~ubuntu-branches/ubuntu/vivid/shelldap/vivid-proposed
» Revision
11
: .pc/fix-POD-error.patch/shelldap
« back to all changes in this revision
Viewing changes to .pc/fix-POD-error.patch/shelldap
- browse files at revision 11
- compare with another revision
- download diff
- download tarball
- view history from revision 11
- Committer: Package Import Robot
- Author(s): Salvatore Bonaccorso
- Date: 2014-08-12 08:57:05 UTC
- mfrom: (1.2.3)
- Revision ID: package-import@ubuntu.com-20140812085705-8p1fgmfedw4x3y77
Tags: 1.2.0-1
* Imported Upstream version 1.2.0
* Drop fix-POD-error.patch patch
* Update Vcs-Browser URL to cgit web frontend
* Drop fix-POD-error.patch patch
* Update Vcs-Browser URL to cgit web frontend
- files removed:
- .pc/fix-POD-error.patch
- debian/patches
- files modified:
- .pc/applied-patches
added
removed
.pc/fix-POD-error.patch/shelldap
1
#!/usr/bin/env perl
2
# vim: set nosta noet ts=4 sw=4:
3
#
4
# Copyright (c) 2006-2013, Mahlon E. Smith <mahlon@martini.nu>
5
# All rights reserved.
6
# Redistribution and use in source and binary forms, with or without
7
# modification, are permitted provided that the following conditions are met:
8
#
9
# * Redistributions of source code must retain the above copyright
10
# notice, this list of conditions and the following disclaimer.
11
#
12
# * Redistributions in binary form must reproduce the above copyright
13
# notice, this list of conditions and the following disclaimer in the
14
# documentation and/or other materials provided with the distribution.
15
#
16
# * Neither the name of Mahlon E. Smith nor the names of his
17
# contributors may be used to endorse or promote products derived
18
# from this software without specific prior written permission.
19
#
20
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY
21
# EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
22
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
23
# DISCLAIMED. IN NO EVENT SHALL THE REGENTS AND CONTRIBUTORS BE LIABLE FOR ANY
24
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
25
# (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
26
# LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
27
# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
28
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
29
# SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30
31
=head1 NAME
32
33
Shelldap - A program for interacting with an LDAP server via a shell-like interface
34
35
=head1 DESCRIPTION
36
37
Shelldap /LDAP::Shell is a program for interacting with an LDAP server via a shell-like
38
interface.
39
40
This is not meant to be an exhaustive LDAP editing and browsing
41
interface, but rather an intuitive shell for performing basic LDAP
42
tasks quickly and with minimal effort.
43
44
=head1 SYNPOSIS
45
46
shelldap --server example.net [--help]
47
48
=head1 FEATURES
49
50
- Upon successful authenticated binding, credential information is
51
auto-cached to ~/.shelldap.rc -- future loads require no command line
52
flags.
53
54
- Custom 'description maps' for entry listings. (See the 'list' command.)
55
56
- History and autocomplete via readline, if installed.
57
58
- Automatic reconnection attempts if the connection is lost with the
59
LDAP server.
60
61
- Basic schema introspection for quick reference.
62
63
- It feels like a semi-crippled shell, making LDAP browsing and editing
64
at least halfway pleasurable.
65
66
=head1 OPTIONS
67
68
All command line options follow getopts long conventions.
69
70
shelldap --server example.net --basedn dc=your,o=company
71
72
You may also optionally create a ~/.shelldap.rc file with command line
73
defaults. This file should be valid YAML. (This file is generated
74
automatically on a successful bind auth.)
75
76
Example:
77
78
server: ldap.example.net
79
binddn: cn=Manager,dc=your,o=company
80
bindpass: xxxxxxxxx
81
basedn: dc=your,o=company
82
tls: yes
83
tls_cacert: /etc/ssl/certs/cacert.pem
84
tls_cert: ~/.ssl/client.cert.pem
85
tls_key: ~/.ssl/private/client.key.pem
86
87
=over 4
88
89
=item B<configfile>
90
91
Optional. Use an alternate configuration file, instead of the
92
default ~/.shelldap.rc.
93
94
--configfile /tmp/alternate-config.yml
95
-f /tmp/alternate-config.yml
96
97
This config file overrides values found in the default config, so
98
you can easily have separate config files for connecting to your
99
cn=monitor or cn=log overlays (for example.)
100
101
=back
102
103
=over 4
104
105
=item B<server>
106
107
Required. The LDAP server to connect to. This can be a hostname, IP
108
address, or a URI.
109
110
--server ldaps://ldap.example.net
111
-H ldaps://ldap.example.net
112
113
=back
114
115
=over 4
116
117
=item B<binddn>
118
119
The full dn of a user to authenticate as. If not specified, defaults to
120
an anonymous bind. You will be prompted for a password.
121
122
--binddn cn=Manager,dc=your,o=company
123
-D cn=Manager,dc=your,o=company
124
125
=back
126
127
=over 4
128
129
=item B<basedn>
130
131
The directory 'root' of your LDAP server. If omitted, shelldap will
132
try and ask the server for a sane default.
133
134
--basedn dc=your,o=company
135
-b dc=your,o=company
136
137
=back
138
139
=over 4
140
141
=item B<promptpass>
142
143
Force password prompting. Useful to temporarily override cached
144
credentials.
145
146
=back
147
148
=item B<sasl>
149
150
A space separated list of SASL mechanisms. Requires the Authen::SASL
151
module.
152
153
--sasl "PLAIN CRAM-MD5 GSSAPI"
154
155
=back
156
157
=over 4
158
159
=item B<tls>
160
161
Enables TLS over what would normally be an insecure connection.
162
Requires server side support.
163
164
=item B<tls_cacert>
165
166
Specify CA Certificate to trust.
167
168
--tls_cacert /etc/ssl/certs/cacert.pem
169
170
=item B<tls_cert>
171
172
The TLS client certificate.
173
174
--tls_cert ~/.ssl/client.cert.pem
175
176
=item B<tls_key>
177
178
The TLS client key. Not specifying a key will connect via TLS without
179
key verification.
180
181
--tls_key ~/.ssl/private/client.key.pem
182
183
=back
184
185
=over 4
186
187
=item B<cacheage>
188
189
Set the time to cache directory lookups in seconds.
190
191
By default, directory lookups are cached for 300 seconds, to speed
192
autocomplete up when changing between different basedns.
193
194
Modifications to the directory automatically reset the cache. Directory
195
listings are not cached. (This is just used for autocomplete.) Set it
196
to 0 to disable caching completely.
197
198
=back
199
200
=over 4
201
202
=item B<timeout>
203
204
Set the maximum time an LDAP operation can take before it is cancelled.
205
206
=back
207
208
=over 4
209
210
=item B<debug>
211
212
Print extra operational info out, and backtrace on fatal error.
213
214
=back
215
216
=over 4
217
218
=item B<version>
219
220
Display the version number.
221
222
=back
223
224
=head1 SHELL COMMANDS
225
226
=over 4
227
228
=item B< cat>
229
230
Display an LDIF dump of an entry. Globbing is supported. Specify
231
either the full dn, or an rdn. For most commands, rdns are local to the
232
current search base. ('cwd', as translated to shell speak.) You may additionally
233
add a list of attributes to display. Use '+' for server side attributes.
234
235
cat uid=mahlon
236
cat ou=*
237
cat uid=mahlon,ou=People,dc=example,o=company
238
cat uid=mahlon + userPassword
239
240
=item B< cd>
241
242
Change directory. Translated to LDAP, this changes the current basedn.
243
All commands after a 'cd' operate within the new basedn.
244
245
cd change to 'home' basedn
246
cd ~ change to the binddn, or basedn if anonymously bound
247
cd - change to previous node
248
cd ou=People change to explicit path below current node
249
cd .. change to parent node
250
cd ../../ou=Groups change to node ou=Groups, which is a sibling
251
to the current node's grandparent
252
253
Since LDAP doesn't actually limit what can be a container object, you
254
can actually cd into any entry. Many commands then work on '.', meaning
255
"wherever I currently am."
256
257
cd uid=mahlon
258
cat .
259
260
=item B<clear>
261
262
Clear the screen.
263
264
=item B<copy>
265
266
Copy an entry to a different dn path. All copies are relative to the
267
current basedn, unless a full dn is specified. All attributes are
268
copied, then an LDAP moddn() is performed.
269
270
copy uid=mahlon uid=bob
271
copy uid=mahlon ou=Others,dc=example,o=company
272
copy uid=mahlon,ou=People,dc=example,o=company uid=mahlon,ou=Others,dc=example,o=company
273
274
aliased to: cp
275
276
=item B<create>
277
278
Create an entry from scratch. Arguments are space separated objectClass
279
names. Possible objectClasses are derived automatically from the
280
server, and will tab-complete.
281
282
After the classes are specified, an editor will launch. Required
283
attributes are listed first, then optional attributes. Optionals are
284
commented out. After the editor exits, the resulting LDIF is validated
285
and added to the LDAP directory.
286
287
create top person organizationalPerson inetOrgPerson posixAccount
288
289
aliased to: touch
290
291
=item B<delete>
292
293
Remove an entry from the directory. Globbing is supported.
294
All deletes are sanity-prompted.
295
296
delete uid=mahlon
297
delete uid=ma*
298
299
aliased to: rm
300
301
=item B<edit>
302
303
Edit an entry in an external editor. After the editor exits, the
304
resulting LDIF is sanity checked, and changes are written to the LDAP
305
directory.
306
307
edit uid=mahlon
308
309
aliased to: vi
310
311
=item B<env>
312
313
Show values for various runtime variables.
314
315
=item B<grep>
316
317
Search for arbitrary LDAP filters, and return matching dn results.
318
The search string must be a valid LDAP filter.
319
320
grep uid=mahlon
321
grep uid=mahlon ou=People
322
grep -r (&(uid=mahlon)(objectClass=*))
323
324
aliased to: search
325
326
=item B<inspect>
327
328
View schema information about a given entry, or a list of arbitrary
329
objectClasses, along with the most common flags for the objectClass
330
attributes.
331
332
inspect uid=mahlon
333
inspect posixAccount organizationalUnit
334
inspect _schema
335
336
The output is a list of found objectClasses, their schema heirarchy
337
(up to 'top'), whether or not they are a structural class, and then
338
a merged list of all valid attributes for the given objectClasses.
339
Attributes are marked as either required or optional, and whether
340
they allow multiple values or not.
341
342
If you ask for the special "_schema" object, the raw server schema
343
is dumped to screen.
344
345
=item B<list>
346
347
List entries for the current basedn. Globbing is supported.
348
349
aliased to: ls
350
351
ls -l
352
ls -lR uid=mahlon
353
list uid=m*
354
355
In 'long' mode, descriptions are listed as well, if they exist.
356
There are some default 'long listing' mappings for common objectClass
357
types. You can additionally specify your own mappings in your
358
.shelldap.rc, like so:
359
360
...
361
descmaps:
362
objectClass: attributename
363
posixAccount: gecos
364
posixGroup: gidNumber
365
ipHost: ipHostNumber
366
367
=item B<mkdir>
368
369
Creates a new 'organizationalUnit' entry.
370
371
mkdir containername
372
mkdir ou=whatever
373
374
=item B<move>
375
376
Move an entry to a different dn path. Usage is identical to B<copy>.
377
378
aliased to: mv
379
380
=item B<passwd>
381
382
If supported server side, change the password for a specified entry.
383
The entry must have a 'userPassword' attribute.
384
385
passwd uid=mahlon
386
387
=item B< pwd>
388
389
Print the 'working directory' - aka, the current ldap basedn.
390
391
=item B<setenv>
392
393
Modify various runtime variables normally set from the command line.
394
395
setenv debug 1
396
export debug=1
397
398
=item B<whoami>
399
400
Show current auth credentials. Unless you specified a binddn, this
401
will just show an anonymous bind.
402
403
=back
404
405
=head1 TODO
406
407
Referral support. Currently, if you try to write to a replicant slave,
408
you'll just get a referral. It would be nice if shelldap automatically
409
tried to follow it.
410
411
For now, it only makes sense to connect to a master if you plan on doing
412
any writes.
413
414
=head1 BUGS / LIMITATIONS
415
416
There is no support for editing binary data. If you need to edit base64
417
stuff, just feed it to the regular ldapmodify/ldapadd/etc tools.
418
419
=head1 AUTHOR
420
421
Mahlon E. Smith <mahlon@martini.nu>
422
423
=cut
424
425
package LDAP::Shell;
426
use strict;
427
use warnings;
428
use Term::ReadKey;
429
use Term::Shell;
430
use Digest::MD5;
431
use Net::LDAP qw/
432
LDAP_SUCCESS
433
LDAP_SERVER_DOWN
434
LDAP_OPERATIONS_ERROR
435
LDAP_TIMELIMIT_EXCEEDED
436
LDAP_BUSY
437
LDAP_UNAVAILABLE
438
LDAP_OTHER
439
LDAP_TIMEOUT
440
LDAP_NO_MEMORY
441
LDAP_CONNECT_ERROR /;
442
use Net::LDAP::Util qw/ canonical_dn ldap_explode_dn /;
443
use Net::LDAP::LDIF;
444
use Data::Dumper;
445
use File::Temp;
446
use Algorithm::Diff;
447
use Carp 'confess';
448
use base 'Term::Shell';
449
require Net::LDAP::Extension::SetPassword;
450
451
my $conf = $main::conf;
452
453
# make 'die' backtrace in debug mode
454
$SIG{'__DIE__'} = \&Carp::confess if $conf->{'debug'};
455
456
457
########################################################################
458
### U T I L I T Y F U N C T I O N S
459
########################################################################
460
461
### Initial shell behaviors.
462
###
463
sub init
464
{
465
my $self = shift;
466
$self->{'API'}->{'match_uniq'} = 0;
467
468
$self->{'editor'} = $conf->{'editor'} || $ENV{'EDITOR'} || 'vi';
469
$self->{'env'} = [ qw/ debug cacheage timeout / ];
470
471
# let autocomplete work with the '=' character
472
my $term = $self->term();
473
$term->Attribs->{'basic_word_break_characters'} =~ s/=//m;
474
$term->Attribs->{'completer_word_break_characters'} =~ s/=//m;
475
476
# read in history
477
eval {
478
$term->history_truncate_file("$ENV{'HOME'}/.shelldap_history", 50);
479
$term->ReadHistory("$ENV{'HOME'}/.shelldap_history");
480
};
481
482
# gather metadata from the LDAP server
483
$self->{'root_dse'} = $self->ldap->root_dse() or
484
die "Unable to retrieve LDAP server information. (Doublecheck connection arguments.)\n";
485
$self->{'schema'} = $self->ldap->schema();
486
487
# get an initial list of all objectClasses
488
$self->{'objectclasses'} = [];
489
foreach my $o ( $self->{'schema'}->all_objectclasses() ) {
490
push @{ $self->{'objectclasses'} }, $o->{'name'};
491
}
492
493
if ( $conf->{'debug'} ) {
494
my @versions = $self->{'root_dse'}->get_value('supportedLDAPVersion');
495
print "Connected to $conf->{'server'}\n";
496
print "Supported LDAP version: ", ( join ', ', @versions ), "\n";
497
print "Cipher in use: ", $self->ldap()->cipher(), "\n";
498
}
499
500
# try an initial search and bail early if it doesn't work. (bad baseDN?)
501
my $s = $self->search();
502
die "LDAP baseDN error: ", $s->{'message'}, "\n" if $s->{'code'};
503
504
# okay, now do an initial population of 'cwd' for autocomplete.
505
$self->update_entries();
506
507
# whew, okay. Update prompt, wait for input!
508
$self->update_prompt();
509
510
return;
511
}
512
513
514
### Return an LDAP connection handle, creating it if necessary.
515
###
516
sub ldap
517
{
518
my $self = shift;
519
my $rv;
520
521
# use cached connection object if it exists
522
return $self->{'ldap'} if $self->{'ldap'};
523
524
# fill in potentially missing info
525
die "No server specified.\n" unless $conf->{'server'};
526
527
# Emit a nicer error message if IO::Socket::SSL is
528
# not installed and Net::LDAP decides it is required.
529
#
530
if ( $conf->{'tls'} || $conf->{'server'} =~ m|ldaps://| ) {
531
eval 'use IO::Socket::SSL';
532
die qq{IO::Socket::SSL not installed, but is required for SSL or TLS connections.
533
You may try connecting insecurely, or install the module and try again.\n} if $@;
534
}
535
536
# Prompt for a password after disabling local echo.
537
#
538
if ( ($conf->{'binddn'} && ! $conf->{'bindpass'}) || $conf->{'promptpass'} ) {
539
print "Bind password: ";
540
Term::ReadKey::ReadMode 2;
541
chomp( $conf->{'bindpass'} = <STDIN> );
542
Term::ReadKey::ReadMode 0;
543
print "\n";
544
}
545
546
# make the connection
547
my $ldap = Net::LDAP->new( $conf->{'server'} )
548
or die "Unable to connect to LDAP server '$conf->{'server'}': $!\n";
549
550
# secure connection options
551
#
552
if ( $conf->{'tls'} ) {
553
if ( $conf->{'tls_key'} ) {
554
$ldap->start_tls(
555
verify => 'require',
556
cafile => $conf->{'tls_cacert'},
557
clientcert => $conf->{'tls_cert'},
558
clientkey => $conf->{'tls_key'},
559
keydecrypt => sub {
560
print "Key Passphrase: ";
561
Term::ReadKey::ReadMode 2;
562
chomp( my $secret = <STDIN> );
563
Term::ReadKey::ReadMode 0;
564
print "\n";
565
return $secret;
566
});
567
}
568
else {
569
$ldap->start_tls( verify => 'none' );
570
}
571
}
572
573
eval 'use Authen::SASL';
574
my ( $sasl, $sasl_conn );
575
my $has_sasl = ! defined( $@ );
576
577
if ( $has_sasl && $conf->{'sasl'} ) {
578
my $serv = $conf->{'server'};
579
$serv =~ s!^ldap[si]?://!!;
580
$sasl = Authen::SASL->new( mechanism => $conf->{'sasl'} );
581
$sasl_conn = $sasl->client_new('ldap', $serv);
582
}
583
584
# bind with sasl
585
#
586
if ( $has_sasl && $sasl_conn ) {
587
$rv = $ldap->bind(
588
$conf->{'binddn'},
589
password => $conf->{'bindpass'},
590
sasl => $sasl_conn
591
);
592
}
593
594
# simple bind as an authenticated dn
595
#
596
elsif ( $conf->{'binddn'} ) {
597
$rv = $ldap->bind(
598
$conf->{'binddn'},
599
password => $conf->{'bindpass'}
600
);
601
}
602
603
# bind anonymously
604
#
605
else {
606
$rv = $ldap->bind(sasl => $sasl_conn);
607
}
608
609
my $err = $rv->error();
610
$self->debug(
611
"Bind as " .
612
( $conf->{'binddn'} ? $conf->{'binddn'} : 'anonymous' ) .
613
" to " . $conf->{'server'} . ": $err\n"
614
);
615
616
if ( $rv->code() ) {
617
$err .= " (try the --tls flag?)" if $err =~ /confidentiality required/i;
618
$err .= "\n" . $sasl->error() if $sasl;
619
die "LDAP bind error: $err\n";
620
}
621
622
# Offer to cache authentication info.
623
# If we enter this conditional, we have successfully authed with the server
624
# (non anonymous), and we haven't cached anything in the past.
625
#
626
if ( $conf->{'binddn'} && ! -e $conf->{'configfile'} ) {
627
print "Would you like to cache your connection information? [Yn]: ";
628
chomp( my $response = <STDIN> );
629
unless ( $response =~ /^n/i ) {
630
YAML::Syck::DumpFile( $conf->{'configfile'}, $conf );
631
chmod 0600, $conf->{'configfile'};
632
print "Connection info cached to $conf->{'configfile'}.\n";
633
}
634
}
635
636
$self->{'ldap'} = $ldap;
637
return $ldap;
638
}
639
640
641
### Return a new LDIF object, suitable for populating with
642
### a Net::LDAP::Entry.
643
###
644
sub ldif
645
{
646
my $self = shift;
647
my $use_temp = shift;
648
649
# create tmpfile and link ldif object with it
650
#
651
if ( $use_temp ) {
652
my ( undef, $fname ) =
653
File::Temp::tempfile( 'shelldap_XXXXXXXX', SUFFIX => '.ldif', DIR => '/tmp', UNLINK => 1 );
654
$self->{'ldif'} = Net::LDAP::LDIF->new( $fname, 'w', sort => 1, wrap => $self->wrapsize );
655
$self->{'ldif_fname'} = $fname;
656
}
657
658
# ldif -> stdout
659
else {
660
$self->{'ldif'} = Net::LDAP::LDIF->new( \*STDOUT, 'w', sort => 1, wrap => $self->wrapsize );
661
}
662
663
return $self->{'ldif'};
664
}
665
666
667
### Return an Entry object from an LDIF filename, or undef if there was an error.
668
###
669
sub load_ldif
670
{
671
my $self = shift;
672
my $ldif = Net::LDAP::LDIF->new( shift(), 'r' );
673
674
return unless $ldif;
675
676
my $e;
677
eval { $e = $ldif->read_entry(); };
678
679
return if $@;
680
return $e;
681
}
682
683
684
### Given a filename, return an md5 checksum.
685
###
686
sub chksum
687
{
688
my $self = shift;
689
my $file = shift or return;
690
691
my $md5 = Digest::MD5->new();
692
open F, $file or die "Unable to read file: $!\n";
693
my $hash = $md5->addfile( *F )->hexdigest();
694
close F;
695
696
return $hash;
697
}
698
699
700
### Find and return the current terminal width.
701
###
702
sub wrapsize
703
{
704
my $self = shift;
705
706
my $wrap = $conf->{'wrap'};
707
eval {
708
my $rows;
709
my $term = Term::ReadLine->new( 1 );
710
( $rows, $wrap ) = $term->get_screen_size() unless $wrap;
711
};
712
713
$wrap ||= 78;
714
return $wrap;
715
}
716
717
718
### Used by Term::Shell to generate the prompt.
719
###
720
sub prompt_str
721
{
722
my $self = shift;
723
return $self->{'prompt'};
724
}
725
726
727
### Display the current working entry as the prompt,
728
### truncating if necessary.
729
###
730
sub update_prompt
731
{
732
my $self = shift;
733
my $base = $self->base();
734
735
if ( length $base > 50 ) {
736
my $cwd_dn = $1 if $base =~ /^(.*?),/;
737
$self->{'prompt'} = "... $cwd_dn > ";
738
}
739
else {
740
my $prompt = $base;
741
$prompt =~ s/$conf->{'basedn'}/~/;
742
$self->{'prompt'} = "$prompt > ";
743
}
744
return;
745
}
746
747
748
### Prompt the user to re-edit their LDIF on error.
749
### Returns true if the user wants to do so.
750
###
751
sub prompt_edit_again
752
{
753
my $self = shift;
754
print "Edit again? [Yn]: ";
755
chomp( my $ans = <STDIN> );
756
return $ans !~ /^n/i;
757
}
758
759
760
### Return the basedn of the LDAP connection, being either explicitly
761
### configured or determined automatically from server metadata.
762
###
763
sub base
764
{
765
my $self = shift;
766
$self->{'base'} ||= $conf->{'basedn'};
767
768
# try and determine base automatically from rootDSE
769
#
770
unless ( $self->{'base'} ) {
771
my @namingContexts = $self->{'root_dse'}->get_value('namingContexts');
772
$conf->{'basedn'} = $namingContexts[0];
773
$self->{'base'} = $namingContexts[0];
774
}
775
if ( $_[0] ) {
776
my $base = canonical_dn( $_[0], casefold => 'none' );
777
$self->{'base'} = $base if $base;
778
}
779
return $self->{'base'};
780
}
781
782
783
### Returns true if the specified dn is valid on this LDAP server.
784
###
785
sub is_valid_dn
786
{
787
my $self = shift;
788
my $dn = shift or return 0;
789
790
my $r = $self->search({ base => $dn });
791
return $r->{'code'} == LDAP_SUCCESS ? 1 : 0;
792
}
793
794
795
### Perform an LDAP search.
796
###
797
### Returns a hashref containing the return code and
798
### an arrayref of Net::LDAP::Entry objects.
799
###
800
sub search
801
{
802
my $self = shift;
803
my $opts = shift || {};
804
805
$opts->{'base'} ||= $self->base(),
806
$opts->{'filter'} ||= '(objectClass=*)';
807
$opts->{'scope'} ||= 'base';
808
809
my $search = sub {
810
return $self->ldap->search(
811
base => $opts->{'base'},
812
filter => $opts->{'filter'},
813
scope => $opts->{'scope'},
814
timelimit => $conf->{'timeout'},
815
typesonly => ! $opts->{'vals'},
816
attrs => $opts->{'attrs'} || ['*']
817
);
818
};
819
820
my $s = $self->with_retry( $search );
821
my $rv = {
822
code => $s->code(),
823
message => $s->error(),
824
entries => []
825
};
826
827
$rv->{'entries'} =
828
$opts->{'scope'} eq 'base' ? [ $s->shift_entry() ] : [ $s->entries() ];
829
830
return $rv;
831
}
832
833
834
### Maintain the cache of possible autocomplete values for
835
### the current DN.
836
###
837
sub update_entries
838
{
839
my $self = shift;
840
my %opts = @_;
841
my $base = lc( $self->base() );
842
843
my $s = $opts{'search'} || $self->search({ scope => 'one', base => $base });
844
845
$self->{'cwd_entries'} = [];
846
return if $s->{'code'};
847
848
# setup cache object
849
$self->{'cache'} ||= {};
850
$self->{'cache'}->{ $base } ||= {};
851
$self->{'cache'}->{ $base } = {} if $opts{'clearcache'};
852
my $cache = $self->{'cache'}->{ $base };
853
854
my $now = time();
855
if ( ! exists $cache->{'entries'}
856
or $now - $cache->{'timestamp'} > $conf->{'cacheage'} )
857
{
858
$self->debug("Caching entries for $base\n");
859
foreach my $e ( @{ $s->{'entries'} } ) {
860
my $dn = $e->dn();
861
my $rdn = $dn;
862
$rdn =~ s/,$base//i; # remove base from display
863
push @{ $self->{'cwd_entries'} }, $rdn;
864
}
865
$cache->{'timestamp'} = $now;
866
$cache->{'entries'} = $self->{'cwd_entries'};
867
}
868
else {
869
$self->debug("Using cached lookups for $base\n");
870
}
871
872
$self->{'cwd_entries'} = $cache->{'entries'};
873
return;
874
}
875
876
877
### Roughly convert a given path to a DN.
878
###
879
### Additionally support:
880
### parent '..'
881
### current '.'
882
### last '-'
883
### home '~'
884
###
885
### Synopsis: $dn = $self->path_to_dn( $path );
886
###
887
sub path_to_dn
888
{
889
my $self = shift;
890
my $path = shift;
891
my %flags = @_;
892
my $curbase = $self->base();
893
894
# support empty 'cd' or 'cd ~' going to root
895
return $conf->{'basedn'} if ! $path || $path eq '~';
896
897
# return current base DN
898
return $curbase if $path eq '.';
899
900
# support 'cd -'
901
return $self->{'previous_base'} if $path eq '-';
902
903
# relative path, upwards
904
#
905
if ( $path =~ /^\.\./o ) {
906
# support '..' (possibly iterated and as prefix to a DN)
907
my @base = @{ ldap_explode_dn($curbase, casefold => 'none') };
908
909
# deal with leading ..,
910
#
911
while ( $path =~ /^\.\./ ) {
912
shift( @base ) if @base;
913
$path =~ s/^\.\.//;
914
last if $path !~ /[,\/]\s*/;
915
$path =~ s/[,\/]\s*//;
916
}
917
918
# append the new dn to the node if one was specified:
919
# cd ../../cn=somewhere vs
920
# cd ../../
921
#
922
my $newbase_root = canonical_dn( \@base, casefold => 'none' );
923
$path = $path ? $path . ',' . $newbase_root : $newbase_root;
924
}
925
926
# attach the base if it isn't already there (this takes care of
927
# deeper relative nodes and absolutes)
928
#
929
else {
930
$path = "$path," . $curbase unless $path =~ /$curbase/;
931
}
932
933
return $path;
934
}
935
936
937
### Given an array ref of shell-like globs,
938
### create and return a Net::LDAP::Filter object.
939
###
940
sub make_filter
941
{
942
my $self = shift;
943
my $globs = shift or return;
944
945
return unless ref $globs eq 'ARRAY';
946
return unless scalar @$globs;
947
948
my $filter;
949
$filter = join('', map { (/^\(.*\)$/o) ? $_ : "($_)" } @$globs);
950
$filter = '(|' . $filter . ')' if (scalar(@$globs) > 1);
951
$filter = Net::LDAP::Filter->new( $filter );
952
953
if ( $filter ) {
954
$self->debug( 'Filter parsed as: ' . $filter->as_string() . "\n" );
955
}
956
else {
957
print "Error parsing filter.\n";
958
return;
959
}
960
961
return $filter;
962
}
963
964
965
### Given an arrayref of objectClasses, pull a complete list of
966
### required and optional attrbutes. Returns two arrayrefs.
967
###
968
sub fetch_attributes
969
{
970
my $self = shift;
971
my $ocs = shift or return [], [];
972
973
my ( %seen, @must_attr, @may_attr );
974
foreach my $oc ( sort @{$ocs} ) {
975
976
# required
977
my @must = $self->{'schema'}->must( $oc );
978
foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @must ) {
979
next if $attr->{'name'} =~ /^objectclass$/i;
980
next if $seen{ $attr->{'name'} };
981
push @must_attr, $attr->{'name'};
982
$seen{ $attr->{'name'} }++;
983
}
984
985
# optional
986
my @may = $self->{'schema'}->may( $oc );
987
foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) {
988
next if $attr->{'name'} =~ /^objectclass$/i;
989
next if $seen{ $attr->{'name'} };
990
push @may_attr, $attr->{'name'};
991
$seen{ $attr->{'name'} }++;
992
}
993
}
994
995
return \@must_attr, \@may_attr;
996
}
997
998
999
### Check whether a given string can be used directly as
1000
### an LDAP search filter.
1001
###
1002
### Synopsis: $yesNo = $self->is_valid_filter($string);
1003
###
1004
sub is_valid_filter
1005
{
1006
my $self = shift;
1007
my $filter = shift or return;
1008
1009
return Net::LDAP::Filter->new( $filter ) ? 1 : 0;
1010
}
1011
1012
1013
### Call code in subref $action, if there's any connection related errors,
1014
### try it one additional time before giving up. This should take care of
1015
### most server disconnects due to timeout and other generic connection
1016
### errors, and will attempt to transparently re-establish a connection.
1017
###
1018
sub with_retry
1019
{
1020
my $self = shift;
1021
my $action = shift;
1022
1023
my $rv = $action->();
1024
if ( $rv->code() == LDAP_OPERATIONS_ERROR ||
1025
$rv->code() == LDAP_TIMELIMIT_EXCEEDED ||
1026
$rv->code() == LDAP_BUSY ||
1027
$rv->code() == LDAP_UNAVAILABLE ||
1028
$rv->code() == LDAP_OTHER ||
1029
$rv->code() == LDAP_SERVER_DOWN ||
1030
$rv->code() == LDAP_TIMEOUT ||
1031
$rv->code() == LDAP_NO_MEMORY ||
1032
$rv->code() == LDAP_CONNECT_ERROR ) {
1033
1034
$self->debug( "Error ". $rv->code() . ", retrying.\n" );
1035
$self->{'ldap'} = undef;
1036
$rv = $action->();
1037
}
1038
1039
return $rv;
1040
}
1041
1042
1043
### little. yellow. different. better.
1044
###
1045
sub debug
1046
{
1047
my $self = shift;
1048
return unless $conf->{'debug'};
1049
print "\e[33m";
1050
print shift();
1051
print "\e[0m";
1052
return;
1053
}
1054
1055
1056
### Autocomplete values: Returns cached children entries.
1057
###
1058
sub autocomplete_cwd
1059
{
1060
my $self = shift;
1061
return @{ $self->{'cwd_entries'} };
1062
}
1063
1064
1065
### Autocomplete values: Returns previously set shelldap environment values.
1066
###
1067
sub comp_setenv
1068
{
1069
my $self = shift;
1070
return @{ $self->{'env'} };
1071
}
1072
1073
1074
### Autocomplete values: Returns all objectClasses as defined
1075
### by the LDAP server.
1076
###
1077
sub comp_create
1078
{
1079
my $self = shift;
1080
return @{ $self->{'objectclasses'} };
1081
}
1082
1083
1084
### Autocomplete values: Returns all objectClasses as defined
1085
### by the LDAP server, along with current children DNs.
1086
###
1087
sub comp_inspect
1088
{
1089
my $self = shift;
1090
return ('_schema', @{ $self->{'objectclasses'} }, @{ $self->{'cwd_entries'} });
1091
}
1092
1093
1094
### Inject various autocomplete and alias routines into the symbol table.
1095
###
1096
{
1097
no warnings;
1098
no strict 'refs';
1099
1100
# command, alias
1101
my %cmd_map = (
1102
whoami => 'id',
1103
list => 'ls',
1104
grep => 'search',
1105
edit => 'vi',
1106
delete => 'rm',
1107
copy => 'cp',
1108
cat => 'read',
1109
move => 'mv',
1110
cd => undef,
1111
passwd => undef
1112
);
1113
1114
# setup autocompletes
1115
foreach ( %cmd_map ) {
1116
next unless $_;
1117
my $sub = "comp_$_";
1118
*$sub = \&autocomplete_cwd;
1119
}
1120
*comp_touch = \&comp_create;
1121
*comp_export = \&comp_setenv;
1122
1123
# setup alias subs
1124
#
1125
# Term::Shell has an alias_* feature, but
1126
# it seems to work about 90% of the time.
1127
# that last 10% is something of a mystery.
1128
#
1129
$cmd_map{'create'} = 'touch';
1130
foreach my $cmd ( keys %cmd_map ) {
1131
next unless defined $cmd_map{$cmd};
1132
my $alias_sub = 'run_' . $cmd_map{$cmd};
1133
my $real_sub = 'run_' . $cmd;
1134
*$alias_sub = \&$real_sub;
1135
}
1136
}
1137
1138
1139
### Given an $arrayref, remove LDIF continuation wrapping in place,
1140
### effectively making each entry a single line for LCS comparisons.
1141
###
1142
sub unwrap_line {
1143
my $self = shift;
1144
my $array = shift;
1145
1146
my $i = 1;
1147
while ( $i < scalar(@$array) ) {
1148
if ( $array->[$i] =~ /^\s/ ) {
1149
$array->[ $i - 1 ] =~ s/\n$//;
1150
$array->[ $i ] =~ s/^\s//;
1151
splice( @$array, $i - 1, 2, $array->[$i - 1] . $array->[$i] );
1152
}
1153
else {
1154
$i++;
1155
}
1156
}
1157
}
1158
1159
1160
########################################################################
1161
### S H E L L M E T H O D S
1162
########################################################################
1163
1164
### Don't die on a newline, just no-op.
1165
###
1166
sub run_ { return; }
1167
1168
1169
### Term::Shell hook.
1170
### Write history for each command, print shell debug actions.
1171
###
1172
sub precmd
1173
{
1174
my $self = shift;
1175
my ( $handler, $cmd, $args ) = @_;
1176
1177
my $term = $self->term();
1178
eval { $term->WriteHistory("$ENV{'HOME'}/.shelldap_history"); };
1179
1180
$self->debug( "$$cmd (" . ( join ' ', @$args ) . "), calling '$$handler'\n" );
1181
return;
1182
}
1183
1184
1185
### Display an entry as LDIF to the terminal.
1186
###
1187
sub run_cat
1188
{
1189
my $self = shift;
1190
my $dn = shift;
1191
my @attrs = (@_) ? @_ : ('*');
1192
1193
unless ( $dn ) {
1194
print "No dn provided.\n";
1195
return;
1196
}
1197
1198
# support '.'
1199
$dn = $self->base() if $dn eq '.';
1200
1201
# support globbing
1202
#
1203
my $s;
1204
if ( $dn eq '*' ) {
1205
$s = $self->search({
1206
scope => 'one',
1207
vals => 1,
1208
attrs => \@attrs
1209
});
1210
}
1211
elsif ( $dn =~ /\*/ ) {
1212
$s = $self->search({
1213
scope => 'one',
1214
vals => 1,
1215
filter => $dn,
1216
attrs => \@attrs
1217
});
1218
}
1219
1220
# absolute/relative dn
1221
#
1222
else {
1223
$dn = $self->path_to_dn( $dn );
1224
$s = $self->search({
1225
base => $dn,
1226
vals => 1,
1227
attrs => \@attrs
1228
});
1229
}
1230
1231
# emit error, if any
1232
#
1233
if ( $s->{'code'} ) {
1234
print $s->{'message'} . "\n";
1235
return;
1236
}
1237
1238
# display to stdout
1239
#
1240
foreach my $e ( @{ $s->{'entries'} } ) {
1241
$self->ldif->write_entry( $e );
1242
print "\n";
1243
}
1244
1245
return;
1246
}
1247
1248
1249
### Change shelldap's idea of a current working 'directory',
1250
### by adjusting the current default basedn for all searches.
1251
###
1252
sub run_cd
1253
{
1254
my $self = shift;
1255
my $newbase = shift;
1256
1257
# convert given path to a DN
1258
$newbase = $self->path_to_dn( $newbase );
1259
1260
unless ( $self->is_valid_dn( $newbase ) ) {
1261
print "No such object\n";
1262
return;
1263
}
1264
1265
# store old base
1266
$self->{'previous_base'} = $self->base();
1267
1268
# update new base
1269
$self->base( $newbase );
1270
1271
# get new 'cwd' listing
1272
my $s = $self->search({ scope => 'one', attrs => [ '1.1' ] });
1273
if ( $s->{'code'} ) {
1274
print "$s->{'message'}\n";
1275
return;
1276
}
1277
$self->update_entries( search => $s );
1278
1279
# reflect cwd change in prompt
1280
$self->update_prompt();
1281
return;
1282
}
1283
1284
1285
### Simply clear the screen.
1286
###
1287
sub run_clear
1288
{
1289
my $self = shift;
1290
system( 'clear' );
1291
return;
1292
}
1293
1294
1295
### Fetch the source DN entry, modify it's DN data
1296
### and write it back to the directory.
1297
###
1298
sub run_copy
1299
{
1300
my $self = shift;
1301
my ( $s_dn, $d_dn ) = @_;
1302
1303
unless ( $s_dn ) {
1304
print "No source DN provided.\n";
1305
return;
1306
}
1307
unless ( $d_dn ) {
1308
print "No destination DN provided.\n";
1309
return;
1310
}
1311
1312
# convert given source path to DN
1313
$s_dn = $self->path_to_dn( $s_dn );
1314
1315
# sanity check source
1316
#
1317
my $s = $self->search({ base => $s_dn, vals => 1 });
1318
unless ( $s->{'code'} == LDAP_SUCCESS ) {
1319
print "No such object\n";
1320
return;
1321
}
1322
1323
# see if we're copying the entry to a nonexistent path
1324
#
1325
my ( $new_dn, $old_dn );
1326
( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\-\w=]+),(.*)$/;
1327
if ( $new_dn ) { # absolute
1328
unless ( $self->is_valid_dn( $new_dn ) ) {
1329
print "Invalid destination.\n";
1330
return;
1331
}
1332
}
1333
else { # relative
1334
$new_dn = $self->base();
1335
}
1336
$old_dn = $1 if $s_dn =~ /^[\-\w=]+,(.*)$/;
1337
1338
# get the source entry object
1339
my $e = ${ $s->{'entries'} }[0];
1340
$e->dn( $s_dn );
1341
1342
# add changes in new entry instead of modifying existing
1343
$e->changetype( 'add' );
1344
$e->dn( "$d_dn,$new_dn" );
1345
1346
# get the unique attribute from the dn for modification
1347
# perhaps there is a better way to do this...?
1348
#
1349
my ( $uniqkey, $uniqval ) = ( $1, $2 )
1350
if $d_dn =~ /^([\-\.\w]+)(?:\s+)?=(?:\s+)?([\-\.\s\w]+),?/;
1351
unless ( $uniqkey && $uniqval ) {
1352
print "Unable to parse unique values from RDN.\n";
1353
return;
1354
}
1355
$e->replace( $uniqkey => $uniqval );
1356
1357
# update (which will actually create the new entry)
1358
#
1359
my $update = sub { return $e->update($self->ldap()) };
1360
my $rv = $self->with_retry( $update );
1361
print $rv->error(), "\n";
1362
1363
# clear caches
1364
#
1365
$self->{'cache'}->{ $new_dn } = {} if $new_dn;
1366
$self->{'cache'}->{ $old_dn } = {} if $old_dn;
1367
$self->update_entries( clearcache => 1 );
1368
return;
1369
}
1370
1371
1372
### Create a new entry from scratch, using attributes from
1373
### what the server's schema says is available from the specified
1374
### (optional) objectClass list. Populate a new LDIF file and
1375
### present an editor to the user.
1376
###
1377
sub run_create
1378
{
1379
my $self = shift;
1380
my @ocs = @_;
1381
1382
# manually generate some boilerplate LDIF.
1383
#
1384
unless ( $self->{'create_file'} ) {
1385
my $fh;
1386
1387
( $fh, $self->{'create_file'} ) =
1388
File::Temp::tempfile( 'shelldap_XXXXXXXX', SUFFIX => '.ldif', DIR => '/tmp', UNLINK => 1 );
1389
1390
# first print out the dn and object classes.
1391
#
1392
print $fh 'dn: ???,', $self->base(), "\n";
1393
foreach my $oc ( sort @ocs ) {
1394
print $fh "objectClass: $oc\n";
1395
}
1396
1397
# gather and print attributes for requested objectClasses
1398
#
1399
my ( $must_attr, $may_attr ) = $self->fetch_attributes( \@ocs );
1400
print $fh "$_: \n" foreach @{ $must_attr };
1401
print $fh "# $_: \n" foreach @{ $may_attr };
1402
close $fh;
1403
}
1404
1405
# checksum the file.
1406
#
1407
my $hash_orig = $self->chksum( $self->{'create_file'} );
1408
system( $self->{'editor'}, $self->{'create_file'} ) && die "Unable to launch editor: $!\n";
1409
1410
# detect a total lack of change
1411
#
1412
if ( $hash_orig eq $self->chksum($self->{'create_file'}) ) {
1413
print "Entry not modified.\n";
1414
unlink $self->{'create_file'};
1415
$self->{'create_file'} = undef;
1416
return;
1417
}
1418
1419
# load in LDIF
1420
#
1421
my $ldif = Net::LDAP::LDIF->new( $self->{'create_file'}, 'r', onerror => 'warn' );
1422
my $e = $ldif->read_entry();
1423
unless ( $e ) {
1424
print "Unable to parse LDIF.\n";
1425
unlink $self->{'create_file'};
1426
$self->{'create_file'} = undef;
1427
return;
1428
}
1429
1430
# create the new entry.
1431
#
1432
$e->changetype('add');
1433
my $create = sub { return $e->update($self->ldap()) };
1434
my $rv = $self->with_retry( $create );
1435
print $rv->error(), "\n";
1436
1437
if ( $rv->code() != LDAP_SUCCESS && $self->prompt_edit_again() ) {
1438
return $self->run_create();
1439
}
1440
1441
$self->update_entries( clearcache => 1 );
1442
unlink $self->{'create_file'};
1443
$self->{'create_file'} = undef;
1444
return;
1445
}
1446
1447
1448
### Remove an entry (or entries) from the LDAP directory.
1449
###
1450
sub run_delete
1451
{
1452
my $self = shift;
1453
my @DNs = @_;
1454
1455
unless ( scalar @DNs ) {
1456
print "No dn specified.\n";
1457
return;
1458
}
1459
1460
my $filter;
1461
unless ( $DNs[0] eq '*' ) {
1462
$filter = $self->make_filter( \@DNs ) or return;
1463
}
1464
1465
my $s = $self->search({ scope => 'one', filter => $filter });
1466
unless ( $s->{'code'} == LDAP_SUCCESS ) {
1467
print "$s->{'message'}\n";
1468
return;
1469
}
1470
1471
print "Are you sure? [Ny]: ";
1472
chomp( my $resp = <STDIN> );
1473
return unless $resp =~ /^y/i;
1474
1475
foreach my $e ( @{ $s->{'entries'} } ) {
1476
my $dn = $e->dn();
1477
my $rv = $self->ldap->delete( $dn );
1478
print "$dn: ", $rv->error(), "\n";
1479
}
1480
1481
$self->update_entries( clearcache => 1 );
1482
return;
1483
}
1484
1485
1486
### Fetch an entry from the directory, write it out to disk
1487
### as LDIF, launch an editor, then compare changes and write
1488
### it back to the directory.
1489
###
1490
sub run_edit
1491
{
1492
my $self = shift;
1493
my $dn = shift;
1494
1495
unless ( $dn ) {
1496
print "No dn provided.\n";
1497
return;
1498
}
1499
1500
# convert given path to DN
1501
$dn = $self->path_to_dn( $dn );
1502
1503
# sanity check
1504
#
1505
my $s = $self->search({ base => $dn, vals => 1 });
1506
unless ( $s->{'code'} == LDAP_SUCCESS ) {
1507
print $s->{'message'} . "\n";
1508
return;
1509
}
1510
1511
# fetch entry.
1512
my $e = ${ $s->{'entries'} }[0];
1513
$e->changetype( 'modify' );
1514
1515
# write it out to disk.
1516
#
1517
unless( $self->{'edit_again'} ) {
1518
my $ldif = $self->ldif(1);
1519
$ldif->write_entry( $e );
1520
$ldif->done(); # force sync
1521
}
1522
1523
# load it into an array for potential comparison
1524
open LDIF, "$self->{'ldif_fname'}" or return;
1525
my @orig_ldif = <LDIF>;
1526
close LDIF;
1527
1528
# append optional, unused attributes as comments for fast reference.
1529
#
1530
unless ( $self->{'edit_again'} ) {
1531
my %current_attrs = map { $_ => 1 } $e->attributes();
1532
my ( $must_attr, $may_attr ) = $self->fetch_attributes( $e->get_value('objectClass', asref => 1) );
1533
1534
open LDIF, ">> $self->{'ldif_fname'}";
1535
foreach my $opt_attr ( sort { $a cmp $b } @{$may_attr} ) {
1536
next if $current_attrs{ $opt_attr };
1537
print LDIF "# " . $opt_attr . ":\n";
1538
}
1539
close LDIF;
1540
}
1541
1542
# checksum it, then open it in an editor
1543
#
1544
my $hash_orig = $self->chksum( $self->{'ldif_fname'} );
1545
system( $self->{'editor'}, $self->{'ldif_fname'} ) &&
1546
die "Unable to launch editor: $!\n";
1547
1548
# detect a total lack of change
1549
#
1550
if ( $hash_orig eq $self->chksum($self->{'ldif_fname'}) ) {
1551
print "Entry not modified.\n";
1552
unlink $self->{'ldif_fname'};
1553
$self->{'edit_again'} = undef;
1554
return;
1555
}
1556
1557
# check changes for basic LDIF validity
1558
#
1559
while( ! $self->load_ldif($self->{'ldif_fname'}) ) {
1560
print "Unable to parse LDIF.\n";
1561
if ( $self->prompt_edit_again() ) {
1562
system( $self->{'editor'}, $self->{'ldif_fname'} );
1563
}
1564
else {
1565
unlink $self->{'ldif_fname'};
1566
$self->{'edit_again'} = undef;
1567
return;
1568
}
1569
}
1570
1571
# load changes into a new array for comparison
1572
#
1573
open LDIF, "$self->{'ldif_fname'}" or return;
1574
my @new_ldif = <LDIF>;
1575
close LDIF;
1576
1577
# parser subref
1578
#
1579
my $parse = sub {
1580
my $line = shift || $_;
1581
return if $line =~ /^\#/; # ignore comments
1582
my ( $attr, $val ) = ( $1, $2 ) if $line =~ /^(.+?): (.*)$/;
1583
return unless $attr;
1584
return if index($attr, ':') != -1; # ignore base64
1585
return ( $attr, $val );
1586
};
1587
1588
$self->unwrap_line( \@orig_ldif );
1589
$self->unwrap_line( \@new_ldif );
1590
1591
my $diff = Algorithm::Diff->new( \@orig_ldif, \@new_ldif );
1592
HUNK:
1593
while ( $diff->Next() ) {
1594
next if $diff->Same();
1595
my $diff_bit = $diff->Diff();
1596
my %seen_attr;
1597
1598
# attr removal hunk
1599
#
1600
if ( $diff_bit == 1 ) {
1601
foreach ( $diff->Items(1) ) {
1602
my ( $attr, $val ) = $parse->( $_ ) or next;
1603
$self->debug("DELETE: $_");
1604
$e->delete( $attr => [ $val ] );
1605
}
1606
}
1607
1608
# attr insertion hunk
1609
#
1610
if ( $diff_bit == 2 ) {
1611
foreach ( $diff->Items(2) ) {
1612
my ( $attr, $val ) = $parse->( $_ ) or next;
1613
$self->debug("INSERT: $_");
1614
$e->add( $attr => $val );
1615
}
1616
}
1617
1618
# attr change hunk
1619
#
1620
if ( $diff_bit == 3 ) {
1621
1622
# modification to existing line
1623
#
1624
foreach ( $diff->Items(2) ) {
1625
my ( $attr, $val ) = $parse->( $_ ) or next;
1626
$self->debug("MODIFY: $_");
1627
1628
my $cur_vals = $e->get_value( $attr, asref => 1 ) || [];
1629
my $cur_valcount = scalar @$cur_vals;
1630
next if $cur_valcount == 0; # should have been an 'add'
1631
1632
# replace immediately
1633
#
1634
if ( $cur_valcount == 1 ) {
1635
$e->replace( $attr => $val );
1636
}
1637
else {
1638
1639
# retain attributes that allow multiples, so updating
1640
# one attribute doesn't inadvertently remove others with
1641
# the same name.
1642
#
1643
next if $seen_attr{ $attr };
1644
my @new_vals;
1645
foreach my $line ( @new_ldif ) {
1646
my ( $new_attr, $new_val ) = $parse->( $line ) or next;
1647
next unless $new_attr eq $attr;
1648
$seen_attr{ $attr }++;
1649
push @new_vals, $new_val;
1650
}
1651
1652
$e->replace( $attr => \@new_vals );
1653
}
1654
}
1655
1656
# deletion within the same hunk
1657
#
1658
foreach ( $diff->Items(1) ) {
1659
my ( $attr, $val ) = $parse->( $_ ) or next;
1660
my $cur_vals = $e->get_value( $attr, asref => 1 ) || [];
1661
my $cur_valcount = scalar @$cur_vals;
1662
1663
next if $cur_valcount == 1;
1664
next if $seen_attr{ $attr };
1665
$self->debug("DELETE: $_");
1666
$e->delete( $attr => [ $val ] );
1667
}
1668
}
1669
}
1670
1671
my $update = sub { return $e->update( $self->ldap ); };
1672
my $rv = $self->with_retry( $update );
1673
print $rv->error(), "\n";
1674
1675
if ( $rv->code() != LDAP_SUCCESS && $self->prompt_edit_again() ) {
1676
$self->{'edit_again'} = 1;
1677
return $self->run_edit( $dn );
1678
}
1679
1680
unlink $self->{'ldif_fname'};
1681
$self->{'edit_again'} = undef;
1682
return;
1683
}
1684
1685
1686
### Display current tunable runtime settings.
1687
###
1688
sub run_env
1689
{
1690
my $self = shift;
1691
1692
foreach ( sort @{ $self->{'env'} } ) {
1693
print "$_: ";
1694
print $conf->{$_} ? $conf->{$_} : 0;
1695
print "\n"
1696
}
1697
}
1698
1699
1700
### Alter settings.
1701
###
1702
sub run_setenv
1703
{
1704
my $self = shift;
1705
my ( $key, $val ) = @_;
1706
1707
( $key, $val ) = split /=/, $key if $key && ! defined $val;
1708
return unless $key && defined $val;
1709
$key = lc $key;
1710
1711
$conf->{$key} = $val;
1712
return;
1713
}
1714
1715
1716
### Search across the directory and display matching entries.
1717
###
1718
sub run_grep
1719
{
1720
my $self = shift;
1721
my ( $recurse, $filter, $base ) = @_;
1722
1723
# set 'recursion'
1724
unless ( $recurse && $recurse =~ /\-r|recurse/ ) {
1725
# shift args to the left
1726
( $recurse, $filter, $base ) = ( undef, $recurse, $filter );
1727
}
1728
1729
$filter = Net::LDAP::Filter->new( $filter );
1730
unless ( $filter ) {
1731
print "Invalid search filter.\n";
1732
return;
1733
}
1734
1735
# support '*'
1736
$base = $self->base() if ! $base or $base eq '*';
1737
1738
unless ( $base ) {
1739
print "No search base specified.\n";
1740
return;
1741
}
1742
1743
# convert base path to DN
1744
$base = $self->path_to_dn( $base );
1745
1746
$self->debug("Filter parsed as: " . $filter->as_string() . "\n");
1747
1748
my $s = $self->search({
1749
scope => $recurse ? 'sub' : 'one',
1750
base => $base,
1751
filter => $filter
1752
});
1753
1754
foreach my $e ( @{ $s->{'entries'} } ) {
1755
my $dn = $e->dn();
1756
print "$dn\n";
1757
}
1758
1759
return;
1760
}
1761
1762
1763
### Override internal help function with pod2usage output.
1764
###
1765
sub run_help
1766
{
1767
return Pod::Usage::pod2usage(
1768
-exitval => 'NOEXIT',
1769
-verbose => 99,
1770
-sections => 'SHELL COMMANDS'
1771
);
1772
}
1773
1774
1775
### Generate and display a list of LDAP entries, relative to the current
1776
### location the command was run from.
1777
###
1778
sub run_list
1779
{
1780
my $self = shift;
1781
my @args = @_;
1782
my @attrs = ();
1783
my $filter;
1784
1785
# flag booleans
1786
my ( $recurse, $long );
1787
1788
# parse arguments: [ <option> ...] [<filter> ...] [<attribute> ...]
1789
#
1790
if ( scalar @args ) {
1791
# options: support '-l' or '-R' listings
1792
if ( $args[0] =~ /^\-(\w+)/o ) {
1793
my $flags = $1;
1794
$recurse = $flags =~ /R/;
1795
$long = $flags =~ /l/;
1796
shift( @args );
1797
}
1798
1799
my @filters;
1800
1801
# get filter elements from argument list
1802
#
1803
while ( @args && $self->is_valid_filter($args[0]) ) {
1804
push( @filters, shift(@args) );
1805
}
1806
1807
# No filter for display? Default to all entries.
1808
push( @filters, '(objectClass=*)' ) unless scalar @filters;
1809
1810
# construct OR'ed filter from filter elements
1811
$filter = $self->make_filter( \@filters );
1812
1813
# remaining arguments must be attributes
1814
push( @attrs, @args );
1815
}
1816
1817
# Get all attributes if none are specified, and we're in long-list mode.
1818
push( @attrs, '*' ) if $long && ! scalar @attrs;
1819
1820
my $s = $self->search({
1821
scope => $recurse ? 'sub' : 'one',
1822
vals => 1,
1823
filter => $filter,
1824
attrs => [ @attrs, 'hasSubordinates' ]
1825
});
1826
if ( $s->{'code'} ) {
1827
print "$s->{'message'}\n";
1828
return;
1829
}
1830
1831
# if an entry doesn't have a description field,
1832
# try and show some nice defaults for ls -l !
1833
#
1834
# objectClass -> Attribute to show
1835
#
1836
my %descs = %{
1837
$conf->{'descmaps'}
1838
|| {
1839
posixAccount => 'gecos',
1840
posixGroup => 'gidNumber',
1841
ipHost => 'ipHostNumber',
1842
}
1843
};
1844
1845
# iterate and print
1846
#
1847
my $dn_count = 0;
1848
my $base = $self->base();
1849
foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) {
1850
my $dn = $e->dn();
1851
next if lc( $dn ) eq lc( $base );
1852
1853
if ( ! $long ) {
1854
# strip the current base from the dn, if we're recursing and not in long mode
1855
if ( $recurse ) {
1856
$dn =~ s/,$base//oi;
1857
}
1858
1859
# only show RDN unless -l was given
1860
else {
1861
$dn = canonical_dn( [shift(@{ldap_explode_dn($dn, casefold => 'none')})], casefold => 'none' )
1862
}
1863
}
1864
1865
# if this entry is a container for other entries, append a
1866
# trailing slash.
1867
$dn .= '/' if $e->get_value('hasSubordinates') &&
1868
$e->get_value('hasSubordinates') eq 'TRUE';
1869
1870
# additional arguments/attributes were given; show their values
1871
#
1872
if ( scalar @args ) {
1873
my @elements = ( $dn );
1874
1875
foreach my $attr ( @args ) {
1876
my @vals = $e->get_value( $attr );
1877
push( @elements, join(',', @vals) );
1878
}
1879
1880
print join( "\t", @elements )."\n";
1881
}
1882
1883
# show descriptions
1884
#
1885
else {
1886
my $desc = $e->get_value( 'description' );
1887
if ( $desc ) {
1888
$desc =~ s/\n.*//s; # 1st line only
1889
$dn .= " ($desc)";
1890
}
1891
1892
# no desc? Try and infer something useful
1893
# to display.
1894
#
1895
else {
1896
1897
# pull objectClasses, hash for lookup speed
1898
my @oc = $e->get_value( 'objectClass' );
1899
my %ochash;
1900
map { $ochash{$_} = 1 } @oc;
1901
1902
foreach my $d_listing ( sort keys %descs ) {
1903
if ( exists $ochash{ $d_listing } ) {
1904
my $str = $e->get_value( $descs{ $d_listing }, asref => 1 );
1905
$dn .= ' (' . (join ', ', @$str) . ')' if $str && scalar @$str;
1906
}
1907
next;
1908
}
1909
}
1910
print "$dn\n";
1911
}
1912
$dn_count++;
1913
}
1914
1915
print "\n$dn_count " .
1916
( $dn_count == 1 ? 'object.' : 'objects.') .
1917
"\n" if $long;
1918
return;
1919
}
1920
1921
1922
### Create a new organizationalUnit entry.
1923
###
1924
sub run_mkdir
1925
{
1926
my $self = shift;
1927
my $dir = shift;
1928
1929
unless ( $dir ) {
1930
print "No 'directory' provided.\n";
1931
return;
1932
}
1933
1934
# normalize name, if it is not yet a legal DN
1935
$dir = 'ou=' . $dir unless canonical_dn( $dir );
1936
1937
# convert given path to full DN
1938
$dir = $self->path_to_dn( $dir );
1939
1940
# get RDN: naming attributes (lower-case) and their values
1941
my %rdn = %{ shift(@{ ldap_explode_dn($dir, casefold => 'lower') }) };
1942
1943
# add
1944
my $mkdir = sub {
1945
return $self->ldap()->add( $dir, attr => [
1946
objectClass => [ 'top', 'organizationalUnit' ], %rdn
1947
]);
1948
};
1949
1950
my $rv = $self->with_retry( $mkdir );
1951
1952
print $rv->error(), "\n";
1953
$self->update_entries( clearcache => 1 );
1954
return;
1955
}
1956
1957
1958
### Alter an entry's DN.
1959
###
1960
sub run_move
1961
{
1962
my $self = shift;
1963
my ( $s_dn, $d_dn ) = @_;
1964
1965
unless ( $s_dn ) {
1966
print "No source dn provided.\n";
1967
return;
1968
}
1969
unless ( $d_dn ) {
1970
print "No destination dn provided.\n";
1971
return;
1972
}
1973
1974
# convert given source path to DN
1975
$s_dn = $self->path_to_dn( $s_dn );
1976
1977
unless ( $self->is_valid_dn( $s_dn ) ) {
1978
print "No such object\n";
1979
return;
1980
}
1981
1982
# see if we're moving the entry to a totally new path
1983
my ( $new_dn, $old_dn );
1984
( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\-\w=]+),(.*)$/;
1985
$old_dn = $1 if $s_dn =~ /^[\-\w=]+,(.*)$/;
1986
1987
my $moddn = sub {
1988
return $self->ldap()->moddn(
1989
$s_dn,
1990
newrdn => $d_dn,
1991
deleteoldrdn => 1,
1992
newsuperior => $new_dn
1993
);
1994
};
1995
my $rv = $self->with_retry( $moddn );
1996
print $rv->error(), "\n";
1997
1998
# clear caches
1999
$self->{'cache'}->{ $new_dn } = {} if $new_dn;
2000
$self->{'cache'}->{ $old_dn } = {} if $old_dn;
2001
$self->update_entries( clearcache => 1 );
2002
return;
2003
}
2004
2005
2006
### Change the 'userPassword' attribute of an entry, if
2007
### supported by the LDAP server.
2008
###
2009
sub run_passwd
2010
{
2011
my $self = shift;
2012
my $dn = shift || $self->base();
2013
2014
$self->{'root_dse'} ||= $self->ldap->root_dse();
2015
2016
my $pw_extension = '1.3.6.1.4.1.4203.1.11.1';
2017
unless ( $self->{'root_dse'}->supported_extension( $pw_extension ) ) {
2018
print "Sorry, password changes not supported by LDAP server.\n";
2019
return;
2020
}
2021
2022
# convert given path to DN
2023
$dn = $self->path_to_dn( $dn );
2024
2025
my $s = $self->search( { base => $dn, scope => 'base' } );
2026
if ( $s->{'code'} ) {
2027
print $s->{'message'}, "\n";
2028
return;
2029
}
2030
my $e = ${ $s->{'entries'} }[0];
2031
2032
unless ( $e->exists('userPassword') ) {
2033
print "No userPassword attribute for $dn\n";
2034
return;
2035
}
2036
2037
print "Changing password for $dn\n";
2038
Term::ReadKey::ReadMode 2;
2039
print "Enter new password: ";
2040
chomp( my $pw = <STDIN> );
2041
print "\nRetype new password: ";
2042
chomp( my $pw2 = <STDIN> );
2043
print "\n";
2044
Term::ReadKey::ReadMode 0;
2045
2046
if ( $pw ne $pw2 ) {
2047
print "Sorry, passwords do not match.\n";
2048
return;
2049
}
2050
2051
my $setpw = sub { return $self->ldap->set_password( user => $dn, newpasswd => $pw ); };
2052
my $rv = $self->with_retry( $setpw );
2053
2054
if ( $rv->code() == LDAP_SUCCESS ) {
2055
print "Password updated successfully.\n";
2056
}
2057
else {
2058
print "Password error: " . $rv->error() . "\n";
2059
}
2060
2061
return;
2062
}
2063
2064
2065
### Display the current working "directory".
2066
###
2067
sub run_pwd
2068
{
2069
my $self = shift;
2070
print $self->base() . "\n";
2071
return;
2072
}
2073
2074
2075
### Display the currently bound user.
2076
###
2077
sub run_whoami
2078
{
2079
my $self = shift;
2080
my $msg = ( $conf->{'binddn'} || 'anonymous bind' ) . ' (' . $conf->{'server'} . ')';
2081
print "$msg\n";
2082
return;
2083
}
2084
2085
2086
### Show basic information for an entry (DN) or list of objectClasses.
2087
###
2088
### structural/auxillary classes
2089
### required attributes
2090
### optional attributes
2091
###
2092
sub run_inspect
2093
{
2094
my $self = shift;
2095
my @ocs = @_;
2096
my $dn = $ocs[0];
2097
my ( $must_attr, $may_attr );
2098
2099
unless ( $dn ) {
2100
print "No DN or objectClass(es) provided.\n";
2101
return;
2102
}
2103
2104
# "Magic" argument that dumps all raw schema information.
2105
#
2106
if ( $dn eq '_schema' ) {
2107
$self->{'schema'}->dump();
2108
return;
2109
}
2110
2111
# one argument -- if it successfully resolves to a valid DN, fetch
2112
# the objectClass list from it.
2113
#
2114
if ( scalar @ocs == 1 ) {
2115
$dn = $self->base() if $dn eq '.';
2116
$dn = $self->path_to_dn( $dn );
2117
2118
my $s = $self->search({ base => $dn, vals => 1, attrs => ['objectClass'] });
2119
if ( $s->{'code'} == LDAP_SUCCESS ) {
2120
my $e = ${ $s->{'entries'} }[0];
2121
@ocs = $e->get_value('objectClass');
2122
}
2123
}
2124
2125
# get the complete attributes list.
2126
#
2127
( $must_attr, $may_attr ) = $self->fetch_attributes( \@ocs );
2128
my %must = map { $_ => 1 } @{$must_attr};
2129
2130
# Output objectClass chains and flags.
2131
#
2132
print "ObjectClasses:\n";
2133
foreach my $oc ( sort @ocs ) {
2134
my @sups = $self->findall_supers( $oc );
2135
2136
my @oc_chain = ( $oc, @sups );
2137
my @oc_out;
2138
2139
foreach my $oc ( @oc_chain ) {
2140
my $oc_obj = $self->{'schema'}->objectclass( $oc );
2141
next unless $oc_obj;
2142
2143
$oc = $oc . ' (' . 'structural' . ')' if $oc_obj->{'structural'};
2144
push( @oc_out, $oc );
2145
}
2146
2147
print " " . join( ' --> ', @oc_out ) . "\n" if scalar @oc_out;
2148
}
2149
2150
# Output attributes and flags.
2151
#
2152
print "\nAttributes:\n";
2153
foreach my $attr ( sort (@{$must_attr}, @{$may_attr}) ) {
2154
my @flaglist;
2155
if ( $self->{'schema'}->attribute( $attr )->{'single-value'} ) {
2156
push ( @flaglist, 'single-value' );
2157
}
2158
else {
2159
push ( @flaglist, 'multivalue' );
2160
}
2161
2162
push ( @flaglist, $must{$attr} ? 'required' : 'optional' );
2163
2164
my $flags = '';
2165
$flags = (' (' . join( ', ', sort @flaglist ) . ')') if scalar @flaglist > 0;
2166
2167
printf( " %s%s\n", $attr, $flags );
2168
}
2169
2170
print "\n";
2171
return;
2172
}
2173
2174
2175
### Recursively walk an objectClass heirarchy, returning an array
2176
### of inheritence.
2177
###
2178
sub findall_supers
2179
{
2180
my $self = shift;
2181
my $oc = shift or return;
2182
my @found;
2183
2184
foreach my $sup ( $self->{'schema'}->superclass($oc) ) {
2185
push( @found, $sup );
2186
push( @found, $self->findall_supers( $sup ) );
2187
}
2188
2189
return @found;
2190
}
2191
2192
2193
2194
########################################################################
2195
### M A I N
2196
########################################################################
2197
2198
package main;
2199
use strict;
2200
use warnings;
2201
2202
$0 = 'shelldap';
2203
my $VERSION = '1.1.0';
2204
2205
use Getopt::Long;
2206
use YAML::Syck;
2207
use Pod::Usage;
2208
eval 'use Term::ReadLine::Gnu';
2209
warn qq{Term::ReadLine::Gnu not installed.
2210
Continuing, but shelldap is of limited usefulness without it.\n\n} if $@;
2211
2212
# get config - rc file first, command line overrides
2213
use vars '$conf';
2214
$conf = load_config() || {};
2215
Getopt::Long::GetOptions(
2216
$conf,
2217
'server|H=s',
2218
'configfile|f=s',
2219
'binddn|D=s',
2220
'basedn|b=s',
2221
'cacheage=i',
2222
'promptpass|W',
2223
'timeout=i',
2224
'sasl|Y=s',
2225
'tls_cacert=s',
2226
'tls_cert=s',
2227
'tls_key=s',
2228
'tls', 'debug', 'version',
2229
help => sub {
2230
Pod::Usage::pod2usage(
2231
-verbose => 1,
2232
-message => "\n$0 command line flags\n" . '-' x 65
2233
);
2234
}
2235
);
2236
2237
# show version
2238
if ( $conf->{'version'} ) {
2239
print "$0 $VERSION\n";
2240
exit( 0 );
2241
}
2242
2243
# additional/different config file?
2244
#
2245
if ( $conf->{'configfile'} ) {
2246
my $more_conf = load_config( $conf->{'configfile'} );
2247
while ( my ($k, $v) = each %{$conf} ) { $conf->{ $k } = $v }
2248
}
2249
2250
2251
# defaults
2252
$conf->{'configfile'} ||= "$ENV{'HOME'}/.shelldap.rc";
2253
$conf->{'cacheage'} ||= 300;
2254
$conf->{'timeout'} ||= 10;
2255
2256
# create and enter shell loop
2257
my $shell = LDAP::Shell->new();
2258
$shell->cmdloop();
2259
2260
### load YAML config into global conf.
2261
###
2262
sub load_config
2263
{
2264
my $confpath = shift;
2265
my ( $d, $data );
2266
2267
unless ( $confpath ) {
2268
my @confs = (
2269
"$ENV{'HOME'}/.shelldap.rc",
2270
'/usr/local/etc/shelldap.conf',
2271
'/etc/shelldap.conf',
2272
);
2273
foreach ( @confs ) {
2274
if ( -e $_ ) {
2275
$confpath = $_;
2276
last;
2277
}
2278
}
2279
}
2280
$confpath or return undef;
2281
2282
open YAML, $confpath or return undef;
2283
do {
2284
local $/ = undef;
2285
$data = <YAML>; # slurp!
2286
};
2287
close YAML;
2288
2289
eval { $conf = YAML::Syck::Load( $data ) };
2290
die "Invalid YAML in $confpath\n" if $@;
2291
2292
return $conf;
2293
}
2294
2295
### EOF
2296
Loggerhead is a web-based interface for Breezy
Version: 2.0.1