#!/usr/bin/perl
#
# Manage Cyrus IMAP mailboxes
#
# hjb 
#
# -------------------------------------------------------------
# modified for Linux-Musterloesung
# 01.08.2006
# Thomas Schmitt
#

my $me = `basename $0`;
chomp($me);
my $version = '0.3.0';
my $lupdate = '2004-11-20';
my $author = 'hjb';
my $header = "$me-$version ($author -- $lupdate)";

# -------------------------------------------------------------

use strict qw(vars);
use Getopt::Std;
use IMAP::Admin;
use Term::ReadKey;

# -------------------------------------------------------------
# Default configuration
#
my %conf = (
	'global:config_file'		=> '/etc/linuxmuster/cyrus-mbox.conf',
	'imap:imap_server'		=> 'localhost',
	'imap:cyrus_admin'		=> 'cyrus',
	'imap:cyrus_pwd'		=> '',
	'imap:cyrus_pwd_file'		=> '/etc/imap.secret',
	'imap:@force_subfolders'		=> [ qw( Trash Sent Drafts Templates ) ],
	'imap:@subfolders'		=> [ qw( Learn Learn.Spam Learn.Ham ) ],
	'imap:quota'			=> 0,
);

# -------------------------------------------------------------

my %opts;

#
# parse cmd line
#
my $args = join(' ', @ARGV);
unless (getopts('hv:p:q:f:s:C:cdm', \%opts)) {
	die "Error reading arguments: '$args', try -h for help\n";
}

my ($user_login) = @ARGV;

#
# check cmd options
#

if ($opts{C}) {
	$conf{'global:config_file'} = $opts{C};
};

if ($opts{h}) {
	usage();
	bye(0, '');
};


if ($opts{v} > 0) {
	log_msg('info', "Verbose level: $opts{v}") if $opts{v} > 1;
} else {
	$opts{v} = 0;
}

# read configuration
read_config(\%conf);

bye(-1, "Missing mailbox name, try -h for help") if $user_login eq '';
$conf{'imap:mbox'} = $user_login;

if ($opts{q}) {
	$conf{'imap:quota'} = $opts{q};
	log_msg('info', "Quota: $conf{'imap:quota'} MB") if $opts{v} > 1;
};

if ($opts{s}) {
	$conf{'imap:imap_server'} = $opts{s};
	log_msg('info', "IMAP Server: $conf{'imap:imap_server'}") if $opts{v} > 1;
};

if ($opts{a}) {
	$conf{'imap:cyrus_admin'} = $opts{a};
	log_msg('info', "IMAP admin: $conf{'imap:cyrus_admin'}") if $opts{v} > 1;
};

if ($opts{p}) {
	$conf{'imap:cyrus_pwd'} = $opts{p};
} elsif ( -r $conf{'imap:cyrus_pwd_file'} ) {
	open(PWD, $conf{'imap:cyrus_pwd_file'}) or bye (-3, "Cannot read imap secret form '$conf{'imap:cyrus_pwd_file'}' $!");
	$conf{'imap:cyrus_pwd'} = <PWD>;
	chomp($conf{'imap:cyrus_pwd'});
	close(PWD);
} else {
	print "$conf{'imap:cyrus_admin'}\@$conf{'imap:imap_server'}\'s password: ";
	ReadMode('noecho');
	$conf{'imap:cyrus_pwd'} = ReadLine(0);
	chomp($conf{'imap:cyrus_pwd'});
	ReadMode('normal');
	print "\n";
}

if ($opts{f}) {
	my @folders = split(/[\s,]/, $opts{f});
	$conf{'imap:@subfolders'} = \@folders;
	log_msg('info', "Additional subfolders: '@{$conf{'imap:@subfolders'}}'") if $opts{v} > 1;
};


