# AuthLDAPSDK.pm
#
# Object for handling Authentication via Netscape's LDAP SDK
# and their PerLDAP interface.
# This is a work in progress. At the time of writing, the
# Netscape LDAP SDK and the PerLDAP interface still had some rough
# edges. Nevertheless it works on ActiveState Perl on NT.
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 1997 Open System Consultants
# $Id: AuthLDAPSDK.pm,v 1.5 2000/02/15 07:07:54 mikem Exp mikem $

package Radius::AuthLDAPSDK;
use Radius::AuthGeneric;
use Mozilla::LDAP::Conn;
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';
}

#####################################################################
# 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];
    }
    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
# BUG ALERT: acfcording to the SDK docs, if the LDAP server
# disappears, PerLDAP will not (yet) reconnect
sub reconnect
{
    my ($self) = @_;

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

    my ($result, $certdbfilename, $port);

    # Maybe we need to do SSL
    # This is only possible with Netscape SDK.
    $port = 389;
    if (defined $self->{UseSSL})
    {
	# Get the name of the certificate database. certdbhandle
	my ($certdbpath, $certdbhandle) = split(/\s+/, $self->{UseSSL});
	$certdbfilename = &Radius::Util::format_special($certdbpath);
	$port = Mozilla::LDAP::API::LDAPS_PORT;
    }
    $port = $self->{Port} if defined  $self->{Port};

    my $host = &Radius::Util::format_special($self->{Host});
    $self->log($main::LOG_DEBUG, "Connecting to $host, port $port");
    if (!($self->{ld} = new Mozilla::LDAP::Conn
	 ($host, 
	  Radius::Radius::get_port($port),
	  $self->{AuthDN}, 
	  $self->{AuthPassword},
	  $certdbfilename)))
    {
	$self->log($main::LOG_ERR, 
		   "Could not open LDAP connection to $host, port $port");
	return 0;
    }
    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 $entry = $self->{ld}->search($self->{BaseDN},
				    'subtree',
				    "($self->{UsernameAttr}=$name)");

    # We only use the first returned record
    my $got_password;
    my $user;

    if ($entry)
    {
	if ($main::config->{Trace} >= 4)
	{
	    # This will print all the attributes we got on stdout
	    $entry->printLDIF();
	}

	# Get a new User object to return
	$user = new Radius::User $name;

	print "password is $entry->{userpassword}[0]\n";

	# All the attributes are now in $entry as 
	# $entry->{attributename}[n] The attribute names are all lowercase
	# Multiple instances of the same atribute are in consecutove entries
	# in the array
	if (defined $self->{EncryptedPasswordAttr})
	{
	    $user->get_check->add_attr('Encrypted-Password',
			    $entry->{lc $self->{EncryptedPasswordAttr}}[0]);
	    $got_password = 1;
	}
	elsif (defined $self->{PasswordAttr})
	{
	    $user->get_check->add_attr('User-Password',
			    $entry->{lc $self->{PasswordAttr}}[0]);
	    $got_password = 1;
	}
	if (defined $self->{CheckAttr}
	    && defined $entry->{lc $self->{CheckAttr}})
	{
	    # Join all the attributes together into a long set of
	    # comma separated check items
	    $user->get_check->parse(join ',', 
				    @{$entry->{lc $self->{CheckAttr}}});
	}
	if (defined $self->{ReplyAttr}
	    &&  defined $entry->{lc $self->{ReplyAttr}})
	{
	    # Join all the attributes together into a long set of
	    # comma separated reply items
	    $user->get_reply->parse(join ',', 
				    @{$entry->{lc $self->{ReplyAttr}}});
	}
	# Get any additional auth attributes from AuthAttrDef
	# Based on code contributed by Steven E Ames.
	my $ldapname;
	foreach $ldapname (keys %{$self->{AuthAttrDef}})
	{
	    if (defined $entry->{lc $ldapname})
	    {
		my @vals = @{$entry->{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");
    }
    if ($user && !$got_password)
    {
	$self->log($main::LOG_ERR, "There was no password attribute found for $name. Check your LDAP database.");
	# Force a rejection
	$user->get_check->add_attr('Encrypted-Password', 'no password attribute in LDAP database');
    }
    return $user;
}
1;