use strict;
use Carp;
use Net::LDAP;
use URI::ldap;
use Net::LDAP::LDIF;
use vars qw($opt_n $opt_v $opt_t $opt_u $opt_A $opt_B $opt_L $opt_R $opt_d
$opt_F $opt_S $opt_f $opt_b $opt_b $opt_s $opt_a $opt_l $opt_z
$opt_D $opt_w $opt_h $opt_p $opt_3);
use Getopt::Std;
my %scopes = ( 'base' => 0, 'one' => 1, 'sub' => '2' );
my %derefs = ( 'never' => 0, 'search' => 1, 'find' => 2, 'always' => 3 );
my @textsyntax = grep /^\w/, (<<'EOS' =~ /( modifiersName modifyTimestamp
creatorsName createTimestamp
objectClass aliasedObjectName knowledgeInformation cn sn
serialNumber c l st street o ou title description
searchGuide businessCategory postalAddress postalCode
postOfficeBox physicalDeliveryOfficeName telephoneNumber
telexNumber teletexTerminalIdentifier
facsimileTelephoneNumber x121Address
internationaliSDNNumber registeredAddress
destinationIndicator preferredDeliveryMethod
presentationAddress supportedApplicationContext member
owner roleOccupant seeAlso userPassword name givenName
initials generationQualifier x500UniqueIdentifier
dnQualifier enhancedSearchGuide protocolInformation
distinguishedName uniqueMember houseIdentifier dmdName
mail rfc822Mailbox
labeledURI
collectivePostalAddress collectiveTelephoneNumber
collectiveFacsimileTelephoneNumber
supportedLDAPVersion
EOS
my %istext; foreach (@textsyntax) { $istext{lc($_)} = 1; };
die "Usage: $0 [options] filter [attributes...]\
where:\
filter RFC 2254 compliant LDAP search filter\
attributes whitespace-separated list of attributes to retrieve\
(if no attribute list is given, all are retrieved)\
options:\
-n show what would be done but don\'t actually search\
-v run in verbose mode (diagnostics to standard output)\
-A retrieve attribute names only (no values)\
-B do not suppress printing of non-ASCII values\
-L print entries in LDIF format (-B is implied)\
-R do not automatically follow referrals\
-d level set LDAP debugging level to \'level\'\
-F sep print `sep' instead of \'=\' between attribute names and values\
-b basedn base dn for search\
-s scope one of base, one, or sub (search scope)\
-a deref one of never, always, search, or find (alias dereferencing)\
-l time lim time limit (in seconds) for search\
-z size lim size limit (in entries) for search\
-D binddn bind dn\
-w passwd bind passwd (for simple authentication)\
-h host ldap server\
-p port port on ldap server\
-3 connect using LDAPv3, otherwise use LDAPv2\n" unless @ARGV;
getopts('nvtuABLRd:F:S:f:b:s:a:l:z:D:w:h:p:3');
die "$0: arguments -t -u -S and -f are not supported yet" if ($opt_t ||
$opt_u ||
$opt_S ||
$opt_f);
$opt_h = 'nameflow.dante.net' unless $opt_h;
$opt_F = '=' unless $opt_F;
die "$0: unknown scope $opt_s\n" if $opt_s && !defined($scopes{$opt_s});
die "$0: unknown deref $opt_a\n" if $opt_a && !defined($derefs{$opt_a});
my $filter = shift || die "$0: missing filter\n";
my $initial = URI->new("ldap:");
$initial->host($opt_h);
$initial->dn($opt_b);
$initial->port($opt_p) if $opt_p;
my %exts;
$exts{bindname} = $opt_D if $opt_D;
$exts{bindpassword} = $opt_w if $opt_w;
$initial->extensions(%exts);
my @urls = ($initial->as_string);
my $ldif = Net::LDAP::LDIF->new('-', 'w') if $opt_L;
my $first_record = 1;
while (@urls) {
my $url = URI::ldap->new(shift @urls);
my %exts = $url->extensions;
my $ldap;
my %openargs;
my %bindargs;
my %searchargs;
$bindargs{dn} = $exts{bindname} if $exts{bindname};
$bindargs{password} = $exts{bindpassword} if $exts{bindpassword};
$openargs{port} = $url->port if $url->port;
$openargs{debug} = $opt_d if $opt_d;
dumpargs("new", $url->host, \%openargs) if ($opt_n || $opt_v);
unless ($opt_n) {
$ldap = new Net::LDAP($url->host,
%openargs) or die $@;
}
$bindargs{version} = $opt_3 ? 3 : 2;
if ($bindargs{version} == 3) {
dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v);
unless ($opt_n) {
$ldap->bind(%bindargs) or $bindargs{version} = 2;
}
}
if ($bindargs{version} == 2) {
dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v);
unless ($opt_n) {
$ldap->bind(%bindargs) or die $@;
}
}
$searchargs{base} = $opt_b if $opt_b;
$searchargs{base} = $url->dn if $url->dn;
$searchargs{scope} = $opt_s if $opt_s;
$searchargs{scope} = $url->_scope if $url->_scope;
$searchargs{deref} = $derefs{$opt_a} if $opt_a;
$searchargs{sizelimit} = $opt_z if $opt_z;
$searchargs{timelimit} = $opt_l if $opt_l;
$searchargs{attrsonly} = 1 if $opt_t; $searchargs{filter} = $filter;
$searchargs{attrs} = [ @ARGV ];
dumpargs("search", undef, \%searchargs) if ($opt_n || $opt_v);
unless ($opt_n) {
my $results = $ldap->search(%searchargs) or die $@;
my @entries = $results->entries;
if ($opt_L) {
$ldif->write(@entries);
} else {
my $entry;
foreach $entry (@entries) {
print "\n" unless $first_record;
$first_record = 0;
my ($attr, $val);
print $entry->dn,"\n";
foreach $attr ($entry->attributes) {
my $is_printable = $istext{lc($attr)};
foreach $val ($entry->get($attr)) {
print "$attr$opt_F";
if ($opt_B || $is_printable) {
print "$val\n";
} else {
print "(binary value)\n";
}
} } } }
my @refs = $results->referrals;
if ($opt_v && @refs) {
map { print "Referral to: $_\n" } @refs;
}
push @urls, @refs unless $opt_R;
my @conts = $results->references;
if ($opt_v && @conts) {
map { print "Continue at: $_\n" } @conts;
}
push @urls, @conts unless $opt_R;
}
if ($opt_n || $opt_v) {
print "unbind()\n";
}
unless ($opt_n) {
$ldap->unbind() or die $@;
}
}
sub dumpargs {
my ($cmd,$s,$rh) = @_;
my @t;
push @t, "'$s'" if $s;
map {
my $value = $$rh{$_};
if (ref($value) eq 'ARRAY') {
push @t, "$_ => [" . join(", ", @$value) . "]";
} else {
push @t, "$_ => '$value'";
}
} keys(%$rh);
print "$cmd(", join(", ", @t), ")\n";
}