Open quanah opened 9 years ago
#!/usr/bin/perl -w
#
# $Id: ldapwalk.pl,v 1.1 2007/07/01 20:14:40 dieter Exp dieter $
# ldapwalk.pl - Walks through Records Matching a Given Filter
# Author: Clayton Donley, Motorola, <donley@cig.mot.com>
#
# Demonstration of Synchronous Searching in PERL5.
#
# Rather than printing attribute and values directly, they are
# stored in a Hash, where further manipulation would be very simple.
# The output could then be printed to a file or standard output, or
# simply run through the modify or add commands.
#
# Usage: ldapwalk.pl FILTER
# Example: ldapwalk.pl "sn=Donley"
#
use strict;
use Net::LDAPapi;
# Define these values
my $ldap_server = "localhost";
my $BASEDN = "ou=benchmark,o=avci,c=de";
my $sizelimit = 100; # Set to Maximum Number of Entries to Return
# Can set small to test error routines
my $deref = "search";
# Various Variable Declarations...
my $ld;
my $dn;
my $attr;
my $ent;
my $ber;
my @vals;
my %record;
my $rc;
my $result;
#
# Initialize Connection to LDAP Server
if (($ld = new Net::LDAPapi($ldap_server)) == -1)
{
die "Connection Failed!";
}
# ldap_set_option(0,LDAP_OPT_DEBUG_LEVEL,-1);
#
# Bind as NULL User to LDAP connection $ld
$ld->sasl_parms(-mech=>"DIGEST-MD5",-flags=>LDAP_SASL_AUTOMATIC);
if ($ld->bind_s("benchmark","xxx",LDAP_AUTH_SASL) != LDAP_SUCCESS)
# if ($ld->bind_s != LDAP_SUCCESS)
{
$ld->unbind;
die "bind: ", $ld->errstring, ": ", $ld->extramsg;
}
#
# This will set the size limit to $sizelimit from above. The command
# is a Netscape addition, but I've programmed replacement versions for
# other APIs.
$ld->set_option(LDAP_OPT_SIZELIMIT,$sizelimit);
# $ld->set_option(LDAP_OPT_DEREF,$deref);
# This routine is COMPLETELY unnecessary in this application, since
# the rebind procedure at the end of this program simply rebinds as
# a NULL user.
#$ld->set_rebind_proc(&rebindproc);
#
# Specify Search Filter and List of Attributes to Return
my $filter = $ARGV[0];
my @attrs = ("cn","mail","telephonenumber");
#
# Perform Search
my $msgid = $ld->search($BASEDN,LDAP_SCOPE_ONELEVEL,$filter,\@attrs,0);
if ($msgid < 0)
{
$ld->unbind;
die "search: ", $ld->errstring, ": ", $ld->extramsg;
}
# Reset Number of Entries Counter
my $nentries = 0;
# Set no timeout.
my $timeout = -1;
#
# Cycle Through Entries
while (($rc = $ld->result($msgid,0,$timeout)) == LDAP_RES_SEARCH_ENTRY)
{
$nentries++;
for ($ent = $ld->first_entry; $ent != 0; $ent = $ld->next_entry)
{
#
# Get Full DN
if (($dn = $ld->get_dn) eq "")
{
$ld->unbind;
die "get_dn: ", $ld->errstring, ": ", $ld->extramsg;
}
#
# Cycle Through Each Attribute
for ($attr = $ld->first_attribute; $attr ne ""; $attr = $ld->next_attribute)
{
#
# Notice that we're using get_values_len. This will retrieve binary
# as well as text data. You can change to get_values to only get text
# data.
#
@vals = $ld->get_values ($attr);
$record{$dn}->{$attr} = [@vals];
}
}
$ld->msgfree;
}
if ($rc == LDAP_RES_SEARCH_RESULT &&
$ld->err != LDAP_SUCCESS)
{
$ld->unbind;
die "result: ", $ld->errstring, ": ", $ld->extramsg;
}
print "Found $nentries records\n";
$ld->unbind;
foreach $dn (keys %record)
{
my $item;
print "dn: $dn\n";
foreach $attr (keys %{$record{$dn}})
{
for $item ( @{$record{$dn}{$attr}})
{
if ($attr =~ /binary/ )
{
print "$attr: <binary>\n";
} elsif ($attr eq "jpegphoto") {
#
# Notice how easy it is to take a binary attribute and dump it to a file
# or such. Gotta love PERL.
#
print "$attr: JpegPhoto (length: " . length($item). ")\n";
open (TEST,">$dn.jpg");
print TEST $item;
close (TEST);
} else {
print "$attr: $item\n";
}
}
}
}
exit;
sub rebindproc
{
return("","",LDAP_AUTH_SIMPLE);
}
Ugh, github issues suck
Added to repo, so could be used for a test script at some point as well.
FYI - Updated pasted code in your comment with Markdown's syntax highlighting format
Thanks... I checked the script in as well. ;)
So I'm having difficulty reproducing failures related to this. Slight modifications to the script as provided have been necessary to make the code even function:
while (($rc = $ld->result($msgid,0,$timeout)) == LDAP_RES_SEARCH_ENTRY)
The return from ldap_result() would be a status code, but the return from result() is the LDAPMessage from ldap_result() - the return code is stored in $ld->{"status"}
The following changes have allowed ldapwalk-dieter.pl to function on my system:
while(1) {
$rc = $ld->result($msgid,0,$timeout);
if ($ld->{"status"} == LDAP_RES_SEARCH_ENTRY) {
# <snip>
} else { last; }
}
Beyond this, ldapwalk-dieter.pl has been successfully run across 32k objects.
$ perl ldapwalk-dieter.pl objectClass=person | head -n 1
Found 32432 records
$ perl ldapwalk-dieter.pl sn=Liddell
Found 2 records
dn: cn=Ottilia Liddell,ou=Users,o=Test Data,c=nz
cn: Ottilia Liddell
dn: cn=Tash Liddell,ou=Users,o=Test Data,c=nz
cn: Tash Liddell
But this did turn up #3. :)
Ok. I'll contact deiter and see if it's still an issue for him.
I haven't seen a response from Dieter, going to move this to 3.1.x
As noted in the thread here: https://sourceforge.net/p/net-ldapapi/mailman/net-ldapapi-software/?viewmonth=200809&style=flat
we can end up with this error:
Sep 19 18:38:56 freelancer slapd[28153]: send_search_entry: conn 52963 ber write failed.