mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-17 08:12:48 +01:00
327 lines
11 KiB
Perl
Executable File
327 lines
11 KiB
Perl
Executable File
#!/usr/local/bin/perl
|
|
#$Id: migrate_mail2.pl,v 19991216.4 2003/06/12 21:38:33 dkernen Exp $
|
|
#
|
|
# An example of how to migrate from a Netscape server
|
|
# (which uses a slash as a separator and which does
|
|
# not allow subfolders under the INBOX, only next to it)
|
|
# to a Cyrus server (which uses a dot (.) as a separator
|
|
# and which requires subfolders to be under "INBOX").
|
|
# There are also some allowed-character differences taken
|
|
# into account but this is by no means complete AFAIK.
|
|
#
|
|
# This is an example. If you are doing mail migrations
|
|
# then this may in fact be a very helpful example but
|
|
# it is unlikely to work 100% correctly as-is.
|
|
# A good place to start is by testing a rather large-volume
|
|
# transfer of actual mail from the source server with the
|
|
# -v option turned on and redirect output to a file for
|
|
# perusal. Examine the output carefully for unexpected
|
|
# results, such as a number of messages being skipped because
|
|
# they're already in the target folder when you know darn
|
|
# well this is the first time you ran the script. This
|
|
# would indicate an incompatibility with the logic for
|
|
# detecting duplicates, unless for some reason the source
|
|
# mailbox contains a lot of duplicate messages to begin with.
|
|
# (The latter case is an example of why you should use an
|
|
# actual mailbox stuffed with actual mail for test; if you
|
|
# generate test messages and then test migrating those you
|
|
# will only prove that your test messages are migratable.
|
|
#
|
|
# Also, you may need to play with the rules
|
|
# for translating folder names based on what kind of
|
|
# names your target server and source server support.
|
|
#
|
|
# You may also need to play with the logic that determines
|
|
# whether or not a message has already been migrated,
|
|
# especially if your source server has messages that
|
|
# did not come from an SMTP gateway or something like that.
|
|
#
|
|
# Some servers allow folders to contain mail and subfolders,
|
|
# some allow folders to only contain either mail or subfolders.
|
|
# If you are migrating from a "mixed use" type to a "single use"
|
|
# type server then you'll have to figure out how to deal
|
|
# with this. (This script deals with this by creating folders like
|
|
# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail"
|
|
# to hold mail if the source folder contains mail and subfolders
|
|
# and the target server supports only single-use folders.
|
|
# You may not choose a different strategy.)
|
|
#
|
|
# Finally, it's possible that in some server-to-server
|
|
# copies, the source server supports messages that the
|
|
# target server considers unacceptable. For example, some
|
|
# but not all IMAP servers flat out refuse to accept
|
|
# messages with "base newlines", which is to say messages
|
|
# whose lines are match the pattern /[^\r]\n$/. There is
|
|
# no logic in this script that deals with the situation;
|
|
# you will have to identify it if it exists and figure
|
|
# out how you want to handle it.
|
|
#
|
|
# This is probably not an exhaustive list of issues you'll
|
|
# face in a migration, but it's a start.
|
|
#
|
|
# If you're just migrating from an old version to a newer
|
|
# version of the same server then you'll probably have
|
|
# a much easier time of it.
|
|
#
|
|
#
|
|
|
|
use Mail::IMAPClient;
|
|
use Data::Dumper;
|
|
use IO::File;
|
|
use File::Basename ;
|
|
use Getopt::Std;
|
|
use strict;
|
|
use vars qw/ $opt_B $opt_D $opt_T $opt_U
|
|
$opt_W $opt_b $opt_d $opt_h
|
|
$opt_t $opt_u $opt_w $opt_v
|
|
$opt_s $opt_S $opt_W $opt_p
|
|
$opt_P $opt_f $opt_F $opt_m
|
|
$opt_M
|
|
/;
|
|
|
|
getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:');
|
|
|
|
if ( $opt_h ) {
|
|
print STDERR <<"HELP";
|
|
|
|
$0 - an example script demonstrating the use of the Mail::IMAPClient's
|
|
migrate method.
|
|
|
|
Syntax:
|
|
$0 -s source_server -u source_user -w source_password -p source_port \
|
|
-d debug_source -f source_debugging_file -b source_buffsize \
|
|
-t source_timeout -m source_auth_mechanism \
|
|
-S target_server -U target_user -W target_password -P target_port \
|
|
-D debug_target -F target_debugging_file -B target_buffsize \
|
|
-T target_timeout -M target_auth_mechanism \
|
|
-v
|
|
|
|
where "source" refers to the "copied from" mailbox, target is the
|
|
"copied to" mailbox, and -v turns on verbose output.
|
|
Authentication mechanisms default to "PLAIN".
|
|
|
|
HELP
|
|
exit;
|
|
}
|
|
$opt_v and ++$|;
|
|
print "$0: Started at ",scalar(localtime),"\n" if $opt_v;
|
|
|
|
$opt_p||=143;
|
|
$opt_P||=143;
|
|
|
|
# Make a connection to the source mailbox:
|
|
my $imap = Mail::IMAPClient->new(
|
|
Server => $opt_s,
|
|
User => $opt_u,
|
|
Password=> $opt_w,
|
|
Uid => 1,
|
|
Port => $opt_p,
|
|
Debug => $opt_d||0,
|
|
Buffer => $opt_b||4096,
|
|
Fast_io => 1,
|
|
( $opt_m ? ( Authmechanism => $opt_m) : () ),
|
|
Timeout => $opt_t,
|
|
($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()),
|
|
) or die "$@";
|
|
|
|
# Make a connection to the target mailbox:
|
|
my $imap2 = Mail::IMAPClient->new(
|
|
Server => $opt_S,
|
|
User => $opt_U,
|
|
Password=> $opt_W,
|
|
Port => $opt_P,
|
|
Uid => 1,
|
|
Debug => $opt_D||0,
|
|
( $opt_M ? ( Authmechanism => $opt_M) : () ),
|
|
($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()),
|
|
Buffer => $opt_B||4096,
|
|
Fast_io => 1,
|
|
Timeout => $opt_T, # True value
|
|
) or die "$@";
|
|
|
|
# Turn off buffering on debug files:
|
|
$imap->Debug_fh->autoflush;
|
|
$imap2->Debug_fh->autoflush;
|
|
|
|
# Get folder hierarchy separator characters from source and target:
|
|
my $sep1 = $imap->separator;
|
|
my $sep2 = $imap2->separator;
|
|
|
|
# Find out if source and target support subfolders inside INBOX:
|
|
my $inferiorFlag1 = $imap->is_parent("INBOX");
|
|
my $inferiorFlag2 = $imap2->is_parent("INBOX");
|
|
|
|
# Set up a test folders to see if the source and target support mixed-use
|
|
# folders (i.e. folders with both subfolders and mail messages):
|
|
my $testFolder1 = "Migrate_Test_$$" ; # Ex: Migrate_Test_1234
|
|
$testFolder1 = $inferiorFlag2 ?
|
|
"INBOX" . $sep2 . $testFolder1 :
|
|
$testFolder1 ;
|
|
|
|
# The following folder will be a subfolder of $testFolder1:
|
|
my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ;
|
|
$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2 : $testFolder2 ;
|
|
|
|
$imap2->create($testFolder2) ; # Create the subfolder first; RFC2060 dictates that
|
|
# the parent folder should be created at the same time
|
|
|
|
|
|
# The following line inspired the selectable method. It was also made obsolete by it,
|
|
# but I'm leaving it as is to demonstrate use of lower-level method calls:
|
|
my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1;
|
|
|
|
# Repeat the above with the source mailbox:
|
|
$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ;
|
|
$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1 : $testFolder1 ;
|
|
|
|
$imap->create($testFolder2) ;
|
|
|
|
my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1;
|
|
|
|
print "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ",
|
|
( defined($inferiorFlag1) ? "allows " : "does not allow "),
|
|
"children in the INBOX. It supports ",
|
|
($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v;
|
|
|
|
print "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ",
|
|
( defined($inferiorFlag2) ? "allows " : "does not allow "),
|
|
"children in the INBOX. It supports ",
|
|
($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v;
|
|
|
|
for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);}
|
|
|
|
my($totalMsgs, $totalBytes) = (0,0);
|
|
|
|
# Now we will migrate the folder. Here we are doing one message at a time
|
|
# so that we can do more granular status reporting and error checking.
|
|
# A lazier way would be to do all the messages in one migrate method call
|
|
# (specifying "ALL" as the message number) but then we wouldn't be able
|
|
# to print out which message we were migrating and it would be a little
|
|
# bit tougher to control checking for duplicates and stuff like that.
|
|
# We could also check the size of the message on the target right after
|
|
# the migrate as an extra safety check if we wanted to but I didn't bother
|
|
# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!)
|
|
|
|
# Iterate over all the folders in the source mailbox:
|
|
for my $f ($imap->folders) {
|
|
# Select the folder on the source side:
|
|
$imap->select($f) ;
|
|
|
|
# Massage the foldername into an acceptable target-side foldername:
|
|
my $targF = "";
|
|
my $srcF = $f;
|
|
$srcF =~ s/^INBOX$sep1//i;
|
|
if ( $inferiorFlag2 ) {
|
|
$targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ;
|
|
} else {
|
|
$targF = $srcF ;
|
|
}
|
|
|
|
$targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2;
|
|
$targF =~ tr/#\$\& '"/\@\@+_/;
|
|
if ( $imap->is_parent($f) and !$mixedUse2 ) {
|
|
$targF .= "_mail" ;
|
|
}
|
|
print "Migrating folder $f to $targF\n" if $opt_v;
|
|
|
|
# Create the (massaged) folder on the target side:
|
|
unless ( $imap2->exists($targF) ) {
|
|
$imap2->create($imap2->Massage($targF))
|
|
or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next;
|
|
}
|
|
|
|
# ... and select it
|
|
$imap2->select($imap2->Massage($targF))
|
|
or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next;
|
|
|
|
# now that we know the target folder is selectable, we can close it again:
|
|
$imap2->close;
|
|
my $count = 0;
|
|
my $expectedTotal = $imap->message_count($f) ;
|
|
|
|
# Now start iterating over all the messages on the source side...
|
|
for my $msg ($imap->messages) {
|
|
++$count;
|
|
my $h = "";
|
|
# Get some basic info about the message:
|
|
eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]};
|
|
my $tsize = $imap->size($msg);
|
|
my $ret = 0 ; my $h2 = [];
|
|
|
|
# Make sure we didn't already migrate the message in a previous pass:
|
|
$imap2->select($targF);
|
|
if ( $tsize and $h and $h2 = $imap2->search(
|
|
HEADER => 'Message-id' => $imap2->Quote($h),
|
|
NOT => SMALLER => $tsize,
|
|
NOT => LARGER => $tsize
|
|
)
|
|
) {
|
|
print
|
|
"Skipping $f/$msg to $targF. ",
|
|
"One or more messages (" ,join(", ",@$h2),
|
|
") with the same size and message id ($h) ",
|
|
"is already on the server. ",
|
|
"\n"
|
|
if $opt_v;
|
|
$imap2->close;
|
|
|
|
} else {
|
|
|
|
print
|
|
"Migrating $f/$msg to $targF. ",
|
|
"Message #$count of $expectedTotal has ",
|
|
$tsize , " bytes.",
|
|
"\n" if $opt_v;
|
|
$imap2->close;
|
|
|
|
# Migrate the message:
|
|
my $ret = $imap->migrate($imap2,$msg,"$targF") ;
|
|
$ret and ( $totalMsgs++ , $totalBytes += $tsize);
|
|
$ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ;
|
|
}
|
|
}
|
|
}
|
|
|
|
print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n"
|
|
if $opt_v;
|
|
exit;
|
|
|
|
|
|
=head1 AUTHOR
|
|
|
|
David J. Kernen
|
|
|
|
The Kernen Group, Inc.
|
|
|
|
imap@kernengroup.com
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
This example and Mail::IMAPClient are Copyright (c) 2003
|
|
by The Kernen Group, Inc. All rights reserved.
|
|
|
|
This example is distributed with Mail::IMAPClient and
|
|
subject to the same licensing requirements as Mail::IMAPClient.
|
|
|
|
imtest is a utility distributed with Cyrus IMAP server,
|
|
Copyright (c) 1994-2000 Carnegie Mellon University.
|
|
All rights reserved.
|
|
|
|
=cut
|
|
|
|
#$Log: migrate_mail2.pl,v $
|
|
#Revision 19991216.4 2003/06/12 21:38:33 dkernen
|
|
#
|
|
#Preparing 2.2.8
|
|
#Added Files: COPYRIGHT
|
|
#Modified Files: Parse.grammar
|
|
#Added Files: Makefile.old
|
|
# Makefile.PL Todo sample.perldb
|
|
# BodyStructure.pm
|
|
# Parse.grammar Parse.pod
|
|
# range.t
|
|
# Thread.grammar
|
|
# draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
|
|
# rfc2221.txt rfc2359.txt rfc2683.txt
|
|
#
|