Perl module for basic imap server administration
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
IMAP::Admin provides basic \s-1IMAP\s0 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 \s-1RFC\s0 compliant \s-1IMAP\s0 server, but I currently have only tested it against Carnegie Mellon University's Cyrus \s-1IMAP\s0 and Mirapoint's \s-1IMAP\s0 servers. It does a \s-1CAPABILITY\s0 check for specific extensions to see if they are supported.
Operationally it opens a socket connection to the \s-1IMAP\s0 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 (\*(L"/\*(R" might be another popular one).
\s-1CRAM\s0 on the new call will attempt to use \s-1CRAM-MD5\s0 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
\s-1SSL\s0 on the new call will attempt to make an \s-1SSL\s0 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 key. By default these are in current_directory/certs, respectively named ca-cert.pem, client-cert.pem, and client-key.pem. The location of this can be overridden by setting SSL_ca_file, SSL_cert_file, and SSL_key_file (you'll probably want to also set SSL_ca_path).
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 \s-1SSL\s0 Cyrus \s-1IMAP\s0 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 \s-1RFC2595\s0 compliant can issue a \s-1STARTTLS\s0 to initiate the secure layer, but currently IMAP::Admin doesn't issue this command (in \s-1SERVICES\s0 section):
imap2 cmd=\*(L"imapd -s\*(R" listen=\*(L"simap\*(R" prefork=0
where simap in /etc/services is:
simap 993/tcp # \s-1IMAP\s0 over \s-1SSL\s0
\s-1RFC2060\s0 commands. These should work with any \s-1RFC2060\s0 compliant \s-1IMAP\s0 mail servers.
create makes new mailboxes. Cyrus \s-1IMAP\s0, 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 not, but it is supported by Cyrus \s-1IMAP\s0 and Mirapoint).
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. If you wish to insure a hierarchical delete use the h_delete command as it deletes starting with the subfolders and back up to the specified mailbox. delete returns a 0 on success or a 1 on failure. An error message is placed in the object->{'Error'} variable on failure.
h_delete hierarchical delete (I don't believe this is \s-1RFC\s0 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'} variable. Don't forget to set your Separator if it's not a period.
list lists mailboxes. list accepts wildcard matching
subscribe/unsubscribe does this action on given mailbox.
rename renames a mailbox. \s-1IMAP\s0 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 \s-1IMAP\s0 server will move a renamed mailbox to the default partition unless a partition is given. You can optionally supply a partition name as an extra argument to this function.
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 \s-1IMAP\s0 server has it implemented as recursive. It returns an error or an array that contains information about the mailbox. For example: \s-1FLAGS\s0 (\Answered \Flagged \Draft \Deleted \Seen $Forwarded $MDNSent NonJunk Junk $Label7) \s-1OK\s0 [\s-1PERMANENTFLAGS\s0 (\Deleted)] 2285 \s-1EXISTS\s0 2285 \s-1RECENT\s0 \s-1OK\s0 [\s-1UNSEEN\s0 1] \s-1OK\s0 [\s-1UIDVALIDITY\s0 1019141395] \s-1OK\s0 [\s-1UIDNEXT\s0 293665] \s-1OK\s0 [\s-1READ-WRITE\s0] 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 \s-1RFC2060\s0 to interpret the output. Essentially each time a message is deleted the sequence numbers all get decremented so you can see the same message sequence number several times in the list of deleted messages. In the following example (taken from the \s-1RFC\s0) messages 3, 4, 7, and 11 were deleted: * 3 \s-1EXPUNGE\s0 * 3 \s-1EXPUNGE\s0 * 5 \s-1EXPUNGE\s0 * 8 \s-1EXPUNGE\s0 . \s-1OK\s0 \s-1EXPUNGE\s0 completed
\s-1RFC2087\s0 imap extensions. These are supported by Cyrus \s-1IMAP\s0 and Mirapoint.
get_quotaroot and get_quota retrieve quota information. They return an array on success and undef on failure. In the event of a failure the error is place in the object->{'Error'} variable. The array has three elements for each item in the quota. $quota[0] <- mailbox name $quota[1] <- quota amount used in kbytes $quota[2] <- quota in kbytes
set_quota sets the quota. The number is in kilobytes so 10000 is approximately 10Meg. set_quota returns a 0 on success or a 1 on failure. An error message is placed in the object->{'Error'} variable on failure.
To delete a quota do a set_quota($mailbox, \*(L"none\*(R");
\s-1RFC2086\s0 imap extensions. These are supported by Cyrus \s-1IMAP\s0, Mirapoint and probably many others.
get_acl retrieves acl information. It returns an array on success and under on failure. In the event of a failure the error is placed in the object->{'Error'} variable. The array contains a pair for each person who has an acl on this mailbox $acl[0] user who has acl information $acl[1] acl information $acl[2] next user ...
You could also treat the return from get_acl as a hash, in which case the user is the key and the acl information is the value.
set_acl set acl information for a single mailbox. You can specify more the one user's rights on the same set call. It returns a 0 on success or a 1 on failure. An error message is placed in the object->{'Error'} variable on failure.
delete_acl removes acl information on a single mailbox for the given users. You can specify more the one users rights to be removed in the same delete_acl call. It returns a 0 on success or a 1 on failure. An error message is placed int the object->{'Error'} variable on failure.
standard rights (rfc2086): l - lookup (mailbox is visible to \s-1LIST/LSUB\s0 commands) r - read (\s-1SELECT\s0 the mailbox, perform \s-1CHECK\s0, \s-1FETCH\s0, \s-1PARTIAL\s0, \s-1SEARCH\s0, and \s-1COPY\s0) s - keep seen/unssen information across sessions (\s-1STORE\s0 \s-1SEEN\s0 flag) w - write (\s-1STORE\s0 flags other then \s-1SEEN\s0 and \s-1DELETED\s0) i - insert (perform \s-1APPEND\s0 and \s-1COPY\s0 into mailbox) p - post (send mail to submission address for mailbox) c - create (\s-1CREATE\s0 new sub-mailboxes) (*note* allows for delete of sub mailboxes as well) d - delete (\s-1STORE\s0 \s-1DELETED\s0 flag, perform \s-1EXPUNGE\s0) a - administer (perform \s-1SETACL\s0)
The access control information is from Cyrus \s-1IMAP\s0.
read = \*(L"lrs\*(R" post = \*(L"lrsp\*(R" append = \*(L"lrsip\*(R" write = \*(L"lrswipcd\*(R" all = \*(L"lrswipcda\*(R"
Currently all the of the socket traffic is handled via prints and _read. This means that some of the calls could hang if the socket connection is broken. Eventually the will be properly selected and timed.
This is licensed under the Artistic license (same as perl). A copy of the license is included in this package. The file is called Artistic. If you use this in a product or distribution drop me a line, 'cause I am always curious about that...
$Id: Admin.pm,v 1.37 2002/02/01 22:46:57 eric Exp $
Eric Estabrooks, [email protected]
perl\|(1).