Ready for 7.10.29 development.
This commit is contained in:
Colin Kuskie
commit
c806f99b7b
4236 changed files with 1217679 additions and 0 deletions
371
lib/WebGUI/LDAPLink.pm
Normal file
371
lib/WebGUI/LDAPLink.pm
Normal file
|
|
@ -0,0 +1,371 @@
|
|||
package WebGUI::LDAPLink;
|
||||
|
||||
=head1 LEGAL
|
||||
|
||||
-------------------------------------------------------------------
|
||||
WebGUI is Copyright 2001-2009 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 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($self->session,);
|
||||
%ldapLink = WebGUI::LDAPLink->new($self->session,$ldapLinkId)->get;
|
||||
|
||||
$ldapLink = WebGUI::LDAPLink->new($self->session,$ldapLinkId);
|
||||
$connection = $ldapLink->connectToLDAP();
|
||||
$ldapLink->unbind;
|
||||
|
||||
=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 $self = shift;
|
||||
my ($uri, $auth, $result, $error);
|
||||
|
||||
if (defined $self->{_connection}) {
|
||||
return $self->{_connection};
|
||||
}
|
||||
|
||||
my $ldapUrl = $self->{_ldapLink}->{ldapUrl};
|
||||
my $connectDn = $self->{_ldapLink}->{connectDn};
|
||||
my $identifier = $self->{_ldapLink}->{identifier};
|
||||
|
||||
if ($ldapUrl eq "") {
|
||||
$self->{_error} = 100;
|
||||
return 0;
|
||||
}
|
||||
|
||||
my $ldap = $self->connectToLDAP($ldapUrl);
|
||||
|
||||
return 0 unless ($ldap);
|
||||
|
||||
$auth = $ldap->bind(dn=>$connectDn, password=>$identifier);
|
||||
if ($auth->code == 48 || $auth->code == 49) {
|
||||
$self->{_error} = 104;
|
||||
} elsif($auth->code > 0) {
|
||||
$self->{_error} = $auth->code;
|
||||
}
|
||||
|
||||
return $ldap;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 connectToLDAP ( )
|
||||
|
||||
Attempts to bind to an LDAP server returning the Net::LDAP object if successful
|
||||
|
||||
=cut
|
||||
|
||||
sub connectToLDAP {
|
||||
my $self = shift;
|
||||
my $ldapUrl = shift || $self->getValue("ldapUrl");
|
||||
my $uri = URI->new($ldapUrl);
|
||||
|
||||
unless ($uri) {
|
||||
$self->{_error} = 105;
|
||||
return undef;
|
||||
}
|
||||
|
||||
$self->{_uri} = $uri;
|
||||
my $ldap = Net::LDAP->new($uri->host,
|
||||
port => $uri->port, #Port will default to 389 or 636
|
||||
scheme => $uri->scheme,
|
||||
);
|
||||
|
||||
unless($ldap) {
|
||||
$self->{_error} = 103;
|
||||
return undef;
|
||||
}
|
||||
|
||||
$self->{_connection} = $ldap;
|
||||
|
||||
return $ldap;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub DESTROY {
|
||||
my $self = shift;
|
||||
$self->unbind;
|
||||
undef $self;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 get ( )
|
||||
|
||||
Returns the list of LDAP connection properties.
|
||||
|
||||
=cut
|
||||
|
||||
sub get {
|
||||
my $self = shift;
|
||||
return $self->{_ldapLink};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getErrorCode ( )
|
||||
|
||||
Returns the numerical error code generated by the bind() method.
|
||||
|
||||
=cut
|
||||
|
||||
sub getErrorCode {
|
||||
my $self = shift;
|
||||
return $self->{_error};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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 $self = shift;
|
||||
my $errorCode = shift || $self->getErrorCode;
|
||||
return "" unless $errorCode;
|
||||
my $i18nCode = "LDAPLink_".$errorCode;
|
||||
my $i18n = WebGUI::International->new($self->session,"AuthLDAP");
|
||||
return $i18n->get($i18nCode);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getList ( session )
|
||||
|
||||
Returns a hash reference containing all ldap links. The format is: ldapLinkId => ldapLinkName. This is a class method.
|
||||
|
||||
=head3 session
|
||||
|
||||
A reference to the current session.
|
||||
|
||||
=cut
|
||||
|
||||
sub getList {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my %list;
|
||||
tie %list, "Tie::IxHash";
|
||||
%list = $session->db->buildHash("select ldapLinkId, ldapLinkName from ldapLink order by ldapLinkName");
|
||||
return \%list;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getURI ( )
|
||||
|
||||
Returns the uri object for the ldap connection.
|
||||
|
||||
=cut
|
||||
|
||||
sub getURI {
|
||||
my $self = shift;
|
||||
return $self->{_uri};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 getValue ( property )
|
||||
|
||||
Returns the value of the property passed in.
|
||||
|
||||
=cut
|
||||
|
||||
sub getValue {
|
||||
my $self = shift;
|
||||
my $prop = shift;
|
||||
return $self->get->{$prop};
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 unbind ( )
|
||||
|
||||
Disconnect cleanly from the current databaseLink.
|
||||
|
||||
=cut
|
||||
|
||||
sub unbind {
|
||||
my $self = shift;
|
||||
if (defined $self->{_connection}) {
|
||||
$self->{_connection}->unbind;
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 new ( session, ldapLinkId )
|
||||
|
||||
Constructor.
|
||||
|
||||
=head3 session
|
||||
|
||||
A reference to the current session.
|
||||
|
||||
=head3 ldapLinkId
|
||||
|
||||
The ldapLinkId of the ldapLink you're creating an object reference for.
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $session = shift;
|
||||
my $ldapLinkId = shift;
|
||||
return undef unless $ldapLinkId;
|
||||
my $ldapLink = $session->db->quickHashRef("select * from ldapLink where ldapLinkId=?",[$ldapLinkId]);
|
||||
bless {_session=>$session, _ldapLinkId=>$ldapLinkId, _ldapLink=>$ldapLink }, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=head2 session ( )
|
||||
|
||||
Returns a reference to the current session.
|
||||
|
||||
=cut
|
||||
|
||||
sub session {
|
||||
my $self = shift;
|
||||
return $self->{_session};
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
=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 = shift;
|
||||
my $property = shift;
|
||||
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;
|
||||
my $recurseFilter = $_[5] || $self->get->{ldapGlobalRecursiveFilter};
|
||||
my $rfAlreadyTransformed = $_[6];
|
||||
return undef unless($ldap && $base && $property);
|
||||
|
||||
if (length $recurseFilter and not $rfAlreadyTransformed) {
|
||||
$recurseFilter =~ tr/\r//d;
|
||||
$recurseFilter =~ s/\A\n*//; $recurseFilter =~ s/\n*\z//;
|
||||
$recurseFilter = (join '|', map{quotemeta} grep{/\S/} split /\n/, $recurseFilter);
|
||||
$recurseFilter = length($recurseFilter)? qr/(?i:$recurseFilter)/ : undef;
|
||||
}
|
||||
|
||||
#Prevent infinite recursion
|
||||
$count++;
|
||||
return undef if $count == 99;
|
||||
|
||||
#search the base
|
||||
my $msg = $ldap->search(
|
||||
base => $base,
|
||||
scope => 'sub',
|
||||
filter => "&(objectClass=*)"
|
||||
);
|
||||
#return undef if nothing found
|
||||
return undef 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);
|
||||
$properties = [] unless ref $properties eq "ARRAY";
|
||||
push(@{$array},@{$properties});
|
||||
#Loop through the recursive keys
|
||||
if ($property ne $recProperty) {
|
||||
$properties = $entry->get_value($recProperty,asref => 1);
|
||||
}
|
||||
foreach my $prop (@{$properties}) {
|
||||
next if $recurseFilter and $prop =~ m/$recurseFilter/;
|
||||
$self->recurseProperty($prop,$array,$property,$recProperty,$count,$recurseFilter,1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue