LDAP - Net::LDAP::Schema and attributes

Author

Net::LDAP::Schema and attributes

Andrej Ricnik-Bay

2006-09-13, 4:14 am

Hi Gents,

I've quickly glanced over the mailing list archive, read the docs on cpan,
googled around but I still fail to understand how I could narrow down
a search for attributes that only returns values that make sense in a
given ou, e.g. ou=people,ou=users,o=org

The reason that I'm looking for this is because I want to present users
who have authenticated themselves against ldap with a list of attributes
that they can query from a CGI script, and then export a query result to
a csv file. However, our directory knows over 800 attributes, most of
which have no relevance to a query; but I'm reluctant to hard-code
choices in case we modify the schema later on and extend the objects
in ou=people .

Any hints/code examples or pointer on which friendly manual to read
are greatly appreciated.

Cheers,
Andrej

Peter Marschall

2006-09-13, 4:14 am

Hi,

On Wednesday, 13. September 2006 06:03, Andrej Ricnik-Bay wrote:
> I've quickly glanced over the mailing list archive, read the docs on cpan,
> googled around but I still fail to understand how I could narrow down
> a search for attributes that only returns values that make sense in a
> given ou, e.g. ou=people,ou=users,o=org
>
> The reason that I'm looking for this is because I want to present users
> who have authenticated themselves against ldap with a list of attributes
> that they can query from a CGI script, and then export a query result to
> a csv file. However, our directory knows over 800 attributes, most of
> which have no relevance to a query; but I'm reluctant to hard-code
> choices in case we modify the schema later on and extend the objects
> in ou=people .

Try to use a strategy like this one
- get all objectclasses in ou=people,ou=users,o=org
(= one search for the attribute objectclass)
- get the attributes for the objectclasses found
(= one call to $schema->must() and $schema->may() per objectclass)
- combine & uniq the lists of attributes found from the calls above

Depending on your use case you might consider doing this not interactively but
on a regular schedule in a spearate job and have the results stored in a
config file.

Hope it helps
Peter
--
Peter Marschall
peter@adpm.de

Andrej Ricnik-Bay

2006-09-13, 4:14 am

Thanks to both Peter and Simon,

I like both ideas, I guess I'll need to have a much closer second
look at our schema and then decide which way I want to go down.

I think that several of the attributes for objects in people is of no
concern to most staff anyway, and I need to investigate how access
to those fields is locked down.

But I guess I could cut the selectable attributes down to maybe a
subset of 15 which would be easy enough using a config file as
Simon suggested.

Thanks again!

Cheers,
Andrej

Andrej Ricnik-Bay

2006-09-17, 10:03 pm

Hi again,

I've run into a problem that I can't quite understand.

I've created an HTML form that invokes a CGI script as form-action,
that works well. I have a collection of LDAP related functions in a
package that I use from the CGI script - this works to. ldapconnect()
works, parseldapoutput() works ...

One of the functions in the package outputs another form (the list of allowed
attributes to search for) whose form-action is yet another script that
then uses more of the first scripts functions to (or so I thought)
do an LDAP search on the fields selected from the form. When I
invoke search_it from script2 I get the following error in my apache log:

Can't call method "search" on an undefined value at ldap2csv.pl line
118, <DATA> line 225.

I can't for the life of me figure out which value it's complaining about as
uninitialised ... I've verified with a print that the parameter passed is valid
and has the list of attributes in it; everything else is constant.

from script2:
&ldapcsv::print_header();

read( STDIN, $data, $ENV{"CONTENT_LENGTH"});
@pairs = split( "&", $data);
#print "Anything here at all? $data <BR>\n";
foreach $pair (@pairs) {
$name=""; $value="";
# print "<BR>SPACER<BR> $#pairs <BR>\n";
$pair =~ tr/+/ /;
$pair =~ s/%(..)/pack("C", hex($1))/eg;
$pair =~ m/(\w+)(?:=)?(.+)/ ;
if( defined $2 && $2 ne "=" ) {
$name=$1;
$value=$2;
chomp $name;
chomp $value;
if ( $name =~ /Attributes/ && defined $query ){
$query .= ", '".$value."'"
} else {
$query = "'".$value."'"
}
}
}
print "<BR>Final: $query <BR>\n";

&ldapcsv::search_it( $query );

