path: root/scripts/IMAPdir2Maildir++.pl

#! /usr/bin/perl -w
#
# IMAPdir2Maildir++.pl (v0.2) - convert IMAPdir++ depots to Maildir depots
# Copyright (C) 2004  Henry Baragar mailto:Henry.Baragar@Instantiated.ca
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
# WARNING:
#	All activity on the IMAPdir must be stopped before running this
#	script.  MAIL MAY BE LOST if you do not.  This includes both MTA's
#	(e.g. qmail, postfix) and MUA's (e.g. bincimap).
#
# WARNING:
#	There is no attempt to convert .qmail* files, .mailfilter or any 
# 	other files that affect mail delivery:  that is YOUR RESPONSIBILITY.
#
# This script converts a IMAPdir++ depot to an Maildir depot.  It is 
# invoked as follows:
#	IMAPdir2Maildir++ [-d] [IMAPdir [Maildir]]
# where "-d" is used for printing debuggin information.
# Running this script produces the following directories:
#	IMAPdir.bak	- The original IMAPdir (untouched)
#	Maildir		- the new Maildir mail depot 
#	IMAPdir		- a new diretory with links into Maildir
# The purpose of the new IMAPdir directory is allow the conversion of 
# .qmail* and related scripts to be postponed until a less stressful time.
#
# The IMAPdir.bak directory can be deleted once you are comfortable that the
# Maildir is operational.  The IMAPdir directory can be removed once you are
# comfortable that you have converted all the mail delivery files.
#
# NOTE:
#	Hidden folders, those beginning with a ".", in the IMAPdir 
# 	depot are migrated to subfolders of INBOX.HIDDEN (which are 
#	different from subdirectories) in the Maildir++ depot. 
#	Although we try, we do not guarantee to map these correcly 
#	in the .bincimap-subscribed folder.
#
# NOTE:
#	IMAPdir supports folders that are siblings of the INBOX, 
#	whereas Maildir++ does not.  Consquently, we migrate all 
#	of the INBOX sibling folders in IMAPdir to subfolders of
#	INBOX.SIBLING in the Maildir++ depot.  Although we try, 
#	we do not guarantee to map these correcly in the 
#	.bincimap-subscribed folder.
#
# NOTE:
#	When run invoked from root, this script changes ID to the
#	owner of the IMAPdir as soon as possible.  That is, most
#	of the script is not run as root.
#
# NOTE:
#	This script assumes that the INBOX is spelled as "INBOX" (all caps).

#
# We start by making sure that we are called correctly.
# Note that "IMAPdir" and "Maildir" will be supplied if they are missing.
#
$USAGE = "Usage: $0 [-d] [IMAPdir [Maildir]]\n";
$DEBUG = shift if @ARGV && $ARGV[0] eq "-d";
die $USAGE if grep /^-/, @ARGV;
$IMAPdir = shift || "IMAPdir";
$Maildir = shift || "Maildir";
die $USAGE if $ARGV[0];

#
# Make sure the environment is ready for conversion:
# - drop root privileges
# - make sure we don't clobber anything
# - make sure that we don't get messed up by a previous run that was aborted
#
@stats  = stat $IMAPdir or die "Can't stat $IMAPdir: $!";
$)=$stats[5];			# Change gid  (when root) 
$>=$stats[4];			# Change user (must do after setgid)
$mode = 07777 & $stats[2];
-d $IMAPdir			or  die "$IMAPdir not a directory";
maildir("$IMAPdir/INBOX")	or  die "$IMAPdir/INBOX not a Maildir";
-e $Maildir			and die "$Maildir exists";
$IMAPdir_bak = "$IMAPdir.bak";
-f $IMAPdir_bak 		and die "$IMAPdir_bak exists";
$SHADOWdir = "$IMAPdir-conv-$$";
-e $SHADOWdir			and die "$SHADOWdir exists";

#
# Find the source folders that need migrating and determine their targets.
# NB.  Linked folders need to be migrated after real folders since we might
#      need to create a real folder before creating the link 
#
opendir IMAPDIR, $IMAPdir;
for my $folder (readdir IMAPDIR) {
    next if $folder =~ /^[.]{1,2}$/;		#skip "." and ".."
    my($source) = "$IMAPdir/$folder";
    $mapname = mapname($folder);
    my($target) = "$Maildir/$mapname";
    next unless maildir($source);
    if (-l $source)	{ $linked{$source}  = $target; }
    else		{ $Maildir{$source} = $target; }
    $SHADOW{$target} = "$SHADOWdir/$folder";
    $mapping{$folder} = "INBOX$mapname";
    }
close IMAPDIR;
if ($DEBUG) {
    print "Maildirs:\n";  print "\t$_ -> $Maildir{$_}\n" for sort keys %Maildir;
    print "Links:\n";     print "\t$_ <- $linked{$_}\n" for sort keys %linked;
    print "Shadow:\n";    print "\t$_ <- $SHADOW{$_}\n" for sort keys %SHADOW;
    }

#
# Migrate the folders, create the links and copy the .binc* files
#
mkdir $SHADOWdir 		or  die "Can't make $SHADOWdir: $!";
mkdir $Maildir			or  die "Can't make $Maildir: $!";
migratefolder($_,$Maildir{$_}) for keys %Maildir;
linkfolder($_,$linked{$_}) for keys %linked;
symlink(abspath($_),$SHADOW{$_}) for keys %SHADOW;
fixsubscribed($IMAPdir,$Maildir,%mapping);
chmod $mode, $SHADOWdir		or  die "Can't chmod $mode $SHADOWdir: $!";
chmod $mode, $Maildir		or  die "Can't chmod $mode $Maildir: $!";

