#!/usr/bin/perl -w
#
# Copies a user's mailbox to a new mailbox
#

if ($#ARGV < 1) {
	print "Usage: $0 old_username new_username\n";
	print "  Copies old_username's mailbox to new_username.\n";
	print "  new_username's mailbox should not already exist.\n";
	exit(-1);
}

use IMAP::Admin;
use Mail::IMAPClient;

require "/private/admin/acct/email/prefs.pl";
require "/private/admin/acct/email/utils.pl";

my $imap = IMAP::Admin->new('Server' => $prefs{'cyrushost'},
			'Login' => $prefs{'cyrususer'},
			'Password' => $prefs{'cyruspass'},
			);

if (! $imap) {
	print "Error connecting to IMAP server.\n";
	exit;
}

my $oldusername = $ARGV[0];
my $newusername = $ARGV[1];
my $oldmailbox = "user.$oldusername";
my $newmailbox = "user.$newusername";


# Make sure that old mailbox exists
if (! $imap->list($oldmailbox)) {
	print "Error: mailbox for $oldusername not found.\n";
	exit;
}


# Create the new mailbox
my $rv = &createmailbox($imap, $newmailbox);

if ($rv ne "success") {
	print "$rv\n";
	exit;
}
else {
	print "Successfully created inbox for $newusername\n";
}


# Set the quota on the new mailbox
$rv = &setmailquota($imap, $newmailbox, $prefs{'mailquota'});
if ($rv ne "success") {
	print "$rv\n";
}
else {
	print "Successfully set quota for $newusername to $prefs{'mailquota'}\n";
}


# Add rights for "cyrus" user to old and new mailbox
$rv = $imap->set_acl($oldmailbox, "cyrus", "lrswipcda");
if ($rv != 0) {
	print "Error setting acl on old mailbox: " . $imap->{'Error'} . "\n";
	exit;
}
$rv = $imap->set_acl($newmailbox, "cyrus", "lrswipcda");
if ($rv != 0) {
	print "Error setting acl on new mailbox: " . $imap->{'Error'} . "\n";
	exit;
}


# Open connection for Mail::IMAPClient
my $imap1 = Mail::IMAPClient->new(Server => $prefs{'cyrushost'},
				User => $prefs{'cyrususer'},
				Password => $prefs{'cyruspass'},
				Uid => 1,
				Peek => 1,
				Buffer => 4096,
				Fast_io => 1,
				) or die("Cannot connect to imap server - $!");

my $search = $oldmailbox . ".*";
my $targetf;
my @folders;
foreach my $f (&getfolderlist($imap1, $oldmailbox)) {
#	print "$f\n";

	# Strip quotes
	$f =~ s/"//g;

	# Add acl on source so we can read it
	$rv = $imap->set_acl($f, "cyrus", "lrswipcda");
	if ($rv != 0) {
		print "Error setting acl on $f: " . $imap->{'Error'} . "\n";
		next;
	}

	# Select the folder on the source side
	$imap1->select($f);

	# Get target folder name
	if ($f =~ /^user\.$oldusername(.*)$/) {
		$targetf = "user.$newusername$1";
	}

	# Push all the folder names into an array so we can remove
	# the "cyrus" acls later
	push @folders, $f, $targetf;

	print "Copying folder $f to $targetf\n";

	# Create folder on target side if it does not exist
	if (! $imap->list($targetf)) {
		# Created folders inherit acl of parent, so no need to add cyrus acl
		$rv = $imap->create($targetf);
		if ($rv != 0) {
			print "Error creating target folder $targetf: " . $imap->{'Error'} . "\n";
			next;
		}
	}

	# Now copy the selected folder
	# Skip folders with zero messages or the copy will appear to error
	next if ($imap1->message_count == 0);

	my $uidlist = $imap1->copy($targetf, $imap1->messages);
	if (defined($uidlist)) {
#		print "Copied the following UIDs to $targetf: $uidlist\n";
	}
	else {
		print "Error copying messages to $targetf\n";
		next;
	}
}


# Remove cyrus acl from folder
foreach $f (@folders) {
	$rv = $imap->delete_acl($f, "cyrus");
	if ($rv != 0) {
		print "Error deleting acl on $f: " . $imap->{'Error'} . "\n";
		next;
	}
}


$imap1->logout;
$imap->close;



##############################
# Return a list of folders
#
# The built in folders() function in Mail::IMAPClient
# can't figure out the folder separator when you are
# connected as a user without a mailbox (like user "cyrus"),
# so we duplicate a bunch of their code here with the
# assumption that the separator is (.).
#
##############################
sub getfolderlist {
	my ($imap, $mailbox) = @_;

	# Get the "root" mailbox first, then any subfolders
	my @list = $imap->list(undef, $mailbox);
	push @list, $imap->list(undef, "$mailbox" . ".*");

        my $m;
	my @folders;

        for ($m = 0; $m < scalar(@list); $m++ ) {
                if ($list[$m] && $list[$m] !~ /\x0d\x0a$/ ) {
                        $list[$m] .= $list[$m+1] ;
                        $list[$m+1] = "";
                        $list[$m] .= "\x0d\x0a" unless $list[$m] =~ /\x0d\x0a$/;
                }

                push @folders, $1||$2
                        if $list[$m] =~
                        /       ^\*\s+LIST               # * LIST
                                \s+\([^\)]*\)\s+         # (Flags)
                                (?:"[^"]*"|NIL)\s+       # "delimiter" or NIL
                                (?:"([^"]*)"|(.*))\x0d\x0a$  # Name or "Folder name" 
                        /ix;
                $folders[-1] = '"' . $folders[-1] . '"' if $1;
        }

	return @folders;
}