script1:
package ldapcsv;
use strict;
use Net::LDAP;
use Net::LDAP::Entry;
use Net::LDAP::Schema;
..
..
..
sub search_it {
my ( $param ) = @_ ;
print "<BR>In search_it: $param <BR>\n";
$mesg = $ldap->search(
base => 'ou=people,ou=users,o=ORG',
filter => '(cn=*)',
scope => 'sub',
attrs => [ "$param" ],
timelimit => 90
);
if ( $mesg->code == 0 ) {
my @entry = $mesg->entries;
if (@entry) {
foreach my $entr (@entry) {
my $attr;
foreach $attr ( sort $entr->attributes ) {
print " $attr : ", $entr->get_value($attr), "\n";
}
}
}
}
}

Where to look, what (else) to try?

Cheers,
Andrej

Peter Marschall

2006-09-18, 4:08 am

Hi,

On Monday, 18. September 2006 04:26, Andrej Ricnik-Bay wrote:
> Can't call method "search" on an undefined value at ldap2csv.pl line
> 118, <DATA> line 225.

It's in line 118, where the Perl is told to perform the search() method on
something that is undefined nistead of an object of a class that supports a
search() method.

> I can't for the life of me figure out which value it's complaining about as
> uninitialised ... I've verified with a print that the parameter passed is
> valid and has the list of attributes in it; everything else is constant.

> from script2:
> &ldapcsv::print_header();
>
> read( STDIN, $data, $ENV{"CONTENT_LENGTH"});
> @pairs = split( "&", $data);
> #print "Anything here at all? $data <BR>\n";
> foreach $pair (@pairs) {
> $name=""; $value="";
> # print "<BR>SPACER<BR> $#pairs <BR>\n";
> $pair =~ tr/+/ /;
> $pair =~ s/%(..)/pack("C", hex($1))/eg;
> $pair =~ m/(\w+)(?:=)?(.+)/ ;
> if( defined $2 && $2 ne "=" ) {
> $name=$1;
> $value=$2;
> chomp $name;
> chomp $value;
> if ( $name =~ /Attributes/ && defined $query ){
> $query .= ", '".$value."'"
> } else {
> $query = "'".$value."'"
> }
> }
> }
> print "<BR>Final: $query <BR>\n";
>
> &ldapcsv::search_it( $query );
>
>
> script1:
> package ldapcsv;
> use strict;
> use Net::LDAP;
> use Net::LDAP::Entry;
> use Net::LDAP::Schema;
> .
> .
> .
> sub search_it {
> my ( $param ) = @_ ;
> print "<BR>In search_it: $param <BR>\n";
> $mesg = $ldap->search(

I guess here is the problem.
Did you define $ldap in this package ?

> base => 'ou=people,ou=users,o=ORG',
> filter => '(cn=*)',
> scope => 'sub',
> attrs => [ "$param" ],
> timelimit => 90
> );
> if ( $mesg->code == 0 ) {
> my @entry = $mesg->entries;
> if (@entry) {
> foreach my $entr (@entry) {
> my $attr;
> foreach $attr ( sort $entr->attributes ) {
> print " $attr : ", $entr->get_value($attr), "\n";
> }
> }
> }
> }
> }
>

Hope it helps
Peter
--
Peter Marschall
peter@adpm.de

Peter Marschall

2006-09-18, 7:07 pm

Hi,

Please keep your reply to the list !!!
You deprive others of the help you get if you send personal mail
in response to posts that help you with your requests.

On Monday, 18. September 2006 09:45, Andrej Ricnik-Bay wrote:
> On 9/18/06, Peter Marschall <peter@adpm.de> wrote:
>
> OK, but I don't understand how or why.
>

You still do work with packages !
[color=darkred]

Why don't you do it the clean way:
pass the $ldap object as a parameter to search_it()
instead of relying on global variables, which is
a bad habit anyway.
[color=darkred]
>
> Yep. See above. I assumed that it might be a scope
> problem (and a timing issue) and put all three files into
> a single file, working without packaging. Even though
> my LDAP connect works fine, and I can bind, as soon
> as I attempt the search I get the same message (on a
> different line now, of course) - very confusing.

=46rom what I can tell, the problem described is neither=20
a timing problem nor a problem of perl-ldap.

Peter
=2D-=20
Peter Marschall
peter@adpm.de

Andrej Ricnik-Bay

2006-09-18, 7:07 pm

On 9/19/06, Peter Marschall <peter@adpm.de> wrote:
> Hi,
Hi Peter,

> Please keep your reply to the list !!!
> You deprive others of the help you get if you send personal mail
> in response to posts that help you with your requests.
Sorry, only clicking on the reply is a bad habit, I'll watch it.

> You still do work with packages !
Nope - that was just to point out that I had used the package in the
original script since you asked about that. The new version doesn't
have it at all

