This commit is contained in:
Nick Bebout 2012-09-02 19:08:57 -05:00
parent 495d5a9526
commit c08a56e486
277 changed files with 692 additions and 10803 deletions

529
W/patches/FAQ_ralph.patch Normal file
View file

@ -0,0 +1,529 @@
--- FAQ.orig 2009-04-30 04:09:14.000000000 +0200
+++ FAQ 2010-02-02 08:53:04.000000000 +0100
@@ -6,12 +6,12 @@
+------------------+
=======================================================================
-Q. How to install impasync ?
+Q. How to install imapsync ?
R. http://www.linux-france.org/prj/imapsync/INSTALL
=======================================================================
-Q. How to configure impasync ?
+Q. How to configure imapsync ?
R. http://www.linux-france.org/prj/imapsync/README
@@ -46,7 +46,7 @@
Thank you for your participation.
=======================================================================
-Q. Where I can read IMAP RFCs ?
+Q. Where I can read up on the various IMAP RFCs ?
R. Here:
@@ -67,12 +67,12 @@
=======================================================================
-Q. Where I can find old imapsync releases ?
+Q. Where I can find old imapsync releases?
R. ftp://www.linux-france.org/pub/prj/imapsync/
=======================================================================
-Q. How can I try imapsync with Mail::IMAPClient 3.xx perl library?
+Q. How can I try imapsync with the new Mail::IMAPClient 3.xx perl library?
R. - Download latest Mail::IMAPClient 3.xx at
http://search.cpan.org/dist/Mail-IMAPClient/
@@ -105,8 +105,8 @@
=======================================================================
Q. I am interested in creating a local clone of the IMAP on a LAN
server for faster synchronisations, Email will always be delivered
-to the remote server and so the synchronisation will be one way from
-remote to local. How suited is ImapSync to continouous one-way
+to the remote server and so the synchronisation will be one way - from
+remote to local. How suited is ImapSync for continuous one-way
synchronisation of mailboxes? Is there a better solution?
R. If messages are delivered remotely and you play locally with the
@@ -130,17 +130,16 @@
- Mutt
- Thunderbird
-Eurora shows by default the time the imap server received the email.
-I think it is quite a wrong behavior since the messages can
-have travelled some time before the reception.
-
-The sent time and date are given by the "Date:" header
-and it is set most of the time by the MUA (Mail User Agent,
-Mutt, Eudora, Thunderbird etc.).
-
-imapsync does not touch any header since the
-header is used to identify the messages in
-both parts.
+Eurora shows by default the time the imap server received the email. I
+think it is quite a wrong behavior since the messages can have
+travelled some time before the reception.
+
+The sent time and date are given by the "Date:" header and it is set
+most of the time by the MUA (Mail User Agent, Mutt, Eudora,
+Thunderbird etc.).
+
+imapsync does not touch any header since the header is used to
+identify the messages in both parts.
Solutions:
a) Don't use buggy Eudora.
@@ -156,7 +155,7 @@
=======================================================================
Q. Does imapsync retain the \Answered and $Forwarded flags?
-R. imapsync retains all flags except \Recent
+R. imapsync retains ALL flags except \Recent
(RFC 3501 says "This flag can not be altered by the client.")
Some imap servers have problems with flags not beginning with
@@ -195,11 +194,11 @@
=======================================================================
Q. Some passwords contain * and " characters. Login fails.
-R. Use
+R. Use a backslash to escape the characters:
imapsync --password1 \"password\"
-Ii works for the star * character,
+It works for the star * character,
I don't know if it works for the " character.
=======================================================================
@@ -273,46 +272,43 @@
imaps stream tcp nowait cyrus /usr/sbin/stunnel -s cyrus -p /etc/ssl/certs/imapd.pem -r localhost:imap2
=======================================================================
-Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl,
-or at least claims to. Imapsync appears to require io-socket-ssl,
-which doesn't seem to be available on win32. Are there any other options?
+Q: I'm trying to use imapsync on win32 for gmail, but it requires ssl,
+or at least claims to. Imapsync appears to require io-socket-ssl,
+which doesn't seem to be available on win32. Are there any other
+options?
R: (Q and R come as is from Bryce Walter)
-I think I'm having success using cygwin perl instead of
-ActiveState Perl. I wasn't able to get CPAN working and
-building IO::Socket::SSL in ActiveState, but cygwin did
-all right. I had to force the install of the Net::SSLeay
-dependency, because it partially failed one test, but I think
-it worked anyway. In order to get working in cygwin, I
-installed the entire "perl" category, lynx, ncftp, and lftp
-(specified as ftp program in cpan setup). I'm not sure if I
-needed all those, or if cpan just kept asking because I didn't
-have any installed at the time. Anyway, cpan worked, and
-I installed all dependencies that imapsync complained
-about until it started working.
+
+I think I'm having success using cygwin perl instead of ActiveState
+Perl. I wasn't able to get CPAN working and building IO::Socket::SSL
+in ActiveState, but cygwin did all right. I had to force the install
+of the Net::SSLeay dependency, because it partially failed one test,
+but I think it worked anyway. In order to get working in cygwin, I
+installed the entire "perl" category, lynx, ncftp, and lftp (specified
+as ftp program in cpan setup). I'm not sure if I needed all those, or
+if cpan just kept asking because I didn't have any installed at the
+time. Anyway, cpan worked, and I installed all dependencies that
+imapsync complained about until it started working.
=======================================================================
Q: Multiple copies when I run imapsync twice ore more.
-R. Multiple copies of the emails on the destination
-server. Some IMAP servers (Domino for example) add some
-headers for each message transfered. The message is
-transfered again and again each time you run imapsync. This
-is bad of course. The explanation is that imapsync considers
-the message is not the same since headers have changed (one
+R. Multiple copies of the emails on the destination server. Some IMAP
+servers (Domino for example) add some headers for each message
+transfered. The message is transfered again and again each time you
+run imapsync. This is bad of course. The explanation is that imapsync
+considers the message is not the same since headers have changed (one
line added) and size too (the header part).
-You can look at the headers found by imapsync by using the
---debug option (and search for the message on both part),
-Header lines from the source server begin with a "FH:" prefix,
-Header lines from the destination server begin with a "TH:" prefix.
-Since --debug is very verbose I suggest to isolate a
-email in a specific folder in case you want to forward
-me the output.
+You can look at the headers found by imapsync by using the --debug
+option (and search for the message on both part), Header lines from
+the source server begin with a "FH:" prefix, Header lines from the
+destination server begin with a "TH:" prefix. Since --debug is very
+verbose I suggest to isolate a email in a specific folder in case you
+want to forward me the output.
The way to avoid this problem is by using options --skipheader and
---skipsize, like this (avoid headers beginning whith the
-string "X-"):
+--skipsize, like this (avoid headers beginning whith the string "X-"):
imapsync ... --skipheader '^X-' --skipsize
@@ -325,11 +321,11 @@
imapsync ... --useheader 'Message-ID' --skipsize
Remark. (Trick found by Tomasz Kaczmarski)
-Option --useheader 'Message-ID' asks the server
-to send only header lines begining with 'Message-ID'.
-Some (buggy) servers send the whole header (all lines)
-instead of the 'Message-ID' line. In that case, a trick
-to keep the --useheader filtering behavior is to use
+
+Option --useheader 'Message-ID' asks the server to send only header
+lines begining with 'Message-ID'. Some (buggy) servers send the whole
+header (all lines) instead of the 'Message-ID' line. In that case, a
+trick to keep the --useheader filtering behavior is to use
--skipheader with a negative lookahead pattern :
imapsync ... --skipheader '^(?!Message-ID)' --skipsize
@@ -357,14 +353,14 @@
or maybe
--exclude '^"public\.'
-In the example given the character "." is the folder separator,
-you can ommit it. Just take the string as it appears on the
-imapsync output line :
+In the example given the character "." is the folder separator, you
+can ommit it. Just take the string as it appears on the imapsync
+output line :
From folders list : [INBOX] [public.dreams] [etc.]
======================================================================
-Q. I want the --folder 'MyFolder' option be recurse.
+Q. I want the --folder 'MyFolder' option be recursive.
R. Do not use the --folder option.
Instead, use --include '^MyFolder'
@@ -412,17 +408,17 @@
--exclude '^user\.'
======================================================================
-Q. Is anyway imapsync to purge destionation folder when the source
- folder is deleted?
+Q. Is there anyway of making imapsync purge the destination folder
+ when the source folder is deleted?
+
+R. No, that's too dangerous.
-R. No, that's too much dangerous.
-But if the source folder is empty (not deleted) and
-options --delete2 --expunge2 are used then
-the destination folder will be empty.
+But if the source folder is empty (not deleted) and options --delete2
+--expunge2 are used then the destination folder will be empty.
======================================================================
Q. Is it possible to synchronize all messages from one server to
-another whithout recreating the folder structure and the target server.
+another without recreating the folder structure and the target server.
R. Yes.
1) First try (safe mode):
@@ -437,15 +433,15 @@
3) Remove --dry
Check the imap folder tree on the target side, you should
- only have one : the classical INBOX.
+ only have one: the classical INBOX.
4) Remove --justfolders
======================================================================
-Q. I have moved from Braunschweig to Graz, so I would like to have my whole
-Braunschweig mail sorted into a folder INBOX.Braunschweig of my new mail
-account.
+Q. I have moved from Braunschweig to Graz, so I would like to have my
+ whole Braunschweig mail sorted into a folder INBOX.Braunschweig of my
+ new mail account.
R.
1) First try (safe mode):
@@ -468,30 +464,29 @@
R. Examples:
-0) First try with --dry --justfolders options since imapsync shows the
-transformations it will do without really doing them. Then when happy
-with the output remove the --dry --justfolders options.
+0) First try with --dry --justfolders options since imapsync shows the
+ transformations it will do without really doing them. Then when
+ happy with the output remove the --dry --justfolders options.
1) To remove INBOX. in the name of destination folders:
--regextrans2 's/^INBOX\.(.+)/$1/'
2) To sync a complete account in a subfolder called FOO:
- a) Separator is dot character "." and "INBOX" prefixes every folder
+ a) Seperator is dot character "." and "INBOX" prefixes every folder
--regextrans2 's/^INBOX(.*)/INBOX.FOO$1/'
Or
- b) Separator is slash character "/"
+ b) Seperator is slash character "/"
--regextrans2 's#(.*)#FOO/$1#'
3) to substitute all characters dot "." by underscores "_"
--regextrans2 's/\./_/g'
=======================================================================
-Q. I would like to move emails from InBox to a sub-folder
-called , say "2005-InBox" based on the date (Like all emails
-received in the Year 2005 should be moved to the folder
-called "2005-InBox").
+Q. I would like to move emails from InBox to a sub-folder called,
+ say "2005-InBox" based on the date (Like all emails received in the
+ Year 2005 should be moved to the folder called "2005-InBox").
R. 2 ways :
@@ -499,17 +494,18 @@
------------
1) You create a folder INBOX.2005-INBOX
-2) Mostly every email software allow sorting by date.
-In inbox, you select from 1 january to 31 december
-messages with the shift key.
+
+2) Mostly every email software allow sorting by date. In inbox, you
+ select from 1 january to 31 december messages with the shift key.
+ (in mutt, use ~d)
+
3) Cut/paste in INBOX.2005-INBOX
b) With imapsync:
-----------------
-You have to calculate the day of year (and
-add 365). For example, running it today,
-Sat Mar 11 13:06:01 CET 2006:
+You have to calculate the day of year (and add 365). For example,
+running it today, Sat Mar 11 13:06:01 CET 2006:
imapsync ...
--host1 imap.truc.org --host2 imap.trac.org \
@@ -528,9 +524,9 @@
$ date +%j
070
-Also, you must take imapsync 1.159 at least since I tested
-what I just wrote above and found 2 bugs about --mindate
---maxdate options behavior.
+Also, you must take imapsync 1.159 at least since I tested what I just
+wrote above and found 2 bugs about --mindate --maxdate options
+behavior.
=======================================================================
Q. I want to play with headers line and --regexmess but I want to leave
@@ -573,42 +569,39 @@
Return-Path: <foo@yoyo.org>
Received: ...
-Any Maidir/ configured imap server may refuse this message
-since its header is invalid. The first "From " line is not
-valid. It lacks a colon character ":".
-To solve this problem you have several solutions a) or b):
-
-a) Remove these first "From " line manually for each message
-before using imapsync. Don't think to add a colon to this
-line since you will end with two "From:" lines (just look at
-the other lines)
+Any Maildir/ configured imap server may refuse this message since its
+header is invalid. The first "From " line is not valid. It lacks a
+colon character ":". To solve this problem you have several solutions
+
+a) Remove these first "From " line manually for each message before
+ using imapsync. Don't think to add a colon to this line since you
+ will end with two "From:" lines (just look at the other lines)
b) Run imapsync with the following options :
---regexmess 's/\AFrom \w .*\n//' --skipsize
+ --regexmess 's/\AFrom \w .*\n//' --skipsize
=======================================================================
Q. The contact folder isn't well copied.
- How to copy the contact folder ?
+ How to copy the contact folder?
-R. Forget the destination server (chose the same)
+R. Forget the destination server (choose the same)
Change the script around line 1426
# ITSD
$new_id = $from->copy($t_fold,$f_msg);
#$new_id = $to->append_string($t_fold,$string, $flags_f, $d);
-and tried a copy of the mail instead an append_string.
-Because we are using the same server, we can use $from->copy
-Therefore we seem to not download and upload the message and therefore
-we do not have any format issues.
-And now it works fine.
-(Thanks to Hansjoerg.Maurer)
+
+and tried a copy of the mail instead an append_string. Because we are
+using the same server, we can use $from->copy Therefore we seem to not
+download and upload the message and therefore we do not have any
+format issues. And now it works fine. (Thanks to Hansjoerg.Maurer)
=======================================================================
-Q. Synchronysing from XXX to Gmail
+Q. Synchronising from XXX to Gmail
-R. There are some details to get the special [Gmail]
-sub-folders right. Here's an example of migrating an old "Sent"
-folder to Gmail's structure:
+R. There are some details to get the special [Gmail] sub-folders
+ right. Here's an example of migrating an old "Sent" folder to
+ Gmail's structure:
imapsync --syncinternaldates \
--host1 mail.oldhost.com \
@@ -625,9 +618,9 @@
The same goes for the "All Mail" archive psuedo-folder.
=======================================================================
-Q. Synchronysing from Gmail to XXX
+Q. Synchronising from Gmail to XXX
-R. Gmail needs ssl.
+R. Gmail needs SSL
./imapsync \
--host1 imap.gmail.com --ssl1 \
@@ -661,6 +654,7 @@
Q. Syncing from Google Apps domain to Googlemail account
A known bug encountered with this output (Alexander is a folder name):
+
++++ Verifying [Alexander] -> [Alexander] ++++
+ NO msg #16 [A96Dh4AwlLVphOAW5MS/eQ:779824] in Alexander
+ Copying msg #16:779824 to folder Alexander
@@ -679,9 +673,9 @@
imapsync ... --folder Alexander
=======================================================================
-Q. I'm migrating from WU to Cyrus, and the mail folders are
-under /home/user/mail but the tool copies everything in
-/home/user, how can i avoid that?
+Q. I'm migrating from WU to Cyrus, and the mail folders are under
+ /home/user/mail but the tool copies everything in /home/user, how
+ can i avoid that?
R. Use
imapsync ... --include '^mail'
@@ -690,12 +684,11 @@
=======================================================================
-Q. I'm migrating from WU to Cyrus, and the mail folders are
-under /home/user/mail directory. When imapsync creates the
-folders in the new cyrus imap server, it makes a folder
-"mail" and below that folder puts all the mail folders the
-user have in /home/user/mail, i would like to have all those
-folders directly under INBOX.
+Q. I'm migrating from WU to Cyrus, and the mail folders are under
+ /home/user/mail directory. When imapsync creates the folders in
+ the new cyrus imap server, it makes a folder "mail" and below that
+ folder puts all the mail folders the user have in /home/user/mail,
+ i would like to have all those folders directly under INBOX.
R. Use
imapsync ... --regextrans2 's/^mail/INBOX/' --dry
@@ -719,30 +712,32 @@
--skipheader '^Content-Type'
- MIME separator IDs seem to change every time a mail is accessed so
-this is required to stop duplicates.
+ this is required to stop duplicates.
--maxage 3650
- some messages just don't seem to want to transfer and produce the
-perl errors I mentioned before. This prevents the errors, but the bad
-messages don't transfer.
+ perl errors I mentioned before. This prevents the errors, but the
+ bad messages don't transfer.
Even though the mail migrated OK, there are a couple of gotchas with
Groupwise IMAP:
-1) Some of the GW folders are not real folders and are not available to
-IMAP, the main problem one being "Sent Items". I could find no way of
-coping the contents of these folders. The nearest I got was to create a
-"real" folder and copy/move the sent items into it, but imapsync still
-didn't see the messages (I think because there is something funny about
-the reported dates/sizes).
+1) Some of the GW folders are not real folders and are not available
+to IMAP, the main problem one being "Sent Items". I could find no way
+of coping the contents of these folders. The nearest I got was to
+create a "real" folder and copy/move the sent items into it, but
+imapsync still didn't see the messages (I think because there is
+something funny about the reported dates/sizes).
+
It think this problem has been rectified in GW6.5.
2) The "skipheader '^Content-Type'" directive is required to stop
-duplicate messages being created. GW seems to generate this field on the
-fly for messages that have MIME separators and so it's different every time.
+duplicate messages being created. GW seems to generate this field on
+the fly for messages that have MIME separators and so it's different
+every time.
3) Version 6.0.1 of the Groupwise Internet Connector sucks. I was
-getting server abends when I pushed it a bit hard! I eventually had to
+getting server aborts when I pushed it a bit hard! I eventually had to
upgrade to 6.0.4 which seems to be a lot more stable.
@@ -816,18 +811,19 @@
--sep1 '/' --exclude 'user/demo/Trash' \
--regextrans2 's/^user.//' --syncinternaldates
-The 'exclude user/demo/Trash' was used because there was one message
-there with 8 bit headers which dbmail doesn't accept, so I had to skip
-the whole folder. It would be nice to have an option to just ignore and
-log unsyncable messages, but do the rest, instead of stopping.
+The 'exclude user/demo/Trash' was used because there was one message
+there with 8 bit headers which dbmail doesn't accept, so I had to skip
+the whole folder. It would be nice to have an option to just ignore
+and log unsyncable messages, but do the rest, instead of stopping.
******************
There are two other major problems:
-1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops
+
+1) dbmail doesn't accept utf8 header, while cyrus does. imapsync stops
in that case, making sync impossible
-To convert the wholes messages from 8bit to 7bit, use option :
+To convert the whole messages from 8bit to 7bit, use option :
--regexmess 's/[\x80-\xff]/X/g'
@@ -861,7 +857,7 @@
Q. From any to Exchange2007
Several problems:
-- Big messages: increse the "send- and receive-connector"
+- Big messages: increase the "send- and receive-connector"
in exchange2007 to 40 MB.
R. 2 solutions

View file

