# AuthLDAP.pm
#
# Object for handling Authentication vi LDAP.
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 1997 Open System Consultants
# $Id: AuthLDAP.pm,v 1.13 1999/07/14 05:28:50 mikem Exp mikem $

package Radius::AuthLDAP;
use Radius::AuthGeneric;
use Net::LDAPapi;
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} = LDAP_PORT;
}

#####################################################################
# 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;
    }
    elsif ($keyword eq 'AuthAttrDef')
    {
	# Probably should do some error checks here.
	my ($ldapname, $attrib, $type) = split (/,\s*/, $value);
	$self->{AuthAttrDef}{$ldapname} = [$attrib, $type];
    }
    elsif ($keyword eq 'HoldServerConnection')
    {
	$self->{HoldServerConnection}++;
    }
    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) = @_;

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

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

    # 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})
    {
	# 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;
	}
    }

    if ((ldap_simple_bind_s($self->{ld}, 
			    $self->{AuthDN}, 
			    $self->{AuthPassword})) != LDAP_SUCCESS)
    {
	$self->log($main::LOG_ERR, 
		   "Could not bind connection with $self->{AuthDN}. Disconnecting");
	$self->{ld} = undef;
	return 0;
    }
    # REVISIT: may want to set some options here

    return 1;  # LDAP is available
}

#####################################################################
# 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, 1) unless $self->reconnect;

    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};

    # look for all of the new AuthAttr attributes (basically push more
    # attributes onto @attrs
    my $ldapname;
    foreach $ldapname (keys %{$self->{AuthAttrDef}})
    {
	my ($attrib, $type) = @{$self->{AuthAttrDef}{$ldapname}};
	
	push(@attrs, $ldapname);
    }

    my $result;
    if (ldap_search_s($self->{ld},
		      $self->{BaseDN},
		      LDAP_SCOPE_SUBTREE,
		      "($self->{UsernameAttr}=$name)", 
		      \@attrs, 
		      0,
		      $result) != LDAP_SUCCESS)
    {
	my $msg = ldap_err2string(ldap_result2error($self->{ld}, $result, 0));
	$self->log($main::LOG_ERR, "ldap_search_s failed: $msg. 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, 1);
    }

    # We only use the first returned record
    my $got_password;
    my $ent = ldap_first_entry($self->{ld}, $result);
    if ($ent)
    {
	# Get a new User object to return
	$user = new Radius::User $name;

	my $dn = &ldap_get_dn($self->{ld}, $ent);
	$self->log($main::LOG_DEBUG, 
		   "LDAP got result for $dn");
	
	my ($attr, $ber);
	for ($attr = ldap_first_attribute($self->{ld}, $ent, $ber);
	     defined $attr;
	     $attr = ldap_next_attribute($self->{ld}, $ent, $ber))
	{
	    my @vals = ldap_get_values($self->{ld}, $ent, $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
            {
		# Perhaps its one of the attributes from AuthAttrDef
		# Based on code contributed by Steven E Ames.
		my $ldapname;

	        foreach $ldapname (keys %{$self->{AuthAttrDef}})
	        {
		    if ($attr eq lc $ldapname)
		    {
			my ($attrib, $type) = @{$self->{AuthAttrDef}{$ldapname}};
			if ($type eq 'check') 
			{
			    if ($attrib eq 'GENERIC')
			    {
				$user->get_check->parse(join ',', @vals);
			    }
			    else 
			    {
				$user->get_check->add_attr($attrib, $vals[0]);
			    }
			}
			elsif ($type eq 'reply')
			{
			    if ($attrib eq 'GENERIC')
                            {
				$user->get_reply->parse(join ',', @vals);
                            }
			    else
			    {
				$user->get_reply->add_attr($attrib, $vals[0]);
			    }
			}
		    }
		}
	    }
	}
    }
    else
    {
	$self->log($main::LOG_DEBUG, "No entries for $name found in LDAP database");
    }
    # Force disconnection from database. Some LDAP servers
    # dont expect us to try to bind several times on the same
    # TCP connection. Some dont even like us to search several times!
    $self->{ld} = undef unless $self->{HoldServerConnection};

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