#/bin/perl
#Websieve funclib.pl library for Cyrus Perl admin modules
#Version 1.2a

use Cyrus::IMAP::Admin;
use Cyrus::SIEVE::managesieve;

my (@scripts,$password,$username);
$IMAPERROR='';
$SIEVEERROR='';

sub _cb_eof {
	my %cb=@_;
	$IMAPERROR= "Connection to server lost.\n";
	${$cb{-rock}}=undef;
}
	
sub openimap {
	my ($uid,$pass,$server,$port,$ssl,$separator)=@_;
	$port='143' if !$port;
	$IMAPERROR='';
	my $mech='LOGIN'; #if nothing will default to first available I believe
	#$mech can only be 'LOGIN'  at this time
	#since we can't pass the password for DIGEST-MD5 to imclient
	$imap=Cyrus::IMAP::Admin->new($server,$port);
	$imap->addcallback({-trigger=>'EOF',
			    -callback=>\&_cb_eof,
			    -rock=>\$imap}) if defined $imap;
	$IMAPERROR="Can't connect to IMAP server" if !$imap;
	return '' if $IMAPERROR;
	my $err=$imap->authenticate(-user=>$uid, -password=>$pass, -mechanism=>$mech);
	$IMAPERROR=$imap->error;
	if (!$IMAPERROR && !$err) {
		$IMAPERROR="Error Authenticating to $server with id $uid";
	}
	return '' if $IMAPERROR;
	return $imap;

}
sub closeimap {
	$imap=undef;
}
sub listmailbox {
	my ($mbx)=@_;
	my (@mbxtmp,@mbx,$mbxname,$l);
	@mbxtmp=$imap->list($mbx);
 	foreach $mbxname (@mbxtmp) {
 		$l=$mbxname->[0];
		push (@mbx,$l);	
	#	if ($mbxname->[1] ne '') {
	#		$l .= ' (' .$mbxname->[1] . ')';
	#	}
	}
	$IMAPERROR=$imap->error;
	return @mbx;
}

sub getquota {
	my ($mbx) = @_;
	my ($root,%quota)=$imap->quotaroot($mbx);
	my (@quotatmp);
	foreach my $quota (keys %quota) {
		push (@quotatmp,$mbx);
		push (@quotatmp,$quota{$quota}[0]);
		push (@quotatmp,$quota{$quota}[1]);
	}
	$IMAPERROR=$imap->error;
	return @quotatmp;
}

sub getacl {
	my ($mbx)=@_;
	my (@acltmp,$acl,$acluser);
	my %acl=$imap->listacl($mbx);
 	my @aclkeys=keys %acl;
	while (@aclkeys) {
		$acluser=shift(@aclkeys);
		$acl=$acl{$acluser};
		push (@acltmp,$acluser);
		push (@acltmp,$acl);
	}
	$IMAPERROR=$imap->error;
	return @acltmp;
}
sub setacl {
	my ($mbx,$user,$acl)=@_;
	my $err=$imap->setacl($mbx,$user,$acl);
	$IMAPERROR=$imap->error;
	return $IMAPERROR;
}

sub setquota {
	my ($mbx,$quota)=@_;
	my $err=$imap->setquota($mbx,"STORAGE",$quota);
	$IMAPERROR=$imap->error;
	return $IMAPERROR;
}

sub createmailbox {
	my ($mbx,$partition)=@_;
	my $err=$imap->create($mbx,$partition);
	$IMAPERROR=$imap->error;
	return $IMAPERROR;
}
sub deletemailbox {
	my ($mbx)=@_;
	my $err=$imap->delete($mbx);
	$IMAPERROR=$imap->error;
	return $IMAPERROR;
}


sub prompt {
	my($type,$prompt)=@_;
	if (($type eq "username") && (defined $username)) {
		return $username;
	} elsif (($type eq "authname") && (defined $username)) {
		return $username;
	} elsif (($type eq "realm") && (defined $realm)) {
		return $realm;
	} elsif (($type eq "password") && (defined $password)) {
		return $password;
	}
	return "";
}

sub opensieve {
	my ($uid,$pass,$port,$server,$ssl)=@_;
	$username=$uid;
	$password=$pass;
	$realm="";
	$SIEVEERROR='';
	$ENV{SASL_SIEVE_MECH}="CRAM-MD5"; # only works with a small mod 
	$sieve=sieve_get_handle($server,"prompt","prompt","prompt","prompt");
	delete $ENV{SASL_SIEVE_MECH};
	undef $username;
	undef $password;
	if (!defined $sieve) {
    		my $err = sieve_get_global_error();
    		$SIEVEERROR="unable to connect to server: $err";
		return;
	}
	return $sieve;
}

sub closesieve {
	$sieve=undef;
}

sub list_cb {
	my($name,$isactive)=@_;
	if ($isactive == 1) {
		$name=$name."*";
	}
	push (@scripts,$name)
}
sub listscripts {
	@scripts=();
	my $err=sieve_list($sieve,"list_cb");
	$SIEVEERROR=sieve_get_error($sieve);
	return @scripts;
}
sub getscript {
	my ($scriptname)=@_;
	my $str='';
	my $err=sieve_get($sieve,$scriptname,$str);
	$SIEVEERROR=sieve_get_error($sieve);
	return $str;
}

sub putscript {
	my ($scriptname,$script)=@_;
	my $err=sieve_put($sieve,$scriptname,$script);
	$SIEVEERROR=sieve_get_error($sieve);
	return $SIEVEERROR;
}

sub setactive {
	my ($script)=@_;
	my $err=sieve_activate($sieve,$script);
	$SIEVEERROR=sieve_get_error($sieve);
	return $SIEVEERROR;
}

sub deletescript {
	my ($script)=@_;
	my $err=sieve_delete($sieve,$script);
	$SIEVEERROR=sieve_get_error($sieve);
	return $SIEVEERROR;
}
1;