Mirrors/imapsync
1
0
Fork 0
mirror of https://github.com/imapsync/imapsync.git synced 2024-11-17 00:02:29 +01:00
Code Issues Releases Activity

1.267

Browse Source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:43 +00:00
parent c09ef20a65
commit 36bfe4238a
46 changed files with 30656 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
BUG_IMAPClient_3.xx
View File

@ -6,4 +6,8 @@ BUGS found with Mail-IMAPClient-3.05/
30 timeout.
2) --expunge2 does not expunge anything.
Fixed in Mail-IMAPClient-3.10/

20
ChangeLog
View File

@ -1,17 +1,29 @@
RCS file: RCS/imapsync,v
Working file: imapsync
head: 1.264
head: 1.267
branch:
locks: strict
gilles: 1.264
access list:
symbolic names:
keyword substitution: kv
total revisions: 264; selected revisions: 264
total revisions: 267; selected revisions: 267
description:
----------------------------
revision 1.264 locked by: gilles;
revision 1.267
date: 2008/10/07 11:36:02; author: gilles; state: Exp; lines: +14 -10
Better test to check non existing folders on destination
server.
----------------------------
revision 1.266
date: 2008/10/07 05:56:52; author: gilles; state: Exp; lines: +27 -10
*** empty log message ***
----------------------------
revision 1.265
date: 2008/08/30 14:20:38; author: gilles; state: Exp; lines: +7 -7
carp to warn
----------------------------
revision 1.264
date: 2008/08/27 15:19:05; author: gilles; state: Exp; lines: +7 -8
Archiveopteryx 3.0.0
----------------------------

401
Mail-IMAPClient-3.10/COPYRIGHT Normal file
View File

