#!/usr/bin/perl
#
# cyrusadmin.pl
#
# by Jesús Villaverde Castro <mail AT jesusvillaverde.com>
# thanks to Robert Urban for his functions to edit files
#
# Changelog
#
# 2005-04-2
#  First release
# 2005-12-01
#  Added virtual domain support (avaliable on cyrus-imapd 2.2)
#
# The script supports adding/removing users, creating/removing sasl accounts, allowing/disallowing users to access 
# other's mailboxes, set quotas and add users to postfix virtual alias map file. (intended to let postfix check
# if the recipient of an arriving  mail exists, and refuse the mail if it doesn't)
#
# Note: To create sasl users you must execute this script as root on the server.
#
# TODO:
# - Code debugging. It's my first perl script, so it might have some extra waste code :-)

use IMAP::Admin;
use Cyrus::IMAP::Admin;
use FileHandle;
use File::Basename;
use Fcntl ':flock'; # import LOCK_* constants

# Modify these variables to your needs
$SERVER="localhost";
$ADMIN="cyrus";
$PASSWORD="MYPASS";
$DEBUG=1;
$VERBOSE=1;
$USERS_FILE = '/etc/postfix/usuarios';
# If we set $do_postfix=1, the script will add the users to $USERS_FILE in order to accept mail to them
$do_postfix=1;
# Set according with the value in "imapd.conf". The capability of using dots in usernames depends on this variable
$unixhierarchysep = "yes"; # Possible values = yes/no
#The domain variable is for the postfix file and for users who don't have FQD
$cyrusdomain = "foo.bar";

# Other variables
$ARGS="";

#-----------------------------------------------
# Parse arguments
#-----------------------------------------------

$user;		#Username with FQD
$username;	# Only the username
$userdomain;	# Only the FQD
$passwd="";	# Initialized to know if the user supplies a passwd or want's the program to ask for it
$users;
$quota;

while ($_ = shift) {
	if (/^-h(elp)?$/){
		usage();
		exit;
	} elsif (/^-m(enu)?$/) {
		conectar();
		menu();
		$imap->close;
		salir();
	} elsif (/^-a(dd)?$/) {
		$ARGS = "$ARGS -add";
	} elsif (/^-d(el)?$/) {
		$ARGS = "$ARGS -del";
	} elsif (/^-u(ser)?:/) {
		$ARGS = "$ARGS -user";
		$_ =~ s/-u(ser)?://g;
		$user = $_;
		splitusername("$user");
	} elsif (/^-sasl:/) {
		$ARGS = "$ARGS -sasl";
		$_ =~ s/-sasl://g;
		$passwd = $_;
	} elsif (/^-allow:/) {
		$ARGS = "$ARGS -allow";
		$_ =~ s/-allow://g;
		$users = $_;
	} elsif (/^-disallow:/) {
		$ARGS = "$ARGS -disallow";
		$_ =~ s/-disallow://g;
		$users = $_;
	} elsif (/^-q(uota)?/) {
		$ARGS = "$ARGS -quota";
		$_ =~ s/-q(uota)?://g;
		$quota = $_;
		if ($quota =~ /^(\d+)mb?/i) #If quota size is specified in MB (m)
			{
			$_ =~ s/mb?//g;
			$quota = $_ * 1024;
			$DEBUG && print "Quota: $quota\n";
			}
	} else {
		print "Unknown parameter [$_]\n";
		usage();
		exit;
	}
	$trash="";
}


if (!defined ($trash)){	# No arguments are given
	usage();
	exit; 
	}
	

conectar();

if ($DEBUG==1) { print "Arguments: $ARGS\n"}

if ($ARGS =~ /-add/ && $ARGS =~ /-del/)
	{
	print "You can't create and delete a user at the same time!!\n";
	exit;
	}
elsif ($ARGS =~ /-add/)
	{
	adduser($user,$passwd);
	}
elsif ($ARGS =~ /-del/)
	{
	setacl('allow','cyrus');
	deluser($user,$passwd);
	}
elsif ($ARGS =~ /-sasl/ && $ARGS =~/-u/)
	{
	if ($passwd eq "")
		{
		$passwd=query('Enter new password: ','1');
		sasl('passwd',$user,$passwd);
		}
	elsif ($passwd eq 'disable')
		{
		sasl('delete',$user);
		}
	else {
		sasl('passwd',$user,$passwd);
		}
	}

if ($ARGS =~ /-allow/ && $ARGS =~ /-u/)
	{
	@arg = ('allow',split (/,+/,$users));	# We put users separated by commas into the array. First item is the action to be done
	setacl(@arg);
	}
