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