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

1.670

Browse source
This commit is contained in:
Nick Bebout 2015-12-03 11:16:32 -06:00
parent f1987d5e52
commit b7c835d670
134 changed files with 44448 additions and 2810 deletions
Download patch file Download diff file Expand all files Collapse all files

34
W/.BUILD_EXE_TIME
View file

@ -326,3 +326,37 @@
1435280203 END 1.643 : vendredi 26 juin 2015, 02:56:43 (UTC+0200)
1437158716 BEGIN 1.644 : vendredi 17 juillet 2015, 20:45:16 (UTC+0200)
1437160124 END 1.644 : vendredi 17 juillet 2015, 21:08:44 (UTC+0200)
1439777074 BEGIN 1.650 : lundi 17 août 2015, 04:04:34 (UTC+0200)
1439778213 END 1.650 : lundi 17 août 2015, 04:23:33 (UTC+0200)
1440289827 BEGIN 1.651 : dimanche 23 août 2015, 02:30:27 (UTC+0200)
1440291228 END 1.651 : dimanche 23 août 2015, 02:53:48 (UTC+0200)
1441934795 BEGIN 1.654 : vendredi 11 septembre 2015, 03:26:35 (UTC+0200)
1441940822 BEGIN 1.655 : vendredi 11 septembre 2015, 05:07:02 (UTC+0200)
1441941869 END 1.655 : vendredi 11 septembre 2015, 05:24:29 (UTC+0200)
1447192716 BEGIN 1.665 : mardi 10 novembre 2015, 22:58:36 (UTC+0100)
1447193035 END 1.665 : mardi 10 novembre 2015, 23:03:55 (UTC+0100)
1447201375 BEGIN 1.665 : mercredi 11 novembre 2015, 01:22:55 (UTC+0100)
1447201490 END 1.665 : mercredi 11 novembre 2015, 01:24:50 (UTC+0100)
1447201666 BEGIN 1.665 : mercredi 11 novembre 2015, 01:27:46 (UTC+0100)
1447202045 BEGIN 1.665 : mercredi 11 novembre 2015, 01:34:05 (UTC+0100)
1447202227 END 1.665 : mercredi 11 novembre 2015, 01:37:07 (UTC+0100)
1447205467 BEGIN 1.665 : mercredi 11 novembre 2015, 02:31:07 (UTC+0100)
1447205527 END 1.665 : mercredi 11 novembre 2015, 02:32:07 (UTC+0100)
1447205754 BEGIN 1.665 : mercredi 11 novembre 2015, 02:35:54 (UTC+0100)
1447205813 END 1.665 : mercredi 11 novembre 2015, 02:36:53 (UTC+0100)
1447205877 BEGIN 1.665 : mercredi 11 novembre 2015, 02:37:57 (UTC+0100)
1447206591 BEGIN 1.665 : mercredi 11 novembre 2015, 02:49:51 (UTC+0100)
1447206779 END 1.665 : mercredi 11 novembre 2015, 02:52:59 (UTC+0100)
1447206877 BEGIN 1.665 : mercredi 11 novembre 2015, 02:54:37 (UTC+0100)
1447207318 BEGIN 1.665 : mercredi 11 novembre 2015, 03:01:58 (UTC+0100)
1447207507 END 1.665 : mercredi 11 novembre 2015, 03:05:07 (UTC+0100)
1447208020 BEGIN 1.665 : mercredi 11 novembre 2015, 03:13:40 (UTC+0100)
1447208213 END 1.665 : mercredi 11 novembre 2015, 03:16:53 (UTC+0100)
1447209722 BEGIN 1.665 : mercredi 11 novembre 2015, 03:42:03 (UTC+0100)
1447209976 END 1.665 : mercredi 11 novembre 2015, 03:46:16 (UTC+0100)
1448298296 BEGIN 1.666 : lundi 23 novembre 2015, 18:04:56 (UTC+0100)
1448298474 END 1.666 : lundi 23 novembre 2015, 18:07:54 (UTC+0100)
1448851660 BEGIN 1.667 : lundi 30 novembre 2015, 03:47:40 (UTC+0100)
1448852283 END 1.667 : lundi 30 novembre 2015, 03:58:03 (UTC+0100)
1449111689 BEGIN 1.670 : jeudi 3 décembre 2015, 04:01:29 (UTC+0100)
1449112253 END 1.670 : jeudi 3 décembre 2015, 04:10:53 (UTC+0100)

0
W/CONCEPTION → W/CONCEPTION.txt
View file

33
W/LOG_imapsync/2015_10_22_15_58_28.txt Normal file
View file

@ -0,0 +1,33 @@
Transfer started at Thu Oct 22 15:58:28 2015
PID is 4432
Log file is LOG_imapsync/2015_10_22_15_58_28.txt ( to change it, use --logfile filepath ; or use --nolog to turn off logging )
$RCSfile: imapsync,v $ $Revision: 1.663 $ $Date: 2015/10/03 23:59:27 $
Here is a [linux] system (Linux petite 3.2.0-90-generic #128-Ubuntu SMP Fri Aug 14 21:44:10 UTC 2015 i686)
With perl 5.14.2 Mail::IMAPClient 3.37
Command line used:
../imapsync --modu
Temp directory is /tmp ( to change it use --tmpdir dirpath )
PID file is /tmp/imapsync.pid ( to change it use --pidfile filepath ; to avoid it use --pidfile "" )
Modules version list:
Mail::IMAPClient 3.37
IO::Socket 1.32
IO::Socket::IP ?
IO::Socket::INET 1.31
IO::Socket::SSL 1.53
Net::SSLeay 1.42
Compress::Zlib 2.048
Digest::MD5 2.51
Digest::HMAC_MD5 1.01
Digest::HMAC_SHA1 1.03
Term::ReadKey 2.30
File::Spec 3.33
Time::HiRes 1.972101
Unicode::String 2.09
IO::Tee 0.64
File::Copy::Recursive 0.38
Authen::NTLM 1.09
URI::Escape 3.31
Data::Uniqid 0.12
JSON::WebToken 0.10
( use --no-modules_version to turn off printing this Perl modules list )
--host1 option is mandatory, for help run ../imapsync --help

BIN
W/Mail-IMAPClient-3.37.tar.gz Normal file
View file

Binary file not shown.

2291
W/Mail-IMAPClient-3.37/Changes Normal file
View file

File diff suppressed because it is too large Load diff

40
W/Mail-IMAPClient-3.37/MANIFEST Normal file
View file

@ -0,0 +1,40 @@
Changes
MANIFEST
Makefile.PL
README
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/idle.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
t/basic.t
t/body_string.t
t/bodystructure.t
t/fetch_hash.t
t/messageset.t
t/pod.t
t/simple.t
t/thread.t
test_template.txt
META.yml Module meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)

56
W/Mail-IMAPClient-3.37/META.json Normal file
View file

@ -0,0 +1,56 @@
{
"abstract" : "IMAP4 client library",
"author" : [
"Phil Pearl (Lobbes) <phil@zimbra.com>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Mail-IMAPClient",
"no_index" : {
"directory" : [
"t",
"inc"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Carp" : "0",
"Errno" : "0",
"Fcntl" : "0",
"File::Temp" : "0",
"IO::File" : "0",
"IO::Select" : "0",
"IO::Socket" : "0",
"IO::Socket::INET" : "1.26",
"List::Util" : "0",
"MIME::Base64" : "0",
"Parse::RecDescent" : "1.94",
"Test::More" : "0",
"perl" : "5.008"
}
}
},
"release_status" : "stable",
"resources" : {
"homepage" : "http://sourceforge.net/projects/mail-imapclient/"
},
"version" : "3.37"
}

36
W/Mail-IMAPClient-3.37/META.yml Normal file
View file

@ -0,0 +1,36 @@
---
abstract: 'IMAP4 client library'
author:
- 'Phil Pearl (Lobbes) <phil@zimbra.com>'
build_requires:
ExtUtils::MakeMaker: 0
configure_requires:
ExtUtils::MakeMaker: 0
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 6.66, CPAN::Meta::Converter version 2.120921'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Mail-IMAPClient
no_index:
directory:
- t
- inc
requires:
Carp: 0
Errno: 0
Fcntl: 0
File::Temp: 0
IO::File: 0
IO::Select: 0
IO::Socket: 0
IO::Socket::INET: 1.26
List::Util: 0
MIME::Base64: 0
Parse::RecDescent: 1.94
Test::More: 0
perl: 5.008
resources:
homepage: http://sourceforge.net/projects/mail-imapclient/
version: 3.37

138
W/Mail-IMAPClient-3.37/Makefile.PL Normal file
View file

@ -0,0 +1,138 @@
use ExtUtils::MakeMaker;
use warnings;
use strict;
use 5.008_001;
my @missing;
my %optional = (
"Authen::NTLM" => { for => "Authmechanism 'NTLM'" },
"Authen::SASL" => { for => "Authmechanism 'DIGEST-MD5'" },
"Compress::Zlib" => { for => "COMPRESS DEFLATE support" },
"Digest::HMAC_MD5" => { for => "Authmechanism 'CRAM-MD5'" },
"Digest::MD5" => { for => "Authmechanism 'DIGEST-MD5'" },
"IO::Socket::SSL" => { for => "SSL enabled connections (Ssl => 1)" },
"Test::Pod" => { for => "Pod tests", ver => "1.00" },
);
foreach my $mod ( sort keys %optional ) {
my $for = $optional{$mod}->{"for"} || "";
my $ver = $optional{$mod}->{"ver"} || "";
eval "use $mod $ver ();";
push @missing, $mod . ( $for ? " for $for" : "" ) if $@;
}
# similar message to one used in DBI:
if (@missing) {
print( "The following optional modules were not found:",
map( "\n\t" . $_, @missing ), "\n" );
print <<'MSG';
Optional modules are available from any CPAN mirror, reference:
http://search.cpan.org/
http://www.perl.com/CPAN/modules/by-module
http://www.perl.org/CPAN/modules/by-module
MSG
sleep 3;
}
# HACK: die on broken Parse::RecDescent 1.966002 through 1.967009
# - rt.cpan.org#74593: Recent changes break Module::ExtractUse and ...
# - rt.cpan.org#74733: Fails with Parse::RecDescent >= 1.966_002
do {
eval { require version; require Parse::RecDescent; };
unless ($@) {
my $found = version->parse( Parse::RecDescent->VERSION() );
my $broke = version->parse("1.966002");
my $fixed = version->parse("1.967009");
if ( $found < $fixed and $found >= $broke ) {
die(
"Found broken Parse::RecDescent $found in your environment.\n",
"Please upgrade to version $fixed or greater.\n"
);
}
}
};
WriteMakefile(
NAME => 'Mail::IMAPClient',
AUTHOR => 'Phil Pearl (Lobbes) <phil@zimbra.com>',
ABSTRACT => 'IMAP4 client library',
VERSION_FROM => 'lib/Mail/IMAPClient.pm',
LICENSE => 'perl',
META_MERGE => {
resources => {
bugtracker => {
web =>
'http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient',
mailto => 'bug-Mail-IMAPClient@rt.cpan.org',
},
homepage => 'http://sourceforge.net/projects/mail-imapclient/',
repository => {
url => 'git://git.code.sf.net/p/mail-imapclient/git',
web => 'http://sourceforge.net/p/mail-imapclient/git/',
type => 'git',
},
},
},
MIN_PERL_VERSION => '5.008',
PREREQ_PM => {
'Carp' => 0,
'Errno' => 0,
'Fcntl' => 0,
'IO::File' => 0,
'IO::Select' => 0,
'IO::Socket' => 0,
'IO::Socket::INET' => 1.26,
'List::Util' => 0,
'MIME::Base64' => 0,
'Parse::RecDescent' => 1.94,
'Test::More' => 0,
'File::Temp' => 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;
}
if ( -s "./test.txt" ) {
print("The file test.txt will be used for extended tests.\n");
return;
}
print <<EOF;
(OPTIONAL) For extended tests during 'make test', create a file
'test.txt' in the top level directory of this distribution (the same
directory as the Makefile.PL, etc.). This file must contain an IMAP
server name or IP (server=...), a user account (user=...), and a
password (passed=...). A port (port=....) and an authentication
mechanism to be used (authmechanism=...) can also be specified.
Example:
--- BEGIN: test.txt ---
server=localhost
user=mytestuser
passed=mypassword
port=143
--- END: test.txt ---
NOTE: When testing is completed, be sure to remove test.txt (either by
hand or by 'make clean').
EOF
}

97
W/Mail-IMAPClient-3.37/README Normal file
View file

@ -0,0 +1,97 @@
Mail::IMAPClient
================
Mail::IMAPClient is a Perl module that provides an interface for
communicating with an IMAP server as an IMAP client.
DEPENDENCIES
============
The following are the minimum requirements for using Mail::IMAPClient:
- Perl 5.8
http://www.perl.org/
- Perl modules from CPAN:
http://search.cpan.org/
Required:
List::Util
MIME::Base64
Parse::RecDescent
Optional:
Authen::NTLM
Authen::SASL
Compress::Zlib
Digest::HMAC_MD5
Digest::MD5
IO::Socket::SSL
- RFC 3501 (IMAP4REV1) compatible IMAP server
http://www.faqs.org/rfcs/rfc3501.html
- Mail::IMAPClient (this package)
INSTALLATION
============
1. Download Mail::IMAPClient module
http://search.cpan.org/dist/Mail-IMAPClient/
2. Read this README
3. This module has a number of dependencies on other Perl modules
available from CPAN. If any modules are missing, appropriate
warnings will be generated in the following step.
4. Prepare to build this module and install any prerequisite modules:
perl Makefile.PL
5. (OPTIONAL) For extended tests during 'make test', create a file
'test.txt' in the top level directory of this distribution (the
same directory as the Makefile.PL, etc.). This file must contain
an IMAP server name or IP (server=...), a user account (user=...),
and password a (passed=...). A port (port=....) and an
authentication mechanism to be used (authmechanism=...) can also be
specified.
Example:
--- BEGIN: test.txt ---
server=localhost
user=mytestuser
passed=mypassword
port=143
--- END: test.txt ---
NOTE: When testing is completed, be sure to remove test.txt (either
by hand or by 'make clean').
6. Build, test and install this module:
make
make test
(sudo) make install
7. Read the documentation to become familiar with this module.
Project Links
=============
- Bugs/tickets:
http://rt.cpan.org/Public/Dist/Display.html?Name=Mail-IMAPClient
- Source code repository (git):
http://sourceforge.net/p/mail-imapclient/git/
- CPAN releases:
http://search.cpan.org/dist/Mail-IMAPClient/
- Project website
http://sourceforge.net/projects/mail-imapclient/
COPYRIGHT AND LICENSE
=====================
Copyright (C) 1999-2003 The Kernen Group, Inc.
Copyright (C) 2007-2009 Mark Overmeer
Copyright (C) 2010-2015 Phil Pearl (Lobbes)
All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.0 or,
at your option, any later version of Perl 5 you may have available.
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.

172
W/Mail-IMAPClient-3.37/examples/build_dist.pl Executable file
View file

@ -0,0 +1,172 @@
#!/usr/local/bin/perl
#$Id$
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$
# $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
W/Mail-IMAPClient-3.37/examples/build_ldif.pl Executable file
View file

@ -0,0 +1,235 @@
#!/usr/local/bin/perl
#$Id$
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$
# $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
W/Mail-IMAPClient-3.37/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
W/Mail-IMAPClient-3.37/examples/copy_folder.pl Executable file
View file

@ -0,0 +1,147 @@
#!/usr/local/bin/perl
#$Id$
++$|;
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
W/Mail-IMAPClient-3.37/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
W/Mail-IMAPClient-3.37/examples/cyrus_expunge.pl Executable file
View file

@ -0,0 +1,85 @@
#!/usr/local/bin/perl
#$Id$
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
W/Mail-IMAPClient-3.37/examples/find_dup_msgs.pl Executable file
View file

@ -0,0 +1,217 @@
#!/usr/local/bin/perl
# $Id$
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
#

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

