# AuthLDAP2.pm
#
# Object for handling Authentication via LDAP, using the new
# perl-ldap module Net::LDAP. It replaces AuthLDAP.pm, which
# should not be used for new installations
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 1997 Open System Consultants
# $Id: AuthLDAP2.pm,v 1.2 1999/06/21 00:06:14 mikem Exp mikem $

package Radius::AuthLDAP2;
use Radius::AuthGeneric;
use Net::LDAP qw(LDAP_SUCCESS);
use Net::LDAP::Util;
use strict;

use vars qw($VERSION @ISA);
BEGIN 
{
    @ISA = qw(Radius::AuthGeneric);
}

# Class initialized flag
my $initialized;

#####################################################################
# Constructs a new handler
sub new
{
    my ($class, $file, @args) = @_;

    my $self = $class->SUPER::new($file);
    $self->log($main::LOG_WARNING, 
	       "No BaseDN defined for $class at '$main::config_file' line $.")
	if !defined $self->{BaseDN};
    $self->log($main::LOG_WARNING, 
	       "No UsernameAttr defined for $class at '$main::config_file' line $.")
	if !defined $self->{UsernameAttr};
    $self->log($main::LOG_WARNING, 
	       "No PasswordAttr or EncryptedPasswordAttr defined for $class at '$main::config_file' line $.")
	if !defined $self->{PasswordAttr}
           && !defined $self->{EncryptedPasswordAttr};

    return $self;
}

#####################################################################
# Do per-instance default initialization
sub initialize
{
    my ($self) = @_;

    $self->SUPER::initialize;
    $self->{Host} = 'localhost';
    $self->{UsernameAttr} = 'uid';
    $self->{Port} = 389;
}

#####################################################################
# Override the keyword function in Configurable
sub keyword
{
    my ($self, $file, $keyword, $value) = @_;

    if ($keyword eq 'BaseDN')
    {
	$self->{BaseDN} = $value;
    }
    elsif ($keyword eq 'Host')
    {
	$self->{Host} = $value;
    }
    elsif ($keyword eq 'Port')
    {
	$self->{Port} = $value;
    }
    elsif ($keyword eq 'UseSSL')
    {
	$self->{UseSSL} = $value;
    }
    elsif ($keyword eq 'AuthDN')
    {
	$self->{AuthDN} = $value;
    }
    elsif ($keyword eq 'AuthPassword')
    {
	$self->{AuthPassword} = $value;
    }
    elsif ($keyword eq 'UsernameAttr')
    {
	$self->{UsernameAttr} = $value;
    }
    elsif ($keyword eq 'PasswordAttr')
    {
	$self->{PasswordAttr} = $value;
    }
    elsif ($keyword eq 'EncryptedPasswordAttr')
    {
	$self->{EncryptedPasswordAttr} = $value;
    }
    elsif ($keyword eq 'CheckAttr')
    {
	$self->{CheckAttr} = $value;
    }
    elsif ($keyword eq 'ReplyAttr')
    {
	$self->{ReplyAttr} = $value;
    }
    else
    {
	return $self->SUPER::keyword($file, $keyword, $value);
    }
    return 1;
}

#####################################################################
# This function may be called during operation to reinitialize 
# this module
# it is expected to reload any state, perhaps by rereading files, 
# reconnecting to a database or something like that.
# Its not actually called yet, but it as well to be prepared 
# for the day
# when it will be.
sub reinitialize
{
    my ($self) = @_;
}

#####################################################################
# reconnect
# Connect or reconnect to the LDAP
# Returns true if there is a viable LDAP connection available
sub reconnect
{
    my ($self) = @_;

    # Some LDAP servers (notably imail) disconnect us after an unbind
    if ($self->{ld} && eof($self->{ld}->{net_ldap_socket}))
    {
	close($self->{ld}->{net_ldap_socket});
	$self->{ld} = undef;
    }

    return 1 if $self->{ld}; # We are already connected

    my $result;
    $self->log($main::LOG_DEBUG, "Connecting to $self->{Host}, port $self->{Port}");
    if (!($self->{ld} = new Net::LDAP
	 ($self->{Host},
	  port => Radius::Radius::get_port($self->{Port}))))
    {
	$self->log($main::LOG_ERR, 
		   "Could not open LDAP connection to $self->{Host}, port $self->{Port}");
	return 0;
    }

    # SSL is not supported by Net::LDAP yet
    # Maybe we need to do SSL
    # This is only possible with Netscape SDK. With Umich LDAP
    # perl will die with something like 
    # Can't locate auto/Net/LDAPapi/ldapssl_cli.al in @INC
    if (defined $self->{UseSSL})
    {
	$self->log($main::LOG_ERR, 
		       "SSL is not supported");

	# Get the name of the certificate database. certdbhandle
	# is not used by SDK yet.
#	my ($certdbpath, $certdbhandle) = split(/\s+/, $self->{UseSSL});
#	my $certdbfilename = &main::format_special($certdbpath);
#	if (($result = ldapssl_client_init($certdbfilename, $certdbhandle))
#	    != LDAP_SUCCESS)
#	{
#	    my $msg = ldap_err2string(ldap_result2error($self->{ld}, $result, 0));
#	    $self->log($main::LOG_ERR, 
#		       "Could not initialize SSL with $certdbpath, $certdbhandle: $msg. Disconnecting");
#	    $self->{ld} = undef;
#	    return 0;
#	}
#	if (($result = ldapssl_install_routines($self->{ld}))
#	    != LDAP_SUCCESS)
#	{
#	    my $msg = ldap_err2string(ldap_result2error($self->{ld}, $result, 0));
#	    $self->log($main::LOG_ERR, 
#		       "Could not install SSL routines: $msg. Disconnecting");
#	    $self->{ld} = undef;
#	    return 0;
#	}
    }

    return 1;  # LDAP is available
}

