version 0.2 of the MySQL module

Karjala karjala_lists at karjala.org
Tue Jul 4 23:40:24 UTC 2006


There.

Brad Fitzpatrick wrote:
> Mart, Karjala,
>
> Please submit a patch with a copyright and license statement.
>
> - Brad
>   
-------------- next part --------------

package DJabberd::Authen::MySQL;
use strict;
use base 'DJabberd::Authen';

use DJabberd::Log;
our $logger = DJabberd::Log->get_logger;
use DBI;
sub log {
    $logger;
}

=head1 NAME

DJabberd::Authen::MySQL - A MySQL authentication module for DJabberd

=head1 VERSION

Version 0.30

=head1 SYNOPSIS

    <VHost mydomain.com>

        [...]

        <Plugin DJabberd::Authen::MySQL>
            DBName               djabberd
            DBHost               127.0.0.1
            DBPort               6723
            DBUsername           dbusername
            DBPassword           dbpassword
            DBTable              user
            DBUsernameColumn     username
            DBPasswordColumn     password
            DBEncryptedPasswords 1
            DBWhere              canjabber = 1
        </Plugin>
    </VHost>

DBName, DBUsername, DBTable, DBUsernameColumn and DBPasswordColumn are required.
Everything else is optional.

DBEncryptedPasswords will cause this plugin to expect password strings generated
by MySQL's PASSWORD() function. Note that this will prevent DJabberd from doing
digest authentication and will thus require clients to send passwords in cleartext.

=cut

sub set_config_dbname {
    my ($self, $dbname) = @_;
    $self->{'mysql_dbname'} = $dbname;
}

sub set_config_dbusername {
    my ($self, $dbusername) = @_;
    $self->{'mysql_dbusername'} = $dbusername;
}

sub set_config_dbpassword {
    my ($self, $dbpassword) = @_;
    $self->{'mysql_dbpassword'} = $dbpassword;
}

sub set_config_dbhost {
    my ($self, $dbhost) = @_;
    $self->{'mysql_dbhost'} = $dbhost;
}

sub set_config_dbport {
    my ($self, $dbport) = @_;
    $self->{'mysql_dbport'} = $dbport;
}

sub set_config_dbtable {
    my ($self, $dbtable) = @_;
    $self->{'mysql_table'} = $dbtable;
}

sub set_config_dbusernamecolumn {
    my ($self, $dbusernamecolumn) = @_;
    $self->{'mysql_usernamecolumn'} = $dbusernamecolumn;
}

sub set_config_dbpasswordcolumn {
    my ($self, $dbpasswordcolumn) = @_;
    $self->{'mysql_passwordcolumn'} = $dbpasswordcolumn;
}

sub set_config_dbencryptedpasswords {
    my ($self, $dbencryptedpassword) = @_;
    $self->{'mysql_encryptedpassword'} = $dbencryptedpassword;
}

sub set_config_dbwhere {
    my ($self, $dbwhere) = @_;
    $self->{'mysql_where'} = $dbwhere;
}

sub finalize {
    my $self = shift;
    my $dsn = "DBI:mysql:database=$self->{'mysql_dbname'}";
    if (defined $self->{'mysql_dbhost'}) { $dsn .= ";host=$self->{'mysql_dbhost'}"; }
    if (defined $self->{'mysql_dbport'}) { $dsn .= ";port=$self->{'mysql_dbport'}"; }
    my $dbh = DBI->connect($dsn, $self->{'mysql_dbusername'}, $self->{'mysql_dbpassword'}, { RaiseError => 1 });
    $self->{'mysql_dbh'} = $dbh;
}

sub can_retrieve_cleartext {
    my $self = shift;
    return $self->{'mysql_encryptedpassword'} ? 0 : 1;
}

sub get_password {
    my ($self, $cb, %args) = @_;

    my $user = $args{'username'};
    my $dbh = $self->{'mysql_dbh'};

    my $sql_username = "SELECT $self->{'mysql_usernamecolumn'}, $self->{'mysql_passwordcolumn'} FROM $self->{'mysql_table'} WHERE $self->{'mysql_usernamecolumn'} = ".$dbh->quote($user);
    my $sql_where = (defined $self->{'mysql_where'} ? " AND $self->{'mysql_where'}" : "");

    my ($username, $password) = $dbh->selectrow_array("$sql_username $sql_where");
    if (defined $username) {
        $logger->debug("Fetched password for '$username'");
        $cb->set($password);
        return;
    }
    $logger->info("Can't fetch password for '$username': user does not exist or did not satisfy WHERE clause");
    $cb->decline;
}

sub check_cleartext {
    my ($self, $cb, %args) = @_;
    my $username = $args{username};
    my $password = $args{password};
    my $conn = $args{conn};
    unless ($username =~ /^\w+$/) {
        $cb->reject;
        return;
    }

    my $dbh = $self->{'mysql_dbh'};
    my $sql_username = "SELECT $self->{'mysql_usernamecolumn'} FROM $self->{'mysql_table'} WHERE $self->{'mysql_usernamecolumn'} = ".$dbh->quote($username);
    my $sql_password = " AND $self->{'mysql_passwordcolumn'} = ".($self->{'mysql_encryptedpassword'} ? "PASSWORD(".$dbh->quote($password).")" : $dbh->quote($password));
    my $sql_where = (defined $self->{'mysql_where'} ? " AND $self->{'mysql_where'}" : "");

    if (defined(($dbh->selectrow_array("$sql_username $sql_password $sql_where"))[0])) {
        $cb->accept;
        $logger->debug("User '$username' authenticated successfully");
        return 1;
    } else {
        $cb->reject();
        if (defined(($dbh->selectrow_array("$sql_username $sql_where"))[0])) { # if user exists
            $logger->info("Auth failed for user '$username': password error");
            return 0;
        } else {
            $logger->info("Auth failed for user '$username': user does not exist or did not satisfy WHERE clause");
            return 1;
        }
    }
}

=head1 ACKNOWLEDGEMENTS

=head1 COPYRIGHT & LICENSE

Copyright 2006 Alexander Karelas, Mart Atkins & Brad Fitzpatrick, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1; # End of DJabberd::Authen::MySQL


More information about the Djabberd mailing list