diff options
Diffstat (limited to 'scripts/Maildir++2IMAPdir.pl')
| -rwxr-xr-x | scripts/Maildir++2IMAPdir.pl | 255 |
1 files changed, 255 insertions, 0 deletions
diff --git a/scripts/Maildir++2IMAPdir.pl b/scripts/Maildir++2IMAPdir.pl new file mode 100755 index 0000000..0ff47c1 --- /dev/null +++ b/scripts/Maildir++2IMAPdir.pl @@ -0,0 +1,255 @@ +#! /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; + } |