sub bind
{
    my ($self) = @_;

    my $result = $self->{ld}->bind
	(dn => $self->{AuthDN},
	 password => $self->{AuthPassword});
    if (!$result || $result->code() != LDAP_SUCCESS)
    {
	my $code = $result ? $result->code() : -1;
	my $errname = ldap_error_name($code);

	$self->log($main::LOG_ERR, 
		   "Could not bind connection with $self->{AuthDN}, error: $errname. Disconnecting");
	$self->{ld} = undef;
	return 0;
    }

    return 1; # Success
}

sub unbind
{
    my ($self) = @_;

    $self->{ld}->unbind;
}

#####################################################################
# Find a the named user by looking in the database, and constructing
# User object if we found the named user
# $name is the user name we want
# $p is the current request we are handling
sub findUser
{
    my ($self, $name, $p) = @_;

    # (Re)-connect to the database if necessary, 
    # No reply will be sent to the original requester if we 
    # fail to connect
    return undef unless $self->reconnect;
    return undef unless $self->bind;

    my $user;

    # Construct an LDAP request
    my @attrs;
    if (defined $self->{EncryptedPasswordAttr})
    {
	push(@attrs, $self->{EncryptedPasswordAttr});
    }
    else
    {
	push(@attrs, $self->{PasswordAttr});
    }
    push(@attrs, $self->{CheckAttr}) if defined $self->{CheckAttr};
    push(@attrs, $self->{ReplyAttr}) if defined $self->{ReplyAttr};

    my $result = $self->{ld}->search
	 (base => $self->{BaseDN},
	  scope => 'sub',
	  filter => "($self->{UsernameAttr}=$name)",
	  attrs => \@attrs);

    # $result is an object of type Net::LDAP::Search
    if (!$result || $result->code() != LDAP_SUCCESS)
    {
	my $code = $result ? $result->code() : -1;
	my $errname = ldap_error_name($code);
	$self->log($main::LOG_ERR, "ldap search failed with error $errname. Disconnecting from LDAP server. $?");
	# Any error probably indicates we lost the connection to 
	# the database. Make sure we try to reconnect again later.
	$self->{ld} = undef;
	return undef;
    }
	
    # We only use the first returned record
    my $got_password;
    my $ent = $result->entry(0);
    if ($ent)
    {
	# Get a new User object to return
	$user = new Radius::User;

	my $dn = $ent->dn;
	$self->log($main::LOG_DEBUG, 
		   "LDAP got result for $dn");
	
	my ($attr);
	foreach $attr ($ent->attributes())
	{
	    my @vals = $ent->get($attr);
	    $self->log($main::LOG_DEBUG, "LDAP got $attr: @vals");

	    # The attributes are not returned in the order we asked 
	    # for them. Bummer. Also the case of the returned 
	    # attribute names does not necessarily match either.
	    # OK so we have to look at each one and see if its one
	    # we expect and need to use
	    $attr = lc $attr;
	    if ($attr eq lc $self->{EncryptedPasswordAttr})
	    {
		$got_password = 1;
		$user->get_check->add_attr('Encrypted-Password',
					   $vals[0]);
	    }
	    elsif ($attr eq lc $self->{PasswordAttr})
	    {
		$got_password = 1;
		$user->get_check->add_attr('User-Password',
					   $vals[0]);
	    }
	    elsif ($attr eq lc $self->{CheckAttr})
	    {
		# This is the attribute with check items in it
		$user->get_check->parse(join ',', @vals);
	    }
	    elsif ($attr eq lc $self->{ReplyAttr})
	    {
		# This is the attribute with reply items in it
		$user->get_reply->parse(join ',', @vals);
	    }
	}
    }
    else
    {
	$self->log($main::LOG_DEBUG, "No entries for $name found in LDAP database");
    }

    $self->unbind;
 
    if ($user && !$got_password)
    {
	$self->log($main::LOG_ERR, "There was no password attribute found for $name. Check your LDAP database.");
	return undef; # Be unforgiving: may not be able to get their password
    }
    return $user;
}
1;