Auth changes (John Peacock with minor modifications by baud)
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@252 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
29ac28601b
commit
011f44e11d
347
lib/Qpsmtpd/Auth.pm
Normal file
347
lib/Qpsmtpd/Auth.pm
Normal file
@ -0,0 +1,347 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
Qpsmtpd::Auth - Authentication framework for qpsmtpd
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
Provides support for SMTP AUTH within qpsmtpd transactions, see
|
||||||
|
|
||||||
|
L<http://www.faqs.org/rfcs/rfc2222.html>
|
||||||
|
L<http://www.faqs.org/rfcs/rfc2554.html>
|
||||||
|
|
||||||
|
for more details.
|
||||||
|
|
||||||
|
=head1 USAGE
|
||||||
|
|
||||||
|
This module is automatically loaded by Qpsmtpd::SMTP only if a plugin
|
||||||
|
providing one of the defined L<Auth Hooks> is loaded. The only
|
||||||
|
time this can happen is if the client process employs the EHLO command to
|
||||||
|
initiate the SMTP session. If the client uses HELO, the AUTH command is
|
||||||
|
not available and this module isn't even loaded.
|
||||||
|
|
||||||
|
=head2 Plugin Design
|
||||||
|
|
||||||
|
An authentication plugin can bind to one or more auth hooks or bind to all
|
||||||
|
of them at once. See L<Multiple Hook Behavior> for more details.
|
||||||
|
|
||||||
|
All plugins must provide two functions:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item * register()
|
||||||
|
|
||||||
|
This is the standard function which is called by qpsmtpd for any plugin
|
||||||
|
listed in config/plugins. Typically, an auth plugin should register at
|
||||||
|
least one hook, like this:
|
||||||
|
|
||||||
|
|
||||||
|
sub register {
|
||||||
|
my ($self, $qp) = @_;
|
||||||
|
|
||||||
|
$self->register_hook("auth", "authfunction");
|
||||||
|
}
|
||||||
|
|
||||||
|
where in this case "auth" means this plugin expects to support any of
|
||||||
|
the defined authentication methods.
|
||||||
|
|
||||||
|
=item * authfunction()
|
||||||
|
|
||||||
|
The plugin must provide an authentication function which is part of
|
||||||
|
the register_hook call. That function will receive the following
|
||||||
|
six parameters when called:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item $self
|
||||||
|
|
||||||
|
A Qpsmtpd::Plugin object, which can be used, for example, to emit log
|
||||||
|
entries or to send responses to the remote SMTP client.
|
||||||
|
|
||||||
|
=item $transaction
|
||||||
|
|
||||||
|
A Qpsmtpd::Transaction object which can be used to examine information
|
||||||
|
about the current SMTP session like the remote IP address.
|
||||||
|
|
||||||
|
=item $user
|
||||||
|
|
||||||
|
Whatever the remote SMTP client sent to identify the user (may be bare
|
||||||
|
name or fully qualified e-mail address).
|
||||||
|
|
||||||
|
=item $clearPassword
|
||||||
|
|
||||||
|
If the particular authentication method supports unencrypted passwords
|
||||||
|
(currently PLAIN and LOGIN), which will be the plaintext password sent
|
||||||
|
by the remote SMTP client.
|
||||||
|
|
||||||
|
=item $hashPassword
|
||||||
|
|
||||||
|
An encrypted form of the remote user's password, using the MD-5 algorithm
|
||||||
|
(see also the $ticket parameter).
|
||||||
|
|
||||||
|
=item $ticket
|
||||||
|
|
||||||
|
This is the cryptographic challenge which was sent to the client as part
|
||||||
|
of a CRAM-MD5 transaction. Since the MD-5 algorithm is one-way, the same
|
||||||
|
$ticket value must be used on the backend to compare with the encrypted
|
||||||
|
password sent in $hashPassword.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
Plugins should perform whatever checking they want and then return one
|
||||||
|
of the following values (taken from Qpsmtpd::Constants):
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item OK
|
||||||
|
|
||||||
|
If the authentication has succeeded, the plugin can return this value and
|
||||||
|
all subsequently registered hooks will be skipped.
|
||||||
|
|
||||||
|
=item DECLINE
|
||||||
|
|
||||||
|
If the authentication has failed, but any additional plugins should be run,
|
||||||
|
this value will be returned. If none of the registered plugins succeed, the
|
||||||
|
overall authentication will fail.
|
||||||
|
|
||||||
|
=item DENY
|
||||||
|
|
||||||
|
If the authentication has failed, and the plugin wishes this to short circuit
|
||||||
|
any further testing, it should return this value. For example, a plugin could
|
||||||
|
register the L<auth-plain> hook and immediately fail any connection which is
|
||||||
|
not trusted (i.e. not in the same network).
|
||||||
|
|
||||||
|
Another reason to return DENY over DECLINE would be if the user name matched
|
||||||
|
an existing account but the password failed to match. This would make a
|
||||||
|
dictionary-based attack much harder to accomplish. See the example authsql
|
||||||
|
plugin for how this might be accomplished
|
||||||
|
|
||||||
|
By returning DENY, no further authentication attempts will be made using the
|
||||||
|
current method and data. A remote SMTP client is free to attempt a second
|
||||||
|
auth method if the first one fails.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
Plugins may also return an optional message with the return code, e.g.
|
||||||
|
|
||||||
|
return (DENY, "If you forgot your password, contact your admin");
|
||||||
|
|
||||||
|
and this will be appended to whatever response is sent to the remote SMTP
|
||||||
|
client. There is no guarantee that the end user will see this information,
|
||||||
|
though, since some prominent MTA's (produced by M$oft) I<helpfully>
|
||||||
|
hide this information under the default configuration. This message will
|
||||||
|
be logged locally, if appropriate based on the configured log level. If
|
||||||
|
you are running multiple auth plugins, it is helpful to include at least
|
||||||
|
the plugin name in the returned message (for debugging purposes).
|
||||||
|
|
||||||
|
=head1 Auth Hooks
|
||||||
|
|
||||||
|
The currently defined authentication methods are:
|
||||||
|
|
||||||
|
=over 4
|
||||||
|
|
||||||
|
=item * auth-plain
|
||||||
|
|
||||||
|
Any plugin which registers an auth-plain hook will engage in a plaintext
|
||||||
|
prompted negotiation. This is the least secure authentication method since
|
||||||
|
both the user name and password are visible in plaintext. Most SMTP clients
|
||||||
|
will preferentially chose a more secure method if it is advertised by the
|
||||||
|
server.
|
||||||
|
|
||||||
|
=item * auth-login
|
||||||
|
|
||||||
|
A slightly more secure method where the username and password are Base-64
|
||||||
|
encoded before sending. This is still an insecure method, since it is
|
||||||
|
trivial to decode the Base-64 data. Again, it will not normally be chosen
|
||||||
|
by SMTP clients unless a more secure method is not available (or if it fails).
|
||||||
|
CURRENTLY NOT SUPPORTED DUE TO LACK OF DOCUMENTATION ON FUNCTIONALITY
|
||||||
|
|
||||||
|
=item * auth-cram-md5
|
||||||
|
|
||||||
|
A cryptographically secure authentication method which employs a one-way
|
||||||
|
hashing function to transmit the secret information without significant
|
||||||
|
risk between the client and server. The server provides a challenge key
|
||||||
|
L<$ticket>, which the client uses to encrypt the user's password.
|
||||||
|
Then both user name and password are concatenated and Base-64 encoded before
|
||||||
|
transmission.
|
||||||
|
|
||||||
|
This hook must normally have access to the user's plaintext password,
|
||||||
|
since there is no way to extract that information from the transmitted data.
|
||||||
|
Since the CRAM-MD5 scheme requires that the server send the challenge
|
||||||
|
L<$ticket> before knowing what user is attempting to log in, there is no way
|
||||||
|
to use any existing MD5-encrypted password (like is frequently used with MySQL).
|
||||||
|
|
||||||
|
=item * auth
|
||||||
|
|
||||||
|
A catch-all hook which requires that the plugin support all three preceeding
|
||||||
|
authentication methods. Any plugins registering the auth hook will be run
|
||||||
|
only after all other plugins registered for the specific authentication
|
||||||
|
method which was requested. This allows you to move from more specific
|
||||||
|
plugins to more general plugins (e.g. local accounts first vs replicated
|
||||||
|
accounts with expensive network access later).
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head2 Multiple Hook Behavior
|
||||||
|
|
||||||
|
If more than one hook is registered for a given authentication method, then
|
||||||
|
they will be tried in the order that they appear in the config/plugins file
|
||||||
|
unless one of the plugins returns DENY, which will immediately cease all
|
||||||
|
authentication attempts for this transaction.
|
||||||
|
|
||||||
|
In addition, all plugins that are registered for a specific auth hook will
|
||||||
|
be tried before any plugins which are registered for the general auth hook.
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
John Peacock <jpeacock@cpan.org>
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
Copyright (c) 2004 John Peacock
|
||||||
|
|
||||||
|
Portions based on original code by Ask Bjoern Hansen and Guillaume Filion
|
||||||
|
|
||||||
|
This plugin is licensed under the same terms as the qpsmtpd package itself.
|
||||||
|
Please see the LICENSE file included with qpsmtpd for details.
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
package Qpsmtpd::Auth;
|
||||||
|
use Qpsmtpd::Constants;
|
||||||
|
use MIME::Base64;
|
||||||
|
|
||||||
|
sub Qpsmtpd::SMTP::auth {
|
||||||
|
my ( $self, $arg, @stuff ) = @_;
|
||||||
|
|
||||||
|
#they AUTH'd once already
|
||||||
|
return $self->respond( 503, "but you already said AUTH ..." )
|
||||||
|
if ( defined $self->{_auth}
|
||||||
|
and $self->{_auth} == OK );
|
||||||
|
|
||||||
|
return $self->{_auth} = Qpsmtpd::Auth::SASL( $self, $arg, @stuff );
|
||||||
|
}
|
||||||
|
|
||||||
|
sub SASL {
|
||||||
|
|
||||||
|
# $DB::single = 1;
|
||||||
|
my ( $session, $mechanism, $prekey ) = @_;
|
||||||
|
my ( $user, $passClear, $passHash, $ticket );
|
||||||
|
$mechanism = lc($mechanism);
|
||||||
|
|
||||||
|
if ( $mechanism eq "plain" ) {
|
||||||
|
if ($prekey) {
|
||||||
|
( $passHash, $user, $passClear ) = split /\x0/,
|
||||||
|
decode_base64($prekey);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
|
||||||
|
$session->respond( 334, "Username:" );
|
||||||
|
|
||||||
|
# We read the username and password from STDIN
|
||||||
|
$user = <>;
|
||||||
|
chop($user);
|
||||||
|
chop($user);
|
||||||
|
if ( $user eq '*' ) {
|
||||||
|
$session->respond( 501, "Authentification canceled" );
|
||||||
|
return DECLINED;
|
||||||
|
}
|
||||||
|
|
||||||
|
$session->respond( 334, "Password:" );
|
||||||
|
$passClear = <>;
|
||||||
|
chop($passClear);
|
||||||
|
chop($passClear);
|
||||||
|
if ( $passClear eq '*' ) {
|
||||||
|
$session->respond( 501, "Authentification canceled" );
|
||||||
|
return DECLINED;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
# elsif ($mechanism eq "login") {
|
||||||
|
# if ( $prekey ) {
|
||||||
|
# ($passHash, $user, $passClear) = split /\x0/, decode_base64($prekey);
|
||||||
|
# }
|
||||||
|
# else {
|
||||||
|
#
|
||||||
|
# $session->respond(334, encode_base64("User Name:"));
|
||||||
|
# $user = decode_base64(<>);
|
||||||
|
# #warn("Debug: User: '$user'");
|
||||||
|
# if ($user eq '*') {
|
||||||
|
# $session->respond(501, "Authentification canceled");
|
||||||
|
# return DECLINED;
|
||||||
|
# }
|
||||||
|
#
|
||||||
|
# $session->respond(334, encode_base64("Password:"));
|
||||||
|
# $passClear = <>;
|
||||||
|
# $passClear = decode_base64($passClear);
|
||||||
|
# #warn("Debug: Pass: '$pass'");
|
||||||
|
# if ($passClear eq '*') {
|
||||||
|
# $session->respond(501, "Authentification canceled");
|
||||||
|
# return DECLINED;
|
||||||
|
# }
|
||||||
|
# }
|
||||||
|
# }
|
||||||
|
elsif ( $mechanism eq "cram-md5" ) {
|
||||||
|
|
||||||
|
# rand() is not cryptographic, but we only need to generate a globally
|
||||||
|
# unique number. The rand() is there in case the user logs in more than
|
||||||
|
# once in the same second, of if the clock is skewed.
|
||||||
|
$ticket = sprintf( "<%x.%x\@" . $session->config("me") . ">",
|
||||||
|
rand(1000000), time() );
|
||||||
|
|
||||||
|
# We send the ticket encoded in Base64
|
||||||
|
$session->respond( 334, encode_base64( $ticket, "" ) );
|
||||||
|
my $line = <>;
|
||||||
|
chop($line);
|
||||||
|
chop($line);
|
||||||
|
|
||||||
|
if ( $line eq '*' ) {
|
||||||
|
$session->respond( 501, "Authentification canceled" );
|
||||||
|
return DECLINED;
|
||||||
|
}
|
||||||
|
|
||||||
|
( $user, $passHash ) = split( ' ', decode_base64($line) );
|
||||||
|
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$session->respond( 500, "Unrecognized authentification mechanism" );
|
||||||
|
return DECLINED;
|
||||||
|
}
|
||||||
|
|
||||||
|
# try running the specific hooks first
|
||||||
|
my ( $rc, $msg ) =
|
||||||
|
$session->run_hooks( "auth-$mechanism", $mechanism, $user, $passClear,
|
||||||
|
$passHash, $ticket );
|
||||||
|
|
||||||
|
# try running the polymorphous hooks next
|
||||||
|
if ( $rc == DECLINED ) {
|
||||||
|
( $rc, $msg ) =
|
||||||
|
$session->run_hooks( "auth", $mechanism, $user, $passClear, $passHash,
|
||||||
|
$ticket );
|
||||||
|
}
|
||||||
|
|
||||||
|
if ( $rc == OK ) {
|
||||||
|
$msg = "Authentication successful" .
|
||||||
|
( defined $msg ? " - " . $msg : "" );
|
||||||
|
$session->respond( 235, $msg );
|
||||||
|
$ENV{RELAYCLIENT} = 1;
|
||||||
|
$session->log( LOGINFO, $msg );
|
||||||
|
return OK;
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
$msg = "Authentication failed" .
|
||||||
|
( defined $msg ? " - " . $msg : "" );
|
||||||
|
$session->respond( 535, $msg );
|
||||||
|
$session->log( LOGERROR, $msg );
|
||||||
|
return DENY;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# tag: qpsmtpd plugin that sets RELAYCLIENT when the user authentifies
|
||||||
|
|
||||||
|
1;
|
||||||
@ -3,6 +3,7 @@ use strict;
|
|||||||
|
|
||||||
my %hooks = map { $_ => 1 } qw(
|
my %hooks = map { $_ => 1 } qw(
|
||||||
config queue data_post quit rcpt mail ehlo helo
|
config queue data_post quit rcpt mail ehlo helo
|
||||||
|
auth auth-plain auth-login auth-cram-md5
|
||||||
connect reset_transaction unrecognized_command disconnect
|
connect reset_transaction unrecognized_command disconnect
|
||||||
);
|
);
|
||||||
|
|
||||||
|
|||||||
@ -10,6 +10,7 @@ use Qpsmtpd::Connection;
|
|||||||
use Qpsmtpd::Transaction;
|
use Qpsmtpd::Transaction;
|
||||||
use Qpsmtpd::Plugin;
|
use Qpsmtpd::Plugin;
|
||||||
use Qpsmtpd::Constants;
|
use Qpsmtpd::Constants;
|
||||||
|
use Qpsmtpd::Auth;
|
||||||
|
|
||||||
use Mail::Address ();
|
use Mail::Address ();
|
||||||
use Mail::Header ();
|
use Mail::Header ();
|
||||||
@ -166,6 +167,25 @@ sub ehlo {
|
|||||||
? @{ $self->transaction->notes('capabilities') }
|
? @{ $self->transaction->notes('capabilities') }
|
||||||
: ();
|
: ();
|
||||||
|
|
||||||
|
# Check for possible AUTH mechanisms
|
||||||
|
my %auth_mechanisms;
|
||||||
|
HOOK: foreach my $hook ( keys %{$self->{_hooks}} ) {
|
||||||
|
if ( $hook =~ m/^auth-?(.+)?$/ ) {
|
||||||
|
if ( defined $1 ) {
|
||||||
|
$auth_mechanisms{uc($1)} = 1;
|
||||||
|
}
|
||||||
|
else { # at least one polymorphous auth provider
|
||||||
|
%auth_mechanisms = map {$_,1} qw(PLAIN CRAM-MD5);
|
||||||
|
last HOOK;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if ( %auth_mechanisms ) {
|
||||||
|
push @capabilities, 'AUTH '.join(" ",keys(%auth_mechanisms));
|
||||||
|
$self->{_commands}->{'auth'} = "";
|
||||||
|
}
|
||||||
|
|
||||||
$self->respond(250,
|
$self->respond(250,
|
||||||
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
|
$self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip ."]",
|
||||||
"PIPELINING",
|
"PIPELINING",
|
||||||
@ -415,6 +435,10 @@ sub data {
|
|||||||
|
|
||||||
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
|
my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP";
|
||||||
|
|
||||||
|
# only true if client authenticated
|
||||||
|
if ( defined $self->{_auth} and $self->{_auth} == OK ) {
|
||||||
|
$header->add("X-Qpsmtpd-Auth","True");
|
||||||
|
}
|
||||||
|
|
||||||
$header->add("Received", "from ".$self->connection->remote_info
|
$header->add("Received", "from ".$self->connection->remote_info
|
||||||
." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
|
." (HELO ".$self->connection->hello_host . ") (".$self->connection->remote_ip
|
||||||
|
|||||||
23
plugins/authdeny
Normal file
23
plugins/authdeny
Normal file
@ -0,0 +1,23 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
#
|
||||||
|
# This plugin doesn't actually check anything and will fail any
|
||||||
|
# user no matter what they type. It is strictly a proof of concept for
|
||||||
|
# the Qpsmtpd::Auth module. Don't run this in production!!!
|
||||||
|
#
|
||||||
|
|
||||||
|
sub register {
|
||||||
|
my ( $self, $qp ) = @_;
|
||||||
|
$self->register_hook( "auth", "authdeny" );
|
||||||
|
}
|
||||||
|
|
||||||
|
sub authdeny {
|
||||||
|
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
|
||||||
|
@_;
|
||||||
|
|
||||||
|
# $DB::single = 1;
|
||||||
|
|
||||||
|
$self->log( LOGWARN, "Cannot authenticate using authdeny" );
|
||||||
|
|
||||||
|
return ( DECLINED, "$user is not free to abuse my relay" );
|
||||||
|
}
|
||||||
|
|
||||||
27
plugins/authnull
Normal file
27
plugins/authnull
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
#!/usr/bin/perl
|
||||||
|
#
|
||||||
|
# This plugin doesn't actually check anything and will authenticate any
|
||||||
|
# user no matter what they type. It is strictly a proof of concept for
|
||||||
|
# the Qpsmtpd::Auth module. Don't run this in production!!!
|
||||||
|
#
|
||||||
|
|
||||||
|
sub register {
|
||||||
|
my ( $self, $qp ) = @_;
|
||||||
|
|
||||||
|
# $self->register_hook("auth-plain", "authnull");
|
||||||
|
# $self->register_hook("auth-login", "authnull");
|
||||||
|
# $self->register_hook("auth-cram-md5", "authnull");
|
||||||
|
|
||||||
|
$self->register_hook( "auth", "authnull" );
|
||||||
|
}
|
||||||
|
|
||||||
|
sub authnull {
|
||||||
|
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
|
||||||
|
@_;
|
||||||
|
|
||||||
|
# $DB::single = 1;
|
||||||
|
$self->log( LOGERROR, "authenticating $user using $method" );
|
||||||
|
|
||||||
|
return ( OK, "$user is free to abuse my relay" );
|
||||||
|
}
|
||||||
|
|
||||||
116
plugins/authsql
Normal file
116
plugins/authsql
Normal file
@ -0,0 +1,116 @@
|
|||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
authsql - Authenticate to vpopmail via MySQL
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
This plugin authenticates vpopmail users directly against a standard
|
||||||
|
vpopmail MySQL database. It makes the not-unreasonable assumption that
|
||||||
|
both pw_name and pw_domain are lowercase only (qmail doesn't actually care).
|
||||||
|
It also requires that vpopmail be built with the recommended
|
||||||
|
'--enable-clear-passwd=y' option, because there is no other way to compare
|
||||||
|
the password with CRAM-MD5.
|
||||||
|
|
||||||
|
=head1 CONFIGURATION
|
||||||
|
|
||||||
|
Decide which authentication methods you are willing to support and uncomment
|
||||||
|
the lines in the register() sub. See the POD for Qspmtpd::Auth for more
|
||||||
|
details on the ramifications of supporting various authentication methods.
|
||||||
|
Then, change the database information at the top of the authsql() sub so that
|
||||||
|
the module can access the database. This can be a read-only account since
|
||||||
|
the plugin does not update the last accessed time (yet, see below).
|
||||||
|
|
||||||
|
The remote user must login with a fully qualified e-mail address (i.e. both
|
||||||
|
account name and domain), even if they don't normally need to. This is
|
||||||
|
because the vpopmail table has a unique index on pw_name/pw_domain, and this
|
||||||
|
module requires that only a single record be returned from the database.
|
||||||
|
|
||||||
|
=head1 FUTURE DIRECTION
|
||||||
|
|
||||||
|
The default MySQL configuration for vpopmail includes a table to log access,
|
||||||
|
lastauth, which could conceivably be updated upon sucessful authentication.
|
||||||
|
The addition of this feature is left as an exercise for someone who cares. ;)
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
John Peacock <jpeacock@cpan.org>
|
||||||
|
|
||||||
|
=head1 COPYRIGHT AND LICENSE
|
||||||
|
|
||||||
|
Copyright (c) 2004 John Peacock
|
||||||
|
|
||||||
|
This plugin is licensed under the same terms as the qpsmtpd package itself.
|
||||||
|
Please see the LICENSE file included with qpsmtpd for details.
|
||||||
|
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
sub register {
|
||||||
|
my ( $self, $qp ) = @_;
|
||||||
|
|
||||||
|
$self->register_hook( "auth-plain", "authsql" );
|
||||||
|
|
||||||
|
# $self->register_hook("auth-cram-md5", "authsql");
|
||||||
|
|
||||||
|
}
|
||||||
|
|
||||||
|
sub authsql {
|
||||||
|
use DBI;
|
||||||
|
use Qpsmtpd::Constants;
|
||||||
|
use Digest::HMAC_MD5 qw(hmac_md5_hex);
|
||||||
|
|
||||||
|
# $DB::single = 1;
|
||||||
|
|
||||||
|
my $connect = "dbi:mysql:dbname=vpopmail";
|
||||||
|
my $dbuser = "vpopmailuser";
|
||||||
|
my $dbpasswd = "**********";
|
||||||
|
|
||||||
|
my $dbh = DBI->connect( $connect, $dbuser, $dbpasswd );
|
||||||
|
$dbh->{ShowErrorStatement} = 1;
|
||||||
|
|
||||||
|
my ( $self, $transaction, $method, $user, $passClear, $passHash, $ticket ) =
|
||||||
|
@_;
|
||||||
|
my ( $pw_name, $pw_domain ) = split "@", lc($user);
|
||||||
|
|
||||||
|
unless ( defined $pw_domain ) {
|
||||||
|
return DECLINED;
|
||||||
|
}
|
||||||
|
|
||||||
|
my $sth = $dbh->prepare(<<SQL);
|
||||||
|
select pw_clear_passwd
|
||||||
|
from vpopmail
|
||||||
|
where pw_name = ? and pw_domain = ?
|
||||||
|
SQL
|
||||||
|
|
||||||
|
$sth->execute( $pw_name, $pw_domain );
|
||||||
|
|
||||||
|
my ($pw_clear_passwd) = $sth->fetchrow_array;
|
||||||
|
|
||||||
|
$sth->finish;
|
||||||
|
$dbh->disconnect;
|
||||||
|
|
||||||
|
unless ( defined $pw_clear_passwd ) {
|
||||||
|
|
||||||
|
# if this isn't defined then the user doesn't exist here
|
||||||
|
# or the administrator forgot to build with --enable-clear-passwd=y
|
||||||
|
return ( DECLINED, "authsql/$method" );
|
||||||
|
}
|
||||||
|
|
||||||
|
# at this point we can assume the user name matched
|
||||||
|
if (
|
||||||
|
( defined $passClear
|
||||||
|
and $pw_clear_passwd eq $passClear ) or
|
||||||
|
( defined $passHash
|
||||||
|
and $passHash eq hmac_md5_hex( $ticket, $pw_clear_passwd ) )
|
||||||
|
)
|
||||||
|
{
|
||||||
|
|
||||||
|
return ( OK, "authsql/$method" );
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
return ( DENY, "authsql/$method - wrong password" );
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user