Chris/webperl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added AuthMethod, and LDAPS and Database subclasses.

Browse Source
This commit is contained in:
Chris 2012-03-12 15:21:34 +00:00
parent c61c16193c
commit d379a093c0
3 changed files with 434 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
AuthMethod.pm Normal file
View File

@ -0,0 +1,93 @@
## @file
# This file contains the implementation of the authentication method base class.
#
# @author Chris Page <chris@starforge.co.uk>
# @version 1.0
# @date 9 March 2012
# @copy 2012, Chris Page <chris@starforge.co.uk>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
## @class
# The base class for all authentication method classes. This class is
# mainly present for documentation purposes - it doesn't actually provide
# any meaningful implementation of an authentication method, and the
# actually interesting stuff should happen in subclasses of it.
package AuthMethod;
use strict;
our $errstr;
BEGIN {
$errstr = '';
}
# ============================================================================
# Constructor
## @cmethod $ new(%args)
# Construct a new AuthMethod object. This will create a new AuthMethod object
# initialised with the provided arguments. All the arguments are copied into
# the new object 'as is', with no processing - the caller must make sure they
# are sane before calling this.
#
# @param args A hash of arguments to initialise the AuthMethod object with.
# @return A new AuthMethod object.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = {
@_,
};
return bless $self, $class;
}
# ============================================================================
# Interface code
## @method $ authenticate($username, $password, $auth)
# Authenticate a user based on the credentials supplied. This will attempt
# to determine whether the user's credentials are valid, and will return
# true if they are, or false if they are not or a problem occured while
# performing the authentication.
#
# @param username The username of the user to authenticate.
# @param password The password of the user to authenticate.
# @param auth A reference to the Auth object calling this function,
# if any errors are encountered while performing the
# authentication, they will be appended to $auth -> {"lasterr"}.
# @return true if the user's credentials are valid, false otherwise.
sub authenticate {
my $self = shift;
my $username = shift;
my $password = shift;
my $auth = shift;
# This class does not know how to authenticate users, always return false.
return 0;
}
# ============================================================================
# Error functions
sub get_error { return $errstr; }
sub set_error { $errstr = shift; return undef; }
1;

191
AuthMethod/Database.pm Normal file
View File