if ($ARGS =~ /-disallow/ && $ARGS =~ /-u/)
	{
	@arg = ('disallow',split (/,+/,$users));	# We put users separated by commas into the array. First item is the action to be done
	setacl(@arg);
	}
if ($ARGS =~ /-quota/ && $ARGS =~ /-u/)
	{
	if ($unixhierarchysep = "yes") 
		{
		setquota("user/$user",$quota);
		}
	else
		{
		setquota("user.$user",$quota);
		}
	}
$imap->close;
exit;

sub conectar
	{
	$imap = IMAP::Admin->new(
			'Server'=>$SERVER,
			'Login'=>$ADMIN,
			'Password'=>$PASSWORD
			);
	defined ($imap->list("*")) || salir (-1);	# Didn't find any other way to check if I was connected to imap server
	}
	
sub list_users	{
        my @userlist = $imap->list("*");	
	open (LIST, ">/tmp/list");
	foreach (@userlist) 
		{ 
		if ($unixhierarchysep = "yes") {
			$_ =~ s/user\///g;	#Remove the "user/" part of the username (when using "unixhierarchysep: yes")
			}
		else {
			$_ =~ s/user\.//g;	#Remove the "user." part of the username (when using "unixhierarchysep: yes")
			}
		if ($_ =~ s/\///g) {
			break;
			}
		else {
			print LIST "$_\n";
			}
		}
	print LIST "--EOF--\n";
	print LIST "Press 'q' to exit\n";
	close (LIST);
	system ("less /tmp/list");
	}

#-----------------------------------------------------------------------------------------
# This function should create mailboxes and sasl users
#-----------------------------------------------------------------------------------------

sub adduser	
		{
		$user = shift;
		$passwd = shift;
		if ($ARGS !~ /-u/)	#If user is not specified at comand line
			{
			$user=query ('Enter new user\'s login: ');
			splitusername("$user");
			}
		$VERBOSE && print "User:$username\nDomain:$userdomain\n";
		if ($unixhierarchysep = "yes") {
			$inbox = "user/$username\@$userdomain";
			$drafts = "user/$username/Drafts\@$userdomain";
			$sent = "user/$username/Sent\@$userdomain";
			$trash = "user/$username/Trash\@$userdomain";
		}
		else {
			$inbox = "user.$username\@$userdomain";
			$drafts = "user.$username\.Drafts\@$userdomain";
			$sent = "user.$username\.Sent\@$userdomain";
			$trash = "user.$username\.Trash\@$userdomain";
			}
		# Create mailboxes using last variables
		$error = $imap->create($inbox);
		if ($error != 0)	# If there's an error while creating mailbox
			{
			if ($imap->{'Error'} =~ /already\ exists/)	# And erroris because the user already exists...
				{
				print "Error: User already exists\n";	 # We notify that
				}
			else		# Otherwise we put the error as imap server tells it.
				{
				print "$imap->{'Error'}\n";	
				}
         		}
		else			# If there's no error, user mailboxes are created
			{
			$VERBOSE && print "Creating Inbox for $username\@$userdomain\n";
			$VERBOSE && print "Creating $drafts\n";
			$imap->create($drafts);
			$VERBOSE && print "Creating $sent\n";
			$imap->create($sent);
			$VERBOSE && print "Creating $trash\n";
			$imap->create($trash);
			# Set permission to manage these mailboxes with user cyrus
			setacl('allow','cyrus');
			}
		if ($ARGS =~ /-sasl/ && $passwd ne 'disable')	# If a valid password is passed as an argument
			{
			sasl ('add',$user,$passwd);
			}
		elsif ($passwd eq 'disable')
			{
			print "Not creating sasl account for $user\n";
			sleep 1;
			}
		else
			{
			my $permit_login="";	# Define variable before loop, because if we do not, the variable exists only into the loop
			do
			{
			$permit_login = query ('Create sasl account? (y/n)');
				if ($permit_login =~ /^y$/) 
					{
					my $question = "Enter password for $user :";
					my $passwd = query ($question,'1');
					sasl ('add',$user,$passwd);
					}
				elsif ($permit_login =~ /^n$/)
					{
					print "Not creating sasl account for $user\n";
					sleep 1;
					}
				else
					{
					print "Unknown option: $permit_login\n"
					}
			}until ($permit_login =~ /^y$/ || $permit_login =~ /^n$/);
			}
		my $line = "$user\tOK";
		if ($do_postfix)
			{
			editFile($USERS_FILE, 'cyrus-users', $line);
			system("postmap $USERS_FILE");
			}
		}

#-----------------------------------------------------------------------------------
# This function should remove mailboxes and sasl users
#-----------------------------------------------------------------------------------

