#!/usr/bin/perl -w
# 
# imapcreate: create IMAP mailboxes with quotas
#			 Reads user names from standard input.
# originally found on http://cyrus-utils.sourceforge.net
# © 2001 Garry Mills  
# 
# enhanced by Clément "nodens" Hermann <clement.hermann@free.fr>
#
# I'd like to consider this as GPL'd (cf www.gnu.org), but won't add any
# copyright without the original author's consent.
# last modification : 2004/11/23
# Changes : 
# 2005/04/19	- Added non-0 exit code on error or warning
# 2005/03/31	- Finally found out the original author's name.
# 2004/11/23	- removed LOGIN as a default mech, now use cyrus' default
#		- Added --auth option to specify mech
#
# TODO : fix STDIN collision when reading password AND mailboxes name from STDIN
# 
use Getopt::Long;
use Cyrus::IMAP::Admin;
use strict;

# CLI options
my ($debug,$user,$pass,$quota,@part,$useunixhierarchy,@mailboxes,$delete,$cyrus,$authmech);

sub usage {
  print "imapcreate - create IMAP mailboxes with quotas\n";
  print "  usage:\n";
  print "	imapcreate [-d] [-u user] [--auth mechanism] [-p pass] [-m mailbox1[,mailbox2][,mailbox<n>]] [-q quota] [-t partition:list]\n";
  print "	[-s] [-v] <server>\n";
  print "\n";
  print "if -s is set, we'll use the unix hierarchy separator (see imapd.conf(1))\n";
  print "if -d is set, we'll delete mailboxes instead of creating them\n";
  print "You can use M or ,m to specify quotas. e.g. 10M. By default,\n";
  print "the quota is expressed in Kbytes.\n";
  print "If no password is submitted with -p, we'll prompt for one.\n";
  print "if no mailbox name is specified with -m, read user names from standard input\n";
  print "if -v is set, we'll run in debug mode, and print information on stdout\n";
  print "\n";
  print "The default mechanism is used for authentication. If you need another\nmechanism, (try LOGIN), use --auth <mechanism> option\n";
  print "\n";
  print "  example: \n";
  print "	imapcreate -u cyradm -m foo,bar,joe -q 50000 -t p1:p2 mail.testing.umanitoba.ca\n";
  print "\n";
  exit 0;
}

# Create a mailbox... usage : &CreateMailBox(user,partition[,quota]).
# You have to be authentified already. We use "$cyrus" as the connection name.
# partition can be 'default'
sub CreateMailBox {
	my $mbuser = $_[0];
	my $mbpart = $_[1];
	my $mbquota = $_[2];
	my $retval = 0;

	print "Creating $mbuser on $mbpart\n" if $debug;
	if ($mbpart eq 'default') {
	$cyrus->createmailbox($mbuser);
	}
	else {
	$cyrus->createmailbox($mbuser, $mbpart);
	}
	if ($cyrus->error) {
		warn $cyrus->error;
		$retval = 1;
	}

	# Set the quota
	if ($mbquota) {
		print "Setting quota for $mbuser to $mbquota\n" if $debug;
		$cyrus->setquota($mbuser, 'STORAGE', $mbquota);
		if ($cyrus->error) {
			warn $cyrus->error;
			$retval = 1;
	    	}
	}
	return $retval;
}

# Delete a mailbox. Usage: $DeleteMailBox($user)
# Assuming we use $user as the admin.
sub DeleteMailBox {
	my $mbuser = $_[0];
	my $delacl = "c";
	my $retval = 0;
	
	print "Deleting $mbuser\n" if $debug;
	$cyrus->setaclmailbox($mbuser, $user, $delacl);
	$cyrus->deletemailbox($mbuser);
	if ($cyrus->error) {
		warn $cyrus->error;
		$retval = 1;
	}
	return $retval;
}

GetOptions( "d|delete" => \$delete, 
	    "u|user=s" => \$user, 
	    "auth=s" => \$authmech, 
	    "p|pass=s" => \$pass, 
	    "m|mailboxes=s" => \@mailboxes, 
	    "q|quota=s" => \$quota,
	    "s|UnixHierarchy" => \$useunixhierarchy, 
	    "t|part=s" => \@part, 
	    "v|verbose" => \$debug );

@part = split(/:/, join(':', @part));
push @part, 'default' unless @part;
my $pn = 0;
@mailboxes = split(/,/, join(',', @mailboxes));

my $server = shift(@ARGV) if (@ARGV);
usage unless $server;

# quotas formatting:
if ($quota) {
	if ($quota =~ /^(\d+)([mk]?)$/i) {
		my $numb = $1;
		my $letter = $2;
		if ($letter =~ /^m$/i) {
			$quota = $numb * 1024;
			print "debug: quota=$quota\n" if $debug;
		} elsif ($letter =~ /^k$/i) {
			$quota = $numb;
			print "debug: quota=$quota\n" if $debug;
		} else {
			die "malformed quota: $quota (must be at least one digit eventually followed by m, M, k or K\n";
#			$quota = $numb;
#			print "debug: quota=$quota\n" if $debug;
		}
	} else {
		die "malformed quota: $quota (must be at least one digit eventually followed by m, M, k or K\n";
	}
}

# Authenticate
$cyrus = Cyrus::IMAP::Admin->new($server);

if ($authmech) {
	$cyrus->authenticate(-mechanism => $authmech, 
			-user => $user,
	 		-password => $pass);
} else {
	$cyrus->authenticate(
			-user => $user,
	 		-password => $pass);
}	
die $cyrus->error if $cyrus->error;

# if there isn't any mailbox defined yet, get them from standard input
if (! (defined $mailboxes[0])) { 
	# For all users
	while (<>) {
		chomp;
		my $mbox = $_;
		push @mailboxes, $mbox;
	}
}

# create/delete mailboxes for each user
my $return = 0;
foreach my $mailbox (@mailboxes) {
	if ($useunixhierarchy) {
	$mailbox = 'user/' . $mailbox;
	} else {
	$mailbox = 'user.' . $mailbox;
	}

	if ($delete) {
		my $retval = &DeleteMailBox($mailbox);
		$return = $retval if ($retval != 0);
	} else {
		# Select the partition
		my $pt = $part[$pn];
		$pn += 1;
		$pn = 0 unless $pn < @part;
		my $retval = &CreateMailBox($mailbox,$pt,$quota);
		$return = $retval if ($retval != 0);
	}
}
exit $return;