mirror of
https://github.com/imapsync/imapsync.git
synced 2025-06-07 13:15:22 +02:00
1.25
This commit is contained in:
parent
22c64d279e
commit
f90d5bb46a
6 changed files with 72 additions and 517 deletions
17
ChangeLog
17
ChangeLog
|
@ -1,15 +1,28 @@
|
||||||
|
|
||||||
RCS file: RCS/imapsync,v
|
RCS file: RCS/imapsync,v
|
||||||
Working file: imapsync
|
Working file: imapsync
|
||||||
head: 1.22
|
head: 1.25
|
||||||
branch:
|
branch:
|
||||||
locks: strict
|
locks: strict
|
||||||
access list:
|
access list:
|
||||||
symbolic names:
|
symbolic names:
|
||||||
keyword substitution: kv
|
keyword substitution: kv
|
||||||
total revisions: 22; selected revisions: 22
|
total revisions: 25; selected revisions: 25
|
||||||
description:
|
description:
|
||||||
----------------------------
|
----------------------------
|
||||||
|
revision 1.25
|
||||||
|
date: 2003/08/23 01:44:33; author: gilles; state: Exp; lines: +18 -12
|
||||||
|
Fixed pb with no UIDPLUS and flags
|
||||||
|
----------------------------
|
||||||
|
revision 1.24
|
||||||
|
date: 2003/08/23 00:05:57; author: gilles; state: Exp; lines: +13 -5
|
||||||
|
Added server software output
|
||||||
|
Added server capability output
|
||||||
|
----------------------------
|
||||||
|
revision 1.23
|
||||||
|
date: 2003/08/22 21:55:01; author: gilles; state: Exp; lines: +37 -8
|
||||||
|
Added code to better sync flags
|
||||||
|
----------------------------
|
||||||
revision 1.22
|
revision 1.22
|
||||||
date: 2003/08/22 17:17:18; author: gilles; state: Exp; lines: +22 -17
|
date: 2003/08/22 17:17:18; author: gilles; state: Exp; lines: +22 -17
|
||||||
Added code to underdstand why Daniele can't create folders
|
Added code to underdstand why Daniele can't create folders
|
||||||
|
|
7
Makefile
7
Makefile
|
@ -1,5 +1,5 @@
|
||||||
|
|
||||||
# $Id: Makefile,v 1.3 2003/05/05 22:55:25 gilles Exp $
|
# $Id: Makefile,v 1.4 2003/08/23 01:55:43 gilles Exp $
|
||||||
|
|
||||||
TARGET=imapsync
|
TARGET=imapsync
|
||||||
|
|
||||||
|
@ -14,7 +14,7 @@ usage:
|
||||||
@echo make testv # run tests verbosely
|
@echo make testv # run tests verbosely
|
||||||
@echo make all
|
@echo make all
|
||||||
|
|
||||||
all: test ChangeLog README VERSION
|
all: ChangeLog README VERSION
|
||||||
|
|
||||||
.PHONY: test testp testf
|
.PHONY: test testp testf
|
||||||
|
|
||||||
|
@ -61,7 +61,7 @@ DIST_NAME=$(TARGET)-$(VERSION)
|
||||||
DIST_FILE=$(DIST_NAME).tgz
|
DIST_FILE=$(DIST_NAME).tgz
|
||||||
VERSION=$(shell ./$(TARGET) --version)
|
VERSION=$(shell ./$(TARGET) --version)
|
||||||
|
|
||||||
dist: cidone clean_dist all INSTALL
|
dist: cidone test clean clean_dist all INSTALL
|
||||||
echo making tarball $(DIST_FILE)
|
echo making tarball $(DIST_FILE)
|
||||||
mkdir -p dist
|
mkdir -p dist
|
||||||
mkdir -p ../prepa_dist/$(DIST_NAME)
|
mkdir -p ../prepa_dist/$(DIST_NAME)
|
||||||
|
@ -72,7 +72,6 @@ dist: cidone clean_dist all INSTALL
|
||||||
cd dist && md5sum -c $(DIST_FILE).md5
|
cd dist && md5sum -c $(DIST_FILE).md5
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
.PHONY: cidone clean_dist
|
.PHONY: cidone clean_dist
|
||||||
|
|
||||||
cidone:
|
cidone:
|
||||||
|
|
4
README
4
README
|
@ -1,7 +1,7 @@
|
||||||
NAME
|
NAME
|
||||||
imapsync - synchronize mailboxes between two imap servers.
|
imapsync - synchronize mailboxes between two imap servers.
|
||||||
|
|
||||||
$Revision: 1.22 $
|
$Revision: 1.25 $
|
||||||
|
|
||||||
INSTALL
|
INSTALL
|
||||||
Get imapsync at http://www.linux-france.org/prj/imapsync/dist/
|
Get imapsync at http://www.linux-france.org/prj/imapsync/dist/
|
||||||
|
@ -115,5 +115,5 @@ SIMILAR SOFTWARES
|
||||||
|
|
||||||
Feedback (good or bad) will be always welcome.
|
Feedback (good or bad) will be always welcome.
|
||||||
|
|
||||||
$Id: imapsync,v 1.22 2003/08/22 17:17:18 gilles Exp $
|
$Id: imapsync,v 1.25 2003/08/23 01:44:33 gilles Exp $
|
||||||
|
|
||||||
|
|
2
VERSION
2
VERSION
|
@ -1 +1 @@
|
||||||
1.22
|
1.25
|
||||||
|
|
500
aaa
500
aaa
|
@ -1,500 +0,0 @@
|
||||||
#!/usr/bin/perl -w
|
|
||||||
|
|
||||||
=head1 NAME
|
|
||||||
|
|
||||||
imapsync - synchronize mailboxes between two imap servers.
|
|
||||||
|
|
||||||
$Revision: 1.21 $
|
|
||||||
|
|
||||||
=head1 INSTALL
|
|
||||||
|
|
||||||
Get imapsync at http://www.linux-france.org/prj/imapsync/dist/
|
|
||||||
tar xzvf imapsync-x.xx.tgz # x.xx is the version number
|
|
||||||
Read the INSTALL file.
|
|
||||||
freshmeat record: http://freshmeat.net/projects/imapsync/
|
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
|
||||||
|
|
||||||
imapsync [options]
|
|
||||||
|
|
||||||
imapsync --help
|
|
||||||
imapsync
|
|
||||||
|
|
||||||
imapsync [--host1 server1] [--port1 <num>]
|
|
||||||
[--user1 <string>] [--passfile1 <string>]
|
|
||||||
[--host2 server2] [--port2 <num>]
|
|
||||||
[--user2 <string>] [--passfile2 <string>]
|
|
||||||
[--folder <string> --folder <string> ...]
|
|
||||||
[--delete] [--expunge]
|
|
||||||
[--dry]
|
|
||||||
[--debug] [--debugimap]
|
|
||||||
[--version] [--help]
|
|
||||||
|
|
||||||
=cut
|
|
||||||
# comment
|
|
||||||
=pod
|
|
||||||
|
|
||||||
=head1 DESCRIPTION
|
|
||||||
|
|
||||||
The command imapsync is a tool allowing incremental and recursive
|
|
||||||
imap transfer from one mailbox to another.
|
|
||||||
|
|
||||||
We sometimes need to transfer mailboxes from one imap server to
|
|
||||||
another. This is called migration.
|
|
||||||
|
|
||||||
imapsync is the adequate tool because it reduces the amount of data
|
|
||||||
transfered by not transfering a given message if it is already on
|
|
||||||
both sides. All flags are preserved, unread will stay unread, read
|
|
||||||
will stay read, deleted will stay deleted. You can stop the
|
|
||||||
transfert at any time and restart it later, imapsync is adapted
|
|
||||||
to a bad connection.
|
|
||||||
|
|
||||||
You can decide to delete the messages from the source mailbox
|
|
||||||
after a successful transfert (it is a good feature when migrating).
|
|
||||||
In that case, use the --delete option, and run imapsync again
|
|
||||||
with the --expunge option.
|
|
||||||
|
|
||||||
You can also just synchronize a mailbox A from another mailbox B
|
|
||||||
in case you just want to keep a "live" copy of B in A.
|
|
||||||
|
|
||||||
=head1 OPTIONS
|
|
||||||
|
|
||||||
Invoke: imapsync --help
|
|
||||||
|
|
||||||
=head1 HISTORY
|
|
||||||
|
|
||||||
I wrote imapsync because an enterprise (basystemes) paid me to install
|
|
||||||
a new imap server without loosing huge old mailboxes located on a far
|
|
||||||
away remote imap server accessible by a low bandwith link. The tool
|
|
||||||
imapcp (written in python) could not help me because I had to verify
|
|
||||||
every mailbox was well
|
|
||||||
transfered and delete it after a good transfert. imapsync started its life
|
|
||||||
being a copy_folder.pl patch.
|
|
||||||
The tool copy_folder.pl comes from the Mail-IMAPClient-2.1.3 perl
|
|
||||||
module tarball source (in the examples/ directory of the tarball).
|
|
||||||
|
|
||||||
=head1 EXAMPLES
|
|
||||||
|
|
||||||
While working on imapsync parameters please run imapsync in dry mode (no
|
|
||||||
modification induced) with the --dry option. Nothing bad can be done
|
|
||||||
this way.
|
|
||||||
|
|
||||||
To synchronize the imap account "buddy" on host "imap.src.fr" to the
|
|
||||||
imap account "max" on host "imap.dest.fr" (the passwords are located
|
|
||||||
in too files "/etc/secret1" for "buddy", "/etc/secret2" for "max") :
|
|
||||||
|
|
||||||
imapsync --host1 imap.src.fr --user1 buddy --passfile1 /etc/secret1 \
|
|
||||||
--host2 imap.dest.fr --user2 max --passfile2 /etc/secret2
|
|
||||||
|
|
||||||
Then, you will have buddy's mailbox updated from max's mailbox.
|
|
||||||
|
|
||||||
=head1 EXIT STATUS
|
|
||||||
|
|
||||||
imapsync will exit with a 0 status (return code) if everything went good.
|
|
||||||
Otherwise, it exits with a non-zero status.
|
|
||||||
|
|
||||||
So if you have a buggy internet connection, you can use this loop
|
|
||||||
in a Bourne shell:
|
|
||||||
|
|
||||||
while ! imapsync ...; do
|
|
||||||
echo imapsync not complete
|
|
||||||
done
|
|
||||||
|
|
||||||
=head1 AUTHOR
|
|
||||||
|
|
||||||
Gilles LAMIRAL lamiral@linux-france.org
|
|
||||||
|
|
||||||
=head1 LICENSE
|
|
||||||
|
|
||||||
imapsync is free, gratis and open source software cover by the GNU General
|
|
||||||
Public License. See the GPL file included in the distribution or the web site
|
|
||||||
http://www.gnu.org/licenses/licenses.html
|
|
||||||
|
|
||||||
=head1 BUGS
|
|
||||||
|
|
||||||
No known bug.
|
|
||||||
Report any bugs to the author: lamiral@linux-france.org
|
|
||||||
|
|
||||||
=head1 IMAP SERVERS
|
|
||||||
|
|
||||||
Success stories reported :
|
|
||||||
|
|
||||||
- Courier IMAP 1.5.1
|
|
||||||
- Cyrus IMAP 1.5, 1.6, 2.1
|
|
||||||
- Netscape Mail Server 3.6 (Wintel)
|
|
||||||
- CommunicatePro server (Redhat 8.0)
|
|
||||||
|
|
||||||
Please report to the author any success or bad story with imapsync and
|
|
||||||
don't forget to mention the IMAP server software names and version on
|
|
||||||
both sides. This will help future users.
|
|
||||||
|
|
||||||
=head1 SIMILAR SOFTWARES
|
|
||||||
|
|
||||||
offlineimap : http://gopher.quux.org:70/devel/offlineimap/
|
|
||||||
mailsync : http://mailsync.sourceforge.net/
|
|
||||||
imapxfer : http://www.washington.edu/imap/
|
|
||||||
part of the imap-utils from UW.
|
|
||||||
|
|
||||||
Feedback (good or bad) will be always welcome.
|
|
||||||
|
|
||||||
$Id: imapsync,v 1.21 2003/08/22 16:25:07 gilles Exp gilles $
|
|
||||||
|
|
||||||
=cut
|
|
||||||
|
|
||||||
|
|
||||||
++$|;
|
|
||||||
use strict;
|
|
||||||
use Getopt::Long;
|
|
||||||
use Mail::IMAPClient;
|
|
||||||
use Digest::MD5 qw(md5_base64);
|
|
||||||
|
|
||||||
my(
|
|
||||||
$rcs, $debug, $debugimap, $error,
|
|
||||||
$host1, $host2, $port1, $port2,
|
|
||||||
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
|
|
||||||
@folder,
|
|
||||||
$delete, $expunge, $dry,
|
|
||||||
$version, $VERSION, $help,
|
|
||||||
);
|
|
||||||
|
|
||||||
use vars qw ($opt_G); # missing code for this will be option.
|
|
||||||
|
|
||||||
|
|
||||||
$rcs = ' $Id: imapsync,v 1.21 2003/08/22 16:25:07 gilles Exp gilles $ ';
|
|
||||||
$rcs =~ m/,v (\d+\.\d+)/;
|
|
||||||
$VERSION = ($1) ? $1 : "UNKNOWN";
|
|
||||||
$error=0;
|
|
||||||
|
|
||||||
my $banner = '$RCSfile: imapsync,v $ ' . '$Revision: 1.21 $ ' . '$Date: 2003/08/22 16:25:07 $ ' . "\n";
|
|
||||||
|
|
||||||
|
|
||||||
get_options();
|
|
||||||
print $banner;
|
|
||||||
|
|
||||||
sub missing_option {
|
|
||||||
my ($option) = @_;
|
|
||||||
die "$option option must be used, run $0 --help for help\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
$host1 || missing_option("--host1") ;
|
|
||||||
$port1 = (defined($port1)) ? $port1 : 143;
|
|
||||||
$user1 || missing_option("--user1");
|
|
||||||
$password1 || $passfile1 || missing_option("--passfile1 or --password1");
|
|
||||||
$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1;
|
|
||||||
|
|
||||||
$host2 || missing_option("--host2") ;
|
|
||||||
$port2 = (defined($port2)) ? $port2 : 143;
|
|
||||||
$user2 || missing_option("--user2");
|
|
||||||
$password2 || $passfile2 || missing_option("--passfile2 or --password2");
|
|
||||||
$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2;
|
|
||||||
|
|
||||||
print "From imap server [$host1] port [$port1] user [$user1]\n";
|
|
||||||
print "To imap server [$host2] port [$port2] user [$user2]\n";
|
|
||||||
|
|
||||||
my $from = ();
|
|
||||||
my $to = ();
|
|
||||||
|
|
||||||
$from = Mail::IMAPClient->new( Server => $host1,
|
|
||||||
Port => $port1,
|
|
||||||
User => $user1,
|
|
||||||
Password => $password1,
|
|
||||||
Fast_IO => 1,
|
|
||||||
Uid => 1,
|
|
||||||
Peek => 1,
|
|
||||||
Debug => $debugimap,
|
|
||||||
)
|
|
||||||
or die "can't open imap connection on [$host1] with user [$user1]\n";
|
|
||||||
|
|
||||||
|
|
||||||
$to = Mail::IMAPClient->new( Server => $host2,
|
|
||||||
Port => $port2,
|
|
||||||
User => $user2,
|
|
||||||
Password => $password2,
|
|
||||||
Fast_IO => 1,
|
|
||||||
Uid => 1,
|
|
||||||
Peek => 1,
|
|
||||||
Debug => $debugimap,
|
|
||||||
)
|
|
||||||
or die "can't open imap connection on [$host2] with user [$user2]\n";
|
|
||||||
|
|
||||||
my (@f_folders, @t_folders);
|
|
||||||
@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()};
|
|
||||||
|
|
||||||
# what are the private folders separators for each server ?
|
|
||||||
my $f_sep = $from->namespace()->[0][0][1];
|
|
||||||
my $t_sep = $to->namespace()->[0][0][1];
|
|
||||||
|
|
||||||
#if (scalar(@folder)) {
|
|
||||||
# # folders are given as argument.
|
|
||||||
# foreach my $f_fold (@folder) {
|
|
||||||
# push (@f_folders, @{$from->folders($f_fold)});
|
|
||||||
# }
|
|
||||||
#}else{
|
|
||||||
# # no folder given so select all
|
|
||||||
# @f_folders = @{$from->folders()};
|
|
||||||
#}
|
|
||||||
|
|
||||||
@t_folders = @{$to->folders()};
|
|
||||||
print
|
|
||||||
"From folders : ", map("[$_] ",@f_folders),"\n",
|
|
||||||
"To folders : ", map("[$_] ",@f_folders),"\n";
|
|
||||||
#exit;
|
|
||||||
|
|
||||||
FOLDER: foreach my $f_fold (@f_folders) {
|
|
||||||
my $t_fold;
|
|
||||||
print "From Folder [$f_fold]\n";
|
|
||||||
$t_fold =~ s@\$f_sep@\$t_sep@g;
|
|
||||||
print "To Folder [$t_fold]\n";
|
|
||||||
unless ($from->select($f_fold)) {
|
|
||||||
warn
|
|
||||||
"From Folder $f_fold : Could not select ",
|
|
||||||
$from->LastError, "\n";
|
|
||||||
$error++;
|
|
||||||
next FOLDER;
|
|
||||||
}
|
|
||||||
unless ($to->exists($t_fold)) {
|
|
||||||
print "To Folder $t_fold does not exist\n";
|
|
||||||
print "Creating folder [$t_fold]\n";
|
|
||||||
unless ($dry){
|
|
||||||
unless ($to->create($t_fold)){
|
|
||||||
warn "Couldn't create [$t_fold]",
|
|
||||||
$to->LastError,"\n";
|
|
||||||
$error++;
|
|
||||||
next FOLDER;
|
|
||||||
}
|
|
||||||
}else{
|
|
||||||
next FOLDER;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
unless ($to->select($t_fold)) {
|
|
||||||
warn
|
|
||||||
"To Folder $t_fold : Could not select ",
|
|
||||||
$to->LastError, "\n";
|
|
||||||
$error++;
|
|
||||||
next FOLDER;
|
|
||||||
}
|
|
||||||
|
|
||||||
if ($expunge){
|
|
||||||
print "Expunging $f_fold and $t_fold\n";
|
|
||||||
$from->expunge();
|
|
||||||
$to->expunge();
|
|
||||||
}
|
|
||||||
|
|
||||||
my @f_msgs = $from->search("ALL");
|
|
||||||
$debug and print "LIST FROM : @f_msgs\n";
|
|
||||||
my @t_msgs = $to->search("ALL");
|
|
||||||
$debug and print "LIST TO : @t_msgs\n";
|
|
||||||
|
|
||||||
my %f_hash = ();
|
|
||||||
my %t_hash = ();
|
|
||||||
|
|
||||||
sub header_parse {
|
|
||||||
# @msgs_all;
|
|
||||||
# %hash;
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
$debug and print "From Parse\n";
|
|
||||||
foreach my $m (@f_msgs) {
|
|
||||||
$debug and print "-" x 50, "\nMSG $m\n";
|
|
||||||
my $head = $from->parse_headers($m,"ALL");
|
|
||||||
my $headstr;
|
|
||||||
$debug and print "Head NUM:", scalar(keys(%$head)), "\n";
|
|
||||||
next unless(scalar(keys(%$head)));
|
|
||||||
foreach my $h (sort keys(%$head)){
|
|
||||||
my $val = $head->{$h}[0];
|
|
||||||
# no accent in headers !
|
|
||||||
$val =~ y/éèàù/XXXX/;
|
|
||||||
$debug and print "H $h:", $val, "\n";
|
|
||||||
$headstr .= "$h:". $val;
|
|
||||||
}
|
|
||||||
my $m_md5 = md5_base64($headstr);
|
|
||||||
my $size = $from->size($m);
|
|
||||||
$debug and print "From $m:$m_md5:$size\n";
|
|
||||||
|
|
||||||
$f_hash{"$m_md5:$size"}{'5'} = "$m_md5:$size";
|
|
||||||
$f_hash{"$m_md5:$size"}{'s'} = $size;
|
|
||||||
$f_hash{"$m_md5:$size"}{'m'} = $m;
|
|
||||||
}
|
|
||||||
|
|
||||||
$debug and print "To Parse\n";
|
|
||||||
foreach my $m (@t_msgs) {
|
|
||||||
$debug and print "-" x 50, "\nMSG $m\n";
|
|
||||||
my $head = $to->parse_headers($m,"ALL");
|
|
||||||
my $headstr;
|
|
||||||
$debug and print "Head NUM:", scalar(keys(%$head)), "\n";
|
|
||||||
next unless(scalar(keys(%$head)));
|
|
||||||
foreach my $h (sort keys(%$head)){
|
|
||||||
$debug and print "$h:", $head->{$h}[0], "\n";
|
|
||||||
$headstr .= "$h:".$head->{$h}[0];
|
|
||||||
}
|
|
||||||
my $m_md5 = md5_base64($headstr);
|
|
||||||
my $size = $to->size($m);
|
|
||||||
$debug and print "To $m:$m_md5:$size\n";
|
|
||||||
$t_hash{"$m_md5:$size"}{'5'} = "$m_md5:$size";
|
|
||||||
$t_hash{"$m_md5:$size"}{'s'} = $size;
|
|
||||||
$t_hash{"$m_md5:$size"}{'m'} = $m;
|
|
||||||
}
|
|
||||||
$debug and print "Verifying\n";
|
|
||||||
# messages in "from" that are not good in "to"
|
|
||||||
|
|
||||||
MESS: foreach my $m_id (keys(%f_hash)) {
|
|
||||||
my $f_size = $f_hash{$m_id}{'s'};
|
|
||||||
my $f_msg = $f_hash{$m_id}{'m'};
|
|
||||||
$debug and print "key $m_id #$f_msg\n";
|
|
||||||
unless (exists($t_hash{$m_id})) {
|
|
||||||
print "Message NO msg #$f_msg [$m_id] in $t_fold\n";
|
|
||||||
# copy
|
|
||||||
print "Copying msg #$f_msg:$f_size to folder $t_fold\n";
|
|
||||||
unless ($dry) {
|
|
||||||
my $string = $from->message_string($f_msg);
|
|
||||||
#$opt_y and print $string;
|
|
||||||
my $new_id;
|
|
||||||
unless($new_id = $to->append($t_fold,$string)){
|
|
||||||
warn "Couldn't append msg #$f_msg to folder $t_fold",
|
|
||||||
$to->LastError, "\n";
|
|
||||||
$error++;
|
|
||||||
next MESS;
|
|
||||||
}else{
|
|
||||||
# good
|
|
||||||
# $new_id is an id if the IMAP server has the
|
|
||||||
# UIDPLUS capability else just a ref
|
|
||||||
|
|
||||||
print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
|
|
||||||
$to->store($new_id,
|
|
||||||
"+FLAGS (" . join(" ",
|
|
||||||
@{$from->flags($f_msg)}
|
|
||||||
) . ")");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
next MESS;
|
|
||||||
}else{
|
|
||||||
$debug and print "Message id [$m_id] found in t:$t_fold\n";
|
|
||||||
}
|
|
||||||
#$debug and print "MESSAGE $m_id\n";
|
|
||||||
my $t_size = $t_hash{$m_id}{'s'};
|
|
||||||
my $t_msg = $t_hash{$m_id}{'m'};
|
|
||||||
unless ($f_size == $t_size) {
|
|
||||||
print
|
|
||||||
"Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n";
|
|
||||||
# delete in to and recopy ?
|
|
||||||
# NO recopy CODE HERE. to be written if needed.
|
|
||||||
$error++;
|
|
||||||
if ($opt_G){
|
|
||||||
print "Deleting msg f:#$t_msg in folder $t_fold\n";
|
|
||||||
$to->delete_message($t_msg);
|
|
||||||
}
|
|
||||||
}else {
|
|
||||||
# Good
|
|
||||||
$debug and print
|
|
||||||
"Message $m_id SZ_GOOD f:$f_msg:$f_size t:$t_msg:$t_size\n";
|
|
||||||
if($delete) {
|
|
||||||
print "Deleting msg #$f_msg in folder $f_fold\n";
|
|
||||||
$from->delete_message($f_msg);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
stats();
|
|
||||||
|
|
||||||
exit(1) if($error);
|
|
||||||
|
|
||||||
sub stats {
|
|
||||||
print "Detected $error errors\n";
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub get_options
|
|
||||||
{
|
|
||||||
my $numopt = scalar(@ARGV);
|
|
||||||
my $opt_ret = GetOptions(
|
|
||||||
"debug" => \$debug,
|
|
||||||
"debugimap" => \$debugimap,
|
|
||||||
"host1=s" => \$host1,
|
|
||||||
"host2=s" => \$host2,
|
|
||||||
"port1=i" => \$port1,
|
|
||||||
"port2=i" => \$port2,
|
|
||||||
"user1=s" => \$user1,
|
|
||||||
"user2=s" => \$user2,
|
|
||||||
"password1=s" => \$password1,
|
|
||||||
"password2=s" => \$password2,
|
|
||||||
"passfile1=s" => \$passfile1,
|
|
||||||
"passfile2=s" => \$passfile2,
|
|
||||||
"folder=s" => \@folder,
|
|
||||||
"delete!" => \$delete,
|
|
||||||
"dry!" => \$dry,
|
|
||||||
"expunge!" => \$expunge,
|
|
||||||
"version" => \$version,
|
|
||||||
"help" => \$help,
|
|
||||||
);
|
|
||||||
|
|
||||||
$debug and print "get options: [$opt_ret]\n";
|
|
||||||
print "$VERSION\n" and exit if ($version) ;
|
|
||||||
usage() and exit if ($help or ! $numopt) ;
|
|
||||||
exit unless ($opt_ret) ;
|
|
||||||
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
sub firstline {
|
|
||||||
# extract the first line of a file (without \n)
|
|
||||||
|
|
||||||
my($file) = @_;
|
|
||||||
my $line = "";
|
|
||||||
|
|
||||||
open FILE, $file or die("$! $file");
|
|
||||||
chomp($line = <FILE>);
|
|
||||||
close FILE;
|
|
||||||
$line = ($line) ? $line : "!EMPTY! $file";
|
|
||||||
return $line;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub usage {
|
|
||||||
print <<EOF;
|
|
||||||
|
|
||||||
usage: $0 [options]
|
|
||||||
|
|
||||||
Several options are mandatory.
|
|
||||||
|
|
||||||
--host1 <string> : "from" imap server. Mandatory.
|
|
||||||
--port1 <int> : port to connect. Default is 143.
|
|
||||||
--user1 <string> : user to login. Mandatory.
|
|
||||||
--password1 <string> : password for the user1. Dangerous, use --passfile1
|
|
||||||
--passfile1 <string> : password file for the user1. Contains the password.
|
|
||||||
--host2 <string> : "destination" imap server. Mandatory.
|
|
||||||
--port2 <int> : port to connect. Default is 143.
|
|
||||||
--user2 <string> : user to login. Mandatory.
|
|
||||||
--password2 <string> : password for the user2. Dangerous, use --passfile2
|
|
||||||
--passfile2 <string> : password file for the user2. Contains the password.
|
|
||||||
--folder <string> : sync only this folder and its children.
|
|
||||||
--folder <string> : and this one (and its children).
|
|
||||||
--folder <string> : and this one, etc.
|
|
||||||
--delete : delete messages in "from" imap server after
|
|
||||||
a successful transfert. useful in case you
|
|
||||||
want to migrate from one server to another one.
|
|
||||||
With imap, delete tags messages as deleted, they
|
|
||||||
are not really deleted. See expunge.
|
|
||||||
--expunge : expunge messages on both account.
|
|
||||||
expunge delete messages marked deleted.
|
|
||||||
--dry : do nothing, just print what would be done.
|
|
||||||
--debug : debug mode.
|
|
||||||
--debugimap : imap debug mode.
|
|
||||||
--version : print sotfware version.
|
|
||||||
--help : print this.
|
|
||||||
|
|
||||||
Example: to synchronise imap account "foo" on "imap.truc.org"
|
|
||||||
to imap account "bar" on "imap.trac.org"
|
|
||||||
|
|
||||||
$0 \\
|
|
||||||
--host1 imap.troc.org --user1 foo --passfile1 /etc/secret1 \\
|
|
||||||
--host2 imap.trac.org --user2 bar --passfile2 /etc/secret2
|
|
||||||
|
|
||||||
|
|
||||||
$rcs
|
|
||||||
imapsync copyleft is the GNU General Public License.
|
|
||||||
EOF
|
|
||||||
}
|
|
59
imapsync
59
imapsync
|
@ -4,7 +4,7 @@
|
||||||
|
|
||||||
imapsync - synchronize mailboxes between two imap servers.
|
imapsync - synchronize mailboxes between two imap servers.
|
||||||
|
|
||||||
$Revision: 1.22 $
|
$Revision: 1.25 $
|
||||||
|
|
||||||
=head1 INSTALL
|
=head1 INSTALL
|
||||||
|
|
||||||
|
@ -137,7 +137,7 @@ both sides. This will help future users.
|
||||||
|
|
||||||
Feedback (good or bad) will be always welcome.
|
Feedback (good or bad) will be always welcome.
|
||||||
|
|
||||||
$Id: imapsync,v 1.22 2003/08/22 17:17:18 gilles Exp $
|
$Id: imapsync,v 1.25 2003/08/23 01:44:33 gilles Exp $
|
||||||
|
|
||||||
=cut
|
=cut
|
||||||
|
|
||||||
|
@ -160,12 +160,12 @@ my(
|
||||||
use vars qw ($opt_G); # missing code for this will be option.
|
use vars qw ($opt_G); # missing code for this will be option.
|
||||||
|
|
||||||
|
|
||||||
$rcs = ' $Id: imapsync,v 1.22 2003/08/22 17:17:18 gilles Exp $ ';
|
$rcs = ' $Id: imapsync,v 1.25 2003/08/23 01:44:33 gilles Exp $ ';
|
||||||
$rcs =~ m/,v (\d+\.\d+)/;
|
$rcs =~ m/,v (\d+\.\d+)/;
|
||||||
$VERSION = ($1) ? $1 : "UNKNOWN";
|
$VERSION = ($1) ? $1 : "UNKNOWN";
|
||||||
$error=0;
|
$error=0;
|
||||||
|
|
||||||
my $banner = '$RCSfile: imapsync,v $ ' . '$Revision: 1.22 $ ' . '$Date: 2003/08/22 17:17:18 $ ' . "\n";
|
my $banner = '$RCSfile: imapsync,v $ ' . '$Revision: 1.25 $ ' . '$Date: 2003/08/23 01:44:33 $ ' . "\n";
|
||||||
|
|
||||||
|
|
||||||
get_options();
|
get_options();
|
||||||
|
@ -194,6 +194,7 @@ print "To imap server [$host2] port [$port2] user [$user2]\n";
|
||||||
my $from = ();
|
my $from = ();
|
||||||
my $to = ();
|
my $to = ();
|
||||||
|
|
||||||
|
$debugimap and print "To connection\n";
|
||||||
$from = Mail::IMAPClient->new( Server => $host1,
|
$from = Mail::IMAPClient->new( Server => $host1,
|
||||||
Port => $port1,
|
Port => $port1,
|
||||||
User => $user1,
|
User => $user1,
|
||||||
|
@ -205,7 +206,7 @@ $from = Mail::IMAPClient->new( Server => $host1,
|
||||||
)
|
)
|
||||||
or die "can't open imap connection on [$host1] with user [$user1]\n";
|
or die "can't open imap connection on [$host1] with user [$user1]\n";
|
||||||
|
|
||||||
|
$debugimap and print "From connection\n";
|
||||||
$to = Mail::IMAPClient->new( Server => $host2,
|
$to = Mail::IMAPClient->new( Server => $host2,
|
||||||
Port => $port2,
|
Port => $port2,
|
||||||
User => $user2,
|
User => $user2,
|
||||||
|
@ -217,6 +218,13 @@ $to = Mail::IMAPClient->new( Server => $host2,
|
||||||
)
|
)
|
||||||
or die "can't open imap connection on [$host2] with user [$user2]\n";
|
or die "can't open imap connection on [$host2] with user [$user2]\n";
|
||||||
|
|
||||||
|
|
||||||
|
print "From software : ", ($from->Report())[0];
|
||||||
|
print "To software : ", ($to->Report())[0];
|
||||||
|
|
||||||
|
print "From capability : ", join(" ", $from->capability()), "\n";
|
||||||
|
print "To capability : ", join(" ", $to->capability()), "\n";
|
||||||
|
|
||||||
my (@f_folders, @t_folders);
|
my (@f_folders, @t_folders);
|
||||||
@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()};
|
@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()};
|
||||||
|
|
||||||
|
@ -224,6 +232,9 @@ my (@f_folders, @t_folders);
|
||||||
my $f_sep = $from->namespace()->[0][0][1];
|
my $f_sep = $from->namespace()->[0][0][1];
|
||||||
my $t_sep = $to->namespace()->[0][0][1];
|
my $t_sep = $to->namespace()->[0][0][1];
|
||||||
|
|
||||||
|
# needed for setting flags
|
||||||
|
my $tohasuidplus = $to->has_capability("UIDPLUS");
|
||||||
|
|
||||||
#if (scalar(@folder)) {
|
#if (scalar(@folder)) {
|
||||||
# # folders are given as argument.
|
# # folders are given as argument.
|
||||||
# foreach my $f_fold (@folder) {
|
# foreach my $f_fold (@folder) {
|
||||||
|
@ -365,20 +376,52 @@ sub header_parse {
|
||||||
# UIDPLUS capability else just a ref
|
# UIDPLUS capability else just a ref
|
||||||
|
|
||||||
print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
|
print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
|
||||||
|
|
||||||
|
unless ($tohasuidplus) {
|
||||||
|
next MESS;
|
||||||
|
}
|
||||||
|
print "Setting flags (UIDPLUS welcome)\n";
|
||||||
|
my @flags_f = @{$from->flags($f_msg)};
|
||||||
|
|
||||||
|
$debugimap and print "Store flags [@flags_f]";
|
||||||
$to->store($new_id,
|
$to->store($new_id,
|
||||||
"+FLAGS (" . join(" ",
|
"+FLAGS (" . join(" ", @flags_f) . ")"
|
||||||
@{$from->flags($f_msg)}
|
);
|
||||||
) . ")");
|
my @flags_t;
|
||||||
|
my $flags_t = $to->flags($new_id);
|
||||||
|
# a bug ?
|
||||||
|
if ($flags_t) {
|
||||||
|
@flags_t = @$flags_t;
|
||||||
|
print
|
||||||
|
"flags from : @flags_f\n",
|
||||||
|
"flags to : @flags_t\n";
|
||||||
|
}else{
|
||||||
|
print "To flags could not be retrieved\n"
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
next MESS;
|
next MESS;
|
||||||
}else{
|
}else{
|
||||||
$debug and print "Message id [$m_id] found in t:$t_fold\n";
|
$debug and print "Message id [$m_id] found in t:$t_fold\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
#$debug and print "MESSAGE $m_id\n";
|
#$debug and print "MESSAGE $m_id\n";
|
||||||
my $t_size = $t_hash{$m_id}{'s'};
|
my $t_size = $t_hash{$m_id}{'s'};
|
||||||
my $t_msg = $t_hash{$m_id}{'m'};
|
my $t_msg = $t_hash{$m_id}{'m'};
|
||||||
|
|
||||||
|
$debug and print "Setting flags\n";
|
||||||
|
my (@flags_f,@flags_t);
|
||||||
|
@flags_f = @{$from->flags($f_msg)};
|
||||||
|
$to->store($t_msg,
|
||||||
|
"+FLAGS (" . join(" ", @flags_f) . ")"
|
||||||
|
);
|
||||||
|
@flags_t = @{$to->flags($t_msg)};
|
||||||
|
$debug and print
|
||||||
|
"flags from : @flags_f\n",
|
||||||
|
"flags to : @flags_t\n";
|
||||||
|
|
||||||
unless ($f_size == $t_size) {
|
unless ($f_size == $t_size) {
|
||||||
|
# Bad size
|
||||||
print
|
print
|
||||||
"Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n";
|
"Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n";
|
||||||
# delete in to and recopy ?
|
# delete in to and recopy ?
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue