source: shelldap @ 46dfe9d6f368

Revision 46dfe9d6f368, 36.6 KB checked in by Mahlon E. Smith <mahlon@…>, 2 years ago (diff)

Update documentation, now that multiline edits work. Minor other
cleanups. Bump version.
  • Property exe set to *
Line 
1#!/usr/bin/env perl
2# vim: set nosta noet ts=4 sw=4:
3#
4# Copyright (c) 2006-2011, 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
33Shelldap / LDAP::Shell
34
35A program for interacting with an LDAP server via a shell-like
36interface.
37
38This is not meant to be an exhaustive LDAP editing and browsing
39interface, but rather an intuitive shell for performing basic LDAP
40tasks quickly and with minimal effort.
41
42=head1 SYNPOSIS
43
44 shelldap --server example.net [--help]
45
46=head1 FEATURES
47
48 - Upon successful authenticated binding, credential information is
49   auto-cached to ~/.shelldap.rc -- future loads require no command line
50   flags.
51
52 - Custom 'description maps' for entry listings.  (See the 'list' command.)
53
54 - History and autocomplete via readline, if installed.
55
56 - Automatic reconnection attempts if the connection is lost with the
57   LDAP server.
58
59 - It feels like a semi-crippled shell, making LDAP browsing and editing
60   at least halfway pleasurable.
61
62=head1 OPTIONS
63
64All command line options follow getopts long conventions.
65
66    shelldap --server example.net --basedn dc=your,o=company
67
68You may also optionally create a ~/.shelldap.rc file with command line
69defaults.  This file should be valid YAML.  (This file is generated
70automatically on a successful bind auth.)
71
72Example:
73
74    server: ldap.example.net
75    binddn: cn=Manager,dc=your,o=company
76    bindpass: xxxxxxxxx
77    basedn: dc=your,o=company
78    tls: yes
79    tls_cacert: /etc/ssl/certs/cacert.pem
80    tls_cert:   ~/.ssl/client.cert.pem
81    tls_key:    ~/.ssl/private/client.key.pem
82
83=over 4
84
85=item B<server>
86
87Required. The LDAP server to connect to.  This can be a hostname, IP
88address, or a URI.
89
90    --server ldaps://ldap.example.net
91
92=back
93
94=over 4
95
96=item B<binddn>
97
98The full dn of a user to authenticate as.  If not specified, defaults to
99an anonymous bind.  You will be prompted for a password.
100
101    --binddn cn=Manager,dc=your,o=company
102
103=back
104
105=over 4
106
107=item B<basedn>
108
109The directory 'root' of your LDAP server.  If omitted, shelldap will
110try and ask the server for a sane default.
111
112    --basedn dc=your,o=company
113
114=back
115
116=over 4
117
118=item B< tls>
119
120Enables TLS over what would normally be an insecure connection.
121Requires server side support.
122
123=item B<tls_cacert>
124
125Specify CA Certificate to trust.
126
127    --tls_cacert /etc/ssl/certs/cacert.pem
128
129=item B<tls_cert>
130
131The TLS client certificate.
132
133    --tls_cert ~/.ssl/client.cert.pem
134
135=item B<tls_key>
136
137The TLS client key.  Not specifying a key will connect via TLS without
138key verification.
139
140    --tls_key ~/.ssl/private/client.key.pem
141
142=back
143
144=over 4
145
146=item B<cacheage>
147
148Set the time to cache directory lookups in seconds.
149
150By default, directory lookups are cached for 300 seconds, to speed
151autocomplete up when changing between different basedns.
152
153Modifications to the directory automatically reset the cache.  Directory
154listings are not cached.  (This is just used for autocomplete.)  Set it
155to 0 to disable caching completely.
156
157=back
158
159=over 4
160
161=item B<timeout>
162
163Set the maximum time an LDAP operation can take before it is cancelled.
164
165=back
166
167=over 4
168
169=item B<debug>
170
171Print extra operational info out, and backtrace on fatal error.
172
173=back
174
175=head1 SHELL COMMANDS
176
177=over 4
178
179=item B< cat>
180
181Display an LDIF dump of an entry.  Globbing is supported.  Specify
182either the full dn, or an rdn.  For most commands, rdns are local to the
183current search base. ('cwd', as translated to shell speak.)  You may additionally
184add a list of attributes to display.  Use '+' for server side attributes.
185
186    cat uid=mahlon
187    cat ou=*
188    cat uid=mahlon,ou=People,dc=example,o=company
189    cat uid=mahlon + userPassword
190
191=item B<  cd>
192
193Change directory.  Translated to LDAP, this changes the current basedn.
194All commands after a 'cd' operate within the new basedn.
195
196    cd                cd to 'home' basedn
197    cd ~              same thing
198    cd -              cd to previous directory
199    cd ou=People      cd to explicit path
200    cd ..             cd to parent node
201
202Since LDAP doesn't actually limit what can be a container object, you
203can actually cd into any entry. Many commands then work on '.', meaning
204"wherever I currently am."
205
206    cd uid=mahlon
207    cat .
208
209=item B<clear>
210
211Clear the screen.
212
213=item B<copy>
214
215Copy an entry to a different dn path.  All copies are relative to the
216current basedn, unless a full dn is specified.  All attributes are
217copied, then an LDAP moddn() is performed.
218
219    copy uid=mahlon uid=bob
220    copy uid=mahlon ou=Others,dc=example,o=company
221    copy uid=mahlon,ou=People,dc=example,o=company uid=mahlon,ou=Others,dc=example,o=company
222
223aliased to: cp
224
225=item B<create>
226
227Create an entry from scratch.  Arguments are space separated objectClass
228names.  Possible objectClasses are derived automatically from the
229server, and will tab-complete.
230
231After the classes are specified, an editor will launch.  Required
232attributes are listed first, then optional attributes.  Optionals are
233commented out.  After the editor exits, the resulting LDIF is validated
234and added to the LDAP directory.
235
236    create top person organizationalPerson inetOrgPerson posixAccount
237
238aliased to: touch
239
240=item B<delete>
241
242Remove an entry from the directory.  Globbing is supported.
243All deletes are sanity-prompted.
244
245    delete uid=mahlon
246    delete uid=ma*
247
248aliased to: rm
249
250=item B<edit>
251
252Edit an entry in an external editor.  After the editor exits, the
253resulting LDIF is sanity checked, and changes are written to the LDAP
254directory.
255
256    edit uid=mahlon
257
258aliased to: vi
259
260=item B< env>
261
262 Show values for various runtime variables.
263
264=item B<grep>
265
266Search for arbitrary LDAP filters, and return matching dn results.
267The search string must be a valid LDAP filter.
268
269    grep uid=mahlon
270    grep uid=mahlon ou=People
271    grep -r (&(uid=mahlon)(objectClass=*))
272
273 aliased to: search
274
275=item B<list>
276
277List entries for the current basedn.  Globbing is supported.
278
279aliased to: ls
280
281    ls -l
282    ls -lR uid=mahlon
283    list uid=m*
284    list verbose
285
286In 'verbose' mode, descriptions are listed as well, if they exist.
287There are also some 'sane' long listings for common objectClass types.
288You can actually specify your own in your .shelldap.rc, like so:
289
290    ...
291    descmaps:
292        objectClass: attributename
293        posixAccount: gecos
294        posixGroup: gidNumber
295        ipHost: ipHostNumber
296        puppetClient: puppetclass
297
298=item B<mkdir>
299
300Creates a new 'organizationalUnit' entry.
301
302    mkdir containername
303    mkdir ou=whatever
304
305=item B<move>
306
307Move an entry to a different dn path.  Usage is identical to B<copy>.
308
309aliased to: mv
310
311=item B<passwd>
312
313If supported server side, change the password for a specified entry.
314The entry must have a 'userPassword' attribute.
315
316    passwd uid=mahlon
317
318=item B< pwd>
319
320Print the 'working directory' - aka, the current ldap basedn.
321
322=item B<setenv>
323
324Modify various runtime variables normally set from the command line.
325
326    setenv debug 1
327    export debug=1
328
329=item B<whoami>
330
331Show current auth credentials.  Unless you specified a binddn, this
332will just show an anonymous bind.
333
334=back
335
336=head1 TODO
337
338Referral support.  Currently, if you try to write to a replicant slave,
339you'll just get a referral.  It would be nice if shelldap automatically
340tried to follow it.
341
342For now, it only makes sense to connect to a master if you plan on doing
343any writes.
344
345"cd ../ou=SomewhereElse" doesn't work, but "cd ../../" does.  This is
346weird, as both should probably work.
347
348=head1 BUGS / LIMITATIONS
349
350There is no support for editing binary data.  If you need to edit base64
351stuff, just feed it to the regular ldapmodify/ldapadd/etc tools.
352
353=head1 AUTHOR
354
355Mahlon E. Smith <mahlon@martini.nu>
356
357=cut
358
359package LDAP::Shell;
360use strict;
361use warnings;
362use Term::ReadKey;
363use Term::Shell;
364use Digest::MD5;
365use Net::LDAP;
366use Net::LDAP::LDIF;
367use Data::Dumper;
368use File::Temp;
369use Algorithm::Diff;
370use Carp 'confess';
371use base 'Term::Shell';
372require Net::LDAP::Extension::SetPassword;
373
374my $conf = $main::conf;
375
376# make 'die' backtrace in debug mode
377$SIG{'__DIE__'} = \&Carp::confess if $conf->{'debug'};
378
379###############################################################
380#
381# UTILITY FUNCTIONS
382#
383###############################################################
384
385# initial shell behaviors
386#
387sub init
388{
389    my $self = shift;
390    $self->{'API'}->{'match_uniq'} = 0;
391
392    $self->{'editor'} = $ENV{'EDITOR'} || 'vi';
393    $self->{'env'}  = [ qw/ debug cacheage timeout / ];
394
395    # let autocomplete work with the '=' character
396    my $term = $self->term();
397    $term->Attribs->{'basic_word_break_characters'}  =~ s/=//m;
398    $term->Attribs->{'completer_word_break_characters'} =~ s/=//m;
399
400    # read in history
401    eval {
402        $term->history_truncate_file("$ENV{'HOME'}/.shelldap_history", 50);
403        $term->ReadHistory("$ENV{'HOME'}/.shelldap_history");
404    };
405
406    $self->{'root_dse'} = $self->ldap->root_dse();
407    if ( $conf->{'debug'} ) {
408        $self->{'schema'}   = $self->ldap->schema();
409        my @versions = 
410            @{ $self->{'root_dse'}->get_value('supportedLDAPVersion', asref => 1) };
411        print "Connected to $conf->{'server'}\n";
412        print "Supported LDAP version: ", ( join ', ', @versions ), "\n";
413        print "Cipher in use: ", $self->ldap()->cipher(), "\n";
414    }
415
416    # try an initial search and die if it doesn't work
417    # (bad baseDN)
418    my $s = $self->search();
419    die "LDAP baseDN error: ", $s->{'message'}, "\n" if $s->{'code'};
420
421    $self->{'schema'} = $self->ldap->schema();
422
423    # okay, now do an initial population of 'cwd'
424    # for autocomplete.
425    $self->update_entries();
426
427    # whew, okay.  Update prompt, wait for input!
428    $self->update_prompt();
429
430    return;
431}
432
433
434# get an ldap connection handle
435#
436sub ldap
437{
438    my $self = shift;
439
440    # use cached connection object if it exists
441    return $self->{'ldap'} if $self->{'ldap'};
442   
443    # fill in potentially missing info
444    die "No server specified.\n" unless $conf->{'server'};
445    if ( $conf->{'binddn'} && ! $conf->{'bindpass'} ) {
446        print "Bind password: ";
447        Term::ReadKey::ReadMode 2;
448        chomp($conf->{'bindpass'} = <STDIN>);
449        Term::ReadKey::ReadMode 0;
450        print "\n";
451    }
452
453    # make connection
454    my $ldap = Net::LDAP->new( $conf->{'server'} )
455        or die "Unable to connect to LDAP server '$conf->{'server'}': $!\n";
456
457    # secure connection options
458    if ( $conf->{'tls'} ) {
459        if ( $conf->{'tls_key'} ) {
460            $ldap->start_tls( 
461                verify     => 'require',
462                cafile     => $conf->{'tls_cacert'},
463                clientcert => $conf->{'tls_cert'},
464                clientkey  => $conf->{'tls_key'},
465                keydecrypt => sub {
466                    print "Key Passphrase: "; 
467                    Term::ReadKey::ReadMode 2;
468                    chomp(my $secret = <STDIN>);
469                    Term::ReadKey::ReadMode 0;
470                    print "\n";
471                    return $secret;
472                });
473        }
474        else {
475            $ldap->start_tls( verify => 'none' );
476        }
477    }
478
479    # bind
480    my $rv;
481    if ( $conf->{'binddn'} ) {
482        # authed
483        $rv = $ldap->bind(
484            $conf->{'binddn'},
485            password => $conf->{'bindpass'}
486        );
487    }
488    else {
489        # anon
490        $rv = $ldap->bind();
491    }
492
493    my $err = $rv->error();
494    if ( $rv->code() ) {
495        $err .= " (forgot the --tls flag?)"
496            if $err =~ /confidentiality required/i;
497        die "LDAP bind error: $err\n";
498    }
499
500    # offer to cache authentication info
501    # if we enter this conditional, we have successfully
502    # authed with the server (non anonymous), and
503    # we haven't cached anything in the past.
504    if ( $conf->{'binddn'} && ! -e $conf->{'confpath'} ) {
505        print "Would you like to cache your connection information? [Y/n]: ";
506        chomp( my $response = <STDIN> );
507        unless ( $response =~ /^n/i ) {
508            YAML::Syck::DumpFile( $conf->{'confpath'}, $conf );
509            chmod 0600, $conf->{'confpath'};
510            print "Connection info cached.\n";
511        }
512    }
513
514    $self->{'ldap'} = $ldap;
515    return $ldap;
516}
517
518# just return an LDIF object
519#
520sub ldif 
521{
522    my $self     = shift;
523    my $use_temp = shift;
524
525    # create tmpfile and link ldif object with it
526    if ( $use_temp ) {
527        my ( undef, $fname ) =
528          File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
529        $self->{'ldif'}    = Net::LDAP::LDIF->new( $fname, 'w', sort => 1 );
530        $self->{'ldif_fname'} = $fname;
531    }
532
533    # ldif -> stdout
534    else {
535        $self->{'ldif'} = Net::LDAP::LDIF->new( \*STDOUT, 'w', sort => 1 );
536    }
537
538    return $self->{'ldif'};
539}
540
541# load and return an Entry object from LDIF
542#
543sub load_ldif
544{
545    my $self = shift;
546
547    my $ldif =  Net::LDAP::LDIF->new( shift(), 'r' );
548    return unless $ldif;
549
550    my $e;
551    eval { $e = $ldif->read_entry(); };
552
553    return if $@;
554    return $e;
555}
556
557# given a filename, return an md5 checksum
558#
559sub chksum 
560{
561    my $self = shift;
562    my $file = shift or return;
563
564    my $md5 = Digest::MD5->new();
565    open F, $file or die "Unable to read temporary ldif: $!\n";
566    my $hash = $md5->addfile( *F )->hexdigest();
567    close F;
568
569    return $hash;
570}
571
572# prompt functions
573#
574sub prompt_str
575{
576    my $self = shift;
577    return $self->{'prompt'};
578}
579sub update_prompt 
580{
581    my $self = shift;
582    my $base = $self->base();
583
584    if ( length $base > 50 ) {
585        my $cwd_dn = $1 if $base =~ /^(.*?),/;
586        $self->{'prompt'} = "... $cwd_dn > ";
587    }
588    else {
589        my $prompt = $base;
590        $prompt =~ s/$conf->{'basedn'}/~/;
591        $self->{'prompt'} = "$prompt > ";
592    }
593    return;
594}
595
596# search base accessor
597#
598sub base 
599{
600    my $self = shift;
601    $self->{'base'} ||= $conf->{'basedn'};
602
603    # try and determine base automatically from rootDSE
604    #
605    unless ( $self->{'base'} ) {
606        my $base = $self->{'root_dse'}->{'asn'} || {};
607        $base = $base->{'attributes'}           || [];
608        $base = $base->[0]                      || {};
609        $base = $base->{'vals'}                 || [];
610        $conf->{'basedn'} = $base->[0];
611        $self->{'base'}   = $base->[0];
612    }
613    if ( $_[0] ) {
614        $self->{'base'} = $_[0];
615    }
616    return $self->{'base'};
617}
618
619# make sure a given rdn includes the current
620# base, making it a dn.
621# accepts a string reference.
622#
623sub rdn_to_dn 
624{
625    my $self = shift;
626    my $rdn  = shift or return;
627
628    return unless ref $rdn;
629
630    # allow cd to 'basedn' and cd to directories 'higher' in the tree
631    return if $$rdn =~ /$conf->{'basedn'}$/;
632
633    # auto fill in current base for deeper DNs
634    my ( $dn, $curbase ) = ( $$rdn, $self->base() );
635    $dn = "$$rdn," . $curbase unless $$rdn =~ /$curbase/i;
636
637    $$rdn = $dn;
638}
639
640# do a search on a dn to determine if it is valid.
641# returns a bool.
642#
643sub is_valid_dn 
644{
645    my $self = shift;
646    my $dn   = shift or return 0;
647
648    my $r = $self->search({ base => $dn });
649
650    return $r->{'code'} == 0 ? 1 : 0;
651}
652
653# perform an ldap search
654# return an hashref containing return code and
655# arrayref of Net::LDAP::Entry objects
656#
657sub search 
658{
659    my $self = shift;
660    my $opts = shift || {};
661
662    $opts->{'base'}   ||= $self->base(),
663    $opts->{'filter'} ||= '(objectClass=*)';
664    $opts->{'scope'}  ||= 'base';
665
666    my $s = $self->ldap->search(
667        base      => $opts->{'base'},
668        filter    => $opts->{'filter'},
669        scope     => $opts->{'scope'},
670        timelimit => $conf->{'timeout'},
671        typesonly => ! $opts->{'vals'},
672        attrs     => $opts->{'attrs'} || ['*']
673    );
674
675    my $rv = {
676        code      => $s->code(),
677        message   => $s->error(),
678        entries   => []
679    };
680
681    # since search is used just about everywhere, this seems like
682    # a pretty good place to check for connection errors.
683    #
684    # check for a lost connection, kill cached object so we
685    # try to reconnect on the next search.
686    #
687    $self->{'ldap'} = undef if $s->code() == 81;
688
689    $rv->{'entries'} =
690      $opts->{'scope'} eq 'base' ? [ $s->shift_entry() ] : [ $s->entries() ];
691
692    return $rv;
693}
694
695# update the autocomplete for entries
696# in the current base tree, respecting or creating cache.
697#
698sub update_entries 
699{
700    my $self = shift;
701    my %opts = @_;
702    my $base = lc( $self->base() );
703   
704    my $s = $opts{'search'} || $self->search({ scope => 'one' });
705
706    $self->{'cwd_entries'} = [];
707    return if $s->{'code'};
708
709    # setup cache object
710    $self->{'cache'} ||= {};
711    $self->{'cache'}->{ $base } ||= {};
712    $self->{'cache'}->{ $base } = {} if $opts{'clearcache'};
713    my $cache = $self->{'cache'}->{ $base };
714
715    my $now = time();
716    if ( ! exists $cache->{'entries'}
717        or $now - $cache->{'timestamp'} > $conf->{'cacheage'} )
718    {
719        $self->debug("Caching entries for $base\n");
720        foreach my $e ( @{ $s->{'entries'} } ) {
721            my $dn  = $e->dn();
722            my $rdn = $dn;
723            $rdn =~ s/,$base//i;  # remove base from display
724            push @{ $self->{'cwd_entries'} }, $rdn;
725        }
726        $cache->{'timestamp'} = $now;
727        $cache->{'entries'} = $self->{'cwd_entries'};
728    }
729    else {
730        $self->debug("Using cached lookups for $base\n");
731    }
732
733    $self->{'cwd_entries'} = $cache->{'entries'};
734    return;
735}
736
737# parse parent ('..') cn requests
738#
739sub parent_dn 
740{
741    my $self = shift;   
742    my $rdn  = shift or return;
743    return unless ref $rdn;
744
745    # FIXME: 'cd ../ou=somewhere' should work
746    my $dn = $self->base();
747    my $dotcount = $$rdn =~ s/\.\./\.\./g;
748    $dn =~ s/^.*?,// for 1 .. $dotcount;
749
750    $$rdn = $dn;
751}
752
753# given an array ref of shell-like globs,
754# make and return an LDAP filter object.
755#
756sub make_filter 
757{
758    my $self  = shift;
759    my $globs = shift or return;
760
761    return unless ref $globs eq 'ARRAY';
762    return unless scalar @$globs;
763
764    my $filter;
765    $filter = join '', map { "($_)" } @$globs;
766    $filter = '(|' . $filter . ')' if scalar @$globs > 1;
767    $filter = Net::LDAP::Filter->new( $filter );
768
769    if ( $filter ) {
770        $self->debug('Filter parsed as: ' . $filter->as_string() . "\n");
771    }
772    else {
773        print "Error parsing filter.\n";
774        return;
775    }
776
777    return $filter;
778}
779
780# little. yellow. different. better.
781#
782sub debug 
783{
784    my $self = shift;
785    return unless $conf->{'debug'};
786    print "\e[33m";
787    print shift();
788    print "\e[0m";
789    return;
790}
791
792# setup command autocompletes for
793# all commands that have the same possible values
794#
795sub autocomplete_cwd
796{
797    my $self = shift;
798    my $word = $_[0];
799
800    return sort @{ $self->{'cwd_entries'} };
801}
802
803sub comp_setenv
804{ 
805    my $self = shift;
806    return @{ $self->{'env'} };
807}
808
809sub comp_create
810{
811    my $self = shift;
812    return @{ $self->{'objectclasses'} } if $self->{'objectclasses'};
813
814    my @oc_data = $self->{'schema'}->all_objectclasses();
815    my @oc;
816    foreach my $o ( @oc_data ) {
817        push @oc, $o->{'name'};
818    }
819    @oc = sort @oc;
820    $self->{'objectclasses'} = \@oc;
821
822    return @oc;
823}
824
825{
826    no warnings;
827    no strict 'refs';
828
829    # command, alias
830    my %cmd_map = (
831        whoami => 'id',
832        list   => 'ls',
833        grep   => 'search',
834        edit   => 'vi',
835        delete => 'rm',
836        copy   => 'cp',
837        cat    => 'read',
838        move   => 'mv',
839        cd     => undef,
840        passwd => undef
841    );
842
843    # setup autocompletes
844    foreach ( %cmd_map ) {
845        next unless $_;
846        my $sub = "comp_$_";
847        *$sub   = \&autocomplete_cwd;
848    }
849    *comp_touch  = \&comp_create;
850    *comp_export = \&comp_setenv;
851
852    # setup alias subs
853    #
854    # Term::Shell has an alias_* feature, but
855    # it seems to work about 90% of the time.
856    # that last 10% is something of a mystery.
857    #
858    $cmd_map{'create'} = 'touch';
859    foreach my $cmd ( keys %cmd_map ) {
860        next unless defined $cmd_map{$cmd};
861        my $alias_sub = 'run_' . $cmd_map{$cmd};
862        my $real_sub  = 'run_' . $cmd;
863        *$alias_sub = \&$real_sub;
864    }
865}
866
867
868# Given an $arrayref, remove LDIF continuation wrapping,
869# effectively making each entry a single line.
870#
871sub unwrap {
872    my $array = shift;
873
874    my $i = 1;
875    while ( $i < scalar(@$array) ) {
876        if ( $array->[$i] =~ /^\s/ ) {
877            $array->[ $i - 1 ] =~ s/\n$//;
878            $array->[ $i ] =~ s/^\s//;
879            splice( @$array, $i - 1, 2, $array->[$i - 1] . $array->[$i] );
880        }
881        else {
882            $i++;
883        }
884    }
885}
886
887
888###############################################################
889#
890# SHELL METHODS
891#
892###############################################################
893
894# don't die on a newline
895#
896sub run_ { return; }
897
898# print shell debug actions
899#
900sub precmd
901{
902    my $self = shift;
903    my ( $handler, $cmd, $args ) = @_;
904
905    my $term = $self->term();
906    eval { $term->WriteHistory("$ENV{'HOME'}/.shelldap_history"); };
907
908    return unless $conf->{'debug'};
909    $self->debug( "$$cmd (" . ( join ' ', @$args ) . "), calling '$$handler'\n" );
910    return;
911} 
912
913sub run_cat 
914{
915    my $self  = shift;
916    my $dn    = shift;
917    my $attrs = \@_;
918    $attrs->[0] = '*' unless scalar @$attrs;
919
920    unless ( $dn ) {
921        print "No dn provided.\n";
922        return;
923    }
924
925    # support '.'
926    $dn = $self->base() if $dn eq '.';
927
928    # support globbing
929    my $s;
930    if ( $dn eq '*' ) {
931        $s = $self->search({
932            scope  => 'one',
933            vals   => 1,
934            attrs  => $attrs
935        });
936    }
937    elsif ( $dn =~ /\*/ ) {
938        $s = $self->search({
939            scope  => 'one',
940            vals   => 1,
941            filter => $dn,
942            attrs  => $attrs
943        });
944    }
945    else {
946        $self->rdn_to_dn( \$dn );
947        $s = $self->search({
948            base   => $dn,
949            vals   => 1,
950            attrs  => $attrs
951        });
952    }
953
954    if ( $s->{'code'} ) {
955        print $s->{'message'} . "\n";
956        return;
957    }
958
959    foreach my $e ( @{ $s->{'entries'} } ) {
960        $self->ldif->write_entry( $e );
961        print "\n";
962    }
963    return;
964}
965
966sub run_cd 
967{
968    my $self    = shift;
969    my $newbase = join ' ', @_;
970   
971    # support 'cd' going to root
972    $newbase ||= $conf->{'basedn'};
973
974    # support 'cd -'
975    if ( $newbase eq '-' ) {
976        $newbase = $self->{'previous_base'} || return;
977    }
978
979    # support '..'
980    if ( $newbase =~ /\.\./ ) {
981        $self->parent_dn( \$newbase );
982    }
983    else {
984        $self->rdn_to_dn( \$newbase );
985    }
986   
987    unless ( $self->is_valid_dn( $newbase ) ) {
988        print "No such object\n";
989        return;
990    }
991
992    # store old base
993    $self->{'previous_base'} = $self->base();
994
995    # update new base
996    $self->base( $newbase );
997
998    # get new 'cwd' listing
999    my $s = $self->search({ scope => 'one' });
1000    if ( $s->{'code'} ) {
1001        print "$s->{'message'}\n";
1002        return;
1003    }
1004    $self->update_entries( search => $s );
1005
1006    # reflect cwd change in prompt
1007    $self->update_prompt();
1008    return;
1009}
1010
1011sub run_clear
1012{
1013    my $self = shift;
1014    system('clear');
1015    return;
1016}
1017
1018sub run_copy
1019{
1020    my $self = shift;
1021    my ( $s_dn, $d_dn ) = @_;
1022
1023    unless ( $s_dn ) {
1024        print "No source dn provided.\n";
1025        return;
1026    }
1027    unless ( $d_dn ) {
1028        print "No destination dn provided.\n";
1029        return;
1030    }
1031
1032    my $s_rdn = $s_dn;
1033    $self->rdn_to_dn( \$s_dn );
1034    my $s = $self->search({ base => $s_dn, vals => 1 });
1035    unless ( $s->{'code'} == 0 ) {
1036        print "No such object\n";
1037        return;
1038    }
1039
1040    # see if we're copying the entry to a totally new path
1041    my ( $new_dn, $old_dn );
1042    ( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\w=]+),(.*)$/;
1043    if ( $new_dn ) {
1044        unless ( $self->is_valid_dn( $new_dn ) ) {
1045            print "Invalid destination.\n";
1046            return;
1047        }
1048    }
1049    else {
1050        $new_dn = $self->base();
1051    }
1052    $old_dn = $1 if $s_dn =~ /^[\w=]+,(.*)$/;
1053
1054    # get the source object
1055    my $e = ${ $s->{'entries'} }[0];
1056    $e->dn( $s_dn );
1057
1058    # add changes in new entry instead of modifying existing
1059    $e->changetype('add'); 
1060    $e->dn( "$d_dn,$new_dn" );
1061
1062    # get the unique attribute from the dn for modification
1063    # perhaps there is a better way to do this...?
1064    #
1065    my ( $uniqkey, $uniqval ) = ( $1, $2 )
1066      if $d_dn =~ /^([\.\w]+)(?:\s+)?=(?:\s+)?([\.\-\s\w]+),?/;
1067    unless ( $uniqkey && $uniqval ) {
1068        print "Unable to parse unique values from rdn.\n";
1069        return;
1070    }
1071    $e->replace( $uniqkey => $uniqval );
1072
1073    # update
1074    my $rv = $e->update( $self->ldap() );
1075    print $rv->error , "\n";
1076
1077    # clear caches
1078    $self->{'cache'}->{ $new_dn } = {} if $new_dn;
1079    $self->{'cache'}->{ $old_dn } = {} if $old_dn;
1080    $self->update_entries( clearcache => 1 );
1081    return;
1082}
1083
1084sub run_create
1085{
1086    my $self = shift;
1087    my @ocs  = @_;
1088
1089    my ( $fh, $fname ) =
1090        File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
1091
1092    # first print out the dn and object classes.
1093    print $fh 'dn: ???,', $self->base(), "\n";
1094    foreach my $oc ( sort @ocs ) {
1095        print $fh "objectClass: $oc\n";
1096    }
1097
1098    # now gather attributes for requested objectClasses
1099    #
1100    my ( %seen, @must_attr, @may_attr );
1101    foreach my $oc ( sort @ocs ) {
1102
1103        # required
1104        my @must = $self->{'schema'}->must( $oc );
1105        foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @must ) {
1106            next if $attr->{'name'} =~ /^objectclass$/i;
1107            next if $seen{ $attr->{'name'} };
1108            push @must_attr, $attr->{'name'};
1109            $seen{ $attr->{'name'} }++;
1110        }
1111
1112        # optional
1113        my @may  = $self->{'schema'}->may( $oc );
1114        foreach my $attr ( sort { $a->{'name'} cmp $b->{'name'} } @may ) {
1115            next if $attr->{'name'} =~ /^objectclass$/i;
1116            next if $seen{ $attr->{'name'} };
1117            push @may_attr, $attr->{'name'};
1118            $seen{ $attr->{'name'} }++;
1119        }
1120    }
1121
1122    # print attributes
1123    print $fh "$_: \n"   foreach @must_attr;
1124    print $fh "# $_: \n" foreach @may_attr;
1125    close $fh;
1126    my $hash_a = $self->chksum( $fname );
1127    system( $self->{'editor'}, $fname ) && die "Unable to launch editor: $!\n";
1128
1129    # hash compare
1130    my $hash_b = $self->chksum( $fname );
1131    if ( $hash_a eq $hash_b ) {
1132        print "Entry not modified.\n";
1133        unlink $fname;
1134        return;
1135    }
1136
1137    # load in LDIF
1138    my $ldif = Net::LDAP::LDIF->new( $fname, 'r', onerror => 'warn' );
1139    my $e   = $ldif->read_entry();
1140    unless ( $e ) {
1141        print "Unable to parse LDIF.\n";
1142        unlink $fname;
1143        return;
1144    }
1145    $e->changetype('add');
1146    my $rv = $e->update( $self->ldap() );
1147    print $rv->error(), "\n";
1148
1149    $self->update_entries( clearcache => 1 ) unless $rv->code();
1150
1151    unlink $fname;
1152    return;
1153}
1154
1155sub run_delete
1156{
1157    my $self = shift;
1158    my @DNs  = @_;
1159
1160    unless ( scalar @DNs ) {
1161        print "No dn specified.\n";
1162        return;
1163    }
1164
1165    my $filter;
1166    unless ( $DNs[0] eq '*' ) {
1167        $filter = $self->make_filter( \@DNs ) or return;
1168    }
1169
1170    my $s = $self->search({ scope => 'one', filter => $filter });
1171    if ( $s->{'code'} ) {
1172        print "$s->{'message'}\n";
1173        return;
1174    }
1175
1176    print "Are you sure? [N/y]: ";
1177    chomp( my $resp = <STDIN> );
1178    return unless $resp =~ /^y/i;
1179   
1180    foreach my $e ( @{ $s->{'entries'} } ) {
1181        my $dn = $e->dn();
1182        my $rv = $self->ldap->delete( $dn );
1183        print "$dn: ", $rv->error(), "\n";
1184    }
1185   
1186    $self->update_entries( clearcache => 1 );
1187    return;
1188}
1189
1190sub run_edit
1191{
1192    my $self = shift;
1193    my $dn   = join ' ', @_;
1194
1195    unless ( $dn ) {
1196        print "No dn provided.\n";
1197        return;
1198    }
1199
1200    # support '.'
1201    $dn = $self->base() if $dn eq '.';
1202
1203    $self->rdn_to_dn( \$dn );
1204    my $s = $self->search({ base => $dn, vals => 1 });
1205
1206    if ( $s->{'code'} ) {
1207        print $s->{'message'} . "\n";
1208        return;
1209    }
1210
1211    # fetch entry and write it out to disk
1212    my $e = ${ $s->{'entries'} }[0];
1213    my $ldif = $self->ldif(1);
1214    $ldif->write_entry( $e );
1215    $ldif->done();  # force sync
1216
1217    # load it into an array for potential comparison
1218    open LDIF, "$self->{'ldif_fname'}" or return;
1219    my @orig_ldif = <LDIF>;
1220    close LDIF;
1221
1222    # checksum it, then open it in an editor
1223    my $hash_a = $self->chksum( $self->{'ldif_fname'} );
1224    system( "$self->{'editor'} $self->{'ldif_fname'}" ) &&
1225        die "Unable to launch editor: $!\n";
1226
1227    # detect a total lack of change
1228    my $hash_b = $self->chksum( $self->{'ldif_fname'} );
1229    if ( $hash_a eq $hash_b ) {
1230        print "Entry not modified.\n";
1231        unlink $self->{'ldif_fname'};
1232        return;
1233    }
1234
1235    # check changes for basic LDIF validity
1236    my $new_e = $self->load_ldif( $self->{'ldif_fname'} );
1237    unless ( $new_e ) {
1238        print "Unable to parse LDIF.\n";
1239        unlink $self->{'ldif_fname'};
1240        return;
1241    }
1242
1243    # load changes into a new array for comparison
1244    open LDIF, "$self->{'ldif_fname'}" or return;
1245    my @new_ldif = <LDIF>;
1246    close LDIF;
1247
1248    $e->changetype('modify');
1249
1250    my $parse = sub {
1251        my $line = shift || $_;
1252        return if $line  =~ /^\#/; # ignore comments
1253        my ( $attr, $val ) = ( $1, $2 ) if $line =~ /^(.+?): (.*)$/;
1254        return unless $attr;
1255        return if index($attr, ':') != -1;  # ignore base64
1256        return ( $attr, $val );
1257    };
1258
1259    unwrap( \@orig_ldif );
1260    unwrap( \@new_ldif );
1261
1262    my $diff = Algorithm::Diff->new( \@orig_ldif, \@new_ldif );
1263    HUNK:
1264    while ( $diff->Next() ) {
1265        next if $diff->Same();
1266        my $diff_bit = $diff->Diff();
1267        my %seen_attr;
1268
1269        # total deletions
1270        if ( $diff_bit == 1 ) {
1271            foreach ( $diff->Items(1) ) {
1272                $self->debug("DELETE: $_");
1273                my ( $attr, $val ) = $parse->( $_ ) or next;
1274                $e->delete( $attr => [ $val ] );
1275            }
1276        }
1277
1278        # new insertions
1279        if ( $diff_bit == 2 ) {
1280            foreach ( $diff->Items(2) ) {
1281                $self->debug("INSERT: $_");
1282                my ( $attr, $val ) = $parse->( $_ ) or next;
1283                $e->add( $attr => $val );
1284            }
1285        }
1286
1287        # replacements
1288        if ( $diff_bit == 3 ) {
1289            foreach ( $diff->Items(2) ) {
1290                $self->debug("MODIFY: $_");
1291                my ( $attr, $val ) = $parse->( $_ ) or next;
1292
1293                my $cur_vals = $e->get_value( $attr, asref => 1 ) || [];
1294                my $cur_valcount = scalar @$cur_vals;
1295                next if $cur_valcount == 0; # should have been an 'add'
1296
1297                # replace immediately
1298                #
1299                if ( $cur_valcount == 1 ) {
1300                    $e->replace( $attr => $val );
1301                }
1302                else {
1303
1304                    # make sure the replace doesn't squash
1305                    # other attributes listed with the same name
1306                    #
1307                    next if $seen_attr{ $attr };
1308                    my @new_vals;
1309                    foreach my $line ( @new_ldif ) {
1310                        my ( $new_attr, $new_val ) = $parse->( $line ) or next;
1311                        next unless $new_attr eq $attr;
1312                        $seen_attr{ $attr }++;
1313                        push @new_vals, $new_val;
1314                    }
1315                    $e->replace( $attr => \@new_vals );
1316                }
1317            }
1318        }
1319
1320    }
1321
1322    unlink $self->{'ldif_fname'};
1323    my $rv = $e->update( $self->ldap );
1324    print $rv->error(), "\n";
1325
1326    return;
1327}
1328
1329sub run_env
1330{
1331    my $self = shift;
1332
1333    foreach ( sort @{ $self->{'env'} } ) {
1334        print "$_: ";
1335        print $conf->{$_} ? $conf->{$_} : 0; 
1336        print "\n"
1337    }
1338}
1339
1340sub run_grep
1341{
1342    my $self = shift;
1343    my ( $recurse, $filter, $base ) = @_;
1344
1345    # set 'recursion'
1346    unless ( $recurse && $recurse =~ /\-r|recurse/ ) {
1347        # shift args to the left
1348        ( $recurse, $filter, $base ) = ( undef, $recurse, $filter );
1349    }
1350
1351    $filter = Net::LDAP::Filter->new( $filter );
1352    unless ( $filter ) {
1353        print "Invalid search filter.\n";
1354        return;
1355    }
1356
1357    # support '*'
1358    $base = $self->base() if ! $base or $base eq '*';
1359
1360    unless ( $base ) {
1361        print "No search base specified.\n";
1362        return;
1363    }
1364    $self->rdn_to_dn( \$base );
1365
1366    $self->debug("Filter parsed as: " . $filter->as_string() . "\n");
1367
1368    my $s = $self->search(
1369        {
1370            scope  => $recurse ? 'sub' : 'one',
1371            base   => $base,
1372            filter => $filter
1373        }
1374    );
1375
1376    foreach my $e ( @{ $s->{'entries'} } ) {
1377        my $dn = $e->dn();
1378        print "$dn\n";
1379    }
1380
1381    return;
1382}
1383
1384# override internal help functions
1385# with pod2usage
1386#
1387sub run_help 
1388{
1389    return Pod::Usage::pod2usage(
1390        -exitval  => 'NOEXIT',
1391        -verbose  => 99,
1392        -sections => 'SHELL COMMANDS'
1393    );
1394}
1395
1396sub run_list
1397{
1398    my $self    = shift;
1399    my @filters = @_;
1400    my $base    = $self->base();
1401
1402    # setup filters
1403    my ( $flags, $filter );
1404    if ( scalar @filters ) {
1405        # support '-l' or '-R' listings
1406        if ( $filters[0] =~ /\-[lR]|verbose/ ) {
1407            $flags = shift @filters;
1408        }
1409       
1410        $filter = $self->make_filter( \@filters );
1411    }
1412
1413    # flag booleans
1414    my ( $recurse, $long );
1415    if ( $flags ) {
1416        $recurse = $flags =~ /R/;
1417        $long   = $flags =~ /l/;
1418    }
1419
1420    my $s = $self->search({
1421        scope  => $recurse ? 'sub' : 'one',
1422        vals   => 1,
1423        filter => $filter,
1424        attrs  => [ '*', 'hasSubordinates' ]
1425    });
1426    if ( $s->{'code'} ) {
1427        print "$s->{'message'}\n";
1428        return;
1429    }
1430
1431    # if an entry doesn't have a description field,
1432    # try and show some nice defaults for ls -l !
1433    #
1434    # objectClass -> Attribute to show
1435    #
1436    my %descs = %{
1437        $conf->{'descmaps'}
1438          || {
1439            posixAccount => 'gecos',
1440            posixGroup   => 'gidNumber',
1441            ipHost       => 'ipHostNumber',
1442          }
1443      };
1444
1445    # iterate and print
1446    #
1447    my $dn_count = 0;
1448    my $dn;
1449    foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) {
1450        $dn = $e->dn();
1451
1452        # if this entry is a container for other entries, append a
1453        # trailing slash.
1454        if ( $e->get_value('hasSubordinates') eq 'TRUE' ) {
1455            $dn .= '/';
1456        }
1457
1458        my $rdn = $dn;
1459        $rdn =~ s/,$base//i;
1460
1461        unless ( $long ) {
1462            $dn = $rdn;
1463            next;
1464        }
1465
1466        # show descriptions
1467        my $desc = $e->get_value('description');
1468        if ( $desc ) {
1469            $desc =~ s/\n.*//s; # 1st line only
1470            $dn .= " ($desc)";
1471        }
1472
1473        # no desc?  Try and infer something useful
1474        # to display.
1475        else {
1476
1477            # pull objectClasses, hash for lookup speed
1478            my @oc   = @{ $e->get_value( 'objectClass', asref => 1 ) || [] };
1479            my %ochash;
1480            map { $ochash{$_} = 1 } @oc;
1481
1482            foreach my $d_listing ( sort keys %descs ) {
1483                if ( exists $ochash{ $d_listing } ) {
1484                    my $str = $e->get_value( $descs{ $d_listing }, asref => 1 );
1485                    $dn .= ' (' . (join ', ', @$str) . ')' if $str && scalar @$str;
1486                }
1487                next;
1488            }
1489        }
1490    } 
1491    continue {
1492        print "$dn\n";
1493        $dn_count++;
1494    }
1495   
1496    print "\n$dn_count " .
1497        ( $dn_count == 1 ? 'object.' : 'objects.') .
1498        "\n" if $long;
1499    return;
1500}
1501
1502sub run_mkdir
1503{
1504    my $self = shift;
1505    my $dir  = join ' ', @_;
1506
1507    unless ( $dir ) {
1508        print "No 'directory' provided.\n";
1509        return;
1510    }
1511
1512    # normalize ou name, then pull uniq val back out.
1513    $dir = "ou=$dir" unless $dir =~ /^ou=/i;
1514    $self->rdn_to_dn( \$dir );
1515
1516    my $ou = $1
1517      if $dir =~ /^[\.\w]+(?:\s+)?=(?:\s+)?([\.\-\s\w]+),?/;
1518
1519    # add
1520    my $r = $self->ldap()->add( $dir, attr => [
1521        objectClass => [ 'top', 'organizationalUnit' ],
1522        ou        => $ou,
1523    ]);
1524
1525    print $r->error(), "\n";
1526    $self->update_entries( clearcache => 1 );
1527    return;
1528}
1529
1530sub run_move
1531{
1532    my $self = shift;
1533    my ( $s_dn, $d_dn ) = @_;
1534
1535    unless ( $s_dn ) {
1536        print "No source dn provided.\n";
1537        return;
1538    }
1539    unless ( $d_dn ) {
1540        print "No destination dn provided.\n";
1541        return;
1542    }
1543
1544    my $s_rdn = $s_dn;
1545    $self->rdn_to_dn( \$s_dn );
1546    unless ( $self->is_valid_dn( $s_dn ) ) {
1547        print "No such object\n";
1548        return;
1549    }
1550
1551    # see if we're moving the entry to a totally new path
1552    my ( $new_dn, $old_dn );
1553    ( $d_dn, $new_dn ) = ( $1, $2 ) if $d_dn =~ /^([\w=]+),(.*)$/;
1554    $old_dn = $1 if $s_dn =~ /^[\w=]+,(.*)$/;
1555
1556    my $rv = $self->ldap()->moddn(
1557        $s_dn,
1558        newrdn       => $d_dn,
1559        deleteoldrdn => 1,
1560        newsuperior  => $new_dn
1561    );
1562    print $rv->error(), "\n";
1563
1564    # clear caches
1565    $self->{'cache'}->{ $new_dn } = {} if $new_dn;
1566    $self->{'cache'}->{ $old_dn } = {} if $old_dn;
1567    $self->update_entries( clearcache => 1 );
1568    return;
1569}
1570
1571sub run_passwd 
1572{
1573    my $self = shift;
1574    my $dn   = shift || $self->base();
1575
1576    $self->{'root_dse'} ||= $self->ldap->root_dse();
1577
1578    my $pw_extension = '1.3.6.1.4.1.4203.1.11.1';
1579    unless ( $self->{'root_dse'}->supported_extension( $pw_extension ) ) {
1580        print "Sorry, password changes not supported by LDAP server.\n";
1581        return;
1582    }
1583
1584    # support '.'
1585    $dn = $self->base() if $dn eq '.';
1586
1587    $self->rdn_to_dn( \$dn );
1588    my $s = $self->search( { base => $dn, scope => 'base' } );
1589    if ( $s->{'code'} ) {
1590        print $s->{'message'}, "\n";
1591        return;
1592    }
1593    my $e = ${ $s->{'entries'} }[0];
1594
1595    unless ( $e->exists('userPassword') ) {
1596        print "No userPassword attribute for $dn\n";
1597        return;
1598    }
1599
1600    print "Changing password for $dn\n";
1601    Term::ReadKey::ReadMode 2;
1602    print "Enter new password: ";
1603    chomp( my $pw  = <STDIN> );
1604    print "\nRetype new password: ";
1605    chomp( my $pw2 = <STDIN> );
1606    print "\n";
1607    Term::ReadKey::ReadMode 0;
1608
1609    if ( $pw ne $pw2 ) {
1610        print "Sorry, passwords do not match.\n";
1611        return;
1612    }
1613
1614    my $rv = $self->ldap->set_password(
1615        user      => $dn,
1616        newpasswd => $pw
1617    );
1618
1619    if ( $rv->code() == 0 ) {
1620        print "Password updated successfully.\n";
1621    } else {
1622        print "Password error: " . $rv->error() . "\n";
1623    }
1624
1625    return;
1626}
1627
1628sub run_pwd 
1629{
1630    my $self = shift;
1631    print $self->base() . "\n";
1632    return;   
1633}
1634
1635sub run_setenv
1636{
1637    my $self = shift;
1638    my ( $key, $val ) = @_;
1639
1640    ( $key, $val ) = split /=/, $key if $key && ! defined $val;
1641    return unless $key && defined $val;
1642    $key = lc $key;
1643
1644    $conf->{$key} = $val;
1645    return;
1646}
1647
1648sub run_whoami
1649{
1650    my $self = shift;
1651    print $conf->{'binddn'} || 'anonymous bind';
1652    print "\n";
1653    return;
1654}
1655
1656###############################################################
1657#
1658# MAIN
1659#
1660###############################################################
1661
1662package main;
1663use strict;
1664use warnings;
1665
1666$0 = 'shelldap';
1667my $VERSION = '0.3';
1668
1669use Getopt::Long;
1670use YAML::Syck;
1671use Pod::Usage;
1672eval 'use Term::ReadLine::Gnu';
1673warn qq{Term::ReadLine::Gnu not installed.
1674Continuing, but shelldap is of limited usefulness without it.\n\n} if $@;
1675
1676# get config - rc file first, command line overrides
1677use vars '$conf';
1678$conf = load_config() || {};
1679Getopt::Long::GetOptions(
1680    $conf, 
1681    'server=s',
1682    'binddn=s',
1683    'basedn=s',
1684    'cacheage=i',
1685    'timeout=i',
1686    'tls_cacert=s',
1687    'tls_cert=s',
1688    'tls_key=s',
1689    'tls', 'debug',
1690     help => sub {
1691        Pod::Usage::pod2usage(
1692            -verbose => 1,
1693            -message => "\n$0 command line flags\n" . '-' x 65
1694        );
1695    }
1696);
1697
1698# defaults
1699$conf->{'confpath'} = "$ENV{'HOME'}/.shelldap.rc";
1700$conf->{'cacheage'} ||= 300;
1701$conf->{'timeout'}  ||= 10;
1702
1703# create and enter shell loop
1704my $shell = LDAP::Shell->new();
1705$shell->cmdloop();
1706
1707# load YAML config into global conf.
1708#
1709sub load_config
1710{
1711    my ( $d, $data );
1712
1713    my $confpath;
1714    my @confs = (
1715        "$ENV{'HOME'}/.shelldap.rc",
1716        '/usr/local/etc/shelldap.conf',
1717        '/etc/shelldap.conf',
1718    );
1719    foreach ( @confs ) {
1720        if ( -e $_ ) {
1721            $confpath = $_;
1722            last;
1723        }
1724    }
1725    $confpath or return undef;
1726
1727    open YAML, $confpath or return undef;
1728    do {
1729        local $/ = undef;
1730        $data = <YAML>;  # slurp!
1731    };
1732    close YAML;
1733
1734    eval { $conf = YAML::Syck::Load( $data ) };
1735    die "Invalid YAML in $confpath\n" if $@;
1736
1737    return $conf;
1738}
1739
1740## EOF
1741
Note: See TracBrowser for help on using the repository browser.