IMAP-Admin
view release on metacpan or search on metacpan
sub new {
my $class = shift;
my $self = {};
my @defaults = (
'Port' => 143,
'Separator' => '.',
'CRAM' => 0,
);
bless $self, $class;
if ((scalar(@_) % 2) != 0) {
croak "$class called with incorrect number of arguments";
}
unshift @_, @defaults;
%{$self} = @_; # set up parameters;
$self->{'CLASS'} = $class;
$self->_initialize;
return $self;
}
sub _initialize {
my $self = shift;
if (!defined($self->{'Server'})) {
croak "$self->{'CLASS'} not initialized properly : Server parameter missing";
}
if (!defined($self->{'Login'})) {
croak "$self->{'CLASS'} not initialized properly : Login parameter missing";
}
if (!defined($self->{'Password'})) {
croak "$self->{'CLASS'} not initialized properly : Password parameter missing";
}
if ($self->{'CRAM'} != 0) {
my $cram_try = "use Digest::HMAC; use Digest::MD5; use MIME::Base64;";
eval $cram_try;
}
if (defined($self->{'SSL'})) { # attempt SSL connection instead
# construct array of ssl options
my $cwd = cwd;
my %ssl_defaults = (
'SSL_use_cert' => 0,
'SSL_verify_mode' => 0x00,
'SSL_key_file' => $cwd."/certs/client-key.pem",
'SSL_cert_file' => $cwd."/certs/client-cert.pem",
'SSL_ca_path' => $cwd."/certs",
'SSL_ca_file' => $cwd."/certs/ca-cert.pem",
);
my @ssl_options;
my $ssl_key;
my $key;
foreach $ssl_key (keys(%ssl_defaults)) {
if (!defined($self->{$ssl_key})) {
$self->{$ssl_key} = $ssl_defaults{$ssl_key};
}
}
foreach $ssl_key (keys(%{$self})) {
if ($ssl_key =~ /^SSL_/) {
push @ssl_options, $ssl_key, $self->{$ssl_key};
}
}
my $SSL_try = "use IO::Socket::SSL";
eval $SSL_try;
# $IO::Socket::SSL::DEBUG = 1;
if (!eval {
$self->{'Socket'} =
IO::Socket::SSL->new(PeerAddr => $self->{'Server'},
PeerPort => $self->{'Port'},
Proto => 'tcp',
Reuse => 1,
Timeout => 5,
@ssl_options); }) {
$self->_error("initialize", "couldn't establish SSL connection to",
$self->{'Server'}, "[$!]");
delete $self->{'Socket'};
return;
}
} else {
if ($self->{'Server'} =~ /^\//) {
if (!eval {
$self->{'Socket'} =
IO::Socket::UNIX->new(Peer => $self->{'Server'}); })
{
delete $self->{'Socket'};
$self->_error("initialize", "couldn't establish connection to",
$self->{'Server'});
return;
}
} else {
if (!eval {
$self->{'Socket'} =
IO::Socket::INET->new(PeerAddr => $self->{'Server'},
PeerPort => $self->{'Port'},
Proto => 'tcp',
Reuse => 1,
Timeout => 5); })
{
delete $self->{'Socket'};
$self->_error("initialize", "couldn't establish connection to",
$self->{'Server'});
return;
}
}
}
my $fh = $self->{'Socket'};
my $try = $self->_read; # get Banner
if ($try !~ /\* OK/) {
$self->close;
$self->_error("initialize", "bad response from", $self->{'Server'},
"[", $try, "]");
return;
}
# this section was changed to accomodate motd's
print $fh "try CAPABILITY\n";
$try = $self->_read;
while ($try !~ /^\* CAPABILITY/) { # we have a potential lockup, should alarm this
$try = $self->_read;
}
$self->{'Capability'} = $try;
$try = $self->_read;
if ($try !~ /^try OK/) {
$self->close;
$self->_error("initialize", "Couldn't do a capabilites check [",
$try, "]");
return;
}
if ($self->{'CRAM'} > 0) {
$id = shift;
print $fh qq{try DELETEACL "$mailbox" "$id"\n};
my $try = $self->_read;
if ($try !~ /^try OK/) {
$self->_error("delete_acl", "couldn't delete acl for", $mailbox,
$id, $acl, ":", $try);
return 1;
}
}
return 0;
}
sub list { # wild cards are allowed, returns array or undef
my $self = shift;
my (@info, @mail);
if (!defined($self->{'Socket'})) {
return;
}
if (scalar(@_) != 1) {
$self->_error("list", "incorrect number of arguments");
return;
}
my $list = shift;
my $fh = $self->{'Socket'};
print $fh qq{try LIST "" "$list"\n};
my $try = $self->_read;
while ($try =~ /^\* LIST.*?\) \".\" \"*(.*?)\"*$/) { # danger danger (could lock up needs timeout) " <- this quote makes emacs happy
push @mail, $1;
$try = $self->_read;
}
if ($try =~ /^try OK/) {
return @mail;
} else {
$self->_error("list", "couldn't get list for", $list, ":", $try);
return;
}
}
# Autoload methods go after =cut, and are processed by the autosplit program.
1;
__END__
=head1 NAME
IMAP::Admin - Perl module for basic IMAP server administration
=head1 SYNOPSIS
use IMAP::Admin;
$imap = IMAP::Admin->new('Server' => 'name.of.server.com',
'Login' => 'login_of_imap_administrator',
'Password' => 'password_of_imap_adminstrator',
'Port' => port# (143 is default),
'Separator' => ".", # default is a period
'CRAM' => 1, # off by default, can be 0,1,2
'SSL' => 1, # off by default
# and any of the SSL_ options from IO::Socket::SSL
);
$err = $imap->create("user.bob");
if ($err != 0) {
print "$imap->{'Error'}\n";
}
if ($err != 0) {
print $imap->error;
}
$err = $imap->create("user.bob", "green");
$err = $imap->delete("user.bob");
$err = $imap->h_delete("user.bob");
$err = $imap->subscribe("user.bob");
$err = $imap->unsubscribe("user.bob");
$err = $imap->rename("bboard", "newbboard");
$err = $imap->rename("bboard", "newbboard", "partition");
@quota = $imap->get_quotaroot("user.bob");
@quota = $imap->get_quota("user.bob");
$err = $imap->set_quota("user.bob", 10000);
@acl = $imap->get_acl("user.bob");
%acl = $imap->get_acl("user.bob");
$err = $imap->set_acl("user.bob", "admin", "lrswipdca", "joe", "lrs");
$err = $imap->delete_acl("user.bob", "joe", "admin");
@list = $imap->list("user.bob");
@list = $imap->list("user.b*");
$imap->{'Capability'} # this contains the Capabilities reply from the IMAP server
$imap->close; # close open imap connection
=head1 DESCRIPTION
IMAP::Admin provides basic IMAP server adminstration. It provides functions for creating and deleting mailboxes and setting various information such as quotas and access rights.
It's interface should, in theory, work with any RFC compliant IMAP server, but I currently have only tested it against Carnegie Mellon University's Cyrus IMAP and Mirapoint's IMAP servers. It does a CAPABILITY check for specific extensions to see if...
Operationally it opens a socket connection to the IMAP server and logs in with the supplied login and password. You then can call any of the functions to perform their associated operation.
Separator on the new call is the hiearchical separator used by the imap server. It is defaulted to a period ("/" might be another popular one).
CRAM on the new call will attempt to use CRAM-MD5 as the login type of choice. A value of 0 means off, 1 means on, 2 means on with fallback to login. *Note* this options requires these perl modules: Digest::MD5, Digest::HMAC, MIME::Base64
SSL on the new call will attempt to make an SSL connection to the imap server. It does not fallback to a regular connection if it fails. It is off by default. IO::Socket::SSL requires a ca certificate, a client certificate, and a client private ke...
If you start the name of the server with a / instead of using tcp/ip it'll attempt to use a unix socket.
I generated my ca cert and ca key with openssl:
openssl req -x509 -newkey rsa:1024 -keyout ca-key.pem -out ca-cert.pem
I generated my client key and cert with openssl:
openssl req -new -newkey rsa:1024 -keyout client-key.pem -out req.pem -nodes
openssl x509 -CA ca-cert.pem -CAkey ca-key.pem -req -in req.pem -out client-cert.pem -addtrust clientAuth -days 600
Setting up SSL Cyrus IMAP v 2.x (completely unofficial, but it worked for me)
add these to your /etc/imapd.conf (remember to change /usr/local/cyrus/tls to wherever yours is)
tls_ca_path: /usr/local/cyrus/tls
tls_ca_file: /usr/local/cyrus/tls/ca-cert.pem
tls_key_file: /usr/local/cyrus/tls/serv-key.pem
tls_cert_file: /usr/local/cyrus/tls/serv-cert.pem
For my server key I used a self signed certificate:
openssl req -x509 -newkey rsa:1024 -keyout serv-key.pem -out serv-cert.pem -nodes -extensions usr_cert (in openssl.cnf I have nsCertType set to server)
I also added this to my /etc/cyrus.conf, it shouldn't strictly be necessary as clients that are RFC2595 compliant can issue a STARTTLS to initiate the secure layer, but currently IMAP::Admin doesn't issue this command (in SERVICES section):
imap2 cmd="imapd -s" listen="simap" prefork=0
where simap in /etc/services is:
simap 993/tcp # IMAP over SSL
=head2 MAILBOX FUNCTIONS
RFC2060 commands. These should work with any RFC2060 compliant IMAP mail servers.
create makes new mailboxes. Cyrus IMAP, for normal mailboxes, has the user. prefix.
create returns a 0 on success or a 1 on failure. An error message is placed in the object->{'Error'} variable on failure. create takes an optional second argument that is the partition to create the mailbox in (I don't know if partition is rfc or no...
delete destroys mailboxes.
The action delete takes varies from server to server depending on it's implementation. On some servers this is a hierarchical delete and on others this will delete only the mailbox specified and only if it has no subfolders that are marked \Noselect...
h_delete hierarchical delete (I don't believe this is RFC anything)
deletes a mailbox and all sub-mailboxes/subfolders that belong to it. It basically gets a subfolder list and does multiple delete calls. It returns 0 on sucess or a 1 on failure with the error message from delete being put into the object->{'Error'...
list lists mailboxes. list accepts wildcard matching
subscribe/unsubscribe does this action on given mailbox.
rename renames a mailbox. IMAP servers seem to be peculiar about how they implement this, so I wouldn't necessarily expect it to do what you think it should. The Cyrus IMAP server will move a renamed mailbox to the default partition unless a partiti...
select selects a mailbox to work on. You need the 'r' acl to select a mailbox.
This command selects a mailbox that mailbox related commands will be performed on. This is not a recursive command so sub-mailboxes/folders will not be affected unless for some bizarre reason the IMAP server has it implemented as recursive. It retu...
FLAGS (\Answered \Flagged \Draft \Deleted \Seen $Forwarded $MDNSent NonJunk Junk $Label7)
OK [PERMANENTFLAGS (\Deleted)]
2285 EXISTS
2285 RECENT
OK [UNSEEN 1]
OK [UIDVALIDITY 1019141395]
OK [UIDNEXT 293665]
OK [READ-WRITE] Completed
expunge permanently removes messages flagged with \Deleted out of the current selected mailbox.
It returns a list of message sequence numbers that it deleted. You need to select a mailbox before you expunge. You need to read section 7.4.1 of RFC2060 to interpret the output. Essentially each time a message is deleted the sequence numbers all g...
* 3 EXPUNGE
* 3 EXPUNGE
( run in 1.004 second using v1.01-cache-2.11-cpan-39bf76dae61 )