#!/usr/bin/perl -w
#
# Written by Michael Donnelly, 2006
#
# This code is free to be modified, distributed or included with other 
# software as necessary.  It is provided freely, without warranties of any kind

my ($login,$passwd)= @ARGV;
Usage() unless (@ARGV > 1);

# These four settings should be hard-coded to the correct values as necessary
my $ldap_uri = "ldap://127.0.0.1";  # A space-seperated list of host URIs.
my $ldap_base = ""; # Set to the server's root DN, such as dc=domain,dc=com
my $ldap_bind = ""; # Used for initial LDAP search to resolve login to DN
my $ldap_pw = "";   # Used for initial LDAP search to resolve login to DN
my $debug = 0;      # Set debug to 1 for testing and dev purposes only

#
# This script can either be used directly from the command line, or can 
# be included for use by other Perl scripts.  If included, please note 
# that the syntax is:
#   $return_code = auth_user($login_name, $passwd, $ldap_uri, $ldap_base_dn);
#
# Applications that expect the password to be in 
# cleartext format, or that expect the user DN to be in a particular format
# are poorly designed, and are going to suffer from portability issues.
#
# The methodology below will work for ALL applications that wish to authenticate
# against any LDAP directory.   
#
# This application is provided as an example of "Doing it right".
#
# 1) Get login (or email) and password from user.
# 2) Bind to the LDAP server anonymously (or using a set account if anon 
#    binds are disabled)
# 3) Search the directory using an appropriate filter to identify the 
#    record for the specific login name provided.
# 4) If one and only one entry is returned, that entry's DN is used.  
#    If 0, or >1 entries are returned, return "no such user"
# 5) The LDAP client then binds to the LDAP directory using the DN returned 
#    in step 4 and the password from step 1
# 6) If the LDAP server says the bind is successful, return "login valid", 
#    otherwise return "invalid password".

#
# A note about including this into other perl programs -- 
# simply call auth_user with the appropriate arguments; a return code
# of 0 indicates success.   See comments in each subroutine for additional
# details
 
use strict;
use Net::LDAP;

my ($code,$string) = auth_user($login,$passwd,
	$ldap_uri,$ldap_base,$ldap_bind,$ldap_pw);

print "$string\n";
exit ($code);

sub auth_user {
	# Tests authentication for the user.
	# Returns
	#	Error code (0 indicates success)
	#	Human-friendly result string

	my ($login,$passwd,$ldap_uri,$ldap_base,$ldap_bind,$ldap_pw) = @_;
	
	my ($LDAP, $result, $dn);

	if ($debug)
	{
		print "Connecting to $ldap_uri as '$ldap_bind'\n";
	}
	($LDAP, $code, $string)= NewLDAPconnection ($ldap_uri,
		$ldap_bind, $ldap_pw );

	if ($code)
	{
		return ($code, 
			"Error $code on initial LDAP connection: $string");
	}

	print "Initial LDAP connection successful\n" if ($debug);

	# Search for the user's DN
	$result = $LDAP->search(
			base => $ldap_base,
			scope => "sub",
			filter => "(|(uid=$login)(mail=$login))",
			attrs => ['1.1'] );

	if ($result->code()) 
	{
		return ($result->code(), $result->error() );
	} 
	$LDAP->unbind();

	# If >1 entry, this is an error.
	if ($result->count > 1)
	{
		return (201, "More than one matching LDAP entry found");
	}
	elsif ($result->count == 0)
	{
		return (202, "No such username or email address found");
	}

	# If only one entry, get the DN and close the existing LDAP connection
	$dn = ($result->first_entry)->dn();

	# Now, we are ready to bind using the user's DN and password.
	($LDAP, $code, $string)= NewLDAPconnection ($ldap_uri, $dn, $passwd);
	if ($code)
	{
		return ($code, "$string");
	}
	else
	{
		return (0, "Authentication success");
	}
}

sub Usage {
	my $scriptname = $0;
	$scriptname =~ s/^.*\///;  # strip everything up to last slash in name

	print "
$scriptname usage instructions:

      $scriptname <login> <password> 

$scriptname takes as two input values, a login name and a password.  The 
script will then bind to the LDAP directory using that account information to 
authenticate the user.	

If the bind is successful, the result string \"Authentication success\" will 
be sent to STDOUT, and a return code of 0 will be generated. 

All errors will return a non-zero error code, with a suitable message to
STDOUT.

Note: This script can be invoked by other perl scripts.  Usage information 
for that invocation is in the script's comments.   These instructions apply 
only to usage of $scriptname from the command line.

";
exit 0;
}

sub NewLDAPconnection {
	# Establishes new LDAP connection, returns:
	#	LDAP handle (if successful)
	#	LDAP error code (if not successful)
	#	LDAP error string (if not successful)

	my ($ldap_uri, $dn, $password, $use_tls, $version) = @_;
	my ($LDAP);
	$LDAP = Net::LDAP->new($ldap_uri);

	$use_tls || ($use_tls = 'optional');
	$version || ($version = 3);

	if (! $LDAP) 
	{
		# the LDAP server is down.
		return("", 100, "The LDAP server $ldap_uri is currently " .
			"unavailable.");
	}

	my $result;

	if ( ( ! ( $ldap_uri =~ /^ldaps:\/\//i ) )
		&& ( ! ( $ldap_uri =~ /^ldapi:\/\//i ) )
		&& $use_tls
		&& ( ($use_tls eq "optional")
		     || ($use_tls eq "required")
		   )
		)
	{
		$result = $LDAP->start_tls();
		if ($result && $result->code && $use_tls eq "required")
		{
			return ("", $result->code, 
				"TLS Error: " . $result->error);
		}
		else
		# TLS bind failed, rebind
		{
			$LDAP = Net::LDAP->new($ldap_uri);
		}
	}

	if ($dn) 
	{
		$result = $LDAP->bind(
			dn => $dn,
			password => $password,
			version => $version
			);
	} 
	else 
	{
		$result = $LDAP->bind(
			anonymous => "",
			version => $version
			);
	}
	if ($result->code)
	{
		return ("", $result->code, $result->error);
	}
	return ($LDAP, 0, 0);
}

1;	# for "require" inclusion into other scripts.