home *** CD-ROM | disk | FTP | other *** search
/ ftp.urbanrage.com / 2015-02-07.ftp.urbanrage.com.tar / ftp.urbanrage.com / pub / perl / IMAP-Admin-1.4.1.tar.gz / IMAP-Admin-1.4.1.tar / IMAP-Admin-1.4.1 / Admin.pm next >
Text File  |  2000-10-26  |  22KB  |  745 lines
  1. # $Id: Admin.pm,v 1.28 2000/10/26 18:50:05 eric Exp $
  2.  
  3. package IMAP::Admin;
  4.  
  5. use strict;
  6. use Carp;
  7. use IO::Select;
  8. use IO::Socket;
  9. use IO::Socket::INET;
  10. use Text::ParseWords qw(parse_line);
  11. use Cwd;
  12.  
  13. use vars qw($VERSION);
  14.  
  15. $VERSION = '1.4.1';
  16.  
  17. sub new {
  18.     my $class = shift;
  19.     my $self = {};
  20.  
  21.     bless $self, $class;
  22.     if ((scalar(@_) % 2) != 0) {
  23.     croak "$class called with incorrect number of arguments";
  24.     }
  25.     while (@_) {
  26.     my $key = shift(@_);
  27.     my $value = shift(@_);
  28.     $self->{$key} = $value;
  29.     }
  30.     $self->{'CLASS'} = $class;
  31.     $self->_initialize;
  32.     return $self;
  33. }
  34.  
  35. sub _initialize {
  36.     my $self = shift;
  37.     
  38.     if (!defined($self->{'Server'})) {
  39.     croak "$self->{'CLASS'} not initialized properly : Server parameter missing";
  40.     }
  41.     if (!defined($self->{'Port'})) {
  42.     $self->{'Port'} = 143; # default imap port;
  43.     }
  44.     if (!defined($self->{'Login'})) {
  45.     croak "$self->{'CLASS'} not initialized properly : Login parameter missing";
  46.     }
  47.     if (!defined($self->{'Password'})) {
  48.     croak "$self->{'CLASS'} not initialized properly : Password parameter missing";
  49.     }
  50.     if (!defined($self->{'Separator'})) {
  51.     $self->{'Separator'} = "."; # set hiearchical separator to a period
  52.     }
  53.     if (defined($self->{'SSL'})) { # attempt SSL connection instead
  54.     # construct array of ssl options
  55.     my $cwd = cwd;
  56.     my %ssl_defaults = (
  57.                 'SSL_use_cert' => 0,
  58.                 'SSL_verify_mode' => 0x00,
  59.                 'SSL_key_file' => $cwd."/certs/client-key.pem",
  60.                 'SSL_cert_file' => $cwd."/certs/client-cert.pem",
  61.                 'SSL_ca_path' => $cwd."/certs",
  62.                 'SSL_ca_file' => $cwd."/certs/ca-cert.pem",
  63.                 );
  64.     my @ssl_options;
  65.     my $ssl_key;
  66.     my $key;
  67.     foreach $ssl_key (keys(%ssl_defaults)) {
  68.         if (!defined($self->{$ssl_key})) {
  69.         $self->{$ssl_key} = $ssl_defaults{$ssl_key};
  70.         }
  71.     }
  72.     foreach $ssl_key (keys(%{$self})) {
  73.         if ($ssl_key =~ /^SSL_/) {
  74.         push @ssl_options, $ssl_key, $self->{$ssl_key};
  75.         }
  76.     }
  77.     my $SSL_try = "use IO::Socket::SSL";
  78.  
  79.         eval $SSL_try;
  80. #    $IO::Socket::SSL::DEBUG = 1;
  81.     if (!eval {
  82.         $self->{'Socket'} = 
  83.           IO::Socket::SSL->new(PeerAddr => $self->{'Server'},
  84.                    PeerPort => $self->{'Port'},
  85.                    Proto => 'tcp',
  86.                    Reuse => 1,
  87.                    Timeout => 5,
  88.                    @ssl_options); }) {
  89.         $self->_error("initialize", "couldn't establish SSL connection to",
  90.               $self->{'Server'}, "[$!]");
  91.         delete $self->{'Socket'};
  92.         return;
  93.     }
  94.     } else {
  95.     if (!eval {
  96.         $self->{'Socket'} = 
  97.           IO::Socket::INET->new(PeerAddr => $self->{'Server'},
  98.                     PeerPort => $self->{'Port'},
  99.                     Proto => 'tcp',
  100.                     Reuse => 1,
  101.                     Timeout => 5); })
  102.     {
  103.         delete $self->{'Socket'};
  104.         $self->_error("initialize", "couldn't establish connection to",
  105.                $self->{'Server'});
  106.         return;
  107.               
  108.     }
  109.     }
  110.     my $fh = $self->{'Socket'};
  111.     my $try = $self->_read; # get Banner
  112.     if ($try !~ /\* OK/) {
  113.     $self->close;
  114.     $self->_error("initialize", "bad response from", $self->{'Server'},
  115.               "[", $try, "]");
  116.     return;
  117.     }
  118.     print $fh "try CAPABILITY\n";
  119.     $self->{'Capability'} = $self->_read;
  120.     $try = $self->_read;
  121.     if ($try !~ /^try OK/) {
  122.     $self->close;
  123.     $self->_error("initialize", "Couldn't do a capabilites check [",
  124.               $try, "]");
  125.     return;
  126.     }
  127.     print $fh qq{try LOGIN "$self->{'Login'}" "$self->{'Password'}"\n};
  128.     $try = $self->_read;
  129.     if ($try !~ /^try OK/) { # should tr this response
  130.     $self->close;
  131.     $self->_error("initialize", $try);
  132.     return;
  133.     } else { 
  134.     $self->{'Error'} = "No Errors";
  135.     return;
  136.     }
  137.     # fall thru, can it be hit ?
  138.     $self->{'Error'} = "No Errors";
  139.     return;
  140. }
  141.  
  142. sub _error {
  143.     my $self = shift;
  144.     my $func = shift;
  145.     my @error = @_;
  146.  
  147.     $self->{'Error'} = join(" ",$self->{'CLASS'}, "[", $func, "]:", @error);
  148. }
  149.  
  150. sub _read {
  151.     my $self = shift;
  152.     my $buffer = "";
  153.     my $char = "";
  154.     my $bytes = 1;
  155.     while ($bytes == 1) {
  156.     $bytes = sysread $self->{'Socket'}, $char, 1;
  157.     if ($bytes == 0) {
  158.         if (length ($buffer) != 0) {
  159.         return $buffer;
  160.         } else {
  161.         return;
  162.         }
  163.     } else {
  164.         if (($char eq "\n") or ($char eq "\r")) {
  165.         if (length($buffer) == 0) {
  166.             # cr or nl left over, just eat it
  167.         } else {
  168.             return $buffer;
  169.         }
  170.         } else {
  171. #        print "got char [$char]\n";
  172.         $buffer .= $char;
  173.         }
  174.     }
  175.     }
  176. }
  177.  
  178. sub close {
  179.     my $self = shift;
  180.  
  181.     if (!defined($self->{'Socket'})) {
  182.     return 0;
  183.     }
  184.     my $fh = $self->{'Socket'};
  185.     print $fh "try logout\n";
  186.     my $try = $self->_read;
  187.     close($self->{'Socket'});
  188.     delete $self->{'Socket'};
  189.     return 0;
  190. }
  191.  
  192. sub create {
  193.     my $self = shift;
  194.  
  195.     if (!defined($self->{'Socket'})) {
  196.     return 1;
  197.     }
  198.     if ((scalar(@_) != 1) && (scalar(@_) != 2)) {
  199.     $self->_error("create", "incorrect number of arguments");
  200.     return 1;
  201.     }
  202.     my $mailbox = shift;
  203.     my $fh = $self->{'Socket'};
  204.     if (scalar(@_) == 1) { # a partition exists
  205.     print $fh qq{try CREATE "$mailbox" $_[0]\n};
  206.     } else {
  207.     print $fh qq{try CREATE "$mailbox"\n};
  208.     }
  209.     my $try = $self->_read;
  210.     if ($try =~ /^try OK/) {
  211.     $self->{'Error'} = 'No Errors';
  212.     return 0;
  213.     } else {
  214.     $self->_error("create", "couldn't create", $mailbox, ":", $try);
  215.     return 1;
  216.     }
  217. }
  218.  
  219. sub rename {
  220.     my $self = shift;
  221.  
  222.     if (!defined($self->{'Socket'})) {
  223.     return 1;
  224.     }
  225.     if (scalar(@_) != 2) {
  226.     $self->_error("rename", "incorrect number of arguments");
  227.     return 1;
  228.     }
  229.     my $old_name = shift;
  230.     my $new_name = shift;
  231.  
  232.     my $fh = $self->{'Socket'};
  233.     print $fh qq{try RENAME "$old_name" "$new_name"\n};
  234.     my $try = $self->_read;
  235.     if ($try =~ /^try OK/) {
  236.     $self->{'Error'} = 'No Errors';
  237.     return 0;
  238.     } else {
  239.     $self->_error("rename", "couldn't rename", $old_name, "to", $new_name,
  240.               ":", $try);
  241.     return 1;
  242.     }
  243. }
  244.  
  245. sub delete {
  246.     my $self = shift;
  247.  
  248.     if (!defined($self->{'Socket'})) {
  249.     return 1;
  250.     }
  251.     if (scalar(@_) != 1) {
  252.     $self->_error("delete", "incorrect number of arguments");
  253.     return 1;
  254.     }
  255.     my $mailbox = shift;
  256.     my $fh = $self->{'Socket'};
  257.     print $fh qq{try DELETE "$mailbox"\n};
  258.     my $try = $self->_read;
  259.     if ($try =~ /^try OK/) {
  260.     $self->{'Error'} = 'No Errors';
  261.     return 0;
  262.     } else {
  263.     $self->_error("delete", "couldn't delete", $mailbox, ":", $try);
  264.     return 1;
  265.     }
  266. }
  267.  
  268. sub h_delete {
  269.     my $self = shift;
  270.  
  271.     if (!defined($self->{'Socket'})) {
  272.     return 1;
  273.     }
  274.     if (scalar(@_) != 1) {
  275.     $self->_error("h_delete", "incorrect number of arguments");
  276.     return 1;
  277.     }
  278.     my $mailbox = shift;
  279.     my $fh = $self->{'Socket'};
  280.     # first get a list of all sub boxes then nuke them, accumulate errors
  281.     # then do something intelligent with them (hmmmmm)
  282.     my $box = join($self->{'Separator'}, $mailbox, "*");
  283.     my @sub_boxes = $self->list($box);
  284.     push @sub_boxes, $mailbox;
  285.     # uncomment following line if you are sanity checking h_delete
  286.     # print "h_delete: got this list of sub boxes [@sub_boxes]\n";
  287.     foreach $box (@sub_boxes) {
  288.     print $fh qq{try DELETE "$box"\n};
  289.     my $try = $self->_read;
  290.     if ($try =~ /^try OK/) {
  291.         $self->{'Error'} = 'No Errors';
  292.     } else {
  293.         $self->_error("h_delete", "couldn't delete", 
  294.               $mailbox, ":", $try);
  295.         return 1; # or just return on the first encountered error ?
  296.     }
  297.     }
  298.     return 0;
  299. }
  300.  
  301. sub get_quotaroot { # returns an array or undef
  302.     my $self = shift;
  303.     my (@quota, @info);
  304.  
  305.     if (!defined($self->{'Socket'})) {
  306.     return 1;
  307.     }
  308.     if (!($self->{'Capability'} =~ /QUOTA/)) {
  309.     $self->_error("get_quotaroot", "QUOTA not listed in server's capabilities");
  310.     return 1;
  311.     }
  312.     if (scalar(@_) != 1) {
  313.     $self->_error("get_quotaroot", "incorrect number of arguments");
  314.     return 1;
  315.     }
  316.     my $mailbox = shift;
  317.     my $fh = $self->{'Socket'};
  318.     print $fh qq{try GETQUOTAROOT "$mailbox"\n};
  319.     my $try = $self->_read;
  320.     while ($try =~ /^\* QUOTA/) {
  321.     $try =~ tr/\)\(//d;
  322.     @info = (split(' ', $try))[2,4,5];
  323.     push @quota, @info;
  324.     $try = $self->_read;
  325.     }
  326.     if ($try =~ /^try OK/) {
  327.     return @quota;
  328.     } else {
  329.     $self->_error("get_quotaroot", "couldn't get quota for", $mailbox, ":", $try);
  330.     return;
  331.     }
  332. }
  333.  
  334. sub get_quota { # returns an array or undef
  335.     my $self = shift;
  336.     my (@quota, @info);
  337.  
  338.     if (!defined($self->{'Socket'})) {
  339.     return;
  340.     }
  341.     if (!($self->{'Capability'} =~ /QUOTA/)) {
  342.     $self->_error("get_quota", 
  343.               "QUOTA not listed in server's capabilities");
  344.     return;
  345.     }
  346.     if (scalar(@_) != 1) {
  347.     $self->_error("get_quota", "incorrect number of arguments");
  348.     return;
  349.     }
  350.     my $mailbox = shift;
  351.     my $fh = $self->{'Socket'};
  352.     print $fh qq{try GETQUOTA "$mailbox"\n};
  353.     my $try = $self->_read;
  354.     while ($try =~ /^\* QUOTA/) {
  355.     $try =~ tr/\)\(//d;
  356.     @info = (split(' ',$try))[2,4,5];
  357.     push @quota, @info;
  358.     $try = $self->_read;
  359.     }
  360.     if ($try =~ /^try OK/) {
  361.     return @quota;
  362.     } else {
  363.     $self->_error("get_quota", "couldn't get quota for", $mailbox, ":", $try);
  364.     return;
  365.     }
  366. }
  367.  
  368. sub set_quota {
  369.     my $self = shift;
  370.  
  371.     if (!defined($self->{'Socket'})) {
  372.     return 1;
  373.     }
  374.     if (!($self->{'Capability'} =~ /QUOTA/)) {
  375.     $self->_error("set_quota", "QUOTA not listed in server's capabilities");
  376.     return 1;
  377.     }
  378.     if (scalar(@_) != 2) {
  379.     $self->_error("set_quota", "incorrect number of arguments");
  380.     return 1;
  381.     }
  382.     my $mailbox = shift;
  383.     my $quota = shift;
  384.     my $fh = $self->{'Socket'};
  385.     if ($quota eq "none") {
  386.     print $fh qq{try SETQUOTA "$mailbox" ()\n};
  387.     } else {
  388.     print $fh qq{try SETQUOTA "$mailbox" (STORAGE $quota)\n};
  389.     }
  390.     my $try = $self->_read;
  391.     if ($try =~ /^try OK/) {
  392.     $self->{'Error'} = "No Errors";
  393.     return 0;
  394.     } else {
  395.     $self->_error("set_quota", "couldn't set quota for", $mailbox, ":", $try);
  396.     return 1;
  397.     }
  398. }
  399.  
  400. sub subscribe {
  401.     my $self = shift;
  402.  
  403.     if (!defined($self->{'Socket'})) {
  404.     return 1;
  405.     }
  406.     if (scalar(@_) != 1) {
  407.     $self->_error("subscribe", "incorrect number of arguments");
  408.     return 1;
  409.     }
  410.     my $mailbox = shift;
  411.     my $fh = $self->{'Socket'};
  412.     print $fh qq{try SUBSCRIBE "$mailbox"\n};
  413.     my $try = $self->_read;
  414.     if ($try !~ /^try OK/) {
  415.     $self->_error("subscribe", "couldn't suscribe ", $mailbox, ":",
  416.               $try);
  417.     return 1;
  418.     }
  419.     $self->{'Error'} = 'No Errors';
  420.     return 0;
  421. }
  422.  
  423. sub unsubscribe {
  424.     my $self = shift;
  425.  
  426.     if (!defined($self->{'Socket'})) {
  427.     return 1;
  428.     }
  429.     if (scalar(@_) != 1) {
  430.     $self->_error("unsubscribe", "incorrect number of arguments");
  431.     return 1;
  432.     }
  433.     my $mailbox = shift;
  434.     my $fh = $self->{'Socket'};
  435.     print $fh qq{try UNSUBSCRIBE "$mailbox"\n};
  436.     my $try = $self->_read;
  437.     if ($try !~ /^try OK/) {
  438.     $self->_error("unsubscribe", "couldn't unsuscribe ", $mailbox, ":",
  439.               $try);
  440.     return 1;
  441.     }
  442.     $self->{'Error'} = 'No Errors';
  443.     return 0;
  444. }
  445.  
  446.  
  447. sub get_acl { # returns an array or undef
  448.     my $self = shift;
  449.     my (@info, @acl_item, @acl, $item);
  450.  
  451.     if (!defined($self->{'Socket'})) {
  452.     return;
  453.     }
  454.     if (!($self->{'Capability'} =~ /ACL/)) {
  455.     $self->_error("get_acl", "ACL not listed in server's capabilities");
  456.     return;
  457.     }
  458.     if (scalar(@_) != 1) {
  459.     $self->_error("get_acl", "incorrect number of arguments");
  460.     return;
  461.     }
  462.     my $mailbox = shift;
  463.     my $fh = $self->{'Socket'};
  464.     print $fh qq{try GETACL "$mailbox"\n};
  465.     my $try = $self->_read;
  466.     while ($try =~ /^\* ACL/) {
  467.     @info = split(' ',$try,4);
  468.         @acl_item = split(' ',$info[3]);
  469.     push @acl, @acl_item;
  470.     $try = $self->_read;
  471.     }
  472.     if ($try =~ /^try OK/) {
  473.     return @acl;
  474.     } else {
  475.     $self->_error("get_acl", "couldn't get acl for", $mailbox, ":", $try);
  476.     return;
  477.     }
  478. }
  479.  
  480. sub set_acl {
  481.     my $self = shift;
  482.     my ($id, $acl);
  483.  
  484.     if (!defined($self->{'Socket'})) {
  485.     return 1;
  486.     }
  487.     if (!($self->{'Capability'} =~ /ACL/)) {
  488.     $self->_error("set_acl", "ACL not listed in server's capabilities");
  489.     return 1;
  490.     }
  491.     if (scalar(@_) < 2) {
  492.     $self->_error("set_acl", "too few arguments");
  493.     return 1;
  494.     }
  495.     if ((scalar(@_) % 2) == 0) {
  496.     $self->_error("set_acl", "incorrect number of arguments");
  497.     return 1;
  498.     }
  499.     my $mailbox = shift;
  500.     my $fh = $self->{'Socket'};
  501.     while(@_) {
  502.     $id = shift;
  503.     $acl = shift;
  504.     print $fh qq{try SETACL "$mailbox" "$id" "$acl"\n};
  505.     my $try = $self->_read;
  506.     if ($try !~ /^try OK/) {
  507.         $self->_error("set_acl", "couldn't set acl for", $mailbox, $id, 
  508.              $acl, ":", $try);
  509.         return 1;
  510.     }
  511.     }
  512.     $self->{'Error'} = 'No Errors';
  513.     return 0;
  514. }
  515.  
  516. sub delete_acl {
  517.     my $self = shift;
  518.     my ($id, $acl);
  519.  
  520.      if (!defined($self->{'Socket'})) {
  521.     return 1;
  522.     }
  523.    if (!($self->{'Capability'} =~ /ACL/)) {
  524.     $self->_error("delete_acl", "ACL not listed in server's capabilities");
  525.     return 1;
  526.     }
  527.     if (scalar(@_) < 1) {
  528.     $self->_error("delete_acl", "incorrect number of arguments");
  529.     return 1;
  530.     }
  531.     my $mailbox = shift;
  532.     my $fh = $self->{'Socket'};
  533.     while(@_) {
  534.     $id = shift;
  535.     print $fh qq{try DELETEACL "$mailbox" "$id"\n};
  536.     my $try = $self->read;
  537.     if ($try !~ /^try OK/) {
  538.         $self->_error("delete_acl", "couldn't delete acl for", $mailbox,
  539.               $id, $acl, ":", $try);
  540.         return 1;
  541.     }
  542.     }
  543.     return 0;
  544. }
  545.  
  546. sub list { # wild cards are allowed, returns array or undef
  547.     my $self = shift;
  548.     my (@info, @mail);
  549.  
  550.     if (!defined($self->{'Socket'})) {
  551.     return;
  552.     }
  553.     if (scalar(@_) != 1) {
  554.     $self->_error("list", "incorrect number of arguments");
  555.     return;
  556.     }
  557.     my $list = shift;
  558.     my $fh = $self->{'Socket'};
  559.     print $fh qq{try LIST "" "$list"\n};
  560.     my $try = $self->_read;
  561.     while ($try =~ /^\* LIST.*?\) \".\" \"*(.*?)\"*$/) { # danger danger (could lock up needs timeout)
  562.     push @mail, $1;
  563.     $try = $self->_read;
  564.     }
  565.     if ($try =~ /^try OK/) {
  566.     return @mail;
  567.     } else {
  568.     $self->_error("list", "couldn't get list for", $list, ":", $try);
  569.     return;
  570.     }
  571. }
  572.  
  573.  
  574. # Autoload methods go after =cut, and are processed by the autosplit program.
  575.  
  576. 1;
  577. __END__
  578.  
  579. =head1 NAME
  580.  
  581. IMAP::Admin - Perl module for basic IMAP server administration
  582.  
  583. =head1 SYNOPSIS
  584.  
  585.   use IMAP::Admin;
  586.     
  587.   $imap = IMAP::Admin->new('Server' => 'name.of.server.com',
  588.                'Login' => 'login_of_imap_administrator',
  589.                'Password' => 'password_of_imap_adminstrator',
  590.                'Port' => port# (143 is default),
  591.                'Separator' => ".", # default is a period
  592.                'SSL' => 1, # off by default
  593.                # and any of the SSL_ options from IO::Socket::SSL
  594.                );
  595.  
  596.   $err = $imap->create("user.bob");
  597.   if ($err != 0) {
  598.     print "$imap->{'Error'}\n";
  599.   }
  600.   $err = $imap->create("user.bob", "green"); 
  601.   $err = $imap->delete("user.bob");
  602.   $err = $imap->h_delete("user.bob");
  603.  
  604.   $err = $imap->subscribe("user.bob");
  605.   $err = $imap->unsubscribe("user.bob");
  606.  
  607.   $err = $imap->rename("bboard", "newbboard");
  608.  
  609.   @quota = $imap->get_quotaroot("user.bob");
  610.   @quota = $imap->get_quota("user.bob");
  611.   $err = $imap->set_quota("user.bob", 10000);
  612.  
  613.   @acl = $imap->get_acl("user.bob");
  614.   $err = $imap->set_acl("user.bob", "admin", "lrswipdca", "joe", "lrs");
  615.   $err = $imap->delete_acl("user.bob", "joe", "admin");
  616.  
  617.   @list = $imap->list("user.bob");
  618.   @list = $imap->list("user.b*");
  619.  
  620.   $imap->{'Capability'} # this contains the Capabilities reply from the IMAP server
  621.  
  622.   $imap->close; # close open imap connection
  623.  
  624. =head1 DESCRIPTION
  625.  
  626. 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.
  627.  
  628. 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 they are supported.
  629.  
  630. 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.
  631.  
  632. 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).
  633.  
  634. 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 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).
  635.  
  636. I generated my ca cert and ca key with openssl:
  637.  openssl req -x509 -newkey rsa:1024 -keyout ca-key.pem -out ca-cert.pem
  638.  
  639. I generated my client key and cert with openssl:
  640.  openssl req -new -newkey rsa:1024 -keyout client-key.pem -out req.pem -nodes
  641.  openssl x509 -CA ca-cert.pem -CAkey ca-key.pem -req -in req.pem -out client-cert.pem -addtrust clientAuth -days 600
  642.  
  643. Setting up SSL Cyrus IMAP v 2.x (completely unofficial, but it worked for me)
  644.  add these to your /etc/imapd.conf (remember to change /usr/local/cyrus/tls to wherever yours is)
  645.   tls_ca_path: /usr/local/cyrus/tls
  646.   tls_ca_file: /usr/local/cyrus/tls/ca-cert.pem
  647.   tls_key_file: /usr/local/cyrus/tls/serv-key.pem
  648.   tls_cert_file: /usr/local/cyrus/tls/serv-cert.pem
  649.  
  650. For my server key I used a self signed certificate:
  651.  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)
  652.  
  653. 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):
  654.   imap2  cmd="imapd -s" listen="simap" prefork=0
  655.  
  656. where simap in /etc/services is:
  657.   simap  993/tcp   # IMAP over SSL
  658.  
  659. =head2 MAILBOX FUNCTIONS
  660.  
  661. RFC2060 commands.  These should work with any RFC2060 compliant IMAP mail servers.
  662.  
  663. create makes new mailboxes.  Cyrus IMAP, for normal mailboxes, has the user. prefix.
  664. 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 IMAP and Mirapoint).
  665.  
  666. delete destroys mailboxes.
  667. 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.
  668.  
  669. h_delete hierarchical delete (I don't believe this is RFC anything)
  670. 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.
  671.  
  672. list lists mailboxes.  list accepts wildcard matching
  673.  
  674. subscribe/unsubscribe does this action on given mailbox.
  675.  
  676. 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.
  677.  
  678. =head2 QUOTA FUNCTIONS
  679.  
  680. RFC2087 imap extensions.  These are supported by Cyrus IMAP and Mirapoint.
  681.  
  682. 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. 
  683. $quota[0] <- mailbox name
  684. $quota[1] <- quota amount used in kbytes
  685. $quota[2] <- quota in kbytes
  686.  
  687. set_quota sets the quota.  The number is in kilobytes so 10000 is approximately 10Meg.
  688. set_quota returns a 0 on success or a 1 on failure.  An error message is placed in the object->{'Error'} variable on failure.
  689.  
  690. To delete a quota do a set_quota($mailbox, "none");
  691.  
  692.  
  693. =head2 ACCESS CONTROL FUNCTIONS
  694.  
  695. RFC2086 imap extensions.  These are supported by Cyrus IMAP, Mirapoint and probably many others.
  696.  
  697. 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
  698. $acl[0] user who has acl information
  699. $acl[1] acl information
  700. $acl[2] next user ...
  701.  
  702. 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.
  703.  
  704. 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.
  705.  
  706. standard rights (rfc2086):
  707.  l - lookup (mailbox is visible to LIST/LSUB commands)
  708.  r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL, SEARCH, and COPY)
  709.  s - keep seen/unssen information across sessions (STORE SEEN flag)
  710.  w - write (STORE flags other then SEEN and DELETED)
  711.  i - insert (perform APPEND and COPY into mailbox)
  712.  p - post (send mail to submission address for mailbox)
  713.  c - create (CREATE new sub-mailboxes) (*note* allows for delete of sub mailboxes as well)
  714.  d - delete (STORE DELETED flag, perform EXPUNGE)
  715.  a - administer (perform SETACL)
  716.  
  717. The access control information is from Cyrus IMAP.
  718.   read   = "lrs"
  719.   post   = "lrsp"
  720.   append = "lrsip"
  721.   write  = "lrswipcd"
  722.   all    = "lrswipcda"
  723.  
  724. =head1 KNOWN BUGS
  725.  
  726. 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.
  727.  
  728. =head1 LICENSE
  729.  
  730. 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...
  731.  
  732. =head1 CVS REVISION
  733.  
  734. $Id: Admin.pm,v 1.28 2000/10/26 18:50:05 eric Exp $
  735.  
  736. =head1 AUTHOR
  737.  
  738. Eric Estabrooks, eric@urbanrage.com
  739.  
  740. =head1 SEE ALSO
  741.  
  742. perl(1).
  743.  
  744. =cut
  745.