package Apache::AuthenIMAP;

use Apache ();
use Apache::Constants qw(OK AUTH_REQUIRED DECLINED SERVER_ERROR);
use IO::Socket;

use strict;
use vars qw($VERSION $debug);

$VERSION = '0.1';
$debug = 0;

sub handler {
    my $r = shift;
    return OK unless $r->is_initial_req;
    my ($res, $password) = $r->get_basic_auth_pw;
    return $res if $res;
    my $user = $r->connection->user;

    #
    # get host/port from Apache configuration
    # host is required; port defaults to imap.
    #
    my $host = $r->dir_config("Auth_IMAP_host") or return DECLINED;
    my $port = $r->dir_config("Auth_IMAP_port") || "imap";

    #
    # Do a sanity check on the username and password
    #
    if (length($user) > 64 || $user =~ /[^A-Za-z0-9]/) {
	$r->log_reason("Apache::AuthenIMAP username too long or contains"
		       ." illegal characters", $r->uri);
	$r->note_basic_auth_failure;
	return AUTH_REQUIRED;
    }
    if (length($password) > 256) {
	$r->log_reason("Apache::AuthenIMAP password too long", $r->uri);
	$r->note_basic_auth_failure;
	return AUTH_REQUIRED;
    }
	
    #
    # connect to IMAP server and authenticate
    #
    my $s = IO::Socket::INET->new(PeerAddr => $host, PeerPort => $port);
    if (!$s) {
	$r->log_reason("Apache::AuthenIMAP failed to connect to $host/$port",
		       $r->uri);
	return SERVER_ERROR;
    }

    #
    # Send the login request (username immediately, password as a sync literal)
    #
    printf $s qq(1 LOGIN "%s" {%d}\r\n), $user, length($password);
    while (<$s>) {
	last if /^\+/; # we're waiting for the sync literal go-ahead
	if (/^1/) {
	    $r->log_reason("Apache::AuthenIMAP bad username $user", $r->uri);
	    $r->note_basic_auth_failure;
	    return AUTH_REQUIRED;
	}
	if (!/^\*/) {
	    $r->log_reason("Apache::AuthenIMAP bad IMAP protocol from server",
			   $r->uri);
	    return SERVER_ERROR;
	}
    }

    #
    # Now send the password
    #
    print $s $password, "\r\n"; # The \r\n is necessary to prod some servers
    while (<$s>) {
	last if /^1/; # that's our reply
	if (!/^\*/) {
	    $r->log_reason("Apache::AuthenIMAP bad IMAP protocol from server",
			   $r->uri);
	    return SERVER_ERROR;
	}
    }

    #
    # See whether the user authenticated successfully
    #
    if (/^1 OK/) {
	return OK;
    } elsif (/^1 NO/) {
	$r->log_reason("Apache::AuthenIMAP auth failed for user $user",
		       $r->uri);
	$r->note_basic_auth_failure;
	return AUTH_REQUIRED;
    } else {
	$r->log_reason("Apache::AuthenIMAP bad IMAP protocol from server",
		       $r->uri);
	return SERVER_ERROR;
    }
}

1;

__END__

=head1 NAME

Apache::AuthenIMAP - Authentication via an IMAP server

=head1 SYNOPSIS

 # Configuration in httpd.conf

 PerlModule Apache::AuthenIMAP

 # Authentication in .htaccess

 AuthName IMAP
 AuthType Basic

 # authenticate via IMAP
 PerlAuthenHandler Apache::AuthenIMAP

 PerlSetVar Auth_IMAP_host imaphost.domain.foo

 require user fred

The AuthType is limited to Basic. The require directive is limited 
to 'valid-user' and 'user user_1 user_2 ...'.

=head1 DESCRIPTION

This module allows authentication against an IMAP server.

=head1 LIST OF TOKENS

=item *
Auth_IMAP_host

The IMAP server host: either its name or its dotted quad IP number.
This is passed as the PeerAddr option to IO::Socket::INET->new.

=item *
Auth_IMAP_port

The port on which the IMAP server is listening: either its service
name or its actual port number. This parameter defaults to "imap"
which is the official service name for IMAP servers. The parameter
is passed as the PeerPort option to IO::Socket::INET->new.

=head1 CONFIGURATION

The module should be loaded upon startup of the Apache daemon.
Add the following line to your httpd.conf:

 PerlModule Apache::AuthenIMAP

=head1 PREREQUISITES

For AuthenIMAP you need to enable the appropriate call-back hook 
when making mod_perl: 

  perl Makefile.PL PERL_AUTHEN=1

=head1 SEE ALSO

L<Apache>, L<mod_perl>

=head1 AUTHORS

=item *
mod_perl by Doug MacEachern <dougm@osf.org>

=item *
Apache::AuthenIMAP by Malcolm Beattie <mbeattie@sable.ox.ac.uk>

=head1 COPYRIGHT

The Apache::AuthenIMAP module is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=cut