> Why don't you do it the clean way:
> pass the $ldap object as a parameter to search_it()
> instead of relying on global variables, which is
> a bad habit anyway.
I had tried that, too, with no effect.

> From what I can tell, the problem described is neither
> a timing problem nor a problem of perl-ldap.
Hmmm ... where else to look (if it blows the scope of the list)?

Here's the full script (not overly elegant, I admit).

--------8<--------8<--------8<--------8<--------8<--------8<--------8<--------
#!/usr/bin/perl -w
# Andrej - andrej.groups@gmail.com
# On our way to a CGI script that queries LDAP and outputs CSV
use strict;
use Net::LDAP;
use Net::LDAP::Search;
use Net::LDAP::Entry;

our (
$ldap, $ldapbasedn, $ldappassword,
$value, $data, $ldapuser,
$mesg, $query, %token,
$attr, $entr, $param,
@entry
); #declared via "our" because we have external components writing to these
use vars qw($pair @pairs $name $data $ldappassword $ldapuser $query);
# for when "our" isn't good enough =/
sub print_header() {
print <<END;
Content-type: text/html\n\n
<HTML>
<HEAD>
<meta http-equiv="Content-Type" content="text/html">
<meta name="GENERATOR" content="vim - baby!">
<title>LDAP query => CSV output</title>
</HEAD>
<BODY>
END
}

sub print_footer() {
print <<END;
</BODY>
</HTML>
END
}

#ldap connection for spitting data at.
sub ldapconnect {
#Connect
$ldap = Net::LDAP->new( "auth", port => 389, async => 0 );
if ( !defined $ldap ) {
exit;
}

#Authenticate
print "<br>in ldapconnect<br>\n";
my $mesg = $ldap->bind( $ldapuser, password => $ldappassword );
my $result = parseldapresponse($mesg);
if ( $result ne "0000" ) {
# debug-info
print "<br>leaving ldapconnect with error<br>\n";
exit;
}
# debug-info
print "<br>leaving ldapconnect<br>\n";
}

sub parseldapresponse {
my ($mesg) = @_;
my $errorcode = $mesg->code;
# debug-info
print "<BR<BR>Errorcode: $errorcode <BR><BR>\n";
return "0000" if ( $errorcode == 0 );
return "2003"
if ( $errorcode == 20 || $errorcode == 68 )
; # attribute exists or value exists
return "2000"
if ( ( $errorcode > 15 && $errorcode < 37 )
|| ( $errorcode > 63 && $errorcode < 71 )
|| $errorcode == 53 );
return "3000";
}

sub show_attrs {
print <<END;
<FORM METHOD="POST" ACTION="./ldapcsv.cgi">
<SELECT NAME="Attributes" SIZE="10" MULTIPLE>
END

open MYLIST, '<../htdocs/attributes.conf' or die "Can't open file";
while( <MYLIST> ){
print "<OPTION VALUE=\"$_\">$_</OPTION>\n";
};
close MYLIST;

print <<END2;
</SELECT>
<INPUT TYPE="SUBMIT" NAME="Process">
END2
}

sub search_it {
print "<BR>In search_it: <BR>\n";
my ( $param ) = @_ ;
$mesg = $ldap->search(
base => 'ou=people,ou=users,o=org',
filter => "(uid=*)",
scope => 'sub',
attrs => [ $param ],
timelimit => 90
);
if ( $mesg->code == 0 ) {
my @entry = $mesg->entries;
if (@entry) {
foreach my $entr (@entry) {
my $attr;
foreach $attr ( sort $entr->attributes ) {
print " $attr : ", $entr->get_value($attr), "\n";
}
}
}
}
}

sub process_attrs {
@pairs = split( "&", $data);
#print "Anything here at all? $data <BR>\n";
foreach $pair (@pairs) {
$name=""; $value="";
# print "<BR>SPACER<BR> $#pairs <BR>\n";
$pair =~ tr/+/ /;
$pair =~ s/%(..)/pack("C", hex($1))/eg;
$pair =~ m/(\w+)(?:=)?(.+)/ ;
if( defined $2 && $2 ne "=" ) {
$name=$1;
$value=$2;
chomp $name;
chomp $value;
if ( $name =~ /Attributes/ && defined $query ){
$query .= ", '".$value."'"
} else {
$query = "'".$value."'"
}
}
}
}

