mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-17 00:02:29 +01:00
862 lines
25 KiB
Perl
Executable File
862 lines
25 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
|
|
=head1 NAME
|
|
|
|
imapsync - IMAP sync or copy tool. Synchronize mailboxes between two imap servers.
|
|
|
|
$Revision: 1.77 $
|
|
|
|
=head1 INSTALL
|
|
|
|
imapsync works fine under any Unix OS.
|
|
imapsync works fine under Windows 2000 (at least) and ActiveState's 5.8 Perl
|
|
|
|
Get imapsync at
|
|
http://www.linux-france.org/prj/imapsync/dist/
|
|
|
|
You'll find a compressed tarball called imapsync-x.xx.tgz
|
|
where x.xx is the version number. Untar the tarball where
|
|
you want :
|
|
|
|
tar xzvf imapsync-x.xx.tgz
|
|
|
|
Go into the directory imapsync-x.xx and read the INSTALL
|
|
file.
|
|
|
|
The freshmeat record is 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> ...]
|
|
[--include <regex>] [--exclude <regex>]
|
|
[--prefix2 <string>]
|
|
[--sep1 <char>]
|
|
[--sep2 <char>]
|
|
[--syncinternaldates]
|
|
[--maxsize <int>]
|
|
[--maxage <int>]
|
|
[--delete] [--expunge]
|
|
[--subscribed] [--subscribe]
|
|
[--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 SECURITY
|
|
|
|
You can use --password1 instead of --passfile1 to give the
|
|
password but it is dangerous because any user on your host
|
|
can see the password by using the 'ps auxwwww'
|
|
command. Using a variable (like $PASSWORD1) is also
|
|
dangerous because of the 'ps auxwwwwe' command. So, saving
|
|
the password in a well protected file (600 or rw-------) is
|
|
the best solution.
|
|
|
|
imasync is not protected against sniffers on the network so
|
|
the passwords are in plain text.
|
|
|
|
|
|
=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 serious bug.
|
|
|
|
Flags : with some IMAP servers the flags are not very well copied the
|
|
first time. Run imapsync twice if you want the flags set correctly.
|
|
(fixed since 1.28 release but wait for a time before removing those
|
|
lines)
|
|
|
|
Report any bugs to the author: lamiral@linux-france.org
|
|
|
|
=head1 IMAP SERVERS
|
|
|
|
Success stories reported (softwares in alphabetic order) :
|
|
|
|
- BincImap 1.2.3
|
|
- CommunicatePro server (Redhat 8.0)
|
|
- Courier IMAP 1.5.1, 2.2.0, 2.1.1
|
|
- Critical Path (7.0.020)
|
|
- Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.1.16, 2.2.1, Cyrus 2.2.2-BETA
|
|
- DBMail 1.2.1
|
|
- Dovecot 0.99.10.4
|
|
- iPlanet Messaging server 4.15
|
|
- Netscape Mail Server 3.6 (Wintel !)
|
|
- SunONE Messaging server 5.2, 6.0 (SUN JES - Java Enterprise System)
|
|
- UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287
|
|
- UW - QMail v2.1
|
|
|
|
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. To help the author maintaining this section
|
|
report the two lines at the begining of the output if they
|
|
are useful to know the softwares. Example:
|
|
|
|
From software :* OK louloutte Cyrus IMAP4 v1.5.19 server ready
|
|
To software :* OK Courier-IMAP ready
|
|
|
|
You can use option --justconnect to get those lines.
|
|
|
|
And please rate imapsync at http://freshmeat.net/projects/imapsync/
|
|
|
|
=head1 HUGE MIGRATION
|
|
|
|
|
|
Have a special attention on options
|
|
--subscribed
|
|
--subscribe
|
|
--delete
|
|
--expunge
|
|
--maxage
|
|
--maxsize
|
|
|
|
If you have many mailboxes to migrate think about a little
|
|
shell program. Write a file called file.csv (for example)
|
|
containing users and passwords.
|
|
The separator used in this example is ';'
|
|
|
|
The file.csv file content is :
|
|
|
|
user0001;password0001;user0002;password0002
|
|
user0011;password0011;user0012;password0012
|
|
...
|
|
|
|
And the shell program is just :
|
|
|
|
{ while IFS=';' read u1 p1 u2 p2; do
|
|
imapsync --user1 $u1 --password1 $p1 --user2 $u2 --password2 $p2 ...
|
|
done ; } < file.csv
|
|
|
|
Welcome in shell programming !
|
|
|
|
=head1 Hacking
|
|
|
|
Feel free to hack imapsync as the GPL Licence permits it.
|
|
|
|
=head1 Links
|
|
|
|
Entries for imapsync:
|
|
http://www.imap.org/products/showall.php
|
|
|
|
|
|
=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.
|
|
mailutil : replace imapxfer in
|
|
part of the imap-utils from UW.
|
|
http://www.gsp.com/cgi-bin/man.cgi?topic=mailutil
|
|
imaprepl : http://www.bl0rg.net/software/
|
|
http://freshmeat.net/projects/imap-repl/
|
|
imap_migrate: http://freshmeat.net/projects/imapmigration/
|
|
pop2imap : http://www.linux-france.org/prj/pop2imap/
|
|
|
|
Feedback (good or bad) will be always welcome.
|
|
|
|
$Id: imapsync,v 1.77 2004/03/11 05:33:22 gilles Exp $
|
|
|
|
=cut
|
|
|
|
|
|
++$|;
|
|
use strict;
|
|
use Getopt::Long;
|
|
use Mail::IMAPClient;
|
|
use Digest::MD5 qw(md5_base64);
|
|
#use Digest::HMAC_MD5;
|
|
|
|
eval { require 'usr/include/sysexits.ph' };
|
|
|
|
|
|
my(
|
|
$rcs, $debug, $debugimap, $error,
|
|
$host1, $host2, $port1, $port2,
|
|
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
|
|
@folder, $include, $exclude, $prefix2,
|
|
$sep1, $sep2,
|
|
$syncinternaldates,
|
|
$maxsize, $maxage,
|
|
$delete, $expunge, $dry,
|
|
$authmd5,
|
|
$subscribed, $subscribe,
|
|
$version, $VERSION, $help,
|
|
$justconnect,
|
|
$mess_size_total_trans,
|
|
$mess_size_total_skipped,
|
|
$mess_size_total_error,
|
|
);
|
|
|
|
use vars qw ($opt_G); # missing code for this will be option.
|
|
|
|
|
|
$rcs = ' $Id: imapsync,v 1.77 2004/03/11 05:33:22 gilles Exp $ ';
|
|
$rcs =~ m/,v (\d+\.\d+)/;
|
|
$VERSION = ($1) ? $1 : "UNKNOWN";
|
|
|
|
my $VERSION_IMAPClient = $Mail::IMAPClient::VERSION;
|
|
|
|
my $md5_supported = 0;
|
|
$md5_supported = md5_supported();
|
|
|
|
$mess_size_total_trans = 0;
|
|
$mess_size_total_skipped = 0;
|
|
$mess_size_total_error = 0;
|
|
|
|
sub md5_supported {
|
|
|
|
|
|
# before 2.2.6 no md5 native
|
|
# 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);
|
|
return(1) if($major >=3);
|
|
return(0) if($major <=1);
|
|
return(1) if($minor >=3);
|
|
return(0) if($minor <=1);
|
|
return(1) if($sub >=6);
|
|
return(0) if($sub <=5);
|
|
}else{
|
|
return 0; # don't match regex => bad
|
|
}
|
|
}
|
|
|
|
$error=0;
|
|
|
|
my $banner = join("",
|
|
'$RCSfile: imapsync,v $ ',
|
|
'$Revision: 1.77 $ ',
|
|
'$Date: 2004/03/11 05:33:22 $ ',
|
|
"\n",
|
|
"Mail::IMAPClient version used here is ",
|
|
$VERSION_IMAPClient, " auth md5 : $md5_supported",
|
|
"\n"
|
|
);
|
|
|
|
unless(defined(&_SYSEXITS_H)) {
|
|
# 64 on my linux box.
|
|
eval 'sub EX_USAGE () {64;}' unless defined(&EX_USAGE);
|
|
}
|
|
|
|
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;
|
|
|
|
$authmd5 = (defined($authmd5)) ? $authmd5 : 1;
|
|
|
|
print "From imap server [$host1] port [$port1] user [$user1]\n";
|
|
print "To imap server [$host2] port [$port2] user [$user2]\n";
|
|
|
|
my $from = ();
|
|
my $to = ();
|
|
|
|
my $authmech = "CRAM-MD5";
|
|
|
|
unless ($md5_supported) {
|
|
print "Auth $authmech not supported by IMAPClient $VERSION_IMAPClient\n";
|
|
}else{
|
|
print "Auth $authmech supported by IMAPClient $VERSION_IMAPClient\n";
|
|
}
|
|
|
|
|
|
|
|
$debugimap and print "From connection\n";
|
|
$from = login_imap($host1, $port1, $user1, $password1, $debugimap);
|
|
|
|
$debugimap and print "To connection\n";
|
|
$to = login_imap($host2, $port2, $user2, $password2, $debugimap);
|
|
|
|
sub login_imap {
|
|
my($host, $port, $user, $password, $debugimap, $authmech) = @_;
|
|
my $imap = Mail::IMAPClient->new();
|
|
$imap->Server($host);
|
|
$imap->Port($port);
|
|
$imap->Fast_io(1);
|
|
$imap->Uid(1);
|
|
$imap->Peek(1);
|
|
$imap->Debug($debugimap);
|
|
$imap->connect()
|
|
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
|
|
|
|
$imap->User($user);
|
|
$imap->Password($password);
|
|
md5auth($imap);
|
|
$imap->login() or die "Error login : [$host] with user [$user] : $@";
|
|
return($imap);
|
|
}
|
|
|
|
|
|
sub md5auth() {
|
|
my ($imap) = @_;
|
|
unless ($md5_supported) {
|
|
return;
|
|
}
|
|
unless ($authmd5) {
|
|
print "$authmech not wanted by you\n";
|
|
return;
|
|
}
|
|
if ($imap->has_capability($authmech)
|
|
or $imap->has_capability("AUTH=$authmech")) {
|
|
print "Server [", $imap->Server,
|
|
"] has capability $authmech\n";
|
|
}else{
|
|
print "Server [", $imap->Server,
|
|
"] has NOT capability $authmech\n";
|
|
return;
|
|
}
|
|
#print "EE", $imap->Authmechanism(), "\n";
|
|
if ($imap->Authmechanism($authmech)) {
|
|
print "Using $authmech authentification\n";
|
|
#$imap->Authmechanism(undef);
|
|
#print "EE", $imap->Authmechanism(), "\n";
|
|
}else{
|
|
$imap->Authmechanism(undef);
|
|
print "Can NOT use $authmech authentification, using plain\n";
|
|
|
|
}
|
|
return;
|
|
}
|
|
|
|
|
|
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";
|
|
|
|
die unless $from->IsAuthenticated();
|
|
die unless $to->IsAuthenticated();
|
|
|
|
my (@f_folders, @t_folders, %fs_folders);
|
|
|
|
# Make a hash of subscribed folders in source server.
|
|
map { $fs_folders{$_}=1 } $from->subscribed();
|
|
|
|
|
|
|
|
|
|
if (scalar(@folder)) {
|
|
# folders given by option --folder
|
|
@f_folders = @folder;
|
|
}elsif ($subscribed) {
|
|
# option --subscribed
|
|
@f_folders = sort keys (%fs_folders);
|
|
}else {
|
|
# no option, all folders
|
|
@f_folders = sort $from->folders();
|
|
# consider (optional) includes and excludes
|
|
if ($include) {
|
|
@f_folders = grep /$include/,@f_folders;
|
|
print "Only including folders matching pattern '$include'\n";
|
|
}
|
|
if ($exclude) {
|
|
@f_folders = grep !/$exclude/,@f_folders;
|
|
print "Excluding folders matching pattern '$exclude'\n";
|
|
}
|
|
}
|
|
|
|
my($f_sep,$t_sep);
|
|
# what are the private folders separators for each server ?
|
|
|
|
|
|
$debug and print "Getting separators\n";
|
|
$f_sep = get_separator($from, $sep1, "--sep1");
|
|
$t_sep = get_separator($to, $sep2, "--sep2");
|
|
|
|
sub get_separator {
|
|
my($imap, $sep_in, $sep_opt) = @_;
|
|
my($sep_out);
|
|
$debug and print "Calling namespace capability\n";
|
|
if ($imap->has_capability("namespace")) {
|
|
# Less complicated call. Must be tested
|
|
# before uncommenting definitively.
|
|
$sep_out = $imap->separator();
|
|
#$sep_out = $imap->namespace()->[0][0][1];
|
|
|
|
}elsif ($sep_in) {
|
|
$sep_out = $sep_in;
|
|
}else{
|
|
print
|
|
"No NAMESPACE capability in imap server ",
|
|
$imap->Server(),"\n",
|
|
"Give the separator caracter with the $sep_opt option\n";
|
|
exit(1);
|
|
}
|
|
return($sep_out);
|
|
}
|
|
|
|
|
|
print "From separator : [$f_sep]\n";
|
|
print "To separator : [$t_sep]\n";
|
|
|
|
exit if ($justconnect);
|
|
|
|
# needed for setting flags
|
|
# my $tohasuidplus = $to->has_capability("UIDPLUS");
|
|
|
|
|
|
@t_folders = sort @{$to->folders()};
|
|
print
|
|
"From folders : ", map("[$_] ",@f_folders),"\n",
|
|
"To folders : ", map("[$_] ",@t_folders),"\n";
|
|
|
|
print
|
|
"From subscribed folders : ", map("[$_] ", sort keys(%fs_folders)), "\n";
|
|
|
|
sub separator_invert {
|
|
my $o_sep="\000";
|
|
|
|
my($f_fold, $f_sep, $t_sep) = @_;
|
|
|
|
my $t_fold = $f_fold;
|
|
$t_fold =~ s@\Q$t_sep@$o_sep@g;
|
|
$t_fold =~ s@\Q$f_sep@$t_sep@g;
|
|
$t_fold =~ s@\Q$o_sep@$f_sep@g;
|
|
return($t_fold);
|
|
}
|
|
|
|
FOLDER: foreach my $f_fold (@f_folders) {
|
|
my $t_fold;
|
|
print "From Folder [$f_fold]\n";
|
|
|
|
$t_fold = separator_invert($f_fold,$f_sep, $t_sep);
|
|
$t_fold = $prefix2 . $t_fold if ($prefix2);
|
|
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) or $to->select($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";
|
|
unless($dry) { $from->expunge() };
|
|
unless($dry) { $to->expunge() };
|
|
}
|
|
|
|
if ($subscribe and exists $fs_folders{$f_fold}) {
|
|
print "Subscribing to folder $t_fold on destination server\n";
|
|
unless($dry) { $to->subscribe($t_fold) };
|
|
}
|
|
|
|
my @f_msgs = $maxage ? $from->since(time - 86400 * $maxage) : $from->search("ALL");
|
|
$debug and print "LIST FROM : @f_msgs\n";
|
|
# internal dates on "TO" are after the ones on "FROM"
|
|
# normally...
|
|
my @t_msgs = $maxage ? $to->since(time - 86400 * $maxage) : $to->search("ALL");
|
|
$debug and print "LIST TO : @t_msgs\n";
|
|
|
|
my %f_hash = ();
|
|
my %t_hash = ();
|
|
|
|
$debug and print "From Parse\n";
|
|
foreach my $m (@f_msgs) {
|
|
parse_header_msg($m, $from, "F", \%f_hash);
|
|
}
|
|
|
|
$debug and print "To Parse\n";
|
|
foreach my $m (@t_msgs) {
|
|
parse_header_msg($m, $to, "T", \%t_hash);
|
|
}
|
|
$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'};
|
|
if (defined $maxsize and $f_size > $maxsize) {
|
|
print "Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n";
|
|
$mess_size_total_skipped += $f_msg;
|
|
next MESS;
|
|
}
|
|
$debug and print "key $m_id #$f_msg\n";
|
|
unless (exists($t_hash{$m_id})) {
|
|
print "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);
|
|
my $d = $from->internaldate($f_msg);
|
|
$d = "\"$d\"";
|
|
$debug and print "internal date from 1: [$d]\n";
|
|
$syncinternaldates or $d = "";
|
|
my $flags_f = join(" ", @{$from->flags($f_msg)});
|
|
# RFC 2060 : This flag can not be altered by the client
|
|
$flags_f =~ s@\\Recent@@g;
|
|
|
|
my $new_id;
|
|
print "flags from : [$flags_f][$d]\n";
|
|
unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){
|
|
warn "Couldn't append msg #$f_msg (Subject: ".$from->subject($f_msg).") to folder $t_fold: ",
|
|
$to->LastError, "\n";
|
|
$error++;
|
|
$mess_size_total_error += $f_size;
|
|
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";
|
|
$mess_size_total_trans += $f_size;
|
|
}
|
|
}
|
|
next MESS;
|
|
}else{
|
|
$debug and print "Message id [$m_id] found in t:$t_fold\n";
|
|
$mess_size_total_skipped += $f_size;
|
|
}
|
|
|
|
#$debug and print "MESSAGE $m_id\n";
|
|
my $t_size = $t_hash{$m_id}{'s'};
|
|
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)};
|
|
# No flag \Recent here, no ?
|
|
|
|
$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";
|
|
$debug and print "Looking dates\n";
|
|
my $d_f = $from->internaldate($f_msg);
|
|
my $d_t = $to->internaldate($t_msg);
|
|
$debug and print
|
|
"idate from : $d_f\n",
|
|
"idate to : $d_t\n";
|
|
#unless ($d_f eq $d_t) {
|
|
# print "!!! Dates differ !!!\n";
|
|
#}
|
|
unless ($f_size == $t_size) {
|
|
# Bad 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 "Total bytes transfered : $mess_size_total_trans\n";
|
|
print "Total bytes skipped : $mess_size_total_skipped\n";
|
|
print "Total bytes error : $mess_size_total_error\n";
|
|
print "Detected $error errors\n";
|
|
print "Please, rate imapsync at http://freshmeat.net/projects/imapsync/\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,
|
|
"authmd5!" => \$authmd5,
|
|
"sep1=s" => \$sep1,
|
|
"sep2=s" => \$sep2,
|
|
"folder=s" => \@folder,
|
|
"include=s" => \$include,
|
|
"exclude=s" => \$exclude,
|
|
"prefix2=s" => \$prefix2,
|
|
"delete!" => \$delete,
|
|
"syncinternaldates!" => \$syncinternaldates,
|
|
"maxsize=i" => \$maxsize,
|
|
"maxage=i" => \$maxage,
|
|
"dry!" => \$dry,
|
|
"expunge!" => \$expunge,
|
|
"subscribed!" => \$subscribed,
|
|
"subscribe!" => \$subscribe,
|
|
"justconnect!"=> \$justconnect,
|
|
"version" => \$version,
|
|
"help" => \$help,
|
|
);
|
|
|
|
$debug and print "get options: [$opt_ret]\n";
|
|
|
|
# just the version
|
|
print "$VERSION\n" and exit if ($version) ;
|
|
|
|
# exit with --help option or no option at all
|
|
usage() and exit if ($help or ! $numopt) ;
|
|
|
|
# don't go on if options are not all known.
|
|
exit(EX_USAGE()) unless ($opt_ret) ;
|
|
|
|
|
|
}
|
|
|
|
|
|
sub parse_header_msg {
|
|
|
|
my ($m, $imap, $s, $s_hash) = @_;
|
|
$debug and print "-" x 50, "\nMSG $m\n";
|
|
my $head = $imap->parse_headers($m,"ALL");
|
|
my $headstr;
|
|
$debug and print "Head NUM:", scalar(keys(%$head)), "\n";
|
|
return unless(scalar(keys(%$head)));
|
|
foreach my $h (sort keys(%$head)){
|
|
foreach my $val ( @{$head->{$h}}) {
|
|
# no 8-bit data in headers !
|
|
$val =~ s/[\x80-\xff]/X/g;
|
|
$debug and print "${s}H $h:", $val, "\n";
|
|
$headstr .= "$h:". $val;
|
|
}
|
|
}
|
|
my $m_md5 = md5_base64($headstr);
|
|
my $size = $imap->size($m);
|
|
$debug and print "$s msg $m:$m_md5:$size\n";
|
|
|
|
$s_hash->{"$m_md5:$size"}{'5'} = "$m_md5:$size";
|
|
$s_hash->{"$m_md5:$size"}{'s'} = $size;
|
|
$s_hash->{"$m_md5:$size"}{'m'} = $m;
|
|
}
|
|
|
|
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.
|
|
--noauthmd5 : don't use MD5 authentification
|
|
--folder <string> : sync only this folder.
|
|
--folder <string> : and this one.
|
|
--folder <string> : and this one, etc.
|
|
--include <regex> : only sync folders matching this regular expression
|
|
(only effective if neither --folder nor --subscribed
|
|
is specified)
|
|
--exclude <regex> : skip folders matching this regular expression
|
|
(only effective if neither --folder nor --subscribed
|
|
is specified)
|
|
--prefix2 <string> : add prefix to all destination folders
|
|
(usually INBOX. for cyrus imap servers)
|
|
--sep1 <char> : separator in case namespace is not supported.
|
|
--sep2 <char> : idem.
|
|
--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.
|
|
expunge is made at the begining so newly
|
|
transfered messages won't be expunged.
|
|
--syncinternaldates : set the internal dates on host2 same as host1
|
|
--maxsize <int> : skip messages larger than <int> bytes
|
|
--maxage <int> : skip messages older than <int> days.
|
|
final stats (skipped) don't count older messages
|
|
--dry : do nothing, just print what would be done.
|
|
--subscribed : transfer only subscribed folders.
|
|
--subscribe : subscribe to the folders transfered on the
|
|
"destination" server that are subscribed
|
|
on the "source" server.
|
|
--debug : debug mode.
|
|
--debugimap : imap debug mode.
|
|
--version : print sotfware version.
|
|
--justconnect : just connect to both servers and print useful
|
|
information.
|
|
--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
|
|
|
|
|
|
Mail::IMAPClient version is $Mail::IMAPClient::VERSION
|
|
$rcs
|
|
imapsync copyleft is the GNU General Public License.
|
|
See http://www.gnu.org/copyleft/gpl.html
|
|
EOF
|
|
}
|