From 06b00d41e4db4395154e1470696118fe8b1f17bb Mon Sep 17 00:00:00 2001 From: Nick Bebout Date: Sat, 12 Mar 2011 02:43:50 +0000 Subject: [PATCH] 1.64 --- CREDITS | 8 + ChangeLog | 42 +++- README | 11 +- TODO | 16 +- VERSION | 2 +- imapsync | 115 ++++++--- imapsync.patch | 89 ------- imapsync.sav | 671 ------------------------------------------------- tests.sh | 40 ++- 9 files changed, 189 insertions(+), 805 deletions(-) delete mode 100644 imapsync.patch delete mode 100755 imapsync.sav diff --git a/CREDITS b/CREDITS index 2c004bf..1d21af9 100644 --- a/CREDITS +++ b/CREDITS @@ -1,5 +1,13 @@ + +Devin Reade +Bug about destination separator character in source folder names. +Rasjid Wilcox +Bug about imap servers (DBmail and Bincimap) that don't support namespaces. + +Dave Rose +Bug in help message about nested folders. Paul Boven Suggested --subscribe option, a better behavior and gave the patch. diff --git a/ChangeLog b/ChangeLog index a32c4f0..4fc57e6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,15 +1,53 @@ RCS file: RCS/imapsync,v Working file: imapsync -head: 1.55 +head: 1.64 branch: locks: strict access list: symbolic names: keyword substitution: kv -total revisions: 55; selected revisions: 55 +total revisions: 64; selected revisions: 64 description: ---------------------------- +revision 1.64 +date: 2003/12/23 19:45:46; author: gilles; state: Exp; lines: +5 -8 +Removed auth capability debug +---------------------------- +revision 1.63 +date: 2003/12/23 19:44:47; author: gilles; state: Exp; lines: +7 -6 +One line only for --version +---------------------------- +revision 1.62 +date: 2003/12/23 19:28:12; author: gilles; state: Exp; lines: +6 -5 +Added ref pop2imap +---------------------------- +revision 1.61 +date: 2003/12/23 19:23:07; author: gilles; state: Exp; lines: +11 -6 +Updated Success stories +---------------------------- +revision 1.60 +date: 2003/12/23 18:21:44; author: gilles; state: Exp; lines: +8 -8 +Try separator() +---------------------------- +revision 1.59 +date: 2003/12/23 18:19:24; author: gilles; state: Exp; lines: +34 -16 +Added MD5 auth +---------------------------- +revision 1.58 +date: 2003/12/23 17:26:45; author: gilles; state: Exp; lines: +44 -27 +Preparation to MD5 auth +---------------------------- +revision 1.57 +date: 2003/12/23 03:04:16; author: gilles; state: Exp; lines: +14 -6 +Prepared code for separator() use. +Added --justconnect option. +---------------------------- +revision 1.56 +date: 2003/12/13 19:38:33; author: gilles; state: Exp; lines: +7 -7 +Removed tha bad help message about nested folders and +--folder option +---------------------------- revision 1.55 date: 2003/12/13 18:16:56; author: gilles; state: Exp; lines: +30 -15 Better subscribe behavior diff --git a/README b/README index c03bd02..d96820f 100644 --- a/README +++ b/README @@ -1,7 +1,7 @@ NAME imapsync - synchronize mailboxes between two imap servers. - $Revision: 1.55 $ + $Revision: 1.64 $ INSTALL Get imapsync at @@ -130,7 +130,7 @@ BUGS IMAP SERVERS Success stories reported : - - Courier IMAP 1.5.1, 2.1.1 + - Courier IMAP 1.5.1, 2.2.0, 2.1.1 - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.2.1, Cyrus 2.2.2-BETA - Netscape Mail Server 3.6 (Wintel) - CommunicatePro server (Redhat 8.0) @@ -138,6 +138,8 @@ IMAP SERVERS - iPlanet Messaging server 4.15 - dovecot ?.?? - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 + - BincImap 1.2.3 + - DBMail 1.2.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 @@ -148,6 +150,8 @@ IMAP SERVERS 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. + Rate imapsync : http://freshmeat.net/projects/imapsync/ HUGE MIGRATION @@ -176,8 +180,9 @@ SIMILAR SOFTWARES mailsync : http://mailsync.sourceforge.net/ imapxfer : http://www.washington.edu/imap/ part of the imap-utils from UW. + pop2imap : http://www.linux-france.org/prj/pop2imap/ Feedback (good or bad) will be always welcome. - $Id: imapsync,v 1.55 2003/12/13 18:16:56 gilles Exp $ + $Id: imapsync,v 1.64 2003/12/23 19:45:46 gilles Exp $ diff --git a/TODO b/TODO index 995adb0..6ee8ba3 100644 --- a/TODO +++ b/TODO @@ -1,17 +1,25 @@ TODO file for imapsync ---------------------- -Add --prefix1 option. Don't know what is the need exactly. -Add SASL support MD5 : DIGEST-MD5 and CRAM-MD5 -see authenticate in IMAPClient.pm -Test the new Mail::IMAPClient (2.1.4 -> 2.2.8 or sup) +Add a --recurse option. + +Add --prefix1 option. Don't know what is the need exactly. Pb if "to separator" is in "from folder" name. Have to choose a caracter != to separator and not in from folders. The solution can be to just exchange the two caracters. +DONE. Look at the separator() function in Mail::IMAPClient + +DONE. Add SASL support MD5 : DIGEST-MD5 and CRAM-MD5 +see authenticate in IMAPClient.pm +Test the new Mail::IMAPClient (2.1.4 -> 2.2.6 or sup) +userdbpw -hmac-md5 | userdb userdb set hmac-md5pw +http://www.inter7.com/courierimap/INSTALL.html + + DONE. Add a --subscribe option to subscribe folders on the destination server. diff --git a/VERSION b/VERSION index 67fc7ad..8725364 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -1.55 +1.64 diff --git a/imapsync b/imapsync index 89125bd..de16b22 100755 --- a/imapsync +++ b/imapsync @@ -4,7 +4,7 @@ imapsync - synchronize mailboxes between two imap servers. -$Revision: 1.55 $ +$Revision: 1.64 $ =head1 INSTALL @@ -152,7 +152,7 @@ Report any bugs to the author: lamiral@linux-france.org Success stories reported : - - Courier IMAP 1.5.1, 2.1.1 + - Courier IMAP 1.5.1, 2.2.0, 2.1.1 - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.2.1, Cyrus 2.2.2-BETA - Netscape Mail Server 3.6 (Wintel) - CommunicatePro server (Redhat 8.0) @@ -160,6 +160,9 @@ Success stories reported : - iPlanet Messaging server 4.15 - dovecot ?.?? - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 + - BincImap 1.2.3 + - DBMail 1.2.1 + Please report to the author any success or bad story with imapsync and don't forget to mention the IMAP server @@ -171,6 +174,8 @@ 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. + Rate imapsync : http://freshmeat.net/projects/imapsync/ =head1 HUGE MIGRATION @@ -211,10 +216,11 @@ Welcome in shell programming ! mailsync : http://mailsync.sourceforge.net/ imapxfer : http://www.washington.edu/imap/ part of the imap-utils from UW. + pop2imap : http://www.linux-france.org/prj/pop2imap/ Feedback (good or bad) will be always welcome. -$Id: imapsync,v 1.55 2003/12/13 18:16:56 gilles Exp $ +$Id: imapsync,v 1.64 2003/12/23 19:45:46 gilles Exp $ =cut @@ -224,6 +230,7 @@ use strict; use Getopt::Long; use Mail::IMAPClient; use Digest::MD5 qw(md5_base64); +#use Digest::HMAC_MD5; eval { require 'usr/include/sysexits.ph' }; @@ -238,24 +245,48 @@ my( $delete, $expunge, $dry, $subscribed, $subscribe, $version, $VERSION, $help, + $justconnect, ); use vars qw ($opt_G); # missing code for this will be option. -$rcs = ' $Id: imapsync,v 1.55 2003/12/13 18:16:56 gilles Exp $ '; +$rcs = ' $Id: imapsync,v 1.64 2003/12/23 19:45:46 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(); + +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.55 $ ', - '$Date: 2003/12/13 18:16:56 $ ', + '$Revision: 1.64 $ ', + '$Date: 2003/12/23 19:45:46 $ ', "\n", "Mail::IMAPClient version used here is ", - $Mail::IMAPClient::VERSION, + $VERSION_IMAPClient, " auth md5 : $md5_supported", "\n" ); @@ -290,29 +321,33 @@ print "To imap server [$host2] port [$port2] user [$user2]\n"; my $from = (); my $to = (); -$debugimap and print "To connection\n"; -$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"; +my $authmech = "CRAM-MD5"; $debugimap and print "From connection\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"; +$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't open imap connection on [$host] with user [$user] : $@\n"; + $imap->User($user); + $imap->Password($password); + $md5_supported and $imap->has_capability($authmech) + and $to->Authmechanism($authmech); + + $imap->login(); + return($imap); +} print "From software : ", ($from->Report())[0]; @@ -326,6 +361,9 @@ 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; @@ -340,20 +378,27 @@ if (scalar(@folder)) { 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")) { - $sep_out = $imap->namespace()->[0][0][1]; + # 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 ", - $from->Server(),"\n", + $imap->Server(),"\n", "Give the separator caracter with the $sep_opt option\n"; exit(1); } @@ -364,6 +409,7 @@ sub get_separator { 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"); @@ -377,8 +423,6 @@ print print "From subscribed folders : ", map("[$_] ", keys(%fs_folders)), "\n"; -#exit; - FOLDER: foreach my $f_fold (@f_folders) { my $t_fold; print "From Folder [$f_fold]\n"; @@ -569,6 +613,7 @@ sub get_options "expunge!" => \$expunge, "subscribed!" => \$subscribed, "subscribe!" => \$subscribe, + "justconnect!"=> \$justconnect, "version" => \$version, "help" => \$help, ); @@ -643,8 +688,8 @@ Several options are mandatory. --user2 : user to login. Mandatory. --password2 : password for the user2. Dangerous, use --passfile2 --passfile2 : password file for the user2. Contains the password. ---folder : sync only this folder and its children. ---folder : and this one (and its children). +--folder : sync only this folder. +--folder : and this one. --folder : and this one, etc. --prefix2 : add prefix to all destination folders (usually INBOX. for cyrus imap servers) @@ -668,6 +713,8 @@ Several options are mandatory. --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" diff --git a/imapsync.patch b/imapsync.patch deleted file mode 100644 index f9e5a55..0000000 --- a/imapsync.patch +++ /dev/null @@ -1,89 +0,0 @@ -*** imapsync.org Sat Dec 13 11:09:08 2003 ---- imapsync Sat Dec 13 12:32:01 2003 -*************** -*** 39,45 **** - [--sep2 ] - [--syncinternaldate] - [--delete] [--expunge] -! [--subscribed] - [--dry] - [--debug] [--debugimap] - [--version] [--help] ---- 39,45 ---- - [--sep2 ] - [--syncinternaldate] - [--delete] [--expunge] -! [--subscribed] [--subscribe] - [--dry] - [--debug] [--debugimap] - [--version] [--help] -*************** -*** 229,235 **** - $sep1, $sep2, - $syncinternaldates, - $delete, $expunge, $dry, $subscribed, $subscribe, -! $version, $VERSION, $help, - ); - - use vars qw ($opt_G); # missing code for this will be option. ---- 229,235 ---- - $sep1, $sep2, - $syncinternaldates, - $delete, $expunge, $dry, $subscribed, $subscribe, -! $version, $VERSION, $help, %s_folders - ); - - use vars qw ($opt_G); # missing code for this will be option. -*************** -*** 317,328 **** - - #@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()}; - - if (scalar(@folder)) { - # folders given by option --folder - @f_folders = @folder; - }elsif ($subscribed) { - # option --subscribed -! @f_folders = $from->subscribed(); - }else { - # no option, all folders - @f_folders = $from->folders() ---- 317,332 ---- - - #@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()}; - -+ foreach my $folder ($from->subscribed()) { -+ $s_folders{$folder}=1; -+ } -+ - if (scalar(@folder)) { - # folders given by option --folder - @f_folders = @folder; - }elsif ($subscribed) { - # option --subscribed -! @f_folders = keys (%s_folders); - }else { - # no option, all folders - @f_folders = $from->folders() -*************** -*** 410,418 **** - $to->expunge(); - } - -! if ($subscribe) { - print "Subscribing to folder $t_fold on destination server\n"; -! $to->subscribe($t_fold); - } - - my @f_msgs = $from->search("ALL"); ---- 414,422 ---- - $to->expunge(); - } - -! if ($subscribe and exists $s_folders{$f_fold}) { - print "Subscribing to folder $t_fold on destination server\n"; -! unless($dry) $to->subscribe($t_fold); - } - - my @f_msgs = $from->search("ALL"); - diff --git a/imapsync.sav b/imapsync.sav deleted file mode 100755 index d781f0d..0000000 --- a/imapsync.sav +++ /dev/null @@ -1,671 +0,0 @@ -#!/usr/bin/perl -w - -=head1 NAME - -imapsync - synchronize mailboxes between two imap servers. - -$Revision: 1.54 $ - -=head1 INSTALL - - 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 ] - [--user1 ] [--passfile1 ] - [--host2 server2] [--port2 ] - [--user2 ] [--passfile2 ] - [--folder --folder ...] - [--prefix2 ] - [--sep1 ] - [--sep2 ] - [--syncinternaldate] - [--delete] [--expunge] - [--subscribed] - [--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 : - - - Courier IMAP 1.5.1, 2.1.1 - - Cyrus IMAP 1.5, 1.6, 2.1, 2.1.15, 2.2.1, Cyrus 2.2.2-BETA - - Netscape Mail Server 3.6 (Wintel) - - CommunicatePro server (Redhat 8.0) - - SunONE Messaging server 5.2 - - iPlanet Messaging server 4.15 - - dovecot ?.?? - - UW-imap servers (imap-2000b) rijkkramer IMAP4rev1 2000.287 - -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 - -Rate imapsync : http://freshmeat.net/projects/imapsync/ - -=head1 HUGE MIGRATION - - -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 - - - -=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.54 2003/12/12 18:13:01 gilles Exp $ - -=cut - - -++$|; -use strict; -use Getopt::Long; -use Mail::IMAPClient; -use Digest::MD5 qw(md5_base64); - -eval { require 'usr/include/sysexits.ph' }; - - -my( - $rcs, $debug, $debugimap, $error, - $host1, $host2, $port1, $port2, - $user1, $user2, $password1, $password2, $passfile1, $passfile2, - @folder, $prefix2, - $sep1, $sep2, - $syncinternaldates, - $delete, $expunge, $dry, $subscribed, $subscribe, - $version, $VERSION, $help, -); - -use vars qw ($opt_G); # missing code for this will be option. - - -$rcs = ' $Id: imapsync,v 1.54 2003/12/12 18:13:01 gilles Exp $ '; -$rcs =~ m/,v (\d+\.\d+)/; -$VERSION = ($1) ? $1 : "UNKNOWN"; - -$error=0; - -my $banner = join("", - '$RCSfile: imapsync,v $ ', - '$Revision: 1.54 $ ', - '$Date: 2003/12/12 18:13:01 $ ', - "\n", - "Mail::IMAPClient version used here is ", - $Mail::IMAPClient::VERSION, - "\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; - -print "From imap server [$host1] port [$port1] user [$user1]\n"; -print "To imap server [$host2] port [$port2] user [$user2]\n"; - -my $from = (); -my $to = (); - -$debugimap and print "To connection\n"; -$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"; - -$debugimap and print "From connection\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"; - - -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); - -#@f_folders = (scalar(@folder)) ? @folder : @{$from->folders()}; - -if (scalar(@folder)) { - # folders given by option --folder - @f_folders = @folder; -}elsif ($subscribed) { - # option --subscribed - @f_folders = $from->subscribed(); -}else { - # no option, all folders - @f_folders = $from->folders() -} - -my($f_sep,$t_sep); -# what are the private folders separators for each server ? - -$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); - if ($imap->has_capability("namespace")) { - $sep_out = $imap->namespace()->[0][0][1]; - }elsif ($sep_in) { - $sep_out = $sep_in; - }else{ - print - "No NAMESPACE capability in imap server ", - $from->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"; - - -# needed for setting flags -# my $tohasuidplus = $to->has_capability("UIDPLUS"); - - -@t_folders = @{$to->folders()}; -print - "From folders : ", map("[$_] ",@f_folders),"\n", - "To folders : ", map("[$_] ",@t_folders),"\n"; -#exit; - -FOLDER: foreach my $f_fold (@f_folders) { - my $t_fold; - print "From Folder [$f_fold]\n"; - $t_fold = $f_fold; - $t_fold =~ s@\Q$f_sep@$t_sep@g unless ($f_sep eq $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"; - $from->expunge(); - $to->expunge(); - } - - if ($subscribe) { - print "Subscribing to folder $t_fold on destination server\n"; - $to->subscribe($t_fold); - } - - 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 = (); - - $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'}; - $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 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"; - } - } - 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'}; - - $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 "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, - "sep1=s" => \$sep1, - "sep2=s" => \$sep2, - "folder=s" => \@folder, - "prefix2=s" => \$prefix2, - "delete!" => \$delete, - "syncinternaldates!" => \$syncinternaldates, - "dry!" => \$dry, - "expunge!" => \$expunge, - "subscribed!" => \$subscribed, - "subscribe!" => \$subscribe, - "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 accent in headers ! - $val =~ y/יטאש/XXXX/; - $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 = ); - close FILE; - $line = ($line) ? $line : "!EMPTY! $file"; - return $line; -} - -sub usage { - print < : "from" imap server. Mandatory. ---port1 : port to connect. Default is 143. ---user1 : user to login. Mandatory. ---password1 : password for the user1. Dangerous, use --passfile1 ---passfile1 : password file for the user1. Contains the password. ---host2 : "destination" imap server. Mandatory. ---port2 : port to connect. Default is 143. ---user2 : user to login. Mandatory. ---password2 : password for the user2. Dangerous, use --passfile2 ---passfile2 : password file for the user2. Contains the password. ---folder : sync only this folder and its children. ---folder : and this one (and its children). ---folder : and this one, etc. ---prefix2 : add prefix to all destination folders - (usually INBOX. for cyrus imap servers) ---sep1 : separator in case namespace is not supported. ---sep2 : 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. ---syncinternaldates : set the internal dates on host2 same as host1 ---dry : do nothing, just print what would be done. ---subscribed : transfer only subscribed folders. ---subscribe : subscribe to the folders transfered on the - "destination" server. ---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 - - - 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 -} diff --git a/tests.sh b/tests.sh index 0c8424f..71e9142 100644 --- a/tests.sh +++ b/tests.sh @@ -1,8 +1,12 @@ #!/bin/sh -# $Id: tests.sh,v 1.11 2003/12/12 17:48:02 gilles Exp $ +# $Id: tests.sh,v 1.12 2003/12/23 18:16:09 gilles Exp $ # $Log: tests.sh,v $ +# Revision 1.12 2003/12/23 18:16:09 gilles +# Added lp_justconnect() +# Added lp_md5auth() +# # Revision 1.11 2003/12/12 17:48:02 gilles # Added lp_subscribe() test # @@ -226,6 +230,38 @@ lp_subscribe() fi } +lp_justconnect() +{ + if test X`hostname` = X"plume"; then + echo3 Here is plume + ./imapsync \ + --host2 plume --user2 tata@est.belle \ + --passfile2 /var/tmp/secret.tata \ + --host1 loul --user1 tata \ + --passfile1 /var/tmp/secret.tata \ + --justconnect + else + : + fi +} + +lp_md5auth() +{ + if test X`hostname` = X"plume"; then + echo3 Here is plume + perl -I ~gilles/build/Mail-IMAPClient-2.2.8/blib/lib/ \ + ./imapsync \ + --host2 plume --user2 tata@est.belle \ + --passfile2 /var/tmp/secret.tata \ + --host1 loul --user1 tata \ + --passfile1 /var/tmp/secret.tata \ + --justconnect + else + : + fi +} + + # mandatory tests @@ -244,6 +280,8 @@ test $# -eq 0 && run_tests \ lp_internaldate \ lp_subscribed \ lp_subscribe \ + lp_justconnect \ + lp_md5auth # selective tests