1#!/usr/bin/perl
2
3use strict;
4use Net::LDAP;
5use vars qw($opt_n $opt_v $opt_b $opt_d $opt_D $opt_w $opt_h $opt_p $opt_3 $opt_x);
6use Getopt::Std;
7use Data::Dumper;
8
9print "Usage: $0 [options]
10options:\
11    -v          run in verbose mode\
12    -h host     ldap server\
13    -x          dump schema content or whatever..
14
15    unused/untested:
16    -n          show what would be done but don\'t actually do\
17    -b basedn   search here
18    -d level    set LDAP debugging level to \'level\'\
19    -D binddn   bind dn\
20    -w passwd   bind passwd (for simple authentication)\
21    -p port     port on ldap server\
22    -3          connect using LDAPv3, otherwise use LDAPv2\n" unless @ARGV;
23
24getopts('nvxb:d:D:w:h:p:3');
25
26$opt_h = 'gold' unless $opt_h;
27
28my %newargs;
29
30$newargs{port} = $opt_p if $opt_p;
31$newargs{debug} = $opt_d if $opt_d;
32
33dumpargs("new", $opt_h, \%newargs) if ($opt_n || $opt_v);
34my $ldap;
35
36unless ($opt_n) {
37    $ldap = Net::LDAP->new($opt_h, %newargs) or die $@;
38}
39
40#
41# Bind as the desired version, falling back if required to v2
42#
43my %bindargs;
44$bindargs{dn} = $opt_D if $opt_D;
45$bindargs{password} = $opt_w if $opt_w;
46$bindargs{version} = $opt_3 ? 3 : 2;
47
48#login
49if ($bindargs{version} == 3) {
50    dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v);
51    unless ($opt_n) {
52	$ldap->bind(%bindargs) or $bindargs{version} = 2;
53    }
54}
55
56if ($bindargs{version} == 2) {
57    dumpargs("bind", undef, \%bindargs) if ($opt_n || $opt_v);
58    unless ($opt_n) {
59	$ldap->bind(%bindargs) or die $@;
60    }
61}
62
63die ("not connected: $!") unless $ldap->{net_ldap_socket};
64
65# do
66# my $mesg = $ldap->search(
67#                 base   => $opt_b,
68#                 scope  => 'sub',
69#                 filter => 'objectclass=*'
70#                 );
71# print Dumper $mesg;
72
73print "============ ROOT DSE DUMP ==============\n"  if ($opt_n || $opt_v);
74my $root = $ldap->root_dse;
75# get naming Context
76if ($root) {
77        print Dumper $root if ($opt_v);
78        $root->get_value( 'namingContext', asref => 1 );
79        my $nc = $root->{attrs}->{namingcontexts};
80        foreach (@$nc) {
81                print "============ DUMP: $_ ==============\n";
82                if ($opt_x) {
83                        system "ldapsearch -s sub -x -h $opt_h -b '$_' \n";
84                } else {
85                        print "ldapsearch -s sub -x -h $opt_h -b '$_' \n";
86                }
87        }
88        # get supported LDAP versions
89        #print $root->supported_version;
90}
91
92print "============ SCHEMA ATTS DUMP ==============\n" if ($opt_n || $opt_v);
93unless ($opt_n) {
94        my $schema = $ldap->schema or die "no schema: $!";
95        print Dumper $schema if $opt_v;
96        # get objectClasses
97        my @ocs = $schema->all_objectclasses;
98        print Dumper @ocs if $opt_v;
99        print "====== objectclasses: $#ocs \n" if ($opt_v);
100        # Get the attributes
101        my @atts = $schema->all_attributes;
102        print Dumper @atts if $opt_v;
103        print "====== attributes: $#atts \n"  if ($opt_v);
104        #foreach (@atts) { print "$_\n"; }
105}
106
107
108# logout
109if ($opt_n || $opt_v) {
110    print "unbind()\n";
111}
112unless ($opt_n) {
113    $ldap->unbind() or die $@;
114}
115
116sub dumpargs {
117    my ($cmd,$s,$rh) = @_;
118    my @t;
119    push @t, "'$s'" if $s;
120    map {
121	my $value = $$rh{$_};
122	if (ref($value) eq 'ARRAY') {
123	    push @t, "$_ => [" . join(", ", @$value) . "]";
124	} else {
125	    push @t, "$_ => '$value'";
126	}
127    } keys(%$rh);
128    print "$cmd(", join(", ", @t), ")\n";
129}
130