1 files changed, 389 insertions, 0 deletions
diff --git a/ldap/admin/src/scripts/FileConn.pm b/ldap/admin/src/scripts/FileConn.pm
new file mode 100644
index 00000000..c777b156
--- /dev/null
+++ b/ldap/admin/src/scripts/FileConn.pm
@@ -0,0 +1,389 @@
+# BEGIN COPYRIGHT BLOCK
+# This Program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; version 2 of the License.
+# 
+# This Program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+# 
+# You should have received a copy of the GNU General Public License along with
+# this Program; if not, write to the Free Software Foundation, Inc., 59 Temple
+# Place, Suite 330, Boston, MA 02111-1307 USA.
+# 
+# In addition, as a special exception, Red Hat, Inc. gives You the additional
+# right to link the code of this Program with code not covered under the GNU
+# General Public License ("Non-GPL Code") and to distribute linked combinations
+# including the two, subject to the limitations in this paragraph. Non-GPL Code
+# permitted under this exception must only link to the code of this Program
+# through those well defined interfaces identified in the file named EXCEPTION
+# found in the source code files (the "Approved Interfaces"). The files of
+# Non-GPL Code may instantiate templates or use macros or inline functions from
+# the Approved Interfaces without causing the resulting work to be covered by
+# the GNU General Public License. Only Red Hat, Inc. may make changes or
+# additions to the list of Approved Interfaces. You must obey the GNU General
+# Public License in all respects for all of the Program code and other code used
+# in conjunction with the Program except the Non-GPL Code covered by this
+# exception. If you modify this file, you may extend this exception to your
+# version of the file, but you are not obligated to do so. If you do not wish to
+# provide this exception without modification, you must delete this exception
+# statement from your version and license this file solely under the GPL without
+# exception. 
+# 
+# 
+# Copyright (C) 2007 Red Hat, Inc.
+# All rights reserved.
+# END COPYRIGHT BLOCK
+#
+# FileConn is a subclass of Mozilla::LDAP::Conn.  This class does
+# not use LDAP.  Instead, it operates on a given LDAP file, allowing
+# you to search, add, modify, and delete entries in the file.
+#
+package FileConn;
+
+use Mozilla::LDAP::Conn;
+use Mozilla::LDAP::API qw(:constant ldap_explode_dn ldap_err2string); # Direct access to C API
+use Mozilla::LDAP::Utils qw(normalizeDN);
+use Mozilla::LDAP::LDIF;
+
+require    Exporter;
+@ISA       = qw(Exporter Mozilla::LDAP::Conn);
+@EXPORT    = qw();
+@EXPORT_OK = qw();
+
+sub new {
+    my $class = shift;
+    my $filename = shift;
+    my $self = {};
+
+    $self = bless $self, $class;
+
+    $self->read($filename);
+
+    return $self;
+}
+
+sub getParentDN {
+    my $dn = shift;
+    my @rdns = ldap_explode_dn($dn, 0);
+    shift @rdns;
+    return join(',', @rdns);
+}
+
+sub read {
+    my $self = shift;
+    my $filename = shift;
+
+    if ($filename) {
+        $self->{filename} = $filename;
+    } else {
+        $filename = $self->{filename};
+    }
+
+    if (!$self->{filename}) {
+        return;
+    }
+
+    open( MYLDIF, "$filename" ) || die "Can't open $filename: $!";
+    my $in = new Mozilla::LDAP::LDIF(*MYLDIF);
+    while ($ent = readOneEntry $in) {
+        if (!$self->add($ent)) {
+            die "Error: could not add entry ", $ent->getDN(), ":", $self->getErrorString();
+        }
+    }
+    close( MYLDIF );
+}
+
+# return all nodes below the given node
+sub iterate {
+    my $self = shift;
+    my $dn = shift;
+    my $scope = shift;
+    my $callback = shift;
+    my $context = shift;
+    my $suppress = shift;
+    my $ndn = normalizeDN($dn);
+    my $children = $self->{$ndn}->{children};
+    if (($scope != LDAP_SCOPE_ONELEVEL) && $self->{$ndn}->{data} && !$suppress) {
+        &{$callback}($self->{$ndn}->{data}, $context);
+    }
+
+    if ($scope == LDAP_SCOPE_BASE) {
+        return;
+    }
+
+    for my $node (@{$children}) {
+        &{$callback}($node->{data}, $context);
+    }
+    if ($scope == LDAP_SCOPE_SUBTREE) {
+        for my $node (@{$children}) {
+            $self->iterate($node->{data}->getDN(), $scope, $callback, $context, 1);
+        }
+    }
+}
+
+sub writecb {
+    my $entry = shift;
+    my $fh = shift;
+    if (! $entry->getDN()) { # rootDSE requires special hack around perldap bug
+        my $ary = $entry->getLDIFrecords();
+        shift @$ary; # remove "dn"
+        shift @$ary; # remove the empty dn value
+        print $fh "dn:\n";
+        print $fh (Mozilla::LDAP::LDIF::pack_LDIF (78, $ary), "\n");
+    } else {
+        Mozilla::LDAP::LDIF::put_LDIF($fh, 78, $entry);
+    }
+}
+
+sub write {
+    my $self = shift;
+    my $filename = shift;
+
+    if ($filename) {
+        $self->{filename} = $filename;
+    } else {
+        $filename = $self->{filename};
+    }
+
+    if (!$self->{filename}) {
+        return;
+    }
+
+    open( MYLDIF, ">$filename" ) || die "Can't write $filename: $!";
+    $self->iterate("", LDAP_SCOPE_SUBTREE, \&writecb, \*MYLDIF);
+    close( MYLDIF );
+}
+
+sub setErrorCode {
+    my $self = shift;
+    $self->{lastErrorCode} = shift;
+}
+
+sub getErrorCode {
+    my $self = shift;
+    return $self->{lastErrorCode};
+}
+
+sub getErrorString {
+    my $self = shift;
+    return ($self->{lastErrorCode} ? ldap_err2string($self->{lastErrorCode}) : LDAP_SUCCESS);
+}
+
+#############################################################################
+# Print the last error code...
+#
+sub printError
+{
+  my ($self, $str) = @_;
+
+  $str = "LDAP error:" unless defined($str);
+  print "$str ", $self->getErrorString(), "\n";
+}
+
+sub close {
+    my $self = shift;
+    $self->write();
+}
+
+sub printcb {
+    my $entry = shift;
+
+    print $entry->getDN(), "\n";
+}
+
+sub print {
+    my $self = shift;
+    my $dn = shift;
+    my $scope = shift;
+    $self->iterate($dn, $scope, \&printcb);
+}
+
+# for each entry, call the user provided filter callback
+# with the entry and the user provided filter context
+# if the filtercb returns true, add the entry to the
+# list of entries to return
+sub searchcb {
+    my $entry = shift;
+    my $context = shift;
+    my $self = $context->[0];
+    my $filtercb = $context->[1];
+    my $filtercontext = $context->[2];
+    if (&{$filtercb}($entry, $filtercontext)) {
+        push @{$self->{entries}}, $entry;
+    }
+}
+
+sub matchall {
+    return 1;
+}
+
+sub matchAttrVal {
+    my $entry = shift;
+    my $context = shift;
+    my $attr = $context->[0];
+    my $val = $context->[1];
+
+    if ($val eq "*") {
+        return $entry->exists($attr);
+    }
+    return $entry->hasValue($attr, $val, 1);
+}   
+
+my $attrpat  = '[-;.:\w]*[-;\w]';
+
+# given a string filter, figure out which subroutine to 
+# use to match
+sub filterToMatchSub {
+    my $self = shift;
+    my ($basedn, $scope, $filter, $attrsonly, @rest) = @_;
+    my ($matchsub, $context);
+# do some filter processing
+    if (!$filter or ($filter eq "(objectclass=*)") or
+        ($filter eq "objectclass=*")) {
+        $matchsub = \&matchall;
+    } elsif ($filter =~ /^\(($attrpat)=(.+)\)$/o) {
+        push @{$context}, $1, $2;
+        $matchsub = \&matchAttrVal;
+#     } elsif ($filter =~ /^\(\|\(($attrpat)=(.+)\)\(($attrpat)=(.+)\)\)$/o) {
+#         $attr = $1;
+#         $val = $2;
+#         $attr1 = $1;
+#         $val1 = $2;
+#         $isand = 0;
+#     } elsif ($filter =~ /^\(\&\(($attrpat)=(.+)\)\(($attrpat)=(.+)\)\)$/o) {
+#         $attr = $1;
+#         $val = $2;
+#         $attr1 = $1;
+#         $val1 = $2;
+#         $isand = 1;
+#     } elsif ($filter =~ /^\(\|\(($attrpat)=(.+)\)\(($attrpat)=(.+)\)\)$/o) {) {
+# # 						   "(&(objectclass=nsBackendInstance)(|(nsslapd-suffix=$suffix)(nsslapd-suffix=$nsuffix)))");
+    }
+
+    $self->iterate($basedn, $scope, \&searchcb, [$self, $matchsub, $context]);
+}
+
+# simple searches only
+sub search {
+    my $self = shift;
+    my ($basedn, $scope, $filter, $attrsonly, @rest) = @_;
+    my $attrs;
+    if (ref($rest[0]) eq "ARRAY") {
+        $attrs = $rest[0];
+    } elsif (scalar(@rest) > 0) {
+        $attrs = \@rest;
+    }
+
+    $scope = Mozilla::LDAP::Utils::str2Scope($scope);
+
+    $self->{entries} = [];
+
+    my $ndn = normalizeDN($basedn);
+    if (!exists($self->{$ndn})) {
+        $self->setErrorCode(LDAP_NO_SUCH_OBJECT);
+        return undef;
+    }
+
+    $self->setErrorCode(0);
+    if (ref($filter) eq 'CODE') {
+        $self->iterate($basedn, $scope, \&searchcb, [$self, $filter, $attrsonly]);
+    } else {
+        $self->filterToMatchSub($basedn, $scope, $filter, $attrsonly);
+    }
+
+    return $self->nextEntry();
+}
+
+sub nextEntry {
+    my $self = shift;
+    return shift @{$self->{entries}};
+}
+
+sub add {
+    my $self = shift;
+    my $entry = shift;
+    my $dn = $entry->getDN();
+    my $ndn = normalizeDN($dn);
+    my $parentdn = getParentDN($dn);
+    my $nparentdn = normalizeDN($parentdn);
+
+    $self->setErrorCode(0);
+    if (exists($self->{$ndn})) {
+        $self->setErrorCode(LDAP_ALREADY_EXISTS);
+        return 0;
+    }
+    if ($nparentdn && !exists($self->{$nparentdn})) {
+        $self->setErrorCode(LDAP_NO_SUCH_OBJECT);
+        return 0;
+    }
+    # each hash entry has two keys
+    # data is the actual Entry
+    # children is the array ref of the one level children of this dn
+    $self->{$ndn}->{data} = $entry;
+    push @{$self->{$nparentdn}->{children}}, $self->{$ndn};
+
+    return 1;
+}
+
+sub update {
+    my $self = shift;
+    my $entry = shift;
+    my $dn = $entry->getDN();
+    my $ndn = normalizeDN($dn);
+
+    $self->setErrorCode(0);
+    if (!exists($self->{$ndn})) {
+        $self->setErrorCode(LDAP_NO_SUCH_OBJECT);
+        return 0;
+    }
+
+    $self->{$ndn}->{data} = $entry;
+
+    return 1;
+}
+
+sub delete {
+    my $self = shift;
+    my $dn = shift;
+
+    if (ref($dn)) {
+        $dn = $dn->getDN(); # an Entry
+    }
+    my $ndn = normalizeDN($dn);
+
+    $self->setErrorCode(0);
+    if (!exists($self->{$ndn})) {
+        $self->setErrorCode(LDAP_NO_SUCH_OBJECT);
+        return 0;
+    }
+
+    if (@{$self->{$ndn}->{children}}) {
+        $self->setErrorCode(LDAP_NOT_ALLOWED_ON_NONLEAF);
+        return 0;
+    }
+
+    # delete the data associated with this node
+    delete $self->{$ndn}->{data};
+    delete $self->{$ndn}->{children};
+
+    my $parentdn = getParentDN($dn);
+    my $nparentdn = normalizeDN($parentdn);
+    # delete this node from its parent
+    for (my $ii = 0; $ii < @{$self->{$nparentdn}->{children}}; ++$ii) {
+        # find matching hash ref in parent's child list
+        if ($self->{$nparentdn}->{children}->[$ii] eq $self->{$ndn}) {
+            # remove that element from the array
+            splice @{$self->{$nparentdn}->{children}}, $ii, 1;
+            # done - should only ever be one matching child
+            last;
+        }
+    }
+
+    # delete this node
+    delete $self->{$ndn};
+
+    return 0;
+}
+
+1;