282 lines
6.7 KiB
Perl
282 lines
6.7 KiB
Perl
package WebGUI::LDAPLink;
|
|
|
|
=head1 LEGAL
|
|
|
|
-------------------------------------------------------------------
|
|
WebGUI is Copyright 2001-2005 Plain Black Corporation.
|
|
-------------------------------------------------------------------
|
|
Please read the legal notices (docs/legal.txt) and the license
|
|
(docs/license.txt) that came with this distribution before using
|
|
this software.
|
|
-------------------------------------------------------------------
|
|
http://www.plainblack.com info@plainblack.com
|
|
-------------------------------------------------------------------
|
|
|
|
=cut
|
|
|
|
|
|
use strict;
|
|
use Tie::CPHash;
|
|
use WebGUI::International;
|
|
use WebGUI::Session;
|
|
use WebGUI::SQL;
|
|
use Net::LDAP;
|
|
|
|
=head1 NAME
|
|
|
|
Package WebGUI::LDAPLink
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This package contains utility methods for WebGUI's ldap link system.
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use WebGUI::LDAPLink;
|
|
$hashRef = WebGUI::LDAPLink::getList();
|
|
%ldapLink = WebGUI::LDAPLink::get($ldapLinkId);
|
|
|
|
$ldapLink = WebGUI::LDAPLink->new($ldapLinkId);
|
|
$connection = $ldapLink->authenticate();
|
|
$ldapLink->disconnect;
|
|
|
|
=head1 METHODS
|
|
|
|
These subroutines are available from this package:
|
|
|
|
=cut
|
|
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 bind ( )
|
|
|
|
Authenticates against the ldap server with the parameters stored in the class, returning a valid ldap connection, or 0 if a connection
|
|
cannot be established
|
|
|
|
=cut
|
|
|
|
sub bind {
|
|
my $class = shift;
|
|
my ($uri, $ldap, $auth, $result, $error);
|
|
|
|
if (defined $class->{_connection}) {
|
|
return $class->{_connection};
|
|
}
|
|
|
|
my $ldapUrl = $class->{_ldapLink}->{ldapUrl};
|
|
my $connectDn = $class->{_ldapLink}->{connectDn};
|
|
my $identifier = $class->{_ldapLink}->{identifier};
|
|
|
|
if($ldapUrl eq "") {
|
|
$class->{_error} = 100;
|
|
return 0;
|
|
} elsif ($connectDn eq "") {
|
|
$class->{_error} = 101;
|
|
return 0;
|
|
} elsif ($identifier eq "") {
|
|
$class->{_error} = 102;
|
|
return 0;
|
|
}
|
|
|
|
if($uri = URI->new($ldapUrl)) {
|
|
unless($ldap = Net::LDAP->new($uri->host, (port=>($uri->port || 389)))){
|
|
$class->{_error} = 103;
|
|
return 0;
|
|
}
|
|
|
|
$auth = $ldap->bind(dn=>$connectDn, password=>$identifier);
|
|
if ($auth->code == 48 || $auth->code == 49){
|
|
$class->{_error} = 104;
|
|
}elsif($auth->code > 0){
|
|
$class->{_error} = $auth->code;
|
|
}
|
|
$class->{_connection} = $ldap;
|
|
}else{
|
|
$class->{_error} = 105;
|
|
return 0;
|
|
}
|
|
return $class->{_connection};
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
sub DESTROY {
|
|
my $class = shift;
|
|
$class->unbind;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 getErrorMessage ( [ldapErrorCode] )
|
|
|
|
Returns the error string representing the error code generated by Net::LDAP. If no code is passed in, the most recent error stored by the class is returned
|
|
|
|
=head3 ldapErrorCode
|
|
|
|
A valid ldap error code.
|
|
|
|
=cut
|
|
|
|
sub getErrorMessage {
|
|
my $class = shift;
|
|
my $errorCode = $_[0] || $class->{_error};
|
|
return "" unless $errorCode;
|
|
my $i18nCode = "LDAPLink_".$errorCode;
|
|
return WebGUI::International::get($i18nCode,"AuthLDAP");
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 getList ( )
|
|
|
|
Returns a hash reference containing all ldap links. The format is:
|
|
ldapLinkId => ldapLinkName
|
|
|
|
=cut
|
|
|
|
sub getList {
|
|
my %list;
|
|
tie %list, "Tie::IxHash";
|
|
%list = WebGUI::SQL->buildHash("select ldapLinkId, ldapLinkName from ldapLink order by ldapLinkName");
|
|
return \%list;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 get ( ldapLinkId )
|
|
|
|
Returns a hashRef containing a single ldap link.
|
|
|
|
=head3 ldapLinkId
|
|
|
|
A valid ldapLinkId
|
|
|
|
=cut
|
|
|
|
sub get {
|
|
my %hash;
|
|
tie %hash, 'Tie::CPHash';
|
|
%hash = WebGUI::SQL->quickHash("select * from ldapLink where ldapLinkId=".quote($_[0]));
|
|
return \%hash;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 unbind ( )
|
|
|
|
Disconnect cleanly from the current databaseLink.
|
|
|
|
=cut
|
|
|
|
sub unbind {
|
|
my ($class, $value);
|
|
$class = shift;
|
|
$value = shift;
|
|
if (defined $class->{_connection}) {
|
|
$class->{_connection}->unbind;
|
|
}
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 new ( ldapLinkId )
|
|
|
|
Constructor.
|
|
|
|
=head3 ldapLinkId
|
|
|
|
The ldapLinkId of the ldapLink you're creating an object reference for.
|
|
|
|
=cut
|
|
|
|
sub new {
|
|
my ($class, $ldapLinkId, $ldapLink);
|
|
$class = shift;
|
|
$ldapLinkId = shift;
|
|
return undef unless $ldapLinkId;
|
|
$ldapLink = get($ldapLinkId);
|
|
bless {_ldapLinkId => $ldapLinkId, _ldapLink => $ldapLink }, $class;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 getProperty(dn,property)
|
|
|
|
Returns the results of a search on the property passed in
|
|
|
|
=head3 distinguished name of property
|
|
|
|
distinguished name of group to check users for
|
|
|
|
=head3 property
|
|
|
|
ldap property to retrieve from distinguished name
|
|
|
|
=cut
|
|
|
|
sub getProperty {
|
|
my $self = shift;
|
|
my $ldap = $self->bind;
|
|
my $dn = $_[0];
|
|
my $property = $_[1];
|
|
return [] unless($ldap && $dn && $property);
|
|
my $results = [];
|
|
my $msg = $ldap->search(
|
|
base => $dn,
|
|
scope => 'sub',
|
|
filter => "&(objectClass=*)"
|
|
);
|
|
if(!$msg->code && $msg->count > 0 ){
|
|
my $entry = $msg->entry(($msg->count)-1);
|
|
$results = $entry->get_value($property,asref => 1);
|
|
}
|
|
return $results;
|
|
}
|
|
|
|
#-------------------------------------------------------------------
|
|
|
|
=head2 recurseProperty(base,array,property,alternateKey)
|
|
|
|
Returns the whether or not the user is in a particular group
|
|
|
|
=cut
|
|
|
|
sub recurseProperty {
|
|
my $self = shift;
|
|
my $ldap = $self->bind;
|
|
my $base = $_[0];
|
|
my $array = $_[1] || [];
|
|
my $property = $_[2];
|
|
my $recProperty = $_[3] || $property;
|
|
my $count = $_[4] || 0;
|
|
return unless($ldap && $base && $property);
|
|
|
|
#Prevent infinate recursion
|
|
$count++;
|
|
return if $count == 99;
|
|
|
|
#search the base
|
|
my $msg = $ldap->search(
|
|
base => $base,
|
|
scope => 'sub',
|
|
filter => "&(objectClass=*)"
|
|
);
|
|
#return if nothing found
|
|
return if($msg->code || $msg->count == 0);
|
|
#loop through the results
|
|
for (my $i = 0; $i < $msg->count; $i++) {
|
|
my $entry = $msg->entry($i);
|
|
#push all the values stored in the property on to the array stack
|
|
my $properties = $entry->get_value($property,asref => 1);
|
|
push(@{$array},@{$properties});
|
|
#Loop through the recursive keys
|
|
if($property ne $recProperty) {
|
|
$properties = $entry->get_value($recProperty,asref => 1);
|
|
}
|
|
foreach my $prop (@{$properties}) {
|
|
$self->recurseProperty($prop,$array,$property,$recProperty,$count);
|
|
}
|
|
}
|
|
}
|
|
|
|
1;
|