@ -0,0 +1,401 @@
COPYRIGHT
Copyright 1999, 2000, 2001, 2002 , 2003 The Kernen Group, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the terms of either:
a) the "Artistic License" which comes with this Kit, or
b) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
General Public License or the Artistic License for more details. All your
base are belong to us.
=============
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
=============
GNU GENERAL PUBLIC LICENSE
Version 1, February 1989
Copyright (C) 1989 Free Software Foundation, Inc.
59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The license agreements of most software companies try to keep users
at the mercy of those companies. By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.
When we speak of free software, we are referring to freedom, not
price. Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must tell them their rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License. The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications. Each
licensee is addressed as "you".
1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program. You may charge a fee for the physical act of
transferring a copy.
2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:
a) cause the modified files to carry prominent notices stating that
you changed the files and the date of any change; and
b) cause the whole of any work that you distribute or publish, that
in whole or in part contains the Program or any part thereof, either
with or without modifications, to be licensed at no charge to all
third parties under the terms of this General Public License (except
that you may choose to grant warranty protection to some or all
third parties, at your option).
c) If the modified program normally reads commands interactively when
run, you must cause it, when started running for such interactive use
in the simplest and most usual way, to print or display an
announcement including an appropriate copyright notice and a notice
that there is no warranty (or else, saying that you provide a
warranty) and that users may redistribute the program under these
conditions, and telling the user how to view a copy of this General
Public License.
d) You may charge a fee for the physical act of transferring a
copy, and you may at your option offer warranty protection in
exchange for a fee.
Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.
3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:
a) accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of
Paragraphs 1 and 2 above; or,
b) accompany it with a written offer, valid for at least three
years, to give any third party free (except for a nominal charge
for the cost of distribution) a complete machine-readable copy of the
corresponding source code, to be distributed under the terms of
Paragraphs 1 and 2 above; or,
c) accompany it with the information you received as to where the
corresponding source code may be obtained. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form alone.)
Source code for a work means the preferred form of the work for making
modifications to it. For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.
4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License. However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.
5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions. You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.
7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.
8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
Appendix: How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.
To do so, attach the following notices to the program. It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) 19yy <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 1, or (at your option)
any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation,
Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) 19xx name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License. Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the
program `Gnomovision' (a program to direct compilers to make passes
at assemblers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
That's all there is to it!

1720
Mail-IMAPClient-3.10/Changes Normal file
View File

File diff suppressed because it is too large Load Diff

82
Mail-IMAPClient-3.10/INSTALL Normal file
View File

@ -0,0 +1,82 @@
Mail::IMAPClient Installation
The Mail::IMAPClient is written entirely in Perl, so it should install
on any reasonably recent version of Perl. See the README file for a perl
one-liner that you can run to verify that your perl has what it takes
to run Mail::IMAPClient.
The installation is standard:
0) cd to installation directory
1) perl Makefile.PL (and reply to the prompts)
2) make (optional)
3) make test (optional)
4) make install
The 'make install' and 'make test' will both do step 2 ('make') if you
haven't done it already. Currently the test script is lame (although
not as lame as in the last release!) but I hope to incorporate more
thorough testing in a future version. You should at least try it and
let me know if your tests fail.
Version 1.0 changed the installation script so that it reuses the
parameter file for the tests if it finds one. Installation can be run in
the background if the test.txt file exists. Touching it is good enough
to prevent prompts; having a correctly formatted version (as shown in
test_template.txt) is even better, as it will allow you to do a thorough
'make test'. Invalid data in test.txt (either from precreating it or from
responding inaccurately to prompts) will cause 'make test' to report 'not
ok' results but won't break anything important (like the IMAPClient.pm
file, or your car).
If you have tests that fail it may be more illuminating to run the
tests by hand. IE: perl -I./blib/lib t/basic.t from the installation
dir will pinpoint the failing test. Better yet, supply an argument to
basic/t (any 'true' argument will do; I use '1') to turn on debugging,
which will be placed in your installation directory in 'imap1.debug'
and 'imap2.debug'. E-mail me the results.
If you don't have a test.txt file in your installation directory then you
will have to answer at least one prompt. If you do have a test.txt file,
and you run 'make clean', then you won't have a test.txt file anymore,
so take precautions.
If you do have a test.txt file and you don't run 'make clean' then
a text file will be sitting around containing logon credentials, so,
again, take precautions. (It's just a test account anyway, right?)
If, when replying to the "perl Makefile.PL" prompts, you supply server,
id, and password credentials for an id that has a ridiculously huge number
of folders and subfolders then the 'make test' may run approximately
forever. Next time try an id with less stuff.
For examples on using Mail::IMAPClient, check out the examples
subdirectory. If you have better examples, then why haven't you e-mailed
them to me? Also, I totally recommend that you have a copy of RFC2060
handy when using this module, since the documentation for this module is
meant to compliment, not replace, RFC2060. In fact, I am so convinced that
you'll need the RFC that I've included a copy of it in the distribution,
under the "docs/" subdirectory. It's a smashing good read so have at
it. Other IMAP related rfcs are there as well.
One of the examples in the examples/ subdirectory is called
cleanTest.pl. If you find your 'make test' has had trouble and left some
folders named "IMAPClient_*" in your test account, you can run this
example to clean up the account. But probably only after you've fixed
any problems encountered with 'make test'!
This module uses Damian Conway's excellent Parse::RecDescent module
for some advanced features. If you don't have that module installed
then you can still install Mail::IMAPClient but you won't have the
full functionality. If you have Parse::RecDescent installed and then
upgrade it, you may find that some features in Mail::IMAPClient suddenly
start throwing compile-time errors. Just 'make clean' and then 'make',
'make test', and 'make install'. This happens because grammers compiled
under older releases of Parse::RecDescent are sometimes incompatible
with newer Parse::RecDescent runtime engines. This would never be a
problem if Mail::IMAPClient recompiled grammers at run time, but for
performance reasons it precompiles them at install time. TANSTAAFL.
Now go and write IMAP clients.
Dave Kernen

39
Mail-IMAPClient-3.10/MANIFEST Normal file
View File

@ -0,0 +1,39 @@
COPYRIGHT
Changes
INSTALL
MANIFEST
Makefile.PL
README
TODO
examples/build_dist.pl
examples/build_ldif.pl
examples/cleanTest.pl
examples/copy_folder.pl
examples/cyrus_expire.pl
examples/cyrus_expunge.pl
examples/find_dup_msgs.pl
examples/imap_to_mbox.pl
examples/imtestExample.pl
examples/migrate_mail2.pl
examples/migrate_mbox.pl
examples/populate_mailbox.pl
examples/sharedFolder.pl
lib/Mail/IMAPClient.pm
lib/Mail/IMAPClient.pod
lib/Mail/IMAPClient/BodyStructure.pm
lib/Mail/IMAPClient/BodyStructure/Parse.grammar
lib/Mail/IMAPClient/BodyStructure/Parse.pm
lib/Mail/IMAPClient/BodyStructure/Parse.pod
lib/Mail/IMAPClient/MessageSet.pm
lib/Mail/IMAPClient/Thread.grammar
lib/Mail/IMAPClient/Thread.pm
lib/Mail/IMAPClient/Thread.pod
prepare_dist
sample.perldb
t/basic.t
t/bodystructure.t
t/messageset.t
t/pod.t
t/thread.t
test_template.txt
META.yml Module meta-data (added by MakeMaker)

26
Mail-IMAPClient-3.10/META.yml Normal file
View File

@ -0,0 +1,26 @@
--- #YAML:1.0
name: Mail-IMAPClient
version: 3.10
abstract: IMAP4 client library
license: ~
author: ~
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
Carp: 0
Data::Dumper: 0
Digest::HMAC_MD5: 0
Errno: 0
Fcntl: 0
File::Temp: 0.18
IO::File: 0
IO::Select: 0
IO::Socket: 0
IO::Socket::INET: 1.26
MIME::Base64: 0
Parse::RecDescent: 1.94
Test::More: 0
Test::Pod: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3

111
Mail-IMAPClient-3.10/Makefile.PL Normal file
View File

@ -0,0 +1,111 @@
use ExtUtils::MakeMaker;
use warnings;
use strict;
sub set_test_data();
WriteMakefile
( NAME => 'Mail::IMAPClient',
, ABSTRACT => 'IMAP4 client library'
, VERSION_FROM => 'lib/Mail/IMAPClient.pm'
, PREREQ_PM =>
{ 'Errno' => 0
, 'IO::Socket' => 0
, 'Fcntl' => 0
, 'IO::Select' => 0
, 'IO::File' => 0
, 'Data::Dumper' => 0
, 'Carp' => 0
, 'IO::Socket::INET' => 1.26
, 'Parse::RecDescent' => 1.94
, 'Digest::HMAC_MD5' => 0
, 'MIME::Base64' => 0
, 'Test::More' => 0
, 'File::Temp' => 0.18
, 'Test::Pod' => 0
}
, clean => { FILES => 'test.txt' }
);
set_test_data();
exit 0;
###
### HELPERS
###
sub set_test_data()
{ unless(-f "lib/Mail/IMAPClient.pm")
{ warn "ERROR: not in installation directory\n";
return;
}
return if -f "./test.txt";
print <<'__INTRO';
You have the option of running an extended suite of tests during
'make test'. This requires an IMAP server name, user account, and
password to test with.
__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")
{ warn "ERROR: couldn't open ./test.txt: $!\n";
return;
}
my $server = "";
until($server)
{ $server = prompt "\nPlease provide the hostname or IP address of "
. "a host running an\nIMAP server (or QUIT to skip "
. "the extended tests)";
chomp $server;
return if $server =~ /^\s*quit\s*$/i ;
}
print TST "server=$server\n";
my $user = "";
until($user)
{ $user = prompt "\nProvide the username of an account on $server (or QUIT)";
chomp $user;
return if $user =~ /^\s*quit\s*$/i ;
}
print TST "user=$user\n";
my $passed = "";
until($passed)
{ $passed = prompt "\nProvide the password for $user (or QUIT)";
chomp $passed;
return if $passed =~ /^\s+$|^quit$/i ;
}
print TST "passed=$passed\n";
my $port = prompt "\nPlease provide the port to connect to on $server "
. "to run the test\n(default is 143)";
chomp $port;
$port ||= 143;
print TST "port=$port\n";
my $authmech = prompt "\nProvide the authentication mechanism to use "
. "on $server to\nrun the test (default is LOGIN)";
chomp $authmech;
$authmech ||= 'LOGIN';
print TST "authmechanism=$authmech\n";
close TST;
print <<'__THANKS';
Gracias! The information you provided (including the password!) has
been stored in test.txt and SHOULD BE REMOVED (either by hand or by
'make clean') after testing.
__THANKS
}

111
Mail-IMAPClient-3.10/README Normal file
View File

@ -0,0 +1,111 @@
Mail::IMAPClient
Copyright 1999-2003 The Kernen Group, Inc.
Copyright 2007 Mark Overmeer
All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the terms of either:
a) the "Artistic License" which comes with this Kit, or
b) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either
the GNU General Public License or the Artistic License for more details.
DESCRIPTION
This module provides perl routines that simplify a sockets connection
to and an IMAP conversation with an IMAP server.
COMPATIBILITY
[This paragraph has not been updated for many years]
This module was developed on Solaris 2.5.1 and 2.6 against Netscape IMAP
servers versions 3.6 and 4.1. However, since it is written in perl and
designed for flexibility, it should run on any OS with a TCP/IP stack and
a version of perl that includes the Socket and IO::Socket modules. It also
should be able to talk to any IMAP server, even those that have, um,
proprietary features (assuming that the programmer knows what those features
are).
To date, I know that the test suite runs successfully with the following IMAP
servers:
-Netscape Messenging Server v4.x
-Netscape Messenging Server v3.x
-UW-IMAP (I think it was 4.5)
-Cyrus IMAP4 v1.5.19
-Mirapoint Message Server Appliances (OS versions 1.6.1, 1.7.1, and 2.0.2)
Version 2.0.3 has been tested with the mdaemon server with mixed
results. It seems that mdaemon does not comply strictly with RFC2060 and
so you may have problems using this module with mdaemon, especially with
folder names with embedded spaces or embedded double quotes. You may be
able to get some simple tasks to work but you won't be able to run the
test suite successfully. Use with caution.
If your server requires the use of the AUTHENTICATE IMAP client command
(say, for strong authentication) then you can still use this module,
provided you can come up with the appropriate responses to any challenges
offered by your server. Mark Bush's Authen::NTLM module can assist with
this if you specifically are interested in NTLM authentication.
REPORING BUGS
See http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient
INSTALLATION
Generally, gunzipping and untarring the source file, running 'perl
Makefile.PL' and 'make install' are all it takes to install this
module. And if that's too much work you can always use the CPAN module!
OVERVIEW OF FUNCTIONALITY
Mail::IMAPClient.pm provides methods to simplify the connection to and
the conversation between a perl script and an IMAP server. Virtually
all IMAP Client commands (as defined in rfc2060) are supported, either
through IMAPClient object methods or the 'default method', which is an
AUTOLOAD hack that assumes a default syntax for IMAP Client commands of:
tagvalue COMMAND [Arg1 [Arg2 [... Arg3]]]"
By remarkable coincidence, AUTOLOAD's default syntax mimics the
general syntax of IMAP Client commands. This means that if a script
tries to use any undefined method then that method will be interpreted
as an unimplemented IMAP command, and the default syntax will be used
to create the command string. I did this as a short cut to writing a
bunch of methods that were practically the same. There are inheritance
implications because of this approach but as far as I can tell this is
not a serious limitation. However, if you decide to write modules that
inherit from this class that require AUTOLOAD logic of their own then you
will have to take the Mail::IMAPClient's AUTOLOAD strategy into account.
Where methods are defined, they usually exist to add functionality,
perhaps by massaging output or by supplying default arguments. An example
is the search method, which accepts the same arguments as the SEARCH
IMAP Client command (as documented in RFC2060) but which massages the
results so that the return value is an array of message sequence numbers
matching the search criteria, rather than a line of text listing the
sequence numbers.
Some methods exists solely to add functionality, such as the folders
method, which invokes the list method but then massages the results to
produce an array containing all folder names. The message_count and
delete_messsage methods are similarly examples of methods that add
function to "raw" IMAP Client commands.
Further information is provided in the module's documentation, which you are
encouraged to read and enjoy.
Good Luck!
Dave Kernen
The Kernen Group, Inc.
DJKERNEN@cpan.org

68
Mail-IMAPClient-3.10/TODO Normal file
View File

@ -0,0 +1,68 @@
=== README
Starting with release 2.99_01, I (Mark Overmeer) try to revive the
module. The original author David Kernen cannot be reached and didn't
release any fixes in four years. That is far too long.
The code and installation procedure has been cleaned-up radically,
and some minimal improvements in the code are made to
fix things people reported.
=== wishlist:
- A start was made in cleanup of the code in Mail/IMAPClient.pm
The file Mail/IMAPClient-cleanup shows the progress (30%)
But I lack the time (a weeks work at least) to complete this
task. There is a lot of code replication to be stripped.
If anyone buys me time, I will complete that task.
=== wishlist from the original author:
The following is a list of some items that I hope to include in a future
release:
- Support for threaded perl programs (still pending as of version 2.2.0.).
- Support for imaps (Imap via SSL). I don't have any way to test this
right now but if you get this to work or know someone who has I'd be
really interested in hearing from you.
- Support for more authentication mechanisms. Currently plain
authentication and cram-md5 authentication are supported. I have
DIGEST-MD5 working at the AUTH qop, but haven't incorporated it into
a released version because I'm still trying to get at least the
integrity qop working, and maybe even privacy, but considering how
much trouble I'm having with just the integrity level I wouldn't
hold my breath if I were you ;-).
- Currently a number of IMAP Client commands are implemented using the
'default method', which is an AUTOLOAD hack. I'd like to reduce that
if possible to a bare minimum. (Some are still pending as of version 2.2.7.)
- I'd like to see this module certified for more OS's and more IMAP servers.
This is (hopefully) just a matter of testing; the code should already
be compatible with the IMAP servers that are out there and with any OS
that allows the IO::Socket module to work. ** A number of platforms
have been added to the list of tested platforms since this was first
written. Please contact DJKernen@cpan.org if you have any to add.
- Support for newer/older/other versions of IMAP. Currently only RFC2060 is
explicitly supported, although thanks to the 'default method'
(implemented via an AUTOLOAD hack) virtually any IMAP command is
supported, even proprietary commands, X- extensions, and so forth. But
not necessarily other authentication mechanisms... :-( (NOTE: the
AUTHENTICATE method partially addresses this issue.)
- Support for piping output from (some?) imap commands directly to a
thingy of some sort (perhaps a coderef, a filehandle, or both).
- Your thingy here!!! Send me your request, and I'll do it in the order of
($popularity/$difficulty ).
- Support for perl version 6. This will probably involve a rewrite that
will make portions of the Mail::IMAPClient module look more like the
Mail::IMAPClient::BodyStructure module. (Perl 6 will have built-in
support for semantics that look remarkably like Damian Conway's
Parse::RecDescent module, which will solve a lot of problems for me.)

172
Mail-IMAPClient-3.10/examples/build_dist.pl Executable file
View File

@ -0,0 +1,172 @@
#!/usr/local/bin/perl
#$Id: build_dist.pl,v 19991216.7 2003/06/12 21:38:29 dkernen Exp $
use Mail::IMAPClient;
=head1 DESCRIPTION
B<build_dist.pl> accepts the name of a target folder as an argument. It
then opens that folder and rummages through all the mail files in it, looking
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
It then appends a message into the folder containing all of the addresses in
thus found as a list of recipients. This message can be used to conveniently
drag and drop names into an address book, distribution list, or e-mail message,
using the GUI client of choice.
The email appended to the folder specified in the I<-f> option will have the
subject "buid_dist.pl I<folder> Output".
=head1 SYNTAX
b<build_dist.pl> I<-h>
b<build_dist.pl> I<-s servername -u username -p password -f folder [ -d ]>
=over 4
=item -f The folder name to process.
=item -s The servername of the IMAP server
=item -u The user to log in as
=item -p The password for the user specified in the I<-u> option
=item -d Tells the IMAP client to turn on debugging info
=item -h Prints out this document
=back
B<NOTE:> You can supply defaults for the above options by updating the script.
=cut
use Getopt::Std;
getopts('s:u:p:f:d');
# Update the following to supply defaults:
$opt_f ||= "default folder";
$opt_s ||= "default server";
$opt_u ||= "default user";
$opt_p ||= "default password"; # security risk: use with caution!
# Let the compiler know we're serious about these two variables:
$opt_h = $opt_h or $opt_d = $opt_d ;
exec "perldoc $0" if $opt_h;
my $imap = Mail::IMAPClient->new(
Server => $opt_s ,
User => $opt_u ,
Password=> $opt_p ,
Debug => $opt_d||0 ,
) or die "can't connect to server\n";
$imap->select($opt_f);
my @msgs = $imap->search("NOT SUBJECT",qq("buid_dist.pl $opt_f Output"));
my %list;
foreach my $m (@msgs) {
my $ref = $imap->parse_headers($m,"Reply-to","From");
warn "Couldn't get recipient address from msg#$m\n"
unless scalar(@{$ref->{'Reply-to'}}) ||
scalar(@{$ref->{'From'}}) ;
my $from = scalar(@{$ref->{'Reply-to'}}) ?
$ref->{'Reply-to'}[0] :
$ref->{'From'}[0] ;
my $addr = $from;
$addr =~ s/.*<//;
$addr =~ s/[\<\>]//g;
$list{$addr} = $from unless exists $list{$addr};
}
$append = <<"EOMSG";
To: ${\(join(",",values %list))}
From: $opt_u\@$opt_s
Date: ${\($imap->Rfc822_date(time))}
Subject: build_dist.pl $opt_f Output
The above note was never actually sent to the following people:
${\(join("\n",keys %list))}
Interesting, eh?
Love,
$opt_u
EOMSG
$imap->append($opt_f,$append) or warn "Couldn't append the message.";
$imap->logout;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# $Id: build_dist.pl,v 19991216.7 2003/06/12 21:38:29 dkernen Exp $
# $Log: build_dist.pl,v $
# Revision 19991216.7 2003/06/12 21:38:29 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.6 2000/12/11 21:58:50 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:09 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:22 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:16 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:46 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.8 1999/11/23 17:51:05 dkernen
# Committing version 1.06 distribution copy
#

235
Mail-IMAPClient-3.10/examples/build_ldif.pl Executable file
View File

@ -0,0 +1,235 @@
#!/usr/local/bin/perl
#$Id: build_ldif.pl,v 19991216.11 2003/06/12 21:38:30 dkernen Exp $
use Mail::IMAPClient;
use MIME::Lite;
use Data::Dumper;
=head1 DESCRIPTION
B<build_ldif.pl> accepts the name of a target folder as an argument. It
then opens that folder and rummages through all the mail files in it, looking
for "Reply-to:" headers (or "From:" headers, where there is no "Reply-to:").
It then prints to STDOUT a file in ldif format containing entries for all of
the addresses that it finds. It also appends a message into the specified folder containing
all of the addresses in both the B<To:> field of the message header and in an
LDIF-format attachment.
B<build_ldif.pl> requires B<MIME::Lite>.
=head1 SYNTAX
B<build_ldif.pl> I<-h>
B<build_ldif.pl> I<-s servername -u username -p password -f folder [ -d ]>
=over 4
=item -f The folder name to process.
=item -s The servername of the IMAP server
=item -t Include "To" and "Cc" fields as well as "From"
=item -u The user to log in as
=item -p The password for the user specified in the I<-u> option
=item -d Tells the IMAP client to turn on debugging info
=item -n Suppress delivering message to folder
=item -h Prints out this document
=back
B<NOTE:> You can supply defaults for the above options by updating the script.
=cut
use Getopt::Std;
getopts('hs:u:p:f:dtn');
# Update the following to supply defaults:
$opt_f ||= "default folder";
$opt_s ||= "default server";
$opt_u ||= "default user";
$opt_p ||= "default password"; # security risk: use with caution!
# Let the compiler know we're serious about these variables:
$opt_0 = ( $opt_h or $opt_d or $opt_t or $opt_n or $opt_0);
exec "perldoc $0" if $opt_h;
my $imap = Mail::IMAPClient->new(
Server => $opt_s ,
User => $opt_u ,
Password=> $opt_p ,
Debug => $opt_d||0 ,
) or die "can't connect to server\n";
$imap->select($opt_f); $imap->expunge;
my @msgs = $imap->search("NOT SUBJECT",qq("buid_ldif.pl $opt_f Output"));
my %list;
foreach my $m (@msgs) {
my $ref = $imap->parse_headers($m,"Reply-to","From");
warn "Couldn't get recipient address from msg#$m\n"
unless scalar(@{$ref->{'Reply-to'}}) ||
scalar(@{$ref->{'From'}}) ;
my $from = scalar(@{$ref->{'Reply-to'}}) ?
$ref->{'Reply-to'}[0] :
$ref->{'From'}[0] ;
my $name = $from ;
$name =~ s/<.*// ;
if ($name =~ /\@/) {
$name = $from ;
$name =~ s/\@.*//; ;
}
$name =~ s/\"//g ;
$name =~ s/^\s+|\s+$//g ;
my $addr = $from ;
$addr =~ s/.*<// ;
$addr =~ s/[\<\>]//g ;
$list{lc($addr)} = [ $addr, $name ]
unless exists $list{lc($addr)} ;
if ($opt_t) { # Do "To" and "Cc", too
my $ref = $imap->parse_headers($m,"To","Cc") ;
my @array = ( @{$ref->{To}} , @{$ref->{Cc}} ) ;
my @members = () ;
foreach my $text (@array) {
while ( $text =~ / "([^"\\]*(\\.[^"\\]*)*"[^,]*),? |
([^",]+),? |
,
/gx
) {
push @members, defined($1)?$1:$3 ;
}
}
foreach my $to (@members) {
my $name = $to ;
$name =~ s/<.*// ;
if ($name =~ /\@/) {
$name = $to ;
$name =~ s/\@.*//; ;
}
$name =~ s/\"//g ;
$name =~ s/^\s+|\s+$//g ;
my $addr = $to ;
$addr =~ s/.*<// ;
$addr =~ s/[\<\>]//g ;
$list{lc($addr)} = [ $addr, $name ]
unless exists $list{lc($addr)} ;
}
}
}
my $text = join "",map {
qq{dn: cn="} . $list{$_}[1] .
qq{", mail=$list{$_}[0]\n} .
qq{cn: } . $list{$_}[1] . qq{\n} .
qq{mail: $list{$_}[0]\n} .
qq{objectclass: top\nobjectclass: person\n\n};
} keys %list ;
# Create a new multipart message:
my $msg = MIME::Lite->new(
From => $opt_u,
map({ ("To" => $list{$_}[0]) } keys %list),
Subject => "LDIF file from $opt_f",
Type =>'TEXT',
Data =>"Attached is the LDIF file of addresses from folder $opt_f."
);
$msg->attach( Type =>'text/ldif',
Filename => "$opt_f.ldif",
Data => $text ,
);
print $text;
$imap->append($opt_f, $msg->as_string) unless $opt_n;
print Dumper($imap) if $opt_d;
$imap->logout;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 1999,2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# $Id: build_ldif.pl,v 19991216.11 2003/06/12 21:38:30 dkernen Exp $
# $Log: build_ldif.pl,v $
# Revision 19991216.11 2003/06/12 21:38:30 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.10 2002/05/24 15:47:18 dkernen
# Misc fixes
#
# Revision 19991216.9 2000/12/11 21:58:51 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.8 2000/03/02 19:57:13 dkernen
#
# Modified Files: build_ldif.pl -- to support new option to all "To:" and "Cc:" to be included in ldif file
#
# Revision 19991216.7 2000/02/21 16:16:10 dkernen
#
# Modified Files: build_ldif.pl -- to allow for "To:" and "Cc:" header handling and
# to handle quoted names in headers
#
# Revision 19991216.6 1999/12/28 13:56:59 dkernen
# Fixed -h option (help).
#
# Revision 19991216.5 1999/12/16 17:19:10 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:24 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:18 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:48 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.8 1999/11/23 17:51:05 dkernen
# Committing version 1.06 distribution copy
#

64
Mail-IMAPClient-3.10/examples/cleanTest.pl Executable file
View File

@ -0,0 +1,64 @@
#!/usr/local/bin/perl
use Mail::IMAPClient;
use IO::File;
#
# Example that will also clean out your test account if interrupted 'make test'
# runs have left junk folders there. Run from installation dir, installation/examples
# subdir, or supply full path to the test.txt file (created during 'perl Makefile.PL'
# and left in the installation dir until 'make clean').
# If you 've already run 'make clean' or said no to extended tests,
# then you don't have the file anyway; re-run 'perl Makefile.PL', reply 'y' to the
# extended tests prompt, then supply the test account's credentials as prompted.
# Then try this again.
#
if ( -f "./test.txt" ) {
$configFile = "./test.txt"
} elsif ( -f "../test.txt" ) {
$configFile = "../test.txt"
} elsif ( $ARGV[0] and -f "$ARGV[0]" ) {
$configFile = $ARGV[0];
} else {
print STDERR "Can't find test.txt. Please run this from the installation directory ",
"or supply the full path to test.txt as an argument on the command line.\n";
}
my $fh = IO::File->new("./test.txt") or die "./test.txt: $!\n";
while (my $input = <$fh>) {
chomp $input;
my($k,$v) = split(/=/,$input,2);
$conf{$k}=$v;
}
my $imap = Mail::IMAPClient->new(Server=>$conf{server},User=>$conf{user},
Password=>$conf{passed}) or die "Connecting to $conf{server}: $! $@\n";
for my $f ( grep(/^IMAPClient_/,$imap->folders) ) {
print "Deleting $f\n";
$imap->select($f);
$imap->delete_messages(@{$imap->messages}) ;
$imap->close($f);
$imap->delete($f);
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut

147
Mail-IMAPClient-3.10/examples/copy_folder.pl Normal file
View File

@ -0,0 +1,147 @@
#!/usr/local/bin/perl
#$Id: copy_folder.pl,v 19991216.3 2003/06/12 21:38:30 dkernen Exp $
++$|;
use Getopt::Std;
use Mail::IMAPClient;
use vars qw/$opt_r $opt_h $opt_t $opt_f/;
getopts("t:f:F:N:rh");
if ( $opt_h ) {
print &usage;
exit;
}
my($to_id,$to_pass,$thost) = $opt_t =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
my($from_id,$from_pass,$fhost) =
$opt_f =~ m{
([^/]+) # everything up to / is the id
/ # then a slash
([^@]+) # then everything up to @ is pswd
@ # then an @-sign
(.*) # then everything else is the host
}x ;
$to_id and $from_id and $to_pass and $from_pass and $thost and $fhost
or die "Error: Must specify -t and -f (to and from)\n" . &usage;
$opt_F or
die "Error: Must specify '-F folder' or how will I know what folder to copy?\n" .
&usage ;
$opt_N ||= $opt_F;
print "Copying folder $opt_F from $from_id\@$fhost to ${to_id}'s $opt_N folder on $thost.\n";
my ($from) = Mail::IMAPClient->new( Server => $fhost,
User => $from_id,
Password=> $from_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my ($to) = Mail::IMAPClient->new( Server => $thost,
User => $to_id,
Password=> $to_pass,
Fast_IO => 1,
Uid => 1,
Debug => 0,
);
my @folders = $opt_r ? @{$from->folders($opt_F)} : ( $opt_F ) ;
foreach my $fold (@folders) {
print "Processing folder $fold\n";
$from->select($fold);
if ($opt_F ne $opt_N) {
$fold =~s/^$opt_F/$opt_N/o;
}
unless ($to->exists($fold)) {
$to->create($fold) or warn "Couldn't create $fold\n" and next;
}
$to->select($fold);
my @msgs = $from->search("ALL");
# my %flaghash = $from->flags(\@msgs);
foreach $msg (@msgs) {
print "Processing message $msg in folder $fold.\n";
my $string = $from->message_string($msg);
# print "String = $string\n";
my $new_id = $to->append($fold,$string)
or warn "Couldn't append msg #$msg to target folder $fold.\n";
$to->store($new_id,"+FLAGS (" . join(" ",@{$from->flags($msg)}) . ")");
}
}
sub usage {
return "Syntax:\n\t$0 -t to_id/to_pass\@to.host -f from_id/from_pass\@from.host \\\n" .
"\t\t-F folder [-N New_Folder] [-r]\n".
"\tor\n\t$0 -h\n\n".
"\twhere:\n\t\t".
"to_id\t\tis the id to recieve the folder\n\t\t".
"to_pass\t\tis the password for to_id\n\t\t".
"from\t\tis the uid who currently has the folder\n\t\t".
"from_pass\tis the password for from_id\n\t\t".
"to.host\t\tis the optional host where the 'to' uid has a mailbox\n\t\t".
"from.host\tis the optional host where the 'from' uid has a mailbox\n\t\t".
"folder\t\tis the folder to copy from\n\t\t".
"New_Folder\tis the folder to copy to (defaults to 'folder')\n\t\t".
"-h\t\tprints this help message\n\t\t".
"-r\t\tspecifies a recursive copy (only works on systems that support the idea " .
"\n\t\t\t\tof recursive folders)\n\t\t".
"\n"
;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 1999,2000,2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# History:
# $Log: copy_folder.pl,v $
# Revision 19991216.3 2003/06/12 21:38:30 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.2 2000/12/11 21:58:51 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#

111
Mail-IMAPClient-3.10/examples/cyrus_expire.pl Executable file
View File

@ -0,0 +1,111 @@
#!/usr/local/bin/perl
#$Id
use Mail::IMAPClient; # available from http://search.cpan.org/search?mode=module&query=IMAPClient
use IO::File;
use Getopt::Std;
use vars qw/ $opt_d $opt_s $opt_p $opt_u $opt_P $opt_h /;
&getopts('d:s:u:p:P:h'); # -d days_to_keep -u cyrys_user -p cyrus_pswd -s cyrus_server -P port
my $days_to_keep = $opt_d||365; # Delete msgs older than -d arg or 365 days
my $cutoff = time - ( $days_to_keep * 24 * 60 * 60 ) ; # time - arg * 24 * 60 * 60 = cutoff date in seconds
# Change the following line (or replace it with something better):
$opt_h and die help()."\n";
my $h = $opt_s || "localhost" ;
my $u = $opt_u || "cyrys" ;
my $p = $opt_p or die "Unable to continue. No password provided.\n" . help();
my $imap = Mail::IMAPClient->new(
Server => "$h",
User => "$u", # $u,
Password=> "$p", # $p,
Uid => 1, # True value
Port => $opt_P||143, # imapd
Debug => 0, # Make true to debug
Buffer => 4096*10, # True value; decrease on machines w/little memory
Fast_io => 1, # True value
Timeout => 30, # True value
# Debug_fh=> IO::File->new(">out.db"), # fhandle
)
or die "$@";
my $mcnt = my $fcnt = 0;
print "Deleting messages older than ",$imap->Rfc2060_date($cutoff),"\n";
for my $f ( $imap->folders ) {
print "Expiring $f\n";
unless ($imap->select($f) ) {
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
$imap->select($f) or warn "Cannot select $f: $@" and next;
}
my @expired = $imap->search("SENTBEFORE",$imap->Rfc2060_date($cutoff));
next unless @expired;
$mcnt += scalar(@expired); $fcnt ++;
print "Deleting ",scalar(@expired)," messages from $f\n";
$imap->delete_message(@expired);
$imap->expunge;
$imap->close;
}
$imap->logout;
print "Deleted a total of $mcnt messages in $fcnt folders.\n";
exit;
sub help {
return <<"EOHELP";
Usage:
$0 [ -d days_to_keep ] [ -s mail_server ] [ -u cyrus_admin_id ] -p cyrus_password
$0 -h
-h -- prints this here help message
-d days_to_keep -- $0 will delete messages older than "days_to_keep". (Default is 365)
-s mail_server -- hostname or IP Address of IMAP mail server (defaults to "localhost")
-u cyrus_admin_id -- user name of Unix account that owns Cyrus server (defaults to "cyrus")
-p cyrus_password -- password for the "cyrus_admin_id" user account (no default)
-P cyrus_port -- port where the cyrus imapd daemon is listening (defaults to value from
/etc/services or '143')
EOHELP
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#$Log: cyrus_expire.pl,v $
#Revision 19991216.2 2003/06/12 21:38:31 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#

85
Mail-IMAPClient-3.10/examples/cyrus_expunge.pl Normal file
View File

@ -0,0 +1,85 @@
#!/usr/local/bin/perl
#$Id: cyrus_expunge.pl,v 19991216.3 2003/06/12 21:38:31 dkernen Exp $
use Mail::IMAPClient;
use IO::File;
# Change the following line (or replace it with something better):
my($h,$u,$p) = ('cyrus_host','cyrus_admin_id','cyrus_admin_pswd');
my $imap = Mail::IMAPClient->new( Server => "$h", # imap host
User => "$u", # $u,
Password=> "$p", # $p,
Uid => 1, # True value
Port => 143, # Cyrus
Debug => 0, # True value
Buffer => 4096*10, # True value
Fast_io => 1, # True value
Timeout => 30, # True value
# Debug_fh=> IO::File->new(">out.db"), # fhandle
)
or die "$@";
for my $f ( $imap->folders ) {
print "Expunging $f\n";
unless ($imap->select($f) ) {
$imap->setacl($f,$u,"lrswipcda") or warn "Cannot setacl for $f: $@\n" and next;
$imap->select($f) or warn "Cannot select $f: $@" and next;
}
$imap->expunge;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: cyrus_expunge.pl,v $
#Revision 19991216.3 2003/06/12 21:38:31 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#Revision 1.1 2003/06/12 21:38:14 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

217
Mail-IMAPClient-3.10/examples/find_dup_msgs.pl Normal file
View File

@ -0,0 +1,217 @@
#!/usr/local/bin/perl
# $Id: find_dup_msgs.pl,v 19991216.5 2003/06/12 21:38:32 dkernen Exp $
use Mail::IMAPClient;
use Mozilla::LDAP::Conn;
use Getopt::Std;
use vars qw/$rootdn $opt_a/;
use Data::Dumper;
# It then connects to a user's mailhost and rummages around,
# looking for duplicate messages.
# It will optionally delete messages that are duplicates (based on
# msg-id header and number of bytes).
# For help, enter:
# find_dup_msgs.pl -h
#
getopts('ahdtvf:F:u:s:p:P:');
if ( $opt_h ) {
print STDERR &usage;
exit;
}
my $uid = $opt_u or die &usage;
$opt_s||='localhost';
$opt_p or die &usage;
$opt_P||=143;
$opt_t and
$opt_d and
die "ERROR: Don't specify -d and -t together.\n" . &usage;
my($pu,$pp) = get_admin();
print "Connecting to $host:$opt_P\n" if $opt_v;
my $imap = Imap->new( Server => $opt_s,
User => $opt_u,
Password=> $opt_p,
Port => $opt_P,
Fast_io => 1,
) or die "couldn't connect to $host port $opt_P: $!\n";
my %folders; my %counts;
FOLDER: foreach my $f ( $opt_F ? $opt_F : $imap->folders ) {
next if $opt_t and $f eq 'Trash';
$folders{$f} = 0;
$counts{$f} = $imap->message_count($f);
print "Processing folder $f\n" if $opt_v;
unless ( $imap->select($f)) {
warn "Error selecting $f: " . $imap->LastError . "\n";
next FOLDER;
}
my @msgs = $imap->search("ALL");
my %hash = ();
MESSAGE: foreach my $m (@msgs) {
my $mid;
if ($opt_a) {
my $h = $imap->parse_headers(
$m,"Date","Subject","From","Message-ID"
) or next MESSAGE;
$mid = "$h->{'Date'}[0]$;$h->{'Subject'}[0]$;".
"$h->{'From'}[0]$;$h->{'Message-ID'}[0]";
} else {
$mid = $imap->parse_headers(
$m,
"Message-ID"
)->{'Message-ID'}[0]
or next MESSAGE;
}
my $size = $imap->size($m);
if ( exists $hash{$mid} and $hash{$mid} == $size ) {
if ($opt_f) {
open F,">>$opt_f" or
die "can't open $opt_f: $!\n";
print F $imap->message_string($m),
"___END OF SAVED MESSAGE___","\n";
close F;
}
$imap->move("Trash",$m) if $opt_t;
$imap->delete_message($m) if $opt_d;
$folders{$f}++;
print "Found a duplicate in ${f}; key = $mid\n" if $opt_v;
} else {
$hash{$mid} = $size;
}
}
print "$f hash:\n",Data::Dumper::Dumper(\%hash) if $opt_v;
$imap->expunge if ($opt_t or $opt_d);
}
my $total; my $totms;
map { $total += $_} values %folders;
map { $totms += $_ } values %counts;
print "Found $total duplicate messages in ${uid}'s mailbox. ",
"The breakdown is:\n",
"\tFolder\tNumber of Duplicates\tNumber of Msgs in Folder\n",
"\t------\t--------------------\t------------------------\n",
map { "\t$_\t$folders{$_}\t$counts{$_}\n" } keys %folders,
"\tTOTAL\t$total\t$totms\n"
;
sub usage {
return "Usage:\n" .
"\t$0 [-d|-t] [-v] [-f filename] [-a] [-P port] \\\n".
"\t\t-s server -u user -p password\n\n" .
"\t-a\t\tdo an especially aggressive search for duplicates\n".
"\t-d\t\tdelete duplicates (default is to just report them)\n".
"\t-f file\t\tsave deleted messages in file named 'file'\n" .
"\t-F fldr\t\tOnly check the folder named 'fldr' (default is to check all folders)\n" .
"\t-h\t\tprint this help message (all other options are ignored)\n" .
"\t-p password\tspecify the target user's password\n" .
"\t-P port\t\tspecify the port to connect to (default is 143)\n" .
"\t-s server\tspecify the target mail server\n" .
"\t-u uid\t\tspecify the target user\n" .
"\t-t\t\tmove deleted messages to trash folder\n" .
"\t-v\t\tprint verbose status messages while processing\n".
"\n" ;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# History:
# $Log: find_dup_msgs.pl,v $
# Revision 19991216.5 2003/06/12 21:38:32 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 1.1 2003/06/12 21:38:14 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.4 2002/08/23 14:34:51 dkernen
#
# Modified Files: Changes IMAPClient.pm Makefile Makefile.PL test.txt for version 2.2.0
# Added Files: Makefile Makefile.PL Parse.grammar Parse.pm Parse.pod version 2.2.0
# Added Files: parse.t for version 2.2.0
# Added Files: bodystructure.t for 2.2.0
# Modified Files: find_dup_msgs.pl for v2.2.0
#
# Revision 1.6 2001/03/08 19:00:35 dkernen
#
# ----------------------------------------------------------------------
# Modified Files:
# copy_folder.pl delete_mailbox.pl find_dup_msgs.pl
# mbox_check.pl process_orphans.pl rename_id.pl
# scratch_indexes.pl
# to get ready for nsusmsg02 upgrade
# ----------------------------------------------------------------------
#
# Revision 1.5 2000/11/01 15:51:58 dkernen
#
# Modified Files: copy_folder.pl find_dup_msgs.pl restore_mbox.pl
#
# Revision 1.4 2000/04/13 21:17:18 dkernen
#
# Modified Files: find_dup_msgs.pl - to add -a switch (for aggressive dup search)
# Added Files: copy_folder.pl - a utility for copying a folder from one user's
# mailbox to another's
#
# Revision 1.3 2000/03/14 16:40:21 dkernen
#
# Modified Files: find_dup_msgs.pl -- to skip msgs with no message-id
#
# Revision 1.2 2000/03/13 19:05:50 dkernen
#
# Modified Files:
# delete_mailbox.pl find_dup_msgs.pl restore_mbox.pl -- to add cvs comments
# find_dup_msgs.pl -- to fix bug that occurred when -t (move-to-trash) switch is used
#

217
Mail-IMAPClient-3.10/examples/imap_to_mbox.pl Executable file
View File

@ -0,0 +1,217 @@
#!/usr/local/bin/perl
# (c) 1999 Thomas Stromberg, Research Triangle Commerce, Inc.
# This software is protected by the BSD License. No rights reserved anyhow.
# <tstromberg@rtci.com>
# DESC: Reads a users IMAP folders, and converts them to mbox
# Good for an interim switch-over from say, Exchange to Cyrus IMAP.
# TODO:
# correct header printing From
use Mail::IMAPClient; # a nice set of perl libs for imap
use IO::Socket::SSL;
use Getopt::Std; # for the command-line overrides. good for user
use File::Path; # create full file paths. (yummy!)
use File::Basename; # find a nice basename for a folder.
use Date::Manip; # to create From header date
$| = 1;
sub connect_imap();
sub find_folders();
sub write_folder($$$$);
# Config for the imap migration kit.
getopts('u:p:P:s:i:f::b:c:W:Sdh');
$SSL = $opt_S || 0;
$SERVER = $opt_s || 'dell2';
$USER = $opt_u || 'userid';
$PASSWORD = $opt_p || 'password';
$PORT = $opt_P || '143';
$INBOX_PATH = $opt_i || "/var/mail/$USER";
$FOLDERS_PATH = $opt_f || "./folders/$USER";
$DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
$READ_DELIMITER = $opt_r || '/';
$WRITE_DELIMITER= $opt_w || '/';
$WRITE_MODE = $opt_W || '>';
$BANNED_CHARS = $opt_b || '.|^|%';
$CR = $opt_c || "\r";
$DELETE = $opt_D || 0;
$DEBUG = $opt_d || "0";
$FAIL = 0;
if ($opt_h) {
# print help here
print "imap_to_mbox.pl - with the following optional arguments:
-S Use an SSL connection (default $SSL)
-s <s> Server specification (default $SERVER)
-u <u> User login (default $USER)
-p <p> User password
-P <p> Server Port (default $PORT)
-i <i> INBOX save path (default $INBOX_PATH)
-f <f> Save path for other folders (default $FOLDERS_PATH)
-m <r> Regexp for IMAP folders not to be saved:
$DONT_MOVE
-r <r> Read delimiter (default \"$READ_DELIMITER\")
-w <w> Write Delimiter (default \"$WRITE_DELIMITER\")
-b <b> Banned chars (default \"$BANNED_CHARS\")
-c <c> Strip CRs from saved files [for Unix] (default \"$CR\")
-D Delete files downloaded on server
-d Debug mode (default $DEBUG)\n";
exit 1;
}
## do our magic tricks ######################################
connect_imap;
find_folders;
sub connect_imap()
{
# Open an SSL session to the IMAP server
# Handles the SSL setup, and gives us back a socket
my $ssl;
if ($opt_S) {
$ssl=IO::Socket::SSL->new(
PeerHost => "$SERVER:imaps"
# , SSL_version => 'SSLv2'
);
defined $ssl
or die "Error connecting to $SERVER:imaps - $@";
$ssl->autoflush(1);
}
$imap = Mail::IMAPClient->new(
Socket => ($opt_S ? $ssl : 0),
Server => $SERVER,
User => $USER,
Password => $PASSWORD,
Port => $PORT,
Debug => $DEBUG,
Uid => 0,
Clear => 1,
)
or die ("Could not connect to $SERVER:$PORT with $USER: $! $?\n");
}
sub find_folders()
{
my @folders = $imap->folders;
# push(@folders, "INBOX");
foreach my $folder (@folders)
{ my $message_count = $imap->message_count($folder);
if(! $message_count) {
print("* $folder is empty, skipping.\n");
next;
}
if($folder =~ /$DONT_MOVE/) {
print("! $folder matches DONT_MOVE ruleset, skipping\n");
next;
}
my $new_folder = $folder;
$new_folder =~ s/\./_/g;
$new_folder =~ s/\Q$READ_DELIMITER/$WRITE_DELIMITER/g;
my $path
= $new_folder eq "INBOX" ? "$INBOX_PATH"
: "$FOLDERS_PATH/$new_folder";
printf "x %4i %-45.45s => %s", $message_count, $folder, $path;
write_folder $folder, $path, 1, $message_count;
}
}
sub write_folder($$$$)
{ my($folder, $newpath, $first_message, $last_message) = @_;
$imap->select($folder)
or warn "Could not examine $folder: $!";
my $new_dir = dirname $newpath;
my $new_file = basename $newpath;
-d $new_dir
or mkpath($new_dir, 0700)
or die "Cannot create $new_dir:$!\n";
open mbox, $WRITE_MODE, $newpath
or die "Cannot create file $newpath: $!\n";
for (my $i=$first_message; $i<$last_message+1; ++$i)
{ my $date = UnixDate(ParseDate($imap->internaldate($i)),
"%a %b %e %T %Y");
my $user = $imap->get_envelope($i)->from_addresses;
$user =~ s/^.*\<([^>]*)\>/$1/;
$user = '-' unless $user;
print '.' if $i%25 == 0;
my $msg_header = $imap->fetch($i, "FAST")
or warn "Could not fetch header $i from $folder\n";
my $msg_rfc822 = $imap->fetch($i, "RFC822");
unless($msg_rfc822)
{ warn "Could not fetch RFC822 $i from $folder\n";
$FAIL=1
}
undef $start;
foreach (@$msg_rfc822)
{ if($_ =~ /\: / && !$message)
{ ++$message;
print mbox "From $user $date\n";
}
if(/^\)\r/)
{ undef $message;
print mbox "\n\n";
}
next unless $message;
$_ =~ s/\r$//;
$_ = $imap->Strip_cr($_) if $CR;
print mbox "$_";
}
if($DELETE && ! $FAIL)
{ $imap->delete_message($i)
or warn "Could not delete_message: $@\n";
$FAIL = 0;
}
}
close mbox
or die "Write errors to $newpath: $!\n";
if($DELETE)
{ $imap->expunge($folder)
or warn "Could not expunge: $@\n";
}
print "\n";
}
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
# elimination (sobek)
#
# Revision 19991216.7 2002/08/23 13:29:48 dkernen
#
# Revision 19991216.6 2000/12/11 21:58:52 dkernen
#
# Revision 19991216.5 1999/12/16 17:19:12 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:25 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:19 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:49 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.3 1999/11/23 17:51:06 dkernen
# Committing version 1.06 distribution copy

226
Mail-IMAPClient-3.10/examples/imtestExample.pl Executable file
View File

@ -0,0 +1,226 @@
#!/usr/local/bin/perl
use Sys::Hostname;
use Mail::IMAPClient;
use IPC::Open3;
use IO::Socket::UNIX;
use IO::Socket;
use Socket;
use Getopt::Std;
&getopts('ha:df:i:o:p:r:m:u:x:w:p:s:');
if ($opt_h) {
print <<" HELP";
$0 -- uses imtest to connect and authenticate to imap server
Options:
-h print this help message
-a auth authenticate as user 'auth'. This value is passed as the '-a' value
to imtest and defaults to whatever you supplied for -u.
-d turn on Mail::IMAPClient debugging
-f file write Mail::IMAPClient debugging info to file 'file'
-m mech use authentication mechanism "mech"; default is to not supply -m to
imtest
-i path path to imtest executable; default is to let your shell find it via the
PATH environmental variable.
-p port port on mail server to connect to (default is 143)
-r rlm Use realm 'rlm' (default is name of mail server)
-s srvr Name of IMAP mail server (default is the localhost's hostname)
-u usr Use 'usr' as the user id (required)
-w pswd Use 'pswd' as the password for 'usr' (required)
-x path Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
-o 'ops' Pass the string 'ops' directy to imtest as additional options.
This is how you get "other" imtest options passed to imtest. (I only
included switches for options that are either really common or useful
to the IMAPClient object as well as to imtest.)
Many of these switches have the same function here as with imtest. I added a
few extras though!
Example:
$0 -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
-m DIGEST-MD5
It's a good idea to test your options by running imtest from the command line
(but without the -x switch) first. Once you have it working by hand you should
be able to get it to work from this script (or one remarkably like it) without
too much bloodshed.
HELP
exit;
}
$opt_u and $opt_w or die "No userid/password credentials supplied. I hate that.\n";
$opt_a ||= $opt_u;
if ($opt_i ) {
$opt_i =~ m#^[/\.]# or $opt_i = "./$opt_i";
$opt_i =~ m#imtest$# or ( -x $opt_i and -f $opt_i )
or $opt_i .= ( $opt_i =~ m#/$# ? "imtest" : "/imtest") ;
-x $opt_i and -f $opt_i or die "Cannot find executable $opt_i\n";
}
$opt_p ||= 143;
$opt_s ||= hostname;
$opt_r ||= $opt_s;
$opt_x ||= "/tmp/$0.sock";
my($rfh,$wfh,$efh) ;
my($imt) = ($opt_i ? "$opt_i " : "imtest ") .
($opt_m ? "-m $opt_m ":"" ) .
qq(-r $opt_r -a $opt_a -u $opt_u ).
qq(-x $opt_x -w $opt_w -p $opt_p $opt_s);
open3($wfh,$rfh,$efh,$imt);
my $line;
until ($line =~ /^Security strength factor:/i ) {
$line = <$rfh> or die "EOF\n";
print STDERR "Prolog: $line" if $opt_d;
}
sleep 5;
my $sock = IO::Socket::UNIX->new("$opt_x")
or warn "No socket: $!\n" and exit;
print STDERR "<<<END OF PROLOG>>>\n" if $opt_d;
my $imap = Mail::IMAPClient->new;
$imap->Prewritemethod(\&Mail::IMAPClient::Strip_cr);
$imap->User("$opt_u");
$imap->Server("$opt_s");
$imap->Port("$opt_p");
$imap->Debug($opt_d);
$imap->Debug_fh($opt_f||\*STDERR);
$imap->State($imap->Connected);
$imap->Socket($sock);
# Your code goes here:
$imap->Select("INBOX");
for my $m (@{$imap->search("TEXT SUBJECT")} ) {
print "Message $m:\t",$imap->subject($m),"\n";
}
# You should have finished your code by about here
$imap->logout;
print STDERR "<<<END>>>\n" if $opt_d;
exit;
=head1 NAME
imtestExample.pl -- uses imtest to connect and authenticate to imap server
=head1 DESCRIPTION
=head2 Options
=over 4
=item -h
print this help message
=item -a auth
authenticate as user 'auth'. This value is passed as the '-a' value
to imtest and defaults to whatever you supplied for -u.
=item -d
turn on Mail::IMAPClient debugging
=item -f file
write Mail::IMAPClient debugging info to file 'file'
=item -m mech
use authentication mechanism "mech"; default is to not supply -m to
imtest
=item -i path
path to imtest executable; default is to let your shell find it via the
PATH environmental variable.
=item -p port
port on mail server to connect to (default is 143)
=item -r rlm
Use realm 'rlm' (default is name of mail server)
=item -s srvr
Name of IMAP mail server (default is the localhost's hostname)
=item -u usr
Use 'usr' as the user id (required)
=item -w pswd
Use 'pswd' as the password for 'usr' (required)
=item -x path
Path to Unix socket (fifo). Default is '/tmp/$0.sock'.
=item -o 'ops'
Pass the string 'ops' directy to imtest as additional options.
This is how you get "other" imtest options passed to imtest. (I only
included switches for options that are either really common or useful
to the IMAPClient object as well as to imtest.)
Many of these switches have the same function here as with imtest. I added a
few extras though!
=back
Example:
imtestExample.pl -o '-k 128 -l 128' -s imapmail -u test -w testpswd \
-i /usr/local/src/cyrus/cyrus-imapd-2.1.11/imtest/ \
-m DIGEST-MD5
It's a good idea to test your options by running imtest from the command line
(but without the -x switch) first. Once you have it working by hand you should
be able to get it to work from this script (or one remarkably like it) without
too much bloodshed.
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
Based on a suggestion by Tara L. Andrews.
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut

326
Mail-IMAPClient-3.10/examples/migrate_mail2.pl Executable file
View File

@ -0,0 +1,326 @@
#!/usr/local/bin/perl
#$Id: migrate_mail2.pl,v 19991216.4 2003/06/12 21:38:33 dkernen Exp $
#
# An example of how to migrate from a Netscape server
# (which uses a slash as a separator and which does
# not allow subfolders under the INBOX, only next to it)
# to a Cyrus server (which uses a dot (.) as a separator
# and which requires subfolders to be under "INBOX").
# There are also some allowed-character differences taken
# into account but this is by no means complete AFAIK.
#
# This is an example. If you are doing mail migrations
# then this may in fact be a very helpful example but
# it is unlikely to work 100% correctly as-is.
# A good place to start is by testing a rather large-volume
# transfer of actual mail from the source server with the
# -v option turned on and redirect output to a file for
# perusal. Examine the output carefully for unexpected
# results, such as a number of messages being skipped because
# they're already in the target folder when you know darn
# well this is the first time you ran the script. This
# would indicate an incompatibility with the logic for
# detecting duplicates, unless for some reason the source
# mailbox contains a lot of duplicate messages to begin with.
# (The latter case is an example of why you should use an
# actual mailbox stuffed with actual mail for test; if you
# generate test messages and then test migrating those you
# will only prove that your test messages are migratable.
#
# Also, you may need to play with the rules
# for translating folder names based on what kind of
# names your target server and source server support.
#
# You may also need to play with the logic that determines
# whether or not a message has already been migrated,
# especially if your source server has messages that
# did not come from an SMTP gateway or something like that.
#
# Some servers allow folders to contain mail and subfolders,
# some allow folders to only contain either mail or subfolders.
# If you are migrating from a "mixed use" type to a "single use"
# type server then you'll have to figure out how to deal
# with this. (This script deals with this by creating folders like
# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail"
# to hold mail if the source folder contains mail and subfolders
# and the target server supports only single-use folders.
# You may not choose a different strategy.)
#
# Finally, it's possible that in some server-to-server
# copies, the source server supports messages that the
# target server considers unacceptable. For example, some
# but not all IMAP servers flat out refuse to accept
# messages with "base newlines", which is to say messages
# whose lines are match the pattern /[^\r]\n$/. There is
# no logic in this script that deals with the situation;
# you will have to identify it if it exists and figure
# out how you want to handle it.
#
# This is probably not an exhaustive list of issues you'll
# face in a migration, but it's a start.
#
# If you're just migrating from an old version to a newer
# version of the same server then you'll probably have
# a much easier time of it.
#
#
use Mail::IMAPClient;
use Data::Dumper;
use IO::File;
use File::Basename ;
use Getopt::Std;
use strict;
use vars qw/ $opt_B $opt_D $opt_T $opt_U
$opt_W $opt_b $opt_d $opt_h
$opt_t $opt_u $opt_w $opt_v
$opt_s $opt_S $opt_W $opt_p
$opt_P $opt_f $opt_F $opt_m
$opt_M
/;
getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:');
if ( $opt_h ) {
print STDERR <<"HELP";
$0 - an example script demonstrating the use of the Mail::IMAPClient's
migrate method.
Syntax:
$0 -s source_server -u source_user -w source_password -p source_port \
-d debug_source -f source_debugging_file -b source_buffsize \
-t source_timeout -m source_auth_mechanism \
-S target_server -U target_user -W target_password -P target_port \
-D debug_target -F target_debugging_file -B target_buffsize \
-T target_timeout -M target_auth_mechanism \
-v
where "source" refers to the "copied from" mailbox, target is the
"copied to" mailbox, and -v turns on verbose output.
Authentication mechanisms default to "PLAIN".
HELP
exit;
}
$opt_v and ++$|;
print "$0: Started at ",scalar(localtime),"\n" if $opt_v;
$opt_p||=143;
$opt_P||=143;
# Make a connection to the source mailbox:
my $imap = Mail::IMAPClient->new(
Server => $opt_s,
User => $opt_u,
Password=> $opt_w,
Uid => 1,
Port => $opt_p,
Debug => $opt_d||0,
Buffer => $opt_b||4096,
Fast_io => 1,
( $opt_m ? ( Authmechanism => $opt_m) : () ),
Timeout => $opt_t,
($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()),
) or die "$@";
# Make a connection to the target mailbox:
my $imap2 = Mail::IMAPClient->new(
Server => $opt_S,
User => $opt_U,
Password=> $opt_W,
Port => $opt_P,
Uid => 1,
Debug => $opt_D||0,
( $opt_M ? ( Authmechanism => $opt_M) : () ),
($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()),
Buffer => $opt_B||4096,
Fast_io => 1,
Timeout => $opt_T, # True value
) or die "$@";
# Turn off buffering on debug files:
$imap->Debug_fh->autoflush;
$imap2->Debug_fh->autoflush;
# Get folder hierarchy separator characters from source and target:
my $sep1 = $imap->separator;
my $sep2 = $imap2->separator;
# Find out if source and target support subfolders inside INBOX:
my $inferiorFlag1 = $imap->is_parent("INBOX");
my $inferiorFlag2 = $imap2->is_parent("INBOX");
# Set up a test folders to see if the source and target support mixed-use
# folders (i.e. folders with both subfolders and mail messages):
my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234
$testFolder1 = $inferiorFlag2 ?
"INBOX" . $sep2 . $testFolder1 :
$testFolder1 ;
# The following folder will be a subfolder of $testFolder1:
my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ;
$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that
# the parent folder should be created at the same time
# The following line inspired the selectable method. It was also made obsolete by it,
# but I'm leaving it as is to demonstrate use of lower-level method calls:
my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1;
# Repeat the above with the source mailbox:
$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ;
$imap->create($testFolder2) ;
my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1;
print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ",
( defined($inferiorFlag1) ? "allows " : "does not allow "),
"children in the INBOX. It supports ",
($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v;
print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ",
( defined($inferiorFlag2) ? "allows " : "does not allow "),
"children in the INBOX. It supports ",
($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v;
for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);}
my($totalMsgs, $totalBytes) = (0,0);
# Now we will migrate the folder. Here we are doing one message at a time
# so that we can do more granular status reporting and error checking.
# A lazier way would be to do all the messages in one migrate method call
# (specifying "ALL" as the message number) but then we wouldn't be able
# to print out which message we were migrating and it would be a little
# bit tougher to control checking for duplicates and stuff like that.
# We could also check the size of the message on the target right after
# the migrate as an extra safety check if we wanted to but I didn't bother
# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!)
# Iterate over all the folders in the source mailbox:
for my $f ($imap->folders) {
# Select the folder on the source side:
$imap->select($f) ;
# Massage the foldername into an acceptable target-side foldername:
my $targF = "";
my $srcF = $f;
$srcF =~ s/^INBOX$sep1//i;
if ( $inferiorFlag2 ) {
$targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ;
} else {
$targF = $srcF ;
}
$targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2;
$targF =~ tr/#\$\& '"/\@\@+_/;
if ( $imap->is_parent($f) and !$mixedUse2 ) {
$targF .= "_mail" ;
}
print "Migrating folder $f to $targF\n" if $opt_v;
# Create the (massaged) folder on the target side:
unless ( $imap2->exists($targF) ) {
$imap2->create($imap2->Massage($targF))
or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next;
}
# ... and select it
$imap2->select($imap2->Massage($targF))
or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next;
# now that we know the target folder is selectable, we can close it again:
$imap2->close;
my $count = 0;
my $expectedTotal = $imap->message_count($f) ;
# Now start iterating over all the messages on the source side...
for my $msg ($imap->messages) {
++$count;
my $h = "";
# Get some basic info about the message:
eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]};
my $tsize = $imap->size($msg);
my $ret = 0 ; my $h2 = [];
# Make sure we didn't already migrate the message in a previous pass:
$imap2->select($targF);
if ( $tsize and $h and $h2 = $imap2->search(
HEADER => 'Message-id' => $imap2->Quote($h),
NOT => SMALLER => $tsize,
NOT => LARGER => $tsize
)
) {
print
"Skipping $f/$msg to $targF. ",
"One or more messages (" ,join(", ",@$h2),
") with the same size and message id ($h) ",
"is already on the server. ",
"\n"
if $opt_v;
$imap2->close;
} else {
print
"Migrating $f/$msg to $targF. ",
"Message #$count of $expectedTotal has ",
$tsize , " bytes.",
"\n" if $opt_v;
$imap2->close;
# Migrate the message:
my $ret = $imap->migrate($imap2,$msg,"$targF") ;
$ret and ( $totalMsgs++ , $totalBytes += $tsize);
$ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ;
}
}
}
print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n"
if $opt_v;
exit;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#$Log: migrate_mail2.pl,v $
#Revision 19991216.4 2003/06/12 21:38:33 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#

131
Mail-IMAPClient-3.10/examples/migrate_mbox.pl Executable file
View File

@ -0,0 +1,131 @@
#!/usr/local/bin/perl
#
# This is an example demonstrating the use of the migrate method.
# Note that the migrate method is considered experimental and should
# be used with caution.
#
#$Id: migrate_mbox.pl,v 19991216.2 2003/06/12 21:38:33 dkernen Exp $
#
use Mail::IMAPClient;
use IO::File;
use File::Basename ;
use Getopt::Std;
use warnings;
use vars qw/$opt_h $opt_H
$opt_s $opt_u $opt_p $opt_d $opt_b $opt_o
$opt_S $opt_U $opt_P $opt_D $opt_B $opt_O
/;
getopts('Hhs:S:u:U:p:P:d:D:b:B:o:O:');
if ($opt_h or $opt_H ) {
print << "HELP";
Usage:
$0 -[h|H] -- prints this message
Lower-case options are for source server; upper-case options are for the target server.
$0 -s server -S server -u uid -U uid -p passwd -P passwd \
-b buffersize -B buffersize -o debugFile -O debugFile > error_file
All uppercase options except -O default to the lowercase option that was specified.
If you don't specify any uppercase options at all then God help you, I don't know
what will happen.
Always capture STDERR so that you'll be able to resolve any problems that come up.
HELP
exit;
}
my $imap = Mail::IMAPClient->new(
Server => $opt_s,
User => $opt_u,
Password=> $opt_p,
Uid => 1,
Debug => $opt_d,
Buffer => $opt_b||4096,
Fast_io => 1,
Timeout => 160, # True value
Debug_fh=> (
$opt_o ? IO::File->new(">$opt_o")||die "can't open $opt_o: $!\n" : undef )
) or die "Error opening source connection: $@\n";
my $imap2 = Mail::IMAPClient->new(
Server => $opt_S||$opt_s,
User => $opt_U||$opt_u,
Password=> $opt_P||$opt_p,
Uid => 1,
Debug => $opt_D||$opt_d,
Buffer => $opt_B||$opt_b||4096,
Fast_io => 1,
Timeout => 160,
Debug_fh=> (
$opt_O ? IO::File->new(">$opt_O")||die "can't open $opt_O: $!\n" : undef )
) or die "Error opening target connection: $@\n";
$imap->Debug_fh->autoflush;
$imap2->Debug_fh->autoflush;
for my $f ($imap->folders) { $imap->select($f) ; $imap->migrate($imap2,"ALL") ;}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: migrate_mbox.pl,v $
#Revision 19991216.2 2003/06/12 21:38:33 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#Revision 1.1 2003/06/12 21:38:15 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

319
Mail-IMAPClient-3.10/examples/populate_mailbox.pl Executable file
View File

@ -0,0 +1,319 @@
#!/usr/local/bin/perl
#$Id: populate_mailbox.pl,v 19991216.8 2003/06/12 21:38:34 dkernen Exp $ #
use Time::Local ;
use FileHandle ;
use File::Copy ;
use Mail::IMAPClient;
use Sys::Hostname ;
#
my $default_user = 'default' ;
my $default_pswd = 'default' ;
#
#########################################################################
# ARGS: DATE = YYYYMMDDHHMM (defaults to current system date) #
# UID = IMAP account id (defaults to $default_user) #
# PSWD = uid's password (defaults to $default_pswd) #
# HOST = Target host (defaults to localhost) #
# CLEAN = 1 (defaults to 0; used to clean out mailbox 1st) #
# CLEANONLY= 1 (defaults to 0; if 1 then only CLEAN is done) #
# DOMAIN = x.com (no default) the mail domain for UID's address #
# #
# EG: populate_mailbox.pl DATE=200001010100 UID=testuser #
# #
#########################################################################
#
(my($x)= join(" ",@ARGV)) ;
$x=~s~=~ ~g ;
chomp($x) ;
#
my %hash = split(/\s+/, $x) if $x ;
#
while (my ($k,$v) = each %hash ) {
$hash{uc $k} = $v ;
}
while (my ($k,$v) = each %hash ) {
delete $hash{$k} if $k =~ tr/[a-z]// ;
}
;
$hash{UID} ||= "$default_user" ;
$hash{PSWD} ||= "$default_pswd" ;
$hash{HOST} ||= hostname ;
#
while (my ($k,$v) = each %hash ) {
print "Running with $k set to $v\n" ;
}
#
my $domain = $hash{DOMAIN} or die "No mail domain provided.\n" ;
my $now = seconds($hash{DATE}) || time ;
#
my $six = $now - ( 6 * 24 * 60 * 60 ) ;
my $seven = $now - ( 7 * 24 * 60 * 60 ) ;
my $notthirty = $now - ( 29 * 24 * 60 * 60 ) ;
my $thirty = $now - ( 30 * 24 * 60 * 60 ) ;
my $notsixty = $now - ( 59 * 24 * 60 * 60 ) ;
my $sixty = $now - ( 60 * 24 * 60 * 60 ) ;
my $notd365 = $now - ( 364 * 24 * 60 * 60 ) ;
my $d365 = $now - ( 365 * 24 * 60 * 60 ) ;
#
$hash{SUBJECTS} = [ "Sixty days old", "Less than sixty days old" ,
"365 days old", "Less than 365 days old" ,
"Trash/Incinerator -- 7 days old" ,
"Sent -- 29 days old" ,
"Sent -- 30 days old" ,
"Trash -- 6 days old" ,
] ;
$hash{FOLDERS} = [ "Sent", "INBOX", "Trash" ,
"365_folder", "Trash/Incinerator" ,
"not_365_folder" ,
] ;
#
&clean_mailbox if $hash{CLEANONLY} || $hash{CLEAN} ;
exit if $hash{CLEANONLY} ;
#
#send to: date: subject: #
#-------- --- ----- --------- #
sendmail( $hash{UID}, $sixty, "Sixty days old" ) ;
sendmail( $hash{UID}, $notsixty, "Less than sixty days old") ;
sendmail( $hash{UID}, $d365, "365 days old" ) ;
sendmail( $hash{UID}, $notd365, "Less than 365 days old" ) ;
#
populate_trash("Trash/Incinerator",$hash{UID}, $seven, 7 ) ;
populate_trash( "Trash" , $hash{UID}, $six, 6 ) ;
populate_trash( "Sent" , $hash{UID}, $thirty, 30 ) ;
populate_trash( "Sent" , $hash{UID}, $notthirty, 29 ) ;
#
movemail( "365 days old" ,
"365_folder" ) ;
#
movemail( "Less than 365 days old" ,
"not_365_folder" ) ;
#
exit ;
#
#
sub seconds {
my $d = shift or return undef ;
my($yy,$moy,$dom,$hr,$min) =
#
$d =~ m! ^ # anchor at start #
(\d\d\d\d) # year #
(\d\d) # month #
(\d\d) # day #
(\d\d) # hour #
(\d\d) # minute #
!x ;
#
return timegm(0,$min,$hr,$dom,$moy-1,($yy>99?$yy-1900:$yy)) ;
}
#
sub sendmail {
#
my($to,$date,$subject) = @_ ;
my $text = <<EOTEXT ;
To: $to\@$hash{DOMAIN}
Date: @{[&rfc822_date($date)]}
Subject: $subject
Dear mail tester,
This is a test message to test mail for messages \l$subject.
I hope you like it!
Love,
The E-Mail Engineering Team
EOTEXT
#
for (my $x = 0; $x < 10 ; $x ++ ) {
my $imap = Mail::IMAPClient->new (
Server => $hash{HOST} ,
User => $hash{UID} ,
Password=> $hash{PSWD} )
or die "can't connect: $!\n" ;
#
$imap->append("INBOX",$text) ;
$imap->logout ;
}
}
#
sub populate_trash {
my $where = shift ;
my $to = shift ;
my $date = shift ;
my $d = shift ;
#
my($ss,$min,$hr,$day,$mon,$year)=gmtime($date) ;
$mon++ ;
$year += 1900 ;
my $fn =sprintf("%4.4d%2.2d%2.2d%2.2d%2.2d%2.2d" ,
$year,$mon,$day,$hr,$min,$ss ) ;
my $x = 0 ;
my $subject = "$where -- $d days old" ;
while ($x++ < 10) {
my $fh ;
$fh .= "Date: @{[&rfc822_date($date)]}\n" ;
$fh .= <<EOTRAH ;
Subject: $subject
This note was put in the $where folder $d days ago. (My how time flies!)
I hope you enjoyed testing with it!
EOTRAH
my $imap = Mail::IMAPClient->new (
Server => $hash{HOST} ,
User => $hash{UID} ,
Password=> $hash{PSWD} )
or die "can't connect: $!\n" ;
$imap->append($where, $fh) ;
#
}
#
}
#
sub movemail {
#
my ($subj,$fold) = @_ ;
my $fh = Mail::IMAPClient->new (
Debug => 0 ,
Server => $hash{HOST} ,
User => $hash{UID} ,
Password => $hash{PSWD} ,
)
;
#
$fh->select("inbox") or die "cannot open inbox: $!\n" ;
#
foreach my $f ($fh->search(qq(SUBJECT "$subj")) ) {
#
$fh->move($fold,$f) ;
#
}
#
}
#
sub clean_mailbox {
#
my $fh =Mail::IMAPClient->new (
Debug => 0 ,
Server => $hash{HOST} ,
User => $hash{UID} ,
Password => $hash{PSWD} ,
)
;
for my $x (@{$hash{FOLDERS}}) {
my @msgs ;
$fh->create($x) unless $fh->exists($x) ;
$fh->select($x) ;
for my $s (@{$hash{SUBJECTS}}) {
push @msgs, $fh->search(qq(SUBJECT "$s")) ;
}
$fh->delete_message(@msgs) if scalar(@msgs) ;
$fh->expunge ;
}
}
#
sub rfc822_date {
#Date: Fri, 09 Jul 1999 13:10:55 -0400 #
my $date = shift ;
my @date = localtime($date) ;
my @dow = qw{ Sun Mon Tue Wed Thu Fri Sat } ;
my @mnt = qw{ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} ;
#
return sprintf (
"%s, %2.2d %s %4.4s %2.2d:%2.2d:%2.2d -0400" ,
$dow[$date[6]] ,
$date[3] ,
$mnt[$date[4]] ,
$date[5]+=1900 ,
$date[2] ,
$date[1] ,
$date[0] )
;
}
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
# $Id: populate_mailbox.pl,v 19991216.8 2003/06/12 21:38:34 dkernen Exp $
# $Log: populate_mailbox.pl,v $
# Revision 19991216.8 2003/06/12 21:38:34 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 1.1 2003/06/12 21:38:16 dkernen
#
# Preparing 2.2.8
# Added Files: COPYRIGHT
# Modified Files: Parse.grammar
# Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
# Revision 19991216.7 2002/08/23 13:29:49 dkernen
#
# Modified Files: Changes IMAPClient.pm INSTALL MANIFEST Makefile Makefile.PL README Todo test.txt
# Made changes to create version 2.1.6.
# Modified Files:
# imap_to_mbox.pl populate_mailbox.pl
# Added Files:
# cleanTest.pl migrate_mbox.pl
#
# Revision 19991216.6 2000/12/11 21:58:53 dkernen
#
# Modified Files:
# build_dist.pl build_ldif.pl copy_folder.pl find_dup_msgs.pl
# imap_to_mbox.pl populate_mailbox.pl
# to add CVS data
#
# Revision 19991216.5 1999/12/16 17:19:15 dkernen
# Bring up to same level
#
# Revision 19991124.3 1999/12/16 17:14:26 dkernen
# Incorporate changes for exists method performance enhancement
#
# Revision 19991124.02 1999/11/24 17:46:21 dkernen
# More fixes to t/basic.t
#
# Revision 19991124.01 1999/11/24 16:51:51 dkernen
# Changed t/basic.t to test for UIDPLUS before trying UID cmds
#
# Revision 1.4 1999/11/23 17:51:06 dkernen
# Committing version 1.06 distribution copy
#

88
Mail-IMAPClient-3.10/examples/sharedFolder.pl Executable file
View File

@ -0,0 +1,88 @@
#!/usr/local/bin/perl
#$Id: sharedFolder.pl,v 19991216.1 2003/06/12 21:38:35 dkernen Exp $
use Mail::IMAPClient;
use Getopt::Std;
use File::Basename;
getopts('s:u:p:f:dh');
if ($opt_h) {
print STDERR "$0 -- example of how to select shared folder\n",
"\n\nUsage:\n",
"\t-s server -- specify name or ip address of mail server\n",
"\t-u userid -- specify login name of authenticating user\n",
"\t-p passwd -- specify login password of authenticating user\n",
"\t-f folder -- specify shared folder to access (i.e. '-f frank/INBOX')\n",
"\t-h display this help message\n\n";
"\t-d turn on debugging output\n\n";
exit;
}
my $server = $opt_s or die "No server name specified\n";
my $user = $opt_u or die "No user name specified\n";
my $pass = $opt_p or die "No password specified\n";
my $folder = $opt_f or die "No shared folder specified\n";
chomp $pass;
my $imap = Mail::IMAPClient->new(Server=>$server,User=>$user,Password=>$pass,Debug=>$opt_d)
or die "Can't connect to $user\@$server: $@ $!\n";
my($prefix,$prefSep) = @{$imap->namespace->[1][0]}
or die "Can't get shared folder namespace or separator: $@\n";
my $target = $prefix .
( $prefix =~ /\Q$prefSep\E$/ || $opt_f =~ /^\Q$prefSep/ ? "" : $prefSep ) .
$opt_f ;
print "Selecting $target\n";
$imap->select($target)
or die "Cannot select $target: $@\n";
print "Ok: $target has ", $imap->message_count($target)," messages.\n";
$imap->logout;
exit;
=head1 AUTHOR
David J. Kernen
The Kernen Group, Inc.
imap@kernengroup.com
=head1 COPYRIGHT
This example and Mail::IMAPClient are Copyright (c) 2003
by The Kernen Group, Inc. All rights reserved.
This example is distributed with Mail::IMAPClient and
subject to the same licensing requirements as Mail::IMAPClient.
imtest is a utility distributed with Cyrus IMAP server,
Copyright (c) 1994-2000 Carnegie Mellon University.
All rights reserved.
=cut
#
#$Log: sharedFolder.pl,v $
#Revision 19991216.1 2003/06/12 21:38:35 dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
# Makefile.PL Todo sample.perldb
# BodyStructure.pm
# Parse.grammar Parse.pod
# range.t
# Thread.grammar
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
# rfc2221.txt rfc2359.txt rfc2683.txt
#
#

2827
Mail-IMAPClient-3.10/lib/Mail/IMAPClient.pm Normal file
View File

File diff suppressed because it is too large Load Diff

3723
Mail-IMAPClient-3.10/lib/Mail/IMAPClient.pod Normal file
View File

File diff suppressed because it is too large Load Diff

557
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/BodyStructure.pm Executable file
View File

@ -0,0 +1,557 @@
use warnings;
use strict;
package Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient::BodyStructure::Parse;
# my has file scope, not limited to package!
my $parser = Mail::IMAPClient::BodyStructure::Parse->new
or die "Cannot parse rules: $@\n"
. "Try remaking Mail::IMAPClient::BodyStructure::Parse.\n";
sub new
{ my $class = shift;
my $bodystructure = shift;
my $self = $parser->start($bodystructure)
or return undef;
$self->{_prefix} = "";
$self->{_id} = exists $self->{bodystructure} ? 'HEAD' : 1;
$self->{_top} = 1;
bless $self, ref($class)||$class;
}
sub _get_thingy
{ my $thingy = shift;
my $object = shift || (ref $thingy ? $thingy : undef);
unless ($object && ref $object)
{ warn $@ = "No argument passed to $thingy method.";
return undef;
}
unless(UNIVERSAL::isa($object, 'HASH') && exists $object->{$thingy})
{ my $a = $thingy =~ /^[aeiou]/i ? 'an' : 'a';
my $has = ref $object eq 'HASH' ? join(", ",keys %$object) : '';
warn $@ = ref($object)." $object does not have $a $thingy. "
. ($has ? "It has $has" : '');
return undef;
}
my $value = $object->{$thingy};
$value =~ s/\\ ( [\\\(\)"\x0d\x0a] )/$1/gx;
$value =~ s/^"(.*)"$/$1/;
$value;
}
BEGIN
{ no strict 'refs';
foreach my $datum (
qw/ bodytype bodysubtype bodyparms bodydisp bodyid bodydesc bodyenc
bodysize bodylang envelopestruct textlines / )
{ *$datum = sub { _get_thingy($datum, @_) };
}
}
sub parts
{ my $self = shift;
return wantarray ? @{$self->{PartsList}} : $self->{PartsList}
if exists $self->{PartsList};
my @parts;
$self->{PartsList} = \@parts;
unless(exists $self->{bodystructure})
{ $self->{PartsIndex}{1} = $self;
@parts = ("HEAD", 1);
return wantarray ? @parts : \@parts;
}
foreach my $p ($self->bodystructure)
{ my $id = $p->id;
push @parts, $id;
$self->{PartsIndex}{$id} = $p ;
my $type = uc $p->bodytype || '';
push @parts, "$id.HEAD"
if $type eq 'MESSAGE';
}
wantarray ? @parts : \@parts;
}
sub bodystructure
{ my $self = shift;
my $partno = 0;
my @parts;
if($self->{_top})
{ $self->{_id} ||= "HEAD";
$self->{_prefix} ||= "HEAD";
$partno = 0;
foreach my $b ( @{$self->{bodystructure}} )
{ $b->{_id} = ++$partno;
$b->{_prefix} = $partno;
push @parts, $b, $b->bodystructure;
}
return wantarray ? @parts : \@parts;
}
my $prefix = $self->{_prefix} || "";
$prefix =~ s/\.?$/./;
foreach my $p ( @{$self->{bodystructure}} )
{ $partno++;
$p->{_prefix} = "$prefix$partno";
$p->{_id} ||= "$prefix$partno";
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
wantarray ? @parts : \@parts;
}
sub id
{ my $self = shift;
return $self->{_id}
if exists $self->{_id};
return "HEAD"
if $self->{_top};
if ($self->{bodytype} eq 'MULTIPART')
{ my $p = $self->{_id} || $self->{_prefix};
$p =~ s/\.$//;
return $p;
}
else
{ return $self->{_id} ||= 1;
}
}
package Mail::IMAPClient::BodyStructure::Part;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
package Mail::IMAPClient::BodyStructure::Envelope;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
sub new
{ my ($class, $envelope) = @_;
$parser->envelope($envelope);
}
sub from_addresses { shift->_addresses(from => 1) }
sub sender_addresses { shift->_addresses(sender => 1) }
sub replyto_addresses { shift->_addresses(replyto => 1) }
sub to_addresses { shift->_addresses(to => 0) }
sub cc_addresses { shift->_addresses(cc => 0) }
sub bcc_addresses { shift->_addresses(bcc => 0) }
sub _addresses($$$)
{ my ($self, $name, $isSender) = @_;
ref $self->{$name} eq 'ARRAY'
or return ();
my @list;
foreach ( @{$self->{$name}} )
{ my $pn = $_->personalname;
my $name = $pn && $pn ne 'NIL' ? "$pn " : '';
push @list, $pn. '<'.$_->mailboxname .'@'. $_->hostname.'>';
}
wantarray ? @list
: $isSender ? $list[0]
: \@list;
}
BEGIN
{ no strict 'refs';
for my $datum ( qw(subject inreplyto from messageid bcc date
replyto to sender cc))
{ *$datum = sub { @_ > 1 ? $_[0]->{$datum} = $_[1] : $_[0]->{$datum} }
}
}
package Mail::IMAPClient::BodyStructure::Address;
our @ISA = qw/Mail::IMAPClient::BodyStructure/;
for my $datum ( qw(personalname mailboxname hostname sourcename) )
{ no strict 'refs';
*$datum = sub { shift->{$datum}; };
}
1;
__END__
=head1 NAME
Mail::IMAPClient::BodyStructure - parse fetched results
=head1 SYNOPSIS
use Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient;
my $imap = Mail::IMAPClient->new(Server=>$serv,User=>$usr,Password=>$pwd);
$imap->select("INBOX") or die "cannot select the inbox for $usr: $@\n";
my @recent = $imap->search("recent");
foreach my $id (@recent)
{ my $fetched = $imap->fetch($id, "bodystructure");
my $struct = Mail::IMAPClient::BodyStructure->new($fetched);
my $mime = $struct->bodytype."/".$struct->bodysubtype;
my $parts =join "\n\t", $struct->parts;
print "Msg $id (Content-type: $mime) contains these parts:\n\t$parts\n";
}
=head1 DESCRIPTION
This extension will parse the result of an IMAP FETCH BODYSTRUCTURE
command into a perl data structure. It also provides helper methods that
will help you pull information out of the data structure.
Use of this extension requires Parse::RecDescent. If you don't have
Parse::RecDescent then you must either get it or refrain from using
this module.
=head2 EXPORT
Nothing is exported by default. C<$parser> is exported upon
request. C<$parser> is the BodyStucture object's Parse::RecDescent object,
which you'll probably only need for debugging purposes.
=head1 Class Methods
The following class method is available:
=head2 new
This class method is the constructor method for instantiating new
Mail::IMAPClient::BodyStructure objects. The B<new> method accepts one
argument, a string containing a server response to a FETCH BODYSTRUCTURE
directive. Only one message's body structure should be described in this
string, although that message may contain an arbitrary number of parts.
If you know the messages sequence number or unique ID (UID)
but haven't got its body structure, and you want to get the body
structure and parse it into a B<Mail::IMAPClient::BodyStructure>
object, then you might as well save yourself some work and use
B<Mail::IMAPClient>'s B<get_bodystructure> method, which accepts
a message sequence number (or UID if I<Uid> is true) and returns a
B<Mail::IMAPClient::BodyStructure> object. It's functionally equivalent
to issuing the FETCH BODYSTRUCTURE IMAP client command and then passing
the results to B<Mail::IMAPClient::BodyStructure>'s B<new> method but
it does those things in one simple method call.
=head1 Object Methods
The following object methods are available:
=head2 bodytype
The B<bodytype> object method requires no arguments. It returns the
bodytype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysubtype
The B<bodysubtype> object method requires no arguments. It returns the
bodysubtype for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyparms
The B<bodyparms> object method requires no arguments. It returns the
bodyparms for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydisp
The B<bodydisp> object method requires no arguments. It returns the
bodydisp for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyid
The B<bodyid> object method requires no arguments. It returns the
bodyid for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodydesc
The B<bodydesc> object method requires no arguments. It returns the
bodydesc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodyenc
The B<bodyenc> object method requires no arguments. It returns the
bodyenc for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodysize
The B<bodysize> object method requires no arguments. It returns the
bodysize for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodylang
The B<bodylang> object method requires no arguments. It returns the
bodylang for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head2 bodystructure
The B<bodystructure> object method requires no arguments. It returns
the bodystructure for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object.
=head2 envelopestruct
The B<envelopestruct> object method requires no arguments. It returns
the envelopestruct for the message whose structure is described by the
calling B<Mail::IMAPClient::Bodystructure> object. This envelope structure
is blessed into the B<Mail::IMAPClient::BodyStructure::Envelope> subclass,
which is explained more fully below.
=head2 textlines
The B<textlines> object method requires no arguments. It returns the
textlines for the message whose structure is described by the calling
B<Mail::IMAPClient::Bodystructure> object.
=head1 Envelopes and the Mail::IMAPClient::BodyStructure::Envelope Subclass
The IMAP standard specifies that output from the IMAP B<FETCH
ENVELOPE> command will be an RFC2060 envelope structure. It further
specifies that output from the B<FETCH BODYSTRUCTURE> command may also
contain embedded envelope structures (if, for example, a message's
subparts contain one or more included messages). Objects belonging to
B<Mail::IMAPClient::BodyStructure::Envelope> are Perl representations
of these envelope structures, which is to say the nested parenthetical
lists of RFC2060 translated into a Perl datastructure.
Note that all of the fields relate to the specific part to which they
belong. In other words, output from a FETCH nnnn ENVELOPE command (or,
in B<Mail::IMAPClient>, C<$imap->fetch($msgid,"ENVELOPE")> or C<my $env =
$imap->get_envelope($msgid)>) are for the message, but fields from within
a bodystructure relate to the message subpart and not the parent message.
An envelope structure's B<Mail::IMAPClient::BodyStructure::Envelope>
representation is a hash of thingies that looks like this:
{
subject => "subject",
inreplyto => "reference_message_id",
from => [ addressStruct1 ],
messageid => "message_id",
bcc => [ addressStruct1, addressStruct2 ],
date => "Tue, 09 Jul 2002 14:15:53 -0400",
replyto => [ adressStruct1, addressStruct2 ],
to => [ adressStruct1, addressStruct2 ],
sender => [ adressStruct1 ],
cc => [ adressStruct1, addressStruct2 ],
}
The B<...::Envelope> object also has methods for accessing data in the
structure. They are:
=over 4
=item date
Returns the date of the message.
=item inreplyto
Returns the message id of the message to which this message is a reply.
=item subject
Returns the subject of the message.
=item messageid
Returns the message id of the message.
=back
You can also use the following methods to get addressing
information. Each of these methods returns an array of
B<Mail::IMAPClient::BodyStructure::Address> objects, which are perl
data structures representing RFC2060 address structures. Some of these
arrays would naturally contain one element (such as B<from>, which
normally contains a single "From:" address); others will often contain
more than one address. However, because RFC2060 defines all of these as
"lists of address structures", they are all translated into arrays of
B<...::Address> objects.
See the section on B<Mail::IMAPClient::BodyStructure::Address>", below,
for alternate (and preferred) ways of accessing these data.
The methods available are:
=over 4
=item bcc
Returns an array of blind cc'ed recipients' address structures. (Don't
expect much in here unless the message was sent from the mailbox you're
poking around in, by the way.)
=item cc
Returns an array of cc'ed recipients' address structures.
=item from
Returns an array of "From:" address structures--usually just one.
=item replyto
Returns an array of "Reply-to:" address structures. Once again there is
usually just one address in the list.
=item sender
Returns an array of senders' address structures--usually just one and
usually the same as B<from>.
=item to
Returns an array of recipients' address structures.
=back
Each of the methods that returns a list of address structures (i.e. a
list of B<Mail::IMAPClient::BodyStructure::Address> arrays) also has an
analagous method that will return a list of E-Mail addresses instead. The
addresses are in the format C<personalname E<lt>mailboxname@hostnameE<gt>>
(see the section on B<Mail::IMAPClient::BodyStructure::Address>,
below) However, if the personal name is 'NIL' then it is omitted from
the address.
These methods are:
=over 4
=item bcc_addresses
Returns a list (or an array reference if called in scalar context)
of blind cc'ed recipients' email addresses. (Don't expect much in here
unless the message was sent from the mailbox you're poking around in,
by the way.)
=item cc_addresses
Returns a list of cc'ed recipients' email addresses. If called in a scalar
context it returns a reference to an array of email addresses.
=item from_addresses
Returns a list of "From:" email addresses. If called in a scalar context
it returns the first email address in the list. (It's usually a list of just
one anyway.)
=item replyto_addresses
Returns a list of "Reply-to:" email addresses. If called in a scalar context
it returns the first email address in the list.
=item sender_addresses
Returns a list of senders' email addresses. If called in a scalar context
it returns the first email address in the list.
=item to_addresses
Returns a list of recipients' email addresses. If called in a scalar context
it returns a reference to an array of email addresses.
=back
Note that context affects the behavior of all of the above methods.
Those fields that will commonly contain multiple entries (i.e. they are
recipients) will return an array reference when called in scalar context.
You can use this behavior to optimize performance.
Those fields that will commonly contain just one address (the sender's) will
return the first (and usually only) address. You can use this behavior to
optimize your development time.
=head1 Addresses and the Mail::IMAPClient::BodyStructure::Address
Several components of an envelope structure are address
structures. They are each parsed into their own object,
B<Mail::IMAPClient::BodyStructure::Address>, which looks like this:
{ mailboxname => 'somebody.special'
, hostname => 'somplace.weird.com'
, personalname => 'Somebody Special
, sourceroute => 'NIL'
}
RFC2060 specifies that each address component of a bodystructure is a
list of address structures, so B<Mail::IMAPClient::BodyStructure> parses
each of these into an array of B<Mail::IMAPClient::BodyStructure::Address>
objects.
Each of these objects has the following methods available to it:
=over 4
=item mailboxname
Returns the "mailboxname" portion of the address, which is the part to
the left of the '@' sign.
=item hostname
Returns the "hostname" portion of the address, which is the part to the
right of the '@' sign.
=item personalname
Returns the "personalname" portion of the address, which is the part of
the address that's treated like a comment.
=item sourceroute
Returns the "sourceroute" portion of the address, which is typically "NIL".
=back
Taken together, the parts of an address structure form an address that will
look something like this:
C<personalname E<lt>mailboxname@hostnameE<gt>>
Note that because the B<Mail::IMAPClient::BodyStructure::Address>
objects come in arrays, it's generally easier to use the methods
available to B<Mail::IMAPClient::BodyStructure::Envelope> to obtain
all of the addresses in a particular array in one operation. These
methods are provided, however, in case you'd rather do things
the hard way. (And also because the aforementioned methods from
B<Mail::IMAPClient::BodyStructure::Envelope> need them anyway.)
=cut
=head1 AUTHOR
David J. Kernen
Reworked and maintained by Mark Overmeer.
=head1 SEE ALSO
perl(1), Mail::IMAPClient, and RFC2060. See also Parse::RecDescent if you
want to understand the internals of this module.
=cut

188
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Executable file
View File

@ -0,0 +1,188 @@
# 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
bodyloc: NIL | STRING
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> bodysubtype
bodyparms(?) bodydisp(?) bodylang(?) bodyloc(?) bodyextra(?)
<defer: $subpartCount = 0>
{ $return =
{ bodysubtype => $item{bodysubtype}
, bodytype => 'MULTIPART'
, bodystructure => $item{'subpart(s)'}
};
take_optional_items($return, \%item
, qw/bodyparms bodydisp bodylang bodyloc 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} }

16425
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/BodyStructure/Parse.pm Normal file
View File

File diff suppressed because it is too large Load Diff

15
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/BodyStructure/Parse.pod Executable file
View File

@ -0,0 +1,15 @@
=head1 NAME
Mail::IMAPClient::BodyStructure::Parse - used internally by Mail::IMAPClient::BodyStructure
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is generated using L<Parse::RecDescent>. It is not meant to be used
directly by other scripts nor is there much point in debugging it.
=head1 SYNOPSIS
This module is used internally by L<Mail::IMAPClient::BodyStructure>
and is not meant to be used or called directly from applications. So
don't do that.

280
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/MessageSet.pm Normal file
View File

@ -0,0 +1,280 @@
use warnings;
use strict;
package Mail::IMAPClient::MessageSet;
=head1 NAME
Mail::IMAPClient::MessageSet - ranges of message sequence nummers
=cut
use overload
'""' => "str"
, '.=' => sub {$_[0]->cat($_[1])}
, '+=' => sub {$_[0]->cat($_[1])}
, '-=' => sub {$_[0]->rem($_[1])}
, '@{}' => "unfold"
, fallback => 1;
sub new
{ my $class = shift;
my $range = $class->range(@_);
bless \$range, $class;
}
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;
}
sub rem
{ my $self = shift;
my %delete = map { ($_ => 1) } map { _unfold_range $_ } @_;
$$self = $self->range(grep {not $delete{$_}} $self->unfold);
$self;
}
sub cat
{ my $self = shift;
$$self = $self->range($$self, @_);
$self;
}
sub range
{ my $self = shift;
my @msgs;
foreach my $m (@_)
{ defined $m && length $m
or next;
foreach my $mm (ref $m eq 'ARRAY' ? @$m : $m)
{ push @msgs, _unfold_range $mm;
}
}
@msgs
or return undef;
@msgs = sort {$a <=> $b} @msgs;
my $low = my $high = shift @msgs;
my @ranges;
foreach my $m (@msgs)
{ next if $m == $high; # double
if($m == $high + 1) { $high = $m }
else
{ push @ranges, $low == $high ? $low : "$low:$high";
$low = $high = $m;
}
}
push @ranges, $low == $high ? $low : "$low:$high" ;
join ",", @ranges;
}
sub unfold
{ my $self = shift;
wantarray ? ( _unfold_range $$self ) : [ _unfold_range $$self ];
}
=head1 SYNOPSIS
my @msgs = $imap->search("SUBJECT","Virus"); # returns 1,3,4,5,6,9,10
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
print $msgset; # prints "1,3:6,9:10"
# add message 14 to the set:
$msgset += 14;
print $msgset; # prints "1,3:6,9:10,14"
# add messages 16,17,18,19, and 20 to the set:
$msgset .= "16,17,18:20";
print $msgset; # prints "1,3:6,9:10,14,16:20"
# Hey, I didn't really want message 17 in there; let's take it out:
$msgset -= 17;
print $msgset; # prints "1,3:6,9:10,14,16,18:20"
# Now let's iterate over each message:
for my $msg (@$msgset)
{ print "$msg\n"; # Prints: "1\n3\n4\n5\n6..16\n18\n19\n20\n"
}
print join("\n", @$msgset)."\n"; # same simpler
local $" = "\n"; print "@$msgset\n"; # even more simple
=head1 DESCRIPTION
The B<Mail::IMAPClient::MessageSet> module is designed to make life easier
for programmers who need to manipulate potentially large sets of IMAP
message UID's or sequence numbers.
This module presents an object-oriented interface into handling your
message sets. The object reference returned by the L<new> method is an
overloaded reference to a scalar variable that contains the message set's
compact RFC2060 representation. The object is overloaded so that using
it like a string returns this compact message set representation. You
can also add messages to the set (using either a '.=' operator or a '+='
operator) or remove messages (with the '-=' operator). And if you use
it as an array reference, it will humor you and act like one by calling
L<unfold> for you.
RFC2060 specifies that multiple messages can be provided to certain IMAP
commands by separating them with commas. For example, "1,2,3,4,5" would
specify messages 1, 2, 3, 4, and (you guessed it!) 5. However, if you are
performing an operation on lots of messages, this string can get quite long.
So long that it may slow down your transaction, and perhaps even cause the
server to reject it. So RFC2060 also permits you to specifiy a range of
messages, so that messages 1, 2, 3, 4 and 5 can also be specified as
"1:5".
This is where B<Mail::IMAPClient::MessageSet> comes in. It will convert
your message set into the shortest correct syntax. This could potentially
save you tons of network I/O, as in the case where you want to fetch the
flags for all messages in a 10000 message folder, where the messages
are all numbered sequentially. Delimited as commas, and making the
best-case assumption that the first message is message "1", it would take
48893 bytes to specify the whole message set using the comma-delimited
method. To specify it as a range, it takes just seven bytes (1:10000).
Note that the L<Mail::IMAPClient> B<Range> method can be used as
a short-cut to specifying C<Mail::IMAPClient::MessageSet-E<gt>new(@etc)>.)
=head1 CLASS METHODS
The only class method you need to worry about is B<new>. And if you create
your B<Mail::IMAPClient::MessageSet> objects via L<Mail::IMAPClient>'s
B<Range> method then you don't even need to worry about B<new>.
=head2 new
Example:
my $msgset = Mail::IMAPClient::MessageSet->new(@msgs);
The B<new> method requires at least one argument. That argument can be
either a message, a comma-separated list of messages, a colon-separated
range of messages, or a combination of comma-separated messages and
colon-separated ranges. It can also be a reference to an array of messages,
comma-separated message lists, and colon separated ranges.
If more then one argument is supplied to B<new>, then those arguments should
be more message numbers, lists, and ranges (or references to arrays of them)
just as in the first argument.
The message numbers passed to B<new> can really be any kind of number at
all but to be useful in a L<Mail::IMAPClient> session they should be either
message UID's (if your I<Uid> parameter is true) or message sequence numbers.
The B<new> method will return a reference to a B<Mail::IMAPClient::MessageSet>
object. That object, when double quoted, will act just like a string whose
value is the message set expressed in the shortest possible way, with the
message numbers sorted in ascending order and with duplicates removed.
=head1 OBJECT METHODS
The only object method currently available to a B<Mail::IMAPClient::MessageSet>
object is the L<unfold> method.
=head2 unfold
Example:
my $msgset = $imap->Range( $imap->messages ) ;
my @all_messages = $msgset->unfold;
The B<unfold> method returns an array of messages that belong to the
message set. If called in a scalar context it returns a reference to the
array instead.
=head1 OVERRIDDEN OPERATIONS
B<Mail::IMAPClient::MessageSet> overrides a number of operators in order
to make manipulating your message sets easier. The overridden operations are:
=head2 stringify
Attempts to stringify a B<Mail::IMAPClient::MessageSet> object will result in
the compact message specification being returned, which is almost certainly
what you will want.
=head2 Auto-increment
Attempts to autoincrement a B<Mail::IMAPClient::MessageSet> object will
result in a message (or messages) being added to the object's message set.
Example:
$msgset += 34;
# Message #34 is now in the message set
=head2 Concatenate
Attempts to concatenate to a B<Mail::IMAPClient::MessageSet> object will
result in a message (or messages) being added to the object's message set.
Example:
$msgset .= "34,35,36,40:45";
# Messages 34,35,36,40,41,42,43,44,and 45 are now in the message set
The C<.=> operator and the C<+=> operator can be used interchangeably, but
as you can see by looking at the examples there are times when use of one
has an aesthetic advantage over use of the other.
=head2 Autodecrement
Attempts to autodecrement a B<Mail::IMAPClient::MessageSet> object will
result in a message being removed from the object's message set.
Examples:
$msgset -= 34;
# Message #34 is no longer in the message set
$msgset -= "1:10";
# Messages 1 through 10 are no longer in the message set
If you attempt to remove a message that was not in the original message set
then your resulting message set will be the same as the original, only more
expensive. However, if you attempt to remove several messages from the message
set and some of those messages were in the message set and some were not,
the additional overhead of checking for the messages that were not there
is negligable. In either case you get back the message set you want regardless
of whether it was already like that or not.
=head1 AUTHOR
David J. Kernen
The Kernen Consulting Group, Inc
=head1 COPYRIGHT
Copyright 1999, 2000, 2001, 2002 The Kernen Group, Inc.
All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the terms of either:
=over 4
=item a) the "Artistic License" which comes with this Kit, or
=item b) the GNU General Public License as published by the Free Software
Foundation; either version 1, or (at your option) any later version.
=back
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the GNU
General Public License or the Artistic License for more details. All your
base are belong to us.
=cut
1;

18
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/Thread.grammar Normal file
View File

@ -0,0 +1,18 @@
# Atoms:
NUMBER: /\d+/
# Rules:
threadmember: NUMBER { $return = $item{NUMBER} ; } |
thread { $return = $item{thread} ; }
thread: "(" threadmember(s) ")"
{
$return = $item{'threadmember(s)'}||undef;
}
# Start:
start: /^\* THREAD /i thread(s?) {
$return=$item{'thread(s?)'}||undef;
}

1014
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/Thread.pm Normal file
View File

File diff suppressed because it is too large Load Diff

14
Mail-IMAPClient-3.10/lib/Mail/IMAPClient/Thread.pod Executable file
View File

@ -0,0 +1,14 @@
=head1 NAME
Mail::IMAPClient::Thread - used internally by Mail::IMAPClient->thread
=head1 DESCRIPTION
This module is used internally by L<Mail::IMAPClient> and is
generated using L<Parse::RecDescent>. It is not meant to be used directly by
other scripts nor is there much point in debugging it.
=head1 SYNOPSIS
This module is used internally by L<Mail::IMAPClient> and is not meant to
be used or called directly from applications. So don't do that.

37
Mail-IMAPClient-3.10/prepare_dist Executable file
View File

@ -0,0 +1,37 @@
#!/usr/bin/perl
use warnings;
use strict;
use Parse::RecDescent 1.94;
use File::Slurp qw/read_file/;
use File::Copy qw/move/;
sub build_parser($$);
build_parser 'lib/Mail/IMAPClient/BodyStructure/Parse.grammar'
, 'Mail::IMAPClient::BodyStructure::Parse';
build_parser 'lib/Mail/IMAPClient/Thread.grammar'
, 'Mail::IMAPClient::Thread';
sub build_parser($$)
{ my ($grammarfn, $package) = @_;
print "* building $package\n";
my $grammar = read_file $grammarfn
or die "cannot read grammar from $grammarfn: $!\n";
Parse::RecDescent->Precompile($grammar, $package);
# clumpsy output by Parse::RecDescent
my $outfn = $package . '.pm';
$outfn =~ s/.*\:\://;
my $realfn = $grammarfn;
$realfn =~ s/\.\w+$/.pm/;
move $outfn, $realfn
or die "cannot move $outfn to $realfn: $!\n";
}

1
Mail-IMAPClient-3.10/sample.perldb Executable file
View File

@ -0,0 +1 @@
&parse_options("NonStop=1 LineInfo=mail_imapclient_db.out");

303
Mail-IMAPClient-3.10/t/basic.t Executable file
View File

@ -0,0 +1,303 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
use File::Temp 'tempfile';
my $debug = $ARGV[0];
my %parms;
my $range = 0;
my $uidplus = 0;
my $fast = 1;
BEGIN
{ open TST, 'test.txt'
or plan skip_all => 'test parameters not provided';
while(my $l = <TST>)
{ chomp $l;
my($p,$v) = split /\=/, $l, 2;
s/^\s+//, s/\s+$// for $p, $v;
$parms{$p} = $v if $v;
}
close TST;
foreach my $p ( qw/server user passed/ )
{ $parms{$p}
or plan skip_all => "missing value for $p"
}
plan tests => 49;
}
use_ok('Mail::IMAPClient');
my $imap = Mail::IMAPClient->new
( Server => $parms{server}
, Port => $parms{port}
, User => $parms{user}
, Password => $parms{passed}
, Authmechanism => $parms{authmech}
, Clear => 0
, Fast_IO => $fast
, Uid => $uidplus
, Range => $range
, Debug => $debug
, Debug_fh => ($debug ? IO::File->new('imap1.debug', 'w') : undef)
);
ok(defined $imap, 'created client');
$imap or die "Cannot log into $parms{server} as $parms{user}.\n"
. "Are server/user/password correct?\n" ;
isa_ok($imap, 'Mail::IMAPClient');
$imap->Debug_fh->autoflush() if $imap->Debug_fh ;
my $testmsg = <<__TEST_MSG;
Date: @{[$imap->Rfc822_date(time)]}
To: <$parms{user}\@$parms{server}>
From: Perl <$parms{user}\@$parms{server}>
Subject: Testing from pid $$
This is a test message generated by $0 during a 'make test' as part of
the installation of that nifty Mail::IMAPClient module from CPAN. Like
all things perl, it's way cool.
__TEST_MSG
my $sep = $imap->separator;
ok(defined $sep, "separator is '$sep'");
my $isparent = $imap->is_parent('INBOX');
my ($target, $target2) = $isparent
? ("INBOX${sep}IMAPClient_$$", "INBOX${sep}IMAPClient_2_$$")
: ("IMAPClient_$$", "IMAPClient_2_$$");
ok(1, "parent $isparent, target $target");
ok($imap->select('inbox'), "select inbox");
ok($imap->create($target), "create target");
if(!$imap->is_parent($target))
{ ok(1, "not parent, skipping quote test 1/3");
ok(1, "not parent, skipping quote test 2/3");
ok(1, "not parent, skipping quote test 3/3");
}
elsif( eval {$imap->create( qq[ $target${sep}has "quotes" ] )} )
{ ok(1, "supports quotes, create");
ok($imap->select( qq[$target${sep}has "quotes"] ), 'select');
$imap->close;
$imap->select('inbox');
ok($imap->delete(qq($target${sep}has "quotes")), 'delete');
}
else
{ if($imap->LastError =~ /NO Invalid.*name/)
{ ok(1, "$parms{server} doesn't support quotes in folder names") }
else { ok(0, "failed creation with quotes") }
ok(1, "skipping 1/2 tests");
ok(1, "skipping 2/2 tests");
}
ok($imap->exists($target), "exists $target");
ok($imap->create($target2), "create $target2");
ok($imap->exists($target2), "exists $target2");
my $uid = $imap->append($target, $testmsg);
ok(defined $uid, "append test message to $target");
ok($imap->select($target), "select $target");
my $msg = ref $uid ? ($imap->search("ALL"))[0] : $uid;
my $size = $imap->size($msg);
cmp_ok($size, '>', 0, "has size $size");
my $string = $imap->message_string($msg);
ok(defined $string, "returned string");
cmp_ok(length($string), '==', $size, "string has size");
{ my ($fh, $fn) = tempfile UNLINK => 1;
ok($imap->message_to_file($fn, $msg), "to file $fn");
cmp_ok(-s $fn, '==', $size, "correct size");
}
my $fields = $imap->search("HEADER", "Message-id", "NOT_A_MESSAGE_ID");
ok(!defined $fields, 'message id does not exist');
my @seen = $imap->seen;
cmp_ok(scalar @seen, '==', 1, 'have seen 1');
ok($imap->deny_seeing(\@seen), 'deny seeing');
my @unseen = $imap->unseen;
cmp_ok(scalar @unseen, '==', 1, 'have unseen 1');
ok($imap->see(\@seen), "let's see one");
cmp_ok(scalar @seen, '==', 1, 'have seen 1');
$imap->deny_seeing(@seen); # reset
$imap->Peek(1);
my $subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==1');
$imap->deny_seeing(@seen);
$imap->Peek(0);
$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
like(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==0');
$imap->deny_seeing(@seen);
$imap->Peek(undef);
$subject = $imap->parse_headers($seen[0],"Subject")->{Subject}[0];
unlike(join("",$imap->flags($seen[0])), qr/\\Seen/i, 'Peek==undef');
my $uid2 = $imap->copy($target2, 1);
ok($uid2, "copy $target2");
my @res = $imap->fetch(1,"RFC822.TEXT");
ok(scalar @res, "fetch rfc822");
my $h = $imap->parse_headers(1, "Subject");
ok($h, "got subject");
like($h->{Subject}[0], qr/^Testing from pid/);
ok($imap->select($target), "select $target");
my @hits = $imap->search(SUBJECT => 'Testing');
cmp_ok(scalar @hits, '==', 1, 'hit subject Testing');
ok(defined $hits[0]);
ok($imap->delete_message(@hits), 'delete hits');
my $flaghash = $imap->flags(\@hits);
my $flagflag = 0;
foreach my $v (values %$flaghash)
{ $flagflag += grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', scalar @hits);
my @nohits = $imap->search(qq(SUBJECT "Productioning"));
cmp_ok(scalar @nohits, '==', 0, 'no hits expected');
ok($imap->restore_message(@hits), 'restore messages');
$flaghash = $imap->flags(\@hits);
foreach my $v (values %$flaghash)
{ $flagflag-- unless grep /\\Deleted/, @$v;
}
cmp_ok($flagflag, '==', 0);
$imap->select($target2);
ok( $imap->delete_message(scalar($imap->search("ALL")))
&& $imap->close
&& $imap->delete($target2) , "delete $target2");
$imap->select("INBOX");
$@ = "";
@hits = $imap->search
(BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED");
ok(!$@, "search undeleted: $@");
#
# Test migrate method
#
my $im2 = Mail::IMAPClient->new
( Server => $parms{server}
, Port => $parms{port}
, User => $parms{user}
, Password=> $parms{passed}
, Authmechanism => $parms{authmechanism}
, Clear => 0,
, Timeout => 30,
, Debug => $debug
, Debug_fh => ($debug ? IO::File->new(">./imap2.debug") : undef)
, Fast_IO => $fast
, Uid => $uidplus
);
ok(defined $im2, 'started second imap client');
my $source = $target;
$imap->select($source)
or die "cannot select source $source: $@";
$imap->append($source, $testmsg) for 1..5;
$imap->close;
$imap->select($source);
my $migtarget = $target. '_mirror';
$im2->create($migtarget)
or die "can't create $migtarget: $@" ;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
$imap->migrate($im2,scalar($imap->search("ALL")),$migtarget)
or die "couldn't migrate: $@";
$im2->close;
$im2->select($migtarget)
or die "can't select $migtarget: $@";
cmp_ok($@, 'eq', '');
#
#
#
my $total_bytes1 = 0;
for ($imap->search("ALL"))
{ my $s = $imap->size($_);
$total_bytes1 += $s;
print "Size of msg $_ is $s\n" if $debug
};
my $total_bytes2 = 0;
for ($im2->search("ALL"))
{ my $s = $im2->size($_);
$total_bytes2 += $s; print "Size of msg $_ is $s\n" if $debug
}
cmp_ok($@, 'eq', '');
cmp_ok($total_bytes1, '==', $total_bytes2, 'size source==target');
# cleanup
$im2->select($migtarget);
$im2->delete_message(@{$im2->messages})
if $im2->message_count;
$im2->close;
$im2->delete($migtarget);
$im2->logout;
#
# Test IDLE
#
if($imap->has_capability("IDLE") )
{ eval { my $idle = $imap->idle; sleep 1; $imap->done($idle) };
cmp_ok($@, 'eq', '');
}
else
{ ok(1, "idle not supported");
}
$imap->select('inbox');
if( $imap->rename($target,"${target}NEW") )
{ ok(1, 'rename');
$imap->close;
$imap->select("${target}NEW") ;
$imap->delete_message(@{$imap->messages}) if $imap->message_count;
$imap->close;
$imap->delete("${target}NEW") ;
}
else
{ ok(0, 'rename failed');
$imap->delete_message(@{$imap->messages})
if $imap->message_count;
$imap->close;
$imap->delete($target) ;
}

53
Mail-IMAPClient-3.10/t/bodystructure.t Executable file
View File

@ -0,0 +1,53 @@
#!/usr/bin/perl
use warnings;
use strict;
use lib 'lib';
use Test::More tests => 10;
use Data::Dumper;
$Data::Dumper::Indent=1;
use_ok('Mail::IMAPClient::BodyStructure');
my $bs = <<'END_OF_BS';
(BODYSTRUCTURE ("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 511 20 NIL NIL NIL))^M
END_OF_BS
my $bsobj = Mail::IMAPClient::BodyStructure->new($bs);
ok(defined $bsobj, 'parsed first');
is($bsobj->bodytype, 'TEXT', 'bodytype');
is($bsobj->bodysubtype, 'PLAIN', 'bodysubtype');
my $bs2 = <<'END_OF_BS2';
(BODYSTRUCTURE (("TEXT" "PLAIN" ("CHARSET" 'us-ascii') NIL NIL "7BIT" 2 1 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 3930 ("Tue, 16 Jul 2002 15:29:17 -0400" "Re: [Fwd: Here is the the list of uids]" (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("David J Kavid" NIL "david.kavid" "generic.com")) NIL NIL "<72f9a217.a21772f9@generic.com>") (("TEXT" "PLAIN" ("CHARSET" "us-ascii") NIL NIL "7BIT" 369 11 NIL NIL NIL)("MESSAGE" "RFC822" NIL NIL NIL "7BIT" 2599 ("Tue, 9 Jul 2002 13:42:04 -0400" "Here is the the list of uids" (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Nicholas Kringle" NIL "nicholas.kringle" "generic.com")) (("Michael Etcetera" NIL "michael.etcetera" "generic.com")) (("Richard W Continued" NIL "richard.continued" "generic.com")) NIL NIL "<015401c2276f$f09b7c10$59cab08c@one.two.generic.com>") ((("TEXT" "PLAIN" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 256 10 NIL NIL NIL)("TEXT" "HTML" ("CHARSET" "iso-8859-1") NIL NIL "QUOTED-PRINTABLE" 791 22 NIL NIL NIL) "ALTERNATIVE" ("BOUNDARY" "----=_NextPart_001_0151_01C2274E.6969D0F0") NIL NIL) "MIXED" ("BOUNDARY" "----=_NextPart_000_0150_01C2274E.6969D0F0") NIL NIL) 75 NIL NIL NIL) "MIXED" ("BOUNDARY" "--1f34eac2082b02") NIL ("EN")) 118 NIL NIL NIL) "MIXED" ("BOUNDARY" "------------F600BD8FDDD648ABA72A09E0") NIL NIL))
END_OF_BS2
$bsobj = Mail::IMAPClient::BodyStructure->new($bs2) ;
ok(defined $bsobj, 'parsed second');
is($bsobj->bodytype, 'MULTIPART', 'bodytype');
is($bsobj->bodysubtype, 'MIXED', 'bodysubtype');
is(join("#",$bsobj->parts),
# Better parsing in version 3.03, changed this outcome
# "1#2#2.HEAD#2.1#2.2#2.2.HEAD#2.2.1#2.2.1.1#2.2.1.2"
"1#2#2.HEAD#2.1#2.1.1#2.1.2#2.1.2.HEAD#2.1.2.1#2.1.2.1.1#2.1.2.1.1.1#2.1.2.1.1.2"
, 'parts');
my $bs3 = <<'END_OF_BS3';
FETCH (UID 1 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "ISO-8859-1")
NIL NIL "quoted-printable" 1744 0)("TEXT" "HTML" ("charset"
"ISO-8859-1") NIL NIL "quoted-printable" 1967 0) "ALTERNATIVE"))
END_OF_BS3
$bsobj = Mail::IMAPClient::BodyStructure->new($bs3) ;
ok(defined $bsobj, 'parsed third');
my $bs4 = <<'END_OF_BS4';
* 9 FETCH (UID 9 BODYSTRUCTURE (("TEXT" "PLAIN" ("charset" "us-ascii") NIL "Notification" "7BIT" 588 0)("MESSAGE" "DELIVERY-STATUS" NIL NIL "Delivery report" "7BIT" 459)("MESSAGE" "RFC822" NIL NIL "Undelivered Message" "8bit" 10286 ("Thu, 31 May 2007 11:25:56 +0200 (CEST)" "*****SPAM***** RE: Daily News" (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) (("admin@activtrades.com" NIL "polettld" "ensma.fr")) ((NIL NIL "polettld" "ensma.fr")) NIL NIL "NIL" "<20070531133257.92825.qmail@cc299962-a.haaks1.ov.home.nl>") (("TEXT" "PLAIN" ("charset" "iso-8859-1") NIL NIL "7bit" 1510 0)("MESSAGE" "RFC822" ("name" "message" "x-spam-type" "original") NIL "Original message" "8bit" 5718) "MIXED")) "REPORT"))
END_OF_BS4
$bsobj = Mail::IMAPClient::BodyStructure->new($bs4);
ok(defined $bsobj, 'parsed fourth');

32
Mail-IMAPClient-3.10/t/messageset.t Executable file
View File

@ -0,0 +1,32 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 7;
use_ok('Mail::IMAPClient::MessageSet');
my $one = q/1:4,3:6,10:15,20:25,2:8/;
my $range = Mail::IMAPClient::MessageSet->new($one);
is($range, "1:8,10:15,20:25", 'range simplify');
is( join(",",$range->unfold)
, "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25"
, 'range unfold');
$range .= "30,31,32,31:34,40:44";
is($range, "1:8,10:15,20:25,30:34,40:44", 'overload concat');
is( join(",",$range->unfold)
, "1,2,3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44"
, 'unfold extended');
$range -= "1:2";
is($range, "3:8,10:15,20:25,30:34,40:44", 'overload subtract');
is( join(",",$range->unfold)
, "3,4,5,6,7,8,10,11,12,13,14,15,20,21,22,23,24,25,"
. "30,31,32,33,34,40,41,42,43,44"
, 'subtract unfold');

9
Mail-IMAPClient-3.10/t/pod.t Executable file
View File

@ -0,0 +1,9 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok();

31
Mail-IMAPClient-3.10/t/thread.t Executable file
View File

@ -0,0 +1,31 @@
#!/usr/bin/perl
use warnings;
use strict;
use Test::More tests => 7;
use_ok('Mail::IMAPClient::Thread');
my $t1 = <<'e1';
* THREAD (166)(167)(168)(169)(172)(170)(171)(173)(174 175 176 178 181 180)(179)(177 183 182 188 184 185 186 187 189)(190)(191)(192)(193)(194 195)(196 197 198)(199)(200 202)(201)(203)(204)(205)(206 207)(208)
e1
my $t2 = <<'e2';
* THREAD (166)(167)(168)(169)(172)((170)(179))(171)(173)((174)(175)(176)(178)(181)(180))((177)(183)(182)(188 (184)(189))(185 186)(187))(190)(191)(192)(193)((194)(195 196))(197 198)(199)(200 202)(201)(203)(204)(205 206 207)(208)
e2
my $parser = Mail::IMAPClient::Thread->new;
ok(defined $parser, 'created parser');
isa_ok($parser, 'Parse::RecDescent'); # !!!
my $thr1 = $parser->start($t1) ;
ok(defined $thr1, 'thread1 start');
cmp_ok(scalar(@$thr1), '==', 25);
my $thr2 = $parser->start($t2);
ok(defined $thr2, 'thread2 start');
cmp_ok(scalar(@$thr2), '==', 23);

5
Mail-IMAPClient-3.10/test_template.txt Executable file
View File

@ -0,0 +1,5 @@
server=imap.server.hostname
user=username
passed=password
port=143
authmechanism=LOGIN

4
README
View File

@ -3,7 +3,7 @@ NAME
Synchronise mailboxes between two imap servers. Good at IMAP migration.
More than 32 different IMAP server softwares supported with success.
$Revision: 1.264 $
$Revision: 1.267 $
INSTALL
imapsync works fine under any Unix OS with perl.
@ -364,5 +364,5 @@ SIMILAR SOFTWARES
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.264 2008/08/27 15:19:05 gilles Exp gilles $
$Id: imapsync,v 1.267 2008/10/07 11:36:02 gilles Exp $

14
TODO
View File

@ -1,6 +1,17 @@
TODO file for imapsync
----------------------
Add failure return code in case of
last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
See Phil Lobbes messages (18 Sep 2008)
Subject: BUG: imapsync may silently disconnect leading to unmigrated data without warnings
Remove --password secret in outpout.
Post on imapsync mailing-list when a new release comes.
Fix bad english language.
Write to zimbra coders about the date presentation:
@ -127,7 +138,8 @@ Explain expunge behavior.
DONE. Add a better test to check non existing folders on destination
server. (status and select are bad).
DONE. Fix the buggy --include behavior with no --folder --folderrec or --subscribed.

2
VERSION
View File

@ -1 +1 @@
1.264
1.267

55
imapsync
View File

@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
at IMAP migration. More than 32 different IMAP server softwares
supported with success.
$Revision: 1.264 $
$Revision: 1.267 $
=head1 INSTALL
@ -422,7 +422,7 @@ Entries for imapsync:
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.264 2008/08/27 15:19:05 gilles Exp gilles $
$Id: imapsync,v 1.267 2008/10/07 11:36:02 gilles Exp $
@ -484,19 +484,18 @@ my(
$authmech1, $authmech2,
$split1, $split2,
$tests, $test_builder,
$allow3xx,
);
use vars qw ($opt_G); # missing code for this will be option.
$rcs = '$Id: imapsync,v 1.264 2008/08/27 15:19:05 gilles Exp gilles $ ';
$rcs = '$Id: imapsync,v 1.267 2008/10/07 11:36:02 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. See file BUG_IMAPClient_3.xx\n";
$mess_size_total_trans = 0;
@ -515,7 +514,19 @@ sub check_lib_version {
# 3.x.x is still buggy with imapsync.
# uncomment "return 1" if you want to check it.
#return 1;
return 0;
#return 0;
if ($allow3xx) {
*Mail::IMAPClient::Ssl = sub {
my $self = shift;
if (@_) { $self->{SSL} = shift }
return $self->{SSL};
};
return(1);
}else{
return(0);
}
}
}
@ -540,8 +551,8 @@ Date::Manip $Date::Manip::VERSION
my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.264 $ ',
'$Date: 2008/08/27 15:19:05 $ ',
'$Revision: 1.267 $ ',
'$Date: 2008/10/07 11:36:02 $ ',
"\n",localhost_info(),
" and the module Mail::IMAPClient version used here is ",
$VERSION_IMAPClient,"\n",
@ -555,6 +566,11 @@ unless(defined(&_SYSEXITS_H)) {
}
get_options();
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. See file BUG_IMAPClient_3.xx\n";
print $banner;
sub missing_option {
@ -580,7 +596,7 @@ sub connect_imap {
$imap->Server($host);
$imap->Port($port);
$imap->Debug($debugimap);
$imap->Ssl($ssl);
$imap->Ssl($ssl) if ($ssl);
$imap->connect()
or die "Can not open imap connection on [$host] : $@\n";
}
@ -735,7 +751,7 @@ sub login_imap {
$imap = Mail::IMAPClient->new();
$imap->Ssl($ssl);
$imap->Ssl($ssl) if ($ssl);
$imap->Clear(20);
$imap->Server($host);
$imap->Port($port);
@ -821,7 +837,7 @@ $split2 and $to->Split($split2);
# Folder stuff
#
my (@f_folders, %requested_folder, @t_folders, %subscribed_folder, %t_folders);
my (@f_folders, %requested_folder, @t_folders, @t_folders_list, %t_folders_list, %subscribed_folder, %t_folders);
sub tests_folder_routines {
ok( !give_requested_folders() ,"no requested folders" );
@ -1014,7 +1030,8 @@ sub tests_compare_lists {
}
@t_folders = sort @{$to->folders()};
my($f_sep,$t_sep);
# what are the private folders separators for each server ?
@ -1174,11 +1191,15 @@ exit if ($justfoldersizes);
my $tohasuidplus = $to->has_capability("UIDPLUS");
@t_folders_list = sort @{$to->folders()};
foreach my $folder (@t_folders_list) {
$t_folders_list{$folder}++;
}
print
"++++ Listing folders ++++\n",
"From folders list : ", map("[$_] ",@f_folders),"\n",
"To folders list : ", map("[$_] ",@t_folders),"\n";
"To folders list : ", map("[$_] ",@t_folders_list),"\n";
print
"From subscribed folders list : ",
@ -1269,8 +1290,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
#$error++;
next FOLDER;
}
unless ($to->exists($t_fold) or $to->select($t_fold)) {
if ( ! exists($t_folders_list{$t_fold})) {
print "To Folder $t_fold does not exist\n";
print "Creating folder [$t_fold]\n";
unless ($dry){
@ -1740,6 +1760,7 @@ sub get_options
"split1=i" => \$split1,
"split2=i" => \$split2,
"tests" => \$tests,
"allow3xx!" => \$allow3xx,
);
$debug and print "get options: [$opt_ret]\n";
@ -2575,9 +2596,9 @@ use constant NonFolderArg => 1; # Value to pass to Massage to
# No bug, somme servers are buggy.
if ( length($string) != $expected_size ) {
carp "message_string: " .
warn "message_string: " .
"expected $expected_size bytes but received " .
length($string);
length($string) . "\n";
$self->LastError("message_string: expected ".
"$expected_size bytes but received " .
length($string)."\n");

202
tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/sh
# $Id: tests.sh,v 1.79 2008/08/27 15:18:12 gilles Exp gilles $
# $Id: tests.sh,v 1.82 2008/10/07 17:39:42 gilles Exp gilles $
#### Shell pragmas
@ -112,7 +112,8 @@ first_sync() {
--passfile1 /var/tmp/secret1 \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--noauthmd5
--noauthmd5 \
--allow3xx
}
@ -124,7 +125,8 @@ 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 \
--allow3xx
else
:
fi
@ -138,7 +140,8 @@ ll_timeout() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX --timeout 1
--folder INBOX --timeout 1 \
--allow3xx
else
:
fi
@ -152,7 +155,8 @@ ll_timeout_ssl() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX --timeout 5 --ssl1 --ssl2
--folder INBOX --timeout 5 --ssl1 --ssl2 \
--allow3xx
else
:
fi
@ -169,7 +173,8 @@ ll_folder() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.yop --folder INBOX.Trash
--folder INBOX.yop --folder INBOX.Trash \
--allow3xx
else
:
fi
@ -183,7 +188,8 @@ ll_oneemail() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.oneemail
--folder INBOX.oneemail \
--allow3xx
else
:
fi
@ -199,7 +205,8 @@ ll_folderrec() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folderrec INBOX.yop
--folderrec INBOX.yop \
--allow3xx
else
:
fi
@ -215,14 +222,14 @@ ll_buffersize() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--buffersize 8
--buffersize 8 \
--allow3xx
else
:
fi
}
ll_justfolders() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
@ -231,7 +238,9 @@ ll_justfolders() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfolders
--justfolders \
--allow3xx
echo "rm -rf /home/vmail/titi/.new_folder/"
else
:
fi
@ -248,7 +257,8 @@ ll_prefix12() {
--passfile2 /var/tmp/secret.titi \
--folder INBOX.qqq \
--prefix1 INBOX.\
--prefix2 INBOX.
--prefix2 INBOX. \
--allow3xx
else
:
fi
@ -266,7 +276,8 @@ ll_internaldate() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX \
--syncinternaldates
--syncinternaldates \
--allow3xx
else
:
fi
@ -283,7 +294,8 @@ ll_idatefromheader() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.oneemail \
--idatefromheader --debug --dry
--idatefromheader --debug --dry \
--allow3xx
else
:
fi
@ -299,7 +311,8 @@ ll_folder_rev() {
--passfile1 /var/tmp/secret.titi \
--host2 localhost --user2 tata@est.belle \
--passfile2 /var/tmp/secret.tata \
--folder INBOX.yop
--folder INBOX.yop \
--allow3xx
else
:
fi
@ -314,7 +327,8 @@ ll_subscribed()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--subscribed
--subscribed \
--allow3xx
else
:
fi
@ -330,7 +344,8 @@ ll_subscribe()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--subscribed --subscribe
--subscribed --subscribe \
--allow3xx
else
:
fi
@ -343,7 +358,8 @@ ll_justconnect()
$CMD_PERL ./imapsync \
--host2 localhost \
--host1 localhost \
--justconnect
--justconnect \
--allow3xx
else
:
fi
@ -358,7 +374,8 @@ ll_justfoldersizes()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes
--justfoldersizes \
--allow3xx
else
:
fi
@ -375,7 +392,8 @@ ll_authmd5()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --authmd5
--justfoldersizes --authmd5 \
--allow3xx
else
:
fi
@ -390,7 +408,8 @@ ll_noauthmd5()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --noauthmd5
--justfoldersizes --noauthmd5 \
--allow3xx
else
:
fi
@ -407,7 +426,8 @@ ll_maxage()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--maxage 1
--maxage 1 \
--allow3xx
else
:
fi
@ -425,7 +445,8 @@ ll_maxsize()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--maxsize 10
--maxsize 10 \
--allow3xx
else
:
fi
@ -441,7 +462,8 @@ ll_skipsize()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--skipsize --folder INBOX.yop.yap
--skipsize --folder INBOX.yop.yap \
--allow3xx
else
:
fi
@ -457,7 +479,8 @@ ll_skipheader()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--skipheader 'X-.*' --folder INBOX.yop.yap
--skipheader 'X-.*' --folder INBOX.yop.yap \
--allow3xx
else
:
fi
@ -475,7 +498,8 @@ ll_include()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--include '^INBOX.yop'
--include '^INBOX.yop' \
--allow3xx
else
:
fi
@ -491,7 +515,8 @@ ll_exclude()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--exclude '^INBOX.yop'
--exclude '^INBOX.yop' \
--allow3xx
else
:
fi
@ -509,7 +534,8 @@ ll_regextrans2()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--regextrans2 's/yop/yopX/'
--regextrans2 's/yop/yopX/' \
--allow3xx
else
:
fi
@ -525,7 +551,8 @@ ll_sep2()
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.yop.yap \
--sep2 '\\' --dry
--sep2 '\\' --dry \
--allow3xx
else
:
fi
@ -537,7 +564,8 @@ ll_bad_login()
--host1 localhost --user1 toto@est.belle \
--passfile1 /var/tmp/secret1 \
--host2 localhost --user2 notiti@est.belle \
--passfile2 /var/tmp/secret2
--passfile2 /var/tmp/secret2 \
--allow3xx
}
@ -547,7 +575,8 @@ ll_bad_host()
--host1 badhost --user1 toto@est.belle \
--passfile1 /var/tmp/secret1 \
--host2 badhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret2
--passfile2 /var/tmp/secret2 \
--allow3xx
}
@ -558,7 +587,8 @@ ll_bad_host_ssl()
--passfile1 /var/tmp/secret1 \
--host2 badhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret2 \
--ssl1 --ssl2
--ssl1 --ssl2 \
--allow3xx
}
@ -571,7 +601,8 @@ ll_justfoldersizes()
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes
--justfoldersizes \
--allow3xx
else
:
fi
@ -590,7 +621,8 @@ ll_useheader()
--passfile2 /var/tmp/secret.titi \
--folder INBOX.yop.yap \
--useheader 'Message-ID' \
--dry --debug
--dry --debug \
--allow3xx
echo 'rm /home/vmail/tata/.yop.yap/cur/*'
else
:
@ -611,7 +643,8 @@ ll_regexmess()
--folder INBOX.yop.yap \
--regexmess 's/\157/O/g' \
--regexmess 's/p/Z/g' \
--debug
--debug \
--allow3xx
file=`ls -t /home/vmail/titi/.yop.yap/cur/* | tail -1`
diff /var/tmp/imapsync/tests/ll_regexmess/dest_01 $file
#echo 'rm -f /home/vmail/titi/.yop.yap/cur/*'
@ -632,7 +665,8 @@ ll_regexmess_scwchu()
--folder INBOX.scwchu \
--regexmess 's{\A(.*?(?! ^$))^Date:(.*?)$}{$1Date:$2\nReceived: From; $2}gxms' \
--skipsize --skipheader 'Received: From;' \
--debug
--debug \
--allow3xx
echo 'rm /home/vmail/titi/.scwchu/cur/*'
else
:
@ -650,7 +684,8 @@ ll_flags()
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.yop.yap \
--dry --debug
--dry --debug \
--allow3xx
echo 'rm /home/vmail/titi/.yop.yap/cur/*'
else
:
@ -668,7 +703,8 @@ ll_regex_flag()
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.yop.yap \
--dry --debug --regexflag 's/\\Answered/\\AnXweXed/g'
--dry --debug --regexflag 's/\\Answered/\\AnXweXed/g' \
--allow3xx
echo 'rm /home/vmail/titi/.yop.yap/cur/*'
else
@ -684,7 +720,8 @@ ssl_justconnect() {
--host1 localhost \
--host2 localhost \
--ssl1 --ssl2 \
--justconnect
--justconnect \
--allow3xx
else
:
fi
@ -699,7 +736,8 @@ ll_ssl() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--ssl1 --ssl2
--ssl1 --ssl2 \
--allow3xx
else
:
fi
@ -714,7 +752,8 @@ ll_authmech_PLAIN() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --nofoldersizes \
--authmech1 PLAIN --authmech2 PLAIN
--authmech1 PLAIN --authmech2 PLAIN \
--allow3xx
else
:
fi
@ -729,7 +768,8 @@ ll_authuser() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --nofoldersizes \
--authuser2 titi@est.belle
--authuser2 titi@est.belle \
--allow3xx
else
:
fi
@ -747,7 +787,8 @@ ll_authmech_LOGIN() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --nofoldersizes \
--authmech1 LOGIN --authmech2 LOGIN
--authmech1 LOGIN --authmech2 LOGIN \
--allow3xx
else
:
fi
@ -762,7 +803,8 @@ ll_authmech_CRAMMD5() {
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--justfoldersizes --nofoldersizes \
--authmech1 CRAM-MD5 --authmech2 CRAM-MD5
--authmech1 CRAM-MD5 --authmech2 CRAM-MD5 \
--allow3xx
else
:
fi
@ -771,13 +813,15 @@ ll_authmech_CRAMMD5() {
ll_delete2() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
sendtestmessage titi@est.belle
$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 \
--delete2 --expunge2
--delete2 --expunge2 \
--allow3xx
else
:
fi
@ -791,7 +835,8 @@ ll_bigmail() {
--passfile1 /var/tmp/secret.tata \
--host2 localhost --user2 titi@est.belle \
--passfile2 /var/tmp/secret.titi \
--folder INBOX.bigmail
--folder INBOX.bigmail \
--allow3xx
echo 'rm /home/vmail/titi/.bigmail/cur/*'
else
:
@ -799,8 +844,6 @@ ll_bigmail() {
}
msw() {
sendtestmessage toto@est.belle
scp imapsync Admin@192.168.68.77:'C:/msys/1.0/home/Admin/imapsync/imapsync'
@ -829,7 +872,67 @@ gmail() {
else
:
fi
}
gmail_gmail() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
$CMD_PERL ./imapsync \
--host1 imap.gmail.com \
--ssl1 \
--user1 gilles.lamiral@gmail.com \
--passfile1 /var/tmp/secret.gilles_gmail \
--host2 imap.gmail.com \
--ssl2 \
--user2 gilles.lamiral@gmail.com \
--passfile2 /var/tmp/secret.gilles_gmail \
--useheader 'Message-Id' --skipsize \
--regextrans2 's¤INBOX¤inbox_copy¤' \
--folder INBOX \
#--dry # --debug --debugimap # --authmech1 LOGIN
else
:
fi
}
gmail_gmail2() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
$CMD_PERL ./imapsync \
--host1 imap.gmail.com \
--ssl1 \
--user1 gilles.lamiral@gmail.com \
--passfile1 /var/tmp/secret.gilles_gmail \
--host2 imap.gmail.com \
--ssl2 \
--user2 imapsync.gl@gmail.com \
--passfile2 /var/tmp/secret.imapsync.gl_gmail \
--useheader 'Message-Id' --skipsize \
--folder INBOX \
#--dry # --debug --debugimap # --authmech1 LOGIN
else
:
fi
}
allow3xx() {
if test X`hostname` = X"plume"; then
echo3 Here is plume
sendtestmessage
$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 \
--allow3xx
else
:
fi
}
@ -1115,7 +1218,10 @@ test $# -eq 0 && run_tests \
ll_folderrec \
ll_bigmail \
gmail \
gmail_gmail \
gmail_gmail2 \
ssl_justconnect \
allow3xx \
# msw