if ($opts{c}) {
	my @subfolders = ( @{$conf{'imap:@force_subfolders'}},  @{$conf{'imap:@subfolders'}} );
	$conf{'imap:@subfolders'} = \@subfolders;
	exit 10 unless imap_create_mailbox(\%conf);

} elsif ($opts{m}) {
	exit 11 unless imap_modify_mailbox(\%conf);
	
} elsif ($opts{d}) {
	exit 12 unless imap_delete_mailbox(\%conf);

};


exit 0;

# -------------------------------------------------------------
#
# usage
#
sub usage {
	print <<__END_OF_USAGE__
$header
Mailbox administration tool for Cyrus IMAPd

usage: $me [-v level ] [ -q n ] [ -f list ] [ -s server ] [ -a admin ] 
           [ -p password ] -c mbox

       $me [-v level ] [ -s server ] [ -a admin ] [ -p password ]
           [ -q n ] [ -f list ] -m mbox

       $me [-v level ] [ -s server ] [ -a admin ] [ -p password] 
           -d mbox

       $me -h
  mbox           mailbox name

options:
  -h             Display this help
  -v level       Be verbose if level > 0
  -C file        Use config file instead of $conf{'global:config_file'}
  -d             Delete mailbox including all subfolders
  -c             Create mailbox
  -m             Modify mailbox
  -q n           Set quota to n MB (n=0: none; default: $conf{'imap:quota'})
  -f list        Create additional subfolders (default: '@{$conf{'imap:@subfolders'}}')
                 (folders '@{$conf{'imap:@force_subfolders'}}' are created anyway)
  -s server      IMAP server (default: $conf{'imap:imap_server'})
  -a admin       Cyrus admin (default: $conf{'imap:cyrus_admin'})
  -p password    Cyrus admin's password
  		 If -p is omitted or empty $me tries to read the password from 
  		 $conf{'imap:cyrus_pwd_file'} first. If this file doesn't exist, 
  		 $me asks for the password.
  
examples:
  Create mailbox for fred including default subfolders and set a 50 MB quota:
    # $me -q 50 -p secret -c fred
  Delete wilma's mailbox including all subfolders:
    # $me -v1 -p secret -d wilma
  Set the quota of simon's mailbox to 30 MB:
    # $me -q 30 -m simon
__END_OF_USAGE__
;
}

#---------------------------------------------------------------
#
# Get a section name, something like '[foobar]'?
# Section names may contain alphanumerical characters including '_' and '-'.
#
sub get_section {
	my ($string) = @_;
        if ($string =~ s/^\[(.+)\]$/$1/) {
                return trim($1);
        } else {
                return undef;
        };
};


#---------------------------------------------------------------
#
# Get a 'param = value list' 
#
sub get_param_value {
	my $string = $_;

	#my ($param, $value) = split(/\s*=\s*/, $string, 2);
	#if ($param && $value) {
	#	return ($param, $value);
	#} else {
	#	return undef;
	#};

	my @list;
	
	my ($param, $value) = split(/\s*=\s*/, $string);
	if ($param && $value) {
		unless ( @list = split(/[\s,]+/, $value) ) {
			@list[0] = $value;
		}
		my $value_cnt = @list;
		return ($param, \@list, $value_cnt);
	}
		
	return undef unless $param;
};

