Add update code - make setup-ds.pl -u do updates

Updates are implemented in:
perl - code that plugs in to setup - scriptlets that are imported into
the setup perl interpreter and executed in process, giving access to all
of the packages and context provided by setup
ldif - applied to instances, in the same manner as ConfigFile directives
to setup
other - any executable file, shell script, etc. can be invoked, with a limited
amount of context from the setup process
An update directory is added to the package - /usr/share/dirsrv/update - this
directory contains the update files - the update filenames begin with two digits
and are executed in numeric order (00 first, then 01, etc. up to 99) which
should provide enough flexibility
In addition, there are 5 stages of update:
pre - invoked before any instance specific code
preinst, runinst, postinst - invoked for each instance
post - invoked after any instance specific code
Example files are provided which demonstrate how to get the context.
There are two different modes of operation for update:
online - must supply a bind dn and password for each instance - servers must
be up and running
offline - operates directly on the dse.ldif - servers must be shutdown first
A new section is added to the .inf file that can be passed in

[slapd-instancename]
RootDN = binddn
RootDNPwd = bindpw

The RootDN is optional - if not supplied, it will get the nsslapd-rootdn attribute from the dse.ldif for the instance.
I also fixed some problems with error messages.
The pam pta plugin entry was giving object class violations, so I added the
missing attributes - note that these are replaced by the plugin code when
the plugin is loaded - they are only needed during setup.

Fixed usage of $_ - $_ behaves like a dynamically scoped variable - which
means if you use it in an outer context, you cannot use it in an inner
context, even if it is used in a different function.  Rather than attempting
to figure out how to use $_ safely in lower level functions, I just removed
the use of it altogether, which also makes the code easier to read.
Reviewed by: nhosoi (Thanks!) - fixed minor issues found
Platforms tested: Fedora 11

1 files changed, 505 insertions, 0 deletions