sub get_login {
@pairs = split( "&", $data);
foreach $pair (@pairs) {
$pair =~ tr/+/ /;
$pair =~ s/%(..)/pack("C", hex($1))/eg;
$pair =~ m/(\w+)(?:=)?(.+)/ ;
if( defined $2) {
$name=$1;
$value=$2;
chomp $name;
chomp $value;
print "<BR>Name: $name \tValue: $value <BR> \n";
$token{$name} = $value;
}
}
$ldapuser = $token{"cn"};
$ldappassword = $token{"passwd"};
}

sub print_login {
print <<END;
<HTML>
<HEAD>
<TITLE>ldap query</TITLE>
</HEAD>
<BODY>
<P>Please supply your LDAP credentials</P>
<FORM METHOD="POST" ACTION="./ldapcsv.cgi">
<INPUT TYPE="TEXT" NAME="cn" MAXLENGTH="25" SIZE="25" ><BR>
<INPUT TYPE="PASSWORD" NAME="passwd" SIZE="25" MAXLENGTH="25"><BR>
<INPUT TYPE="SUBMIT" NAME="Login">
</BODY>
</HTML>
END
}

print_header();
read( STDIN, $data, $ENV{"CONTENT_LENGTH"});
if( length $data == 0 ){
print_login();
}
if( $data =~ /Login/){
get_login();
print "<BR> $ldapuser<BR>\n";
ldapconnect();
show_attrs();
}
if( $data =~ /Process/){
print "<BR>Process clicked!<BR>\n";
process_attrs();
print "<BR> $query <BR>\n";
search_it( $query );
}
print_footer();

--------8<--------8<--------8<--------8<--------8<--------8<--------8<--------
I still find it odd that connect & bind work, but search fails...

> Peter
Cheers,
Andrej

Peter Marschall

2006-09-18, 7:07 pm

Hi,

this is outside the scope of this list,
but I would not expect that a perl object survives
between two invocations of a CGI script.

Regards
Peter