@ -0,0 +1,191 @@
## @file
# This file contains the implementation of the Database authentication class.
#
# @author Chris Page &lt;chris@starforge.co.uk&gt;
# @version 1.0
# @date 12 March 2012
# @copy 2012, Chris Page &lt;chris@starforge.co.uk&gt;
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
## @class
# Implementation of a basic database authentication class. This will
# compare a user's credentials to those stored in a database table.
# The users' passwords are never stored as plain text - this uses a
# salted, hashed storage mechanism for passwords.
#
# This module will expect at least the following configuration values
# to be passed to the constructor.
#
# * table - The name of the database table to authenticate against.
# This must be accessible to the system-wide dbh object.
# * userfield - The name of the column in the table that stores usernames.
# * passfield - The password column in the table.
#
# The module also expects a 'system_salt' value in the configuration
# table to include in the salting process. The following arguments may
# also be provided to the module constructor:
#
# * brypt_cost - the number of iterations of hashing to perform. This
# defaults to COST_DEFAULT if not specified.
package AuthMethod::Database;
use strict;
use base qw(AuthMethod); # This class extends AuthMethod
use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64);
# Custom module imports
use Logging qw(die_log);
use constant COST_DEFAULT => 14; # The default cost to use if bcrypt_cost is not set.
# ============================================================================
# Constructor
## @cmethod $ new(%args)
# Construct a new AuthMethod object. This will create a new AuthMethod object
# initialised with the provided arguments. All the arguments are copied into
# the new object 'as is', with no processing - the caller must make sure they
# are sane before calling this.
#
# @param args A hash of arguments to initialise the AuthMethod object with.
# @return A new AuthMethod object on success, an error message otherwise.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = $class -> SUPER::new(@_);
# bomb if the parent constructor failed.
return $class -> SUPER::get_error() if(!$self);
# Set default values as needed
$self -> {"bcrypt_cost"} = COST_DEFAULT;
# check that required settings are set...
return "AuthMethod::Database missing 'table' argument in new()" if(!$self -> {"table"});
return "AuthMethod::Database missing 'userfield' argument in new()" if(!$self -> {"userfield"});
return "AuthMethod::Database missing 'passfield' argument in new()" if(!$self -> {"passfield"});
return $self;
}
# ============================================================================
# Interface code
## @method $ authenticate($username, $password, $auth)
# Attempt to authenticate the user against the database. This will check the user's
# login against the configured database tabke, and return true if the login is valid.
#
# @param username The username to check against the database.
# @param password The password to check against the database.
# @param auth A reference to the Auth object calling this function,
# if any errors are encountered while performing the
# authentication, they will be appended to $auth -> {"lasterr"}.
# @return true if the user's credentials are valid, false otherwise.
sub authenticate {
my $self = shift;
my $username = shift;
my $password = shift;
my $auth = shift;
my $userh = $self -> {"dbh"} -> prepare("SELECT ".$self -> {"passfield"}." FROM ".$self -> {"table"}."
WHERE ".$self -> {"userfield"}." LIKE ?");
$userh -> execute($username)
or die_log($self -> {"cgi"} -> remote_host(), "Unable to execute user lookup query: ".$self -> {"dbh"} -> errstr);
# If a user has been found with the specified username, check the password...
my $user = $userh -> fetchrow_arrayref();
if($user && $user -> [0]) {
my $hash = $self -> hash_password($password, $user -> [0]);
# If the new hash matches the stored hash, the password is valid.
return ($hash eq $user -> [0]);
}
return 0;
}
# ============================================================================
# Ghastly internals
## @fn private $ generate_settings($cost)
# Generate a settings string to provide to bcrypt(). This will generate a
# string in the form '$2$', followed by the cost - which will be padded with a
# leading zero for you if it is less than 10, and does not have one already -
# followed by '$' and then a 22 character Base64 encoded string containing the
# password salt.
#
# @todo This uses /dev/urandom directly, which is not only unportable, it
# is cryptographically weak. /dev/random fixes the latter - at the cost
# of potentially blocking the user, and has therefore been avoided.
# Possibly switching to Crypt::Random, and doing account creation
# asynchronously (ie: users do not get immediately created accounts)
# would allow proper strength salting in a potentially platform-neutral
# fashion here.
#
# @param cost The cost of the hash. The number of hash iterations is 2^cost.
# This should be as high as possible (at least 14, preferably over 16)
# while not drastically slowing user login.
# @return A settings string suitable for use with bcrypt().
sub generate_settings {
my $cost = shift;
# Make sure the cost has a leading zero if needed.
$cost = "0$cost"
unless($cost > 9 || $cost =~ /^0\d$/);
# Bytes, bytes, we need random(ish) byes!
open(RND, "/dev/urandom")
or die "Unable to open random source: $!\n";
binmode(RND);
my $buffer;
my $read = read(RND, $buffer, 16);
die "Unable to read 16 bytes from random source: $!\n" if($read != 16);
close(RND);
# Can't use MIME::Base64 directly here as bcrypt() expects a somewhat...
# idiosycratic variation of base64 encoding. Use its own encoder instead.
return '$2$'.$cost.'$'.en_base64($buffer);
}
## @method private $ hash_password($password, $settings)
# Generate a salted hash of the supplied password. This will create a 59 character
# long string containing the hashed password and its salt suitable for storing in
# the database. If the $settings string is not provided, one will be generated.
# When creating accounts, $settings will be omitted unless the caller wants to
# provide its own salting system. When checking passwords, password should be the
# password being checked, and settings should be a hash string previously
# generated by this function. The result of this function can then be compared to
# the stored hash to determine whether the password is correct.
#
# @param password The plain-text password to check.
# @param settings An optional settings string, leave undefined for new accounts,
# set to a previously generated hash string when doing password
# validity checking.
# @return A bcrypt() generated, 59 character hash containing the settings string
# and the hashed, salted password.
sub hash_password {
my $self = shift;
my $password = shift;
my $settings = shift || generate_settings($self -> {"bcrypt_cost"});
return bcrypt($password, $salt);
}
1;

150
AuthMethod/LDAPS.pm Normal file
View File

@ -0,0 +1,150 @@
## @file
# This file contains the implementation of the LDAPS-Cohort authentication class.
#
# @author Chris Page &lt;chris@starforge.co.uk&gt;
# @version 1.0
# @date 9 March 2012
# @copy 2012, Chris Page &lt;chris@starforge.co.uk&gt;
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
## @class
# Implementation of a basic LDAP authentication module. This will allow
# users to be authenticated against most LDAPS servers, provided that
# it is configured with the appropriate incantations to talk to it.
#
# This module will expect at least the following configuration values
# to be passed to the constructor.
#
# * server - the server to authenticate the user against, can be either
# a hostname, IP address, or URI.
# * base - the base dn to use when searching for the user's dn.
# * searchfield - the field to use when searching for the user dn.
#
# The following arguments may be provided:
#
# * adminuser - if specified, searching for the user's DN will be done
# using this user rather than anonymously.
# * adminpass - The password to use when logging in as the admin user.
# * reuseconn - If set to a true value, the connection to the LDAPS is reused
# for authentication after finding the user's dn.
package AuthMethod::LDAPS;
use strict;
use base qw(AuthMethod); # This class extends AuthMethod
use Net::LDAPS;
# Custom module imports
use Logging qw(die_log);
## @cmethod $ new(%args)
# Construct a new AuthMethod object. This will create a new AuthMethod object
# initialised with the provided arguments. All the arguments are copied into
# the new object 'as is', with no processing - the caller must make sure they
# are sane before calling this.
#
# @param args A hash of arguments to initialise the AuthMethod object with.
# @return A new AuthMethod object on success, an error message otherwise.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = $class -> SUPER::new(@_);
# bomb if the parent constructor failed.
return $class -> SUPER::get_error() if(!$self);
# check that required settings are set...
return "AuthMethod::LDAPS missing 'server' argument in new()" if(!$self -> {"server"});
return "AuthMethod::LDAPS missing 'base' argument in new()" if(!$self -> {"base"});
return "AuthMethod::LDAPS missing 'searchfield' argument in new()" if(!$self -> {"searchfield"});
return $self;
}
# ============================================================================
# Interface code
## @method $ authenticate($username, $password, $auth)
# Attempt to authenticate the user against the LDAPS server. This will check the user's
# login against the configured LDAPS server, and return true if the login is valid.
#
# @param username The username to check against the server.
# @param password The password to check against the server.
# @param auth A reference to the Auth object calling this function,
# if any errors are encountered while performing the
# authentication, they will be appended to $auth -> {"lasterr"}.
# @return true if the user's credentials are valid, false otherwise.
sub authenticate {
my $self = shift;
my $username = shift;
my $password = shift;
my $auth = shift;
my $valid = 0;
if($username && $password) {
# First obtain the user dn
my $userdn;
my $ldap = Net::LDAPS -> new($self -> {"server"});
if($ldap) {
# Bind for the search - if the object has adminuser and password, bind with them,
# otherwise fall back on using an anonymous bind.
my $mesg = ($self -> {"adminuser"} && $self -> {"adminpass"}) ? $ldap -> bind($self -> {"adminuser"}, $self -> {"adminpass"})
: $ldap -> bind();
if($mesg -> code) {
$auth -> {"lasterr"} .= "LDAPS bind to ".$self -> {"server"}." failed. Response was: ".$mesg -> error."\n";
} else {
# Search for a user with the specified username in the base dn
my $result = $ldap -> search("base" => $self -> {"base"},
"filter" => $self -> {"searchfield"}."=".$username);
# Fetch the user's dn out of the response if possible.
my $entry = $result -> shift_entry;
$userdn = $entry -> dn
if($entry);
}
$ldap -> unbind();
# If a userdn has been obtained, check that the password for it is valid
if($userdn) {
# Open a new connection unless the old one can be reused.
$ldap = Net::LDAPS -> new($self -> {"server"})
unless($self -> {"reuseconn"});
if($ldap) {
# Do the actual login...
$mesg = $ldap -> bind($userdn, password => $password);
$valid = 1
unless($mesg -> code);
$ldap -> unbind();
} else {
$auth -> {"lasterr"} .= "Unable to connect to LDAP server: $@\n";
}
}
} else {
$auth -> {"lasterr"} .= "Unable to connect to LDAP server: $@\n";
}
return $valid;
}
$auth -> {"lasterr"} = "LDAP login failed: username and password are required";
return 0;
}
1;