sub deluser	
		{
		$user = shift;
		$passwd = shift;
		if ($ARGS !~ /-u/)	#If user is not specified at comand line
			{
			$user=query ('Enter the username you want to remove: ');
			splitusername("$user");
			}
		$VERBOSE && print "User:$username\nDomain:$userdomain\n";
		if ($unixhierarchysep = "yes") {
			$error = $imap->h_delete("user/$user");
		}
		else {
			$error = $imap->h_delete("user.$user");
		}
		if ($error != 0) {			# If any error occurs while deleting user
			if ($imap->{'Error'} =~ /does\ not\ exist/)	# Andthe error is because user doesn't exist
				{
				print "Error: User not found\n"
				}
			else		# Otherwise we put the error as imap server returns to us
				{
				print "$imap->{'Error'}\n";	
				}
         		}
		else
			{
			$VERBOSE && print "Removing mailbox $user y and all subfolders\n";
			}
		if ($ARGS =~ /-sasl/ && $passwd eq 'disable')	#Si le pasamos como argumento 'disable'
			{
			sasl ('delete',$user);
			}
		else
			{
			my $dele_login = "";
			do
			{
			$dele_login = query ('Remove sasl account? (y/n)');
			if ($dele_login =~ /^y$/) 
				{
				sasl ('delete',$user);
				}
			elsif ($dele_login =~ /^n$/)
				{
				print "Sasl account for $user not removed\n";
				sleep 1;
				}
			else
				{
				print "Unknown option: $dele_login\n"
				}
			}until ($dele_login =~ /^y$/ || $dele_login =~ /^n$/);
			}
		if ($do_postfix)
			{
			editFile($USERS_FILE, "$user", 'del');
			system("postmap $USERS_FILE");
			}
		}
	
sub menu
	{
	do
		{
		system("clear");
		print <<_EOF_;
		****************************************
		*****  Cyrus IMAP Administration   *****
		*****  Select option               *****
		****************************************
		1.- Add user
		2.- Remove user
		3.- List users
		0.- Exit
		Option:
_EOF_
	
		$_ = <STDIN>;
		chomp;
		print "\n";
		
		if (/^1/)	
		{
		adduser();
		}
		elsif (/^2/)	
		{
		deluser();
		}
		elsif (/^3/)	
		{
		list_users();
		};
			
		} while ($_ ne 0);	# Not Equal, ne
	}
	
sub usage
	{
	print <<_EOF_;
Usage: $0 [options]
	
Options:

-m[enu]			Start in menu mode
-h[elp]			Print this short help
-a[dd]			Add new User
-d[el]			Remove user
-u[ser]:		Specify user name
-sasl:			Specify user passwd. This option adds user 
			to sasl database. Use this unless you want 
			an account  without login access to the
			imap server. Specify sasl=disable
			to disable sasl account
-q[uota]:quota		Specify user quota in bytes or in mb. "none" to disable quota. E.g: -q:10m
-allow:			List of users separated by commas allowed to
			see "user" mailboxes (Remember cross-domain folder listing is not supported yet)
-disallow:		List of users separated by commas disallowed to
			see "user" mailboxes
Examples:

$0 -a -u:cyrus -sasl:cyruspass	# Create cyrus user with cyruspass password
$0 -d -u:pepe -sasl:disable		# Delete user pepe and disable his sasl account
$0 -u:pepe -sasl:disable		# Disable pepe's sasl account
$0 -u:pepe -sasl:			# Create pepe's sasl account (Script will prompt for passwd
					 			Note the colons are present)
$0 -u:pepe -allow:jesus,juan		# Allow Jesus and Juan full access to pepe's mailboxes
	
Cyrus imap and Postfix manage script
Contact author on mail AT jesusvillaverde.com

_EOF_
}

sub sasl
	{
	my ($action,$user,$passwd) = @_;
	if ($action =~ /^add$/)
		{
		$VERBOSE && print "Adding sasl user $user\n";
		my $fh = FileHandle->new;
		open($fh, "|saslpasswd2 -p $username\@$userdomain") || salir('Error while creating user with saslpasswd2. Are you root?');
		print $fh "$passwd\n";
		close($fh);
		}
	elsif ($action =~ /^delete$/)
		{
		$VERBOSE && print "Removing sasl user $user\n";
		my $fh = FileHandle->new;
		open($fh, "|saslpasswd2 -d $username\@$userdomain") || salir ('Error removing user with saslpasswd2. Are you root?');
		close ($fh);
		}
	elsif ($action =~ /^passwd$/)
		{
		print "Creating/modifying sasl password for $user\n";
		my $fh = FileHandle->new;
		open($fh, "|saslpasswd2 -p $username\@$userdomain") || salir('Error in saslpasswd2. Are you root?');
		print $fh "$passwd\n";
		close($fh);
		}
	}