@ -0,0 +1,535 @@
--- imapsync.orig 2005-02-11 14:27:53.508176000 -0600
+++ imapsync 2005-02-14 11:39:31.241157000 -0600
@@ -1,6 +1,6 @@
#!/usr/bin/perl -w
-=head1 NAME
+=head1 NAME
imapsync - IMAP synchronization, copy or migration
tool. Synchronize mailboxes between two imap servers. Good
@@ -35,9 +35,9 @@
imapsync
imapsync [--host1 server1] [--port1 <num>]
- [--user1 <string>] [--passfile1 <string>]
+ [--user1 <string>] [--passfile1 <string>]
[--host2 server2] [--port2 <num>]
- [--user2 <string>] [--passfile2 <string>]
+ [--user2 <string>] [--passfile2 <string>]
[--folder <string> --folder <string> ...]
[--include <regex>] [--exclude <regex>]
[--prefix2 <string>]
@@ -55,14 +55,14 @@
[--debug] [--debugimap]
[--timeout <int>]
[--version] [--help]
-
+
=cut
# comment
=pod
=head1 DESCRIPTION
-The command imapsync is a tool allowing incremental and recursive
+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
@@ -133,10 +133,10 @@
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
+So if you have a buggy internet connection, you can use this loop
in a Bourne shell:
- while ! imapsync ...; do
+ while ! imapsync ...; do
echo imapsync not complete
done
@@ -184,7 +184,7 @@
=head1 IMAP SERVERS
-Success stories reported (softwares in alphabetic order) :
+Success stories reported (softwares in alphabetic order) :
- BincImap 1.2.3
- CommunicatePro server (Redhat 8.0)
@@ -223,7 +223,7 @@
=head1 HUGE MIGRATION
-Have a special attention on options
+Have a special attention on options
--subscribed
--subscribe
--delete
@@ -244,7 +244,7 @@
And the shell program is just :
-{ while IFS=';' read u1 p1 u2 p2; do
+{ while IFS=';' read u1 p1 u2 p2; do
imapsync --user1 $u1 --password1 $p1 --user2 $u2 --password2 $p2 ...
done ; } < file.csv
@@ -266,7 +266,7 @@
mailsync : http://mailsync.sourceforge.net/
imapxfer : http://www.washington.edu/imap/
part of the imap-utils from UW.
- mailutil : replace imapxfer in
+ 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/
@@ -308,10 +308,10 @@
$syncinternaldates, $syncacls,
$maxsize, $maxage,
$skipheader, $skipsize, $foldersizes,
- $delete, $expunge, $dry,
+ $delete, $expunge, $dry,
$authmd5,
$subscribed, $subscribe,
- $version, $VERSION, $help,
+ $version, $VERSION, $help,
$justconnect, $justfolders,
$fast,
$mess_size_total_trans,
@@ -321,6 +321,7 @@
$timeout, # whr (ESS/PRW)
$timestart, $timeend, $timediff,
$timesize, $timebefore,
+ $verbose, $justcopy
);
@@ -362,7 +363,7 @@
$error=0;
-my $banner = join("",
+my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.121 $ ',
'$Date: 2005/02/01 04:03:30 $ ',
@@ -426,7 +427,7 @@
$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout);
sub login_imap {
- my($host, $port, $user, $password,
+ my($host, $port, $user, $password,
$debugimap, $timeout, $authmech) = @_;
my $imap = Mail::IMAPClient->new();
$imap->Server($host);
@@ -461,12 +462,12 @@
print "$authmech not wanted by you\n";
return;
}
- if ($imap->has_capability($authmech)
+ if ($imap->has_capability($authmech)
or $imap->has_capability("AUTH=$authmech")) {
- print "Server [", $imap->Server,
+ print "Server [", $imap->Server,
"] has capability $authmech\n";
}else{
- print "Server [", $imap->Server,
+ print "Server [", $imap->Server,
"] has NOT capability $authmech\n";
return;
}
@@ -520,7 +521,7 @@
@t_folders = sort @{$to->folders()};
-my($f_sep,$t_sep);
+my($f_sep,$t_sep);
# what are the private folders separators for each server ?
@@ -543,8 +544,8 @@
$sep_out = $imap->separator();
return($sep_out);
}else{
- print
- "No NAMESPACE capability in imap server ",
+ print
+ "No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
"Give the separator caracter with the $sep_opt option\n";
exit(1);
@@ -555,7 +556,7 @@
print "From separator : [$f_sep]\n";
print "To separator : [$t_sep]\n";
-if ($foldersizes) {
+if (!$justcopy and $foldersizes) {
my $tot = 0;
my $tmess = 0;
print "++++ Calculating sizes ++++\n";
@@ -564,7 +565,7 @@
my $smess = 0;
printf("From Folder %-25s", "[$f_fold]");
unless ($from->select($f_fold)) {
- warn
+ warn
"From Folder $f_fold : Could not select ",
$from->LastError, "\n";
$error++;
@@ -616,11 +617,11 @@
-print
+print
"From folders : ", map("[$_] ",@f_folders),"\n",
"To folders : ", map("[$_] ",@t_folders),"\n";
-print
+print
"From subscribed folders : ", map("[$_] ", sort keys(%fs_folders)), "\n";
sub separator_invert {
@@ -654,14 +655,14 @@
print "To Folder [$t_fold]\n";
unless ($from->select($f_fold)) {
- warn
+ warn
"From Folder $f_fold : Could not select ",
$from->LastError, "\n";
$error++;
next FOLDER;
}
- unless ($to->exists($t_fold) or $to->select($t_fold)) {
+ 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){
@@ -675,9 +676,9 @@
next FOLDER;
}
}
-
- unless ($to->select($t_fold)) {
- warn
+
+ unless ($to->select($t_fold)) {
+ warn
"To Folder $t_fold : Could not select ",
$to->LastError, "\n";
$error++;
@@ -708,6 +709,7 @@
}
}
}
+ print "Time folders: ", timenext(), " s\n";
next FOLDER if ($justfolders);
@@ -725,6 +727,7 @@
$from->Clear(1);
$to->Clear(1);
+ print "Time query: ", timenext(), " s\n";
print "From Buffer I/O : ", $from->Buffer(), "\n";
print "To Buffer I/O : ", $to->Buffer(), "\n";
@@ -733,49 +736,55 @@
# print "From Buffer I/O : ", $from->Buffer(), "\n";
# print "To Buffer I/O : ", $to->Buffer(), "\n";
- print "++++ From Parse 1 ++++\n";
-
- my $f_heads = $from->parse_headers([@f_msgs],"ALL") if (@f_msgs) ;
- print "Time headers: ", timenext(), " s\n";
- my $f_size = $from->fetch_hash("RFC822.SIZE") if (@f_msgs);
- print "Time sizes : ", timenext(), " s\n";
- #my $f_flags = $from->flags(@f_msgs) ;
- #print "Time flags : ", timenext(), " s\n";
- use Data::Dumper;
- #print Data::Dumper->Dump([$f_heads]);
- #print Data::Dumper->Dump([$f_flags]);
-
- #exit;
- foreach my $m (@f_msgs) {
- parse_header_msg1($m, $f_heads, $f_size, "F", \%f_hash);
- }
- print "Time headers: ", timenext(), " s\n";
-
- print "\n++++ To Parse 1 ++++\n";
- my $t_heads = $to->parse_headers([@t_msgs],"ALL") if (@t_msgs);
- print "Time headers: ", timenext(), " s\n";
- my $t_size = $to->fetch_hash("RFC822.SIZE") if (@t_msgs);
- print "Time sizes : ", timenext(), " s\n";
- #my $t_flags = $to->flags(@t_msgs) ;
- #print "Time flags : ", timenext(), " s\n";
-
- foreach my $m (@t_msgs) {
- parse_header_msg1($m, $t_heads, $t_size, "T", \%t_hash);
- }
- print "Time headers: ", timenext(), " s\n";
- #exit;
-
- print "\n++++ Verifying ++++\n";
- # messages in "from" that are not good in "to"
-
- my @f_hash_keys_sorted_by_uid
- = sort {$f_hash{$a}{'m'} <=> $f_hash{$b}{'m'}} keys(%f_hash);
-
- #print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid;
-
- MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) {
- my $f_size = $f_hash{$m_id}{'s'};
- my $f_msg = $f_hash{$m_id}{'m'};
+ # Define f_hash_keys_sorted_by_uid outside of if statement to keep
+ # Perl happy
+ my @f_hash_keys_sorted_by_uid = ();
+ if ($justcopy) {
+ print "++++ Copying ++++\n";
+ } else {
+ print "++++ From Parse 1 ++++\n";
+
+ my $f_heads = $from->parse_headers([@f_msgs],"ALL") if (@f_msgs) ;
+ print "Time headers: ", timenext(), " s\n";
+ my $f_size = $from->fetch_hash("RFC822.SIZE") if (@f_msgs);
+ print "Time sizes : ", timenext(), " s\n";
+ #my $f_flags = $from->flags(@f_msgs) ;
+ #print "Time flags : ", timenext(), " s\n";
+ use Data::Dumper;
+ #print Data::Dumper->Dump([$f_heads]);
+ #print Data::Dumper->Dump([$f_flags]);
+
+ #exit;
+ foreach my $m (@f_msgs) {
+ parse_header_msg1($m, $f_heads, $f_size, "F", \%f_hash);
+ }
+ print "Time headers: ", timenext(), " s\n";
+
+ print "\n++++ To Parse 1 ++++\n";
+ my $t_heads = $to->parse_headers([@t_msgs],"ALL") if (@t_msgs);
+ print "Time headers: ", timenext(), " s\n";
+ my $t_size = $to->fetch_hash("RFC822.SIZE") if (@t_msgs);
+ print "Time sizes : ", timenext(), " s\n";
+ #my $t_flags = $to->flags(@t_msgs) ;
+ #print "Time flags : ", timenext(), " s\n";
+
+ foreach my $m (@t_msgs) {
+ parse_header_msg1($m, $t_heads, $t_size, "T", \%t_hash);
+ }
+ print "Time headers: ", timenext(), " s\n";
+ #exit;
+
+ print "\n++++ Verifying ++++\n";
+ # messages in "from" that are not good in "to"
+ @f_hash_keys_sorted_by_uid
+ = sort {$f_hash{$a}{'m'} <=> $f_hash{$b}{'m'}} keys(%f_hash);
+
+ #print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid;
+ }
+
+ MESS: foreach my $m_id ($justcopy ? @f_msgs : @f_hash_keys_sorted_by_uid) {
+ my $f_size = $justcopy ? 0 : $f_hash{$m_id}{'s'};
+ my $f_msg = $justcopy ? $m_id : $f_hash{$m_id}{'m'};
# print ".";
if (defined $maxsize and $f_size > $maxsize) {
print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n";
@@ -783,10 +792,10 @@
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";
+ unless (!$justcopy and exists($t_hash{$m_id})) {
+ $verbose and print "+ NO msg #$f_msg [$m_id] in $t_fold\n";
# copy
- print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
+ $verbose and print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
my $string = $from->message_string($f_msg);
while (my $regexmess = shift(@regexmess)) {
$debug and print "eval \$string =~ $regexmess\n";
@@ -809,7 +818,7 @@
$flags_f =~ s@\\Recent@@g;
my $new_id;
- print "flags from : [$flags_f][$d]\n";
+ $verbose and print "flags from : [$flags_f][$d]\n";
unless ($dry) {
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: ",
@@ -820,9 +829,9 @@
}else{
# good
- # $new_id is an id if the IMAP server has the
+ # $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";
+ $verbose and print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
$mess_size_total_trans += $f_size;
$mess_trans += 1;
}
@@ -834,12 +843,12 @@
$mess_skipped += 1;
}
- $fast and next MESS;
- #$debug and print "MESSAGE $m_id\n";
+ ($fast or $justcopy) and next MESS;
+ #$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";
+ $debug and print "Setting flags\n";
my (@flags_f,@flags_t);
my $flags_f_rv = $from->flags($f_msg);
@flags_f = @{$flags_f_rv} if ref($flags_f_rv);
@@ -852,16 +861,16 @@
my $flags_t_rv = $to->flags($t_msg);
@flags_t = @{$flags_t_rv} if ref($flags_t_rv);
- $debug and print
+ $debug and print
"flags from : @flags_f\n",
"flags to : @flags_t\n";
$debug and do {
- print "Looking dates\n";
+ print "Looking dates\n";
my $d_f = $from->internaldate($f_msg);
my $d_t = $to->internaldate($t_msg);
- print
+ print
"idate from : $d_f\n",
"idate to : $d_t\n";
#unless ($d_f eq $d_t) {
@@ -870,7 +879,7 @@
};
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";
# delete in to and recopy ?
# NO recopy CODE HERE. to be written if needed.
@@ -880,17 +889,17 @@
$to->delete_message($t_msg) unless ($dry);
}
}else {
- # Good
+ # 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";
+ $verbose and print "Deleting msg #$f_msg in folder $f_fold\n";
$from->delete_message($f_msg) unless ($dry);
$from->expunge() if ($expunge and not $dry);
}
}
}
-print "Time : ", timenext(), " s\n";
+ print "Time : ", timenext(), " s\n";
}
$timeend = time();
@@ -959,6 +968,8 @@
"timeout=i" => \$timeout,
"skipheader=s" => \$skipheader,
"skipsize!" => \$skipsize,
+ "verbose!" => \$verbose,
+ "justcopy!" => \$justcopy,
);
$debug and print "get options: [$opt_ret]\n";
@@ -1020,7 +1031,7 @@
my $headstr;
$debug and print "Head NUM:", scalar(keys(%$head)), "\n";
# no header -> return
- return unless(scalar(keys(%$head)));
+ return unless(scalar(keys(%$head)));
foreach my $h (sort keys(%$head)){
foreach my $val (sort @{$head->{$h}}) {
# no 8-bit data in headers !
@@ -1050,12 +1061,12 @@
my($file) = @_;
my $line = "";
-
+
open FILE, $file or die("$! $file");
chomp($line = <FILE>);
close FILE;
$line = ($line) ? $line : "!EMPTY! $file";
- return $line;
+ return $line;
}
sub usage {
@@ -1063,7 +1074,7 @@
usage: $0 [options]
-Several options are mandatory.
+Several options are mandatory.
--host1 <string> : "from" imap server. Mandatory.
--port1 <int> : port to connect. Default is 143.
@@ -1085,7 +1096,7 @@
--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
+--prefix2 <string> : add prefix to all destination folders
(usually INBOX. for cyrus imap servers)
--regextrans2 <regex> : Apply the whole regex to each destination folders.
--regexmess <regex> : Apply the whole regex to each message before transfer.
@@ -1101,7 +1112,7 @@
are not really deleted. See expunge.
--expunge : expunge messages on source account.
expunge really deletes messages marked deleted.
- expunge is made at the begining on the
+ expunge is made at the begining on the
source server only. newly transfered messages
are expunged if option --expunge is given.
no expunge is done on destination account but
@@ -1110,12 +1121,12 @@
--maxsize <int> : skip messages larger than <int> bytes
--maxage <int> : skip messages older than <int> days.
final stats (skipped) don't count older messages
---skipheader <regex> : Don't take into account header keyword
+--skipheader <regex> : Don't take into account header keyword
matching <string> ex: --skipheader 'X.*'
--skipsize : Don't take message size into account.
--dry : do nothing, just print what would be done.
--subscribed : transfer only subscribed folders.
---subscribe : subscribe to the folders transfered on the
+--subscribe : subscribe to the folders transfered on the
"destination" server that are subscribed
on the "source" server.
--(no)foldersizes : Calculate the size of each "From" folder in bytes
@@ -1125,12 +1136,17 @@
--debug : debug mode.
--debugimap : imap debug mode.
--version : print sotfware version.
---justconnect : just connect to both servers and print useful
+--justconnect : just connect to both servers and print useful
information.
--justfolders : just do things about folders (ignore messages).
--fast : be faster.
--timeout <int> : imap connect timeout.
--help : print this.
+--verbose : print info for each message transferred.
+--justcopy : only copy messages. Implies nofoldersizes, fast and
+ nomaxsize. No synchronization, might create duplicate
+ messages. Ment to be used for fast migration of
+ messages to new (empty) IMAP accounts.
Example: to synchronise imap account "foo" on "imap.truc.org"
to imap account "bar" on "imap.trac.org"

View file

@ -0,0 +1,224 @@
--- imapsync 2005-07-16 08:46:35.000000000 -0400
+++ ../imapsync.ssl 2005-10-05 14:46:23.000000000 -0400
@@ -38,7 +38,8 @@
[--user1 <string>] [--passfile1 <string>]
[--host2 server2] [--port2 <num>]
[--user2 <string>] [--passfile2 <string>]
- [--noauthmd5]
+ [--noauthmd5] [--authusing <string> --prefix1 <string>]
+ [--authmech <string]
[--folder <string> --folder <string> ...]
[--include <regex>] [--exclude <regex>]
[--prefix2 <string>] [--regextrans2 <regex>]
@@ -61,6 +62,7 @@
[--debug] [--debugimap]
[--timeout <int>] [--fast]
[--version] [--help]
+ [--ssl]
=cut
# comment
@@ -315,25 +317,28 @@
use Digest::MD5 qw(md5_base64);
use Term::ReadKey;
#use Digest::HMAC_MD5;
+use IO::Socket::SSL;
+use MIME::Base64;
eval { require 'usr/include/sysexits.ph' };
my(
$rcs, $debug, $debugimap, $error,
- $host1, $host2, $port1, $port2,
- $user1, $user2, $password1, $password2, $passfile1, $passfile2,
+ $host1, $host2, $port1, $port2,
+ $user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, $include, $exclude, $prefix2, $regextrans2, @regexmess,
+ $authusing, $prefix1, $authmech,
$sep1, $sep2,
- $syncinternaldates, $syncacls,
+ $syncinternaldates, $syncacls,
$fastio1, $fastio2,
- $maxsize, $maxage,
+ $maxsize, $maxage,
$skipheader, @useheader,
$skipsize, $foldersizes, $buffersize,
- $delete, $expunge, $dry,
+ $delete, $expunge, $dry,
$authmd5,
$subscribed, $subscribe,
- $version, $VERSION, $help,
+ $version, $VERSION, $help,
$justconnect, $justfolders,
$fast,
$mess_size_total_trans,
@@ -341,8 +346,9 @@
$mess_size_total_error,
$mess_trans, $mess_skipped,
$timeout, # whr (ESS/PRW)
- $timestart, $timeend, $timediff,
+ $timestart, $timeend, $timediff,
$timesize, $timebefore,
+ $usessl
);
use vars qw ($opt_G); # missing code for this will be option.
@@ -406,11 +412,11 @@
}
$host1 || missing_option("--host1") ;
-$port1 = (defined($port1)) ? $port1 : 143;
+$port1 = (defined($port1)) ? $port1 : ((defined($usessl)) ? 993 : 143);
$user1 || missing_option("--user1");
$host2 || missing_option("--host2") ;
-$port2 = (defined($port2)) ? $port2 : 143;
+$port2 = (defined($port2)) ? $port2 : ((defined($usessl)) ? 993 : 143);
$user2 || missing_option("--user2");
$authmd5 = (defined($authmd5)) ? $authmd5 : 1;
@@ -424,8 +430,8 @@
@useheader = ("ALL") unless (@useheader);
-print "From imap server [$host1] port [$port1] user [$user1]\n";
-print "To imap server [$host2] port [$port2] user [$user2]\n";
+(defined($authusing)) ? print "From imap server [$host1] port [$port1] user [$user1] authusing [$authusing]\n" : print "From imap server [$host1] port [$port1] user [$user1]\n";
+(defined($authusing)) ? print "To imap server [$host2] port [$port2] user [$user2] authusing [$authusing]\n" : print "To imap server [$host2] port [$port2] user [$user2]\n";
$password1 || $passfile1 || do {
print "What's the password for $user1\@$host1? ";
@@ -447,8 +453,9 @@
my $from = ();
my $to = ();
-my $authmech = "CRAM-MD5";
-
+if (!defined($authmech)) {
+ $authmech = "CRAM-MD5";
+}
$timestart = time();
$timebefore = $timestart;
@@ -474,7 +481,19 @@
sub login_imap {
my($host, $port, $user, $password,
$debugimap, $timeout, $fastio) = @_;
- my $imap = Mail::IMAPClient->new();
+ my ($imap);
+ if ($usessl) {
+ my $ssl = new IO::Socket::SSL("$host:$port");
+ die ("Error connecting - $@") unless defined $ssl;
+ $ssl->autoflush(1);
+
+ $imap = Mail::IMAPClient->new(
+ Socket => $ssl,
+ Server => $host,
+ );
+ } else {
+ $imap = Mail::IMAPClient->new();
+ }
$imap->Server($host);
$imap->Port($port);
$imap->Fast_io($fastio);
@@ -482,13 +501,17 @@
$imap->Uid(1);
$imap->Peek(1);
$imap->Debug($debugimap);
- $imap->connect()
- or die "Can not open imap connection on [$host] with user [$user] : $@\n";
- if ($timeout) # whr (ESS/PRW)
- {
- $imap->Timeout($timeout);
- print "Setting imap timeout to $timeout\n";
- }
+ $imap->Authcallback(\&plainauth);
+ if ($usessl) {
+ $imap->State(Mail::IMAPClient::Connected);
+ } else {
+ $imap->connect()
+ or die "Can not open imap connection on [$host] with user [$user] : $@\n";
+ }
+ if ($timeout) { # whr (ESS/PRW)
+ $imap->Timeout($timeout);
+ print "Setting imap timeout to $timeout\n";
+ }
$imap->User($user);
$imap->Password($password);
@@ -497,6 +520,13 @@
return($imap);
}
+sub plainauth() {
+ my $code = shift;
+ my $imap = shift;
+
+ my $string = sprintf("%s\x00%s\x00%s", $imap->User, defined($authusing) ? $authusing : $imap->User, $imap->Password);
+ return encode_base64("$string");
+}
sub md5auth() {
my ($imap) = @_;
@@ -537,7 +567,7 @@
my (@f_folders, @t_folders, %fs_folders);
# Make a hash of subscribed folders in source server.
-# map { $fs_folders{$_}=1 } $from->subscribed();
+map { $fs_folders{$_}=1 } $from->subscribed($prefix1);
@@ -550,7 +580,7 @@
@f_folders = sort keys (%fs_folders);
}else {
# no option, all folders
- @f_folders = sort $from->folders();
+ @f_folders = sort $from->folders($prefix1);
# consider (optional) includes and excludes
if ($include) {
@f_folders = grep /$include/,@f_folders;
@@ -996,6 +1026,8 @@
"port2=i" => \$port2,
"user1=s" => \$user1,
"user2=s" => \$user2,
+ "authusing=s" => \$authusing,
+ "authmech=s" => \$authmech,
"password1=s" => \$password1,
"password2=s" => \$password2,
"passfile1=s" => \$passfile1,
@@ -1006,6 +1038,7 @@
"folder=s" => \@folder,
"include=s" => \$include,
"exclude=s" => \$exclude,
+ "prefix1=s" => \$prefix1,
"prefix2=s" => \$prefix2,
"regextrans2=s" => \$regextrans2,
"regexmess=s" => \@regexmess,
@@ -1031,6 +1064,7 @@
"skipsize!" => \$skipsize,
"fastio1!" => \$fastio1,
"fastio2!" => \$fastio2,
+ "ssl!" => \$usessl
);
$debug and print "get options: [$opt_ret]\n";
@@ -1122,6 +1156,9 @@
--host2 <string> : "destination" imap server. Mandatory.
--port2 <int> : port to connect. Default is 143.
--user2 <string> : user to login. Mandatory.
+--authusing <string> : user to auth with (when running on behalf of another)
+--authmech <string> : auth mechanism to use (e.g. PLAIN, LOGIN, CRAM-MD5...)
+ default CRAM-MD5
--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.
@@ -1187,6 +1224,7 @@
--nofastio1 : don't use fastio with the "from" server.
--nofastio2 : don't use fastio with the "destination" server.
--timeout <int> : imap connect timeout.
+--ssl : use SSL connections.
--help : print this.
Example: to synchronise imap account "foo" on "imap.truc.org"

View file

@ -0,0 +1,593 @@
--- imapsync.orig 2006-03-13 16:34:48.430310000 +0100
+++ imapsync 2006-03-16 07:25:53.113435000 +0100
@@ -38,7 +38,7 @@
[--user1 <string>] [--passfile1 <string>]
[--host2 server2] [--port2 <num>]
[--user2 <string>] [--passfile2 <string>]
- [--noauthmd5]
+ [--authusing <string>] [--authmech <string>]
[--folder <string> --folder <string> ...]
[--include <regex>] [--exclude <regex>]
[--prefix2 <string>] [--prefix1 <string>]
@@ -46,7 +46,6 @@
[--sep1 <char>]
[--sep2 <char>]
[--justfolders] [--justfoldersizes] [--justconnect]
- [--syncinternaldates]
[--buffersize <int>]
[--syncacls]
[--regexmess <regex>] [--regexmess <regex>]
@@ -60,9 +59,10 @@
[--subscribed] [--subscribe]
[--nofoldersizes]
[--dry]
- [--debug] [--debugimap]
+ [--debug] [--debugimap] [--verbose]
[--timeout <int>] [--fast]
[--version] [--help]
+ [--ssl]
=cut
# comment
@@ -134,8 +134,14 @@
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.
+You may authenticate as one user (typically an admin user), but be
+authorized as someone else, which means you don't need to know every
+user's personal password. Specify --authusing ADMIN to enable this.
+In this case, --authmech PLAIN will be used, but otherwise,
+--authmech CRAM-MD5 is the default.
+
+To protect yourself from network sniffers, use --ssl to enable
+encryption.
=head1 EXIT STATUS
@@ -334,26 +340,27 @@
use Digest::MD5 qw(md5_base64);
use Term::ReadKey;
#use Digest::HMAC_MD5;
+use IO::Socket::SSL;
+use MIME::Base64;
eval { require 'usr/include/sysexits.ph' };
my(
- $rcs, $debug, $debugimap, $error,
+ $rcs, $debug, $debugimap, $verbose, $error,
$host1, $host2, $port1, $port2,
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, $include, $exclude,
+ $authusing, $authmech,
$prefix1, $prefix2,
@regextrans2, @regexmess,
$sep1, $sep2,
- $syncinternaldates, $syncacls,
- $fastio1, $fastio2,
+ $syncacls,
$maxsize, $maxage, $minage,
$skipheader, @useheader,
$skipsize, $foldersizes, $buffersize,
$delete, $expunge, $expunge1, $expunge2, $dry,
$justfoldersizes,
- $authmd5,
$subscribed, $subscribe,
$version, $VERSION, $help,
$justconnect, $justfolders,
@@ -365,6 +372,7 @@
$timeout, # whr (ESS/PRW)
$timestart, $timeend, $timediff,
$timesize, $timebefore,
+ $usessl
);
use vars qw ($opt_G); # missing code for this will be option.
@@ -387,17 +395,10 @@
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);
-
- 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);
+ my $ver = sprintf("%c%c%c", $1, $2, $3);
+ return $ver ge v2.2.9;
}else{
return 0; # don't match regex => bad
}
@@ -420,7 +421,7 @@
}
get_options();
-print $banner;
+print $banner if $verbose;
sub missing_option {
my ($option) = @_;
@@ -428,88 +429,72 @@
}
$host1 || missing_option("--host1") ;
-$port1 = (defined($port1)) ? $port1 : 143;
+$port1 ||= defined $usessl ? 993 : 143;
$host2 || missing_option("--host2") ;
-$port2 = (defined($port2)) ? $port2 : 143;
+$port2 ||= defined $usessl ? 993 : 143;
-sub connect_imap {
- my($host, $port, $debugimap) = @_;
- my $imap = Mail::IMAPClient->new();
- $imap->Server($host);
- $imap->Port($port);
- $imap->Debug($debugimap);
- $imap->connect()
- or die "Can not open imap connection on [$host] : $@\n";
-}
+$authmech ||= $authusing ? 'PLAIN' : 'CRAM-MD5';
+
+my $from = connect_imap($host1, $port1, $timeout);
+print "From software : ", server_banner($from);
+print "From capability : ", join(" ", $from->capability()), "\n";
+
+my $to = connect_imap($host2, $port2, $timeout);
+print "To software : ", server_banner($to);
+print "To capability : ", join(" ", $to->capability()), "\n";
if ($justconnect) {
- my $from = ();
- my $to = ();
-
- $from = connect_imap($host1, $port1);
- print "From software : ", ($from->Report())[0];
- print "From capability : ", join(" ", $from->capability()), "\n";
- $to = connect_imap($host2, $port2);
- print "To software : ", ($to->Report())[0];
- print "To capability : ", join(" ", $to->capability()), "\n";
$from->logout();
$to->logout();
exit(0);
}
-
$user1 || missing_option("--user1");
$user2 || missing_option("--user2");
-$authmd5 = (defined($authmd5)) ? $authmd5 : 1;
-
$syncacls = (defined($syncacls)) ? $syncacls : 0;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1;
-$fastio1 = (defined($fastio1)) ? $fastio1 : 1;
-$fastio2 = (defined($fastio2)) ? $fastio2 : 1;
-
-
@useheader = ("ALL") unless (@useheader);
-print "From imap server [$host1] port [$port1] user [$user1]\n";
-print "To imap server [$host2] port [$port2] user [$user2]\n";
+if (defined $authusing) {
+ print "From [$user1\@$host1:$port1] authenticate as [$authusing]\n";
+ print "To [$user2\@$host2:$port2] authenticate as [$authusing]\n";
+} else {
+ print "From [$user1\@$host1:$port1]\n";
+ print "To [$user2\@$host2:$port2]\n";
+}
+
+sub ask_for_password {
+ my ($user, $host) = @_;
-$password1 || $passfile1 || do {
- print "What's the password for $user1\@$host1? ";
+ print "What's the password for $user\@$host? ";
ReadMode 2;
- $password1 = <>; chop $password1;
- printf "\n"; ReadMode 0;
-};
+ my $password = <>;
+ chomp $password;
+ printf "\n";
+ ReadMode 0;
+ return $password;
+}
+unless ($password1 || $passfile1) {
+ $password1 = ask_for_password($authusing || $user1, $host1);
+}
$password1 = (defined($passfile1)) ? firstline ($passfile1) : $password1;
-$password2 || $passfile2 || do {
- print "What's the password for $user2\@$host2? ";
- ReadMode 2;
- $password2 = <>; chop $password2;
- printf "\n"; ReadMode 0;
-};
+unless ($password2 || $passfile2) {
+ $password2 = $authusing ? $password1 : ask_for_password($user2, $host2);
+}
$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2;
-my $from = ();
-my $to = ();
-
-my $authmech = "CRAM-MD5";
-
-
$timestart = time();
$timebefore = $timestart;
-$fastio1 = 1;
-$fastio2 = 1;
-
$debugimap and print "From connection\n";
-$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout, $fastio1);
-
+$from = login_imap($from, $user1, $password1);
$debugimap and print "To connection\n";
-$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout, $fastio2);
+$to = login_imap($to, $user2, $password2);
# No history
$from->Clear(2);
@@ -518,69 +503,79 @@
$debug and print "From Buffer I/O : ", $from->Buffer(), "\n";
$debug and print "To Buffer I/O : ", $to->Buffer(), "\n";
-
-sub login_imap {
- my($host, $port, $user, $password,
- $debugimap, $timeout, $fastio) = @_;
- my $imap = Mail::IMAPClient->new();
+sub connect_imap {
+ my ($host, $port, $timeout) = @_;
+ my ($imap);
+ if ($usessl) {
+ my $ssl = new IO::Socket::SSL("$host:$port");
+ die "Error connecting to $host:$port: $@\n" unless $ssl;
+ $ssl->autoflush(1);
+
+ $imap = Mail::IMAPClient->new(
+ Socket => $ssl,
+ Server => $host,
+ );
+ } else {
+ $imap = Mail::IMAPClient->new();
+ }
$imap->Server($host);
$imap->Port($port);
- $imap->Fast_io($fastio);
$imap->Buffer($buffersize || 4096);
$imap->Uid(1);
$imap->Peek(1);
$imap->Debug($debugimap);
- $imap->connect()
- or die "Can not open imap connection on [$host] with user [$user] : $@\n";
+ if ($usessl) {
+ $imap->State(Mail::IMAPClient::Connected);
+ } else {
+ $imap->connect()
+ or die "Can not open imap connection on [$host]: $@\n";
+ }
+ if ($authusing && $authmech ne "PLAIN") {
+ print "ERROR: --authusing is only implemented with --authmech PLAIN\n";
+ } elsif ($authmech eq "LOGIN") {
+ # Default mode for Mail::IMAPClient, so don't do anything.
+ } elsif ($imap->has_capability("AUTH=$authmech")) {
+ $imap->Authmechanism($authmech);
+ $imap->Authcallback(\&plainauth) if $authmech eq "PLAIN";
+ } else {
+ printf("%s: no support for AUTHENTICATE %s, using LOGIN\n",
+ $imap->Server, $authmech);
+ }
if ($timeout) # whr (ESS/PRW)
{
$imap->Timeout($timeout);
print "Setting imap timeout to $timeout\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 ($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";
- }else{
- $imap->Authmechanism(undef);
- print "Can NOT use $authmech authentification, using plain\n";
+sub server_banner {
+ my $imap = shift;
+ for my $line ($imap->Results()) {
+ return $line if $line =~ /^\* (OK|NO|BAD)/;
}
- return;
+ return "No banner\n";
}
+sub login_imap {
+ my ($imap, $user, $password) = @_;
+ $imap->User($user);
+ $imap->Password($password);
+ $imap->login()
+ or die "Error login: [$imap->{Server}] with user [$user]: $@\n";
+ return($imap);
+}
-
-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";
+sub plainauth() {
+ my $code = shift;
+ my $imap = shift;
+
+ my $string = sprintf("%s\x00%s\x00%s", $imap->User,
+ $authusing || $imap->User, $imap->Password);
+ return encode_base64("$string");
+}
die unless $from->IsAuthenticated();
die unless $to->IsAuthenticated();
@@ -601,7 +596,7 @@
@f_folders = sort keys (%fs_folders);
}else {
# no option, all folders
- @f_folders = sort $from->folders();
+ @f_folders = sort $from->folders($prefix1);
# consider (optional) includes and excludes
if ($include) {
@f_folders = grep /$include/,@f_folders;
@@ -615,22 +610,33 @@
@t_folders = sort @{$to->folders()};
-my($f_sep,$t_sep);
# what are the private folders separators for each server ?
+my $f_sep = get_separator($from, $sep1, "--sep1");
+my $f_prefix = get_prefix($from, $prefix1, "--prefix1");
+if (@t_folders == 0) {
+ if ($authusing) {
+ # We assume we're allowed to create new users.
+ # We may need to make the "user." prefix configurable
+ unless ($dry || $to->create("user.$user2")) {
+ print STDERR "Couldn't create user.$user2 on $host2",
+ $to->LastError, "\n";
+ exit(1);
+ }
+ } else {
+ print "$user2 does not exist on $host2\n";
+ exit(1);
+ }
+}
-$debug and print "Getting separators\n";
-$f_sep = get_separator($from, $sep1, "--sep1");
-$t_sep = get_separator($to, $sep2, "--sep2");
+my $t_sep = get_separator($to, $sep2, "--sep2");
+my $t_prefix = get_prefix($to, $prefix2, "--prefix2");
#my $f_namespace = $from->namespace();
#my $t_namespace = $to->namespace();
#$debug and print "From namespace:\n", Data::Dumper->Dump([$f_namespace]);
#$debug and print "To namespace:\n", Data::Dumper->Dump([$t_namespace]);
-my($f_prefix,$t_prefix);
-$f_prefix = get_prefix($from, $prefix1, "--prefix1");
-$t_prefix = get_prefix($to, $prefix2, "--prefix2");
sub get_prefix {
my($imap, $prefix_in, $prefix_opt) = @_;
@@ -691,7 +697,7 @@
my $tot = 0;
my $tmess = 0;
my @folders = @{$folders_r};
- print "++++ Calculating sizes ++++\n";
+ print "++++ Calculating sizes ++++\n" if $verbose;
foreach my $folder (@folders) {
my $stot = 0;
my $smess = 0;
@@ -881,7 +887,8 @@
my $f_heads = $from->parse_headers($from->Range([@f_msgs]),@useheader)
if (@f_msgs) ;
$debug and print "Time headers: ", timenext(), " s\n";
- my $f_size = $from->fetch_hash("RFC822.SIZE") if (@f_msgs);
+ my $f_size = $from->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE")
+ if (@f_msgs);
$debug and print "Time sizes : ", timenext(), " s\n";
#my $f_flags = $from->flags(@f_msgs) ;
#print "Time flags : ", timenext(), " s\n";
@@ -909,7 +916,7 @@
$debug and print "Time headers: ", timenext(), " s\n";
#exit;
- print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n";
+ print "++++ Synchronizing [$f_fold] -> [$t_fold] ++++\n";
# messages in "from" that are not good in "to"
my @f_hash_keys_sorted_by_uid
@@ -928,9 +935,11 @@
}
$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";
+ print "+ NO msg #$f_msg [$m_id] in $t_fold\n"
+ if $verbose;
# copy
- print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
+ print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n"
+ if $verbose;
my $string = $from->message_string($f_msg);
foreach my $regexmess (@regexmess) {
$debug and print "eval \$string =~ $regexmess\n";
@@ -939,33 +948,18 @@
$debug and print "F message content begin next line\n",
$string,
"F message content ended on previous line\n";
- my $d = "";
- if ($syncinternaldates) {
- $d = $from->internaldate($f_msg);
- $d = "\"$d\"";
- $debug and print "internal date from 1: [$d]\n";
- }
-
- my $flags_f_rv = $from->flags($f_msg);
- my @flags_f;
- my $flags_f;
-
- if (ref($flags_f_rv)) {
- @flags_f = @{$flags_f_rv};
- $flags_f = join(" ", @flags_f);
- }else{
- $flags_f = "";
- }
-
- #$flags_f = join(" ", @{$from->flags($f_msg)});
+ my $flags_f = $f_hash{$m_id}{'F'} || "";
# 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";
+ my $indate = $f_hash{$m_id}{'D'};
+ print "flags from : [$flags_f][$indate]\n" if $verbose;
unless ($dry) {
- unless($new_id = $to->append_string($t_fold,$string, $flags_f, $d)){
+ $new_id = $to->append_string($t_fold, $string,
+ $flags_f, $indate);
+ unless($new_id){
warn "Couldn't append msg #$f_msg (Subject:[".$from->subject($f_msg)."]) to folder $t_fold: ",
$to->LastError, "\n";
$error++;
@@ -976,7 +970,7 @@
# 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";
+ print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n" if $verbose;
$mess_size_total_trans += $f_size;
$mess_trans += 1;
}
@@ -1116,17 +1110,19 @@
my $opt_ret = GetOptions(
"debug!" => \$debug,
"debugimap!" => \$debugimap,
+ "verbose!" => \$verbose,
"host1=s" => \$host1,
"host2=s" => \$host2,
"port1=i" => \$port1,
"port2=i" => \$port2,
"user1=s" => \$user1,
"user2=s" => \$user2,
+ "authusing=s" => \$authusing,
+ "authmech=s" => \$authmech,
"password1=s" => \$password1,
"password2=s" => \$password2,
"passfile1=s" => \$passfile1,
"passfile2=s" => \$passfile2,
- "authmd5!" => \$authmd5,
"sep1=s" => \$sep1,
"sep2=s" => \$sep2,
"folder=s" => \@folder,
@@ -1137,7 +1133,6 @@
"regextrans2=s" => \@regextrans2,
"regexmess=s" => \@regexmess,
"delete!" => \$delete,
- "syncinternaldates!" => \$syncinternaldates,
"syncacls!" => \$syncacls,
"maxsize=i" => \$maxsize,
"maxage=i" => \$maxage,
@@ -1160,8 +1155,7 @@
"skipheader=s" => \$skipheader,
"useheader=s" => \@useheader,
"skipsize!" => \$skipsize,
- "fastio1!" => \$fastio1,
- "fastio2!" => \$fastio2,
+ "ssl!" => \$usessl
);
$debug and print "get options: [$opt_ret]\n";
@@ -1221,6 +1215,8 @@
}
$s_hash->{"$key"}{'5'} = $m_md5;
$s_hash->{"$key"}{'s'} = $size;
+ $s_hash->{"$key"}{'D'} = $s_size->{$m_uid}->{"INTERNALDATE"};
+ $s_hash->{"$key"}{'F'} = $s_size->{$m_uid}->{"FLAGS"};
$s_hash->{"$key"}{'m'} = $m_uid;
}
@@ -1253,10 +1249,10 @@
--host2 <string> : "destination" imap server. Mandatory.
--port2 <int> : port to connect. Default is 143.
--user2 <string> : user to login. Mandatory.
+--authusing <string> : user to auth with (when running on behalf of another)
+--authmech <string> : auth mechanism to use (e.g. PLAIN, LOGIN, CRAM-MD5...)
--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.
---authmd5 : use MD5 authentification.
--folder <string> : sync only this folder.
--folder <string> : and this one.
--folder <string> : and this one, etc.
@@ -1300,7 +1296,6 @@
it will change in future releases.
--expunge1 : expunge messages on source account.
--expunge2 : expunge messages on target account.
---syncinternaldates : sets the internal dates on host2 same as host1
--buffersize <int> : sets the size of a block of I/O.
--maxsize <int> : skip messages larger than <int> bytes
--maxage <int> : skip messages older than <int> days.
@@ -1332,14 +1327,14 @@
--nosyncacls : Does not synchronize acls. This is the default.
--debug : debug mode.
--debugimap : imap debug mode.
---version : print sotfware version.
+--verbose : print information about each message transferred
+--version : print software version.
--justconnect : just connect to both servers and print useful
information. Need only --host1 and --host2 options.
--justfolders : just do things about folders (ignore messages).
--fast : be faster (does not sync flags).
---nofastio1 : don't use fastio with the "from" server.
---nofastio2 : don't use fastio with the "destination" server.
--timeout <int> : imap connect timeout.
+--ssl : use SSL connections.
--help : print this.
Example: to synchronise imap account "foo" on "imap.truc.org"

View file

@ -0,0 +1,191 @@
--- imapsync-orig 2007-03-06 13:12:23.000000000 +0000
+++ imapsync 2008-01-19 21:20:58.000000000 +0000
@@ -48,10 +48,11 @@
imapsync [--host1 server1] [--port1 <num>]
[--user1 <string>] [--passfile1 <string>]
[--host2 server2] [--port2 <num>]
[--user2 <string>] [--passfile2 <string>]
[--ssl1] [--ssl2]
+ [--tls1] [--tls2]
[--authmech1 <string>] [--authmech2 <string>]
[--noauthmd5]
[--folder <string> --folder <string> ...]
[--folderrec <string> --folderrec <string> ...]
[--include <regex>] [--exclude <regex>]
@@ -157,11 +158,12 @@
the best solution.
imasync is not totally protected against sniffers on the
network since passwords may be transferred in plain text in
case CRAM-MD5 is not supported by your imap servers. Use
---ssl1 and --ssl2 to enable encryption on host1 and host2.
+--ssl1 (or --tls1) and --ssl2 (or --tls2) to enable encryption on
+host1 and host2.
You may authenticate as one user (typically an admin user),
but be authorized as someone else, which means you don't
need to know every user's personal password. Specify
--authuser1 "adminuser" to enable this on host1. In this
@@ -420,10 +422,11 @@
$mess_trans, $mess_skipped, $mess_skipped_dry,
$timeout, # whr (ESS/PRW)
$timestart, $timeend, $timediff,
$timesize, $timebefore,
$ssl1, $ssl2,
+ $tls1, $tls2,
$authuser1, $authuser2,
$authmech1, $authmech2,
$split1, $split2,
);
@@ -493,15 +496,15 @@
$split1 ||= 1000;
$split2 ||= 1000;
$host1 || missing_option("--host1") ;
# $port1 = (defined($port1)) ? $port1 : 143;
-$port1 ||= defined $ssl1 ? 993 : 143;
+$port1 ||= (defined $ssl1 && !defined $tls1) ? 993 : 143;
$host2 || missing_option("--host2") ;
# $port2 = (defined($port2)) ? $port2 : 143;
-$port2 ||= defined $ssl2 ? 993 : 143;
+$port2 ||= (defined $ssl2 && !defined $tls2) ? 993 : 143;
sub connect_imap {
my($host, $port, $debugimap) = @_;
my $imap = Mail::IMAPClient->new();
$imap->Server($host);
@@ -593,30 +596,74 @@
$timestart = time();
$timebefore = $timestart;
$debugimap and print "From connection\n";
$from = login_imap($host1, $port1, $user1, $password1,
- $debugimap, $timeout, $fastio1, $ssl1,
+ $debugimap, $timeout, $fastio1, $ssl1, $tls1,
$authmech1, $authuser1);
$debugimap and print "To connection\n";
$to = login_imap($host2, $port2, $user2, $password2,
- $debugimap, $timeout, $fastio2, $ssl2,
+ $debugimap, $timeout, $fastio2, $ssl2, $tls2,
$authmech2, $authuser2);
# history
$debug and print "From Buffer I/O : ", $from->Buffer(), "\n";
$debug and print "To Buffer I/O : ", $to->Buffer(), "\n";
+sub starttls {
+ my $socket = shift;
+ my $banner = $socket->getline();
+ unless ($banner =~ /^\* OK \[CAPABILITY.*STARTTLS.*\]/) {
+ die "No STARTTLS capability: $banner";
+ }
+ print $socket "STARTTLS\015\012";
+ my $txt = $socket->getline();
+ unless($txt =~ /^STARTTLS OK/){
+ die "Invalid response for STARTTLS: $txt\n";
+ }
+ unless(IO::Socket::SSL->start_SSL($socket,
+ {SSL_startHandshake => 1, SSL_version => "TLSv1",
+ SSL_verify_depth => 1,
+ # this would add verification of the certificate: SSL_verify_mode => Net::SSLeay::VERIFY_PEER(),
+ })){
+ die "Couldn't start TLS: ".IO::Socket::SSL::errstr()."\n";
+ }
+ if (ref($socket) ne "IO::Socket::SSL") {
+ die "Socket has not been converted to SSL";
+ }
+ $banner;
+}
+
sub login_imap {
my($host, $port, $user, $password,
$debugimap, $timeout, $fastio,
- $ssl, $authmech, $authuser) = @_;
+ $ssl, $tls, $authmech, $authuser) = @_;
my ($imap);
- if ($ssl) {
+ if ($tls) {
+ require IO::Socket::SSL;
+ require Net::SSLeay;
+
+ my $socssl = new IO::Socket::INET("$host:$port");
+ die "Error connecting to $host:$port: $@\n" unless $socssl;
+ $socssl->autoflush(1);
+
+ my $banner = starttls($socssl);
+
+ $imap = Mail::IMAPClient->new(
+ Socket => $socssl,
+ Server => $host,
+ );
+
+ # put the banner into the IMAPClient's history
+ my $count = $imap->Count($imap->Count+1);
+
+ $imap->_record($count,[ $imap->_next_index($count), "OUTPUT", "$banner"] );
+
+ } elsif ($ssl) {
require IO::Socket::SSL;
my $socssl = new IO::Socket::SSL("$host:$port");
die "Error connecting to $host:$port: $@\n" unless $socssl;
$socssl->autoflush(1);
@@ -635,11 +682,11 @@
$imap->Uid(1);
$imap->Peek(1);
$imap->Debug($debugimap);
$timeout and $imap->Timeout($timeout);
- if ($ssl) {
+ if ($ssl || $tls) {
$imap->State(Mail::IMAPClient::Connected);
} else {
$imap->connect()
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
}
@@ -652,12 +699,12 @@
$imap->Server, $authmech);
} else {
printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
$imap->Server, $authmech);
if ($authmech eq 'PLAIN') {
- print "Frequently PLAIN is only supported with SSL, ",
- "try --ssl1 or --ssl2 option\n";
+ print "Frequently PLAIN is only supported with SSL or TLS, ",
+ "try --ssl1/--tls1 or --ssl2/--tls2 option\n";
}
}
$imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN');
$imap->Authcallback(\&plainauth) if $authmech eq "PLAIN";
@@ -1391,10 +1438,12 @@
"skipsize!" => \$skipsize,
"fastio1!" => \$fastio1,
"fastio2!" => \$fastio2,
"ssl1!" => \$ssl1,
"ssl2!" => \$ssl2,
+ "tls1!" => \$tls1,
+ "tls2!" => \$tls2,
"authmech1=s" => \$authmech1,
"authmech2=s" => \$authmech2,
"authuser1=s" => \$authuser1,
"authuser2=s" => \$authuser2,
"split1=i" => \$split1,
@@ -1525,10 +1574,12 @@
--authmech1 <string> : auth mechanism to use with host1:
PLAIN, LOGIN, CRAM-MD5 etc.
--authmech2 <string> : auth mechanism to use with host2. See --authmech1
--ssl1 : use an SSL connection on host1.
--ssl2 : use an SSL connection on host2.
+--tls1 : use an TLS connection on host1.
+--tls2 : use an TLS connection on host2.
--folder <string> : sync this folder.
--folder <string> : and this one, etc.
--folderrec <string> : sync this folder recursively.
--folderrec <string> : and this one, etc.
--include <regex> : sync folders matching this regular expression

View file

@ -0,0 +1,349 @@
--- imapsync.ORIG 2009-03-30 12:34:43.562500000 -0400
+++ imapsync 2009-03-30 12:32:59.890625000 -0400
@@ -70,7 +73,7 @@
[--minage <int>]
[--skipheader <regex>]
[--useheader <string>] [--useheader <string>]
- [--skipsize]
+ [--skipsize] [--allowsizemismatch]
[--delete] [--delete2]
[--expunge] [--expunge1] [--expunge2]
[--subscribed] [--subscribe]
@@ -454,7 +457,7 @@
$fastio1, $fastio2,
$maxsize, $maxage, $minage,
$skipheader, @useheader,
- $skipsize, $foldersizes, $buffersize,
+ $skipsize, $allowsizemismatch, $foldersizes, $buffersize,
$delete, $delete2,
$expunge, $expunge1, $expunge2, $dry,
$justfoldersizes,
@@ -795,20 +798,16 @@
$imap->Authuser($authuser);
$imap->Password($password);
unless ($imap->login()) {
- print "Error login: [$host] with user [$user] auth [$authmech]: $@\n";
my $info = "Error login: [$host] with user [$user] auth";
my $einfo = $imap->LastError || @{$imap->History}[-1];
chomp($einfo);
my $error = "$info [$authmech]: $einfo\n";
print $error; # note: duplicating error on stdout/stderr
- die $error if ($authmech eq 'LOGIN' or $imap->IsUnconnected() or
-$authuser);
- die if ($authmech eq 'LOGIN');
- die if $imap->IsUnconnected();
+ die $error if ($authmech eq 'LOGIN' or $imap->IsUnconnected() or $authuser);
print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
$imap->Authmechanism("");
$imap->login() or
- die "Error login: [$host] with user [$user] auth [LOGIN]: $@";
+ die "$info [LOGIN]: ", $imap->LastError, "\n";
}
print "Success login on [$host] with user [$user] auth [$authmech]\n";
return($imap);
@@ -1294,8 +1293,8 @@
$t_fold = to_folder_name($f_fold);
print "To Folder [$t_fold]\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
unless ($from->select($f_fold)) {
warn
@@ -1343,8 +1342,8 @@
next FOLDER if ($justfolders);
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
my @f_msgs = select_msgs($from);
@@ -1361,33 +1360,40 @@
my %t_hash = ();
print "++++ From [$f_fold] Parse 1 ++++\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
my $f_heads = $from->parse_headers([@f_msgs],
@useheader)if (@f_msgs) ;
$debug and print "Time headers: ", timenext(), " s\n";
+ last FOLDER if $from->IsUnconnected();
my $f_fir = $from->fetch_hash("FLAGS",
"INTERNALDATE",
"RFC822.SIZE") if (@f_msgs);
$debug and print "Time fir: ", timenext(), " s\n";
-
+ last FOLDER if $from->IsUnconnected();
+
foreach my $m (@f_msgs) {
- parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash);
+ unless (parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash)) {
+ my $f_size = $f_fir->{$m}->{"RFC822.SIZE"} || 0;
+ print "+ Skipping msg #$m:$f_size in folder $f_fold (no header so we ignore this message)\n";
+ $mess_size_total_skipped += $f_size;
+ $mess_skipped += 1;
+ }
}
$debug and print "Time headers: ", timenext(), " s\n";
print "++++ To [$t_fold] Parse 1 ++++\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
my $t_heads = $to->parse_headers([@t_msgs],
@useheader) if (@t_msgs);
$debug and print "Time headers: ", timenext(), " s\n";
+ last FOLDER if $to->IsUnconnected();
my $t_fir = $to->fetch_hash("FLAGS",
"INTERNALDATE",
"RFC822.SIZE") if (@t_msgs);
$debug and print "Time fir: ", timenext(), " s\n";
+ last FOLDER if $to->IsUnconnected();
foreach my $m (@t_msgs) {
parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
}
@@ -1411,7 +1417,10 @@
unless (exists($f_hash{$m_id})) {
my $t_msg = $t_hash{$m_id}{'m'};
print "deleting message $m_id $t_msg\n";
- $to->delete_message($t_msg) unless ($dry);
+ unless ($dry) {
+ $to->delete_message($t_msg);
+ last FOLDER if $to->IsUnconnected();
+ }
}
}
}
@@ -1432,10 +1441,18 @@
print "+ NO msg #$f_msg [$m_id] in $t_fold\n";
# copy
print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
my $string;
$string = $from->message_string($f_msg);
+ unless (defined($string)) {
+ warn
+ "Could not fetch message #$f_msg from $f_fold ",
+ $from->LastError, "\n";
+ $error++;
+ $mess_size_total_error += $f_size;
+ next MESS;
+ }
#print "AAAmessage_string[$string]ZZZ\n";
#my $message_file = "tmp_imapsync_$$";
#$from->select($f_fold);
@@ -1514,8 +1531,8 @@
my $new_id;
print "flags from: [$flags_f][$d]\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
unless ($dry) {
if ($OSNAME eq "MSWin32") {
@@ -1528,6 +1545,7 @@
$new_id = $to->append_string($t_fold,$string, $flags_f, $d);
}
unless($new_id){
+ no warnings 'uninitialized';
warn "Couldn't append msg #$f_msg (Subject:[".
$from->subject($f_msg)."]) to folder $t_fold: ",
$to->LastError, "\n";
@@ -1544,8 +1562,12 @@
$mess_trans += 1;
if($delete) {
print "Deleting msg #$f_msg in folder $f_fold\n";
- $from->delete_message($f_msg) unless ($dry);
- $from->expunge() if ($expunge and not $dry);
+ unless($dry) {
+ $from->delete_message($f_msg);
+ last FOLDER if $from->IsUnconnected();
+ $from->expunge() if ($expunge);
+ last FOLDER if $from->IsUnconnected();
+ }
}
}
}
@@ -1568,8 +1590,8 @@
$debug and print "Setting flags\n";
- last FOLDER if (lost_connection($from,"(from) host1 [$host1]"));
- last FOLDER if (lost_connection($to,"(to) host2 [$host2]"));
+ last FOLDER if $from->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
my (@flags_f,@flags_t);
@@ -1585,8 +1607,11 @@
$to->store($t_msg,
"+FLAGS.SILENT (" . $flags_f . ")"
) unless ($dry);
+ last FOLDER if $to->IsUnconnected();
my $flags_t_rv = $to->flags($t_msg);
+ last FOLDER if $to->IsUnconnected();
+
@flags_t = @{$flags_t_rv} if ref($flags_t_rv);
my $flags_t = join(" ", @flags_t);
$debug and print
@@ -1618,6 +1643,7 @@
if ($opt_G){
print "Deleting msg f:#$t_msg in folder $t_fold\n";
$to->delete_message($t_msg) unless ($dry);
+ last FOLDER if $to->IsUnconnected();
}
}
else {
@@ -1626,8 +1652,12 @@
"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) unless ($dry);
- $from->expunge() if ($expunge and not $dry);
+ unless($dry) {
+ $from->delete_message($f_msg);
+ last FOLDER if $from->IsUnconnected();
+ $from->expunge() if ($expunge);
+ last FOLDER if $from->IsUnconnected();
+ }
}
}
}
@@ -1656,15 +1686,25 @@
my($imap, $error_message) = @_;
if ( $imap->IsUnconnected() ) {
$error++;
- warn("error: lost connection $error_message\n");
+ my $einfo = $imap->LastError || @{$imap->History}[-1] || "";
+ my $sz = 64;
+ # if einfo is long try reduce to a more reasonable size
+ if ( ! $debug and length($einfo) > $sz*2 ) {
+ my $beg = substr($einfo, 0, $sz);
+ my $end = substr($einfo, -$sz, $sz);
+ $einfo = $beg . "..." . $end;
+ }
+ chomp($einfo);
+ $einfo = ": $einfo" if $einfo;
+ warn("error: lost connection $error_message $einfo\n");
return(1);
}else{
return(0);
}
}
-$from->logout() unless $from->isUnconnected();
-$to->logout() unless $to->isUnconnected();
+$from->logout() unless (lost_connection($from,"(from) host1 [$host1]"));
+$to->logout() unless (lost_connection($to,"(to) host2 [$host2]"));
$timeend = time();
@@ -1789,6 +1829,7 @@
"skipheader=s" => \$skipheader,
"useheader=s" => \@useheader,
"skipsize!" => \$skipsize,
+ "allowsizemismatch!" => \$allowsizemismatch,
"fastio1!" => \$fastio1,
"fastio2!" => \$fastio2,
"ssl1!" => \$ssl1,
@@ -2037,6 +2078,9 @@
Ex: Message-ID or Subject or Date.
--useheader <string> and this one, etc.
--skipsize : Don't take message size into account.
+--allowsizemismatch : allow RFC822.SIZE != fetched msg size
+ consider --skipsize to avoid duplicate messages
+ when running syncs more than one time per mailbox
--dry : do nothing, just print what would be done.
--subscribed : transfers subscribed folders.
--subscribe : subscribe to the folders transferred on the
@@ -2648,20 +2692,8 @@
return $self->{SSL};
};
-{
-no warnings 'once';
-*Mail::IMAPClient::Authuser = sub {
- my $self = shift;
-
- if (@_) { $self->{AUTHUSER} = shift }
- return $self->{AUTHUSER};
-};
-}
-
-# End of sub override_imapclient (yes, very bad indentation)
}
-# *Mail::IMAPClient::connect = sub {
sub myconnect {
my $self = shift;
@@ -2691,20 +2723,22 @@
$self->Socket($sock);
if ( $Mail::IMAPClient::VERSION =~ /^2/ ) {
return undef unless myconnect_v2($self);
- }
- if ($self->User and $self->Password) {
- return $self->login ;
- }
- else {
- return $self;
- }
+ }
+ else {
+ $self->Ignoresizeerrors($allowsizemismatch);
+ }
+ if ($self->User and $self->Password) {
+ return $self->login ;
+ }
+ else {
+ return $self;
+ }
}
sub myconnect_v2 {
- my $self = shift;
+ my $self = shift;
$self->State(Connected);
- # $sock->autoflush(1);
$self->Socket->autoflush(1);
my ($code, $output);
$output = "";
@@ -2719,9 +2753,23 @@
}
}
+
+ if ($code =~ /BYE|NO /) {
+ $self->State(Unconnected);
+ return undef ;
+ }
return $self;
}
+# HACK: Mail::IMAPClient 2.2.9 does not have Authuser, but 3.x does
+# - avoid warning: "Mail::IMAPClient::Authuser" used only once w/2.x too
+$Mail::IMAPClient::Authuser = $Mail::IMAPClient::Authuser = sub {
+ my $self = shift;
+
+ if (@_) { $self->{AUTHUSER} = shift }
+ return $self->{AUTHUSER};
+} if ( $Mail::IMAPClient::VERSION =~ /^2/ );
+
package Mail::IMAPClient;

