#!/usr/bin/perl -w

use strict;
use vars qw ( %opt $imap $SERVICE $realm $host $gss_api_step $sasl $sasl_step $conn );
use Getopt::Std;
use Mail::IMAPClient;
use MIME::Base64;
use Term::ReadKey;
use Authen::Krb5;
# Authen::SASL::Cyrus needs to be installed as well !!!
# SASL2 needs to provide the gssapi auth library
use Authen::SASL;
use Authen::SASL::Cyrus;

(my $prog = $0) =~ s!.*/!!;

# on Solaris there is no system sasl2
if ( $^O eq 'solaris' ) {
$ENV{SASL_PATH} = "/usr/local/lib/sasl/2.1.15/lib/sasl2"
    if -d "/usr/local/lib/sasl/2.1.15/lib/sasl2";
}

getopts('vh:r:u:', \%opt) or usage();
my $user = getusername();

Authen::Krb5::init_context() or die "no context: $@\n";
Authen::Krb5::init_ets();
my $realm = Authen::Krb5::get_default_realm();
if ( $opt{r} and $realm ne $opt{r} ) {
    print "using realm $opt{r} instead of default realm $realm\n";
    $realm = $opt{r};
}
die "Kerberos realm unknown, please provide it with -r\n" if ! $realm;

# get the host name(s) of the imap server(s)
# the IMAP server is often called mail or imap, let's assume it is called imap
my @hosts;
if ( $opt{h} ) {
    @hosts = split(/[,\s]+/, $opt{h});
} else {
    my $server = "imap.\L$realm";
    my $rawip = gethostbyname($server);
    $server = "mail.\L$realm" if ! $rawip;
    $rawip = gethostbyname($server);
    @hosts = ( $server ) if $rawip;
}
die "No imap server name found, please specify a valid name with -h\n"
    if ! @hosts;

for $host ( @hosts ) {
    $gss_api_step = $sasl_step = 0;
    print "Connecting to $host:143 User $user\n" if $opt{v};
    $imap = Mail::IMAPClient->new(	
			    Server	=> $host,
			    User	=> $user,
    ) or die "couldn't connect to $host port 143: $!\n";
    $SERVICE = 'imap';
    $imap->authenticate('GSSAPI', \&gssapi_auth)
		       or die "Could not authenticate:$@\n";
    # handle change in Mail::IMAPClient API since version 3
    my ($quota, $maxquota);
    my $major_version = substr($Mail::IMAPClient::VERSION, 0, 1);
    if ( $major_version >= 3 ) {
	$quota = ($imap->tag_and_run('GETQUOTAROOT "INBOX" '))[2];
    } else {
	$quota = ($imap->GETQUOTAROOT("INBOX"))[1];
    }
    if ( ! $@ ) {
        ($quota, $maxquota) = $quota =~ /STORAGE (\d+) (\d+)/;
        if ( $maxquota ) {
            printf "MAILQUOTA on %s: %d of %d kB used (%.1f percent)\n",
                $host, $quota, $maxquota, 100*$quota/$maxquota;
        }
    } else {
	print $imap->LastError, "\n";
    }
    $imap->logout; # or die "Logout error: ", $imap->LastError, "\n";
}

exit;

sub usage {
    print <<EOF;
Usage: $prog [-h host] [-r realm] [-u user] [-v]
       check the mail quota for a user. Authenticate using KerberosV.
       -h host[s]  check host[s] instead of default mail server
       -r realm    use realm instead of default realm
       -u user     use user as username, different from logged in user
       -v          show authentication details and folders processed
EOF
    exit;
}

# required for the gssapi callback
sub getusername {
    die "Invalid username '$opt{u}', must be alphanumeric\n"
        if $opt{u} and $opt{u} !~ /^\w+$/;
    return $opt{u} if $opt{u};
    return getpwuid($<);
}

# gssapi_auth uses $SERVICE, $realm and $host from the calling environment
sub gssapi_auth {
    $gss_api_step++;
    if ( $gss_api_step == 1 ) {
        print "Using Kerberos5 (gssapi) for authentication\n" if $opt{v};
        $sasl = Authen::SASL->new(mechanism => 'GSSAPI',
    			          callback  => { user => \&getusername,
                                  realm => $realm }
        );
        my $ac = Authen::Krb5::AuthContext->new() or die "no context: $@\n";
        my $cc = Authen::Krb5::cc_default();
        my $ticket = Authen::Krb5::mk_req($ac, 0, $SERVICE, $host, 0, $cc);
        if ($user and ! $ticket) {
#	    system "kinit", $user;
            my $psw = read_password($user);
            my $client = Authen::Krb5::parse_name($user);
	    $realm = Authen::Krb5::get_default_realm();
            my $server = Authen::Krb5::parse_name("krbtgt/$realm");
            $cc->initialize($client);
            my $i = Authen::Krb5::get_in_tkt_with_password($client, $server, $psw, $cc);
            die "could not get ticket:$@\n", Authen::Krb5::error($i), "\n"
                unless $i;
            $ticket = Authen::Krb5::mk_req($ac, 0, $SERVICE, $host, 0, $cc);
            $ticket or die "mk_req failed";
	}
        $conn = $sasl->client_new($SERVICE, $host);
        my $err = $conn->error;
        die "gssapi_auth error in client_new: $err\n" if $err !~ /successful/;
	if ( ! grep {$_ eq 'GSSAPI' } $conn->global_listmech() ) {
	    die "SASL mechanism GSSAPI not available, known methods are\n",
	    join(', ', $conn->global_listmech()), "\n";
	}
        my $mesg = $conn->client_start;
        $err = $conn->error;
        die "gssapi_auth error in step $gss_api_step: $err\n" if $err !~ /successful/;
        return encode_base64($mesg, '');
    } else {
        my $mesg=$conn->client_step(decode_base64($_[0]));
        my $err = $conn->error;
        #print "gssapi_auth error in step $gss_api_step: $err\n" if $err;
        return encode_base64($mesg || '', '');
    }
}

sub read_password {
    local $|=1;
    my $user = $_[0] || getusername;
    print "Please enter (UNIX) password for user $user:";
    ReadMode('noecho');
    my $psw = ReadLine(0);
    chomp $psw;
    ReadMode('restore');
    print "\n";
    die "Empty password for $user, exiting.\n" unless $psw;
    return $psw;
}