1#!/usr/bin/perl 2# Nearly complete clone of Umich ldapsearch program 3# 4# c.ridd@isode.com 5# 6# $Id: ldapsearch,v 1.2 2004/01/20 07:07:38 chrisridd Exp $ 7# 8# $Log: ldapsearch,v $ 9# Revision 1.2 2004/01/20 07:07:38 chrisridd 10# Fixes from Peter Marschall 11# 12# Revision 1.1 2003/06/09 12:29:42 gbarr 13# Depend in MakeMaker to fixup the #! line of installed scripts 14# 15# Revision 1.3 2000/08/03 17:10:26 gbarr 16# *** empty log message *** 17# 18# Revision 1.3 1999/01/11 08:33:34 cjr 19# Revised for 0.09 API 20# 21# Revision 1.2 1998/10/20 08:38:43 cjr 22# Add support for binary values (base64 encoding and the -B option) 23# 24# Revision 1.1 1998/10/19 15:14:15 cjr 25# Initial revision 26# 27 28use strict; 29use Carp; 30use Net::LDAP; 31use URI::ldap; 32use Net::LDAP::LDIF; 33use vars qw($opt_n $opt_v $opt_t $opt_u $opt_A $opt_B $opt_L $opt_R $opt_d 34 $opt_F $opt_S $opt_f $opt_b $opt_b $opt_s $opt_a $opt_l $opt_z 35 $opt_D $opt_w $opt_h $opt_p $opt_3); 36use Getopt::Std; 37 38# Enums 39my %scopes = ( 'base' => 0, 'one' => 1, 'sub' => '2' ); 40my %derefs = ( 'never' => 0, 'search' => 1, 'find' => 2, 'always' => 3 ); 41 42# We only print attributes that we know are text 43# This stuff is in lieu of a workable Schema module 44my @textsyntax = grep /^\w/, (<<'EOS' =~ /(#.*|\S+)/g); # qw() with comments 45 # RFC 2251 46 modifiersName modifyTimestamp 47 creatorsName createTimestamp 48 49 # RFC 2256 50 objectClass aliasedObjectName knowledgeInformation cn sn 51 serialNumber c l st street o ou title description 52 searchGuide businessCategory postalAddress postalCode 53 postOfficeBox physicalDeliveryOfficeName telephoneNumber 54 telexNumber teletexTerminalIdentifier 55 facsimileTelephoneNumber x121Address 56 internationaliSDNNumber registeredAddress 57 destinationIndicator preferredDeliveryMethod 58 presentationAddress supportedApplicationContext member 59 owner roleOccupant seeAlso userPassword name givenName 60 initials generationQualifier x500UniqueIdentifier 61 dnQualifier enhancedSearchGuide protocolInformation 62 distinguishedName uniqueMember houseIdentifier dmdName 63 64 # RFC 1274 65 mail rfc822Mailbox 66 67 # RFC 2079 68 labeledURI 69 70 # Definitions from other schemas goes here... 71 collectivePostalAddress collectiveTelephoneNumber 72 collectiveFacsimileTelephoneNumber 73 supportedLDAPVersion 74EOS 75 76my %istext; # keys are canonicalised attribute names. 77foreach (@textsyntax) { $istext{lc($_)} = 1; }; 78 79die "Usage: $0 [options] filter [attributes...]\ 80where:\ 81 filter RFC 2254 compliant LDAP search filter\ 82 attributes whitespace-separated list of attributes to retrieve\ 83 (if no attribute list is given, all are retrieved)\ 84options:\ 85 -n show what would be done but don\'t actually search\ 86 -v run in verbose mode (diagnostics to standard output)\ 87 -A retrieve attribute names only (no values)\ 88 -B do not suppress printing of non-ASCII values\ 89 -L print entries in LDIF format (-B is implied)\ 90 -R do not automatically follow referrals\ 91 -d level set LDAP debugging level to \'level\'\ 92 -F sep print `sep' instead of \'=\' between attribute names and values\ 93 -b basedn base dn for search\ 94 -s scope one of base, one, or sub (search scope)\ 95 -a deref one of never, always, search, or find (alias dereferencing)\ 96 -l time lim time limit (in seconds) for search\ 97 -z size lim size limit (in entries) for search\ 98 -D binddn bind dn\ 99 -w passwd bind passwd (for simple authentication)\ 100 -h host ldap server\ 101 -p port port on ldap server\ 102 -3 connect using LDAPv3, otherwise use LDAPv2\n" unless @ARGV; 103 104getopts('nvtuABLRd:F:S:f:b:s:a:l:z:D:w:h:p:3'); 105 106die "$0: arguments -t -u -S and -f are not supported yet" if ($opt_t || 107 $opt_u || 108 $opt_S || 109 $opt_f); 110# Default the host to a known good LDAP server 111$opt_h = 'nameflow.dante.net' unless $opt_h; 112$opt_F = '=' unless $opt_F; 113 114die "$0: unknown scope $opt_s\n" if $opt_s && !defined($scopes{$opt_s}); 115die "$0: unknown deref $opt_a\n" if $opt_a && !defined($derefs{$opt_a}); 116 117my $filter = shift || die "$0: missing filter\n"; 118 119# We are expecting to get back referrals from the search. Each referral may 120# lead to more referrals being returned, etc etc. 121# 122# So we handle this by looping through a list of referrals, taking the top 123# one each time, but possibly adding extra ones inside the loop. We prime the 124# list of referrals by making a 'referral' from the command line args. 125# 126# The loop body does the open, bind, search, unbind and close. 127# 128# The authentication offered to any particular server is not offered to any 129# other server, unless the referral indicates it should. This prevents you 130# revealing your password (etc) to random servers. 131 132my $initial = URI->new("ldap:"); 133$initial->host($opt_h); 134$initial->dn($opt_b); 135$initial->port($opt_p) if $opt_p; 136my %exts; 137$exts{bindname} = $opt_D if $opt_D; 138$exts{bindpassword} = $opt_w if $opt_w; 139$initial->extensions(%exts); 140 141my @urls = ($initial->as_string); 142 143my $ldif = Net::LDAP::LDIF->new('-', 'w') if $opt_L; 144my $first_record = 1; 145 146while (@urls) { 147 my $url = URI::ldap->new(shift @urls); 148 my %exts = $url->extensions; 149 my $ldap; 150 my %openargs; 151 my %bindargs; 152 my %searchargs; 153 154 $bindargs{dn} = $exts{bindname} if $exts{bindname}; 155 $bindargs{password} = $exts{bindpassword} if $exts{bindpassword}; 156 157 $openargs{port} = $url->port if $url->port; 158 $openargs{debug} = $opt_d if $opt_d; 159 160 dumpargs("new", $url->host, \%openargs) if ($opt_n || $opt_v); 161 162 unless ($opt_n) { 163 $ldap = new Net::LDAP($url->host, 164 %openargs) or die $@; 165 } 166 167# 168# Bind as the desired version, falling back if required to v2 169# 170 171 $bindargs{version} = $opt_3 ? 3 : 2; 172 173 if ($bindargs{version} == 3) { 174 dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v); 175 unless ($opt_n) { 176 $ldap->bind(%bindargs) or $bindargs{version} = 2; 177 } 178 } 179 180 if ($bindargs{version} == 2) { 181 dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v); 182 unless ($opt_n) { 183 $ldap->bind(%bindargs) or die $@; 184 } 185 } 186 187 # Set search arguments 188 $searchargs{base} = $opt_b if $opt_b; 189 $searchargs{base} = $url->dn if $url->dn; 190 $searchargs{scope} = $opt_s if $opt_s; 191 $searchargs{scope} = $url->_scope if $url->_scope; 192 $searchargs{deref} = $derefs{$opt_a} if $opt_a; 193 $searchargs{sizelimit} = $opt_z if $opt_z; 194 $searchargs{timelimit} = $opt_l if $opt_l; 195 $searchargs{attrsonly} = 1 if $opt_t; # typesOnly 196 $searchargs{filter} = $filter; 197 $searchargs{attrs} = [ @ARGV ]; 198 199 dumpargs("search", undef, \%searchargs) if ($opt_n || $opt_v); 200 201 # Print results 202 # Hm, this is harder work than the actual search! 203 unless ($opt_n) { 204 my $results = $ldap->search(%searchargs) or die $@; 205 206 my @entries = $results->entries; 207 if ($opt_L) { 208 $ldif->write(@entries); 209 } else { 210 my $entry; 211 foreach $entry (@entries) { 212 print "\n" unless $first_record; 213 $first_record = 0; 214 my ($attr, $val); 215 # Print in a pseudo EDB format 216 # Not a useful format, but it shows how to get to the 217 # attributes and values in an entry 218 print $entry->dn,"\n"; 219 foreach $attr ($entry->attributes) { 220 my $is_printable = $istext{lc($attr)}; 221 foreach $val ($entry->get($attr)) { 222 print "$attr$opt_F"; 223 if ($opt_B || $is_printable) { 224 print "$val\n"; 225 } else { 226 print "(binary value)\n"; 227 } 228 } # foreach value 229 } # foreach attribute 230 } # foreach entry 231 } # EDB format 232 233 # Check for any referrals 234 my @refs = $results->referrals; 235 if ($opt_v && @refs) { 236 map { print "Referral to: $_\n" } @refs; 237 } 238 push @urls, @refs unless $opt_R; 239 240 # Check for any search continuation references 241 my @conts = $results->references; 242 if ($opt_v && @conts) { 243 map { print "Continue at: $_\n" } @conts; 244 } 245 push @urls, @conts unless $opt_R; 246 } 247 248 if ($opt_n || $opt_v) { 249 print "unbind()\n"; 250 } 251 unless ($opt_n) { 252 $ldap->unbind() or die $@; 253 } 254} # foreach URL 255 256sub dumpargs { 257 my ($cmd,$s,$rh) = @_; 258 my @t; 259 push @t, "'$s'" if $s; 260 map { 261 my $value = $$rh{$_}; 262 if (ref($value) eq 'ARRAY') { 263 push @t, "$_ => [" . join(", ", @$value) . "]"; 264 } else { 265 push @t, "$_ => '$value'"; 266 } 267 } keys(%$rh); 268 print "$cmd(", join(", ", @t), ")\n"; 269} 270