View file

@ -0,0 +1,45 @@
--- imapsync-1.337 2010-08-02 13:56:06.000000000 +0200
+++ imapsync-1.337_tobit-workaround 2010-08-02 13:53:58.000000000 +0200
@@ -3821,6 +3821,7 @@
$banner;
}
+
# IMAPClient 2.2.9 3.xx ads
package Mail::IMAPClient;
@@ -3869,3 +3870,33 @@
#$self->Fast_io( $self->Fast_io );
$sock;
}
+
+sub search {
+ my ( $self, @args ) = @_;
+
+ @args = $self->_quote_search(@args);
+
+ $self->_imap_uid_command( SEARCH => @args )
+ or return undef;
+
+ my @hits;
+ foreach ( $self->History ) {
+ chomp;
+ s/$CR?$LF$//o;
+ s/^(\s*\d+)/* SEARCH $1/;
+ s/^\*\s+SEARCH\s+(?=.*?\d)// or next;
+ push @hits, grep /^\d+$/, split;
+ }
+
+ @hits
+ or $self->_debug("Search successful but found no matching messages");
+
+ # return empty list
+ return
+ wantarray ? @hits
+ : !@hits ? \@hits
+ : $self->Ranges ? $self->Range( \@hits )
+ : \@hits;
+}
+
+

View file

@ -0,0 +1,77 @@
--- imapsync Mon Jun 14 20:43:03 2004
+++ imapsync-mod Sun Jun 27 22:57:55 2004
@@ -49,6 +49,7 @@
[--skipsize]
[--delete] [--expunge]
[--subscribed] [--subscribe]
+ [--foldersizes]
[--dry]
[--debug] [--debugimap]
[--timeout <int>]
@@ -294,7 +295,7 @@
$sep1, $sep2,
$syncinternaldates,
$maxsize, $maxage,
- $skipheader, $skipsize,
+ $skipheader, $skipsize, $foldersizes,
$delete, $expunge, $dry,
$authmd5,
$subscribed, $subscribe,
@@ -535,6 +536,39 @@
print "From separator : [$f_sep]\n";
print "To separator : [$t_sep]\n";
+if ($foldersizes)
+{
+ my $tot = 0;
+ my $tmess = 0;
+ print "Calculating sizes...\n";
+ foreach my $f_fold (@f_folders)
+ {
+ print "From Folder [$f_fold]\n";
+ my $stot = 0;
+ my $smess = 0;
+ unless ($from->select($f_fold)) {
+ warn
+ "From Folder $f_fold : Could not select ",
+ $from->LastError, "\n";
+ $error++;
+ next;
+ }
+ my $szs = $from->fetch_hash("RFC822.SIZE") || (warn("Can't get sizes for $f_fold: ",$from->LastError),$error++,next);
+ my ($k,$v);
+ while (($k,$v) = each(%$szs))
+ {
+ $stot += $v->{'RFC822.SIZE'};
+ $smess++;
+ }
+ print "Size of $f_fold: $stot\n";
+ print "Messages in $f_fold: $smess\n";
+ $tot += $stot;
+ $tmess += $smess;
+ }
+ print "Total size: $tot\n";
+ print "Total messages: $tmess\n";
+}
+
exit if ($justconnect);
# needed for setting flags
@@ -789,6 +823,7 @@
"syncinternaldates!" => \$syncinternaldates,
"maxsize=i" => \$maxsize,
"maxage=i" => \$maxage,
+ "foldersizes" => \$foldersizes,
"dry!" => \$dry,
"expunge!" => \$expunge,
"subscribed!" => \$subscribed,
@@ -918,6 +953,9 @@
--subscribe : subscribe to the folders transfered on the
"destination" server that are subscribed
on the "source" server.
+--foldersizes : Discover the size of each "From" folder in bytes
+ and message counts. Meant to be used with
+ --justconnect.
--debug : debug mode.
--debugimap : imap debug mode.
--version : print sotfware version.

View file

@ -0,0 +1,57 @@
Hi Gilles,
I have used your imapsync program many times over the past few months
and it has been a great help in our mail server migration, so first of
all: Thank you! :-)
However, with the latest task, I ran into a problem: I'm migrating mail
from a Kolab 2.0.4 server to a Kolab 2.1beta2 server (both use Cyrus as
imapd). The problem is: We're also changing domains at the same time,
i.e. any user "NAME@OLD.DOMAIN" on the old server becomes
"NAME@NEW.DOMAIN" on the new server. When transferring mail, this
doesn't have any bad influence, but it does lead to problems when trying
to sync ACLs as well. Right now, imapsync will take the ACLs, compare
the folder on the old and the new server and will then happily set the
ACL for "NAME@NEW.DOMAIN" on the new server to "none" (because it
doesn't exist on the old server) and then try to set the ACLs for
"NAME@OLD.DOMAIN" on the new server - which a) fails (it just removed
the access for NAME@NEW.DOMAIN - hence, the user cannot access his own
mailbox anymore) and b) is not desirable anyway (only "NAME@NEW.DOMAIN"
should have permissions).
So, basically, what I need is an option to tell imapsync that the domain
is changing and have it replace the domain in all user names that are
related to ACLs. Right now, I've solved this by crudely patching the
"acls_sync" subroutine:
sub acls_sync {
my($f_fold, $t_fold) = @_;
[...]
foreach my $user (sort(keys(%users))) {
my $acl = $f_hash->{$user} || "none";
if ($user eq $user2)
{
# the user we use to log in as on the target
# server gets "all" permissions always
$acl = "lrswipcda";
}
my $new_user = $user;
$new_user =~ s/OLD.DOMAIN/NEW.DOMAIN/g;
print "acl $user -> $new_user : [$acl]\n";
next if ($f_hash->{$user} && $t_hash->{$new_user} &&
$f_hash->{$user} eq $t_hash->{$new_user});
unless ($dry) {
print "setting acl $t_fold $new_user $acl\n";
$to->setacl($t_fold, $new_user, $acl)
or warn "Could not set acl: $@\n";
}
}
[...]
but this is really just a hack to suit my current needs. Maybe you could
consider adding something more refined than this hack in a future release? :-)
Best regards,
Thomas

View file

@ -0,0 +1,12 @@
diff -u -r imapsync-1.182/imapsync imapsync-1.182-base64-fix/imapsync
--- imapsync-1.182/imapsync 2006-08-01 16:07:42.000000000 -0700
+++ imapsync-1.182-base64-fix/imapsync 2006-09-27 16:09:59.000000000 -0700
@@ -635,7 +635,7 @@
my $string = sprintf("%s\x00%s\x00%s", $imap->User,
$imap->Authuser, $imap->Password);
- return encode_base64("$string");
+ return encode_base64("$string", "");
}

View file

@ -0,0 +1,35 @@
--- imapsync.orig Mon May 9 12:03:59 2005
+++ imapsync Mon May 9 12:07:05 2005
@@ -44,6 +44,7 @@
[--sep1 <char>]
[--sep2 <char>]
[--syncinternaldates]
+ [--buffersize <int>]
[--maxsize <int>]
[--maxage <int>]
[--skipheader <regex>]
@@ -312,6 +313,7 @@
$sep1, $sep2,
$syncinternaldates, $syncacls,
$maxsize, $maxage,
+ $buffersize,
$skipheader, $skipsize, $foldersizes,
$delete, $expunge, $dry,
$authmd5,
@@ -450,7 +452,7 @@
$imap->Server($host);
$imap->Port($port);
$imap->Fast_io(1);
- $imap->Buffer(65536);
+ $imap->Buffer($buffersize || 65536);
$imap->Uid(1);
$imap->Peek(1);
$imap->Debug($debugimap);
@@ -979,6 +981,7 @@
"syncacls!" => \$syncacls,
"maxsize=i" => \$maxsize,
"maxage=i" => \$maxage,
+ "buffersize=i" => \$buffersize,
"foldersizes!" => \$foldersizes,
"dry!" => \$dry,
"expunge!" => \$expunge,

View file

@ -0,0 +1,58 @@
--- imapsync.orig Fri Apr 22 03:12:18 2005
+++ imapsync Mon May 2 11:16:51 2005
@@ -580,7 +580,7 @@
foreach my $f_fold (@f_folders) {
my $stot = 0;
my $smess = 0;
- printf("From Folder %-25s", "[$f_fold]");
+ printf("From Folder %-35s", "[$f_fold]");
unless ($from->select($f_fold)) {
warn
"From Folder $f_fold : Could not select ",
@@ -694,6 +694,25 @@
}
}
+ if ($syncacls) {
+ my $f_hash = $from->getacl($f_fold)
+ or warn "Could not getacl for $f_fold: $@\n";
+ my $t_hash = $to->getacl($t_fold)
+ or warn "Could not getacl for $t_fold: $@\n";
+ my %users = map({ ($_, 1) } (keys(%$f_hash), keys(%$t_hash)));
+ foreach my $user (sort(keys(%users))) {
+ my $acl = $f_hash->{$user} || "none";
+ print "acl $user : [$acl]\n";
+ next if ($f_hash->{$user} && $t_hash->{$user} &&
+ $f_hash->{$user} eq $t_hash->{$user});
+ unless ($dry) {
+ print "setting acl $t_fold $user $acl\n";
+ $to->setacl($t_fold, $user, $acl)
+ or warn "Could not set acl: $@\n";
+ }
+ }
+ }
+
unless ($to->select($t_fold)) {
warn
"To Folder $t_fold : Could not select ",
@@ -711,20 +730,6 @@
if ($subscribe and exists $fs_folders{$f_fold}) {
print "Subscribing to folder $t_fold on destination server\n";
unless($dry) { $to->subscribe($t_fold) };
- }
-
- if ($syncacls) {
- my $hash = $from->getacl($f_fold)
- or warn "Could not getacl for $f_fold: $@\n";
- foreach my $user (keys(%$hash)) {
- my $acl = $hash->{$user};
- print "acl $user : " . $acl . "\n";
- unless ($dry) {
- print "setting acl $t_fold $user $acl\n";
- $to->setacl($t_fold, $user, $acl)
- or warn "Could not set acl: $@\n";
- }
- }
}
next FOLDER if ($justfolders);

1175
W/patches/imapsync-readkey Normal file

File diff suppressed because it is too large Load diff

131
W/patches/imapsync-ssl.diff Normal file
View file

@ -0,0 +1,131 @@
--- imapsync Fri Jul 9 11:08:43 2004
+++ imapsync-ssl Tue Aug 31 12:13:06 2004
@@ -33,9 +33,9 @@ $Revision: 1.96 $
imapsync --help
imapsync
- imapsync [--host1 server1] [--port1 <num>]
+ imapsync [--host1 server1] [--port1 <num>] [--ssl1]
[--user1 <string>] [--passfile1 <string>]
- [--host2 server2] [--port2 <num>]
+ [--host2 server2] [--port2 <num>] [--ssl2]
[--user2 <string>] [--passfile2 <string>]
[--folder <string> --folder <string> ...]
[--include <regex>] [--exclude <regex>]
@@ -283,13 +283,15 @@ use Getopt::Long;
use Mail::IMAPClient;
use Digest::MD5 qw(md5_base64);
#use Digest::HMAC_MD5;
+use IO::Socket::INET;
+use IO::Socket::SSL;
eval { require 'usr/include/sysexits.ph' };
my(
$rcs, $debug, $debugimap, $error,
- $host1, $host2, $port1, $port2,
+ $host1, $host2, $port1, $port2, $ssl1, $ssl2,
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, $include, $exclude, $prefix2, $regextrans2,
$sep1, $sep2,
@@ -372,13 +374,13 @@ sub missing_option {
}
$host1 || missing_option("--host1") ;
-$port1 = (defined($port1)) ? $port1 : 143;
+$port1 = (defined($port1)) ? $port1 : ((defined($ssl1)) ? 993 : 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;
+$port2 = (defined($port2)) ? $port2 : ((defined($ssl2)) ? 993 : 143);
$user2 || missing_option("--user2");
$password2 || $passfile2 || missing_option("--passfile2 or --password2");
$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2;
@@ -402,38 +404,56 @@ unless ($md5_supported) {
$timestart = time();
$debugimap and print "From connection\n";
-$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout);
+$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout, undef, $ssl1);
$debugimap and print "To connection\n";
-$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout);
+$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout, undef, $ssl2);
sub login_imap {
my($host, $port, $user, $password,
- $debugimap, $timeout, $authmech) = @_;
- my $imap = Mail::IMAPClient->new();
- $imap->Server($host);
- $imap->Port($port);
+ $debugimap, $timeout, $authmech, $ssl) = @_;
+ my $socket = undef;
+
+ if (!defined($ssl)) {
+ $socket = IO::Socket::INET->new( PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ } else {
+ $socket = IO::Socket::SSL->new( PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ }
+ if (!$socket) {
+ die "Can not open imap connection on [$host:$port]: $@";
+ }
+
+ my $imap = Mail::IMAPClient->new(Server => $host,
+ Port => $port,
+ Socket => $socket,
+ User => $user,
+ Password=> $password);
+ $imap->State($imap->Connected());
+
$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";
- if ($timeout) # whr (ESS/PRW)
- {
- $imap->Timeout($timeout);
- print "Setting imap timeout to $timeout\n";
- }
-
- $imap->User($user);
- $imap->Password($password);
- md5auth($imap);
+
+ if ($timeout) # whr (ESS/PRW)
+ {
+ $imap->Timeout($timeout);
+ print "Setting imap timeout to $timeout\n";
+ }
+
+ select_auth($imap);
+
$imap->login() or die "Error login : [$host] with user [$user] : $@";
+
return($imap);
}
-sub md5auth() {
+sub select_auth() {
my ($imap) = @_;
unless ($md5_supported) {
return;
@@ -810,6 +830,8 @@ sub get_options
"host2=s" => \$host2,
"port1=i" => \$port1,
"port2=i" => \$port2,
+ "ssl1!" => \$ssl1,
+ "ssl2!" => \$ssl2,
"user1=s" => \$user1,
"user2=s" => \$user2,
"password1=s" => \$password1,

View file

@ -0,0 +1,108 @@
--- /tmp/imapsync-1.118 2005-01-21 09:24:18.915332630 -0800
+++ imapsync 2005-01-21 13:38:57.842421835 -0800
@@ -34,9 +34,9 @@
imapsync --help
imapsync
- imapsync [--host1 server1] [--port1 <num>]
+ imapsync [--host1 server1] [--port1 <num>] [--ssl1]
[--user1 <string>] [--passfile1 <string>]
- [--host2 server2] [--port2 <num>]
+ [--host2 server2] [--port2 <num>] [--ssl2]
[--user2 <string>] [--passfile2 <string>]
[--folder <string> --folder <string> ...]
[--include <regex>] [--exclude <regex>]
@@ -292,13 +292,15 @@
use Mail::IMAPClient;
use Digest::MD5 qw(md5_base64);
#use Digest::HMAC_MD5;
+use IO::Socket::INET;
+use IO::Socket::SSL;
eval { require 'usr/include/sysexits.ph' };
my(
$rcs, $debug, $debugimap, $error,
- $host1, $host2, $port1, $port2,
+ $host1, $host2, $port1, $port2, $ssl1, $ssl2,
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, $include, $exclude, $prefix2, $regextrans2, @regexmess,
$sep1, $sep2,
@@ -383,13 +385,13 @@
}
$host1 || missing_option("--host1") ;
-$port1 = (defined($port1)) ? $port1 : 143;
+$port1 = (defined($port1)) ? $port1 : ((defined($ssl1)) ? 993 : 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;
+$port2 = (defined($port2)) ? $port2 : ((defined($ssl2)) ? 993 : 143);
$user2 || missing_option("--user2");
$password2 || $passfile2 || missing_option("--passfile2 or --password2");
$password2 = (defined($passfile2)) ? firstline ($passfile2) : $password2;
@@ -417,17 +419,35 @@
$timebefore = $timestart;
$debugimap and print "From connection\n";
-$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout);
+$from = login_imap($host1, $port1, $user1, $password1, $debugimap, $timeout, $ssl1);
$debugimap and print "To connection\n";
-$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout);
+$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout, $ssl2);
sub login_imap {
my($host, $port, $user, $password,
- $debugimap, $timeout, $authmech) = @_;
- my $imap = Mail::IMAPClient->new();
- $imap->Server($host);
- $imap->Port($port);
+ $debugimap, $timeout, $authmech, $ssl) = @_;
+ my $socket = undef;
+
+ if (!defined($ssl)) {
+ $socket = IO::Socket::INET->new( PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ } else {
+ $socket = IO::Socket::SSL->new( PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'tcp');
+ }
+ if (!$socket) {
+ die "Can not open imap connection on [$host:$port]: $@";
+ }
+
+ my $imap = Mail::IMAPClient->new(Server => $host,
+ Port => $port,
+ Socket => $socket,
+ User => $user,
+ Password=> $password);
+ $imap->State($imap->Connected());
$imap->Fast_io(1);
$imap->Buffer(65536);
$imap->Uid(1);
@@ -440,9 +460,6 @@
$imap->Timeout($timeout);
print "Setting imap timeout to $timeout\n";
}
-
- $imap->User($user);
- $imap->Password($password);
md5auth($imap);
$imap->login() or die "Error login : [$host] with user [$user] : $@";
return($imap);
@@ -918,6 +935,8 @@
"host2=s" => \$host2,
"port1=i" => \$port1,
"port2=i" => \$port2,
+ "ssl1!" => \$ssl1,
+ "ssl2!" => \$ssl2,
"user1=s" => \$user1,
"user2=s" => \$user2,
"password1=s" => \$password1,

View file

@ -0,0 +1,62 @@
--- imapsync Mon Oct 18 21:15:27 2004
+++ imapsync-mod Sat Nov 20 15:15:52 2004
@@ -552,7 +552,7 @@
my $tmess = 0;
print "Calculating sizes...\n";
foreach my $f_fold (@f_folders) {
- print "From Folder [$f_fold]\n";
+ print "\nFrom Folder [$f_fold]\n";
my $stot = 0;
my $smess = 0;
unless ($from->select($f_fold)) {
@@ -574,7 +574,6 @@
$stot += $s;
print ".";
}
- print "\n";
print "Size of $f_fold: $stot\n";
print "Messages in $f_fold: $smess\n";
$tot += $stot;
@@ -589,11 +588,12 @@
map {$stot2 += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref;
}
print "Size of $f_fold: $stot2\n";
+ print "Messages in $f_fold: $smess2\n";
$tot += $stot2;
$tmess += $smess2;
}
}
- print "Total size: $tot\n";
+ print "\n\nTotal size: $tot\n";
print "Total messages: $tmess\n";
print "Time : ", timenext(), " s\n";
@@ -746,7 +746,9 @@
$d = "\"$d\"";
$debug and print "internal date from 1: [$d]\n";
$syncinternaldates or $d = "";
- my $flags_f = join(" ", @{$from->flags($f_msg)});
+ my $flags_f_rv = $from->flags($f_msg);
+ my $flags_f = '';
+ $flags_f = join(" ", @{$flags_f_rv}) if ref($flags_f_rv);
# RFC 2060 : This flag can not be altered by the client
$flags_f =~ s@\\Recent@@g;
@@ -781,13 +783,15 @@
$debug and print "Setting flags\n";
my (@flags_f,@flags_t);
- @flags_f = @{$from->flags($f_msg)};
+ my $flags_f_rv = $from->flags($f_msg);
+ @flags_f = @{$flags_f_rv} if ref($flags_f_rv);
# No flag \Recent here, no ?
$to->store($t_msg,
"+FLAGS (" . join(" ", @flags_f) . ")"
);
- @flags_t = @{$to->flags($t_msg)};
+ my $flags_t_rv = $to->flags($t_msg);
+ @flags_t = @{$flags_t_rv} if ref($flags_t_rv);
$debug and print
"flags from : @flags_f\n",
"flags to : @flags_t\n";

2430
W/patches/imapsync-yahoo Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,462 @@
--- imapsync.ORIG 2009-05-21 02:30:56.828125000 -0400
+++ imapsync 2009-05-21 02:35:55.984375000 -0400
@@ -72,13 +72,14 @@
[--useheader <string>] [--useheader <string>]
[--skipsize] [--allowsizemismatch]
[--delete] [--delete2]
- [--expunge] [--expunge1] [--expunge2]
+ [--expunge] [--expunge1] [--expunge2] [--uidexpunge2]
[--subscribed] [--subscribe]
[--nofoldersizes]
[--dry]
[--debug] [--debugimap]
[--timeout <int>] [--fast]
[--split1] [--split2]
+ [--reconnectretry1 <int>] [--reconnectretry2 <int>]
[--version] [--help]
=cut
@@ -358,6 +359,7 @@
--expunge
--expunge1
--expunge2
+--uidexpunge2
--maxage
--minage
--maxsize
@@ -456,7 +458,7 @@
$skipheader, @useheader,
$skipsize, $allowsizemismatch, $foldersizes, $buffersize,
$delete, $delete2,
- $expunge, $expunge1, $expunge2, $dry,
+ $expunge, $expunge1, $expunge2, $uidexpunge2, $dry,
$justfoldersizes,
$authmd5,
$subscribed, $subscribe,
@@ -474,6 +476,7 @@
$authuser1, $authuser2,
$authmech1, $authmech2,
$split1, $split2,
+ $reconnectretry1, $reconnectretry2,
$tests, $test_builder,
$allow3xx, $justlogin,
);
@@ -735,12 +738,12 @@
$debugimap and print "From connection\n";
$from = login_imap($host1, $port1, $user1, $password1,
$debugimap, $timeout, $fastio1, $ssl1,
- $authmech1, $authuser1);
+ $authmech1, $authuser1, $reconnectretry1);
$debugimap and print "To connection\n";
$to = login_imap($host2, $port2, $user2, $password2,
$debugimap, $timeout, $fastio2, $ssl2,
- $authmech2, $authuser2);
+ $authmech2, $authuser2, $reconnectretry2);
# history
@@ -751,13 +754,13 @@
sub login_imap {
my($host, $port, $user, $password,
$debugimap, $timeout, $fastio,
- $ssl, $authmech, $authuser) = @_;
+ $ssl, $authmech, $authuser, $reconnectretry) = @_;
my ($imap);
$imap = Mail::IMAPClient->new();
$imap->Ssl($ssl) if ($ssl);
- $imap->Clear(20);
+ $imap->Clear(5);
$imap->Server($host);
$imap->Port($port);
$imap->Fast_io($fastio);
@@ -766,7 +769,12 @@
$imap->Peek(1);
$imap->Debug($debugimap);
$timeout and $imap->Timeout($timeout);
-
+
+ ( Mail::IMAPClient->VERSION =~ /^2/ or !$imap->can("Reconnectretry"))
+ ? warn("--reconnectretry* requires IMAPClient >= 3.17\n")
+ : $imap->Reconnectretry($reconnectretry)
+ if ($reconnectretry);
+
#$imap->connect()
myconnect($imap)
or die "Can not open imap connection on [$host] with user [$user]: $@\n";
@@ -831,13 +839,13 @@
-#print "From capability: ", join(" ", $from->capability()), "\n";
-#print "To capability: ", join(" ", $to->capability()), "\n";
+$debug and print "From capability: ", join(" ", $from->capability()), "\n";
+$debug and print "To capability: ", join(" ", $to->capability()), "\n";
die unless $from->IsAuthenticated();
-print "host1 :state Authenticated\n";
+print "host1: state Authenticated\n";
die unless $to->IsAuthenticated();
-print "host2 :state Authenticated\n";
+print "host2: state Authenticated\n";
exit(0) if ($justlogin);
@@ -1100,13 +1108,17 @@
$debug and print "Calling namespace capability\n";
if ($imap->has_capability("namespace")) {
$sep_out = $imap->separator();
- return($sep_out);
+ return($sep_out) if defined $sep_out;
+ warn
+ "NAMESPACE request failed for ",
+ $imap->Server(), ": ", $imap->LastError, "\n";
+ exit(1);
}
else{
- print
+ warn
"No NAMESPACE capability in imap server ",
$imap->Server(),"\n",
- "Give the separator caracter with the $sep_opt option\n";
+ "Give the separator character with the $sep_opt option\n";
exit(1);
}
}
@@ -1133,9 +1145,9 @@
}
unless ($imap->select($folder)) {
warn
- "$side Folder $folder: Could not select ",
+ "$side Folder $folder: Could not select: ",
$imap->LastError, "\n";
- #$error++;
+ $error++;
next;
}
if (defined($maxage) or defined($minage)) {
@@ -1319,9 +1331,9 @@
unless ($from->select($f_fold)) {
warn
- "From Folder $f_fold: Could not select ",
+ "From Folder $f_fold: Could not select: ",
$from->LastError, "\n";
- #$error++;
+ $error++;
next FOLDER;
}
if ( ! exists($t_folders_list{$t_fold})) {
@@ -1329,7 +1341,7 @@
print "Creating folder [$t_fold]\n";
unless ($dry){
unless ($to->create($t_fold)){
- warn "Couldn't create [$t_fold]",
+ warn "Couldn't create [$t_fold]: ",
$to->LastError,"\n";
$error++;
next FOLDER;
@@ -1344,9 +1356,9 @@
unless ($to->select($t_fold)) {
warn
- "To Folder $t_fold: Could not select ",
+ "To Folder $t_fold: Could not select: ",
$to->LastError, "\n";
- #$error++;
+ $error++;
next FOLDER;
}
@@ -1384,17 +1396,22 @@
last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
- my $f_heads = $from->parse_headers([@f_msgs],
- @useheader)if (@f_msgs) ;
+ my ($f_heads, $f_fir) = ({}, {});
+ $f_heads = $from->parse_headers([@f_msgs], @useheader) if (@f_msgs);
$debug and print "Time headers: ", timenext(), " s\n";
last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
- my $f_fir = $from->fetch_hash("FLAGS",
- "INTERNALDATE",
- "RFC822.SIZE") if (@f_msgs);
+
+ $f_fir = $from->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE")
+ if (@f_msgs);
$debug and print "Time fir: ", timenext(), " s\n";
+ unless ($f_fir) {
+ warn
+ "From Folder $f_fold: Could not fetch_hash ",
+ scalar(@f_msgs), " msgs: ", $from->LastError, "\n";
+ $error++;
+ next FOLDER;
+ }
last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
foreach my $m (@f_msgs) {
unless (parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash)) {
@@ -1407,25 +1424,21 @@
$debug and print "Time headers: ", timenext(), " s\n";
print "++++ To [$t_fold] Parse 1 ++++\n";
- last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
- my $t_heads = $to->parse_headers([@t_msgs],
- @useheader) if (@t_msgs);
+ my ($t_heads, $t_fir) = ({}, {});
+ $t_heads = $to->parse_headers([@t_msgs], @useheader) if (@t_msgs);
$debug and print "Time headers: ", timenext(), " s\n";
- last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
- my $t_fir = $to->fetch_hash("FLAGS",
- "INTERNALDATE",
- "RFC822.SIZE") if (@t_msgs);
+
+ $t_fir = $to->fetch_hash("FLAGS", "INTERNALDATE", "RFC822.SIZE")
+ if (@t_msgs);
$debug and print "Time fir: ", timenext(), " s\n";
- last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
foreach my $m (@t_msgs) {
parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
}
$debug and print "Time headers: ", timenext(), " s\n";
-
+
print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n";
# messages in "from" that are not good in "to"
@@ -1439,18 +1452,31 @@
if($delete2) {
+ my @expunge;
foreach my $m_id (@t_hash_keys_sorted_by_uid) {
#print "$m_id ";
unless (exists($f_hash{$m_id})) {
my $t_msg = $t_hash{$m_id}{'m'};
- print "deleting message $m_id $t_msg\n";
- unless ($dry) {
- last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
+ my $flags = $t_hash{$m_id}{'F'} || "";
+ my $isdel = $flags =~ /\B\\Deleted\b/ ? 1 : 0;
+ print "deleting message $m_id $t_msg\n"
+ if ! $isdel;
+ push(@expunge,$t_msg) if $uidexpunge2;
+ unless ($dry or $isdel) {
$to->delete_message($t_msg);
+ last FOLDER if $to->IsUnconnected();
}
}
}
+
+ my $cnt = scalar @expunge;
+ if(@expunge and !$to->can("uidexpunge")) {
+ warn "uidexpunge not supported (< IMAPClient 3.17)\n";
+ }
+ elsif(@expunge) {
+ print "uidexpunge $cnt message(s)\n";
+ $to->uidexpunge(\@expunge) if !$dry;
+ }
}
MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) {
@@ -1475,7 +1501,7 @@
$string = $from->message_string($f_msg);
unless (defined($string)) {
warn
- "Could not fetch message #$f_msg from $f_fold ",
+ "Could not fetch message #$f_msg from $f_fold: ",
$from->LastError, "\n";
$error++;
$mess_size_total_error += $f_size;
@@ -1591,10 +1617,10 @@
if($delete) {
print "Deleting msg #$f_msg in folder $f_fold\n";
unless($dry) {
- last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
$from->delete_message($f_msg);
+ last FOLDER if $from->IsUnconnected();
$from->expunge() if ($expunge);
+ last FOLDER if $from->IsUnconnected();
}
}
}
@@ -1612,44 +1638,31 @@
}
$fast and next MESS;
- #$debug and print "MESSAGE $m_id\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";
- last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
+ # used cached flag values for efficiency
+ my $flags_f = $f_hash{$m_id}{'F'} || "";
+ my $flags_t = $t_hash{$m_id}{'F'} || "";
- my (@flags_f,@flags_t);
- my $flags_f_rv = $from->flags($f_msg);
- @flags_f = @{$flags_f_rv} if ref($flags_f_rv);
-
# No flag \Recent here, no ?
- my $flags_f = join(" ", @flags_f);
-
$flags_f = flags_regex($flags_f) if @regexflag;
-
- # This add or change flags but no flag are removed with this
- $to->store($t_msg,
- "+FLAGS.SILENT (" . $flags_f . ")"
- ) unless ($dry);
-
- # I think one IsUnconnected() is enough before all flags operations.
- #last FOLDER if $to->IsUnconnected();
-
- my $flags_t_rv = $to->flags($t_msg);
- #last FOLDER if $to->IsUnconnected();
- @flags_t = @{$flags_t_rv} if ref($flags_t_rv);
- my $flags_t = join(" ", @flags_t);
- $debug and print
- "flags from: $flags_f\n",
- "flags to : $flags_t\n";
-
+ $debug and print "Setting flags from($flags_f) to($flags_t)\n";
+
+ # This add or change flags but no flag are removed with this
+ $to->store($t_msg, "+FLAGS.SILENT ($flags_f)" )
+ if (!$dry and $flags_f ne $flags_t);
+ last FOLDER if $to->IsUnconnected();
$debug and do {
+ my @flags_t = @{ $to->flags($t_msg) || [] };
+ last FOLDER if $to->IsUnconnected();
+
+ print "flags from: $flags_f\n",
+ "flags to : @flags_t\n";
+
print "Looking dates\n";
#my $d_f = $from->internaldate($f_msg);
#my $d_t = $to->internaldate($t_msg);
@@ -1657,7 +1670,7 @@
my $d_t = $t_hash{$m_id}{'D'};
print
"idate from: $d_f\n",
- "idate to : $d_t\n";
+ "idate to : $d_t\n";
#unless ($d_f eq $d_t) {
# print "!!! Dates differ !!!\n";
@@ -1673,8 +1686,7 @@
if ($opt_G){
print "Deleting msg f:#$t_msg in folder $t_fold\n";
$to->delete_message($t_msg) unless ($dry);
- # $opt_G is fake
- #last FOLDER if $to->IsUnconnected();
+ last FOLDER if $to->IsUnconnected();
}
}
else {
@@ -1684,10 +1696,10 @@
if($delete) {
print "Deleting msg #$f_msg in folder $f_fold\n";
unless($dry) {
- last FOLDER if $from->IsUnconnected();
- last FOLDER if $to->IsUnconnected();
$from->delete_message($f_msg);
+ last FOLDER if $from->IsUnconnected();
$from->expunge() if ($expunge);
+ last FOLDER if $from->IsUnconnected();
}
}
}
@@ -1713,21 +1725,31 @@
#
# can be tested with a "killall /usr/bin/imapd" (or equivalent) in command line.
#
+sub _filter {
+ my $str = shift or return "";
+ my $sz = 64;
+ my $len = length($str);
+ if ( ! $debug and $len > $sz*2 ) {
+ my $beg = substr($str, 0, $sz);
+ my $end = substr($str, -$sz, $sz);
+ $str = $beg . "..." . $end;
+ }
+ $str =~ s/\012?\015$//;
+ return "(len=$len) " . $str;
+}
+
sub lost_connection {
my($imap, $error_message) = @_;
if ( $imap->IsUnconnected() ) {
$error++;
+ my $lcomm = $imap->LastIMAPCommand || "";
my $einfo = $imap->LastError || @{$imap->History}[-1] || "";
- my $sz = 64;
- # if einfo is long try reduce to a more reasonable size
- if ( ! $debug and length($einfo) > $sz*2 ) {
- my $beg = substr($einfo, 0, $sz);
- my $end = substr($einfo, -$sz, $sz);
- $einfo = $beg . "..." . $end;
- }
- chomp($einfo);
- $einfo = ": $einfo" if $einfo;
- warn("error: lost connection $error_message $einfo\n");
+
+ # if string is long try reduce to a more reasonable size
+ $lcomm = _filter($lcomm);
+ $einfo = _filter($einfo);
+ warn("error: last command: $lcomm\n") if ($debug && $lcomm);
+ warn("error: lost connection $error_message", $einfo, "\n");
return(1);
}else{
return(0);
@@ -1847,6 +1869,7 @@
"expunge!" => \$expunge,
"expunge1!" => \$expunge1,
"expunge2!" => \$expunge2,
+ "uidexpunge2!" => \$uidexpunge2,
"subscribed!" => \$subscribed,
"subscribe!" => \$subscribe,
"justbanner!" => \$justbanner,
@@ -1871,6 +1894,8 @@
"authuser2=s" => \$authuser2,
"split1=i" => \$split1,
"split2=i" => \$split2,
+ "reconnectretry1=i" => \$reconnectretry1,
+ "reconnectretry2=i" => \$reconnectretry2,
"tests" => \$tests,
"allow3xx!" => \$allow3xx,
"justlogin!" => \$justlogin,
@@ -2088,6 +2113,8 @@
it will change in future releases.
--expunge1 : expunge messages on source account.
--expunge2 : expunge messages on target account.
+--uidexpunge2 : uidexpunge messages on the destination imap server
+ that are not on the source server, requires --delete2
--syncinternaldates : sets the internal dates on host2 same as host1.
Turned on by default.
--idatefromheader : sets the internal dates on host2 same as the
@@ -2132,6 +2159,8 @@
and exit.
--justfolders : just do things about folders (ignore messages).
--fast : be faster (just does not sync flags).
+--reconnectretry1 <int>: reconnect if connection is lost up to <int> times
+--reconnectretry2 <int>: reconnect if connection is lost up to <int> times
--split1 <int> : split the requests in several parts on source server.
<int> is the number of messages handled per request.
default is like --split1 1000

View file

@ -0,0 +1,108 @@
--- imapsync.1.282+patch1 2009-06-19 15:44:09.140625000 -0400
+++ imapsync 2009-06-19 15:50:31.437500000 -0400
@@ -515,7 +515,7 @@
if (@_) { $self->{SSL} = shift }
return $self->{SSL};
-};
+} unless Mail::IMAPClient->can("Ssl");
return(1);
}else{
@@ -1245,7 +1245,7 @@
my ($t_fold);
my ($x_fold) = @_;
# first we remove the prefix
- $x_fold =~ s/^$f_prefix//;
+ $x_fold =~ s/^\Q$f_prefix\E//;
$debug and print "removed source prefix: [$x_fold]\n";
$t_fold = separator_invert($x_fold,$f_sep, $t_sep);
$debug and print "inverted separators: [$t_fold]\n";
@@ -1414,9 +1414,11 @@
last FOLDER if $from->IsUnconnected();
foreach my $m (@f_msgs) {
- unless (parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash)) {
+ my $rc = parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash);
+ if (!$rc) {
+ my $reason = !defined($rc) ? "no header" : "duplicate";
my $f_size = $f_fir->{$m}->{"RFC822.SIZE"} || 0;
- print "+ Skipping msg #$m:$f_size in folder $f_fold (no header so we ignore this message)\n";
+ print "+ Skipping msg #$m:$f_size in folder $f_fold ($reason so we ignore this message)\n";
$mess_size_total_skipped += $f_size;
$mess_skipped += 1;
}
@@ -1435,7 +1437,14 @@
$debug and print "Time fir: ", timenext(), " s\n";
last FOLDER if $to->IsUnconnected();
foreach my $m (@t_msgs) {
- parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
+ my $rc = parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
+ if (!$rc) {
+ my $reason = !defined($rc) ? "no header" : "duplicate";
+ my $t_size = $t_fir->{$m}->{"RFC822.SIZE"} || 0;
+ print "+ Skipping msg #$m:$t_size in 'to' folder $t_fold ($reason so we ignore this message)\n";
+ #$mess_size_total_skipped += $msize;
+ #$mess_skipped += 1;
+ }
}
$debug and print "Time headers: ", timenext(), " s\n";
@@ -1580,7 +1589,7 @@
my $flags_f = $f_hash{$m_id}{'F'} || "";
# RFC 2060: This flag can not be altered by any client
- $flags_f =~ s@\\Recent@@gi;
+ $flags_f =~ s@\\Recent\s?@@gi;
$flags_f = flags_regex($flags_f) if @regexflag;
my $new_id;
@@ -1646,14 +1655,24 @@
my $flags_f = $f_hash{$m_id}{'F'} || "";
my $flags_t = $t_hash{$m_id}{'F'} || "";
- # No flag \Recent here, no ?
+ # RFC 2060: This flag can not be altered by any client
+ $flags_f =~ s@\\Recent\s?@@gi;
$flags_f = flags_regex($flags_f) if @regexflag;
- $debug and print "Setting flags from($flags_f) to($flags_t)\n";
-
- # This add or change flags but no flag are removed with this
- $to->store($t_msg, "+FLAGS.SILENT ($flags_f)" )
- if (!$dry and $flags_f ne $flags_t);
+ # compare flags - add missing flags
+ my @ff = split(' ', $flags_f );
+ my %ft = map { $_ => 1 } split(' ', $flags_t );
+ my @flags_a = map { exists $ft{$_} ? () : $_ } @ff;
+
+ $debug and print "Setting flags(@flags_a) ffrom($flags_f) fto($flags_t) on msg #$t_msg in $t_fold\n";
+
+ # This adds or changes flags but no flag are removed with this
+ if (!$dry and @flags_a and !$to->store($t_msg, "+FLAGS.SILENT (@flags_a)") ) {
+ warn "Could not add flags '@flags_a' flagf '$flags_f'",
+ " flagt '$flags_t' on msg #$t_msg in $t_fold: ",
+ $to->LastError, "\n";
+ #$error++;
+ }
last FOLDER if $to->IsUnconnected();
$debug and do {
@@ -1979,7 +1998,7 @@
#$headstr = $imap->message_string($m_uid);
print "no header so we ignore this message\n";
- return;
+ return undef;
}
my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"};
my $flags = $s_fir->{$m_uid}->{"FLAGS"};
@@ -1994,6 +2013,8 @@
else {
$key = "$m_md5:$size";
}
+ # 0 return code is used to identify duplicate message hash
+ return 0 if exists $s_hash->{"$key"};
$s_hash->{"$key"}{'5'} = $m_md5;
$s_hash->{"$key"}{'s'} = $size;
$s_hash->{"$key"}{'D'} = $idate;

View file

@ -0,0 +1,98 @@
--- imapsync.ORIG 2009-06-30 15:39:54.156250000 -0400
+++ imapsync 2009-06-30 15:55:06.703125000 -0400
@@ -1237,7 +1237,7 @@
my ($t_fold);
my ($x_fold) = @_;
# first we remove the prefix
- $x_fold =~ s/^$f_prefix//;
+ $x_fold =~ s/^\Q$f_prefix\E//;
$debug and print "removed source prefix: [$x_fold]\n";
$t_fold = separator_invert($x_fold,$f_sep, $t_sep);
$debug and print "inverted separators: [$t_fold]\n";
@@ -1406,9 +1406,11 @@
last FOLDER if $from->IsUnconnected();
foreach my $m (@f_msgs) {
- unless (parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash)) {
+ my $rc = parse_header_msg1($from, $m, $f_heads, $f_fir, "F", \%f_hash);
+ if (!$rc) {
+ my $reason = !defined($rc) ? "no header" : "duplicate";
my $f_size = $f_fir->{$m}->{"RFC822.SIZE"} || 0;
- print "+ Skipping msg #$m:$f_size in folder $f_fold (no header so we ignore this message)\n";
+ print "+ Skipping msg #$m:$f_size in folder $f_fold ($reason so we ignore this message)\n";
$mess_size_total_skipped += $f_size;
$mess_skipped += 1;
}
@@ -1427,7 +1429,14 @@
$debug and print "Time fir: ", timenext(), " s\n";
last FOLDER if $to->IsUnconnected();
foreach my $m (@t_msgs) {
- parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
+ my $rc = parse_header_msg1($to, $m, $t_heads, $t_fir, "T", \%t_hash);
+ if (!$rc) {
+ my $reason = !defined($rc) ? "no header" : "duplicate";
+ my $t_size = $t_fir->{$m}->{"RFC822.SIZE"} || 0;
+ print "+ Skipping msg #$m:$t_size in 'to' folder $t_fold ($reason so we ignore this message)\n";
+ #$mess_size_total_skipped += $msize;
+ #$mess_skipped += 1;
+ }
}
$debug and print "Time headers: ", timenext(), " s\n";
@@ -1572,7 +1581,7 @@
my $flags_f = $f_hash{$m_id}{'F'} || "";
# RFC 2060: This flag can not be altered by any client
- $flags_f =~ s@\\Recent@@gi;
+ $flags_f =~ s@\\Recent\s?@@gi;
$flags_f = flags_regex($flags_f) if @regexflag;
my $new_id;
@@ -1638,14 +1647,24 @@
my $flags_f = $f_hash{$m_id}{'F'} || "";
my $flags_t = $t_hash{$m_id}{'F'} || "";
- # No flag \Recent here, no ?
+ # RFC 2060: This flag can not be altered by any client
+ $flags_f =~ s@\\Recent\s?@@gi;
$flags_f = flags_regex($flags_f) if @regexflag;
- $debug and print "Setting flags from($flags_f) to($flags_t)\n";
+ # compare flags - add missing flags
+ my @ff = split(' ', $flags_f );
+ my %ft = map { $_ => 1 } split(' ', $flags_t );
+ my @flags_a = map { exists $ft{$_} ? () : $_ } @ff;
- # This add or change flags but no flag are removed with this
- $to->store($t_msg, "+FLAGS.SILENT ($flags_f)" )
- if (!$dry and $flags_f ne $flags_t);
+ $debug and print "Setting flags(@flags_a) ffrom($flags_f) fto($flags_t) on msg #$t_msg in $t_fold\n";
+
+ # This adds or changes flags but no flag are removed with this
+ if (!$dry and @flags_a and !$to->store($t_msg, "+FLAGS.SILENT (@flags_a)") ) {
+ warn "Could not add flags '@flags_a' flagf '$flags_f'",
+ " flagt '$flags_t' on msg #$t_msg in $t_fold: ",
+ $to->LastError, "\n";
+ #$error++;
+ }
last FOLDER if $to->IsUnconnected();
$debug and do {
@@ -1971,7 +1990,7 @@
#$headstr = $imap->message_string($m_uid);
print "no header so we ignore this message\n";
- return;
+ return undef;
}
my $size = $s_fir->{$m_uid}->{"RFC822.SIZE"};
my $flags = $s_fir->{$m_uid}->{"FLAGS"};
@@ -1986,6 +2005,8 @@
else {
$key = "$m_md5:$size";
}
+ # 0 return code is used to identify duplicate message hash
+ return 0 if exists $s_hash->{"$key"};
$s_hash->{"$key"}{'5'} = $m_md5;
$s_hash->{"$key"}{'s'} = $size;
$s_hash->{"$key"}{'D'} = $idate;

View file

@ -0,0 +1,882 @@
#!/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]
[--timeout <int>]
[--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,
$timeout, # whr (ESS/PRW)
);
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, $timeout);
$debugimap and print "To connection\n";
$to = login_imap($host2, $port2, $user2, $password2, $debugimap, $timeout);
sub login_imap {
my($host, $port, $user, $password, $debugimap, $timeout, $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";
if ($timeout) # whr (ESS/PRW)
{
$imap->Timeout($timeout);
print "Setting imap timeout to $timeout\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()};
for (my $i=0; $i<scalar(@t_folders); $i++) # whr (ESS/PRW)
{
if ( $t_folders[$i] =~ /^INBOX\/INBOX$/ )
{
$t_folders[$i] = "INBOX";
}
}
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);
$t_fold='INBOX' if ($t_fold eq 'INBOX/INBOX'); # whr (ESS/PRW)
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;
}
$to->subscribe($t_fold); # whr (ESS/PRW)
$to->setacl($t_fold,'root','c'); # whr (ESS/PRW)
}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,
"timeout=i" => \$timeout, # whr (ESS/PRW)
);
$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.
--timeout <int> : imap connect timeout.
--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
}

5543
W/patches/imapsync.dave Normal file

File diff suppressed because it is too large Load diff

146
W/patches/imapsync.diff Normal file
View file

@ -0,0 +1,146 @@
--- imapsync.orig Wed Dec 24 04:04:34 2003
+++ imapsync Wed Jan 21 10:32:24 2004
@@ -34,10 +34,13 @@
[--host2 server2] [--port2 <num>]
[--user2 <string>] [--passfile2 <string>]
[--folder <string> --folder <string> ...]
+ [--include <regex>] [--exclude <regex>]
[--prefix2 <string>]
[--sep1 <char>]
[--sep2 <char>]
- [--syncinternaldate]
+ [--syncinternaldates]
+ [--maxsize <int>]
+ [--maxage <int>]
[--delete] [--expunge]
[--subscribed] [--subscribe]
[--dry]
@@ -239,9 +242,10 @@
$rcs, $debug, $debugimap, $error,
$host1, $host2, $port1, $port2,
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
- @folder, $prefix2,
+ @folder, $include, $exclude, $prefix2,
$sep1, $sep2,
$syncinternaldates,
+ $maxsize, $maxage,
$delete, $expunge, $dry,
$subscribed, $subscribe,
$version, $VERSION, $help,
@@ -369,10 +373,19 @@
@f_folders = @folder;
}elsif ($subscribed) {
# option --subscribed
- @f_folders = keys (%fs_folders);
+ @f_folders = sort keys (%fs_folders);
}else {
# no option, all folders
- @f_folders = $from->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);
@@ -415,13 +428,13 @@
# my $tohasuidplus = $to->has_capability("UIDPLUS");
-@t_folders = @{$to->folders()};
+@t_folders = sort @{$to->folders()};
print
"From folders : ", map("[$_] ",@f_folders),"\n",
"To folders : ", map("[$_] ",@t_folders),"\n";
print
- "From subscribed folders : ", map("[$_] ", keys(%fs_folders)), "\n";
+ "From subscribed folders : ", map("[$_] ", sort keys(%fs_folders)), "\n";
sub separator_invert {
my $o_sep="\000";
@@ -485,9 +498,9 @@
unless($dry) { $to->subscribe($t_fold) };
}
- my @f_msgs = $from->search("ALL");
+ my @f_msgs = $maxage ? $from->since(time - 86400 * $maxage) : $from->search("ALL");
$debug and print "LIST FROM : @f_msgs\n";
- my @t_msgs = $to->search("ALL");
+ my @t_msgs = $maxage ? $to->since(time - 86400 * $maxage) : $to->search("ALL");
$debug and print "LIST TO : @t_msgs\n";
my %f_hash = ();
@@ -508,6 +521,10 @@
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)\n";
+ 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";
@@ -526,7 +543,7 @@
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",
+ warn "Couldn't append msg #$f_msg (Subject: ".$from->subject($f_msg).") to folder $t_fold: ",
$to->LastError, "\n";
$error++;
next MESS;
@@ -619,9 +636,13 @@
"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,
@@ -656,8 +677,8 @@
return unless(scalar(keys(%$head)));
foreach my $h (sort keys(%$head)){
foreach my $val ( @{$head->{$h}}) {
- # no accent in headers !
- $val =~ y/éèàù/XXXX/;
+ # no 8-bit data in headers !
+ $val =~ s/[\x80-\xff]/X/g;
$debug and print "${s}H $h:", $val, "\n";
$headstr .= "$h:". $val;
}
@@ -704,6 +725,12 @@
--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.
@@ -718,6 +745,8 @@
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
--dry : do nothing, just print what would be done.
--subscribed : transfer only subscribed folders.
--subscribe : subscribe to the folders transfered on the

View file

@ -0,0 +1,633 @@
--- imapsync-1.267/imapsync Tue Oct 7 06:36:03 2008
+++ /usr/local/bin/imapsync Mon Dec 8 12:09:28 2008
@@ -79,6 +79,9 @@
[--debug] [--debugimap]
[--timeout <int>] [--fast]
[--split1] [--split2]
+ [--quiet]
+ [--showstats]
+ [--emailreport] [--emailuser <string]
[--version] [--help]
=cut
@@ -435,6 +438,7 @@
use Carp;
use Getopt::Long;
use Mail::IMAPClient;
+use Net::SMTP;
use Digest::MD5 qw(md5_base64);
#use Term::ReadKey;
#use IO::Socket::SSL;
@@ -442,6 +446,7 @@
use English;
use POSIX qw(uname);
use Fcntl;
+use Time::Zone;
#use Test::Simple tests => 1;
use Test::More 'no_plan';
@@ -450,7 +455,7 @@
my(
- $rcs, $debug, $debugimap, $error,
+ $rcs, $debug, $debugimap, $error, $errortext, $emailreport, $emailuser,
$host1, $host2, $port1, $port2,
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, @include, @exclude, @folderrec,
@@ -484,7 +489,7 @@
$authmech1, $authmech2,
$split1, $split2,
$tests, $test_builder,
- $allow3xx,
+ $allow3xx,$quiet,$showstats
);
use vars qw ($opt_G); # missing code for this will be option.
@@ -548,7 +553,6 @@
}
-
my $banner = join("",
'$RCSfile: imapsync,v $ ',
'$Revision: 1.267 $ ',
@@ -566,12 +570,12 @@
}
get_options();
-
+$errortext = "";
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. See file BUG_IMAPClient_3.xx\n";
-print $banner;
+!$quiet and print $banner;
sub missing_option {
my ($option) = @_;
@@ -622,11 +626,11 @@
my $to = ();
$from = connect_imap($host1, $port1, $debugimap, $ssl1);
- print "From software : ", server_banner($from);
- print "From capability : ", join(" ", $from->capability()), "\n";
+ !$quiet and print "From software : ", server_banner($from);
+ !$quiet and print "From capability : ", join(" ", $from->capability()), "\n";
$to = connect_imap($host2, $port2, $debugimap, $ssl2);
- print "To software : ", server_banner($to);
- print "To capability : ", join(" ", $to->capability()), "\n";
+ !$quiet and print "To software : ", server_banner($to);
+ !$quiet and print "To capability : ", join(" ", $to->capability()), "\n";
$from->logout();
$to->logout();
exit(0);
@@ -638,16 +642,16 @@
$syncinternaldates = defined($syncinternaldates) ? defined($syncinternaldates) : 1;
if($idatefromheader) {
- print "Turned ON idatefromheader, ",
+ !$quiet and print "Turned ON idatefromheader, ",
"will set the internal dates on host2 from the 'Date:' header line.\n";
$syncinternaldates = 0;
}
if ($syncinternaldates) {
- print "Turned ON syncinternaldates, ",
+ !$quiet and print "Turned ON syncinternaldates, ",
"will set the internal dates on host2 same as host1.\n";
}else{
- print "Turned OFF syncinternaldates\n";
+ !$quiet and print "Turned OFF syncinternaldates\n";
}
if ($syncinternaldates || $idatefromheader) {
@@ -656,11 +660,12 @@
require Date::Manip;
Date::Manip->import(qw(ParseDate Date_Cmp UnixDate Date_Init Date_TimeZone));
#print "Date_init : [", join(" ",Date_Init()), "]\n";
- print "TimeZone :[", Date_TimeZone(), "]\n";
if (not (Date_TimeZone())) {
- warn "TimeZone not defined, setting it to GMT";
+ #warn "TimeZone not defined, setting it to GMT";
Date_Init("TZ=GMT");
- print "TimeZone : [", Date_TimeZone(), "]\n";
+ !$quiet and print "TimeZone : [", Date_TimeZone(), "]\n";
+ }else{
+ !$quiet and print "TimeZone :[", Date_TimeZone(), "]\n";
}
}
@@ -680,8 +685,8 @@
$authuser1 ||= $user1;
$authuser2 ||= $user2;
-print "Will try to use $authmech1 authentication on host1\n";
-print "Will try to use $authmech2 authentication on host2\n";
+!$quiet and print "Will try to use $authmech1 authentication on host1\n";
+!$quiet and print "Will try to use $authmech2 authentication on host2\n";
$syncacls = (defined($syncacls)) ? $syncacls : 0;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1;
@@ -693,8 +698,8 @@
@useheader = ("ALL") unless (@useheader);
-print "From imap server [$host1] port [$port1] user [$user1]\n";
-print "To imap server [$host2] port [$port2] user [$user2]\n";
+!$quiet and print "From imap server [$host1] port [$port1] user [$user1]\n";
+!$quiet and print "To imap server [$host2] port [$port2] user [$user2]\n";
sub ask_for_password {
@@ -765,20 +770,20 @@
$imap->connect()
or die "Can not open imap connection on [$host] with user [$user] : $@\n";
- print "Banner : ", server_banner($imap);
+ !$quiet and print "Banner : ", server_banner($imap);
if ($imap->has_capability("AUTH=$authmech")
or $imap->has_capability($authmech)
) {
- printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n",
- $imap->Server, $authmech);
+ if (!$quiet) { printf("Host %s says it has CAPABILITY for AUTHENTICATE %s\n",
+ $imap->Server, $authmech);}
}
else {
- printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
- $imap->Server, $authmech);
+ if (!$quiet) { printf("Host %s says it has NO CAPABILITY for AUTHENTICATE %s\n",
+ $imap->Server, $authmech);}
if ($authmech eq 'PLAIN') {
print "Frequently PLAIN is only supported with SSL, ",
- "try --ssl1 or --ssl2 option\n";
+ "try using SSL option\n";
}
}
@@ -789,15 +794,15 @@
$imap->Authuser($authuser);
$imap->Password($password);
unless ($imap->login()) {
- print "Error login : [$host] with user [$user] auth [$authmech]: $@\n";
+ !$quiet and print "Error login : [$host] with user [$user] auth [$authmech]: $@\n";
die if ($authmech eq 'LOGIN');
die if $imap->IsUnconnected();
- print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
+ !$quiet and print "Trying LOGIN Auth mechanism on [$host] with user [$user]\n";
$imap->Authmechanism("");
$imap->login() or
die "Error login : [$host] with user [$user] auth [LOGIN] : $@";
}
- print "Success login on [$host] with user [$user] auth [$authmech]\n";
+ !$quiet and print "Success login on [$host] with user [$user] auth [$authmech]\n";
return($imap);
}
@@ -822,13 +827,13 @@
-print "From capability : ", join(" ", $from->capability()), "\n";
-print "To capability : ", join(" ", $to->capability()), "\n";
+!$quiet and print "From capability : ", join(" ", $from->capability()), "\n";
+!$quiet and print "To capability : ", join(" ", $to->capability()), "\n";
die unless $from->IsAuthenticated();
-print "From state Authenticated\n";
+!$quiet and print "From state Authenticated\n";
die unless $to->IsAuthenticated();
-print "To state Authenticated\n";
+!$quiet and print "To state Authenticated\n";
$split1 and $from->Split($split1);
$split2 and $to->Split($split2);
@@ -932,7 +937,7 @@
foreach my $include (@include) {
my @included_folders = grep /$include/, @all_source_folders;
add_to_requested_folders(@included_folders);
- print "Including folders matching pattern '$include': @included_folders\n";
+ !$quiet and print "Including folders matching pattern '$include': @included_folders\n";
}
}
@@ -941,7 +946,7 @@
my @requested_folder = sort(keys(%requested_folder));
my @excluded_folders = grep /$exclude/, @requested_folder;
remove_from_requested_folders(@excluded_folders);
- print "Excluding folders matching pattern '$exclude': @excluded_folders\n";
+ !$quiet and print "Excluding folders matching pattern '$exclude': @excluded_folders\n";
}
}
@@ -1056,7 +1061,7 @@
$debug and print "Getting prefix namespace\n";
if (defined($prefix_in)) {
- print "Using [$prefix_in] given by $prefix_opt\n";
+ !$quiet and print "Using [$prefix_in] given by $prefix_opt\n";
$prefix_out = $prefix_in;
return($prefix_out);
}
@@ -1082,7 +1087,7 @@
if ($sep_in) {
- print "Using [$sep_in] given by $sep_opt\n";
+ !$quiet and print "Using [$sep_in] given by $sep_opt\n";
$sep_out = $sep_in;
return($sep_out);
}
@@ -1101,8 +1106,8 @@
}
-print "From separator and prefix : [$f_sep][$f_prefix]\n";
-print "To separator and prefix : [$t_sep][$t_prefix]\n";
+!$quiet and print "From separator and prefix : [$f_sep][$f_prefix]\n";
+!$quiet and print "To separator and prefix : [$t_sep][$t_prefix]\n";
sub foldersizes {
@@ -1111,13 +1116,13 @@
my $tot = 0;
my $tmess = 0;
my @folders = @{$folders_r};
- print "++++ Calculating sizes ++++\n";
+ !$quiet and print "++++ Calculating sizes ++++\n";
foreach my $folder (@folders) {
my $stot = 0;
my $smess = 0;
- printf("$side Folder %-35s", "[$folder]");
+ !$quiet and printf("$side Folder %-35s", "[$folder]");
unless($imap->exists($folder)) {
- print("does not exist yet\n");
+ !$quiet and print("does not exist yet\n");
next;
}
unless ($imap->select($folder)) {
@@ -1148,14 +1153,14 @@
map {$stot += $hashref->{$_}->{"RFC822.SIZE"}} keys %$hashref;
}
}
- printf(" Size: %9s", $stot);
- printf(" Messages: %5s\n", $smess);
+ !$quiet and printf(" Size: %9s", $stot);
+ !$quiet and printf(" Messages: %5s\n", $smess);
$tot += $stot;
$tmess += $smess;
}
- print "Total size: $tot\n";
- print "Total messages: $tmess\n";
- print "Time : ", timenext(), " s\n";
+ !$quiet and print "Total size: $tot\n";
+ !$quiet and print "Total messages: $tmess\n";
+ !$quiet and print "Time : ", timenext(), " s\n";
}
@@ -1196,12 +1201,12 @@
$t_folders_list{$folder}++;
}
-print
+!$quiet and print
"++++ Listing folders ++++\n",
"From folders list : ", map("[$_] ",@f_folders),"\n",
"To folders list : ", map("[$_] ",@t_folders_list),"\n";
-print
+!$quiet and print
"From subscribed folders list : ",
map("[$_] ", sort keys(%subscribed_folder)), "\n"
if ($subscribed);
@@ -1259,11 +1264,11 @@
my %users = map({ ($_, 1) } (keys(%$f_hash), keys(%$t_hash)));
foreach my $user (sort(keys(%users))) {
my $acl = $f_hash->{$user} || "none";
- print "acl $user : [$acl]\n";
+ !$quiet and print "acl $user : [$acl]\n";
next if ($f_hash->{$user} && $t_hash->{$user} &&
$f_hash->{$user} eq $t_hash->{$user});
unless ($dry) {
- print "setting acl $t_fold $user $acl\n";
+ !$quiet and print "setting acl $t_fold $user $acl\n";
$to->setacl($t_fold, $user, $acl)
or warn "Could not set acl: $@\n";
}
@@ -1272,13 +1277,13 @@
}
-print "++++ Looping on each folder ++++\n";
+!$quiet and print "++++ Looping on each folder ++++\n";
FOLDER: foreach my $f_fold (@f_folders) {
my $t_fold;
- print "From Folder [$f_fold]\n";
+ !$quiet and print "From Folder [$f_fold]\n";
$t_fold = to_folder_name($f_fold);
- print "To Folder [$t_fold]\n";
+ !$quiet and print "To Folder [$t_fold]\n";
last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
@@ -1291,12 +1296,13 @@
next FOLDER;
}
if ( ! exists($t_folders_list{$t_fold})) {
- print "To Folder $t_fold does not exist\n";
- print "Creating folder [$t_fold]\n";
+ !$quiet and print "To Folder $t_fold does not exist\n";
+ !$quiet and print "Creating folder [$t_fold]\n";
unless ($dry){
unless ($to->create($t_fold)){
warn "Couldn't create [$t_fold]",
$to->LastError,"\n";
+ $errortext .= "Couldn't create [$t_fold]",
$error++;
next FOLDER;
}
@@ -1317,13 +1323,13 @@
}
if ($expunge){
- print "Expunging $f_fold and $t_fold\n";
+ !$quiet and print "Expunging $f_fold and $t_fold\n";
unless($dry) { $from->expunge() };
#unless($dry) { $to->expunge() };
}
if ($subscribe and exists $subscribed_folder{$f_fold}) {
- print "Subscribing to folder $t_fold on destination server\n";
+ !$quiet and print "Subscribing to folder $t_fold on destination server\n";
unless($dry) { $to->subscribe($t_fold) };
}
@@ -1346,7 +1352,7 @@
my %f_hash = ();
my %t_hash = ();
- print "++++ From [$f_fold] Parse 1 ++++\n";
+ !$quiet and print "++++ From [$f_fold] Parse 1 ++++\n";
last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
@@ -1363,7 +1369,7 @@
}
$debug and print "Time headers: ", timenext(), " s\n";
- print "++++ To [$t_fold] Parse 1 ++++\n";
+ !$quiet and print "++++ To [$t_fold] Parse 1 ++++\n";
last FOLDER if $from->IsUnconnected();
last FOLDER if $to->IsUnconnected();
@@ -1379,7 +1385,7 @@
}
$debug and print "Time headers: ", timenext(), " s\n";
- print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n";
+ !$quiet and print "++++ Verifying [$f_fold] -> [$t_fold] ++++\n";
# messages in "from" that are not good in "to"
my @f_hash_keys_sorted_by_uid
@@ -1396,7 +1402,7 @@
#print "$m_id ";
unless (exists($f_hash{$m_id})) {
my $t_msg = $t_hash{$m_id}{'m'};
- print "deleting message $m_id $t_msg\n";
+ !$quiet and print "deleting message $m_id $t_msg\n";
$to->delete_message($t_msg) unless ($dry);
}
}
@@ -1408,16 +1414,16 @@
my $f_idate = $f_hash{$m_id}{'D'};
if (defined $maxsize and $f_size > $maxsize) {
- print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n";
+ !$quiet and print "+ Skipping msg #$f_msg:$f_size in folder $f_fold (exceeds maxsize limit $maxsize bytes)\n";
$mess_size_total_skipped += $f_size;
$mess_skipped += 1;
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";
+ !$quiet and print "+ NO msg #$f_msg [$m_id] in $t_fold\n";
# copy
- print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
+ !$quiet and print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
last FOLDER if $from->IsUnconnected();
my $string;
$string = $from->message_string($f_msg);
@@ -1497,7 +1503,7 @@
$flags_f = flags_regex($flags_f) if @regexflag;
my $new_id;
- print "flags from : [$flags_f][$d]\n";
+ !$quiet and print "flags from : [$flags_f][$d]\n";
last FOLDER if $to->IsUnconnected();
unless ($dry) {
@@ -1514,6 +1520,9 @@
warn "Couldn't append msg #$f_msg (Subject:[".
$from->subject($f_msg)."]) to folder $t_fold: ",
$to->LastError, "\n";
+ $errortext .= "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;
@@ -1522,11 +1531,11 @@
# 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";
+ !$quiet and print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
$mess_size_total_trans += $f_size;
$mess_trans += 1;
if($delete) {
- print "Deleting msg #$f_msg in folder $f_fold\n";
+ !$quiet and print "Deleting msg #$f_msg in folder $f_fold\n";
$from->delete_message($f_msg) unless ($dry);
$from->expunge() if ($expunge and not $dry);
}
@@ -1577,12 +1586,12 @@
$debug and do {
- print "Looking dates\n";
+ !$quiet and print "Looking dates\n";
#my $d_f = $from->internaldate($f_msg);
#my $d_t = $to->internaldate($t_msg);
my $d_f = $f_hash{$m_id}{'D'};
my $d_t = $t_hash{$m_id}{'D'};
- print
+ !$quiet and print
"idate from : $d_f\n",
"idate to : $d_t\n";
@@ -1592,13 +1601,14 @@
};
unless (($f_size == $t_size) or $skipsize) {
# Bad size
- print
+ !$quiet and 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.
+ $errortext .= "Message $m_id SZ_BAD f:$f_msg:$f_size t:$t_msg:$t_size\n";
$error++;
if ($opt_G){
- print "Deleting msg f:#$t_msg in folder $t_fold\n";
+ !$quiet and print "Deleting msg f:#$t_msg in folder $t_fold\n";
$to->delete_message($t_msg) unless ($dry);
}
}
@@ -1607,22 +1617,22 @@
$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";
+ !$quiet and print "Deleting msg #$f_msg in folder $f_fold\n";
$from->delete_message($f_msg) unless ($dry);
$from->expunge() if ($expunge and not $dry);
}
}
}
if ($expunge1){
- print "Expunging source folder $f_fold\n";
+ !$quiet and print "Expunging source folder $f_fold\n";
unless($dry) { $from->expunge() };
}
if ($expunge2){
- print "Expunging target folder $t_fold\n";
+ !$quiet and print "Expunging target folder $t_fold\n";
unless($dry) { $to->expunge() };
}
-print "Time : ", timenext(), " s\n";
+!$quiet and print "Time : ", timenext(), " s\n";
}
@@ -1673,17 +1683,47 @@
}
sub stats {
- print "++++ Statistics ++++\n";
- print "Time : $timediff sec\n";
- print "Messages transferred : $mess_trans ";
- print "(could be $mess_skipped_dry without dry mode)" if ($dry);
- print "\n";
- print "Messages skipped : $mess_skipped\n";
- print "Total bytes transferred: $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\n";
- print thank_author();
+
+ if ($error){$emailreport=1;}
+ if ($emailreport == 1){
+ my $smtpserver = 'localhost';
+ my $Mail = Net::SMTP->new($smtpserver) ||
+ die "Could not connect to SMTP server $smtpserver : $!";
+ $Mail->mail($emailuser);
+ $Mail->recipient($emailuser);
+ my $Message = "To: " . $emailuser . "\n";
+ $Message .= "From: admin\@vfemail.net\n";
+ $Message .= "Date: " . date_r() ."\n";
+ $Message .= "Subject: IMAPSync Report\n\n\n";
+ $Message .= "++++ Statistics ++++\n";
+ $Message .= "Time : $timediff sec\n";
+ $Message .= "Messages transferred : $mess_trans ";
+ $Message .= "\n";
+ $Message .= "Messages skipped : $mess_skipped\n";
+ $Message .= "Total bytes transferred: $mess_size_total_trans\n";
+ $Message .= "Total bytes skipped : $mess_size_total_skipped\n";
+ $Message .= "Total bytes error : $mess_size_total_error\n";
+ $Message .= "Detected $error errors\n\n";
+ if ($error){$Message .= $errortext."\n\n";}
+
+ $Mail->data($Message);
+ $Mail->quit();
+
+
+
+ }elsif ($showstats){
+ print "++++ Statistics ++++\n";
+ print "Time : $timediff sec\n";
+ print "Messages transferred : $mess_trans ";
+ print "(could be $mess_skipped_dry without dry mode)" if ($dry);
+ print "\n";
+ print "Messages skipped : $mess_skipped\n";
+ print "Total bytes transferred: $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\n";
+ #print thank_author();
+ }
}
sub thank_author {
@@ -1695,6 +1735,25 @@
}
+sub date_r
+ {
+ my ($day, $mon, $str);
+ my (@lt) = ();
+ my @DAYS = ( "Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday" );
+ my @MON = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
+
+ @lt = localtime();
+ $day = $lt[6];
+ $mon = $lt[4];
+
+ $str = $DAYS[$day] . ", " . $lt[3] . " " . $MON[$mon] . " " . ($lt[5]+1900)
+ . " " . sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0] )
+ . " " . sprintf("%03d%02d", (tz_offset() / 3600), 0);
+
+ return $str;
+ }
+
+
sub get_options
{
my $numopt = scalar(@ARGV);
@@ -1760,6 +1819,10 @@
"split1=i" => \$split1,
"split2=i" => \$split2,
"tests" => \$tests,
+ "quiet!" => \$quiet,
+ "showstats" => \$showstats,
+ "emailreport" => \$emailreport,
+ "emailuser=s" => \$emailuser,
"allow3xx!" => \$allow3xx,
);
@@ -1769,7 +1832,7 @@
$test_builder->no_ending(1);
# just the version
- print "$VERSION\n" and exit if ($version) ;
+ !$quiet and print "$VERSION\n" and exit if ($version) ;
if ($tests) {
$test_builder->no_ending(0);
@@ -2027,6 +2090,10 @@
--fastio1 : use fastio with the "from" server.
--fastio2 : use fastio with the "destination" server.
--timeout <int> : imap connect timeout.
+--quiet : Only outupt errors.
+--showstats : On by default, use with --quiet for end results.
+--emailreport : Send final stats to email address.
+--emailuser <string> : User to send final stats to (server defaults to localhost).
--help : print this.
Example: to synchronise imap account "foo" on "imap.truc.org"

View file

@ -0,0 +1,97 @@
--- imapsync.orig Tue Jun 14 23:28:32 2005
+++ imapsync Wed Jun 15 14:04:14 2005
@@ -318,7 +318,7 @@
$user1, $user2, $password1, $password2, $passfile1, $passfile2,
@folder, $include, $exclude, $prefix2, $regextrans2, @regexmess,
$sep1, $sep2,
- $syncinternaldates, $syncacls,
+ $syncinternaldates, $syncacls, $syncuids,
$maxsize, $maxage,
$skipheader, @useheader,
$skipsize, $foldersizes, $buffersize,
@@ -410,6 +410,7 @@
$authmd5 = (defined($authmd5)) ? $authmd5 : 1;
$syncacls = (defined($syncacls)) ? $syncacls : 0;
+$syncuids = (defined($syncuids)) ? $syncuids : 0;
$foldersizes = (defined($foldersizes)) ? $foldersizes : 1;
@useheader = ("ALL") unless (@useheader);
@@ -661,7 +662,8 @@
# needed for setting flags
my $tohasuidplus = $to->has_capability("UIDPLUS");
-
+die("Need UIDPLUS on destination server to synchronize UIDs\n")
+ if ($syncuids && !$tohasuidplus);
print
"From folders : ", map("[$_] ",@f_folders),"\n",
@@ -788,7 +790,7 @@
print "Time sizes : ", timenext(), " s\n";
#my $f_flags = $from->flags(@f_msgs) ;
#print "Time flags : ", timenext(), " s\n";
- use Data::Dumper;
+ #use Data::Dumper;
#print Data::Dumper->Dump([$f_heads]);
#print Data::Dumper->Dump([$f_flags]);
@@ -821,6 +823,7 @@
#print map { $f_hash{$_}{'m'} . " "} @f_hash_keys_sorted_by_uid;
+ my $last_uid = 0;
MESS: foreach my $m_id (@f_hash_keys_sorted_by_uid) {
my $f_size = $f_hash{$m_id}{'s'};
my $f_msg = $f_hash{$m_id}{'m'};
@@ -835,6 +838,21 @@
print "+ NO msg #$f_msg [$m_id] in $t_fold\n";
# copy
print "+ Copying msg #$f_msg:$f_size to folder $t_fold\n";
+ while ($syncuids && !$dry && $last_uid < $f_msg - 1) {
+ my $new_id = $to->append_string($t_fold,
+ "From: imapsync\r\n".
+ "Subject: deleted message\r\n".
+ "\r\n".
+ "This message has been deleted.\r\n");
+ if ($new_id) {
+ warn "Inserted padding message #$new_id\n";
+ $to->delete_message($new_id);
+ $last_uid = $new_id;
+ } else {
+ warn "Failed to insert padding message\n";
+ last;
+ }
+ }
my $string = $from->message_string($f_msg);
foreach my $regexmess (@regexmess) {
$debug and print "eval \$string =~ $regexmess\n";
@@ -883,6 +901,11 @@
print "Copied msg id [$f_msg] to folder $t_fold msg id [$new_id]\n";
$mess_size_total_trans += $f_size;
$mess_trans += 1;
+ $last_uid = $new_id;
+ if ($syncuids && $last_uid != $f_msg) {
+ # not much we can do about this...
+ warn "Couldn't preserve message UID\n";
+ }
}
}
next MESS;
@@ -1002,6 +1025,7 @@
"delete!" => \$delete,
"syncinternaldates!" => \$syncinternaldates,
"syncacls!" => \$syncacls,
+ "syncuids!" => \$syncuids,
"maxsize=i" => \$maxsize,
"maxage=i" => \$maxage,
"buffersize=i" => \$buffersize,
@@ -1156,6 +1180,8 @@
--justconnect. Turned on by default.
--syncacls : Synchronizes acls.
--nosyncacls : Does not synchronize acls. This is the default.
+--syncuids : Synchronizes UIDs.
+--nosyncuids : Does not synchronize UIDs. This is the default.
--debug : debug mode.
--debugimap : imap debug mode.
--version : print sotfware version.

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

4079
W/patches/imapsync_minsize Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,168 @@
diff -urN imapsync-1.366.orig/FAQ imapsync-1.366/FAQ
--- imapsync-1.366.orig/FAQ 2010-10-30 12:24:10.951674625 +0200
+++ imapsync-1.366/FAQ 2010-10-31 14:12:40.447361182 +0100
@@ -514,6 +514,34 @@
--exclude '^user\.'
======================================================================
+Q: How to migrate from Sun Java Enterprise System / Sun One / iPlanet /
+Netscape servers with an admin account?
+
+R: Those imap servers don't allow the typical use of --authuser1 to use an
+administrative account. They expect the use of an IMAP command called
+proxyauth that is issued after login in as an administrative account.
+
+For example, consider the administrative account 'administrator' and your
+real user 'real_user'. The IMAP sequence would be:
+
+ OK [CAPABILITY IMAP4 IMAP4rev1 ACL QUOTA LITERAL+ NAMESPACE UIDPLUS
+ CHILDREN BINARY UNSELECT LANGUAGE STARTTLS XSENDER X-NETSCAPE XSERVERINFO
+ AUTH=PLAIN] imap.server IMAP4 service (Sun Java(tm) System Messaging
+ Server ...))
+ 1 LOGIN administrator password
+ 1 OK User logged in
+ 2 PROXYAUTH real_user
+ 2 OK Completed
+
+In imapsync, you can achieve this by using the following options:
+
+ --host1 source.imap.server \
+ --user1 real_user \
+ --authuser1 administrator \
+ --proxyauth1 \
+ --passfile admin.txt
+
+======================================================================
Q. Is there anyway of making imapsync purge the destination folder
when the source folder is deleted?
diff -urN imapsync-1.366.orig/imapsync imapsync-1.366/imapsync
--- imapsync-1.366.orig/imapsync 2010-10-30 12:24:10.965674761 +0200
+++ imapsync-1.366/imapsync 2010-10-31 13:09:59.922679699 +0100
@@ -204,6 +204,9 @@
with --authuser1 "adminuser", it will not work.
Same behavior with the --authuser2 option.
+When working on Sun/iPlanet/Netscape IMAP servers you must use
+--proxyauth1 to enable administrative user to masquerade as another user.
+Can also be used on destination server with --proxyauth2
=head1 EXIT STATUS
@@ -560,6 +563,7 @@
$ssl1, $ssl2,
$tls1, $tls2,
$authuser1, $authuser2,
+ $proxyauth1, $proxyauth2,
$authmech1, $authmech2,
$split1, $split2,
$reconnectretry1, $reconnectretry2,
@@ -680,6 +684,14 @@
$authmech1 = uc($authmech1);
$authmech2 = uc($authmech2);
+if (defined $proxyauth1 && !$authuser1) {
+ missing_option("With --proxyauth1, --authuser1");
+}
+
+if (defined $proxyauth2 && !$authuser2) {
+ missing_option("With --proxyauth2, --authuser2");
+}
+
$authuser1 ||= $user1;
$authuser2 ||= $user2;
@@ -721,12 +733,14 @@
$debugimap1 and print "Host1 connection\n";
$imap1 = login_imap($host1, $port1, $user1, $password1,
$debugimap1, $timeout, $fastio1, $ssl1, $tls1,
- $authmech1, $authuser1, $reconnectretry1);
+ $authmech1, $authuser1, $reconnectretry1,
+ $proxyauth1);
$debugimap2 and print "Host2 connection\n";
$imap2 = login_imap($host2, $port2, $user2, $password2,
$debugimap2, $timeout, $fastio2, $ssl2, $tls2,
- $authmech2, $authuser2, $reconnectretry2);
+ $authmech2, $authuser2, $reconnectretry2,
+ $proxyauth2);
# history
@@ -1551,7 +1565,8 @@
sub login_imap {
my($host, $port, $user, $password,
$debugimap, $timeout, $fastio,
- $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_;
+ $ssl, $tls, $authmech, $authuser, $reconnectretry,
+ $proxyauth) = @_;
my ($imap);
$imap = Mail::IMAPClient->new();
@@ -1591,13 +1606,25 @@
}
}
- $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN');
+ if ($proxyauth) {
+ $imap->Authmechanism("");
+ } else {
+ $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN');
+ }
+
$imap->Authcallback(\&plainauth) if $authmech eq "PLAIN";
- $imap->User($user);
- $imap->Authuser($authuser);
- $imap->Password($password);
+ if ($proxyauth) {
+ $imap->User($authuser);
+ $imap->Authuser($authuser);
+ $imap->Password($password);
+ } else {
+ $imap->User($user);
+ $imap->Authuser($authuser);
+ $imap->Password($password);
+ }
+
unless ($imap->login()) {
my $info = "Error login: [$host] with user [$user] auth";
my $einfo = $imap->LastError || @{$imap->History}[-1];
@@ -1610,6 +1637,8 @@
$imap->login() or
die_clean("$info [LOGIN]: ", $imap->LastError, "\n");
}
+ $proxyauth && $imap->proxyauth($user);
+
print "Success login on [$host] with user [$user] auth [$authmech]\n";
return($imap);
}
@@ -2423,6 +2452,8 @@
"authmech2=s" => \$authmech2,
"authuser1=s" => \$authuser1,
"authuser2=s" => \$authuser2,
+ "proxyauth1" => \$proxyauth1,
+ "proxyauth2" => \$proxyauth1,
"split1=i" => \$split1,
"split2=i" => \$split2,
"reconnectretry1=i" => \$reconnectretry1,
@@ -2722,12 +2753,18 @@
--user1 <string> : user to login on host1. Mandatory.
--authuser1 <string> : user to auth with on host1 (admin user).
Avoid using --authmech1 SOMETHING with --authuser1.
+--proxyauth1 : Use proxyauth on host1. Requires --authuser1.
+ Required by Sun/iPlanet/Netscape IMAP servers to
+ be able to use an administrative user
--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 on host2. Default is 143.
--user2 <string> : user to login on host2. Mandatory.
--authuser2 <string> : user to auth with on host2 (admin user).
+--proxyauth2 : Use proxyauth on host2. Requires --authuser2.
+ Required by Sun/iPlanet/Netscape IMAP servers to
+ be able to use an administrative user
--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.

View file

@ -0,0 +1,111 @@
diff -urN imapsync-1.366.orig/imapsync imapsync-1.366/imapsync
--- imapsync-1.366.orig/imapsync 2010-10-30 12:24:10.965674761 +0200
+++ imapsync-1.366/imapsync 2010-10-30 14:13:31.456674582 +0200
@@ -204,6 +204,9 @@
with --authuser1 "adminuser", it will not work.
Same behavior with the --authuser2 option.
+When working on Sun/iPlanet/Netscape IMAP servers you must use
+--proxyauth1 to enable administrative user to masquerade as another user.
+Can also be used on destination server with --proxyauth2
=head1 EXIT STATUS
@@ -560,6 +563,7 @@
$ssl1, $ssl2,
$tls1, $tls2,
$authuser1, $authuser2,
+ $proxyauth1, $proxyauth2,
$authmech1, $authmech2,
$split1, $split2,
$reconnectretry1, $reconnectretry2,
@@ -680,6 +684,14 @@
$authmech1 = uc($authmech1);
$authmech2 = uc($authmech2);
+if (defined $proxyauth1 && !$authuser1) {
+ missing_option("With --proxyauth1, --authuser1");
+}
+
+if (defined $proxyauth2 && !$authuser2) {
+ missing_option("With --proxyauth2, --authuser2");
+}
+
$authuser1 ||= $user1;
$authuser2 ||= $user2;
@@ -721,12 +733,14 @@
$debugimap1 and print "Host1 connection\n";
$imap1 = login_imap($host1, $port1, $user1, $password1,
$debugimap1, $timeout, $fastio1, $ssl1, $tls1,
- $authmech1, $authuser1, $reconnectretry1);
+ $authmech1, $authuser1, $reconnectretry1,
+ $proxyauth1);
$debugimap2 and print "Host2 connection\n";
$imap2 = login_imap($host2, $port2, $user2, $password2,
$debugimap2, $timeout, $fastio2, $ssl2, $tls2,
- $authmech2, $authuser2, $reconnectretry2);
+ $authmech2, $authuser2, $reconnectretry2,
+ $proxyauth2);
# history
@@ -1551,7 +1565,8 @@
sub login_imap {
my($host, $port, $user, $password,
$debugimap, $timeout, $fastio,
- $ssl, $tls, $authmech, $authuser, $reconnectretry) = @_;
+ $ssl, $tls, $authmech, $authuser, $reconnectretry,
+ $proxyauth) = @_;
my ($imap);
$imap = Mail::IMAPClient->new();
@@ -1591,13 +1606,25 @@
}
}
- $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN');
+ if ($proxyauth) {
+ $imap->Authmechanism("");
+ } else {
+ $imap->Authmechanism($authmech) unless ($authmech eq 'LOGIN');
+ }
+
$imap->Authcallback(\&plainauth) if $authmech eq "PLAIN";
- $imap->User($user);
- $imap->Authuser($authuser);
- $imap->Password($password);
+ if ($proxyauth) {
+ $imap->User($authuser);
+ $imap->Authuser($authuser);
+ $imap->Password($password);
+ } else {
+ $imap->User($user);
+ $imap->Authuser($authuser);
+ $imap->Password($password);
+ }
+
unless ($imap->login()) {
my $info = "Error login: [$host] with user [$user] auth";
my $einfo = $imap->LastError || @{$imap->History}[-1];
@@ -1610,6 +1637,8 @@
$imap->login() or
die_clean("$info [LOGIN]: ", $imap->LastError, "\n");
}
+ $proxyauth && $imap->proxyauth($user);
+
print "Success login on [$host] with user [$user] auth [$authmech]\n";
return($imap);
}
@@ -2423,6 +2452,8 @@
"authmech2=s" => \$authmech2,
"authuser1=s" => \$authuser1,
"authuser2=s" => \$authuser2,
+ "proxyauth1" => \$proxyauth1,
+ "proxyauth2" => \$proxyauth1,
"split1=i" => \$split1,
"split2=i" => \$split2,
"reconnectretry1=i" => \$reconnectretry1,