sub setacl
	{
	my $action = shift;
	my @users = @_;
	my @folders;
	my $tmpuser;
	my @folderslist = $imap->list("*");
	foreach (@folderslist)
		{
		if ($_ =~ /$username/ && $_ =~ /$userdomain/)
			{
			push @folders, "$_";	
			}
		}
	if ($action eq "allow")
		{
		$DEBUG && print "\nAllowing: @users to access $user Mailboxes:\n@folders\n\n";
		while ($tmpuser = shift @users) 
			{
			while ($folder = shift @folders)
				{
				$VERBOSE && print "Alowing user $tmpuser to access mailbox $folder\n";
				$imap->set_acl($folder, $tmpuser, "lrswipdca");
				}
			}
		}
	elsif ($action eq "disallow")
		{
		$DEBUG && print "\nDisallowing: @users to access $user Mailboxes:\n@folders\n\n";
		while ($tmpuser = shift @users) 
			{
			while ($folder = shift @folders)
				{
				$VERBOSE && print "Disalowing user $tmpuser to access mailbox $folder\n";
				$imap->set_acl($folder, $tmpuser, "");
				}
			}
		}
	}

sub query
{
	my ($prompt,$echo_off) = @_;
	print "${prompt} ";
	my $answer;
	do {
		if ($echo_off) { system("stty -echo"); }
		chomp($answer = <STDIN>);
		if ($echo_off) { system("stty echo"); }
		if (!$answer) { print "\nYou must supply an answer: "; }
	} while(!length($answer));
	print "\n";
	$answer;
}	
	
sub salir
	{
	$_ = shift;
	if ($_ == -1)
		{
		print "Couldn' connect to $SERVER. Check configuration and that the server is running\n";
		}
	else
		{
		print "$_\n";
		}
	unlink ("/tmp/list");
	exit;
	}

#-----------------------------------------------------------------
# editFile()
#
# in order to work with flock(), the contents must be kept in
# memory and written back to input file.
#-----------------------------------------------------------------
sub editFile
	{
	my ($file, $tag, $line) = @_;	# If ($line eq 'del') deletes the line containing $tag (Used to remove users)

	my (@contents);

	$VERBOSE && print "Editing [$file]\n";

	my $fh = FileHandle->new("+<$file");
	defined($fh) || die "Couldn't open $file for reading";
	lockFile($fh);

	my $state = 'looking';
	while(<$fh>) 
		{
		if ($state eq 'looking') 
			{
			$VERBOSE && print "Looking for tag...\n";
			if (/$tag/) 
				{	
				$VERBOSE && print "Found TAG: $tag\n";
				if ($line ne 'del')
					{
					push(@contents, $_);	#Print tag line into @contents
					push(@contents, "$line\n");	#Print user's line into @contents
					$state = 'copyrest';
					}
				else
					{
					shift;	#Print tag line into @contents
					$state = 'copyrest';
					}
				}
			else
				{
				push(@contents, $_);	#Jump to next line
				}
			}
		 else 
		 	{
			# state = copyrest
			push(@contents, $_);
			}
		}

	if ($state eq 'looking') {
		die "Tag [$tag] not found in file [$file]";
	}

	# rewind file-pointer
	seek($fh, 0, 0) || die "seek";
	truncate($fh, 0) || die "truncate";

	# write new contents
	foreach (@contents) 
		{
		print $fh $_;
		}

	unlockFile($fh);
	$fh->close;
	}

sub unlockFile
	{
	my $fh = shift;
	
    	$DEBUG && print "unlocking file\n";
    	flock($fh, LOCK_UN) || die "flock lock_un ($!)";
	}

sub lockFile
	{
	my $fh = shift;

	$DEBUG && print "locking file\n";
	flock($fh, LOCK_EX) || die "flock lock_ex ($!)";
	}

sub setquota
	{
	my ($user,$quota) = @_;
	$VERBOSE && print "Setting quota for [$user] to $quota\n";
	my $err = $imap->set_quota("$user",$quota);
	if ($err = 0)
		{
		print "Failed to set quota for [$user]\n";
		print "$imap->{'Error'}\n";
		}
	}

sub splitusername
	{
	$user = shift;
	$userdomain = $user;
	$username = $user;		# Initialize here or it will be dropped when this function ends
	if ($user =~ /\@/) # If the user name has @, we split them
		{
		$userdomain =~ s/.*\@//g;
		$username =~ s/\@.*//g;
		}
	else	#We set cyrus default domain
		{
		$username = $user;
		$userdomain = $cyrusdomain;
		}
	}