@ -0,0 +1,231 @@
#!/usr/bin/perl
=head1 NAME
idle.pl - example using IMAP idle
=head1 SYNOPSIS
idle.pl [options]
Options: [*] == Required, [+] == Multiple vals OK, (val) == Default
--o Server=<server> *IMAP server name/IP
--o User=<user> *User account to login to
--o Password=<passwd> *Password to use for the User account
(see security note below)
--o Port=<port> port on Server to connect to
--o Ssl=<bool> use SSL on this connection
--o Starttls=<bool> call STARTTLS on this connection
--o Debug=<int> enable debugging in Mail::IMAPClient
--o ImapclientKey=Val any other Mail::IMAPClient attribute/value pair
--folder <folder> folder (mailbox) to IMAP SELECT (INBOX)
--maxidle <sec> maximum time to idle without receiving data (300)
--help display a brief help message
--man display the entire man page
--debug enable script debugging
=head1 NOTES
=head2 --o Password=<password>
A password specified as a command-line option may be visible
to other users via the system process table. It may alternately be
given in the PASSWORD environment variable.
=head2 --maxidle <sec>
RFC 2177 states, "The server MAY consider a client inactive if it has
an IDLE command running, and if such a server has an inactivity
timeout it MAY log the client off implicitly at the end of its timeout
period. Because of that, clients using IDLE are advised to terminate
the IDLE and re-issue it at least every 29 minutes to avoid being
logged off."
The default of --maxidle 300 is used to allow the client to notice
when a connection has silently been closed upstream due to network or
firewall issue or configuration without missing too many idle events.
=cut
use strict;
use warnings;
use File::Basename qw(basename);
use Getopt::Long qw(GetOptions);
use Mail::IMAPClient qw();
use Pod::Usage qw(pod2usage);
use POSIX qw();
use constant {
FOLDER => "INBOX",
MAXIDLE => 300,
};
$| = 1; # set autoflush
my $DEBUG = 0; # GLOBAL set by process_options()
my $QUIT = 0;
my $VERSION = "1.00";
my $Prog = basename($0);
###
# main program
main();
sub main {
my %Opt = process_options();
pout("started $Prog\n");
my $imap = Mail::IMAPClient->new( %{ $Opt{opt} } )
or die("$Prog: error: Mail::IMAPClient->new: $@\n");
my ( $folder, $chkseen, $tag ) = ( $Opt{folder}, 1, undef );
$imap->select($folder)
or die("$Prog: error: select '$folder': $@\n");
$SIG{'INT'} = \&sigint_handler;
until ($QUIT) {
unless ( $imap->IsConnected ) {
warn("$Prog: reconnecting due to error: $@\n") if $imap->LastError;
$imap->connect or last;
$imap->select($folder) or last;
$tag = undef;
}
my $ret;
if ($chkseen) {
$chkseen = 0;
# end idle if necessary
if ($tag) {
$tag = undef;
$ret = $imap->done or last;
}
my $unseen = $imap->unseen_count;
last if $@;
pout("$unseen unseen/new message(s) in '$folder'\n") if $unseen;
}
# idle for X seconds unless data was returned by done
unless ($ret) {
$tag ||= $imap->idle
or die("$Prog: error: idle: $@\n");
warn( "$Prog: DEBUG: ", _ts(), " do idle_data($Opt{maxidle})\n" )
if $DEBUG;
$ret = $imap->idle_data( $Opt{maxidle} ) or last;
# connection can go stale so we exit/re-enter of idle state
# - RFC 2177 mentions 29m but firewalls may be more strict
unless (@$ret) {
warn( "$Prog: DEBUG: ", _ts(), " force exit of idle\n" )
if $DEBUG;
$tag = undef;
# restarted lost connections on next iteration
$ret = $imap->done or next;
}
}
local ( $1, $2, $3 );
foreach my $resp (@$ret) {
$resp =~ s/\015?\012$//;
warn("$Prog: DEBUG: server response: $resp\n") if $DEBUG;
# ignore:
# - DONE command
# - <tag> OK IDLE...
next if ( $resp eq "DONE" );
next if ( $resp =~ /^\w+\s+OK\s+IDLE\b/ );
if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) {
my ( $num, $what ) = ( $1, $2 );
pout("$what: $num message(s) in '$folder'\n");
$chkseen++;
}
elsif ( $resp =~ /^\*\s+(\d+)\s+(EXPUNGE)\b/ ) {
my ( $num, $what ) = ( $1, $2 );
pout("$what: message $num from '$folder'\n");
}
# * 83 FETCH (FLAGS (\Seen))
elsif ( $resp =~ /^\*\s+(\d+)\s+(FETCH)\s+(.*)/ ) {
my ( $num, $what, $info ) = ( $1, $2, $3 );
$chkseen++ if ( $info =~ /[\(|\s]\\Seen[\)|\s]/ );
pout("$what: message $num from '$folder': $info\n");
}
else {
pout("server response: $resp\n");
}
}
}
my $rc = 0;
if ($@) {
if ($QUIT) {
warn("$Prog: caught signal\n");
}
else {
$rc = 1;
}
warn("$Prog: imap error: $@\n") if ( !$QUIT || $DEBUG );
}
exit($rc);
}
###
# supporting routines
sub pout {
print( _ts(), " ", @_ );
}
sub process_options {
my ( %Opt, @err );
GetOptions( \%Opt, "opt=s%", "debug:1", "help", "man", "folder=s",
"maxidle:i" )
or pod2usage( -verbose => 0 );
pod2usage( -message => "$Prog: version $VERSION\n", -verbose => 1 )
if ( $Opt{help} );
pod2usage( -verbose => 2 ) if ( $Opt{man} );
# set global DEBUG
$DEBUG = $Opt{debug} || 0;
# folder (mailbox) to watch
$Opt{folder} = FOLDER unless ( exists $Opt{folder} );
# restart idle when no idle_data seen for this long
$Opt{maxidle} = MAXIDLE unless ( exists $Opt{maxidle} );
$Opt{opt}->{Password} = $ENV{PASSWORD}
if ( !exists $Opt{opt}->{Password} && defined $ENV{PASSWORD} );
foreach my $arg (qw(Server User Password)) {
push( @err, "-o $arg=<val> is required" ) if !exists $Opt{opt}->{$arg};
}
pod2usage(
-verbose => 1,
-message => join( "", map( "$Prog: $_\n", @err ) )
) if (@err);
return %Opt;
}
# example: 2005-10-02 07:50:32
sub _ts {
my %opt = @_;
my $fmt = $opt{fmt} || "%Y-%m-%d %T";
return POSIX::strftime( $fmt, localtime(time) );
}
sub sigint_handler {
$QUIT = 1;
}

266
W/Mail-IMAPClient-3.37/examples/imap_to_mbox.pl Executable file
View file

@ -0,0 +1,266 @@
#!/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.
# $Header$
# History:
# --------
# 2008/08/07 - Added SSL support, fixed From header printing, and CR
# elimination (sobek)
# TODO:
# -----
# lsub instead of list option
use warnings;
use strict;
use Mail::IMAPClient; # a nice set of perl libs for imap
use IO::Socket::SSL; # for SSL support
use vars qw($opt_h $opt_u $opt_p $opt_P $opt_s $opt_i $opt_f $opt_m $opt_b
$opt_c $opt_r $opt_w $opt_W $opt_S $opt_D $opt_U $opt_d $opt_I
$opt_n);
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($$$$);
sub help();
# Config for the imap migration kit.
getopts('u:p:P:s:i:f:m:b:c:r:w:W:SDUdhIn:') or
$opt_h = 1;
my $SSL = $opt_S || 0;
my $SERVER = $opt_s || 'machine';
my $USER = $opt_u || 'userid';
my $PASSWORD = $opt_p || 'password';
my $PORT = $opt_P || '143';
my $INBOX_PATH = $opt_i || "/var/mail/$USER";
my $DOINBOX = $opt_I ? 0 : 1 || 1;
my $FOLDERS_PATH = $opt_f || "./folders/$USER";
my $DONT_MOVE = $opt_m || '.mailboxlist|Trash|INBOXIIMAP|mlbxl';
my $READ_DELIMITER = $opt_r || '/';
my $WRITE_DELIMITER = $opt_w || '/';
my $WRITE_MODE = $opt_W || '>';
my $BANNED_CHARS = $opt_b || '.|^|%';
my $CR = $opt_c || "\r";
my $NUMBER = $opt_n || "";
my $DELETE = $opt_D || 0;
my $DEBUG = $opt_d || "0";
my $UNSEEN = $opt_U || 0;
my $FAIL = 0;
my $imap; # definition for IMAP structure
if ($opt_h) {
# print help here
help();
}
sub help() {
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)
-I skip INBOX (default $DOINBOX)
-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\")
-n <n> Receive only <n> messages (Default ".($NUMBER ? "$NUMBER" : "all").")
-U Unseen messages Only
-D Delete downloaded files 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' # for older versions of openssl
);
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;
if ($folder eq "INBOX" and $DOINBOX == 0) {
print "* $folder is unwanted, skipping.\n";
next;
}
if (!$UNSEEN) {
$message_count = $imap->message_count($folder);
} else {
$message_count = $imap->unseen_count($folder) || 0;
}
if(! $message_count) {
print "* $folder is empty, skipping.\n";
next;
}
if($folder =~ /$DONT_MOVE/) {
warn "! $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";
if ($NUMBER && $NUMBER < $message_count) {
printf "x %4i %-45.45s => %s", $NUMBER, $folder, $path;
write_folder $folder, $path, 1, $NUMBER;
} else {
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 my $mbox, $WRITE_MODE, $newpath
or die "Cannot create file $newpath: $!\n";
my @msgs = $imap->unseen if $UNSEEN;
for (my $i=$first_message; $i<$last_message+1; ++$i)
{ my $m = ($UNSEEN ? shift @msgs : $i);
my $date = UnixDate(ParseDate($imap->internaldate($m)),
"%a %b %e %T %Y");
my $user = $imap->get_envelope($m)->from_addresses;
$user =~ s/^.*<([^>]*)>/$1/;
$user = '-' unless $user;
print '.' if $m%25 == 0;
my $msg_header = $imap->fetch($m, "FAST")
or warn "Could not fetch header $m from $folder\n";
my $msg_rfc822 = $imap->fetch($m, "RFC822");
unless($msg_rfc822)
{ warn "Could not fetch RFC822 $m from $folder\n";
$FAIL=1
}
undef my $start;
foreach (@$msg_rfc822)
{ my $message;
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($m)
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
W/Mail-IMAPClient-3.37/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
W/Mail-IMAPClient-3.37/examples/migrate_mail2.pl Executable file
View file

@ -0,0 +1,326 @@
#!/usr/local/bin/perl
#$Id$
#
# 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
W/Mail-IMAPClient-3.37/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$
#
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
W/Mail-IMAPClient-3.37/examples/populate_mailbox.pl Executable file
View file

@ -0,0 +1,319 @@
#!/usr/local/bin/perl
#$Id$ #
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$
# $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
W/Mail-IMAPClient-3.37/examples/sharedFolder.pl Executable file
View file

@ -0,0 +1,88 @@
#!/usr/local/bin/perl
#$Id$
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
#
#

3468
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pm Normal file
View file

File diff suppressed because it is too large Load diff

3981
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient.pod Normal file
View file

File diff suppressed because it is too large Load diff

576
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/BodyStructure.pm Normal file
View file

@ -0,0 +1,576 @@
use warnings;
use strict;
package Mail::IMAPClient::BodyStructure;
use Mail::IMAPClient::BodyStructure::Parse;
# BUG?: old code used name "HEAD" instead of "HEADER", change?
my $HEAD = "HEAD";
# my has file scope, not limited to package!
my $parser = Mail::IMAPClient::BodyStructure::Parse->new
or die "Cannot parse rules: $@\n"
. "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;
# BUG?: should this default to ($HEAD, TEXT)
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++;
# BUG?: old code didn't add .TEXT sections, should we skip these?
# - This code needs to be generalised (maybe it belongs in parts()?)
# - Should every message should have HEAD (actually MIME) and TEXT?
# at least dovecot and iplanet appear to allow this even for
# non-multipart sections
my $pno = $partno;
my $stype = $self->{bodytype} || "";
my $ptype = $p->{bodytype} || "";
# a message and the multipart inside of it "collapse together"
if ( $partno == 1 and $stype eq 'MESSAGE' and $ptype eq 'MULTIPART' ) {
$pno = "TEXT";
$p->{_prefix} = "$prefix";
}
else {
$p->{_prefix} = "$prefix$partno";
}
$p->{_id} ||= "$prefix$pno";
push @parts, $p, $p->{bodystructure} ? $p->bodystructure : ();
}
wantarray ? @parts : \@parts;
}
sub id {
my $self = shift;
return $self->{_id}
if exists $self->{_id};
return $HEAD
if $self->{_top};
# BUG?: can this be removed? ... seems wrong
if ( $self->{bodytype} eq 'MULTIPART' ) {
my $p = $self->{_id} || $self->{_prefix};
$p =~ s/\.$//;
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 parse_string {
my ( $class, $envelope ) = @_;
$envelope = "(" . $envelope . ")" unless ( $envelope =~ /^\(/ );
$parser->envelopestruct($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, $name . '<' . $_->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;
use Mail::IMAPClient::BodyStructure;
my $imap = Mail::IMAPClient->new(
Server => $server, User => $login, Password => $pass
);
$imap->select("INBOX") or die "Could not select INBOX: $@\n";
my @recent = $imap->search("recent") or die "No recent msgs in INBOX\n";
foreach my $id (@recent) {
my $bsdat = $imap->fetch( $id, "bodystructure" );
my $bso = Mail::IMAPClient::BodyStructure->new( join("", $imap->History) );
my $mime = $bso->bodytype . "/" . $bso->bodysubtype;
my $parts = map( "\n\t" . $_, $bso->parts );
print "Msg $id (Content-type: $mime) contains these parts:$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
to help pull information out of the data structure.
This module requires Parse::RecDescent.
=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.
The module B<Mail::IMAPClient> provides the B<get_bodystructure>
convenience method to simplify use of this module when starting with
just a messages sequence number or unique ID (UID).
=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
a B<Mail::IMAPClient::BodyStructure::Envelope> object for the message
from the calling B<Mail::IMAPClient::Bodystructure> object.
=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 Mail::IMAPClient::BodyStructure::Envelope
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 analogous 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
Original author: David J. Kernen; Reworked by: Mark Overmeer;
Maintained by Phil Pearl.
=head1 SEE ALSO
perl(1), Mail::IMAPClient, Parse::RecDescent, and RFC2060.
=cut

189
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/BodyStructure/Parse.grammar Normal file
View file

@ -0,0 +1,189 @@
# 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" }
RFCNONCOMPLY: /^\(\)/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 | RFCNONCOMPLY
| "(" 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 bodyMD5(?) bodydisp(?)
bodylang(?) bodyextra(?)
{ $return = { bodytype => $item{bodytype} };
take_optional_items($return, \%item
, qw/bodyMD5 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} }

17063
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/BodyStructure/Parse.pm Normal file
View file

File diff suppressed because it is too large Load diff

15
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/BodyStructure/Parse.pod Normal 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
W/Mail-IMAPClient-3.37/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 numbers
=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 specify 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 negligible. 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
W/Mail-IMAPClient-3.37/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;
}

1039
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/Thread.pm Normal file
View file

File diff suppressed because it is too large Load diff

14
W/Mail-IMAPClient-3.37/lib/Mail/IMAPClient/Thread.pod Normal 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.

43
W/Mail-IMAPClient-3.37/prepare_dist Executable file
View file

@ -0,0 +1,43 @@
#!/usr/bin/perl
use strict;
use warnings;
use File::Copy qw/move/;
use Parse::RecDescent 1.94;
sub read_file {
my $file = shift;
local ( $/, *FH );
open( FH, $file ) or return undef;
return <FH>;
}
build_parser(
'lib/Mail/IMAPClient/BodyStructure/Parse.grammar',
'Mail::IMAPClient::BodyStructure::Parse'
);
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");
}

487
W/Mail-IMAPClient-3.37/t/basic.t Normal file
View file

@ -0,0 +1,487 @@
#!/usr/bin/perl
use strict;
use warnings;
use IO::File qw();
use Test::More;
use File::Temp qw(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 in test.txt';
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;
my @missing;
foreach my $p (qw/server user passed/) {
push( @missing, $p ) unless defined $parms{$p};
}
@missing
? plan skip_all => "missing value for: @missing"
: plan tests => 104;
}
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my %new_args = (
Server => delete $parms{server},
Port => delete $parms{port},
User => delete $parms{user},
Password => delete $parms{passed},
Authmechanism => delete $parms{authmech},
Clear => 0,
Fast_IO => $fast,
Uid => $uidplus,
Debug => $debug,
);
# allow other options to be placed in test.txt
%new_args = ( %new_args, %parms );
my $imap = Mail::IMAPClient->new(
%new_args,
Range => $range,
Debug_fh => ( $debug ? IO::File->new( 'imap1.debug', 'w' ) : undef ),
);
ok( defined $imap, 'created client' );
$imap
or die "Cannot log into $new_args{Server} as $new_args{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: <$new_args{User}\@$new_args{Server}>
From: Perl <$new_args{User}\@$new_args{Server}>
Subject: Testing from pid $$
This is a test message generated by $0 during a 'make test' as part of
the installation of the Mail::IMAPClient module from CPAN.
__TEST_MSG
ok( $imap->noop, "noop" );
ok( $imap->tag_and_run("NOOP\r\n"), "tag_and_run" );
my $sep = $imap->separator;
ok( defined $sep, "separator is '$sep'" );
{
my $list = $imap->list();
is( ref($list), "ARRAY", "list" );
my $lsub = $imap->lsub();
is( ref($lsub), "ARRAY", "lsub" );
}
my ( $target, $target2 );
{
my $ispar = $imap->is_parent('INBOX');
my $pre = $ispar ? "INBOX${sep}" : "";
( $target, $target2 ) = ( "${pre}IMAPClient_$$", "${pre}IMAPClient_2_$$" );
ok( defined $ispar, "INBOX is_parent '$ispar' (note: target '$target')" );
}
ok( $imap->select('inbox'), "select inbox" );
# folders
{
my @f = $imap->folders();
ok( @f, "folders" . ( $debug ? ":@f" : "" ) );
my @fh = $imap->folders_hash();
my @fh_keys = qw(attrs delim name);
ok( @fh, "folders_hash keys: @fh_keys" );
is_deeply(
[ sort keys %{ $fh[0] } ],
[ sort @fh_keys ],
"folders eq folders_hash"
)
}
# test append_file
my $append_file_size;
{
my ( $afh, $afn ) = tempfile UNLINK => 1;
# write message to autoflushed file handle since we keep $afh around
my $oldfh = select($afh);
$| = 1;
select($oldfh);
print( $afh $testmsg ) or die("print testmsg failed");
cmp_ok( -s $afn, '>', 0, "tempfile has size" );
ok( $imap->create($target), "create target" );
my $uid = $imap->append_file( $target, $afn );
ok( defined $uid, "append_file test message to $target" );
ok( $imap->select($target), "select $target" );
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
my $size = $imap->size($msg);
cmp_ok( $size, '>', 0, "has size $size" );
my $string = $imap->message_string($msg);
ok( defined $string, "returned string" );
cmp_ok( length($string), '==', $size, "string matches server size" );
# dovecot may disconnect client if deleting selected folder
ok( $imap->select("INBOX"), "select INBOX" );
ok( $imap->delete($target), "delete folder $target" );
$append_file_size = $size;
}
# rt.cpan.org#91912: selectable test for /NoSelect
{
my $targetno = $target . "_noselect";
my $targetsubf = $targetno . "${sep}subfolder";
ok( $imap->create($targetsubf), "create target subfolder" );
ok( !$imap->selectable($targetno),
"not selectable (non-mailbox w/inferior)" );
ok( $imap->delete($targetsubf), "delete target subfolder" );
ok( $imap->delete($targetno), "delete parent folder" );
}
ok( $imap->create($target), "create target" );
ok( $imap->select($target), "select $target" );
# Test append / append_string if we also have UID capability
SKIP: {
skip "UIDPLUS not supported", 3 unless $imap->has_capability("UIDPLUS");
my $ouid = $imap->Uid();
$imap->Uid(1);
# test with date that has a leading space
my $d = " 1-Jan-2011 01:02:03 -0500";
my $uid = $imap->append_string( $target, $testmsg, undef, $d );
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
# hash results do not have UID unless requested
my $h1 = $imap->fetch_hash( $uid, "RFC822.SIZE" );
is( ref($h1), "HASH", "fetch_hash($uid,RFC822.SIZE)" );
is( scalar keys %$h1, 1, "fetch_hash: fetched one msg (as requested)" );
is( !exists $h1->{$uid}->{UID}, 1, "fetch_hash: no UID (not requested)" );
$h1 = $imap->fetch_hash( $uid, "UID RFC822.SIZE" );
is( exists $h1->{$uid}->{UID}, 1, "fetch_hash: has UID (as requested)" );
ok( $imap->delete_message($uid), "delete_message $uid" );
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
# multiple args joined internally in append()
$uid = $imap->append( $target, $testmsg, "Some extra text too" );
ok( defined $uid, "append test message to $target with date (uid=$uid)" );
ok( $imap->delete_message($uid), "delete_message $uid" );
ok( $imap->uidexpunge($uid), "uidexpunge $uid" );
$imap->Uid($ouid);
}
# test append
{
my $uid = $imap->append( $target, $testmsg );
ok( defined $uid, "append test message to $target" );
my $msg = ( $uidplus and $uid ) ? $uid : ( $imap->messages )[0];
my $size = $imap->size($msg);
cmp_ok( $size, '>', 0, "has size $size" );
my $string = $imap->message_string($msg);
ok( defined $string, "returned string" );
cmp_ok( length($string), '==', $size, "string == server size" );
{
my $var;
ok( $imap->message_to_file( \$var, $msg ), "to SCALAR ref" );
cmp_ok( length($var), '==', $size, "correct size" );
my ( $fh, $fn ) = tempfile UNLINK => 1;
ok( $imap->message_to_file( $fn, $msg ), "to file $fn" );
cmp_ok( -s $fn, '==', $size, "correct size" );
}
cmp_ok( $size, '==', $append_file_size, "size matches string/file" );
# save first message/folder for use below...
#OFF ok( $imap->delete($target), "delete folder $target" );
}
#OFF ok( $imap->create($target), "create target" );
ok( $imap->exists($target), "exists $target" );
ok( $imap->create($target2), "create $target2" );
ok( $imap->exists($target2), "exists $target2" );
is( defined $imap->is_parent($sep), 1, "is_parent($sep)" );
is( !$imap->is_parent($target2), 1, "is_parent($target2)" );
{
ok( $imap->subscribe($target), "subscribe $target" );
my $sub1 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub1 ) )[0], "$target", "subscribed" );
ok( $imap->unsubscribe($target), "unsubscribe target" );
my $sub2 = $imap->subscribed();
is( ( grep( /^\Q$target\E$/, @$sub2 ) )[0], undef, "unsubscribed" );
}
my $fwquotes = qq($target has "quotes");
if ( $imap->create($fwquotes) ) {
ok( 1, "create '$fwquotes'" );
ok( $imap->select($fwquotes), "select '$fwquotes'" );
ok( $imap->close, "close '$fwquotes'" );
$imap->select('inbox');
ok( $imap->delete($fwquotes), "delete '$fwquotes'" );
}
else {
my $err = $imap->LastError || "(no error)";
ok( 1, "failed creation with quotes, assume not supported: $err" );
ok( 1, "skipping 1/3 tests" );
ok( 1, "skipping 2/3 tests" );
ok( 1, "skipping 3/3 tests" );
}
ok( $imap->select($target), "select $target" );
my $fields = $imap->search( "HEADER", "Message-id", "NOT_A_MESSAGE_ID" );
is( scalar @$fields, 0, 'bogus 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 $h1 = $imap->fetch_hash("RFC822.SIZE");
is( ref($h1), "HASH", "fetch_hash(RFC822.SIZE)" );
my $id = ( sort { $a <=> $b } keys %$h1 )[0];
my $h2 = $imap->fetch_hash( $id, "RFC822.SIZE" );
is( ref($h2), "HASH", "fetch_hash($id,RFC822.SIZE)" );
is( scalar keys %$h2, 1, "fetch_hash($id,RFC822.SIZE) => fetched one msg" );
}
{
my $seq = "1:*";
my @dat = (qw(RFC822.SIZE INTERNALDATE));
my $h1 = $imap->fetch_hash( $seq, @dat );
is( ref($h1), "HASH", "fetch_hash($seq, " . join( ", ", @dat ) . ")" );
# verify legacy and less desirable use case still works
my $h2 = $imap->fetch_hash("$seq @dat");
is( ref($h2), "HASH", "fetch_hash('$seq @dat')" );
is_deeply( $h1, $h2, "fetch_hash same result with array or string args" );
}
my $h = $imap->parse_headers( 1, "Subject" );
ok( $h, "got subject" );
like( $h->{Subject}[0], qr/^Testing from pid/, "subject matched" );
ok( $imap->select($target), "select $target" );
my @hits = $imap->search( SUBJECT => 'Testing' );
cmp_ok( scalar @hits, '==', 1, 'hit subject Testing' );
ok( defined $hits[0], "subject is defined" );
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, "delete verified" );
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, "restore verified" );
$imap->select($target2);
ok(
$imap->delete_message( scalar( $imap->search("ALL") ) )
&& $imap->close
&& $imap->delete($target2),
"delete $target2"
);
$imap->select("INBOX");
$@ = undef;
@hits =
$imap->search( BEFORE => Mail::IMAPClient::Rfc2060_date(time), "UNDELETED" );
ok( !$@, "search undeleted" ) or diag( '$@:' . $@ );
#
# Test migrate method
#
my $im2 = Mail::IMAPClient->new(
%new_args,
Timeout => 30,
Debug_fh => ( $debug ? IO::File->new(">./imap2.debug") : undef ),
);
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: $@";
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
#
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;
}
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
cmp_ok( $total_bytes1, '==', $total_bytes2, 'size source==target' );
# cleanup
$im2->select($migtarget);
$im2->delete_message( @{ $im2->messages } )
if $im2->message_count;
ok( $im2->close, "close" );
$im2->delete($migtarget);
ok_relaxed_logout($im2);
# Test IDLE
SKIP: {
skip "IDLE not supported", 4 unless $imap->has_capability("IDLE");
ok( my $idle = $imap->idle, "idle" );
sleep 1;
ok( $imap->idle_data, "idle_data" );
ok( $imap->done($idle), "done" );
ok( !$@, "LastError not set" ) or diag( '$@:' . $@ );
}
$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);
}
$imap->_disconnect;
ok( $imap->reconnect, "reconnect" );
ok_relaxed_logout($imap);
# STARTTLS - an optional feature
if ( $imap->_load_module("SSL") ) {
$imap->connect( Ssl => 0, Starttls => 1 );
ok( 1, "OPTIONAL connect(Starttls=>1)" . ( $@ ? ": (error) $@ " : "" ) );
}
else {
ok( 1, "skipping optional STARTTLS test" );
}
# LOGOUT
# - on successful LOGOUT $code is OK (not BYE!) see RFC 3501 sect 7.1.5
# however some servers return BYE instead so we let that pass here...
sub ok_relaxed_logout {
my $imap = shift;
local ($@);
my $rc = $imap->logout;
my $err = $imap->LastError || "";
ok( ( $rc or $err =~ /^\* BYE/ ), "logout" . ( $err ? ": $err" : "" ) );
}