#---------------------------------------------------------------
#
# read config params from a Windows like ini file
#
# returns a hash of params if successfull, otherwhise returns undef
#
sub read_config {
	my ($config) = @_;

	my $conf_file = $config->{'global:config_file'};
	
	unless ( open (CNF, $conf_file) ) {
		bye(-1, "Cannot open config file '$conf_file': $!");
		return undef;
	}
	log_msg('info', "Reading config file '$conf_file'") if $opts{v} > 1;

	my $section = '';
        while (<CNF>) {
        	chomp;
        	my $line = trim($_);		# trim white space
        	next if $line eq '';		# ignore empty lines
        	next if $line =~ /^[#;]/;	# ignore comment lines

        	my $sec = get_section($line);
        	if ($sec) {
        		# it's a section, something like '[foobar]'
        		$section = $sec;
			log_msg('info', "[$section]") if $opts{v} > 2;
        	} elsif ($section ne '') {
        		# check for 'param = value' pairs
        		my ($param, $value, $value_cnt) = get_param_value($line);
        		if ($param) {
        			# it's a line like 'param = value'
        			if ($param =~/^@/) {
        				# a list of values was expected
        				$config->{"$section:$param"} = $value;
        				log_msg('info', "  $section:$param = @{$value}") if $opts{v} > 2;
        			} else {
        				# a scalar was expected
        				$config->{"$section:$param"} = $value->[0];
        				log_msg('info', "  $section:$param = $value->[0]") if $opts{v} > 2;
        			}
        				
        		};
        	};
        }
        close(CNF);
	return $config;
}

#---------------------------------------------------------------
#
# Trim leading and trailing white space
#

sub trim {
	my ($string) = @_;

	$string =~ s/^\s+//;
        $string =~ s/\s+$//;
        $string;
};

#---------------------------------------------------------------
#
# terminate program
#
sub bye {
	my ($exit_code,$msg) = @_;
	my $err = - $exit_code;

	if ($err > 0) {
		log_msg('err', "$msg") if $msg;
		log_msg('err', '*** aborted ***');
	} else {
		log_msg('info', "$msg") if $msg;
	}
	exit $exit_code;
}

#---------------------------------------------------------------
#
# log message
#
sub log_msg {
	my ($level, $msg) = @_;

	$level = lc($level);
	if ($level =~ /err|warning/) {
		warn "$msg\n";
	} else {
		print "$msg\n";
	}
}

#---------------------------------------------------------------
#
# connect to imap server
#
sub imap_connect {
	my ($server, $admin, $admin_pwd) = @_;

	#
	# connect to imap server
	#
	my $imap = IMAP::Admin->new(
	  	'Server' => $server,
	  	'Login' => $admin,
	  	'Password' => $admin_pwd,
	  	'CRAM' => 2,
	  	);
	my $status = $imap->error;

	if ($status ne 'No Errors') {
		log_msg('warning', "Error: $status");
		$imap->close();
		return undef;
	}
	return $imap;
}

#---------------------------------------------------------------
#
# connect to imap server
#
sub create_subfolders {
	my ($imap, $login, @subfolders) = @_;
	#
	# create subfolders
	#
	log_msg('info', "Creating subfolders '@subfolders'") if $opts{v} > 2;
	foreach my $folder (@subfolders) {
		log_msg('info', "Creating subfolder '$folder'") if $opts{v} > 1;
		my $err = $imap->create("user.$login.$folder");
		if ($err != 0) {
			my $status = $imap->error;
			log_msg('warning', "Error: $status");
			$imap->close();
			return undef;
		}
		log_msg('info', "Subfolder '$folder' created") if $opts{v} > 0;
	}
	return 1;
}

#---------------------------------------------------------------
#
# create imap mailbox
#
sub imap_create_mailbox {
	my ($conf) = @_;
	
	my $server = $conf->{'imap:imap_server'};
	my $admin =  $conf->{'imap:cyrus_admin'};
	my $admin_pwd = $conf->{'imap:cyrus_pwd'};
	my $login = $conf->{'imap:mbox'};
	my $quota = $conf->{'imap:quota'};
	my @subfolders = @{$conf->{'imap:@subfolders'}};
	#my ($server, $admin, $admin_pwd, $login, $quota, $subfolders) = @_;
	
	my $imap = imap_connect($server, $admin, $admin_pwd) or return undef;
	
	#
	# create mailbox
	#
	log_msg('info', "Creating mailbox '$login'") if $opts{v} > 0;
	my $err = $imap->create("user.$login");
	if ($err != 0) {
		my $status = $imap->error;
		log_msg('warning', "Error: $status");
		$imap->close();
		return undef;
	}
	log_msg('info', "Mailbox '$login' created") if $opts{v} > 0;

	#
	# create subfolders
	#
	create_subfolders($imap, $login, @subfolders) or return undef;


	#
	# set quota
	#
	$quota = set_quota($imap, $login, $quota);
	$imap->close();
	return $quota;
}


#---------------------------------------------------------------
#
# remove imap mailbox
#
sub imap_delete_mailbox {
	my ($conf) = @_;
	
	my $server = $conf->{'imap:imap_server'};
	my $admin =  $conf->{'imap:cyrus_admin'};
	my $admin_pwd = $conf->{'imap:cyrus_pwd'};
	my $login = $conf->{'imap:mbox'};
	#my ($server, $admin, $admin_pwd, $login) = @_;

	my $imap = imap_connect($server, $admin, $admin_pwd) or return undef;

	#
	# get a list of $login's mailboxes
	#
	log_msg('info', "Getting list of $login's mailboxes") if $opts{v} > 1;
	my @mboxes = $imap->list("user.$login.*");	# subfolders
	push @mboxes, "user.$login";			# add the root mailbox

	#
	# set acl of all mailboxes so that we can delete the stuff
	#
	foreach my $mbox (@mboxes) {
		log_msg('info', "Setting ACL of '$mbox' for removal") if $opts{v} > 1;
		my $err = $imap->set_acl("$mbox", $admin, 'c');
		if ($err != 0) {
			my $status = $imap->error;
			log_msg('warning', "Error: $status");
			$imap->close();
			return undef;
		}
		log_msg('info', "ACL of '$mbox' set for removal") if $opts{v} > 1;
	}

	#
	# remove mailboxes
	#
	log_msg('info', "Deleting mailbox '$login' including all subfolders") if $opts{v} > 1;
	my $err = $imap->h_delete("user.$login");
	if ($err != 0) {
		my $status = $imap->error;
		log_msg('warning', "Error: $status");
		$imap->close();
		return undef;
	}
	log_msg('info', "Mailbox '$login' including all subfolders deleted") if $opts{v} > 0;
	$imap->close();
	return 1;
}

#---------------------------------------------------------------
#
# set quota
#
sub imap_modify_mailbox {
	my ($conf) = @_;

	my $server = $conf->{'imap:imap_server'};
	my $admin =  $conf->{'imap:cyrus_admin'};
	my $admin_pwd = $conf->{'imap:cyrus_pwd'};
	my $login = $conf->{'imap:mbox'};
	my $quota = $conf->{'imap:quota'};
	my @subfolders = @{$conf->{'imap:@subfolders'}};

	my $imap = imap_connect($server, $admin, $admin_pwd) or return undef;
	
	#
	# create subfolders
	#
	if ( $opts{f} ) {
		create_subfolders($imap, $login, @subfolders) or return undef;
	}

	#
	# set quota
	#
	if ( $opts{q} ) {
		set_quota($imap, $login, $quota) or return undef;
	}
	$imap->close();
	return 1;
}

#---------------------------------------------------------------
#
# set quota
#
sub set_quota {
	my ($imap, $login, $quota) = @_;

	#
	# set quota
	#
	my $quota_kb = 'none';
	if ($quota > 0) {
		$quota_kb = $quota * 1024; # quota in KB
		log_msg('info', "Setting quota of mailbox '$login' to $quota_kb KB") if $opts{v} > 1;
	} else {
		log_msg('info', "Setting quota of mailbox '$login' to 'none'") if $opts{v} > 1;
	}
	my $err = $imap->set_quota("user.$login", $quota_kb);
	if ($err != 0) {
		my $status = $imap->error;
		log_msg('warning', "Error: $status");
		return undef;
	}
	if ($quota > 0) {
		log_msg('info', "Quota of mailbox '$login' set to $quota_kb KB") if $opts{v} > 0;
	} else {
		log_msg('info', "Quota of mailbox '$login' set to 'none'") if $opts{v} > 0;
	}
	return 1;
}