diff --git a/ldap/admin/src/scripts/DSUpdate.pm.in b/ldap/admin/src/scripts/DSUpdate.pm.in
new file mode 100644
index 00000000..23f33899
--- /dev/null
+++ b/ldap/admin/src/scripts/DSUpdate.pm.in
@@ -0,0 +1,505 @@
+# 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) 2009 Red Hat, Inc.
+# All rights reserved.
+# END COPYRIGHT BLOCK
+#
+
+###########################
+#
+# This perl module provides code to update/upgrade directory
+# server shared files/config and instance specific files/config
+#
+##########################
+
+package DSUpdate;
+use Util;
+use Inf;
+use FileConn;
+use DSCreate qw(setDefaults createInstanceScripts);
+
+use File::Basename qw(basename dirname);
+
+# load perldap
+use Mozilla::LDAP::Conn;
+use Mozilla::LDAP::Utils qw(normalizeDN);
+use Mozilla::LDAP::API qw(ldap_explode_dn);
+use Mozilla::LDAP::LDIF;
+
+use Exporter;
+@ISA       = qw(Exporter);
+@EXPORT    = qw(updateDS);
+@EXPORT_OK = qw(updateDS);
+
+use strict;
+
+use SetupLog;
+
+# the default location of the updates - this is a subdir
+# of the directory server data dir (e.g. /usr/share/dirsrv)
+# the default directory is read-only - if you need to provide
+# additional updates, pass in additional update directories
+# to updateDS
+my $DS_UPDATE_PATH = "@updatedir@";
+
+my $PRE_STAGE = "pre";
+my $PREINST_STAGE = "preinst";
+my $RUNINST_STAGE = "runinst";
+my $POSTINST_STAGE = "postinst";
+my $POST_STAGE = "post";
+
+my @STAGES = ($PRE_STAGE, $PREINST_STAGE, $RUNINST_STAGE, $POSTINST_STAGE, $POST_STAGE);
+my @INSTSTAGES = ($PREINST_STAGE, $RUNINST_STAGE, $POSTINST_STAGE);
+
+# used to create unique package names for loading updates
+# from perl scriptlets
+my $pkgname = "Package00000000000";
+
+# generate and return a unique package name that is a 
+# subpackage of our current package
+sub get_pkgname {
+        return __PACKAGE__ . "::" . $pkgname++;
+}
+
+sub loadUpdates {
+    my $errs = shift;
+    my $dirs = shift;
+    my $mapinfo = shift || {};
+    my @updates; # a list of hash refs, sorted in execution order
+
+    for my $dir (@{$dirs}) {
+        for my $file (glob("$dir/*")) {
+            my $name = basename($file);
+            next if $name !~ /^\d\d/; # we only consider files that begin with two digits
+#            print "name = $name\n";
+            my $href = { path => $file, name => $name };
+            if ($file =~ /\.(pl|pm)$/) { # a perl file
+                my $fullpkg = get_pkgname(); # get a unique package name for the file
+                # this will import the update functions from the given file
+                # each file is given its own private namespace via the package
+                # directive below
+                # we have to use the eval because package takes a "bareword" -
+                # you cannot pass a dynamically constructed string to package
+                eval "package $fullpkg; require q($file)"; # "import" it
+                if ($@) {
+                    if ($@ =~ /did not return a true value/) {
+                        # this usually means the file did not end with 1; - just use it anyway
+                        debug(3, "notice: $file does not return a true value - using anyway\n");
+                    } else {
+                        # probably a syntax or other compilation error in the file
+                        # we can't safely use it, so log it and skip it
+                        push @{$errs}, ['error_loading_update', $file, $@];
+                        debug(0, "Error: not applying update $file. Error: $@\n");
+                        next; # skip this one
+                    }
+                }
+                # grab the hook functions from the update
+                for my $fn (@STAGES) {
+                    # this is some deep perl magic - see the perl Symbol Table
+                    # documentation for the gory details
+                    # We're trying to find if the file defined a symbol called
+                    # pre, run, post, etc. and if so, if that symbol is code
+                    no strict 'refs'; # turn off strict refs to use magic
+                    if (*{$fullpkg . "::" . $fn}{CODE}) {
+                        debug(5, "$file $fn is defined\n");
+                        # store the "function pointer" in the href for this update
+                        $href->{$fn} = \&{$fullpkg . "::" . $fn};
+                    } else {
+                        debug(5, "$file $fn is not defined or not a subroutine\n");
+                    }
+                }
+            } else { # some other type of file
+                $href->{file} = 1;
+            }
+            if ($mapinfo->{$file}) {
+                $href->{mapper} = $mapinfo->{$file}->{mapper};
+                $href->{infary} = $mapinfo->{$file}->{infary};
+            }
+            push @updates, $href;
+        }
+    }
+
+    # we have all the updates now - sort by the name
+    @updates = sort { $a->{name} cmp $b->{name} } @updates;
+
+    return @updates;
+}
+
+sub applyLDIFUpdate {
+    my ($upd, $conn, $inf) = @_;
+    my @errs;
+    my $path = ref($upd) ? $upd->{path} : $upd;
+
+    my $mapper;
+    my @infary;
+    # caller can set mapper to use and additional inf to use
+    if (ref($upd)) {
+        if ($upd->{mapper}) {
+            $mapper = new Inf($upd->{mapper});
+        }
+        if ($upd->{infary}) {
+            @infary = @{$upd->{infary}};
+        }
+    }
+    if (!$mapper) {
+        $mapper = new Inf("$inf->{General}->{prefix}@infdir@/dsupdate.map");
+    }
+    my $dsinf = new Inf("$inf->{General}->{prefix}@infdir@/slapd.inf");
+
+    $mapper = process_maptbl($mapper, \@errs, $inf, $dsinf, @infary);
+    if (!$mapper or @errs) {
+        return @errs;
+    }
+
+    getMappedEntries($mapper, [$path], \@errs, \&check_and_add_entry,
+                     [$conn]);
+
+    return @errs;
+}
+
+# process an update from an ldif file or executable
+# LDIF files only apply to instance updates, so ignore
+# LDIF files when not processing updates for instances
+sub processUpdate {
+    my ($upd, $inf, $configdir, $stage, $inst, $dseldif, $conn) = @_;
+    my @errs;
+    # $upd is either a hashref or a simple path name
+    my $path = ref($upd) ? $upd->{path} : $upd;
+    if ($path =~ /\.ldif$/) {
+        # ldif files are only processed during the runinst stage
+        if ($stage eq $RUNINST_STAGE) {
+            @errs = applyLDIFUpdate($upd, $conn, $inf);
+        }
+    } elsif (-x $path) {
+        # setup environment
+        $ENV{DS_UPDATE_STAGE} = $stage;
+        $ENV{DS_UPDATE_DIR} = $configdir;
+        $ENV{DS_UPDATE_INST} = $inst; # empty if not instance specific
+        $ENV{DS_UPDATE_DSELDIF} = $dseldif; # empty if not instance specific
+        $? = 0; # clear error condition
+        my $output = `$path 2>&1`;
+        if ($?) {
+            @errs = ('error_executing_update', $path, $?, $output);
+        }
+        debug(1, $output);
+    } else {
+        @errs = ('error_unknown_update', $path);
+    }
+
+    return @errs;
+}
+
+# 
+sub updateDS {
+    # get base configdir, instances from setup
+    my $setup = shift;
+    # get other info from inf
+    my $inf = $setup->{inf};
+    # directories containing updates to apply
+    my $dirs = shift || [];
+    my $mapinfo = shift;
+    # the default directory server update path
+    if ($inf->{slapd}->{updatedir}) {
+        push @{$dirs}, $inf->{General}->{prefix} . $inf->{slapd}->{updatedir};
+    } else {
+        push @{$dirs}, $inf->{General}->{prefix} . $DS_UPDATE_PATH;
+    }
+    my @errs;
+    my $force = $setup->{force};
+
+    my @updates = loadUpdates(\@errs, $dirs, $mapinfo);
+
+    if (@errs and !$force) {
+        return @errs;
+    }
+
+    if (!@updates) {
+        # nothing to do?
+        debug(0, "No updates to apply in @{$dirs}\n");
+        return @errs;
+    }
+
+    # run pre-update hooks
+    for my $upd (@updates) {
+        my @localerrs;
+        if ($upd->{$PRE_STAGE}) {
+            debug(1, "Running stage $PRE_STAGE update ", $upd->{path}, "\n");
+            @localerrs = &{$upd->{$PRE_STAGE}}($inf, $setup->{configdir});
+        } elsif ($upd->{file}) {
+            debug(1, "Running stage $PRE_STAGE update ", $upd->{path}, "\n");
+            @localerrs = processUpdate($upd, $inf, $setup->{configdir}, $PRE_STAGE);
+        }
+        if (@localerrs) {
+            push @errs, @localerrs;
+            if (!$force) {
+                return @errs;
+            }
+        }
+    }
+
+    # update each instance
+    for my $inst ($setup->getDirServers()) {
+        my @localerrs = updateDSInstance($inst, $inf, $setup->{configdir}, \@updates, $force);
+        if (@localerrs) {
+            # push array here because localerrs will likely be an array of
+            # array refs already
+            push @errs, @localerrs;
+            if (!$force) {
+                return @errs;
+            }
+        }
+    }
+
+    # run post-update hooks
+    for my $upd (@updates) {
+        my @localerrs;
+        if ($upd->{$POST_STAGE}) {
+            debug(1, "Running stage $POST_STAGE update ", $upd->{path}, "\n");
+            @localerrs = &{$upd->{$POST_STAGE}}($inf, $setup->{configdir});
+        } elsif ($upd->{file}) {
+            debug(1, "Running stage $POST_STAGE update ", $upd->{path}, "\n");
+            @localerrs = processUpdate($upd, $inf, $setup->{configdir}, $POST_STAGE);
+        }
+        if (@localerrs) {
+            push @errs, @localerrs;
+            if (!$force) {
+                return @errs;
+            }
+        }
+    }
+
+    return @errs;
+}
+
+sub updateDSInstance {
+    my ($inst, $inf, $configdir, $updates, $force) = @_;
+    my @errs;
+
+    my $dseldif = "$configdir/$inst/dse.ldif";
+
+    # get the information we need from the instance
+    delete $inf->{slapd}; # delete old data, if any
+    if (@errs = initInfFromInst($inf, $dseldif, $configdir, $inst)) {
+        return @errs;
+    }
+
+    # upgrade instance scripts
+    if (@errs = createInstanceScripts($inf, 1)) {
+        return @errs;
+    }
+
+    my $conn;
+    if ($inf->{General}->{UpdateMode} eq 'online') {
+        # open a connection to the directory server to upgrade
+        my $host = $inf->{General}->{FullMachineName};
+        my $port = $inf->{slapd}->{ServerPort};
+        # this says RootDN and password, but it can be any administrative DN
+        # such as the one used by the console
+        my $binddn = $inf->{$inst}->{RootDN} || $inf->{slapd}->{RootDN};
+        my $bindpw = $inf->{$inst}->{RootDNPwd};
+        my $certdir = $inf->{$inst}->{cert_dir} || $inf->{$inst}->{config_dir} || $inf->{slapd}->{cert_dir};
+
+        $conn = new Mozilla::LDAP::Conn({ host => $host, port => $port, bind => $binddn,
+                                          pswd => $bindpw, cert => $certdir, starttls => 1 });
+        if (!$conn) {
+            debug(0, "Could not open TLS connection to $host:$port - trying regular connection\n");
+            $conn = new Mozilla::LDAP::Conn({ host => $host, port => $port, bind => $binddn,
+                                              pswd => $bindpw });
+        }
+
+        if (!$conn) {
+            debug(0, "Could not open a connection to $host:$port\n");
+            return ('error_online_update', $host, $port, $binddn);
+        }
+    } else {
+        $conn = new FileConn($dseldif);
+        if (!$conn) {
+            debug(0, "Could not open a connection to $dseldif: $!\n");
+            return ('error_offline_update', $dseldif, $!);
+        }
+    }
+
+    # run pre-instance hooks first, then runinst hooks, then postinst hooks
+    # the DS_UPDATE_STAGE 
+    for my $stage (@INSTSTAGES) {
+        # always process these first in the runinst stage - we don't really have any
+        # other good way to process conditional features during update
+        if ($stage eq $RUNINST_STAGE) {
+            my @ldiffiles;
+            if ("@enable_pam_passthru@") {
+                push @ldiffiles, "$inf->{General}->{prefix}@templatedir@/template-pampta.ldif";
+            }
+            if ("@enable_bitwise@") {
+                push @ldiffiles, "$inf->{General}->{prefix}@templatedir@/template-bitwise.ldif";
+            }
+            if ("@enable_dna@") {
+                push @ldiffiles, "$inf->{General}->{prefix}@templatedir@/template-dnaplugin.ldif";
+                push @ldiffiles, $inf->{General}->{prefix} . $DS_UPDATE_PATH . "/dnaplugindepends.ldif";
+            }
+            for my $ldiffile (@ldiffiles) {
+                my @localerrs = processUpdate($ldiffile, $inf, $configdir, $stage,
+                                              $inst, $dseldif, $conn);
+                if (@localerrs) {
+                    push @errs, @localerrs;
+                    if (!$force) {
+                        $conn->close();
+                        return @errs;
+                    }
+                }
+            }
+        }
+        for my $upd (@{$updates}) {
+            my @localerrs;
+            if ($upd->{$stage}) {
+                debug(1, "Running stage $stage update ", $upd->{path}, "\n");
+                @localerrs = &{$upd->{$stage}}($inf, $inst, $dseldif, $conn);
+            } elsif ($upd->{file}) {
+                debug(1, "Running stage $stage update ", $upd->{path}, "\n");
+                @localerrs = processUpdate($upd, $inf, $configdir, $stage,
+                                           $inst, $dseldif, $conn);
+            }
+            if (@localerrs) {
+                push @errs, @localerrs;
+                if (!$force) {
+                    $conn->close();
+                    return @errs;
+                }
+            }
+        }
+    }
+
+    $conn->close();
+    return @errs;
+}
+
+# populate the fields in the inf we need to perform upgrade
+# tasks from the information in the instance dse.ldif and
+# other config
+sub initInfFromInst {
+    my ($inf, $dseldif, $configdir, $inst) = @_;
+    my $conn = new FileConn($dseldif, 1);
+    if (!$conn) {
+        debug(1, "Error: Could not open config file $dseldif: Error $!\n");
+        return ('error_opening_dseldif', $dseldif, $!);
+    }
+
+    my $dn = "cn=config";
+    my $entry = $conn->search($dn, "base", "(cn=*)", 0);
+    if (!$entry) {
+        $conn->close();
+        debug(1, "Error: Search $dn in $dseldif failed: ".$conn->getErrorString()."\n");
+        return ('error_finding_config_entry', $dn, $dseldif, $conn->getErrorString());
+    }
+
+    my $servid = $inst;
+    $servid =~ s/slapd-//;
+
+    $inf->{General}->{FullMachineName} = $entry->getValue("nsslapd-localhost");
+    $inf->{General}->{SuiteSpotUserID} = $entry->getValue("nsslapd-localuser");
+    $inf->{slapd}->{ServerPort} = $entry->getValue("nsslapd-port");
+    $inf->{slapd}->{ldapifilepath} = $entry->getValue("nsslapd-ldapifilepath");
+    if (!$inf->{$inst}->{RootDN}) {
+        $inf->{$inst}->{RootDN} || $entry->getValue('nsslapd-rootdn');
+    }
+    # we don't use this password - we either use {$inst} password or
+    # none at all
+    $inf->{slapd}->{RootDNPwd} = '{SSHA}dummy';
+    if (!$inf->{$inst}->{cert_dir}) {
+        $inf->{$inst}->{cert_dir} = $entry->getValue('nsslapd-certdir');
+    }
+    $inf->{slapd}->{cert_dir} = $inf->{$inst}->{cert_dir};
+    if (!$inf->{slapd}->{ldif_dir}) {
+        $inf->{slapd}->{ldif_dir} = $entry->getValue('nsslapd-ldifdir');
+    }
+    if (!$inf->{slapd}->{ServerIdentifier}) {
+        $inf->{slapd}->{ServerIdentifier} = $servid;
+    }
+    if (!$inf->{slapd}->{bak_dir}) {
+        $inf->{slapd}->{bak_dir} = $entry->getValue('nsslapd-bakdir');
+    }
+    if (!$inf->{slapd}->{config_dir}) {
+        $inf->{slapd}->{config_dir} = $configdir;
+    }
+    if (!$inf->{slapd}->{inst_dir}) {
+        $inf->{slapd}->{inst_dir} = $entry->getValue('nsslapd-instancedir');
+    }
+    if (!$inf->{slapd}->{run_dir}) {
+        $inf->{slapd}->{run_dir} = $entry->getValue('nsslapd-rundir');
+    }
+    if (!$inf->{slapd}->{schema_dir}) {
+        $inf->{slapd}->{schema_dir} = $entry->getValue('nsslapd-schemadir');
+    }
+    if (!$inf->{slapd}->{lock_dir}) {
+        $inf->{slapd}->{lock_dir} = $entry->getValue('nsslapd-lockdir');
+    }
+    if (!$inf->{slapd}->{log_dir}) {
+        # use the errorlog dir
+        my $logfile = $entry->getValue('nsslapd-errorlog');
+        if ($logfile) {
+            $inf->{slapd}->{log_dir} = dirname($logfile);
+        }
+    }
+    if (!$inf->{slapd}->{sasl_path}) {
+        $inf->{slapd}->{sasl_path} = $entry->getValue('nsslapd-saslpath');
+    }
+
+
+    # dn: cn=config,cn=ldbm database,cn=plugins,cn=config
+    $dn = "cn=config,cn=ldbm database,cn=plugins,cn=config";
+    $entry = $conn->search($dn, "base", "(cn=*)", 0);
+    if (!$entry) {
+        $conn->close();
+        debug(1, "Error: Search $dn in $dseldif failed: ".$conn->getErrorString()."\n");
+        return ('error_finding_config_entry', $dn, $dseldif, $conn->getErrorString());
+    }
+
+    if (!$inf->{slapd}->{db_dir}) {
+        $inf->{slapd}->{db_dir} = $entry->getValue('nsslapd-directory');
+    }
+
+    $conn->close(); # don't need this anymore
+
+    # set defaults for things we don't know how to find, after setting the values
+    # we do know how to find
+    return setDefaults($inf);
+}
+
+1;
+
+# emacs settings
+# Local Variables:
+# mode:perl
+# indent-tabs-mode: nil
+# tab-width: 4
+# End: