source: trunk/athena/bin/mailquota/mailquota.pl @ 19981

Revision 19981, 7.0 KB checked in by rbasch, 21 years ago (diff)
Remove an extraneous comment line.
Line 
1#!/usr/athena/bin/perl -w
2
3# $Id: mailquota.pl,v 1.2 2003-11-07 22:49:23 rbasch Exp $
4
5# Display the IMAP resource usage on the user's post office server.
6
7use strict;
8use warnings FATAL => 'all';
9use Cyrus::IMAP;
10use Getopt::Std;
11
12sub usage(;$);
13sub print_quota($$$$$);
14sub send_command($);
15sub quota_callback(@);
16sub quotaroot_callback(@);
17sub capability_callback(@);
18sub close_and_errorout($);
19sub close_connection();
20sub errorout($);
21
22sub usage(;$) {
23    print STDERR "mailquota: $_[0]\n" if $_[0];
24    print STDERR <<EOF;
25Usage: mailquota [<options>] [<user>]
26  Options:
27    -h <host>     query <host> instead of default post office server
28    -m <mailbox>  query for <mailbox> (default is INBOX)
29    -n            be silent unless usage % is above the threshold
30    -u <percent>  usage % threshold (default is 90); implies -n
31    -d            turn on debugging
32EOF
33    exit 1;
34}
35
36my $need_header = 1;
37my $root_width = 16;
38my $num_width = 10;
39my $percent_width = 5;
40my $format = "%-${root_width}.${root_width}s" .
41    " %${num_width}s %${num_width}s %${percent_width}s" .
42    " %${num_width}s %${num_width}s %${percent_width}s\n";
43
44# Parse the command line arguments.
45my %opts;
46getopts('dh:m:nu:', \%opts) || usage;
47my $username = shift @ARGV || $ENV{'USER'} || getlogin || (getpwuid($<))[0] ||
48        errorout "Cannot determine user name";
49
50usage "Too many arguments" if @ARGV > 0;
51my $debug = $opts{'d'};
52my $warn_only = $opts{'n'};
53my $usage_threshold = $opts{'u'};
54my $host = $opts{'h'} || (split(" ", `hesinfo $username pobox`))[1] ||
55    errorout "Cannot find Post Office server for $username";
56my $mbox = $opts{'m'} || "INBOX";
57
58# Validate the usage percentage threshold, allowing a trailing %.
59# Setting the threshold implies we should only display quotas
60# for which any resource usage is above the threshold.
61if (defined $usage_threshold) {
62    chop $usage_threshold if $usage_threshold =~ /^\d+%$/;
63    usage "-u argument must be numeric" if $usage_threshold !~ /^\d+$/;
64    $warn_only = 1;
65} else {
66    $usage_threshold = 90;
67}
68
69# Connect to the IMAP server, check for the QUOTA extension, and
70# authenticate.
71my $client = Cyrus::IMAP->new($host) ||
72    errorout "Cannot connect to IMAP server on $host";
73my $caps = '';
74$client->addcallback({-trigger => 'CAPABILITY',
75                      -callback => \&capability_callback,
76                      -rock => \$caps});
77send_command "CAPABILITY";
78$caps =~ '\bQUOTA\b' ||
79    close_and_errorout "$host does not support the IMAP QUOTA extension";
80$client->authenticate(-authz => $username) ||
81    close_and_errorout "Cannot authenticate to $host";
82
83# Send the GETQUOTAROOT command, which returns both the QUOTA and
84# QUOTAROOT responses.  Quota information will be displayed via
85# the QUOTA callback.
86$client->addcallback({-trigger => 'QUOTA',
87                      -callback => \&quota_callback});
88$client->addcallback({-trigger => 'QUOTAROOT',
89                      -callback => \&quotaroot_callback});
90send_command "GETQUOTAROOT $mbox";
91
92# We are done talking to the IMAP server; close down the connection.
93close_connection();
94
95# Print the quota information for the given quota root and its
96# storage and message resource values.
97sub print_quota($$$$$) {
98    my ($root, $storage_used, $storage_max, $message_used, $message_max) = @_;
99    my $storage_percent;
100    my $storage_percent_out;
101    my $message_percent;
102    my $message_percent_out;
103
104    # Calculate the usage percentages, and format for output.
105    if ($storage_max) {
106        $storage_percent = ($storage_used / $storage_max) * 100;
107        $storage_percent_out = sprintf("%.0f%%", $storage_percent);
108    }
109    if ($message_max) {
110        $message_percent = ($message_used / $message_max) * 100;
111        $message_percent_out = sprintf("%.0f%%", $message_percent);
112    }
113
114    # Skip this quota if we are only displaying usages above the
115    # specified threshold.
116    return unless (!$warn_only ||
117                   (defined $storage_percent &&
118                    $storage_percent >= $usage_threshold) ||
119                   (defined $message_percent &&
120                    $message_percent >= $usage_threshold));
121
122    # Print a header if this is the first line of output.
123    if ($need_header) {
124        printf($format,
125               "Quota",
126               "KB Used", "KB Max", "KB %",
127               "# Msgs", "# Max", "# %");
128        $need_header = 0;
129    }
130    printf($format,
131           $root,
132           defined $storage_used ? $storage_used : '-',
133           defined $storage_max ? $storage_max : '-',
134           defined $storage_percent_out ? $storage_percent_out : '-',
135           defined $message_used ? $message_used : '-',
136           defined $message_max ? $message_max : '-',
137           defined $message_percent_out ? $message_percent_out : '-');
138}
139
140# Subroutine to send a command to the IMAP server, and wait for the
141# response; any defined callbacks for the response are invoked.
142# If the server response indicates failure, we error out.
143sub send_command($) {
144    print "Sending: $_[0]\n" if $debug;
145    my ($status, $text) = $client->send('', '', $_[0]);
146    print "Response: status $status, text $text\n" if $debug;
147    errorout "Premature end-of-file on IMAP connection to $host"
148        if $status eq 'EOF';
149    close_and_errorout "IMAP error for $mbox on $host: $text"
150        if $status ne 'OK';
151}
152
153# Callback subroutine to parse the QUOTA response.
154# The "-text" hash element contains the quota root name, and a list
155# of quota resource names, usages, and limits.  Recognized names are
156# STORAGE (sum of message sizes, in kilobytes) and MESSAGE (number of
157# messages).  See RFC 2087.
158sub quota_callback(@) {
159    my %cb = @_;
160    my ($root, $quotalist);
161    print "In QUOTA callback: text $cb{-text}\n" if $debug;
162    if (($root, $quotalist) = ($cb{-text} =~ /(\S*)\s+\((.*)\)/io)) {
163        my ($storage_used, $storage_max, $message_used, $message_max);
164        while ($quotalist) {
165            my ($resource, $used, $max);
166            ($resource, $used, $max, $quotalist) = split /\s/, $quotalist, 4;
167            last unless $max;
168            $resource = uc $resource;
169            if ($resource eq "STORAGE") {
170                $storage_used = $used;
171                $storage_max = $max;
172            }
173            elsif ($resource eq "MESSAGE") {
174                $message_used = $used;
175                $message_max = $max;
176            }
177        }
178        print_quota($root, $storage_used, $storage_max,
179                    $message_used, $message_max)
180            if (defined $storage_max || defined $message_max);
181    }
182}
183
184# Callback subroutine to parse the QUOTAROOT response.  The "-text"
185# hash element contains the mailbox name, and zero or more quota root
186# names.  This is currently used for debugging only.
187sub quotaroot_callback(@) {
188    my %cb = @_;
189    print "In QUOTAROOT callback: text $cb{-text}\n" if $debug;
190}
191
192# Callback subroutine to parse the CAPABILITY response.  The "-rock" hash
193# element is a reference to the string in which to store the space-separated
194# capability names.
195sub capability_callback(@) {
196    my %cb = @_;
197    print "In CAPABILITY callback: keyword $cb{-keyword}, text $cb{-text}\n"
198        if $debug;
199    ${$cb{-rock}} = $cb{-text};
200}
201
202# Close the connection to the IMAP server, and error out.
203sub close_and_errorout($) {
204    close_connection();
205    errorout $_[0];
206}
207
208# Logout from the IMAP server, and close the connection.
209sub close_connection() {
210    $client->send('', '', "LOGOUT");
211    $client->DESTROY();
212}
213
214sub errorout($) {
215    print STDERR "mailquota: $_[0]\n";
216    exit 1;
217}
Note: See TracBrowser for help on using the repository browser.