source: shelldap @ 78b2a48e07db

Revision 78b2a48e07db, 36.7 KB checked in by Mahlon E. Smith <mahlon@…>, 3 years ago (diff)

Combine multiple lines into a single one before displaying LDIF. Patch
by Gertjan Halkes <shelldap@…>.

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