#/usr/bin/perl # funclib.pl version 2.5c # Jun 12/2001 use IMAP::Admin; use IMAP::Sieve; $IMAPERROR=''; $SIEVEERROR=''; sub openimap { my ($uid,$pass,$server,$port,$ssl,$separator)=@_; my $err; $IMAPERROR=''; undef $imap; $port='143' if !$port; $separator='.' if !$separator; if ($ssl) { eval {$imap=IMAP::Admin->new('Server'=>$server,'Login'=>$uid,'Password'=>$pass,'Port'=>$port,'SSL'=>$ssl,'Separator'=>$separator)}; } else { eval {$imap=IMAP::Admin->new('Server'=>$server,'Login'=>$uid,'Password'=>$pass,'Port'=>$port,'Separator'=>$separator)}; } $err=$imap->{'Error'}; if ($err) { return $imap if $err =~/No Errors/i; $IMAPERROR=$err; return; } return $imap; } sub closeimap { if ($imap) { eval {$imap->close}}; undef $imap; } sub listmailbox { my ($mbx) = @_; @mbx=$imap->list($mbx); $IMAPERROR=$imap->{'Error'} if !defined @mbx; return (@mbx); } sub getquota { my ($mbx) = @_; @tmp=eval {$imap->get_quotaroot($mbx)}; $IMAPERROR=$imap->{'Error'} unless (defined(@tmp) && scalar(@tmp) > 1); return unless (defined(@tmp) && scalar(@tmp) > 1); #recreate array and remove extra spaces - fixes array properly # @tmp=($tmp[3],$tmp[4],$tmp[5]); return @tmp; } sub getacl { my ($mbx) = @_; @acl=$imap->get_acl($mbx); return(@acl); } sub setacl { my ($mbx,$user,$acl)=@_; my $err; $err=$imap->set_acl("$mbx",$user,$acl); if ($err) { $err=$imap->{'Error'}; return $err; } return; } sub setquota { my ($mbx,$quota) = @_; my $err=eval {$imap->set_quota("$mbx",$quota)}; if ($err) { $err=$imap->{'Error'}; return $err; } return; } sub createmailbox { my ($mbx,$partition) = @_; if ($partition) { my $err=$imap->create($mbx,$partition); } else { $err=$imap->create($mbx); } if ($err) { $err=$imap->{'Error'}; return $err; } return; } sub deletemailbox { my ($mbx) = @_; my $err=$imap->delete("$mbx"); if ($err) { $err=$imap->{'Error'}; return $err; } return; } sub opensieve { my ($uid,$pass,$port,$server,$ssl)=@_; $SIEVEERROR=''; if ($ssl) { eval {$sieve=IMAP::Sieve->new('Proxy'=>$proxy,'Port'=>$port,'Server'=>$server,'Login'=>$uid,'Password'=>$pass,'SSL'=>$ssl)}; } else { eval {$sieve=IMAP::Sieve->new('Proxy'=>$proxy,'Port'=>$port,'Server'=>$server,'Login'=>$uid,'Password'=>$pass)}; } my $err=$sieve->{'Error'}; if ($err) { return $sieve if $err =~/No Errors/i; $SIEVEERROR=$err; return ''; } return $sieve; } sub closesieve { if ($sieve) {$sieve->close}; undef $sieve; } sub listscripts { @scripts=$sieve->listscripts; return @scripts; } sub getscript { my ($scriptname) = @_; my ($script); $script=$sieve->getscript($scriptname); $SIEVEERROR=$sieve->{'Error'}; $SIEVEERROR='' if $SIEVEERROR=~/No Errors/i; return $script; } sub putscript { my ($scriptname,$script) = @_; $res=$sieve->putscript($scriptname,$script); my @scripts=$sieve->listscripts; if ($res) { $res=$sieve->{'Error'}; print "res=$res
"; return $res; } return; } sub setactive { my ($script)=@_; $res=$sieve->setactive($script); if ($res) { $res= $sieve->{'Error'}; return $res; } return; } sub noop { $test=$sieve->noop; return; } sub deletescript { my ($script)=@_; $res=$sieve->deletescript($script); if ($res) { $res= $sieve->{'Error'}; return $res; } return; } 1;