Support for LDAP with TLS.
This commit is contained in:
parent
71b3236549
commit
8d57d19288
148
Webperl/AuthMethod/LDAP.pm
Normal file
148
Webperl/AuthMethod/LDAP.pm
Normal file
@ -0,0 +1,148 @@
|
||||
## @file
|
||||
# This file contains the implementation of the LDAP authentication class.
|
||||
#
|
||||
# @author 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
|
||||
# Implementation of a basic LDAP authentication module. This will allow
|
||||
# users to be authenticated against most LDAP servers, provided that
|
||||
# it is configured with the appropriate incantations to talk to it.
|
||||
#
|
||||
# This module supports the following comfiguration variables:
|
||||
#
|
||||
# - `server` (required) the server to authenticate the user against, can be either
|
||||
# a hostname, IP address, or URI.
|
||||
# - `base` (required) the base dn to use when searching for the user's dn.
|
||||
# - `searchfield` (required) the field to use when searching for the user dn.
|
||||
# - `adminuser` (optional) if specified, searching for the user's DN will be done
|
||||
# using this user rather than anonymously.
|
||||
# - `adminpass` (optional) The password to use when logging in as the admin user.
|
||||
# - `reuseconn` (optional) If set to a true value, the connection to the LDAP is reused
|
||||
# for authentication after finding the user's dn.
|
||||
# - `usetls` (optional) If set to true, start_tls is called on the conntection.
|
||||
# Otherwise *no TLS is used and the server connection is not encrypted*
|
||||
#
|
||||
# These will generally be provided by supplying the configuration variables
|
||||
# in the auth_methods_params table and using Webperl::AuthMethods to load
|
||||
# the AuthMethod at runtime.
|
||||
package Webperl::AuthMethod::LDAP;
|
||||
|
||||
use strict;
|
||||
use base qw(Webperl::AuthMethod); # This class extends AuthMethod
|
||||
use Net::LDAPS;
|
||||
|
||||
## @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(@_)
|
||||
or return undef;
|
||||
|
||||
# check that required settings are set...
|
||||
return set_error("Webperl::AuthMethod::LDAP missing 'server' argument in new()") if(!$self -> {"server"});
|
||||
return set_error("Webperl::AuthMethod::LDAP missing 'base' argument in new()") if(!$self -> {"base"});
|
||||
return set_error("Webperl::AuthMethod::LDAP 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 set in $auth -> {"errstr"}.
|
||||
# @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::LDAP -> new($self -> {"server"});
|
||||
|
||||
if($ldap) {
|
||||
$ldap -> start_tls('none') if($self -> {"usetls"});
|
||||
|
||||
# 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) {
|
||||
return $auth -> self_error("LDAP bind to ".$self -> {"server"}." failed. Response was: ".$mesg -> error);
|
||||
} 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.
|
||||
if(!$self -> {"reuseconn"}) {
|
||||
$ldap = Net::LDAP -> new($self -> {"server"});
|
||||
|
||||
$ldap -> start_tls('none')
|
||||
if($ldap && $self -> {"usetls"});
|
||||
}
|
||||
|
||||
if($ldap) {
|
||||
# Do the actual login...
|
||||
$mesg = $ldap -> bind($userdn, password => $password);
|
||||
$valid = 1
|
||||
unless($mesg -> code);
|
||||
|
||||
$ldap -> unbind();
|
||||
} else {
|
||||
return $auth -> self_error("Unable to connect to LDAP server: $@");
|
||||
}
|
||||
}
|
||||
} else {
|
||||
return $auth -> self_error("Unable to connect to LDAP server: $@");
|
||||
}
|
||||
|
||||
return $valid;
|
||||
}
|
||||
|
||||
return $auth -> self_error("LDAP login failed: username and password are required");
|
||||
}
|
||||
|
||||
1;
|
Loading…
x
Reference in New Issue
Block a user