76
W/Mail-IMAPClient-3.37/t/body_string.t Normal file
View file

@ -0,0 +1,76 @@
#!/usr/bin/perl
#
# tests for body_string()
#
# body_string() calls fetch() internally. rather than refactor
# body_string() just for testing, we subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use IO::Socket qw(:crlf);
use Test::More tests => 3;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"simple fetch",
[
'12 FETCH 1 BODY[TEXT]',
'* 1 FETCH (FLAGS (\\Seen \\Recent) BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"12 OK Fetch completed.$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
# 2010-05-27: test for bug reported by Heiko Schlittermann
[
"uwimap IMAP4rev1 2007b.404 fetch unseen",
[
'4 FETCH 1 BODY[TEXT]',
'* 1 FETCH (BODY[TEXT]',
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
")$CRLF",
"* 1 FETCH (FLAGS (\\Recent \\Seen)$CRLF",
"4 OK Fetch completed$CRLF",
],
[ 1 ],
"This is a test message$CRLF" . "Line Z (last line)$CRLF",
],
);
package Test::Mail::IMAPClient;
use base qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $response ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->body_string(@$request);
is_deeply( $r, $response, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0, Debug => 0 );
run_tests( $imap, \@tests );

172
W/Mail-IMAPClient-3.37/t/bodystructure.t Normal file
View file

File diff suppressed because one or more lines are too long

317
W/Mail-IMAPClient-3.37/t/fetch_hash.t Normal file
View file

