source: trunk/athena/bin/mitmailutils/mitmailrename.pl @ 24300

Revision 24300, 2.7 KB checked in by geofft, 15 years ago (diff)
In mitmailutils: * Switch from Hesiod to using *.mail.mit.edu so we can use GSSAPI authentication (Trac: #403). * Because of a Cyrus SASL bug (documented in that ticket) regarding parsing long encrypted responses, set maxssf to zero to send mail in the clear. This isn't as terrible as it sounds because mail travels in the clear on the public Internet anyway, and a bunch of client programs (Pine on Athena 9, for instance) don't use encryption, and the major use of mitmailutils is `from` and `mailquota` anyway. Patch based on one from Jonathan Reed <jdreed@mit.edu>.
Line 
1#!/usr/bin/perl -w
2
3# $Id: mitmailrename.pl,v 1.2 2004-07-29 19:11:53 rbasch Exp $
4
5# Rename an IMAP folder.
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
19sub usage(;$) {
20    print STDERR "$prog: $_[0]\n" if ($_[0] && $_[0] ne "help");
21    print STDERR <<EOF;
22Usage: $prog [<options>] <existing-mailbox> <new-mailbox>
23  Options:
24    --debug                turn on debugging
25    --help                 print this usage information
26    --host=<name>          query host <name> instead of default POBOX server
27EOF
28    exit 1;
29}
30
31# Parse the command line arguments.
32use vars qw($opt_debug $opt_host);
33
34GetOptions("debug", "help" => \&usage, "host=s") || usage;
35
36usage "Please specify an existing and new mailbox names" if @ARGV != 2;
37
38my $username = $ENV{'ATHENA_USER'} || $ENV{'USER'} || getlogin || (getpwuid($<))[0] ||
39    errorout "Cannot determine user name";
40
41unless ($opt_host) {
42    $opt_host = (gethostbyname("$username.mail.mit.edu"))[0];
43    errorout "Cannot find Post Office server for $username" unless $opt_host;
44}
45errorout "Exchange accounts are not supported yet. Try http://owa.mit.edu/." if $opt_host =~ /EXCHANGE/;
46
47# Connect to the IMAP server, and authenticate.
48my $client = Cyrus::IMAP->new($opt_host) ||
49    errorout "Cannot connect to IMAP server on $opt_host";
50unless ($client->authenticate(-authz => $username, -maxssf => 0)) {
51    close_connection();
52    errorout "Cannot authenticate to $opt_host";
53}
54
55# Rename the mailbox.
56send_command "RENAME \"$ARGV[0]\" \"$ARGV[1]\"";
57
58# We are done talking to the IMAP server, close down the connection.
59close_connection();
60
61# Subroutine to send a command to the IMAP server, and wait for the
62# response; any defined callbacks for the response are invoked.
63# If the server response indicates failure, we error out.
64sub send_command($) {
65    print "Sending: $_[0]\n" if $opt_debug;
66    my ($status, $text) = $client->send('', '', $_[0]);
67    print "Response: status $status, text $text\n" if $opt_debug;
68    errorout "Premature end-of-file on IMAP connection to $opt_host"
69        if $status eq 'EOF';
70    if ($status ne 'OK') {
71        close_connection();
72        errorout "IMAP error on $opt_host: $text"
73    }
74}
75
76# Logout from the IMAP server, and close the connection.
77sub close_connection() {
78    $client->send('', '', "LOGOUT");
79    # Set the client reference to undef, so that perl invokes the
80    # destructor, which closes the connection.  Note that if we invoke
81    # the destructor explicitly here, then perl will still invoke it
82    # again when the program exits, thus touching memory which has
83    # already been freed.
84    $client = undef;
85}
86
87sub errorout($) {
88    print STDERR "$prog: $_[0]\n";
89    exit 1;
90}
Note: See TracBrowser for help on using the repository browser.