source: trunk/athena/bin/mitmailutils/mitmailcreate.pl @ 23913

Revision 23913, 3.7 KB checked in by andersk, 15 years ago (diff)
In mitmailutils: * Replace test for EXCHANGE.MIT.EDU with test for *EXCHANGE*.
Line 
1#!/usr/bin/perl -w
2
3# $Id: mitmailcreate.pl,v 1.2 2004-07-29 19:11:52 rbasch Exp $
4
5# Create, remove, subscribe to or unsubscribe to IMAP mailboxes.
6
7use strict;
8use warnings FATAL => 'all';
9use Cyrus::IMAP;
10use Getopt::Long;
11
12sub usage(;$);
13sub send_command($);
14sub close_connection();
15sub errorout($);
16
17my $prog = $0;
18
19my $imap_cmd;
20my $create = 0;
21my $create_subscribe_cmd;
22
23if ($prog =~ m/create/o) {
24    $create = 1;
25    $imap_cmd = 'CREATE';
26    # If the --no-subscribe option is given, we will unsubscribe the
27    # mailbox explicitly, as a formerly existing mailbox of the same
28    # name may still be in the subscription list.
29    $create_subscribe_cmd = 'SUBSCRIBE';
30} elsif ($prog =~ m/remove/o) {
31    $imap_cmd = 'DELETE';
32} elsif ($prog =~ m/unsubscribe/o) {
33    $imap_cmd = 'UNSUBSCRIBE';
34} elsif ($prog =~ m/subscribe/o) {
35    $imap_cmd = 'SUBSCRIBE';
36}
37
38sub usage(;$) {
39    print STDERR "$prog: $_[0]\n" if ($_[0] && $_[0] ne "help");
40    print STDERR <<EOF;
41Usage: $prog [<options>]
42  Options:
43    --debug                turn on debugging
44    --help                 print this usage information
45    --host=<name>          query host <name> instead of default POBOX server
46EOF
47    if ($create) {
48        print STDERR <<EOF;
49    --no-subscribe         do not add to list of subscribed mailboxes
50EOF
51    }
52    exit 1;
53}
54
55# Parse the command line arguments.
56use vars qw($opt_debug $opt_host $opt_no_subscribe);
57
58GetOptions("debug",
59           "help" => \&usage,
60           "host=s",
61           "no-subscribe" => sub {
62               unless ($create) {
63                   usage "Unknown option: no-subscribe";
64               }
65               $opt_no_subscribe = 1;
66               $create_subscribe_cmd = 'UNSUBSCRIBE';
67           }
68           ) || usage;
69
70usage "Please specify a mailbox name" if @ARGV == 0;
71
72my $username = $ENV{'ATHENA_USER'} || $ENV{'USER'} || getlogin || (getpwuid($<))[0] ||
73    errorout "Cannot determine user name";
74
75unless ($opt_host) {
76    $opt_host = (split(" ", `hesinfo $username pobox`))[1] ||
77        errorout "Cannot find Post Office server for $username";
78}
79errorout "Exchange accounts are not supported yet. Try http://owa.mit.edu/." if $opt_host =~ /EXCHANGE/;
80
81# Connect to the IMAP server, and authenticate.
82my $client = Cyrus::IMAP->new($opt_host) ||
83    errorout "Cannot connect to IMAP server on $opt_host";
84unless ($client->authenticate(-authz => $username)) {
85    close_connection();
86    errorout "Cannot authenticate to $opt_host";
87}
88
89# Loop to act upon mailboxes given on the command line.
90foreach (@ARGV) {
91    send_command "$imap_cmd \"$_\"";
92    # If creating the mailbox, subscribe or unsubscribe to it.
93    if ($create) {
94        send_command "$create_subscribe_cmd \"$_\"";
95    }
96}
97
98# We are done talking to the IMAP server, close down the connection.
99close_connection();
100
101# Subroutine to send a command to the IMAP server, and wait for the
102# response; any defined callbacks for the response are invoked.
103# If the server response indicates failure, we error out.
104sub send_command($) {
105    print "Sending: $_[0]\n" if $opt_debug;
106    my ($status, $text) = $client->send('', '', $_[0]);
107    print "Response: status $status, text $text\n" if $opt_debug;
108    errorout "Premature end-of-file on IMAP connection to $opt_host"
109        if $status eq 'EOF';
110    if ($status ne 'OK') {
111        close_connection();
112        errorout "IMAP error on $opt_host: $text"
113    }
114}
115
116# Logout from the IMAP server, and close the connection.
117sub close_connection() {
118    $client->send('', '', "LOGOUT");
119    # Set the client reference to undef, so that perl invokes the
120    # destructor, which closes the connection.  Note that if we invoke
121    # the destructor explicitly here, then perl will still invoke it
122    # again when the program exits, thus touching memory which has
123    # already been freed.
124    $client = undef;
125}
126
127sub errorout($) {
128    print STDERR "$prog: $_[0]\n";
129    exit 1;
130}
Note: See TracBrowser for help on using the repository browser.