[LDAPsh-cvs] ldapsh ldapsh,1.34,1.35
Status: Beta
Brought to you by:
rcorvalan
|
From: <j-d...@us...> - 2003-12-13 12:39:47
|
Update of /cvsroot/ldapsh/ldapsh
In directory sc8-pr-cvs1:/tmp/cvs-serv17973
Modified Files:
ldapsh
Log Message:
* Added 'create' and 'remove' commands.
Index: ldapsh
===================================================================
RCS file: /cvsroot/ldapsh/ldapsh/ldapsh,v
retrieving revision 1.34
retrieving revision 1.35
diff -C2 -d -r1.34 -r1.35
*** ldapsh 13 Dec 2003 10:22:48 -0000 1.34
--- ldapsh 13 Dec 2003 12:39:44 -0000 1.35
***************
*** 220,224 ****
use Data::Dumper qw(Dumper);
use Unicode::MapUTF8 qw(to_utf8 from_utf8);
! use subs qw(connect bind delete dump exit reset);
BEGIN {
--- 220,224 ----
use Data::Dumper qw(Dumper);
use Unicode::MapUTF8 qw(to_utf8 from_utf8);
! use subs qw(bind connect delete dump exit mkdir reset);
BEGIN {
***************
*** 1880,1883 ****
--- 1880,2220 ----
=head2 Changing entries
+ =head3 create
+
+ B<Synopsis>: C<create ['-d',|'-k',|'-m',|'-n',|'-q',|'-v',] 'E<lt>RDN|DNE<gt>' [,'E<lt>objectclassE<gt>' ...]>
+
+ Create a new LDIF file based on the specified distinguished named and object
+ classes. By default, the LDIF file will be populated with attributes to comply
+ with the schema supplied by the LDAP server. A text editor will then be invoked
+ on the LDIF file. In the file is subsequently edited, a new LDAP entry will be
+ created. Upon success, the LDIF file is deleted. Note: you must be sure to
+ create a valid LDIF file from the template that is provided to you. If you do
+ not, an entry cannot be created. If this error occurs, your invalid LDIF file
+ will be preserved for your convenience.
+
+ By default, the LDIF file is populated with all attributes specified in the schema
+ ('MUST' and 'MAY'). When the C<-m> parameter is given, only 'MUST' attributes
+ are included. The C<-n> parameter prevents schema-based population.
+ The C<-q> parameter suppresses informational comments about each attribute
+ while C<-v> prints verbose information about each attribute.
+
+ The C<-k> parameter prevents deletion of the LDIF file (regardless of success),
+ while C<-d> forces deletion (regardless of failure).
+
+ =cut
+
+ sub create(@) {
+ my @entries;
+ my @successes;
+ my %localArgs = ('d' => 0, 'k' => 0, 'm' => 0, 'n' => 0, 'q' => 0, 'v' => 0);
+
+ @ARGV = @_;
+ Getopt::Long::GetOptions(\%localArgs, keys %localArgs);
+
+ my $dn = shift(@ARGV);
+ unless ($dn) {
+ print STDERR "A distinguished name is required.\n";
+ return undef;
+ }
+
+ _bindneeded() or return undef;
+
+ # Set up temp file (LDIF)
+ require Net::LDAP::LDIF;
+ require File::Temp;
+
+ my ($fh, $tempfile) = File::Temp::tempfile('LDAPShell_vi_XXXXXXXXXX', SUFFIX => '.ldif');
+
+ # Print DN
+ my @parts = _splitdn($dn,2);
+ if (scalar(@parts) == 1) {
+ print $fh "dn: $dn, $CWD\n";
+ }
+ else {
+ print $fh "dn: $dn\n";
+ }
+ @parts = split('=',$parts[0]);
+ # Deal with objectclasses
+ my %attrs = ();
+ if (@ARGV > 0) {
+ $attrs{"objectclass"} = 1;
+ foreach (@ARGV) {
+ print $fh "objectclass: $_\n"; # caution: user might have supplied bad data
+ }
+ if (!$localArgs{n}) {
+ my $schema = $Globals->{LDAPCONN}{VALUE}->schema(dn=>"cn=Subschema");
+ if ($schema) {
+ foreach (@ARGV) {
+ my $objectclass = $_;
+ my @must = $schema->must($objectclass);
+ foreach (@must) {
+ my %attr = %$_;
+ my $name = lc($attr{name});
+ if (!$attrs{$name}) {
+ if ($localArgs{v}) {
+ print $fh "# MUST $objectclass \"$attr{desc}\" ($name)\n";
+ }
+ elsif (!$localArgs{q}) {
+ print $fh "# MUST\n";
+ }
+ if ("$name" eq "$parts[0]") {
+ print $fh "$name: $parts[1]\n";
+ }
+ else {
+ print $fh "$name: \n";
+ }
+ $attrs{$name} = 1;
+ }
+ }
+ }
+ if (!$localArgs{m}) {
+ foreach (@ARGV) {
+ my $objectclass = $_;
+ my @must = $schema->may($objectclass);
+ foreach (@must) {
+ my %attr = %$_;
+ my $name = lc($attr{name});
+ if (!$attrs{$name}) {
+ if ($localArgs{v}) {
+ print $fh "# MAY $objectclass \"$attr{desc}\" ($name)\n";
+ }
+ elsif (!$localArgs{q}) {
+ print $fh "# MAY\n";
+ }
+ if ("$name" eq "$parts[0]") {
+ print $fh "$name: $parts[1]\n";
+ }
+ else {
+ print $fh "$name: \n";
+ }
+ $attrs{$name} = 1;
+ }
+ }
+ }
+ }
+ }
+ else {
+ print $fh "# Server did not provide a schema (do you have permission?).\n";
+ print $fh "$parts[0]: $parts[1]\n";
+ }
+ }
+ }
+ if (!$attrs{$parts[0]}) {
+ print $fh "$parts[0]: $parts[1]\n";
+ }
+
+ close $fh;
+ my $mtime = (stat($tempfile))[9];
+ my $cleanup = 1; # success => unlink $tempfile by default
+
+ system($Globals->{EDITOR}{VALUE}, $tempfile);
+ if ( (stat($tempfile))[9] > $mtime ) {
+ my $ldif = Net::LDAP::LDIF->new($tempfile, "r", onerror => undef);
+ while (not $ldif->eof()) {
+ my $entry = $ldif->read_entry();
+ if ($ldif->error()) {
+ printf STDERR "Encountered error reading LDIF format: [[%s]]\n", $ldif->error();
+ if ($localArgs{d}) {
+ unlink $tempfile;
+ print STDERR "\n";
+ }
+ else {
+ print STDERR "LDIF stored in $tempfile\n\n";
+ }
+ return undef;
+ } elsif (defined($entry)) {
+ push(@entries, $entry);
+ }
+ }
+ if (@entries > 0) {
+ foreach (@entries) {
+ my $result = $Globals->{LDAPCONN}{VALUE}->add($_);
+ if ($result->is_error) {
+ printf STDERR qq{LDAP Error adding entry '%s'. Code:%s. Message:%s\n},
+ $_->dn, $result->code, $result->error;
+ # failure => keep by default
+ $cleanup = 0;
+ last;
+ }
+ push(@successes, $_);
+ }
+ }
+ }
+ else {
+ # no user mods => delete by default
+ }
+
+ if ($cleanup) {
+ if ($localArgs{k}) {
+ print STDERR "LDIF stored in $tempfile\n\n";
+ }
+ else {
+ unlink $tempfile;
+ }
+ }
+ else {
+ if ($localArgs{d}) {
+ unlink $tempfile;
+ }
+ else {
+ print STDERR "LDIF stored in $tempfile\n\n";
+ }
+ }
+
+ return @successes;
+ }
+
+ =head3 new
+
+ A synonym for L<create|create>.
+
+ =cut
+
+ sub new {
+ create(@_);
+ }
+
+ =head3 mkdir
+
+ A synonym for L<create|create>.
+
+ =cut
+
+ sub mkdir {
+ create(@_);
+ }
+
+ =head3 remove
+
+ B<Synopsis>: C<remove ['-a',] ['-f',] E<lt>expansionE<gt>>
+
+ Remove entries from the directory. Unless the C<-f> parameter is given, the
+ command will prompt you prior to starting and will stop if an error is
+ encountered. You may specify C<-r>, too, as a normal part of expansion (see
+ L<Expansion|expansion>). If C<-a> is specified, an attempt will be made to
+ delete leaf entries before their parent entries. Thus, to delete an entire
+ subdirectory hierarchy, you might try this:
+
+ cd 'cn=Old Directory Subtree'
+ remove '-ar'
+ cd '-'
+
+ =cut
+
+ sub remove {
+ my $localArgs = {};
+ my $entries = _entriesExpander [$localArgs, 'a', 'f'], @_;
+ return 0 unless defined $entries;
+ if (@$entries < 1) {
+ printf STDERR "No entries removed.\n";
+ return 0;
+ }
+ unless ($localArgs->{'f'}) {
+ return 0 unless _askBool("Delete ".scalar(@$entries)." entries?", 0);
+ }
+ if ($localArgs->{'a'}) { # sort
+ my %hash = map { join(',', reverse(_splitdn($_->dn, -1))) => $_ } @$entries;
+ foreach my $key (sort {$b cmp $a} keys %hash) {
+ my $entry = $hash{$key};
+ my $result = $Globals->{LDAPCONN}{VALUE}->delete($entry);
+ if ($result->is_error) {
+ printf STDERR qq{LDAP error removing entry '%s'. Code:%s. Message:%s\n},
+ $entry->dn, $result->code, $result->error;
+ return 0 unless $localArgs->{'f'};
+ }
+ }
+ }
+ else {
+ foreach my $entry (@$entries) {
+ my $result = $Globals->{LDAPCONN}{VALUE}->delete($entry);
+ if ($result->is_error) {
+ printf STDERR qq{LDAP error removing entry '%s'. Code:%s. Message:%s\n},
+ $entry->dn, $result->code, $result->error;
+ return 0 unless $localArgs->{'f'};
+ }
+ }
+ }
+ return 1;
+ }
+
+ =head3 rm
+
+ A synonym for L<remove|remove>.
+
+ =cut
+
+ sub rm {
+ remove(@_);
+ }
+
+ =head3 cp
+
+ B<Synopsis>: C<cp 'E<lt>from-expansionE<gt>'|'*' 'E<lt>toE<gt>'>
+
+ Copy an entry to a new DN or copy a set of entries to new locations in the
+ LDAP tree.
+
+ C<from-expansion> will be expanded in the usual way
+ (see L<Expansion|expansion>), with the addition that C<*> corresponds to
+ the filter C<(objectclass=*)>.
+
+ If C<to> parameter is an RDN, a single object will be copied to a new RDN within
+ the same level of the LDAP tree, and you will get an error if C<from-expansion>
+ expands to more than one object.
+
+ If C<to> is a DN, all the objects from C<from-expansion> will be be copied to
+ the new location, using C<to> as a base DN and retaining their old RDNs.
+ This makes it convenient to copy many objects.
+
+ B<TODO>: With C<to> being a DN, we may want to copy entire subtrees.
+ Currently we only copy objects as leaves.
+
+ =cut
+
+ sub cp($$) {
+ my ($from, $to) = @_;
+ $from = undef if ($from eq "*");
+ my $localcopy = (scalar(_splitdn($to,2)) == 1); #I.e $to is an RDN.
+ my $entries = _entriesExpander undef, $from;
+ if (scalar(@$entries) != 1 && $localcopy) {
+ print STDERR "$from does not exist or is ambiguous.\n";
+ return undef;
+ }
+
+ foreach my $entry (@$entries) {
+ my ($oldrdn, $oldpath) = _splitdn($entry->dn, 2);
+ my ($newrdn) = _splitdn($to, 2);
+ my ($old_rdn_attr, $old_rdn_attr_val) = split("=", $oldrdn, 2);
+ my ($new_rdn_attr, $new_rdn_attr_val) = split("=", $newrdn, 2);
+
+ my $newdn;
+ if ($localcopy) {
+ $newdn = "$newrdn,$oldpath";
+ } else {
+ $newdn = "$oldrdn,$to";
+ }
+
+ $entry->dn($newdn);
+
+ if ($localcopy) {
+ if ($entry->exists($old_rdn_attr)) {
+ $entry->delete($old_rdn_attr)
+ }
+ $entry->add($new_rdn_attr => $new_rdn_attr_val);
+ }
+
+ my $result = $Globals->{LDAPCONN}{VALUE}->add($entry);
+ if ($result->is_error) {
+ printf STDERR qq{LDAP Error updating entry '%s'. Code:%s. Message:%s\n},
+ $entry->dn, $result->code, $result->error;
+ return undef;
+ }
+ $Globals->{ENTRIES}{VALUE} = [];
+ }
+ }
+
+
+ =head2 Changing attributes
+
=head3 vi
***************
*** 2188,2258 ****
printf STDERR qq{Changed %s entries of %s. %s errors.\n}, $updcounter, scalar(@$entries), $errcounter;
return(not $errcounter);
- }
-
-
- =head3 cp
-
- B<Synopsis>: C<cp 'E<lt>from-expansionE<gt>'|'*' 'E<lt>toE<gt>'>
-
- Copy an entry to a new DN or copy a set of entries to new locations in the
- LDAP tree.
-
- C<from-expansion> will be expanded in the usual way
- (see L<Expansion|expansion>), with the addition that C<*> corresponds to
- the filter C<(objectclass=*)>.
-
- If C<to> parameter is an RDN, a single object will be copied to a new RDN within
- the same level of the LDAP tree, and you will get an error if C<from-expansion>
- expands to more than one object.
-
- If C<to> is a DN, all the objects from C<from-expansion> will be be copied to
- the new location, using C<to> as a base DN and retaining their old RDNs.
- This makes it convenient to copy many objects.
-
- B<TODO>: With C<to> being a DN, we may want to copy entire subtrees.
- Currently we only copy objects as leaves.
-
- =cut
-
- sub cp($$) {
- my ($from, $to) = @_;
- $from = undef if ($from eq "*");
- my $localcopy = (scalar(_splitdn($to,2)) == 1); #I.e $to is an RDN.
- my $entries = _entriesExpander undef, $from;
- if (scalar(@$entries) != 1 && $localcopy) {
- print STDERR "$from does not exist or is ambiguous.\n";
- return undef;
- }
-
- foreach my $entry (@$entries) {
- my ($oldrdn, $oldpath) = _splitdn($entry->dn, 2);
- my ($newrdn) = _splitdn($to, 2);
- my ($old_rdn_attr, $old_rdn_attr_val) = split("=", $oldrdn, 2);
- my ($new_rdn_attr, $new_rdn_attr_val) = split("=", $newrdn, 2);
-
- my $newdn;
- if ($localcopy) {
- $newdn = "$newrdn,$oldpath";
- } else {
- $newdn = "$oldrdn,$to";
- }
-
- $entry->dn($newdn);
-
- if ($localcopy) {
- if ($entry->exists($old_rdn_attr)) {
- $entry->delete($old_rdn_attr)
- }
- $entry->add($new_rdn_attr => $new_rdn_attr_val);
- }
-
- my $result = $Globals->{LDAPCONN}{VALUE}->add($entry);
- if ($result->is_error) {
- printf STDERR qq{LDAP Error updating entry '%s'. Code:%s. Message:%s\n},
- $entry->dn, $result->code, $result->error;
- return undef;
- }
- $Globals->{ENTRIES}{VALUE} = [];
- }
}
--- 2525,2528 ----
|