path: root/scripts/Maildir++2IMAPdir.pl

#! /usr/bin/perl -w
#
# Maildir++2IMAPdir.pl (v0.2) - convert Maildir++ depots to IMAPdir 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 Maildir 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 Maildir++ depot to an IMAPdir depot.  It is 
# invoked as follows:
#	Maildir++2IMAPdir Maildir IMAPdir
# where "-d" is used for printing debuggin information.
# Running this script produces the following directories:
#	Maildir.bak	- The original Maildir (untouched)
#	IMAPdir		- the new IMAPdir mail depot 
#	Maildir		- a new diretory with links into IMAPdir
# The purpose of the new Maildir directory is allow the conversion of 
# .qmail* and related scripts to be postponed until a less stressful time.
#
# The Maildir.bak directory can be deleted once you are comfortable that the
# IMAPdir is operational.  The Maildir directory can be removed once you are
# comfortable that you have converted all the mail delivery files.
#
# 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.
#

#
# We start by making sure that we are called correctly.
# Note that "Maildir" and "IMAPdir" will be supplied if they are missing.
#
$USAGE = "Usage: $0 [-d] [Maildir [IMAPdir]]\n";
$DEBUG = shift if @ARGV && $ARGV[0] eq "-d";
die $USAGE if grep /^-/, @ARGV;
$Maildir = shift || "Maildir";
$IMAPdir = shift || "IMAPdir";
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 $Maildir or die "Can't stat $Maildir: $!";
$)=$stats[5];			# Change gid  (when root) 
$>=$stats[4];			# Change user (must do after setgid)
$mode = 07777 & $stats[2];
maildir("$Maildir")		or  die "$Maildir not a Maildir";
-e $IMAPdir			and die "$IMAPdir exists";
$Maildir_bak = "$Maildir.bak";
-e $Maildir_bak 		and die "$Maildir_bak exists";
$SHADOWdir = "$Maildir-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 MAILDIR, $Maildir;
for my $folder (readdir MAILDIR) {
    next if $folder =~ /^[.]{2}$/;		# skip ".."
    next unless $folder =~ /^[.]/;
    my($source) = "$Maildir/$folder";
    my($target) = $IMAPdir."/".mapname($folder);
    next unless maildir($source);
    if (-l $source)	{ $linked{$source}  = $target; }
    else		{ $IMAPdir{$source} = $target; }
    $SHADOW{$target} = "$SHADOWdir/$folder";
    }
close MAILDIR;
if ($DEBUG) {
    print "IMAPdirs:\n";  print "\t$_ -> $IMAPdir{$_}\n" for sort keys %IMAPdir;
    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 .subscribe 
#
mkdir $SHADOWdir 		or  die "Can't make $SHADOWdir: $!";
mkdir $IMAPdir			or  die "Can't make $IMAPdir: $!";
migratefolder($_,$IMAPdir{$_}) for keys %IMAPdir;
linkfolder($_,$linked{$_}) for keys %linked;
symlink(abspath($_),$SHADOW{$_}) for keys %SHADOW;
symlink(abspath("$IMAPdir/INBOX/$_"),"$SHADOWdir/$_") for ("tmp","new","cur");
cpfiles(<$Maildir/.subscribed>,$IMAPdir);
chmod $mode, $SHADOWdir		or  die "Can't chmod $mode $SHADOWdir: $!";
chmod $mode, $IMAPdir		or  die "Can't chmod $mode $IMAPdir: $!";

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

#
# maildir returns true if the suplied directory looks like IMAPdir
#
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 Maildir++ folder name to a IMAPdir folder name
#
sub mapname {
    my ($folder) = shift;
    return "INBOX" if $folder =~ /^[.]?$/;
    return "INBOX$folder" if $folder =~ /^[.]/;
    return "BOTCHED.$folder";
    }
#
#
# migratefolder migrates a Maildir folder from a Maildir++ depot to
# an IMAPdir depot
#
# Note that linkfolder should be used if the Maildir++ 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: $!";
    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 Maildir); in which case we need to make it point to the
#	new folder in the IMAPdir 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 IMAPdir 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/(.*)};
	$relpath = "." unless $relpath;
	print "$relpath\n\t" if $DEBUG;
	if ($relpath eq "" or $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;
    }