#!/usr/bin/perl -w
#
# Overview: This trigger script authenticates a Perforce userid against
# against an AD sAMAccount name. It will handle multiple domains.
#
# This debug version of the script is meant to be used on the commandline.
# AD_auth_debug.pl <username>"
use strict;
use Net::LDAP;
$|=1;
######################## Set Variables ####################################
# AD connect timeout
my $timeout = 10;
# Set AD server info.
my $ad_port = "389"; # AD Port, should probably leave.
my $ad_host = "AD IP"; # Put IP of your AD server here
# AD read Account.
# Full DN including user. You don't need to use an Administrator account
# any account should do I suggest you change the below line to a standard user.
my $ad_read_dn = 'CN=user,CN=Users,DC=test,DC=domain,DC=com';
my $ad_read_p = 'Password';
###########################################################################
open(STDERR, ">&STDOUT") or die "Can't dup stdout";
if (scalar(@ARGV != 1)) { die "\nUsage:\nAD_auth.pl \%username\%\n" }
my $p4_user = shift;
chomp $p4_user;
print "Please end your password: ";
my $password = <STDIN>;
$password =~ s/\r\n//;
chomp $password;
if ($password =~ /^$/) { die "Null passwords not allowed" }
print "Proceeding with the following details:\n\n";
print " User set to: $p4_user\n";
print " Password set to: $password\n\n";
print " Connecting to IP: $ad_host\n";
print " Connecting to Port: $ad_port\n\n";
print " Using read DN: $ad_read_dn\n";
print " Using read DN p: $ad_read_p\n\n";
##### Authenticate! ######################################################
my $ad = Net::LDAP->new($ad_host, port => $ad_port, timeout => $timeout ) ||
die "Unable to connect with read account";
my $mesg = $ad->bind ("$ad_read_dn", password => $ad_read_p, version => 3 ) ||
die "Unable to bind\n";
$mesg = $ad->search( base => '',
filter => "(objectclass=*)",
scope => 'base' );
my $ret = 1;
my $tc = Net::LDAP->new($ad_host, port => $ad_port, timeout => $timeout ) ||
die "Unable to connect with read account";
my @entries = ($mesg->entries);
print "Doing base query. Scanning for root domain naming context\n";
foreach my $entry (@entries) {
my $root_dn = $entry->get_value('rootDomainNamingContext');
print " Got root db: $root_dn\n";
$mesg = $ad->search ( base => $root_dn,
filter => "(samaccountname=$p4_user)",
scope => 'sub',
attrs => "mail" ) || next;
my @users = ($mesg->entries);
print "Checking if user exists here\n";
next if (! defined $users[0]);
print "User is defined\n";
print "Attempting to bind ".$users[0]->dn()."with password $password\n";
$mesg = $tc->bind(dn => $users[0]->dn(), password => $password) || next;
print "Got message back\n";
if (! $mesg->code) { $ret = 0; last }
print "Seem to have gotten an error code skipped last exit.\nError Code: ".$mesg->error."\n";
}
if ($ret) { print "Authentication Failed. Access Denied" }
exit $ret;