#
# Success! (since we would have died if we had an error)
#
rename $IMAPdir, $IMAPdir_bak;
rename $SHADOWdir, $IMAPdir;

#
# maildir returns true if the suplied directory looks like Maildir
#
sub maildir {
    my ($dir) = shift;
    return unless -d $dir;
    return unless -d "$dir/tmp" && -d "$dir/new" && -d "$dir/cur";
    return $dir;
    }

#
# mapname maps a IMAPdir folder name to a Maildir++ folder name
#
sub mapname {
    my ($folder) = shift;
    return $1 || "" if $folder =~ /^INBOX(\..*)?/;
    return ".HIDDEN$folder" if $folder =~ /^\./;
    return ".SIBLING.$folder";
    }
#
#
# migratefolder migrates a Maildir folder from an IMAPdir  depot to
# a Maildir depot
#
# Note that linkfolder should be used if the IMAPdir Maildir is a symbolic link
# Note that we link data files to preserve space (since they do not change).
#
sub migratefolder {
    my ($source,$target) = @_;
    mkdir $target || die "Can't create $target: $!"
	unless $source =~ m{/INBOX$}; 
    for my $subdir (("tmp","cur","new")) {
	my $tsub = "$target/$subdir";
	my $ssub = "$source/$subdir";
	mkdir $tsub or die "Can't create $tsub: $!";
	opendir SUBDIR, $ssub;
	for $file (readdir SUBDIR) {
	    next if $file =~ /^[.]{1,2}$/;		# skip "." and ".."
	    my ($sfile) = "$ssub/$file";
	    my ($tfile) = "$tsub/$file";
	    next unless -f $sfile;
	    link($sfile, $tfile) or die "Can't create link $sfile $tfile: $!";
	    }
	closedir SUBDIR;
	copyperms($ssub,$tsub);
	}
    cpfiles(bincfiles($source), "$target/");
    copyperms($source,$target);
    }

#
# copyperms copies the perms of one maildir to another
#
sub copyperms {
    my ($template,$target) = @_;
    my ($mode)  = 0777& (stat $template)[2] or die "stat'ing $template: $!";
    chmod $mode, $target;
    return if -l $target;
    chmod $mode, "$target/tmp", "$target/new", "$target/cur";
    }

#
# linkfolder
#
# Doing the right thing for symbolic links is tricky.
# There are three cases:
#   1.  The link points to another folder in the source's parents directory 
#	(i.e. the IMAPdir); in which case we need to make it point to the
#	new folder in the Maildir directory
#   2.	The link points to a subsubdirectory (or deeper) of the source's 
#	parent directory; in which case we need to copy the directory to
#	the Maildir directory (effectively eliminating the link)
#   3.	The link points somewhere else outside the source's parent directory;
#       in which case we simply make a new link to point to that directory
#
sub linkfolder {
    my ($source,$target) = @_;
    my ($abspath) = abspath($source);
    my ($sparent) = "$source/";
    $sparent =~ s{[^/]*/$}{};
    $sparent = abspath($sparent);
    print "$source->$target:\n\t$abspath\n\t$sparent\n\t" if $DEBUG;
    if ($abspath =~ m{^$sparent/}) {
        my($relpath) = $abspath =~ m{^$sparent/(.*)};
	print "$relpath\n\t" if $DEBUG;
	if ($relpath =~ m{^[^/]*$}) {
	    print "  case 1  \n" if $DEBUG;
	    symlink mapname($relpath)||"." , $target;
	    }
	else {
	    print "  case 2  \n" if $DEBUG;
	    migratefolder($source,$target);
	    }
	}
    else {
	print "  case 3  \n" if $DEBUG;
	symlink $abspath, $target;
	}
    }

#
# abspath determines the absolute path of a path, particular one that is 
# a symbolic link
#
sub abspath {
    my ($path) = @_;
    my ($cwd) = `pwd`;
    chomp $cwd;
    chdir $path or die "Can't cd to $path: $!";
    my ($abspath) = `pwd`;
    chomp $abspath;
    chdir $cwd or die "Can't cd to $cwd: $!";
    return $abspath;
    }

#
# cpfiles just calls the system cp
#
sub cpfiles {
    return if @_ < 2;
    system "cp", "-p", @_;
    }

#
# binfiles returns the list of binc* files in the supplied directory
#
sub bincfiles {
    my ($dir) = shift;
    return unless -d $dir;
    opendir DIR, $dir;
    my @bincfiles = grep /^binc/, readdir DIR;
    close DIR;
    return grep {s{^}{$dir/}} @bincfiles;
    }

#
# fixsubscribed
# 
# Creates a new .binc-subscribed file mapping old names to new names
# (for those cases where the mapping was not one-to-one).
#
sub fixsubscribed {
    my ($IMAPdir,$Maildir,%dotmapping) = @_;
    # change the files system separator to the (Binc) IMAP separator
    my %mapping;
    while (my ($key,$value) = each %dotmapping) {
	$key =~ s{[.]}{/}g;
	$value =~ s{[.]}{/}g;
	print "$key=>$value\n" if $DEBUG;
	$mapping{$key} = $value;
	}
    return unless open IMAPDIR, "$IMAPdir/.subscribed";
    open MAILDIR, ">$Maildir/.subscribed"
	or die "Can't open $Maildir/.subscribed: $!";
    while (<IMAPDIR>) {
	chomp;
	s{^/*}{};	# Remove leading "/"s
	s{/*$}{};	# Remove trailing "/"s
	my $mapping = $mapping{$_} || $_;
	print MAILDIR "$mapping\n";
	}
    close IMAPDIR;
    close MailDIR;
    }