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