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

1.239

Browse source
This commit is contained in:
Nick Bebout 2011-03-12 02:44:35 +00:00
parent 6576e43299
commit 0d91a1a20f
80 changed files with 31457 additions and 28691 deletions
Download patch file Download diff file Expand all files Collapse all files

350
imapsync
View file

@ -9,7 +9,7 @@ tool. Synchronise mailboxes between two imap servers. Good
at IMAP migration. More than 32 different IMAP server softwares
supported with success.
$Revision: 1.233 $
$Revision: 1.239 $
=head1 INSTALL
@ -211,6 +211,12 @@ No known serious bug. Report any bug to the author.
Before reporting bugs, read the FAQ, this README and the
TODO files.
Don't write imapsync in uppercase in the email title, I'll
know you run windows.
Make a good title, not just "imapsync" or "problem",
a good title is made of keywords summary, not too long (one visible line).
In your report, please include:
- imapsync version.
@ -242,12 +248,13 @@ Failure stories reported with the following 4 imap servers :
- dkimap4 2.39
- Imail 7.04 (maybe).
Success stories reported with the following 34 imap servers
Success stories reported with the following 35 imap servers
(softwares names are in alphabetic order) :
- Archiveopteryx 2.03, 2.04 (OSL 3.0) http://www.archiveopteryx.org/
- BincImap 1.2.3 (GPL) (http://www.bincimap.org/)
- CommuniGatePro server (Redhat 8.0)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8 (GPL)
- Courier IMAP 1.5.1, 2.2.0, 2.1.1, 2.2.1, 3.0.8, 3.0.3, 4.1.1 (GPL)
(http://www.courier-mta.org/)
- Critical Path (7.0.020)
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.1.18
@ -278,7 +285,7 @@ Success stories reported with the following 34 imap servers
- OpenMail IMAP server B.07.00.k0 (Samsung Contact ?)
- OpenWave
- Qualcomm Worldmail (NT)
- Rockliffe Mailsite 5.3.11
- Rockliffe Mailsite 5.3.11, 4.5.6
- Samsung Contact IMAP server 8.5.0
- Scalix v10.1, 10.0.1.3, 11.0.0.431
- SmarterMail
@ -290,7 +297,7 @@ Success stories reported with the following 34 imap servers
(http://www.washington.edu/imap/)
- UW - QMail v2.1
- Imap part of TCP/IP suite of VMS 7.3.2
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 5.5.
- Zimbra-IMAP 3.0.1 GA 160, 3.1.0 Build 279, 4.0.5, 4.5.2, 4.5.6, 5.5.
Please report to the author any success or bad story with
imapsync and don't forget to mention the IMAP server
@ -373,11 +380,13 @@ Entries for imapsync:
imapcopy : http://home.arcor.de/armin.diehl/imapcopy/imapcopy.html
migrationtool : http://sourceforge.net/projects/migrationtool/
imapmigrate : http://sourceforge.net/projects/cyrus-utils/
wonko_imapsync: http://wonko.com/article/554
pop2imap : http://www.linux-france.org/prj/pop2imap/
Feedback (good or bad) will be always welcome.
$Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $
$Id: imapsync,v 1.239 2007/12/29 02:44:10 gilles Exp $
@ -396,6 +405,9 @@ use English;
use POSIX qw(uname);
use Fcntl;
#use Test::Simple tests => 1;
use Test::More 'no_plan';
eval { require 'usr/include/sysexits.ph' };
@ -431,19 +443,20 @@ my(
$authuser1, $authuser2,
$authmech1, $authmech2,
$split1, $split2,
$tests, $test_builder,
);
use vars qw ($opt_G); # missing code for this will be option.
$rcs = ' $Id: imapsync,v 1.233 2007/10/30 03:20:53 gilles Exp gilles $ ';
$rcs = ' $Id: imapsync,v 1.239 2007/12/29 02:44:10 gilles Exp $ ';
$rcs =~ m/,v (\d+\.\d+)/;
$VERSION = ($1) ? $1 : "UNKNOWN";
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
#check_lib_version() or
# die "Upgrade perl lib Mail::IMAPClient to release 2.2.9 at least\n";
check_lib_version() or
die "imapsync needs perl lib Mail::IMAPClient release 2.2.9 exactly, future imapsync release may suppoort 3.0.x, but sorry not now\n";
$mess_size_total_trans = 0;
@ -453,18 +466,14 @@ $mess_trans = $mess_skipped = $mess_skipped_dry = 0;
sub check_lib_version {
# I know this is ugly, I should write a sort function
if ($VERSION_IMAPClient =~ m/(\d+)\.(\d+)\.(\d+)/) {
$debug and print "VERSION_IMAPClient $1 $2 $3\n";
my($major,$minor,$sub) = ($1, $2, $3);
#my($major,$minor,$sub) = ($1, $2, $3);
return(1) if($major >=3);
return(0) if($major <=1);
return(1) if($minor >=3);
return(0) if($minor <=1);
return(1) if($sub >=8);
return(0) if($sub <=7);
}else{
return(1) if($VERSION_IMAPClient eq '2.2.9');
}
else{
return 0; # don't match regex => bad
}
}
@ -473,8 +482,8 @@ $error=0;
my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.233 $ ',
'$Date: 2007/10/30 03:20:53 $ ',
'$Revision: 1.239 $ ',
'$Date: 2007/12/29 02:44:10 $ ',
"\n",localhost_info(),
" and the module Mail::IMAPClient version used here is ",
$VERSION_IMAPClient,"\n",
@ -552,7 +561,8 @@ $user2 || missing_option("--user2");
if(defined($authmd5) and not($authmd5)) {
$authmech1 ||= 'LOGIN';
$authmech2 ||= 'LOGIN';
}else{
}
else{
$authmech1 ||= $authuser1 ? 'PLAIN' : 'CRAM-MD5';
$authmech2 ||= $authuser2 ? 'PLAIN' : 'CRAM-MD5';
}
@ -641,7 +651,8 @@ sub login_imap {
Socket => $socssl,
Server => $host,
);
} else {
}
else {
$imap = Mail::IMAPClient->new();
}
$imap->Clear(20);
@ -656,7 +667,8 @@ sub login_imap {
if ($ssl) {
$imap->State(Mail::IMAPClient::Connected);
} else {
}
else {
$imap->connect2()
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
}
@ -667,7 +679,8 @@ sub login_imap {
) {
printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n",
$imap->Server, $authmech);
} else {
}
else {
printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
$imap->Server, $authmech);
if ($authmech eq 'PLAIN') {
@ -727,43 +740,191 @@ print "To state Authenticated\n";
$split1 and $from->Split($split1);
$split2 and $to->Split($split2);
#
# Folder stuff
#
my (@f_folders, %requested_folder, @t_folders, %subscribed_folder, %t_folders);
sub tests_folder_routines {
ok( !give_requested_folders() ,"no requested folders" );
ok( !is_requested_folder('folder_foo') );
ok( add_to_requested_folders('folder_foo') );
ok( is_requested_folder('folder_foo') );
ok( !is_requested_folder('folder_NO_EXIST') );
ok( !remove_from_requested_folders('folder_foo'), "removed folder_foo");
ok( !is_requested_folder('folder_foo') );
my @f;
ok( @f = add_to_requested_folders('folder_bar', 'folder_toto'), "add result: @f");
ok( is_requested_folder('folder_bar') );
ok( is_requested_folder('folder_toto') );
ok( remove_from_requested_folders('folder_toto') );
ok( !is_requested_folder('folder_toto') );
ok( init_requested_folders() , 'empty requested folders');
ok( !give_requested_folders() , 'no requested folders' );
}
sub give_requested_folders {
return(keys(%requested_folder));
}
sub init_requested_folders {
%requested_folder = ();
return(1);
}
sub is_requested_folder {
my ( $folder ) = @_;
defined( $requested_folder{ $folder } );
}
sub add_to_requested_folders {
my @wanted_folders = @_;
foreach my $folder ( @wanted_folders ) {
++$requested_folder{ $folder };
}
return( keys( %requested_folder ) );
}
sub remove_from_requested_folders {
my @wanted_folders = @_;
foreach my $folder (@wanted_folders) {
delete $requested_folder{$folder};
}
return( keys(%requested_folder) );
}
my (@f_folders, @t_folders, %fs_folders, %t_folders);
# Make a hash of subscribed folders in source server.
map { $fs_folders{$_}=1 } $from->subscribed();
map { $subscribed_folder{$_} = 1 } $from->subscribed();
my @all_source_folders = sort $from->folders();
if (scalar(@folder) or $subscribed or scalar(@folderrec)) {
# folders given by option --folder
push(@f_folders, @folder) if scalar(@folder);
# option --subscribed
push(@f_folders, sort keys (%fs_folders)) if ($subscribed);
if (scalar(@folder)) {
add_to_requested_folders(@folder);
}
# option --subscribed
if ($subscribed) {
add_to_requested_folders(keys (%subscribed_folder));
}
# option --folderrec
if (scalar(@folderrec)) {
foreach my $folderrec (@folderrec) {
push(@f_folders, $from->folders($folderrec));
add_to_requested_folders($from->folders($folderrec));
}
}
@f_folders = sort @f_folders;
}else {
# no folder/subscribed/folderrec options => all folders
@f_folders = sort $from->folders();
}
else {
# no include, no folder/subscribed/folderrec options => all folders
if (not scalar(@include)) {
add_to_requested_folders(@all_source_folders);
}
}
# consider (optional) includes and excludes
if (scalar(@include)) {
my @f_folders_inc;
foreach my $include (@include) {
push(@f_folders_inc, grep /$include/, @f_folders);
print "Including folders matching pattern '$include'\n";
my @included_folders = grep /$include/, @all_source_folders;
add_to_requested_folders(@included_folders);
print "Including folders matching pattern '$include': @included_folders\n";
}
push(@f_folders, sort @f_folders_inc);
}
foreach my $exclude (@exclude) {
@f_folders = grep !/$exclude/,@f_folders;
print "Excluding folders matching pattern '$exclude'\n";
if (scalar(@exclude)) {
foreach my $exclude (@exclude) {
my @requested_folder = sort(keys(%requested_folder));
my @excluded_folders = grep /$exclude/, @requested_folder;
remove_to_requested_folders(@excluded_folders);
print "Excluding folders matching pattern '$exclude': @excluded_folders\n";
}
}
my @requested_folder = sort(keys(%requested_folder));
@f_folders = @requested_folder;
sub compare_lists {
my ($list_1_ref, $list_2_ref) = @_;
return(-1) if ((not defined($list_1_ref)) and defined($list_2_ref));
return(0) if (! $list_1_ref); # end if no list
return(1) if (! $list_2_ref); # end if only one list
if (not ref($list_1_ref)) {$list_1_ref = [$list_1_ref]};
if (not ref($list_2_ref)) {$list_2_ref = [$list_2_ref]};
my $last_used_indice = 0;
ELEMENT:
foreach my $indice ( 0 .. $#$list_1_ref ) {
$last_used_indice = $indice;
# End of list_2
return 1 if ($indice > $#$list_2_ref);
my $element_list_1 = $list_1_ref->[$indice];
my $element_list_2 = $list_2_ref->[$indice];
my $balance = $element_list_1 cmp $element_list_2 ;
next ELEMENT if ($balance == 0) ;
return $balance;
}
# each element equal until last indice of list_1
return -1 if ($last_used_indice < $#$list_2_ref);
# same size, each element equal
return 0
}
sub tests_compare_lists {
my $empty_list_ref = [];
ok( 0 == compare_lists() , 'compare_lists, no args');
ok( 0 == compare_lists(undef) , 'compare_lists, undef = nothing');
ok( 0 == compare_lists(undef, undef) , 'compare_lists, undef = undef');
ok(-1 == compare_lists(undef , []) , 'compare_lists, undef < []');
ok(+1 == compare_lists([]) , 'compare_lists, [] > nothing');
ok(+1 == compare_lists([], undef) , 'compare_lists, [] > undef');
ok( 0 == compare_lists([] , []) , 'compare_lists, [] = []');
ok( 0 == compare_lists([1], 1 ) , "compare_lists, [1] = 1 ") ;
ok( 0 == compare_lists( 1 , [1]) , "compare_lists, 1 = [1]") ;
ok( 0 == compare_lists( 1 , 1 ) , "compare_lists, 1 = 1 ") ;
ok(-1 == compare_lists( 1 , 2 ) , "compare_lists, 1 = 1 ") ;
ok(+1 == compare_lists( 2 , 1 ) , "compare_lists, 1 = 1 ") ;
ok( 0 == compare_lists([1,2], [1,2]) , "compare_lists, [1,2] = [1,2]") ;
ok(-1 == compare_lists([1], [1,2]) , "compare_lists, [1] < [1,2]") ;
ok(-1 == compare_lists([1], [1,1]) , "compare_lists, [1] < [1,1]") ;
ok(+1 == compare_lists([1, 1], [1]) , "compare_lists, [1, 1] > [1]") ;
ok( 0 == compare_lists([1 .. 20_000] , [1 .. 20_000])
, "compare_lists, [1..20_000] = [1..20_000]") ;
ok(-1 == compare_lists([1], [3]) , 'compare_lists, [1] < [3]') ;
ok( 0 == compare_lists([2], [2]) , 'compare_lists, [0] = [2]') ;
ok(+1 == compare_lists([3], [1]) , 'compare_lists, [3] > [1]') ;
ok(-1 == compare_lists(["a"], ["b"]) , 'compare_lists, ["a"] < ["b"]') ;
ok( 0 == compare_lists(["a"], ["a"]) , 'compare_lists, ["a"] = ["a"]') ;
ok( 0 == compare_lists(["ab"], ["ab"]) , 'compare_lists, ["ab"] = ["ab"]') ;
ok(+1 == compare_lists(["b"], ["a"]) , 'compare_lists, ["b"] > ["a"]') ;
ok(-1 == compare_lists(["a"], ["aa"]) , 'compare_lists, ["a"] < ["aa"]') ;
ok(-1 == compare_lists(["a"], ["a", "a"]), 'compare_lists, ["a"] < ["a", "a"]') ;
}
@ -801,7 +962,8 @@ sub get_prefix {
my $r_namespace = $imap->namespace();
$prefix_out = $r_namespace->[0][0][0];
return($prefix_out);
}else{
}
else{
print
"No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
@ -825,7 +987,8 @@ sub get_separator {
if ($imap->has_capability("namespace")) {
$sep_out = $imap->separator();
return($sep_out);
}else{
}
else{
print
"No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
@ -870,7 +1033,8 @@ sub foldersizes {
or warn "Could not find size of message $m: $@\n";
$stot += $s;
}
}else{
}
else{
my $hashref = {};
$smess = $imap->message_count();
unless ($smess == 0) {
@ -932,7 +1096,7 @@ print
print
"From subscribed folders list : ",
map("[$_] ", sort keys(%fs_folders)), "\n"
map("[$_] ", sort keys(%subscribed_folder)), "\n"
if ($subscribed);
sub separator_invert {
@ -1030,7 +1194,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
$error++;
next FOLDER;
}
}else{
}
else{
next FOLDER;
}
}
@ -1051,7 +1216,7 @@ FOLDER: foreach my $f_fold (@f_folders) {
#unless($dry) { $to->expunge() };
}
if ($subscribe and exists $fs_folders{$f_fold}) {
if ($subscribe and exists $subscribed_folder{$f_fold}) {
print "Subscribing to folder $t_fold on destination server\n";
unless($dry) { $to->subscribe($t_fold) };
}
@ -1198,7 +1363,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
$error++;
$mess_size_total_error += $f_size;
next MESS;
}else{
}
else{
# good
# $new_id is an id if the IMAP server has the
# UIDPLUS capability else just a ref
@ -1211,12 +1377,14 @@ FOLDER: foreach my $f_fold (@f_folders) {
$from->expunge() if ($expunge and not $dry);
}
}
}else{
}
else{
$mess_skipped_dry += 1;
}
unlink($message_file);
next MESS;
}else{
}
else{
$debug and print "Message id [$m_id] found in t:$t_fold\n";
$mess_size_total_skipped += $f_size;
$mess_skipped += 1;
@ -1279,7 +1447,8 @@ FOLDER: foreach my $f_fold (@f_folders) {
print "Deleting msg f:#$t_msg in folder $t_fold\n";
$to->delete_message($t_msg) unless ($dry);
}
}else {
}
else {
# Good
$debug and print
"Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n";
@ -1310,6 +1479,9 @@ $timediff = $timeend - $timestart;
stats();
exit(1) if($error);
sub select_msgs {
@ -1426,12 +1598,23 @@ sub get_options
"authuser2=s" => \$authuser2,
"split1=i" => \$split1,
"split2=i" => \$split2,
"tests" => \$tests,
);
$debug and print "get options: [$opt_ret]\n";
$test_builder = Test::More->builder;
$test_builder->no_ending(1);
# just the version
print "$VERSION\n" and exit if ($version) ;
if ($tests) {
$test_builder->no_ending(0);
tests();
exit;
}
# exit with --help option or no option at all
usage() and exit if ($help or ! $numopt) ;
@ -1485,7 +1668,8 @@ sub parse_header_msg1 {
my $key;
if ($skipsize) {
$key = "$m_md5";
}else {
}
else {
$key = "$m_md5:$size";
}
$s_hash->{"$key"}{'5'} = $m_md5;
@ -1669,6 +1853,16 @@ EOF
}
sub tests {
SKIP: {
skip "No test in normal run" if (not $tests);
tests_folder_routines();
tests_compare_lists();
}
}
package Mail::IMAPClient;
@ -1748,25 +1942,25 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending '$string' to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
my ($code, $output) = ("","");
until ( $code ) {
$output = $self->_read_line or close $fh, return undef;
$output = $self->_read_line or $fh->close, return undef;
foreach my $o (@$output) {
$self->_record($count,$o); # $o is already an array ref
($code) = $o->[DATA] =~ /(^\+|^\d+\sNO|^\d+\sBAD)/i;
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
$fh->close;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
$fh->close;
return undef;
}
}
@ -1782,7 +1976,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
_debug $self, "control points to $$control\n" if ref($control) and $self->Debug;
@ -1796,7 +1990,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
}
@ -1804,7 +1998,7 @@ sub append_file2 {
unless ($feedback) {
$self->LastError("Error sending append msg text to IMAP: $!\n");
close $fh;
$fh->close;
return undef;
}
}
@ -1825,16 +2019,16 @@ sub append_file2 {
if ($o->[DATA] =~ /^\*\s+BYE/) {
carp $o->[DATA] if $^W;
$self->State(Unconnected);
close $fh;
$fh->close;
return undef ;
} elsif ( $o->[DATA]=~ /^\d+\s+(NO|BAD)/i ) {
carp $o->[DATA] if $^W;
close $fh;
$fh->close;
return undef;
}
}
}
close $fh;
$fh->close;
if ($code !~ /^OK/i) {
return undef;
@ -1871,15 +2065,18 @@ sub fetch_hash2 {
next unless $uid;
if ( exists $hash->{$uid} ) {
$entry = $hash->{$uid} ;
} else {
}
else {
$hash->{$uid} ||= $entry;
}
} else {
}
else {
my($mid) = $l =~ /^\* (\d+) FETCH/i;
next unless $mid;
if ( exists $hash->{$mid} ) {
$entry = $hash->{$mid} ;
} else {
}
else {
$hash->{$mid} ||= $entry;
}
}
@ -1889,7 +2086,8 @@ sub fetch_hash2 {
$entry->{$w} = $output->[$x+1];
$entry->{$w} =~ s/(?:\x0a?\x0d)+$//g;
chomp $entry->{$w};
} else {
}
else {
$l =~ /\( # open paren followed by ...
(?:.*\s)? # ...optional stuff and a space
\Q$w\E\s # escaped fetch field<sp>
@ -1933,7 +2131,7 @@ sub login2 {
$carp =~ s/^[\S]+ ([^\x0d\x0a]*)\x0d?\x0a/$1/;
carp $carp unless defined wantarray;
return undef;
}
};
return $self;
}
@ -1969,7 +2167,7 @@ sub parse_headers2 {
".peek"
) . "[header]" ;
} else {
}else {
$string = "$msg body" .
# use ".peek" if Peek parameter is a) defined and true, or
# b) undefined, but not if it's defined and untrue:
@ -1992,10 +2190,12 @@ sub parse_headers2 {
if ( my($msgid) = $header =~ /UID\s+(\d+)/ ) {
$h = {};
$headers->{$msgid} = $h;
} else {
}
else {
$h = {};
}
} else {
}
else {
if ( my($msgid) = $header =~ /^\*\s+(\d+)/ ) {
#start of new message header:
$h = {};
@ -2104,7 +2304,8 @@ sub authenticate2 {
if ($Mail::IMAPClient::_CRAM_MD5_ERR) {
$self->LastError($Mail::IMAPClient::_CRAM_MD5_ERR);
carp $Mail::IMAPClient::_CRAM_MD5_ERR if $^W;
} else {
}
else {
$response = \&_cram_md5_2;
}
}
@ -2159,8 +2360,8 @@ sub connect2 {
and $IO::Socket::INET::VERSION eq '1.25'
and !$self->Port;
%$self = (%$self, @_);
my $sock = ($self->Ssl ? IO::Socket::SSL->new : IO::Socket::INET->new);
my $dp = ($self->Ssl ? 'imaps(993)' : 'imap(143)');
my $sock = IO::Socket::INET->new;
my $dp = 'imap(143)';
#print "i01\n";
my $ret = $sock->configure({
PeerAddr => $self->Server ,
@ -2206,7 +2407,8 @@ sub connect2 {
if ($self->User and $self->Password) {
return $self->login ;
} else {
}
else {
return $self;
}
}