On Monday, 18. September 2006 22:35, Andrej Ricnik-Bay wrote:
> On 9/19/06, Peter Marschall <peter@adpm.de> wrote:
>
> Hi Peter,
>
>
> Sorry, only clicking on the reply is a bad habit, I'll watch it.
>
>
> Nope - that was just to point out that I had used the package in the
> original script since you asked about that. The new version doesn't
> have it at all
>
>
> I had tried that, too, with no effect.
>
>
> Hmmm ... where else to look (if it blows the scope of the list)?
>
> Here's the full script (not overly elegant, I admit).
>
> --------8<--------8<--------8<--------8<--------8<--------8<--------8<-----
>--- #!/usr/bin/perl -w
> # Andrej - andrej.groups@gmail.com
> # On our way to a CGI script that queries LDAP and outputs CSV
> use strict;
> use Net::LDAP;
> use Net::LDAP::Search;
> use Net::LDAP::Entry;
>
> our (
> $ldap, $ldapbasedn, $ldappassword,
> $value, $data, $ldapuser,
> $mesg, $query, %token,
> $attr, $entr, $param,
> @entry
> ); #declared via "our" because we have external components writing to
> these use vars qw($pair @pairs $name $data $ldappassword $ldapuser $query);
> # for when "our" isn't good enough =/
> sub print_header() {
> print <<END;
> Content-type: text/html\n\n
> <HTML>
> <HEAD>
> <meta http-equiv="Content-Type" content="text/html">
> <meta name="GENERATOR" content="vim - baby!">
> <title>LDAP query => CSV output</title>
> </HEAD>
> <BODY>
> END
> }
>
> sub print_footer() {
> print <<END;
> </BODY>
> </HTML>
> END
> }
>
>
> #ldap connection for spitting data at.
> sub ldapconnect {
> #Connect
> $ldap = Net::LDAP->new( "auth", port => 389, async => 0 );
> if ( !defined $ldap ) {
> exit;
> }
>
> #Authenticate
> print "<br>in ldapconnect<br>\n";
> my $mesg = $ldap->bind( $ldapuser, password => $ldappassword );
> my $result = parseldapresponse($mesg);
> if ( $result ne "0000" ) {
> # debug-info
> print "<br>leaving ldapconnect with error<br>\n";
> exit;
> }
> # debug-info
> print "<br>leaving ldapconnect<br>\n";
> }
>
>
> sub parseldapresponse {
> my ($mesg) = @_;
> my $errorcode = $mesg->code;
> # debug-info
> print "<BR<BR>Errorcode: $errorcode <BR><BR>\n";
> return "0000" if ( $errorcode == 0 );
> return "2003"
> if ( $errorcode == 20 || $errorcode == 68 )
> ; # attribute exists or value exists
> return "2000"
> if ( ( $errorcode > 15 && $errorcode < 37 )
>
> || ( $errorcode > 63 && $errorcode < 71 )
> || $errorcode == 53 );
>
> return "3000";
> }
>
> sub show_attrs {
> print <<END;
> <FORM METHOD="POST" ACTION="./ldapcsv.cgi">
> <SELECT NAME="Attributes" SIZE="10" MULTIPLE>
> END
>
> open MYLIST, '<../htdocs/attributes.conf' or die "Can't open file";
> while( <MYLIST> ){
> print "<OPTION VALUE=\"$_\">$_</OPTION>\n";
> };
> close MYLIST;
>
> print <<END2;
> </SELECT>
> <INPUT TYPE="SUBMIT" NAME="Process">
> END2
> }
>
> sub search_it {
> print "<BR>In search_it: <BR>\n";
> my ( $param ) = @_ ;
> $mesg = $ldap->search(
> base => 'ou=people,ou=users,o=org',
> filter => "(uid=*)",
> scope => 'sub',
> attrs => [ $param ],
> timelimit => 90
> );
> if ( $mesg->code == 0 ) {
> my @entry = $mesg->entries;
> if (@entry) {
> foreach my $entr (@entry) {
> my $attr;
> foreach $attr ( sort $entr->attributes ) {
> print " $attr : ", $entr->get_value($attr), "\n";
> }
> }
> }
> }
> }
>
> sub process_attrs {
> @pairs = split( "&", $data);
> #print "Anything here at all? $data <BR>\n";
> foreach $pair (@pairs) {
> $name=""; $value="";
> # print "<BR>SPACER<BR> $#pairs <BR>\n";
> $pair =~ tr/+/ /;
> $pair =~ s/%(..)/pack("C", hex($1))/eg;
> $pair =~ m/(\w+)(?:=)?(.+)/ ;
> if( defined $2 && $2 ne "=" ) {
> $name=$1;
> $value=$2;
> chomp $name;
> chomp $value;
> if ( $name =~ /Attributes/ && defined $query ){
> $query .= ", '".$value."'"
> } else {
> $query = "'".$value."'"
> }
> }
> }
> }
>
>
> sub get_login {
> @pairs = split( "&", $data);
> foreach $pair (@pairs) {
> $pair =~ tr/+/ /;
> $pair =~ s/%(..)/pack("C", hex($1))/eg;
> $pair =~ m/(\w+)(?:=)?(.+)/ ;
> if( defined $2) {
> $name=$1;
> $value=$2;
> chomp $name;
> chomp $value;
> print "<BR>Name: $name \tValue: $value <BR> \n";
> $token{$name} = $value;
> }
> }
> $ldapuser = $token{"cn"};
> $ldappassword = $token{"passwd"};
> }
>
> sub print_login {
> print <<END;
> <HTML>
> <HEAD>
> <TITLE>ldap query</TITLE>
> </HEAD>
> <BODY>
> <P>Please supply your LDAP credentials</P>
> <FORM METHOD="POST" ACTION="./ldapcsv.cgi">
> <INPUT TYPE="TEXT" NAME="cn" MAXLENGTH="25" SIZE="25" ><BR>
> <INPUT TYPE="PASSWORD" NAME="passwd" SIZE="25" MAXLENGTH="25"><BR>
> <INPUT TYPE="SUBMIT" NAME="Login">
> </BODY>
> </HTML>
> END
> }
>
> print_header();
> read( STDIN, $data, $ENV{"CONTENT_LENGTH"});
> if( length $data == 0 ){
> print_login();
> }
> if( $data =~ /Login/){
> get_login();
> print "<BR> $ldapuser<BR>\n";
> ldapconnect();
> show_attrs();
> }
> if( $data =~ /Process/){
> print "<BR>Process clicked!<BR>\n";
> process_attrs();
> print "<BR> $query <BR>\n";
> search_it( $query );
> }
> print_footer();
>
> --------8<--------8<--------8<--------8<--------8<--------8<--------8<-----
>--- I still find it odd that connect & bind work, but search fails...
>
>
> Cheers,
> Andrej

--
Peter Marschall
peter@adpm.de

Andrej Ricnik-Bay

2006-09-18, 7:07 pm

On 9/19/06, Peter Marschall <peter@adpm.de> wrote:
> Hi,
Hi Peter,

And thanks for the response.

> this is outside the scope of this list,
> but I would not expect that a perl object survives
> between two invocations of a CGI script.
/me slaps his hand on his forehead
Sorry guys.

> Regards
> Peter
Cheers,
Andrej

Sponsored Links