@ -0,0 +1,317 @@
#!/usr/bin/perl
#
# tests for fetch_hash()
#
# fetch_hash() calls fetch() internally. rather than refactor
# fetch_hash() just for testing, we instead subclass M::IC and use the
# overidden fetch() to feed it test data.
use strict;
use warnings;
use Test::More tests => 27;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
my @tests = (
[
"unquoted value",
[ q{* 1 FETCH (UNQUOTED foobar)}, ],
[ [1], qw(UNQUOTED) ],
{ "1" => { "UNQUOTED" => q{foobar}, } },
],
[
"quoted value",
[ q{* 1 FETCH (QUOTED "foo bar baz")}, ],
[ [1], qw(QUOTED) ],
{ "1" => { "QUOTED" => q{foo bar baz}, }, },
],
[
"escaped-backslash before end-quote",
[ q{* 1 FETCH (QUOTED "foo bar baz\\\\")}, ],
[ [1], qw(QUOTED) ],
{ "1" => { "QUOTED" => q{foo bar baz\\\\}, }, },
],
[
"parenthesized value",
[ q{* 1 FETCH (PARENS (foo bar))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar}, }, },
],
[
"parenthesized value with quotes",
[ q{* 1 FETCH (PARENS (foo "bar" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "bar" baz}, }, },
],
[
"parenthesized value with parens at start",
[ q{* 1 FETCH (PARENS ((foo) bar baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(foo) bar baz}, }, },
],
[
"parenthesized value with parens in middle",
[ q{* 1 FETCH (PARENS (foo (bar) baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo (bar) baz}, }, },
],
[
"parenthesized value with parens at end",
[ q{* 1 FETCH (PARENS (foo bar (baz)))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo bar (baz)}, }, },
],
[
"parenthesized value with quoted parentheses",
[ q{* 1 FETCH (PARENS (foo "(bar)" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "(bar)" baz}, }, },
],
[
"parenthesized value with quoted unclosed parentheses",
[ q{* 1 FETCH (PARENS (foo "(bar" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "(bar" baz}, }, },
],
[
"parenthesized value with quoted unopened parentheses",
[ q{* 1 FETCH (PARENS (foo "bar)" baz))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{foo "bar)" baz}, }, },
],
[
"complex parens",
[ q{* 1 FETCH (PARENS ((((foo) "bar") baz (quux))))}, ],
[ [1], qw(PARENS) ],
{ "1" => { "PARENS" => q{(((foo) "bar") baz (quux))}, }, },
],
[
"basic literal value",
[ q{* 1 FETCH (LITERAL}, q{foo}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo}, }, },
],
[
"multiline literal value",
[ q{* 1 FETCH (LITERAL}, q{foo\r\nbar\r\nbaz\r\n}, q{)}, ],
[ [1], qw(LITERAL) ],
{ "1" => { "LITERAL" => q{foo\r\nbar\r\nbaz\r\n}, }, },
],
[
"multiple attributes",
[ q{* 1 FETCH (FOO foo BAR bar BAZ baz)}, ],
[ [1], qw(FOO BAR BAZ) ],
{
"1" => {
"FOO" => q{foo},
"BAR" => q{bar},
"BAZ" => q{baz},
},
},
],
[
"dotted attribute",
[ q{* 1 FETCH (FOO.BAR foobar)}, ],
[ [1], qw(FOO.BAR) ],
{ "1" => { "FOO.BAR" => q{foobar}, }, },
],
[
"complex attribute",
[ q{* 1 FETCH (FOO.BAR[BAZ (QUUX)] quuz)}, ],
[ [1], q{FOO.BAR[BAZ (QUUX)]} ],
{ "1" => { q{FOO.BAR[BAZ (QUUX)]} => q{quuz}, }, },
],
[
"BODY.PEEK[] requests match BODY[] responses",
[q{* 1 FETCH (BODY[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY[]" => q{foo}, }, },
],
[
"BODY.PEEK[] requests match BODY.PEEK[] responses also",
[q{* 1 FETCH (BODY.PEEK[] foo)}],
[ [1], qw(BODY.PEEK[]) ],
{ "1" => { "BODY.PEEK[]" => q{foo}, }, },
],
[
"BODY[]<0.1024> requests match BODY[]<0> responses",
[ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ],
[ [1], qw(BODY[]<0.1024>) ],
{ "1" => { "BODY[]<0>" => q{foo}, }, },
],
[
"BODY.PEEK[]<0.1024> requests match BODY[]<0> responses",
[ q{* 1 FETCH (BODY[]<0>}, q{foo}, ")\r\n" ],
[ [1], qw(BODY.PEEK[]<0.1024>) ],
{ "1" => { "BODY[]<0>" => q{foo}, }, },
],
[
"non-escaped BODY[HEADER.FIELDS (...)]",
[
q{* 1 FETCH (FLAGS () BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]},
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
To: phil+to@perkpartners.com
Subject: foo "bar\" (baz\)
Date: Sat, 22 Jan 2011 20:43:58 -0500
'
],
[ [1], ( qw(FLAGS), 'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' ) ],
{
'1' => {
'BODY[HEADER.FIELDS (TO FROM SUBJECT DATE)]' =>
'From: Phil Pearl (Lobbes) <phil+from@perkpartners.com>
To: phil+to@perkpartners.com
Subject: foo "bar\" (baz\)
Date: Sat, 22 Jan 2011 20:43:58 -0500
',
'FLAGS' => '',
},
},
],
);
my @uid_tests = (
[
"uid enabled",
[ q{* 1 FETCH (UID 123 UNQUOTED foobar)}, ],
[ [123], qw(UNQUOTED) ],
{ "123" => { "UNQUOTED" => q{foobar}, } },
],
[
"ENVELOPE with escaped-backslash before end-quote",
[ q{* 1 FETCH (UID 1 FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL "<msgid>")) } ],
[ [1], qw(UID FLAGS ENVELOPE) ],
{
"1" => {
'UID' => '1',
'FLAGS' => '\\Seen',
'ENVELOPE' =>
q{"Fri, 28 Jan 2011 00:03:30 -0500" "Subject" (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken N" NIL "ken" "dom.loc")) (("Ken Backslash\\\\" NIL "ken.bl" "dom.loc")) NIL NIL NIL "<msgid>"}
},
},
],
[
"escaped ENVELOPE subject",
[
q{* 1 FETCH (UID 1 X-SAVEDATE "28-Jan-2011 16:52:31 -0500" FLAGS (\Seen) ENVELOPE ("Fri, 28 Jan 2011 00:03:30 -0500"},
q{foo "bar\\" (baz\\)},
q{ (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>")) }
],
[ [1], qw(UID X-SAVEDATE FLAGS ENVELOPE) ],
{
"1" => {
'X-SAVEDATE' => '28-Jan-2011 16:52:31 -0500',
'UID' => '1',
'FLAGS' => '\\Seen',
'ENVELOPE' =>
q{"Fri, 28 Jan 2011 00:03:30 -0500" "foo \\"bar\\\\\\" (baz\\\\)" (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) (("Phil Pearl" NIL "phil" "dom.loc")) ((NIL NIL "phil" "dom.loc")) NIL NIL NIL "<msgid>"}
},
},
],
[
"real life example",
[
'* 1 FETCH (UID 541 FLAGS (\\Seen) INTERNALDATE "15-Sep-2009 20:05:45 +1000" RFC822.SIZE 771 BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]',
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
' BODY[]',
'Return-Path: <rob@pyro>
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
Lines: 1
This is a test mailing
',
')
',
],
[
[1],
q{BODY.PEEK[HEADER.FIELDS (To From Date Subject)]},
qw(FLAGS INTERNALDATE RFC822.SIZE BODY[])
],
{
"541" => {
'BODY[]' => 'Return-Path: <rob@pyro>
Delivered-To: rob@pyro
Received: from pyro (pyro [127.0.0.1])
by pyro.home (Postfix) with ESMTP id A5C8115A066
for <rob@pyro>; Tue, 15 Sep 2009 20:05:45 +1000 (EST)
Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
X-Mailer: swaks v20061116.0 jetmore.org/john/code/#swaks
Message-Id: <20090915100545.A5C8115A066@pyro.home>
Lines: 1
This is a test mailing
',
'INTERNALDATE' => '15-Sep-2009 20:05:45 +1000',
'FLAGS' => '\\Seen',
'BODY[HEADER.FIELDS (TO FROM DATE SUBJECT)]' =>
'Date: Tue, 15 Sep 2009 20:05:45 +1000
To: rob@pyro
From: rob@pyro
Subject: test Tue, 15 Sep 2009 20:05:45 +1000
',
'RFC822.SIZE' => '771',
},
},
],
);
package Test::Mail::IMAPClient;
use vars qw(@ISA);
@ISA = qw(Mail::IMAPClient);
sub new {
my ( $class, %args ) = @_;
my %me = %args;
return bless \%me, $class;
}
sub fetch {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
sub Escaped_results {
my ( $self, @args ) = @_;
return $self->{_next_fetch_response} || [];
}
package main;
sub run_tests {
my ( $imap, $tests ) = @_;
for my $test (@$tests) {
my ( $comment, $fetch, $request, $expect ) = @$test;
$imap->{_next_fetch_response} = $fetch;
my $r = $imap->fetch_hash(@$request);
is_deeply( $r, $expect, $comment );
}
}
my $imap = Test::Mail::IMAPClient->new( Uid => 0 );
run_tests( $imap, \@tests );
$imap->Uid(1);
run_tests( $imap, \@uid_tests );

37
W/Mail-IMAPClient-3.37/t/messageset.t Normal file
View file

@ -0,0 +1,37 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::MessageSet') or exit; }
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'
);

10
W/Mail-IMAPClient-3.37/t/pod.t Normal file
View file

@ -0,0 +1,10 @@
#!/usr/bin/perl
use strict;
use warnings;
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();

36
W/Mail-IMAPClient-3.37/t/simple.t Normal file
View file

@ -0,0 +1,36 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 13;
BEGIN { use_ok('Mail::IMAPClient') or exit; }
{
my $obj = Mail::IMAPClient->new();
my %t = ( 0 => "01-Jan-1970" );
foreach my $k ( sort keys %t ) {
my $v = $t{$k};
my $s = $v . ' 00:00:00 +0000';
is( Mail::IMAPClient::Rfc2060_date($k), $v, "Rfc2060_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_date($k), $v, "Rfc3501_date($k)=$v" );
is( Mail::IMAPClient::Rfc3501_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( Mail::IMAPClient::Rfc2060_datetime($k),
$s, "Rfc3501_datetime($k)=$s" );
is( $obj->Rfc3501_date($k), $v, "->Rfc3501_date($k)=$v" );
is( $obj->Rfc2060_date($k), $v, "->Rfc2060_date($k)=$v" );
is( $obj->Rfc3501_datetime($k), $s, "->Rfc3501_datetime($k)=$s" );
is( $obj->Rfc2060_datetime($k), $s, "->Rfc2060_datetime($k)=$s" );
foreach my $z (qw(+0000 -0500)) {
my $vz = $v . ' 00:00:00 ' . $z;
is( Mail::IMAPClient::Rfc2060_datetime( $k, $z ),
$vz, "Rfc2060_datetime($k)=$vz" );
is( Mail::IMAPClient::Rfc3501_datetime( $k, $z ),
$vz, "Rfc3501_datetime($k)=$vz" );
}
}
}

30
W/Mail-IMAPClient-3.37/t/thread.t Normal file
View file

@ -0,0 +1,30 @@
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 7;
BEGIN { use_ok('Mail::IMAPClient::Thread') or exit; }
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
W/Mail-IMAPClient-3.37/test_template.txt Normal file
View file

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

29
W/OSI_request.txt Executable file
View file

@ -0,0 +1,29 @@
Rationale:Clearly state rationale for a new license
There is few licenses on the free work market allowing anything
from the author point of view. The purpose of any license is
to write what can be done without having to contact the authors.
There is no such permissive license in the OSI list.
CC0 WTFPL and Bugroff are too restrictive licenses
CC0 https://creativecommons.org/about/cc0
WTFPL http://www.wtfpl.net/about/
Bugroff http://tunes.org/legalese/bugroff.html
I
Distinguish: Compare to and contrast with the most similar OSI-approved license(s)
There is no similar OSI-approved license. All
Legal review: Describe any legal review the license has been through, and provide results of any legal analysis if available
None.
Proliferation category: Recommend which license proliferation category is appropriate
The NOLIMIT license allows any work under it to be relicensed under any other license.

0
W/RECORD → W/RECORD.txt
View file

0
W/TESTING → W/TESTING.txt
View file

0
W/TIME → W/TIME.txt
View file

89
W/build_exe.bat
View file

@ -1,14 +1,13 @@
REM $Id: build_exe.bat,v 1.28 2015/05/11 01:09:57 gilles Exp gilles $
REM $Id: build_exe.bat,v 1.33 2015/11/23 16:47:21 gilles Exp gilles $
@ECHO OFF
ECHO Building imapsync.exe
@REM Allow to be called from anywhere;
@REM the following command cd to dirname of the current batch pathname
cd /D %~dp0
CALL .\install_modules.bat
REM CALL .\install_modules.bat
perl ^
-mAuthen::NTLM ^
@ -33,37 +32,67 @@ perl ^
-mLWP::UserAgent ^
-mHTML::Entities ^
-mJSON ^
-mCrypt::OpenSSL::RSA ^
-e ''
cd
@ECHO ON
@REM --link libssl32_.dll
del imapsync.exe
pp -o imapsync.exe ^
--link libeay32_.dll ^
--link zlib1_.dll ^
--link ssleay32_.dll ^
-M Mail::IMAPClient ^
-M IO::Socket ^
-M IO::Socket::IP ^
-M IO::Socket::SSL ^
-M IO::Socket::INET ^
-M Digest::MD5 ^
-M Digest::HMAC_MD5 ^
-M Digest::HMAC_SHA1 ^
-M Term::ReadKey ^
-M File::Spec ^
-M Authen::NTLM ^
-M Time::Local ^
-M URI::Escape ^
-M Data::Uniqid ^
-M File::Copy::Recursive ^
-M IO::Tee ^
-M Unicode::String ^
-M JSON::WebToken ^
-M LWP::UserAgent ^
-M HTML::Entities ^
-M JSON ^
.\imapsync
--link libeay32_.dll ^
--link zlib1_.dll ^
--link ssleay32_.dll ^
.\imapsync
echo Done building imapsync.exe
@REM Previous options to pp
@REM Previous options to pp
@REM --link libeay32_.dll ^
@REM --link zlib1_.dll ^
@REM --link ssleay32_.dll ^
@REM -M Mail::IMAPClient ^
@REM -M IO::Socket ^
@REM -M IO::Socket::IP ^
@REM -M IO::Socket::SSL ^
@REM -M IO::Socket::INET ^
@REM -M Digest::MD5 ^
@REM -M Digest::HMAC_MD5 ^
@REM -M Digest::HMAC_SHA1 ^
@REM -M Term::ReadKey ^
@REM -M File::Spec ^
@REM -M Authen::NTLM ^
@REM -M Time::Local ^
@REM -M URI::Escape ^
@REM -M Data::Uniqid ^
@REM -M File::Copy::Recursive ^
@REM -M IO::Tee ^
@REM -M Unicode::String ^
@REM -M JSON::WebToken ^
@REM -M LWP::UserAgent ^
@REM -M HTML::Entities ^
@REM -M JSON ^
EXIT
-M Mail::IMAPClient ^
-M IO::Socket ^
-M IO::Socket::IP ^
-M IO::Socket::SSL ^
-M IO::Socket::INET ^
-M Digest::MD5 ^
-M Digest::HMAC_MD5 ^
-M Digest::HMAC_SHA1 ^
-M Term::ReadKey ^
-M File::Spec ^
-M Authen::NTLM ^
-M Time::Local ^
-M URI::Escape ^
-M Data::Uniqid ^
-M File::Copy::Recursive ^
-M IO::Tee ^
-M Unicode::String ^
-M JSON::WebToken ^
-M LWP::UserAgent ^
-M HTML::Entities ^
-M Crypt::OpenSSL::RSA ^
-M JSON ^

5
W/build_mac.sh
View file

@ -1,5 +1,7 @@
#!/bin/sh
# $Id: build_mac.sh,v 1.2 2015/11/04 18:19:48 gilles Exp gilles $
eval `perl -I $HOME/perl5/lib/perl5 -Mlocal::lib`
export MANPATH=$HOME/perl5/man:$MANPATH
@ -11,10 +13,13 @@ echo "$HOSTNAME $ARCH $KERNEL"
VERSION=`./imapsync --version`
BIN_NAME=imapsync_bin_Darwin
cpanm Mail::IMAPClient
pp -o $BIN_NAME \
-M Mail::IMAPClient -M IO::Socket -M IO::Socket::SSL \
-M Digest::MD5 -M Digest::HMAC_MD5 -M Term::ReadKey \
-M Authen::NTLM \
-M Crypt::OpenSSL::RSA -M JSON -M JSON::WebToken -M LWP -M HTML::Entities \
imapsync
./imapsync_bin_Darwin

46
W/imapsync.1
View file

@ -124,7 +124,7 @@
.\" ========================================================================
.\"
.IX Title "IMAPSYNC 1"
.TH IMAPSYNC 1 "2015-07-17" "perl v5.14.2" "User Contributed Perl Documentation"
.TH IMAPSYNC 1 "2015-12-03" "perl v5.14.2" "User Contributed Perl Documentation"
.\" For nroff, turn off justification. Always turn off hyphenation; it makes
.\" way too many mistakes in technical documents.
.if n .ad l
@ -132,10 +132,10 @@
.SH "NAME"
imapsync \- IMAP synchronisation, sync, copy or migration tool.
Synchronises mailboxes between two imap servers.
Good at IMAP migration. More than 52 different IMAP server softwares
Good at IMAP migration. More than 66 different IMAP server softwares
supported with success, few failures.
.PP
$Revision: 1.644 $
$Revision: 1.670 $
.SH "SYNOPSIS"
.IX Header "SYNOPSIS"
To synchronize imap account \*(L"foo\*(R" on \*(L"imap.truc.org\*(R"
@ -206,36 +206,36 @@ The option list:
.PP
.Vb 10
\& imapsync [\-\-host1 server1] [\-\-port1 <num>]
\& [\-\-user1 <string>] [\-\-passfile1 <string>]
\& [\-\-user1 str ] [\-\-passfile1 str ]
\& [\-\-host2 server2] [\-\-port2 <num>]
\& [\-\-user2 <string>] [\-\-passfile2 <string>]
\& [\-\-user2 str ] [\-\-passfile2 str ]
\& [\-\-ssl1] [\-\-ssl2]
\& [\-\-tls1] [\-\-tls2]
\& [\-\-authmech1 <string>] [\-\-authmech2 <string>]
\& [\-\-authmech1 str ] [\-\-authmech2 str ]
\& [\-\-proxyauth1] [\-\-proxyauth2]
\& [\-\-domain1] [\-\-domain2]
\& [\-\-authmd51] [\-\-authmd52]
\& [\-\-folder <string> \-\-folder <string> ...]
\& [\-\-folderrec <string> \-\-folderrec <string> ...]
\& [\-\-include <regex>] [\-\-exclude <regex>]
\& [\-\-prefix2 <string>] [\-\-prefix1 <string>]
\& [\-\-regextrans2 <regex> \-\-regextrans2 <regex> ...]
\& [\-\-folder str \-\-folder str ...]
\& [\-\-folderrec str \-\-folderrec str ...]
\& [\-\-include reg ] [\-\-exclude reg ]
\& [\-\-prefix2 str ] [\-\-prefix1 str ]
\& [\-\-regextrans2 reg \-\-regextrans2 reg ...]
\& [\-\-sep1 <char>]
\& [\-\-sep2 <char>]
\& [\-\-justfolders] [\-\-justfoldersizes] [\-\-justconnect] [\-\-justbanner]
\& [\-\-syncinternaldates]
\& [\-\-idatefromheader]
\& [\-\-syncacls]
\& [\-\-regexmess <regex>] [\-\-regexmess <regex>]
\& [\-\-skipmess <regex>] [\-\-skipmess <regex>]
\& [\-\-maxsize <int>]
\& [\-\-minsize <int>]
\& [\-\-maxage <int>]
\& [\-\-minage <int>]
\& [\-\-search <string>]
\& [\-\-search1 <string>]
\& [\-\-search2 <string>]
\& [\-\-useheader <string>] [\-\-useheader <string>]
\& [\-\-regexmess reg ] [\-\-regexmess reg ]
\& [\-\-skipmess reg ] [\-\-skipmess reg ]
\& [\-\-maxsize int ]
\& [\-\-minsize int ]
\& [\-\-maxage int ]
\& [\-\-minage int ]
\& [\-\-search str ]
\& [\-\-search1 str ]
\& [\-\-search2 str ]
\& [\-\-useheader str ] [\-\-useheader str ]
\& [\-\-nouid1] [\-\-nouid2]
\& [\-\-usecache]
\& [\-\-noskipsize]
@ -247,7 +247,7 @@ The option list:
\& [\-\-nofoldersizes] [\-\-nofoldersizesatend]
\& [\-\-dry]
\& [\-\-debug] [\-\-debugimap][\-\-debugimap1][\-\-debugimap2] [\-\-debugcontent]
\& [\-\-timeout <int>]
\& [\-\-timeout int ]
\& [\-\-noreleasecheck]
\& [\-\-releasecheck]
\& [\-\-pidfile <filepath>] [\-\-pidfilelocking]
@ -569,4 +569,4 @@ https://web.archive.org/web/20070202005121/http://www.imap.org/products/showall.
.PP
Feedback (good or bad) will often be welcome.
.PP
\&\f(CW$Id:\fR imapsync,v 1.644 2015/07/17 01:22:52 gilles Exp gilles $
\&\f(CW$Id:\fR imapsync,v 1.670 2015/12/03 02:36:41 gilles Exp gilles $

28
W/install_module_one.bat Normal file
View file

@ -0,0 +1,28 @@
@REM $Id: install_module_one.bat,v 1.1 2015/11/23 16:49:17 gilles Exp gilles $
@ECHO OFF
SET SHELL=
SET
REM EXIT
ECHO Installing Perl module IO::Socket::SSL for imapsync
REM CD /D %~dp0
perl -v
IF ERRORLEVEL 1 ECHO Perl needed. Install Strawberry Perl. Get it at http://strawberryperl.com/ ^
&& EXIT /B
@ECHO perl is here
FOR %%M in (
IO::Socket::SSL ^
) DO perl -m%%M -e "print qq{Updating %%M $%%M::VERSION \n}" ^
& cpanm %%M
REM IO::Socket::SSL
@ECHO Perl modules for imapsync installed
PAUSE

28
W/install_module_ssl.bat Normal file
View file

@ -0,0 +1,28 @@
@REM $Id: install_module_ssl.bat,v 1.1 2015/11/05 14:51:08 gilles Exp gilles $
@ECHO OFF
SET SHELL=
SET
REM EXIT
ECHO Installing Perl module IO::Socket::SSL for imapsync
REM CD /D %~dp0
perl -v
IF ERRORLEVEL 1 ECHO Perl needed. Install Strawberry Perl. Get it at http://strawberryperl.com/ ^
&& EXIT /B
@ECHO perl is here
FOR %%M in (
IO::Socket::SSL ^
) DO perl -m%%M -e "print qq{Updating %%M $%%M::VERSION \n}" ^
& cpanm %%M
REM IO::Socket::SSL
@ECHO Perl modules for imapsync installed
PAUSE

23
W/install_modules.bat
View file

@ -1,10 +1,13 @@
REM $Id: install_modules.bat,v 1.17 2015/05/23 09:40:38 gilles Exp gilles $
@ECHO OFF
REM $Id: install_modules.bat,v 1.18 2015/11/04 18:15:11 gilles Exp gilles $
@ECHO OFF
@REM Needed with remote ssh
SET SHELL=
SET
ECHO Installing Perl modules for imapsync
REM CD /D %~dp0
CD /D %~dp0
perl -v
IF ERRORLEVEL 1 ECHO Perl needed. Install Strawberry Perl. Get it at http://strawberryperl.com/ ^
@ -21,6 +24,7 @@ FOR %%M in ( ^
Digest::MD5 ^
File::Copy::Recursive ^
Getopt::ArgvFile ^
Socket6 ^
IO::Socket::INET ^
IO::Socket::INET6 ^
IO::Socket::SSL ^
@ -33,16 +37,15 @@ FOR %%M in ( ^
Test::Pod ^
Unicode::String ^
URI::Escape ^
Crypt::OpenSSL::RSA ^
JSON ^
JSON::WebToken ^
LWP ^
HTML::Entities ^
JSON ^
) DO ECHO Updating %%M ^
& perl -MCPAN -e "install %%M"
) DO @perl -m%%M -e "print qq{Updating %%M $%%M::VERSION \n}" ^
& cpanm %%M
REM & perl -m%%M -e "" || perl -MCPAN -e "install %%M"
ECHO Perl modules for imapsync installed
ECHO Perl modules for imapsync updated
REM PAUSE

1
W/learn/10990.txt Normal file
View file

File diff suppressed because one or more lines are too long

450
W/learn/10_99.txt Normal file
View file

@ -0,0 +1,450 @@
10
Hello Guys
LLLLLLLLLL
END
11
Hello Guys
LLLLLLLLLLL
END
12
Hello Guys
LLLLLLLLLLLL
END
13
Hello Guys
LLLLLLLLLLLLL
END
14
Hello Guys
LLLLLLLLLLLLLL
END
15
Hello Guys
LLLLLLLLLLLLLLL
END
16
Hello Guys
LLLLLLLLLLLLLLLL
END
17
Hello Guys
LLLLLLLLLLLLLLLLL
END
18
Hello Guys
LLLLLLLLLLLLLLLLLL
END
19
Hello Guys
LLLLLLLLLLLLLLLLLLL
END
20
Hello Guys
LLLLLLLLLLLLLLLLLLLL
END
21
Hello Guys
LLLLLLLLLLLLLLLLLLLLL
END
22
Hello Guys
LLLLLLLLLLLLLLLLLLLLLL
END
23
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLL
END
24
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLL
END
25
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLL
END
26
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLL
END
27
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLL
END
28
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
29
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
30
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
31
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
32
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
33
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
34
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
35
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
36
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
37
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
38
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
39
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
40
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
41
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
42
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
43
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
44
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
45
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
46
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
47
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
48
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
49
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
50
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
51
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
52
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
53
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
54
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
55
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
56
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
57
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
58
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
59
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
60
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
61
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
62
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
63
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
64
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
65
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
66
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
67
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
68
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
69
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
70
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
71
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
72
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
73
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
74
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
75
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
76
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
77
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
78
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
79
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
80
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
81
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
82
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
83
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
84
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
85
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
86
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
87
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
88
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
89
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
90
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
91
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
92
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
93
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
94
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
95
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
96
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
97
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
98
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END
99
Hello Guys
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
END

14
W/learn/getoptlong Executable file
View file

@ -0,0 +1,14 @@
#!/usr/bin/perl -w
use strict ;
use Getopt::Long ;
use Data::Dumper ;
my %define ;
GetOptions (
"define=s" => \%define
) ;
print Dumper( \%define ) ;

46
W/learn/imap_rename_regex Executable file
View file

@ -0,0 +1,46 @@
#!/usr/bin/perl -w
# $Id: imap_rename_regex,v 1.5 2015/08/15 03:42:01 gilles Exp gilles $
use Mail::IMAPClient;
++$| ;
$ARGV[3] or die "usage: $0 host user password regex do_it\n";
my $host = $ARGV[0] ;
my $user = $ARGV[1] ;
my $password = $ARGV[2] ;
my $regex = $ARGV[3] ;
my $doit = $ARGV[4] || 0 ;
my $imap = Mail::IMAPClient->new( ) ;
$imap->Debug( 1 ) ;
$imap->Server( $host ) ;
$imap->Ssl( 1 ) ;
$imap->connect( ) or die ;
$imap->IsUnconnected( ) ;
$imap->User( $user ) ;
$imap->Password( $password ) ;
$imap->login( ) or die ;
$imap->Uid( 1 ) ;
$imap->Peek( 1 ) ;
my @folders = $imap->folders( ) ;
foreach my $folder ( @folders ) {
print "$folder\n" ;
my $folder_new = $folder ;
if ( eval( "\$folder_new =~ $regex" )
and ( $folder_new ne $folder ) ) {
print "Renaming [$folder] -> [$folder_new]\n" ;
$imap->noop( ) ;
if ( $doit and $imap->rename( $folder, $folder_new ) ) {
print "renamed ok [$folder] -> [$folder_new]\n" ;
}else{
print "KO renamed [$folder] -> [$folder_new]\n" ;
}
}
}
$imap->logout();

7
W/learn/imap_rename_regex_examples.txt Normal file
View file

@ -0,0 +1,7 @@
# Removing trailing blanks in folders names
./imap_rename_regex lamiral.info tata `cat /g/var/pass/secret.tata` 's,([^ ]+) +$,$1,'
#./imap_rename_regex lamiral.info tata `cat /g/var/pass/secret.tata` 's,([^ ]+) +$,$1,' doit

2
W/learn/imap_utf7_decode
View file

@ -19,11 +19,9 @@ sub imap_utf7_decode {
# On remplace , par / dans les BASE 64 (, entre & et -)
# On remplace les &, non suivi d'un - par +
# On remplace les &- par &
$s =~ s/\+/PLUSPLACEHOLDER/g;
$s =~ s/&([^,&\-]*),([^,\-&]*)\-/&$1\/$2\-/g;
$s =~ s/&(?!\-)/\+/g;
$s =~ s/&\-/&/g;
$s =~ s/PLUSPLACEHOLDER/+-/g;
return( Unicode::String::utf7( $s )->utf8 ) ;
}

23
W/learn/imap_utf7_encode Executable file
View file

@ -0,0 +1,23 @@
#!/usr/bin/perl
use Unicode::String ;
while (<>) {
chomp ;
push( @result, sprintf( "%s\n", imap_utf7_encode( $_ ) ) ) ;
}
print @result ;
# http://cpansearch.perl.org/src/FABPOT/Unicode-IMAPUtf7-2.01/lib/Unicode/IMAPUtf7.pm
sub imap_utf7_encode {
my ( $s ) = @_ ;
$s = Unicode::String::utf8( $s )->utf7 ;
$s =~ s/\+([^\/&\-]*)\/([^\/\-&]*)\-/\+$1,$2\-/g ;
$s =~ s/&/&\-/g ;
$s =~ s/\+([^+\-]+)?\-/&$1\-/g ;
return( $s ) ;
}

31
W/learn/imapclient_quota_qq Executable file
View file

@ -0,0 +1,31 @@
#!/usr/bin/perl -w
use lib '/g/public_html/imapsync/W/Mail-IMAPClient-3.37/lib/' ;
use Mail::IMAPClient;
$ARGV[3] or die "usage: $0 host user password quotaroot\n";
$host = $ARGV[0];
$user = $ARGV[1];
$password = $ARGV[2];
$quotaroot = $ARGV[3];
print "Mail::IMAPClient::VERSION $Mail::IMAPClient::VERSION\n" ;
my $imap = Mail::IMAPClient->new( ) ;
$imap->Debug( 1 ) ;
$imap->Server( $host ) ;
$imap->Ssl( 1 ) ;
$imap->Showcredentials( 0 ) ;
$imap->connect( ) or die ;
$imap->IsUnconnected( ) ;
$imap->User( $user ) ;
$imap->Password( $password ) ;
$imap->login( ) or die ;
$imap->Uid( 1 ) ;
$imap->Peek( 1 ) ;
$imap->getquotaroot( $quotaroot ) ;
$imap->getquota( '""' ) ;
$imap->logout( ) ;

4
W/learn/imapclient_quota_qq_memo Executable file
View file

@ -0,0 +1,4 @@
#!/bin/sh
./imapclient_quota_qq imap.gmail.com imapsync.gl@gmail.com `cat /g/var/pass/secret.imapsync.gl_gmail` INBOX

8
W/learn/imapclient3xx_skeleton_test → W/learn/imapclient_skeleton Executable file → Normal file
View file

@ -7,7 +7,7 @@ $ARGV[3] or die "usage: $0 host user password folder\n";
$host = $ARGV[0];
$user = $ARGV[1];
$password = $ARGV[2];
$folder = $ARGV[3];
$folder_arg = $ARGV[3];
my $imap = Mail::IMAPClient->new();
$imap->Debug(1);
@ -19,5 +19,9 @@ $imap->Password($password);
$imap->login() or die;
$imap->Uid(1);
$imap->Peek(1);
$imap->select($folder) or die;
my @folders = $imap->folders( ) ;
foreach my $folder ( @folders ) {
print "$folder\n" ;
}
$imap->select( $folder_arg ) or die ;
$imap->logout();

9
W/learn/increaseline Executable file
View file

@ -0,0 +1,9 @@
#!/bin/sh
# Generate messages with line lenght from 10 ... up to 99 characters
for M in `count 10 99`; do
echo $M
{ echo Hello Guys; echo ; perl -e "print 'L' x ${M}" ; echo; echo END; }
done

2
W/learn/mail2world
View file

@ -1,6 +1,6 @@
#!/usr/bin/perl -w
use lib '/g/public_html/imapsync/W/Mail-IMAPClient-3.35/lib/' ;
use lib '/g/public_html/imapsync/W/Mail-IMAPClient-3.37/lib/' ;
use Mail::IMAPClient ;
use Data::Dumper ;

15
W/learn/re_backslashb Executable file
View file

@ -0,0 +1,15 @@
#!/usr/bin/perl -w
if ( not( grep /\b\\Noselect\b/i, ('* LIST (\Noselect \HasChildren) "/" Archive') ) ) {
print "Selectable\n" ;
}else{
print "Not selectable\n" ;
}
if ( not( grep /\\Noselect\b/i, ('* LIST (\Noselect \HasChildren) "/" Archive') ) ) {
print "Selectable\n" ;
}else{
print "Not selectable\n" ;
}

0
W/livredor → W/livredor.txt
View file

102
W/memo
View file

@ -1,6 +1,6 @@
#!/bin/sh
# $Id: memo,v 1.52 2015/04/25 01:27:47 gilles Exp gilles $
# $Id: memo,v 1.60 2015/12/01 08:17:49 gilles Exp gilles $
count_nice() {
@ -119,7 +119,7 @@ verify_month_year() {
test -f "$fmy" || { echo "No $fmy" ; statistics_VERSION_monthly_ip ${month} ${year} ; }
test -f "$fmy" || { echo "No $fmy" ; return 1 ; }
fmy_YYYYmm=`date -r "$fmy" +%Y%m`
diff_month=`expr $fmy_YYYYmm - ${year}${month}`
diff_month=`expr $fmy_YYYYmm - ${year}${month}` || :
echo -n $diff_month
test "$diff_month" -ge 1 && echo " is enough" && return 0
echo " is not enough"
@ -136,7 +136,7 @@ verify_year() {
verify_month_year $month $year
done
statistics_VERSION_yearly_ip $year
statistics_VERSION_synthesis
statistics_VERSION_synthesis $year
}
@ -213,6 +213,7 @@ statistics_VERSION_yearly_runs() {
echo "statistics_VERSION_synthesis 2012 # short"
statistics_VERSION_synthesis() {
year=${1:-`date '+%Y'`}
year_now=`date '+%Y'`
(
cd /home/lf/glamiral/imapsync_stats
echo Nb users each month
@ -226,10 +227,14 @@ statistics_VERSION_synthesis() {
echo Nb users each year
wc -l stats_imapsync_????.ip
echo "Nb runs each year : "
for yyyy in `count_nice 2011 ${year}`; do
for yyyy in `count_nice 2011 ${year_now}`; do
echo -n "$yyyy: "
statistics_VERSION_yearly_runs $yyyy
done
nb_runs_current_year=`statistics_VERSION_yearly_runs $year_now`
current_day_of_year=`date +%j`
echo; echo -n "$year_now~~"
echo "$nb_runs_current_year/$current_day_of_year*365" | bc
)
}
@ -264,7 +269,7 @@ statistics_VERSION_monthly_ip() {
(
cd $HOME/imapsync_stats
ls access.log_${year}${month}??.imapsync_VERSION || return 1
cut -d ' ' -f 1,12,13,18,19 access.log_${year}${month}??.imapsync_VERSION |sort -n |uniq -c|sort -n > stats_imapsync_${year}_${month}.ip
cut -d ' ' -f 1,12,13,15,16,18,19 access.log_${year}${month}??.imapsync_VERSION |sort -n |uniq -c|sort -n > stats_imapsync_${year}_${month}.ip
)
}
@ -278,7 +283,7 @@ verify_month_year() {
test -f "$fmy" || { echo "No $fmy" ; statistics_VERSION_monthly_ip ${month} ${year} ; }
test -f "$fmy" || { echo "No $fmy" ; return 1 ; }
fmy_YYYYmm=`date -r "$fmy" +%Y%m`
diff_month=`expr $fmy_YYYYmm - ${year}${month}`
diff_month=`expr $fmy_YYYYmm - ${year}${month}` || :
echo -n $diff_month
test "$diff_month" -ge 1 && echo " is enough" && return 0
echo " is not enough"
@ -295,7 +300,7 @@ verify_year() {
verify_month_year $month $year
done
statistics_VERSION_yearly_ip $year
statistics_VERSION_synthesis
statistics_VERSION_synthesis $year
}
echo "statistics_VERSION_monthly_os 08 2012 # short"
@ -380,16 +385,49 @@ statistics_VERSION_monthly() {
}
echo "statistics_VERSION_yearly_ip 2012 # very long"
echo "statistics_VERSION_yearly_ip 2015 # very long"
statistics_VERSION_yearly_ip() {
year=${1:-`date '+%Y'`}
(
statistics_VERSION_getstats
cd $HOME/imapsync_stats
cut -d ' ' -f 1,12,13,18,19 access.log_${year}????.imapsync_VERSION |sort -n |uniq -c|sort -n > stats_imapsync_${year}.ip
cut -d ' ' -f 1,12,13,15,16,18,19 access.log_${year}????.imapsync_VERSION |sort -n |uniq -c|sort -n > stats_imapsync_${year}.ip
)
}
echo "statistics_VERSION_yearly_ip_resolved 2015 # very long"
statistics_VERSION_yearly_ip_resolved() {
year=${1:-`date '+%Y'`}
today=`date +%Y_%m_%d`
(
cd $HOME/imapsync_stats
mkdir -p daily
cat stats_imapsync_${year}.ip | awk '{ count=$1; ip=$2; $1=""; print $2 " " $0 " " count ; }' \
| webresolve > daily/stats_imapsync_${year}.ip.resolved.${today}.txt
)
}
echo "statistics_VERSION_yearly_ip_geo 2015 # long"
statistics_VERSION_yearly_ip_geo() {
year=${1:-`date '+%Y'`}
today=`date +%Y_%m_%d`
(
cd $HOME/imapsync_stats
awk '{ print $2 }' stats_imapsync_${year}.ip | xargs -n1 geoiplookup | sort | uniq -c | sort -n > stats_imapsync_${year}.ipgeo
)
}
echo "statistics_VERSION_all_years_ip_geo # long"
statistics_VERSION_all_years_ip_geo() {
(
cd $HOME/imapsync_stats
awk '{ print $2 }' stats_imapsync_20??.ip | xargs -n1 geoiplookup | sort | uniq -c | sort -n > stats_imapsync_20xx.ipgeo
)
}
statistics_VERSION_yearly_runs() {
year=${1:-`date '+%Y'`}
(
@ -414,20 +452,56 @@ statistics_releases_yearly() {
year=${1:-`date '+%Y'`}
(
cd $HOME/imapsync_stats
test -f stats_imapsync_${year}.ip && grep -o -P imapsync/'1\.\d{3}' stats_imapsync_${year}.ip | grep -o -P '1\.\d{3}' | sort -n | uniq -c | sort -n
test -f stats_imapsync_${year}.ip \
&& grep -o -P imapsync/'1\.\d{3}' stats_imapsync_${year}.ip \
| grep -o -P '1\.\d{3}' | sort -n | uniq -c | sort -n
)
}
# releasecheck started on 1.349 in the imapsync code. date: 2010/09/06 00:25:03
# Disable releasecheck started on 1.584 on github Mar 5, 2014
# https://github.com/imapsync/imapsync/commits/master/imapsync
statistics_releases_all_times() {
year=${1:-`date '+%Y'`}
(
cd $HOME/imapsync_stats
grep -o -P imapsync/'1\.\d{3}' stats_imapsync_20??.ip | grep -o -P '1\.\d{3}' | sort -n | uniq -c | sort -n
grep -h -o -P imapsync/'1\.\d{3}' stats_imapsync_20??.ip \
| grep -o -P '1\.\d{3}' | sort -n | uniq -c | sort -n
)
}
statistics_perl_monthly() {
month=${1:-`date '+%m'`}
year=${2:-`date '+%Y'`}
(
cd $HOME/imapsync_stats
test -f stats_imapsync_${year}_${month}.ip \
&& grep -o -P 'perl ''(\.|\d)+' stats_imapsync_${year}_${month}.ip \
| grep -o -P '(\.|\d)+' | sort -n | uniq -c | sort -n
)
}
statistics_perl_yearly() {
year=${1:-`date '+%Y'`}
(
cd $HOME/imapsync_stats
test -f stats_imapsync_${year}.ip \
&& grep -o -P 'perl ''(\.|\d)+' stats_imapsync_${year}.ip \
| grep -o -P '(\.|\d)+' | sort -n | uniq -c | sort -n
)
}
statistics_perl_all() {
(
cd $HOME/imapsync_stats
ls -d stats_imapsync_????.ip > /dev/null || return
grep -h -o -P 'perl ''(\.|\d)+' stats_imapsync_20??.ip \
| grep -o -P '(\.|\d)+' | sort -n | uniq -c | sort -nr
)
}
@ -446,6 +520,8 @@ statistics_VERSION_synthesis() {
done
echo && echo "==== % Operating systems in ${year} "
statistics_VERSION_yearly_os $year
echo && echo "==== Perl releases in ${year} "
statistics_perl_yearly $year | tail -9
echo && echo "==== Biggest users in ${year} "
tail -n 9 stats_imapsync_${year}.ip
echo && echo "==== Most releases used in ${year} "
@ -464,6 +540,8 @@ statistics_VERSION_synthesis() {
)
}
}
test X"`hostname`" = Xks2 && statistics_VERSION_ks
@ -491,7 +569,7 @@ else
<news date="`date '+%Y%m%d'`">
`LANG=fr_FR date '+%A %d %B %Y'` : Synchronisez ou migrez vos boites
aux lettres avec économie et l'outil <A
aux lettres avec \E9conomie et l'outil <A
HREF="prj/imapsync/">imapsync $VERSION</A> (Gilles LAMIRAL)
</news>
EOF

6
W/paypal.shtml
View file

@ -35,9 +35,7 @@ border:0px;
<body>
<h1>imapsync donation</h1>
<p>Help the author to maintain imapsync:<br/>
(<b>1 EUR ~ 1.3 USD</b> on 06/2012)
</p>
<p>Help the author to maintain imapsync:</p>
<form action="https://www.paypal.com/cgi-bin/webscr" method="post">
<p>
<input type="hidden" name="cmd" value="_s-xclick"/>
@ -65,7 +63,7 @@ border:0px;
<!--#config timefmt="%D" -->
<!--#config timefmt="%A %B %d, %Y" -->
<b>This document last modified on <!--#echo var="LAST_MODIFIED" --></b>
($Id: paypal.shtml,v 1.7 2012/06/10 09:06:46 gilles Exp gilles $)
($Id: paypal.shtml,v 1.8 2015/09/19 08:21:46 gilles Exp gilles $)
</p>
</body>

82
W/paypal_reply/imapsync_sold_by_country.txt Normal file
View file

@ -0,0 +1,82 @@
1113 Etats-Unis_d'Amerique___ 26.13 % 26.13 % 1
774 Allemagne_______________ 18.17 % 44.31 % 2
399 Royaume-Uni_____________ 9.37 % 53.67 % 3
203 France__________________ 4.77 % 58.44 % 4
198 Italie__________________ 4.65 % 63.09 % 5
188 Canada__________________ 4.41 % 67.50 % 6
173 Suisse__________________ 4.06 % 71.57 % 7
146 Pays-Bas________________ 3.43 % 74.99 % 8
146 Australie_______________ 3.43 % 78.42 % 9
89 Autriche________________ 2.09 % 80.51 % 10
78 Belgique________________ 1.83 % 82.34 % 11
72 Espagne_________________ 1.69 % 84.03 % 12
63 Suede___________________ 1.48 % 85.51 % 13
50 Danemark________________ 1.17 % 86.69 % 14
48 Bresil__________________ 1.13 % 87.81 % 15
40 Norvege_________________ 0.94 % 88.75 % 16
31 Finlande________________ 0.73 % 89.48 % 17
25 Japon___________________ 0.59 % 90.07 % 18
25 ________________________ 0.59 % 90.66 % 19
24 Republique_tcheque______ 0.56 % 91.22 % 20
24 Pologne_________________ 0.56 % 91.78 % 21
22 Russie__________________ 0.52 % 92.30 % 22
21 Irlande_________________ 0.49 % 92.79 % 23
19 Nouvelle-Zelande________ 0.45 % 93.24 % 24
18 Hongrie_________________ 0.42 % 93.66 % 25
14 Portugal________________ 0.33 % 93.99 % 26
14 Hong-Kong_______________ 0.33 % 94.32 % 27
14 Afrique_du_Sud__________ 0.33 % 94.65 % 28
13 Malaisie________________ 0.31 % 94.95 % 29
12 Luxembourg______________ 0.28 % 95.23 % 30
12 Inde____________________ 0.28 % 95.52 % 31
12 Grece___________________ 0.28 % 95.80 % 32
12 Argentine_______________ 0.28 % 96.08 % 33
11 Slovaquie_______________ 0.26 % 96.34 % 34
11 Singapour_______________ 0.26 % 96.60 % 35
11 Chine___________________ 0.26 % 96.85 % 36
10 Mexique_________________ 0.23 % 97.09 % 37
10 Israel__________________ 0.23 % 97.32 % 38
10 Chili___________________ 0.23 % 97.56 % 39
8 Slovenie________________ 0.19 % 97.75 % 40
8 Roumanie________________ 0.19 % 97.93 % 41
8 Emirats_Arabes_Unis_____ 0.19 % 98.12 % 42
7 Lettonie________________ 0.16 % 98.29 % 43
5 Thailande_______________ 0.12 % 98.40 % 44
5 Malte___________________ 0.12 % 98.52 % 45
5 Islande_________________ 0.12 % 98.64 % 46
4 Indonesie_______________ 0.09 % 98.73 % 47
4 Egypte__________________ 0.09 % 98.83 % 48
3 Venezuela_______________ 0.07 % 98.90 % 49
3 Turquie_________________ 0.07 % 98.97 % 50
3 Philippines_____________ 0.07 % 99.04 % 51
3 Estonie_________________ 0.07 % 99.11 % 52
3 Croatie_________________ 0.07 % 99.18 % 53
3 Bulgarie________________ 0.07 % 99.25 % 54
2 Vietnam_________________ 0.05 % 99.30 % 55
2 Uruguay_________________ 0.05 % 99.34 % 56
2 Lituanie________________ 0.05 % 99.39 % 57
2 Costa_Rica______________ 0.05 % 99.44 % 58
2 Chypre__________________ 0.05 % 99.48 % 59
1 Ukraine_________________ 0.02 % 99.51 % 60
1 Trinite-et-Tobago_______ 0.02 % 99.53 % 61
1 Tanzanie________________ 0.02 % 99.55 % 62
1 Taiwan__________________ 0.02 % 99.58 % 63
1 Serbie__________________ 0.02 % 99.60 % 64
1 Senegal_________________ 0.02 % 99.62 % 65
1 Saint_Christophe-Nevis-Anguilla__ 0.02 % 99.65 % 66
1 Qatar___________________ 0.02 % 99.67 % 67
1 Perou___________________ 0.02 % 99.69 % 68
1 Panama__________________ 0.02 % 99.72 % 69
1 Nouvelle-Caledonie______ 0.02 % 99.74 % 70
1 Nigeria_________________ 0.02 % 99.77 % 71
1 Namibie_________________ 0.02 % 99.79 % 72
1 Mongolie________________ 0.02 % 99.81 % 73
1 Moldavie________________ 0.02 % 99.84 % 74
1 Maldives________________ 0.02 % 99.86 % 75
1 Îles_Vierges_britanniques__ 0.02 % 99.88 % 76
1 Koweit__________________ 0.02 % 99.91 % 77
1 Jordanie________________ 0.02 % 99.93 % 78
1 Colombie________________ 0.02 % 99.95 % 79
1 Bahrein_________________ 0.02 % 99.98 % 80
1 Antilles_neerlandaises__ 0.02 % 100.00 % 81
TOTAL = 4259 sales over 81 countries on Mon Oct 26 02:15:08 CET 2015

29
W/paypal_reply/memo Normal file → Executable file
View file

@ -28,6 +28,35 @@ Europe a un autre assujetti : Article 262 ter => Exoneration
EOF
}
echo paypal_bilan_licence_support_only_csv
paypal_bilan_licence_support_only_csv() {
# DID output diff between paypal_bilan_1.79 and next
(
#set -x
perl -c /g/public_html/imapsync/W/paypal_reply/paypal_bilan || return 1
cd /g/var/paypal_bilan_support_only/ || return 1
/g/public_html/imapsync/W/paypal_reply/paypal_bilan_1.79 \
--debug --debug_csv --debug_email --details --debug_invoice \
--dir_invoices /g/var/paypal_invoices_dev --write_invoices --first_in 30001 \
2015_08.csv \
> 2015_08.out1 2>&1 || return 1
/g/public_html/imapsync/W/paypal_reply/paypal_bilan \
--debug --debug_csv --debug_email --details --debug_invoice \
--dir_invoices /g/var/paypal_invoices_dev --write_invoices --first_in 30001 \
2015_08.csv \
> 2015_08.out2 2>&1 || return 1
echo diff 2015_08.out1 2015_08.out2
diff 2015_08.out1 2015_08.out2
)
}
echo paypal_bilan_licence_support_same_button_04_2014_04_csv
paypal_bilan_licence_support_same_button_04_2014_04_csv() {
# DID output diff between paypal_bilan_1.78 and next

28
W/paypal_reply/paypal_bilan
View file

@ -1,6 +1,6 @@
#!/usr/bin/perl
# $Id: paypal_bilan,v 1.78 2014/05/04 02:01:26 gilles Exp gilles $
# $Id: paypal_bilan,v 1.80 2015/11/01 01:13:59 gilles Exp gilles $
use strict;
use warnings;
@ -13,7 +13,7 @@ use Test::More 'no_plan' ;
die unless (utf8_supported_charset('ISO-8859-1'));
my $rcs = '$Id: paypal_bilan,v 1.78 2014/05/04 02:01:26 gilles Exp gilles $ ' ;
my $rcs = '$Id: paypal_bilan,v 1.80 2015/11/01 01:13:59 gilles Exp gilles $ ' ;
$rcs =~ m/,v (\d+\.\d+)/ ;
my $VERSION = ($1) ? $1: "UNKNOWN" ;
@ -424,7 +424,7 @@ sub compute_line_debug {
return( "#" x 78, "\n",
"[$A->{Date}] [$A->{Heure}] [$A->{Fuseau_horaire}] [$A->{Nom}] [$A->{Type}] [$A->{Etat}] ",
"[$A->{Devise}] [$A->{Hors_taxe_paypal}] [$A->{Montant}] [$A->{Numero_davis_de_reception}] [$A->{Solde}] [$A->{Impact_sur_le_solde}] ",
"[$A->{Devise}] [$A->{Hors_taxe_paypal}] [$A->{Montant}] [$A->{N_de_transaction}] [$A->{Solde}] [$A->{Impact_sur_le_solde}] ",
"[$A->{Pays}] [$A->{Nom_Option_1}] [$A->{Valeur_Option_1}] [$A->{Titre_de_l_objet}]\n" ) ;
}
@ -445,7 +445,7 @@ sub details {
return( "[$A->{invoice}] [$A->{Date}] [$A->{Heure}] [$A->{Fuseau_horaire}] ",
"[$A->{Nom}] [$A->{Type}] [$A->{Etat}] [$A->{Devise}] [$A->{Montant}] ",
"[$A->{Numero_davis_de_reception}] [$A->{Solde}] [$A->{Impact_sur_le_solde}]\n" ) ;
"[$A->{N_de_transaction}] [$A->{Solde}] [$A->{Impact_sur_le_solde}]\n" ) ;
}
@ -579,13 +579,13 @@ sub compute_line {
@{$A}{ qw(
Date Heure Fuseau_horaire Nom Type Etat
Devise Montant Numero_davis_de_reception Solde
Devise Montant N_de_transaction Solde
Pays Nom_Option_1 Valeur_Option_1 Hors_taxe_paypal
Titre_de_l_objet Nom_Option_2 Option_2_Valeur
Impact_sur_le_solde
) }
= @action{ ( 'Date', 'Heure', 'Fuseau horaire', 'Nom', 'Type', 'Etat',
'Devise', 'Montant', "Numéro d'avis de réception", 'Solde',
'Devise', 'Montant', "N° de transaction", 'Solde',
'Pays', 'Nom Option 1', 'Valeur Option 1', 'Hors taxe',
"Titre de l'objet", 'Nom Option 2', 'Option 2 Valeur',
'Impact sur le solde') } ;
@ -862,6 +862,9 @@ sub object_type {
}elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} )
and ( 'Software only. For individual use.' eq $F->{Valeur_Option_1} ) ) {
$F->{object_type} = 'software' ;
}elsif ( ( 'imapsync any' eq $F->{Titre_de_l_objet} )
and ( 'Support only. For professional use.' eq $F->{Valeur_Option_1} ) ) {
$F->{object_type} = 'support' ;
}
}
@ -1013,13 +1016,12 @@ sub write_tex_variables_file {
close( FILE ) ;
if ( ! -f "$dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) {
open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_manual.tex") or die ;
print FILE "%% $0 created this file
open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_manual.tex") or die ;
print FILE "%% $0 created this file
%% Can be used to override imapsync_var.tex definitions\n" ;
print FILE $tex_variables_utf8 ;
close( FILE ) ;
print FILE $tex_variables_utf8 ;
close( FILE ) ;
}
}
sub download_urls {
@ -1031,7 +1033,9 @@ sub download_urls {
and (
( 'software' eq $F->{object_type} )
or
( 'software + support' eq $F->{object_type} )
( 'software + support' eq $F->{object_type} )
or
( 'support' eq $F->{object_type} )
)
) {
$F->{urlSrc} = 'http://imapsync.lamiral.info/paypal_return.shtml' ;

1445
W/paypal_reply/paypal_bilan_1.78 Executable file
View file

File diff suppressed because it is too large Load diff

1445
W/paypal_reply/paypal_bilan_1.79 Executable file
View file

File diff suppressed because it is too large Load diff

22
W/paypal_reply/paypal_build_invoices
View file

@ -1,6 +1,6 @@
#!/bin/sh
# $Id: paypal_build_invoices,v 1.94 2015/07/15 00:55:25 gilles Exp gilles $
# $Id: paypal_build_invoices,v 1.99 2015/11/25 18:53:08 gilles Exp gilles $
# usage: sh paypal_build_invoices /g/var/paypal_invoices/????
@ -66,9 +66,13 @@ cp /home/gilles/public_html/AGIL/factures/000/facture_imapsync-000.tex /g/var/pa
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4031 /g/paypal/paypal_2015_04_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4085 /g/paypal/paypal_2015_05_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4139 /g/paypal/paypal_2015_06_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4196 /g/paypal/paypal_2015_07_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4263 /g/paypal/paypal_2015_08_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4317 /g/paypal/paypal_2015_09_complet.csv
#/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4383 /g/paypal/paypal_2015_10_complet.csv
set -x
/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4196 /g/paypal/paypal_2015_07_complet.csv
/g/public_html/imapsync/W/paypal_reply/paypal_bilan --write_invoices --first_in 4451 /g/paypal/paypal_2015_11_complet.csv
set +x
@ -131,9 +135,13 @@ set +x
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4031 /g/paypal/paypal_2015_04_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4085 /g/paypal/paypal_2015_05_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4139 /g/paypal/paypal_2015_06_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4196 /g/paypal/paypal_2015_07_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4263 /g/paypal/paypal_2015_08_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4317 /g/paypal/paypal_2015_09_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4383 /g/paypal/paypal_2015_10_complet.csv
set -x
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4196 /g/paypal/paypal_2015_07_complet.csv
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan --first_in 4451 /g/paypal/paypal_2015_11_complet.csv
set +x
# La totale
@ -143,7 +151,7 @@ set +x
1330 1331 1332 1333 1334 1652 1653 2131 2132
2295 2296 2297 2298 2625 2626 2970 2971 2972
3093 3296 3411 3412 3450 3451 3614 3615 3616 3617
3807 3808 3957 3958 4030' \
3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450' \
/g/paypal/paypal_201?_??_complet.csv
#set -v
@ -152,7 +160,7 @@ set +x
1330 1331 1332 1333 1334 1652 1653 2131 2132
2295 2296 2297 2298 2625 2626 2970 2971 2972
3093 3296 3411 3412 3450 3451 3614 3615 3616 3617
3807 3808 3957 3958 4030' \
3807 3808 3957 3958 4030 4194 4195 4381 4382 4449 4450' \
/g/paypal/paypal_201?_??_complet.csv
#set +v
@ -188,13 +196,11 @@ set +x
#echo 2015 : ( from 3809 to ???? ) EUR
#set -v
: /g/public_html/imapsync/W/paypal_reply/paypal_bilan \
--first_in 3809 --avoid_numbers '3807 3808 3957 3958 4030' \
--first_in 3809 --avoid_numbers '3807 3808 3957 3958 4030 4194 4195 4381 4382' \
/g/paypal/paypal_2015_??_complet.csv
#set +v
echo 'sh paypal_build_invoices /g/var/paypal_invoices/4???'
# USD de 147 à 340

2646
W/perlcritic_1.out Normal file
View file

File diff suppressed because it is too large Load diff

1492
W/perlcritic_2.out
View file

File diff suppressed because it is too large Load diff

162
W/perlcritic_3.out
View file

@ -1,87 +1,77 @@
Main code has high complexity score (387) at line 1, column 1. Consider refactoring. (Severity: 3)
Literal line breaks in a string at line 918, column 1. See pages 60,61 of PBP. (Severity: 3)
Literal line breaks in a string at line 930, column 1. See pages 60,61 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 1112, column 33. See page 236 of PBP. (Severity: 3)
Main code has high complexity score (400) at line 1, column 1. Consider refactoring. (Severity: 3)
Regular expression without "/x" flag at line 1121, column 33. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 1138, column 18. See page 236 of PBP. (Severity: 3)
Literal line breaks in a string at line 1212, column 1. See pages 60,61 of PBP. (Severity: 3)
Literal line breaks in a string at line 1245, column 1. See pages 60,61 of PBP. (Severity: 3)
Code structure is deeply nested at line 1613, column 41. Consider refactoring. (Severity: 3)
Literal line breaks in a string at line 1761, column 1. See pages 60,61 of PBP. (Severity: 3)
Subroutine "errors_incr" does not end with "return" at line 1783, column 1. See page 197 of PBP. (Severity: 4)
Subroutine "tests_live_result" does not end with "return" at line 1808, column 1. See page 197 of PBP. (Severity: 4)
Reused variable name in lexical scope: $nb_errors at line 1809, column 2. Invent unique variable names. (Severity: 3)
Subroutine "foldersizesatend" does not end with "return" at line 1817, column 1. See page 197 of PBP. (Severity: 4)
Too many arguments at line 1843, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 1861, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 1871, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "modules_VERSION" with high complexity score (21) at line 1989, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 2121, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2182, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "authenticate_imap" with high complexity score (21) at line 2243, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 2243, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2347, column 1. See page 182 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2420, column 51. See page 236 of PBP. (Severity: 3)
Backtick operator used at line 2428, column 12. Use IPC::Open3 instead. (Severity: 3)
Subroutine "is_valid_directory" does not end with "return" at line 2558, column 1. See page 197 of PBP. (Severity: 4)
Close filehandles as soon as possible after opening them at line 2578, column 2. See page 209 of PBP. (Severity: 4)
Subroutine "remove_tmp_files" does not end with "return" at line 2589, column 1. See page 197 of PBP. (Severity: 4)
"die" used instead of "croak" at line 2603, column 2. See page 283 of PBP. (Severity: 3)
Always unpack @_ first at line 2704, column 1. See page 178 of PBP. (Severity: 4)
Regular expression without "/x" flag at line 2711, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2712, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2713, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2739, column 31. See page 236 of PBP. (Severity: 3)
Reused variable name in lexical scope: $imap2 at line 2799, column 9. Invent unique variable names. (Severity: 3)
Regular expression without "/x" flag at line 2818, column 25. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2821, column 20. See page 236 of PBP. (Severity: 3)
Mixed high and low-precedence booleans at line 2822, column 13. See page 70 of PBP. (Severity: 4)
Expression form of "eval" at line 3263, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 3489, column 13. See page 161 of PBP. (Severity: 5)
Subroutine "select_msgs" does not end with "return" at line 3630, column 1. See page 197 of PBP. (Severity: 4)
Subroutine "tests_msgs_from_maxmin" does not end with "return" at line 3771, column 1. See page 197 of PBP. (Severity: 4)
Subroutine "copy_message" with high complexity score (25) at line 3848, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 3848, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 3926, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 3960, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "tests_subject" does not end with "return" at line 4087, column 1. See page 197 of PBP. (Severity: 4)
Too many arguments at line 4150, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "sleep_if_needed" does not end with "return" at line 4211, column 1. See page 197 of PBP. (Severity: 4)
Reused variable name in lexical scope: $total_bytes_transferred at line 4212, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $nb_msg_transferred at line 4212, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $nb_msg_transferred at line 4224, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $maxmessagespersecond at line 4224, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $total_bytes_transferred at line 4245, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $maxbytespersecond at line 4245, column 9. Invent unique variable names. (Severity: 3)
Hard tabs used at line 4830, column 10. See page 20 of PBP. (Severity: 3)
Expression form of "eval" at line 5434, column 13. See page 161 of PBP. (Severity: 5)
Regular expression without "/x" flag at line 5669, column 22. See page 236 of PBP. (Severity: 3)
Expression form of "eval" at line 5674, column 13. See page 161 of PBP. (Severity: 5)
Too many arguments at line 5838, column 1. See page 182 of PBP. (Severity: 3)
Always unpack @_ first at line 6000, column 1. See page 178 of PBP. (Severity: 4)
Backtick operator used at line 6007, column 4. Use IPC::Open3 instead. (Severity: 3)
Subroutine "tests_pipemess" does not end with "return" at line 6024, column 1. See page 197 of PBP. (Severity: 4)
Backtick operator used at line 6213, column 12. Use IPC::Open3 instead. (Severity: 3)
Backtick operator used at line 6233, column 11. Use IPC::Open3 instead. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6373, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6399, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6428, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6440, column 12. See page 261 of PBP. (Severity: 3)
Expression form of "eval" at line 6546, column 43. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 6550, column 45. See page 161 of PBP. (Severity: 5)
Split long regexps into smaller qr// chunks at line 6755, column 20. See page 261 of PBP. (Severity: 3)
"$i" is declared but not used at line 6814, column 9. Unused variables clutter code and make it harder to read. (Severity: 3)
Magic variable "$ENV" should be assigned as "local" at line 6861, column 12. See pages 81,82 of PBP. (Severity: 4)
Magic variable "$ENV" should be assigned as "local" at line 6869, column 12. See pages 81,82 of PBP. (Severity: 4)
Test without a label at line 6876, column 2. Add a label argument to all Test::More functions. (Severity: 3)
Test without a label at line 6877, column 2. Add a label argument to all Test::More functions. (Severity: 3)
Reused variable name in lexical scope: $logfile at line 6882, column 2. Invent unique variable names. (Severity: 3)
Subroutine "teelaunch" does not end with "return" at line 6889, column 1. See page 197 of PBP. (Severity: 4)
Reused variable name in lexical scope: $logfile at line 6890, column 2. Invent unique variable names. (Severity: 3)
Close filehandles as soon as possible after opening them at line 6893, column 2. See page 209 of PBP. (Severity: 4)
"die" used instead of "croak" at line 6894, column 7. See page 283 of PBP. (Severity: 3)
Magic variable "*STDERR" should be assigned as "local" at line 6896, column 10. See pages 81,82 of PBP. (Severity: 4)
One-argument "select" used at line 6897, column 2. See page 224 of PBP. (Severity: 4)
Subroutine "testslive" does not end with "return" at line 7387, column 1. See page 197 of PBP. (Severity: 4)
Return value of eval not tested at line 7409, column 17. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3)
Return value of eval not tested at line 7448, column 17. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3)
Regular expression without "/x" flag at line 1130, column 33. See page 236 of PBP. (Severity: 3)
Code structure is deeply nested at line 1651, column 41. Consider refactoring. (Severity: 3)
Reused variable name in lexical scope: $sync at line 1823, column 2. Invent unique variable names. (Severity: 3)
Hard tabs used at line 1849, column 22. See page 20 of PBP. (Severity: 3)
Reused variable name in lexical scope: $sync at line 1933, column 2. Invent unique variable names. (Severity: 3)
Regular expression without "/x" flag at line 1982, column 29. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2004, column 31. See page 236 of PBP. (Severity: 3)
Reused variable name in lexical scope: $sync at line 2013, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $sync at line 2036, column 2. Invent unique variable names. (Severity: 3)
Regular expression without "/x" flag at line 2069, column 30. See page 236 of PBP. (Severity: 3)
Reused variable name in lexical scope: $sync at line 2080, column 53. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $sync at line 2088, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $sync at line 2136, column 2. Invent unique variable names. (Severity: 3)
Regular expression without "/x" flag at line 2172, column 26. See page 236 of PBP. (Severity: 3)
Reused variable name in lexical scope: $nb_errors at line 2220, column 2. Invent unique variable names. (Severity: 3)
Too many arguments at line 2256, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2274, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2284, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "modules_VERSION" with high complexity score (25) at line 2401, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 2570, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2603, column 1. See page 182 of PBP. (Severity: 3)
Subroutine "authenticate_imap" with high complexity score (21) at line 2671, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 2671, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 2776, column 1. See page 182 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 2850, column 51. See page 236 of PBP. (Severity: 3)
Backtick operator used at line 2858, column 12. Use IPC::Open3 instead. (Severity: 3)
Return value of eval not tested at line 2992, column 2. You can't depend upon the value of $@/$EVAL_ERROR to tell whether an eval failed. (Severity: 3)
"die" used instead of "croak" at line 3037, column 2. See page 283 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3145, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3146, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3147, column 15. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3156, column 8. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3157, column 8. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3158, column 8. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3184, column 31. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3261, column 25. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3264, column 20. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3465, column 24. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3466, column 19. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3470, column 19. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3540, column 39. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3541, column 39. See page 236 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 3542, column 41. See page 236 of PBP. (Severity: 3)
Hard tabs used at line 3556, column 106. See page 20 of PBP. (Severity: 3)
Expression form of "eval" at line 3796, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 4026, column 13. See page 161 of PBP. (Severity: 5)
Subroutine "copy_message" with high complexity score (25) at line 4389, column 1. Consider refactoring. (Severity: 3)
Too many arguments at line 4389, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 4467, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 4501, column 1. See page 182 of PBP. (Severity: 3)
Too many arguments at line 4690, column 1. See page 182 of PBP. (Severity: 3)
Reused variable name in lexical scope: $total_bytes_transferred at line 4751, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $nb_msg_transferred at line 4751, column 2. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $nb_msg_transferred at line 4764, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $maxmessagespersecond at line 4764, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $total_bytes_transferred at line 4785, column 9. Invent unique variable names. (Severity: 3)
Reused variable name in lexical scope: $maxbytespersecond at line 4785, column 9. Invent unique variable names. (Severity: 3)
Expression form of "eval" at line 5972, column 13. See page 161 of PBP. (Severity: 5)
Regular expression without "/x" flag at line 6207, column 22. See page 236 of PBP. (Severity: 3)
Expression form of "eval" at line 6212, column 13. See page 161 of PBP. (Severity: 5)
Too many arguments at line 6376, column 1. See page 182 of PBP. (Severity: 3)
Backtick operator used at line 6543, column 4. Use IPC::Open3 instead. (Severity: 3)
Backtick operator used at line 6750, column 12. Use IPC::Open3 instead. (Severity: 3)
Backtick operator used at line 6770, column 11. Use IPC::Open3 instead. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6932, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6958, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 6999, column 12. See page 261 of PBP. (Severity: 3)
Split long regexps into smaller qr// chunks at line 7011, column 12. See page 261 of PBP. (Severity: 3)
Expression form of "eval" at line 7117, column 43. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 7121, column 45. See page 161 of PBP. (Severity: 5)
Split long regexps into smaller qr// chunks at line 7326, column 20. See page 261 of PBP. (Severity: 3)
Regular expression without "/x" flag at line 7493, column 19. See page 236 of PBP. (Severity: 3)
Close filehandles as soon as possible after opening them at line 7537, column 2. See page 209 of PBP. (Severity: 4)
Magic variable "*STDERR" should be assigned as "local" at line 7540, column 10. See pages 81,82 of PBP. (Severity: 4)
One-argument "select" used at line 7541, column 2. See page 224 of PBP. (Severity: 4)

9
W/perlcritic_4.out Normal file
View file

@ -0,0 +1,9 @@
Expression form of "eval" at line 3796, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 4026, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 5972, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 6212, column 13. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 7117, column 43. See page 161 of PBP. (Severity: 5)
Expression form of "eval" at line 7121, column 45. See page 161 of PBP. (Severity: 5)
Close filehandles as soon as possible after opening them at line 7537, column 2. See page 209 of PBP. (Severity: 4)
Magic variable "*STDERR" should be assigned as "local" at line 7540, column 10. See pages 81,82 of PBP. (Severity: 4)
One-argument "select" used at line 7541, column 2. See page 224 of PBP. (Severity: 4)

4
W/prereq.Ubuntu
View file

@ -1,11 +1,11 @@
$SHELL says /bin/bash
$0 gives ./INSTALL.d/prerequisites_imapsync
ps -ef gives gilles 9123 9122 0 20:33 pts/28 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync
ps -ef gives gilles 4983 4982 0 03:58 pts/18 00:00:00 /bin/sh ./INSTALL.d/prerequisites_imapsync
Distributor ID: Ubuntu
Description: Ubuntu 12.04.5 LTS
Release: 12.04
Codename: precise
Linux petite 3.2.0-84-generic #121-Ubuntu SMP Tue May 5 18:55:46 UTC 2015 i686 i686 i386 GNU/Linux
Linux petite 3.2.0-91-generic #129-Ubuntu SMP Wed Sep 9 10:56:56 UTC 2015 i686 i686 i386 GNU/Linux
Ok: Found Perl 5.14.2
Ok: Found Perl module Digest::HMAC_MD5
Ok: Found Perl module Authen::NTLM

451
W/prereq.scandeps
View file

@ -2,242 +2,252 @@
usage: imapsync [options]
Several options are mandatory.
str means string
int means integer
reg means regular expression
cmd means command
--dry : Makes imapsync doing nothing, just print what would
be done without --dry.
--dry : Makes imapsync doing nothing, just print what would
be done without --dry.
--host1 <string> : Source or "from" imap server. Mandatory.
--port1 <int> : Port to connect on host1. Default is 143, 993 if --ssl1
--user1 <string> : User to login on host1. Mandatory.
--showpasswords : Shows passwords on output instead of "MASKED".
Useful to restart a complete run by just reading the log.
--password1 <string> : Password for the user1.
--host2 <string> : "destination" imap server. Mandatory.
--port2 <int> : Port to connect on host2. Default is 143, 993 if --ssl2
--user2 <string> : User to login on host2. Mandatory.
--password2 <string> : Password for the user2.
--host1 str : Source or "from" imap server. Mandatory.
--port1 int : Port to connect on host1. Default is 143, 993 if --ssl1
--user1 str : User to login on host1. Mandatory.
--showpasswords : Shows passwords on output instead of "MASKED".
Useful to restart a complete run by just reading the log.
--password1 str : Password for the user1.
--host2 str : "destination" imap server. Mandatory.
--port2 int : Port to connect on host2. Default is 143, 993 if --ssl2
--user2 str : User to login on host2. Mandatory.
--password2 str : Password for the user2.
--passfile1 <string> : Password file for the user1. It must contain the
password on the first line. This option avoids to show
the password on the command line like --password1 does.
--passfile2 <string> : Password file for the user2. Contains the password.
--passfile1 str : Password file for the user1. It must contain the
password on the first line. This option avoids to show
the password on the command line like --password1 does.
--passfile2 str : Password file for the user2. Contains the password.
--ssl1 : Use a SSL connection on host1.
--ssl2 : Use a SSL connection on host2.
--tls1 : Use a TLS connection on host1.
--tls2 : Use a TLS connection on host2.
--timeout <int> : Connections timeout in seconds. Default is 120.
0 means no timeout.
--ssl1 : Use a SSL connection on host1.
--ssl2 : Use a SSL connection on host2.
--tls1 : Use a TLS connection on host1.
--tls2 : Use a TLS connection on host2.
--timeout int : Connections timeout in seconds. Default is 120.
0 means no timeout.
--authmech1 <string> : Auth mechanism to use with host1:
PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
--authmech2 <string> : Auth mechanism to use with host2. See --authmech1
--authmech1 str : Auth mechanism to use with host1:
PLAIN, LOGIN, CRAM-MD5 etc. Use UPPERCASE.
--authmech2 str : Auth mechanism to use with host2. See --authmech1
--authuser1 <string> : User to auth with on host1 (admin user).
Avoid using --authmech1 SOMETHING with --authuser1.
--authuser2 <string> : User to auth with on host2 (admin user).
--proxyauth1 : Use proxyauth on host1. Requires --authuser1.
Required by Sun/iPlanet/Netscape IMAP servers to
be able to use an administrative user.
--proxyauth2 : Use proxyauth on host2. Requires --authuser2.
--authuser1 str : User to auth with on host1 (admin user).
Avoid using --authmech1 SOMETHING with --authuser1.
--authuser2 str : User to auth with on host2 (admin user).
--proxyauth1 : Use proxyauth on host1. Requires --authuser1.
Required by Sun/iPlanet/Netscape IMAP servers to
be able to use an administrative user.
--proxyauth2 : Use proxyauth on host2. Requires --authuser2.
--authmd51 : Use MD5 authentification for host1.
--authmd52 : Use MD5 authentification for host2.
--domain1 <string> : Domain on host1 (NTLM authentication).
--domain2 <string> : Domain on host2 (NTLM authentication).
--authmd51 : Use MD5 authentification for host1.
--authmd52 : Use MD5 authentification for host2.
--domain1 str : Domain on host1 (NTLM authentication).
--domain2 str : Domain on host2 (NTLM authentication).
--folder <string> : Sync this folder.
--folder <string> : and this one, etc.
--folderrec <string> : Sync this folder recursively.
--folderrec <string> : and this one, etc.
--folder str : Sync this folder.
--folder str : and this one, etc.
--folderrec str : Sync this folder recursively.
--folderrec str : and this one, etc.
--folderfirst <string> : Sync this folder first. --folderfirst "Work"
--folderfirst <string> : then this one, etc.
--folderlast <string> : Sync this folder last. --folderlast "[Gmail]/All Mail"
--folderlast <string> : then this one, etc.
--folderfirst str : Sync this folder first. --folderfirst "Work"
--folderfirst str : then this one, etc.
--folderlast str : Sync this folder last. --folderlast "[Gmail]/All Mail"
--folderlast str : then this one, etc.
--nomixfolders : Do not merge folders when host1 is case sensitive
while host2 is not (like Exchange). Only the first
similar folder is synced (ex: Sent SENT sent -> Sent).
--nomixfolders : Do not merge folders when host1 is case sensitive
while host2 is not (like Exchange). Only the first
similar folder is synced (ex: Sent SENT sent -> Sent).
--skipemptyfolders : Empty host1 folders are not created on host2.
--skipemptyfolders : Empty host1 folders are not created on host2.
--include <regex> : Sync folders matching this regular expression
--include <regex> : or this one, etc.
in case both --include --exclude options are
use, include is done before.
--exclude <regex> : Skips folders matching this regular expression
Several folders to avoid:
--exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
--exclude <regex> : or this one, etc.
--f1f2 str1=str2 : Force folder str1 to be synced to str2.
--include reg : Sync folders matching this regular expression
--include reg : or this one, etc.
in case both --include --exclude options are
use, include is done before.
--exclude reg : Skips folders matching this regular expression
Several folders to avoid:
--exclude 'fold1|fold2|f3' skips fold1, fold2 and f3.
--exclude reg : or this one, etc.
--subfolder2 <string> : Move whole host1 folders hierarchy under this
host2 folder <string>.
It does it by adding two --regextrans2 options before
all others. Add --debug to see what's really going on.
--subfolder2 str : Move whole host1 folders hierarchy under this
host2 folder str .
It does it by adding two --regextrans2 options before
all others. Add --debug to see what's really going on.
--regextrans2 <regex> : Apply the whole regex to each destination folders.
--regextrans2 <regex> : and this one. etc.
When you play with the --regextrans2 option, first
add also the safe options --dry --justfolders
Then, when happy, remove --dry, remove --justfolders.
Have in mind that --regextrans2 is applied after prefix
and separator inversion.
--regextrans2 reg : Apply the whole regex to each destination folders.
--regextrans2 reg : and this one. etc.
When you play with the --regextrans2 option, first
add also the safe options --dry --justfolders
Then, when happy, remove --dry, remove --justfolders.
Have in mind that --regextrans2 is applied after prefix
and separator inversion.
--tmpdir <string> : Where to store temporary files and subdirectories.
Will be created if it doesn't exist.
Default is system specific, Unix is /tmp but
it's often small and deleted at reboot.
--tmpdir /var/tmp should be better.
--pidfile <string> : The file where imapsync pid is written.
--pidfilelocking : Abort if pidfile already exists. Usefull to avoid
concurrent transfers on the same mailbox.
--tmpdir str : Where to store temporary files and subdirectories.
Will be created if it doesn't exist.
Default is system specific, Unix is /tmp but
it's often small and deleted at reboot.
--tmpdir /var/tmp should be better.
--pidfile str : The file where imapsync pid is written.
--pidfilelocking : Abort if pidfile already exists. Usefull to avoid
concurrent transfers on the same mailbox.
--nolog : Turn off logging on file
--logfile <string> : Change the default logfile pathname and filename.
--nolog : Turn off logging on file
--logfile str : Change the default log filename (can be dirname/filename).
--logdir str : Change the default log directory. Default is LOG_imapsync
--prefix1 <string> : Remove prefix to all destination folders
(usually INBOX. or INBOX/ or an empty string "")
you have to use --prefix1 if host1 imap server
does not have NAMESPACE capability, so imapsync
suggests to use it. All other cases are bad.
--prefix2 <string> : Add prefix to all host2 folders. See --prefix1
--sep1 <string> : Host1 separator in case NAMESPACE is not supported.
--sep2 <string> : Host2 separator in case NAMESPACE is not supported.
--prefix1 str : Remove prefix to all destination folders
(usually INBOX. or INBOX/ or an empty string "")
you have to use --prefix1 if host1 imap server
does not have NAMESPACE capability, so imapsync
suggests to use it. All other cases are bad.
--prefix2 str : Add prefix to all host2 folders. See --prefix1
--sep1 str : Host1 separator in case NAMESPACE is not supported.
--sep2 str : Host2 separator in case NAMESPACE is not supported.
--skipmess <regex> : Skips messages maching the regex.
Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
--skipmess is applied before --regexmess
--skipmess <regex> : or this one, etc.
--skipmess reg : Skips messages maching the regex.
Example: 'm/[\x80-ff]/' # to avoid 8bits messages.
--skipmess is applied before --regexmess
--skipmess reg : or this one, etc.
--pipemess <command> : Apply this command to each message content before
the copy.
--pipemess <command> : and this one, etc.
--pipemess cmd : Apply this cmd command to each message content
before the copy.
--pipemess cmd : and this one, etc.
--disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
--disarmreadreceipts : Disarms read receipts (host2 Exchange issue)
--regexmess <regex> : Apply the whole regex to each message before transfer.
Example: 's/\000/ /g' # to replace null by space.
--regexmess <regex> : and this one, etc.
--regexmess reg : Apply the whole regex to each message before transfer.
Example: 's/\000/ /g' # to replace null by space.
--regexmess reg : and this one, etc.
--regexflag <regex> : Apply the whole regex to each flags list.
Example: 's/"Junk"//g' # to remove "Junk" flag.
--regexflag <regex> : and this one, etc.
--regexflag reg : Apply the whole regex to each flags list.
Example: 's/"Junk"//g' # to remove "Junk" flag.
--regexflag reg : and this one, etc.
--delete : Deletes messages on host1 server after a successful
transfer. Option --delete has the following behavior:
it marks messages as deleted with the IMAP flag
\Deleted, then messages are really deleted with an
EXPUNGE IMAP command.
--delete : Deletes messages on host1 server after a successful
transfer. Option --delete has the following behavior:
it marks messages as deleted with the IMAP flag
\Deleted, then messages are really deleted with an
EXPUNGE IMAP command.
--delete2 : Delete messages in host2 that are not in
host1 server. Useful for backup or pre-sync.
--delete2duplicates : Delete messages in host2 that are duplicates.
Works only without --useuid since duplicates are
detected with an header part of each message.
--delete2 : Delete messages in host2 that are not in
host1 server. Useful for backup or pre-sync.
--delete2duplicates : Delete messages in host2 that are duplicates.
Works only without --useuid since duplicates are
detected with an header part of each message.
--delete2folders : Delete folders in host2 that are not in host1 server.
For safety, first try it like this (it is safe):
--delete2folders --dry --justfolders --nofoldersizes
--delete2foldersonly <regex>: Deleted only folders matching regex.
Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/"
--delete2foldersbutnot <regex>: Do not delete folders matching regex.
Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/"
--noexpunge : Do not expunge messages on host1.
Expunge really deletes messages marked deleted.
Expunge is made at the beginning, on host1 only.
Newly transferred messages are also expunged if
option --delete is given.
No expunge is done on host2 account (unless --expunge2)
--expunge1 : Expunge messages on host1 after messages transfer.
--expunge2 : Expunge messages on host2 after messages transfer.
--uidexpunge2 : uidexpunge messages on the host2 account
that are not on the host1 account, requires --delete2
--nomixfolders : Avoid merging folders that are considered different on
host1 but the same on destination host2 because of
case sensitivities and insensitivities.
--delete2folders : Delete folders in host2 that are not in host1 server.
For safety, first try it like this (it is safe):
--delete2folders --dry --justfolders --nofoldersizes
--delete2foldersonly reg : Deleted only folders matching regex.
Example: --delete2foldersonly "/^Junk$|^INBOX.Junk$/"
--delete2foldersbutnot reg : Do not delete folders matching regex.
Example: --delete2foldersbutnot "/Tasks$|Contacts$|Foo$/"
--noexpunge : Do not expunge messages on host1.
Expunge really deletes messages marked deleted.
Expunge is made at the beginning, on host1 only.
Newly transferred messages are also expunged if
option --delete is given.
No expunge is done on host2 account (unless --expunge2)
--expunge1 : Expunge messages on host1 after messages transfer.
--expunge2 : Expunge messages on host2 after messages transfer.
--uidexpunge2 : uidexpunge messages on the host2 account
that are not on the host1 account, requires --delete2
--nomixfolders : Avoid merging folders that are considered different on
host1 but the same on destination host2 because of
case sensitivities and insensitivities.
--syncinternaldates : Sets the internal dates on host2 same as host1.
Turned on by default. Internal date is the date
a message arrived on a host (mtime).
--idatefromheader : Sets the internal dates on host2 same as the
"Date:" headers.
--syncinternaldates : Sets the internal dates on host2 same as host1.
Turned on by default. Internal date is the date
a message arrived on a host (mtime).
--idatefromheader : Sets the internal dates on host2 same as the
"Date:" headers.
--maxsize <int> : Skip messages larger (or equal) than <int> bytes
--minsize <int> : Skip messages smaller (or equal) than <int> bytes
--maxage <int> : Skip messages older than <int> days.
final stats (skipped) don't count older messages
see also --minage
--minage <int> : Skip messages newer than <int> days.
final stats (skipped) don't count newer messages
You can do (+ are the messages selected):
past|----maxage+++++++++++++++>now
past|+++++++++++++++minage---->now
past|----maxage+++++minage---->now (intersection)
past|++++minage-----maxage++++>now (union)
--maxsize int : Skip messages larger (or equal) than int bytes
--minsize int : Skip messages smaller (or equal) than int bytes
--maxage int : Skip messages older than int days.
final stats (skipped) don't count older messages
see also --minage
--minage int : Skip messages newer than int days.
final stats (skipped) don't count newer messages
You can do (+ are the messages selected):
past|----maxage+++++++++++++++>now
past|+++++++++++++++minage---->now
past|----maxage+++++minage---->now (intersection)
past|++++minage-----maxage++++>now (union)
--search <string> : Selects only messages returned by this IMAP SEARCH
command. Applied on both sides.
--search1 <string> : Same as --search for selecting host1 messages only.
--search2 <string> : Same as --search for selecting host2 messages only.
--search CRIT equals --search1 CRIT --search2 CRIT
--search str : Selects only messages returned by this IMAP SEARCH
command. Applied on both sides.
--search1 str : Same as --search for selecting host1 messages only.
--search2 str : Same as --search for selecting host2 messages only.
--search CRIT equals --search1 CRIT --search2 CRIT
--exitwhenover <int> : Stop syncing when total bytes transferred reached.
Gmail per day allows 2500000000 down 500000000 upload.
--exitwhenover int : Stop syncing when total bytes transferred reached.
Gmail per day allows
2500000000 = 2.5 GB downloaded from Gmail as host2
500000000 = 500 MB uploaded to Gmail as host1.
--maxlinelength <int> : skip messages with a line length longer than <int> bytes.
RFC 2822 says it must be no more than 1000 bytes.
--maxlinelength int : skip messages with a line length longer than int bytes.
RFC 2822 says it must be no more than 1000 bytes.
--useheader <string> : Use this header to compare messages on both sides.
Ex: Message-ID or Subject or Date.
--useheader <string> and this one, etc.
--useheader str : Use this header to compare messages on both sides.
Ex: Message-ID or Subject or Date.
--useheader str and this one, etc.
--subscribed : Transfers subscribed folders.
--subscribe : Subscribe to the folders transferred on the
host2 that are subscribed on host1. On by default.
--subscribeall : Subscribe to the folders transferred on the
host2 even if they are not subscribed on host1.
--subscribed : Transfers subscribed folders.
--subscribe : Subscribe to the folders transferred on the
host2 that are subscribed on host1. On by default.
--subscribeall : Subscribe to the folders transferred on the
host2 even if they are not subscribed on host1.
--nofoldersizes : Do not calculate the size of each folder in bytes
and message counts. Default is to calculate them.
--nofoldersizesatend : Do not calculate the size of each folder in bytes
and message counts at the end. Default is on.
--justfoldersizes : Exit after having printed the folder sizes.
--nofoldersizes : Do not calculate the size of each folder in bytes
and message counts. Default is to calculate them.
--nofoldersizesatend: Do not calculate the size of each folder in bytes
and message counts at the end. Default is on.
--justfoldersizes : Exit after having printed the folder sizes.
--syncacls : Synchronises acls (Access Control Lists).
--nosyncacls : Does not synchronize acls. This is the default.
Acls in IMAP are not standardized, be careful.
--syncacls : Synchronises acls (Access Control Lists).
--nosyncacls : Does not synchronize acls. This is the default.
Acls in IMAP are not standardized, be careful.
--usecache : Use cache to speedup.
--nousecache : Do not use cache. Caveat: --useuid --nousecache creates
duplicates on multiple runs.
--useuid : Use uid instead of header as a criterium to recognize
messages. Option --usecache is then implied unless
--nousecache is used.
--usecache : Use cache to speedup.
--nousecache : Do not use cache. Caveat: --useuid --nousecache creates
duplicates on multiple runs.
--useuid : Use uid instead of header as a criterium to recognize
messages. Option --usecache is then implied unless
--nousecache is used.
--debug : Debug mode.
--debugcontent : Debug content of the messages transfered.
--debugflags : Debug flags.
--debugimap1 : IMAP debug mode for host1. imap debug is very verbose.
--debugimap2 : IMAP debug mode for host2.
--debugimap : IMAP debug mode for host1 and host2.
--debugmemory : Debug mode showing memory consumption after each copy.
--debug : Debug mode.
--debugfolders : Debug mode for the folders part only.
--debugcontent : Debug content of the messages transfered. Huge ouput.
--debugflags : Debug mode for flags.
--debugimap1 : IMAP debug mode for host1. Very verbose.
--debugimap2 : IMAP debug mode for host2. Very verbose.
--debugimap : IMAP debug mode for host1 and host2.
--debugmemory : Debug mode showing memory consumption after each copy.
--tests : Run non-regression tests.
--testslive : Run a live test with test1.lamiral.info imap server.
Useful to check the basics. Needs internet connexion.
--tests : Run non-regression tests.
--testslive : Run a live test with test1.lamiral.info imap server.
Useful to check the basics. Needs internet connexion.
--version : Print software version.
--noreleasecheck : Do not check for new imapsync release (a http request).
--releasecheck : Check for new imapsync release (a http request).
--justconnect : Just connect to both servers and print useful
information. Need only --host1 and --host2 options.
--justlogin : Just login to both host1 and host2 with users
credentials, then exit.
--justfolders : Do only things about folders (ignore messages).
--version : Print only software version.
--noreleasecheck : Do not check for new imapsync release (a http request).
--releasecheck : Check for new imapsync release (a http request).
--noid : Do not send/receive ID command to imap servers.
--justconnect : Just connect to both servers and print useful
information. Need only --host1 and --host2 options.
--justlogin : Just login to both host1 and host2 with users
credentials, then exit.
--justfolders : Do only things about folders (ignore messages).
--help : print this help.
--help : print this help.
Example: to synchronize imap account "test1" on "test1.lamiral.info"
to imap account "test2" on "test2.lamiral.info"
@ -248,23 +258,20 @@ imapsync \
--host1 test1.lamiral.info --user1 test1 --password1 secret1 \
--host2 test2.lamiral.info --user2 test2 --password2 secret2
Here is a [linux] system (Linux petite 3.2.0-84-generic #121-Ubuntu SMP Tue May 5 18:55:46 UTC 2015 i686)
Here is a [linux] system (Linux petite 3.2.0-91-generic #129-Ubuntu SMP Wed Sep 9 10:56:56 UTC 2015 i686)
With perl 5.14.2 Mail::IMAPClient 3.30
$Id: imapsync,v 1.644 2015/07/17 01:22:52 gilles Exp gilles $
$Id: imapsync,v 1.670 2015/12/03 02:36:41 gilles Exp gilles $
This current imapsync is up to date
Homepage: http://imapsync.lamiral.info/
[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources
[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources
[MSG] No '/home/gilles/.cpanplus/custom-sources' dir, skipping custom sources
'Tie::Hash::NamedCapture' => '0.08',
'Authen::NTLM::DES' => '1.02',
'Authen::NTLM::MD4' => '1.02',
'IO::Compress::Gzip' => '2.048',
'IO::Compress::Gzip::Constants' => '2.048',
'IO::Compress::Base::Common' => '2.048',
'IO::Uncompress::Gunzip' => '2.048',
'IO::Compress::Base::Common' => '2.048',
'IO::Compress::Gzip::Constants' => '2.048',
'Compress::Raw::Zlib' => '2.048',
'Convert::ASN1::IO' => 'undef',
'Convert::ASN1::_decode' => 'undef',
@ -287,6 +294,7 @@ Homepage: http://imapsync.lamiral.info/
'File::GlobMapper' => '1.000',
'IO::Compress::Base' => '2.048',
'IO::Compress::Adapter::Bzip2' => '2.048',
'IO::Compress::Zlib::Constants' => '2.048',
'IO::Compress::RawDeflate' => '2.048',
'IO::Compress::Adapter::Deflate' => '2.048',
'IO::Compress::Zlib::Extra' => '2.048',
@ -296,16 +304,18 @@ Homepage: http://imapsync.lamiral.info/
'Compress::Raw::Bzip2' => '2.048',
'IO::Uncompress::Adapter::Bunzip2' => '2.048',
'IO::Uncompress::Base' => '2.048',
'IO::Compress::Zlib::Constants' => '2.048',
'IO::Uncompress::Adapter::Inflate' => '2.048',
'JSON::WebToken::Constants' => 'undef',
'JSON::WebToken::Exception' => 'undef',
'Module::Runtime' => '0.011',
'JSON::WebToken::Crypt' => 'undef',
'common::sense' => '3.4',
'Authen::NTLM' => '1.09',
'CPAN::Config' => 'undef',
'URI' => '1.59',
'URI::mailto' => 'undef',
'URI::_userpass' => 'undef',
'URI::_query' => 'undef',
'URI::data' => 'undef',
'URI::mailto' => 'undef',
'URI::_query' => 'undef',
'URI::QueryParam' => 'undef',
'URI::Split' => 'undef',
'URI::_foreign' => 'undef',
@ -333,8 +343,6 @@ Homepage: http://imapsync.lamiral.info/
'URI::file::Win32' => 'undef',
'URI::file::Unix' => 'undef',
'URI::file::Base' => 'undef',
'URI::sip' => '0.11',
'URI::_login' => 'undef',
'URI::_punycode' => '0.04',
'URI::IRI' => 'undef',
'URI::_ldap' => '1.12',
@ -342,22 +350,24 @@ Homepage: http://imapsync.lamiral.info/
'URI::news' => 'undef',
'URI::rtsp' => 'undef',
'URI::Heuristic' => '4.20',
'URI::_userpass' => 'undef',
'URI::sip' => '0.11',
'URI::_login' => 'undef',
'URI::_idna' => 'undef',
'URI::_generic' => 'undef',
'LWP::MediaTypes' => '6.01',
'HTTP::Date' => '6.00',
'HTTP::Request' => '6.00',
'File::Listing' => '6.03',
'HTTP::Negotiate' => '6.00',
'Net::HTTP' => '6.02',
'HTTP::Status' => '6.00',
'LWP::Protocol' => '6.00',
'HTTP::Response' => '6.01',
'Net::HTTPS' => '6.02',
'LWP::Debug' => 'undef',
'HTTP::Negotiate' => '6.00',
'Net::LDAP' => '0.43',
'Net::LDAP::LDIF' => '0.18',
'Mail::Internet' => '2.08',
'HTTP::Status' => '6.00',
'LWP::Protocol' => '6.00',
'HTTP::Response' => '6.01',
'HTTP::Request' => '6.00',
'HTML::HeadParser' => '3.69',
'HTTP::Config' => '6.00',
'HTTP::Request::Common' => '6.00',
@ -368,6 +378,7 @@ Homepage: http://imapsync.lamiral.info/
'HTTP::Headers::Util' => '6.00',
'LWP::MemberMixin' => 'undef',
'LWP' => '6.03',
'HTTP::Date' => '6.00',
'Compress::Zlib' => '2.048',
'Mail::IMAPClient::MessageSet' => 'undef',
'Digest::HMAC_MD5' => '1.01',
@ -375,6 +386,7 @@ Homepage: http://imapsync.lamiral.info/
'Mail::Header' => '2.08',
'Mail::Mailer' => '2.08',
'Mail::Util' => '2.08',
'Params::Classify' => '0.013',
'Net::HTTP::Methods' => '6.00',
'Net::SSL' => '2.84',
'Net::LDAP::Bind' => '1.03',
@ -404,17 +416,24 @@ Homepage: http://imapsync.lamiral.info/
'URI::file' => '4.21',
'URI::_server' => 'undef',
'Unicode::CharName' => '1.07',
'Crypt::OpenSSL::Bignum' => '0.04',
'Crypt::OpenSSL::Random' => '0.04',
'Data::Uniqid' => '0.12',
'Digest::HMAC_SHA1' => '1.03',
'File::Copy::Recursive' => '0.38',
'IO::Tee' => '0.64',
'JSON' => '2.53',
'JSON::WebToken' => '0.10',
'JSON::WebToken::Crypt::RSA' => 'undef',
'Term::ReadKey' => '2.30',
'Test::More' => '0.98',
'Unicode::String' => '2.09',
'File::Spec::Unix' => '3.33',
'File::Spec' => '3.33',
'JSON::PP' => '2.27203',
'JSON::PP::Boolean' => 'undef',
'JSON::XS::Boolean' => 'undef',
'JSON' => '2.53',
'Crypt::OpenSSL::RSA' => '0.27',
'JSON::XS' => '2.32',
'LWP::UserAgent' => '6.03',
'HTML::Entities' => '3.69',

63
W/test2.bat
View file

@ -1,64 +1,11 @@
@REM $Id: test2.bat,v 1.16 2014/05/22 14:20:07 gilles Exp gilles $
@REM $Id: test2.bat,v 1.20 2015/11/23 16:47:01 gilles Exp gilles $
@REM
cd C:\msys\1.0\home\Admin\imapsync
@REM perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --delete2 --expunge2 --folder INBOX
@REM perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --delete2 --expunge1 --expunge2 --folder INBOX --usecache
@REM imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --justfolders --nofoldersize --folder INBOX.yop.yap --sep1 / --regextrans2 "s,/,_,"
@REM imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --nofoldersize --folder INBOX.yop.yap --regexflag 's/\\Answered//g' --debug > out.txt
@REM perl imapsync --version
@REM perl imapsync --tests_debug
@REM imapsync.exe ^
@REM --host1 p --user1 big1 --passfile1 secret.big1 ^
@REM --host2 p --user2 big2 --passfile2 secret.big2 ^
@REM --folder INBOX.bigmail
@REM perl imapsync
@REM perl imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --nofoldersize --folder INBOX.yop.yap --regexflag "s/\\ /\\/g" --debugflags
@REM FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (file.txt) DO imapsync ^
@REM --host1 imap.side1.org --user1 %%G --password1 %%H ^
@REM --host2 imap.side2.org --user2 %%I --password2 %%J
@REM imapsync --host1 p --user1 tata --passfile1 secret.tata ^
@REM --host2 p --user2 dollar --password2 "$%%&<>|^"^" --justlogin
@REM imapsync --host1 p --user1 tata --passfile1 secret.tata ^
@REM --host2 p --user2 equal --password2 "==lalala" --justlogin --debugimap2
@REM perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata ^
@REM --host2 p --user2 titi --passfile2 secret.titi ^
@REM --folder INBOX.useuid --useuid --debugcache --delete2
@REM perl ./imapsync --host1 p --user1 tata --passfile1 secret.tata ^
@REM --host2 imap.gmail.com --ssl2 --user2 gilles.lamiral@gmail.com --passfile2 secret.gilles_gmail ^
@REM --usecache --nofoldersizes --folder INBOX --regextrans2 "s(INBOX)([Gmail]/te*st)"
@REM perl ./imapsync --host1 imap.gmail.com --port1 993 --ssl1 --host2 imap.bigs.dk --justconnect
@REM imapsync.exe --host1 imap.gmail.com --port1 993 --ssl1 --host2 imap.bigs.dk --justconnect
cd /D %~dp0
@REM @ECHO off
SET csvfile=file.txt
FOR /F "tokens=1,2,3,4 delims=; eol=#" %%G IN (%csvfile%) DO (
@ECHO ==== Syncing from account %%G to account %%I ====
@ECHO.
imapsync ^
--host1 imap.side1.org --user1 %%G --password1 %%H ^
--host2 imap.side2.org --user2 %%I --password2 %%J
@ECHO.==== End syncing from account %%G to account %%I ====
@ECHO.
)
@ECHO Loop finished!
@ECHO Log files are in LOG_imapsync directory
.\imapsync.exe --modules_version
@PAUSE
.\imapsync.exe --testslive
@PAUSE

31
W/test3.bat
View file

@ -1,31 +1,16 @@
@REM $Id: test3.bat,v 1.20 2015/05/11 01:08:57 gilles Exp gilles $
@REM $Id: test3.bat,v 1.22 2015/09/21 22:49:50 gilles Exp gilles $
cd /D %~dp0
@REM \$1 must be $1 on Windows
@REM .\imapsync.exe --host1 ex-cashub1.caltech.edu --justconnect --host2 ex-cashub1.caltech.edu --ssl1 --ssl2 --ssl1_SSL_version SSLv3 --ssl2_SSL_version SSLv3
@REM perl .\imapsync --tests_debug
@REM @EXIT
@REM perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
@REM --nofoldersizes --regextrans2 "s,INBOX\\yop\\(.*),OLDBOX\\$1," --prefix1 "" --sep1 "." --sep2 "\\" --prefix2 "" --justfolders --dry --debug
@REM .\imapsync.exe --host1 p --user1 tata --passfile1 secret.tata --host2 imap-mail.outlook.com --ssl2 --user2 gilles.lamiral@outlook.com ^
@REM --passfile2 secret.outlook.com --folder INBOX --usecache --regextrans2 "s/INBOX/tata/"
@REM Change all " to _
@REM --justfolders --nofoldersizes --dry --regextrans2 s,\^",_,g
@REM perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
@REM --justfolders --nofoldersizes --dry --regextrans2 "s,(/|^) +,$1,g" --regextrans2 "s, +(/|$),$1,g"
perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
--justfolders --subfolder2 SUB2
@REM ==== split lon lines
perl ./imapsync ^
--host1 p --user1 tata ^
--passfile1 secret.tata ^
--host2 p --user2 titi ^
--passfile2 secret.titi ^
--nofoldersizes --folder "INBOX.longline" --regexmess "s,(.{9900}),$1\r\n,g" --dry --debugcontent
@EXIT

54
W/test3_boxon.bat
View file

@ -18,3 +18,57 @@ REM --justconnect
REM .\imapsync.exe --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --ssl1 --ssl2 --delete2 --folder INBOX
REM .\imapsync.exe --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi --ssl1 --ssl2 --delete2 --folder INBOX --usecache
@REM .\imapsync.exe --host1 ex-cashub1.caltech.edu --justconnect --host2 ex-cashub1.caltech.edu --ssl1 --ssl2 --ssl1_SSL_version SSLv3 --ssl2_SSL_version SSLv3
@REM perl .\imapsync --tests_debug
@REM @EXIT
@REM perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
@REM --nofoldersizes --regextrans2 "s,INBOX\\yop\\(.*),OLDBOX\\$1," --prefix1 "" --sep1 "." --sep2 "\\" --prefix2 "" --justfolders --dry --debug
@REM .\imapsync.exe --host1 p --user1 tata --passfile1 secret.tata --host2 imap-mail.outlook.com --ssl2 --user2 gilles.lamiral@outlook.com ^
@REM --passfile2 secret.outlook.com --folder INBOX --usecache --regextrans2 "s/INBOX/tata/"
@REM Change all " to _
@REM --justfolders --nofoldersizes --dry --regextrans2 s,\^",_,g
@REM perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
@REM --justfolders --nofoldersizes --dry --regextrans2 "s,(/|^) +,$1,g" --regextrans2 "s, +(/|$),$1,g"
@ECHO ==== --subfolder2 SUB2
perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
--justfolders --subfolder2 SUB2 --dry
@ECHO ==== 4 --TLS1 --TLS2 --JUSTLOGIN
perl ./imapsync --debug --host1 p --tls1 --user1 tata --passfile1 secret.tata --host2 p --tls2 --user2 titi --passfile2 secret.titi --justconnect
@ECHO ==== Remove [Gmail] on host2
perl .\imapsync --host1 imap.gmail.com --ssl1 --user1 gilles.lamiral@gmail.com --passfile1 secret.gilles_gmail ^
--host2 p --user2 tata --passfile2 secret.tata ^
--regextrans2 "s,\[Gmail\].,," --dry --justfolders
@ECHO ==== --subfolder2 SUB2 domino
perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
--sep2 "\\" --prefix2 "" --justfolders --subfolder2 SUB2 --dry --debug --folder INBOX.yop.yap.yip
@ECHO ==== --subfolder2 remove INBOX domino
perl .\imapsync --host1 p --user1 tata --passfile1 secret.tata --host2 p --user2 titi --passfile2 secret.titi ^
--prefix1 "" ^
--sep2 "\\" --prefix2 "" --regextrans2 "s,^Inbox\\(.*),$1,i" --justfolders --dry --debug --folder INBOX.yop.yap.yip
@REM ==== split lon lines
perl ./imapsync ^
--host1 p --user1 tata ^
--passfile1 secret.tata ^
--host2 p --user2 titi ^
--passfile2 secret.titi ^
--nofoldersizes --folder "INBOX.longline" --regexmess "s,(.{9900}),$1\r\n,g" --dry --debugcontent
@REM

8
W/test3_gmail.bat
View file

@ -1,5 +1,5 @@
@REM $Id: test3_gmail.bat,v 1.2 2014/11/14 17:09:34 gilles Exp gilles $
@REM $Id: test3_gmail.bat,v 1.3 2015/09/19 08:23:14 gilles Exp gilles $
cd /D %~dp0
@ -11,6 +11,6 @@ cd /D %~dp0
@REM PAUSE
.\imapsync.exe --host1 imap.gmail.com --ssl1 --user1 gilles.lamiral@gmail.com --passfile1 secret.gilles_gmail ^
--host2 imap.gmail.com --ssl2 --user2 gilles.lamiral@gmail.com --passfile2 secret.gilles_gmail ^
--usecache --nofoldersizes
perl .\imapsync --host1 imap.gmail.com --ssl1 --user1 gilles.lamiral@gmail.com --passfile1 secret.gilles_gmail ^
--host2 p --user2 tata --passfile2 secret.tata ^
--regextrans2 "s,\[Gmail\].,," --dry --justfolders

4
W/test_tests.bat
View file

@ -1,6 +1,4 @@
@REM
@REM $Id: test_tests.bat,v 1.2 2015/06/27 20:01:16 gilles Exp gilles $
@REM $Id: test_tests.bat,v 1.3 2015/09/19 08:46:11 gilles Exp gilles $
@REM cd C:\msys\1.0\home\Admin\imapsync
cd /D %~dp0