[Fedora-directory-commits] ldapserver/ldap/admin/src/scripts DSMigration.pm.in, NONE, 1.1 Migration.pm.in, NONE, 1.1 migrate-ds.pl.in, NONE, 1.1 migrate-ds.res, NONE, 1.1 Setup.pm.in, 1.7, 1.8 SetupLog.pm, 1.1, 1.2 Util.pm.in, 1.3, 1.4 setup-ds.pl.in, 1.2, 1.3 setup-ds.res.in, 1.4, 1.5
Richard Allen Megginson (rmeggins)
fedora-directory-commits at redhat.com
Fri Jun 29 21:12:23 UTC 2007
Author: rmeggins
Update of /cvs/dirsec/ldapserver/ldap/admin/src/scripts
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv15196/ldapserver/ldap/admin/src/scripts
Modified Files:
Setup.pm.in SetupLog.pm Util.pm.in setup-ds.pl.in
setup-ds.res.in
Added Files:
DSMigration.pm.in Migration.pm.in migrate-ds.pl.in
migrate-ds.res
Log Message:
Resolves: bug 245815
Description: DS Admin Migration framework
Reviewed by: nhosoi (Thanks!)
Fix Description: Created a Migration class that is very similar to the Setup class - to act as a sort of global context for the migration process. Moved most of the guts of migrateTo11 into the new DSMigration class and the new migrate-ds.pl - we should deprecate migrateTo11 in favor of migrate-ds.pl. I had to enhance the check_and_add_entry function to handle pseudo-LDIF change records - pseudo because mozilla perldap LDIF has no real LDIF change record support.
Fixed a bug in create_instance.c - creating an instance without starting it was not working if the port number of an existing directory server was supplied.
Added a new method createDSInstance to Util - this just wraps ds_newinst.pl for now.
Platforms tested: RHEL4
Doc: Yes. We will need to document the migration procedures.
Flag day: Yes. Autotool file changes.
--- NEW FILE DSMigration.pm.in ---
# 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
#
###########################
#
# This perl module provides a way to set up a new installation after
# the binaries have already been extracted. This is typically after
# using native packaging support to install the package e.g. RPM,
# pkgadd, depot, etc. This script will show the license, readme,
# dsktune, then run the usual setup pre and post installers.
#
##########################
package DSMigration;
use Migration;
use Util;
use Inf;
# tempfiles
use File::Temp qw(tempfile tempdir);
# 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(migrateDS);
@EXPORT_OK = qw(migrateDS);
use strict;
use SetupLog;
use Util;
# these are the attributes for which we will always use
# the new value, or which do not apply anymore
my %ignoreOld =
(
'nsslapd-errorlog' => 'nsslapd-errorlog',
'nsslapd-accesslog' => 'nsslapd-accesslog',
'nsslapd-auditlog' => 'nsslapd-auditlog',
'nskeyfile' => 'nsKeyfile',
'nscertfile' => 'nsCertfile',
'nsslapd-pluginpath' => 'nsslapd-pluginPath',
'nsslapd-plugintype' => 'nsslapd-pluginType',
'nsslapd-pluginversion' => 'nsslapd-pluginVersion',
'nsslapd-plugin-depends-on-named' => 'nsslapd-plugin-depends-on-named',
# these are new attrs that we should just pass through
'nsslapd-schemadir' => 'nsslapd-schemadir',
'nsslapd-lockdir' => 'nsslapd-lockdir',
'nsslapd-tmpdir' => 'nsslapd-tmpdir',
'nsslapd-certdir' => 'nsslapd-certdir',
'nsslapd-ldapifilepath' => 'nsslapd-ldapifilepath',
'nsslapd-ldapilisten' => 'nsslapd-ldapilisten',
'nsslapd-ldapiautobind' => 'nsslapd-ldapiautobind',
'nsslapd-ldapimaprootdn' => 'nsslapd-ldapimaprootdn',
'nsslapd-ldapimaptoentries' => 'nsslapd-ldapimaptoentries',
'nsslapd-ldapiuidnumbertype' => 'nsslapd-ldapiuidnumbertype',
'nsslapd-ldapigidnumbertype' => 'nsslapd-ldapigidnumbertype',
'nsslapd-ldapientrysearchbase' => 'nsslapd-ldapientrysearchbase',
'nsslapd-ldapiautodnsuffix' => 'nsslapd-ldapiautodnsuffix'
);
# these are the attributes for which we will always use
# the old value
my %alwaysUseOld =
(
'aci' => 'aci'
);
my $pkgname; # global used in several different places - set in migrateDS
my $oldsroot; # global used in several different places - set in migrateDS
sub getNewDbDir {
my ($ent, $attr, $inst) = @_;
my %objclasses = map { lc($_) => $_ } $ent->getValues('objectclass');
my $cn = $ent->getValues('cn');
my $newval;
if ($objclasses{nsbackendinstance}) {
$newval = "@localstatedir@/lib/$pkgname/$inst/db/$cn";
} elsif (lc $cn eq 'config') {
$newval = "@localstatedir@/lib/$pkgname/$inst/db";
} elsif (lc $cn eq 'changelog5') {
$newval = "@localstatedir@/lib/$pkgname/$inst/cldb";
}
debug(2, "New value [$newval] for attr $attr in entry ", $ent->getDN(), "\n");
return $newval;
}
sub migrateCredentials {
my ($ent, $attr, $inst) = @_;
my $oldval = $ent->getValues($attr);
debug(3, "Executing migratecred -o $oldsroot/$inst -n @instconfigdir@/$inst -c $oldval . . .\n");
my $newval = `migratecred -o $oldsroot/$inst -n @instconfigdir@/$inst -c $oldval`;
debug(3, "Converted old value [$oldval] to new value [$newval] for attr $attr in entry ", $ent->getDN(), "\n");
return $newval;
}
# these are attributes that we have to transform from
# the old value to the new value (e.g. a pathname)
# The key of this hash is the attribute name. The value
# is an anonymous sub which takes two arguments - the entry
# and the old value. The return value of the sub is
# the new value
my %transformAttr =
(
'nsslapd-directory' => \&getNewDbDir,
'nsslapd-db-logdirectory' => \&getNewDbDir,
'nsslapd-changelogdir' => \&getNewDbDir,
'nsds5replicacredentials' => \&migrateCredentials,
'nsmultiplexorcredentials' => \&migrateCredentials
);
sub copyDatabaseDirs {
my $srcdir = shift;
my $destdir = shift;
if (-d $srcdir && ! -d $destdir) {
debug(1, "Copying database directory $srcdir to $destdir\n");
system ("cp -p -r $srcdir $destdir") == 0 or
die "Could not copy database directory $srcdir to $destdir: $?";
} elsif (! -d $srcdir) {
die "Error: database directory $srcdir does not exist";
} else {
debug(1, "The destination directory $destdir already exists, copying files/dirs individually\n");
foreach my $file (glob("$srcdir/*")) {
debug(3, "Copying $file to $destdir\n");
if (-f $file) {
system ("cp -p $file $destdir") == 0 or
die "Error: could not copy $file to $destdir: $!";
} elsif (-d $file) {
system ("cp -p -r $file $destdir") == 0 or
die "Error: could not copy $file to $destdir: $!";
}
}
}
}
sub copyDatabases {
my $oldroot = shift;
my $inst = shift;
my $newdbdir = shift;
# global config and instance specific config are children of this entry
my $basedbdn = normalizeDN("cn=ldbm database,cn=plugins,cn=config");
# get the list of databases, their index and transaction log locations
my $fname = "$oldroot/$inst/config/dse.ldif";
open( DSELDIF, "$fname" ) || die "Can't open $fname: $!";
my $in = new Mozilla::LDAP::LDIF(*DSELDIF);
my $targetdn = normalizeDN("cn=config,cn=ldbm database,cn=plugins,cn=config");
while (my $ent = readOneEntry $in) {
next if (!$ent->getDN()); # just skip root dse
# look for the one level children of $basedbdn
my @rdns = ldap_explode_dn($ent->getDN(), 0);
my $parentdn = normalizeDN(join(',', @rdns[1..$#rdns]));
if ($parentdn eq $basedbdn) {
my $cn = $ent->getValues('cn');
my %objclasses = map { lc($_) => $_ } $ent->getValues('objectclass');
if ($cn eq 'config') { # global config
debug(1, "Found ldbm database plugin config entry ", $ent->getDN(), "\n");
my $dir = $ent->getValues('nsslapd-directory');
my $homedir = $ent->getValues('nsslapd-db-home-directory');
my $logdir = $ent->getValues('nsslapd-db-logdirectory');
debug(1, "old db dir = $dir homedir = $homedir logdir = $logdir\n");
my $srcdir = $homedir || $dir || "$oldroot/$inst/db";
copyDatabaseDirs($srcdir, $newdbdir);
copyDatabaseDirs($logdir, $newdbdir) if ($logdir && $logdir ne $srcdir);
} elsif ($objclasses{nsbackendinstance}) {
debug(1, "Found ldbm database instance entry ", $ent->getDN(), "\n");
my $dir = $ent->getValues('nsslapd-directory');
# the default db instance directory is
# $oldroot/$inst/$cn
debug(1, "old instance $cn dbdir $dir\n");
my $srcdir = $dir || "$oldroot/$inst/db/$cn";
copyDatabaseDirs($srcdir, "$newdbdir/$cn");
} # else just ignore for now
}
}
close DSELDIF;
}
sub copyChangelogDB {
my $oldroot = shift;
my $inst = shift;
my $newdbdir = shift;
# changelog config entry
my $cldn = normalizeDN("cn=changelog5, cn=config");
my $fname = "$oldroot/$inst/config/dse.ldif";
open( DSELDIF, "$fname" ) || die "Can't open $fname: $!";
my $in = new Mozilla::LDAP::LDIF(*DSELDIF);
while (my $ent = readOneEntry $in) {
my $targetdn = normalizeDN($ent->getDN());
if ($targetdn eq $cldn) {
my $oldcldir = $ent->getValues('nsslapd-changelogdir');
debug(1, "old cldb dir = $oldcldir\n");
my $srcdir = $oldcldir || "$oldroot/$inst/cldb";
copyDatabaseDirs($srcdir, $newdbdir);
last;
}
}
close DSELDIF;
}
sub fixAttrsInEntry {
my ($ent, $inst) = @_;
for my $attr (keys %{$ent}) {
my $lcattr = lc $attr;
if ($transformAttr{$lcattr}) {
$ent->setValues($attr, &{$transformAttr{$lcattr}}($ent, $attr, $inst));
}
}
}
sub mergeEntries {
my ($old, $new, $inst) = @_;
my %inoldonly; # attrs in old entry but not new one
my %innewonly; # attrs in new entry but not old one
my @attrs; # attrs common to old and new
# if the attribute exists in the old entry but not the new one
# we should probably add it (checking for special cases first)
# if the attribute exists in the new entry but not the old one
# we might have to delete it from the new entry
# first, get a list of all attributes
foreach my $attr (keys %{$old}) {
if (! $new->exists($attr)) {
$inoldonly{$attr} = $attr;
} else {
push @attrs, $attr;
}
}
foreach my $attr (keys %{$new}) {
if (! $old->exists($attr)) {
$innewonly{$attr} = $attr;
}
}
# iterate through the attr lists
my $cn = lc $new->getValues("cn");
foreach my $attr (keys %inoldonly, keys %innewonly, @attrs) {
my $lcattr = lc $attr;
if ($ignoreOld{$lcattr}) {
next; # use new value or just omit if attr is obsolete
} elsif ($transformAttr{$lcattr}) {
# only transform if the value is in the old entry
if (!$innewonly{$attr}) {
$new->setValues($attr, &{$transformAttr{$lcattr}}($old, $attr, $inst));
}
} elsif ($cn eq "internationalization plugin" and $lcattr eq "nsslapd-pluginarg0") {
next; # use the new value of this path name
} elsif ($cn eq "referential integrity postoperation" and $lcattr eq "nsslapd-pluginarg1") {
next; # use the new value of this path name
} elsif ($innewonly{$attr}) {
$new->remove($attr); # in new but not old - just remove it
} else {
$new->setValues($attr, $old->getValues($attr)); # use old value
}
}
}
sub mergeDseLdif {
my $oldroot = shift;
my $inst = shift;
my $ent;
# first, read in old file
my %olddse; # map of normalized DN to Entry
my @olddns; # the DNs in their original order
my $fname = "$oldroot/$inst/config/dse.ldif";
open( OLDDSELDIF, $fname ) || die "Can't open $fname: $!";
my $in = new Mozilla::LDAP::LDIF(*OLDDSELDIF);
while ($ent = readOneEntry $in) {
my $dn = normalizeDN($ent->getDN());
push @olddns, $dn;
$olddse{$dn} = $ent;
}
close OLDDSELDIF;
# next, read in new file
my %newdse; # map of normalized DN to Entry
my @newdns; # the DNs in their original order that are not in olddns
$fname = "@instconfigdir@/$inst/dse.ldif";
open( NEWDSELDIF, $fname ) || die "Can't open $fname: $!";
$in = new Mozilla::LDAP::LDIF(*NEWDSELDIF);
while ($ent = readOneEntry $in) {
my $dn = normalizeDN($ent->getDN());
$newdse{$dn} = $ent;
if (! exists $olddse{$dn}) {
push @newdns, $dn;
}
}
close NEWDSELDIF;
# temp file for new, merged dse.ldif
my ($dsefh, $tmpdse) = tempfile(SUFFIX => '.ldif');
# now, compare entries
# if the entry exists in the old tree but not the new, add it
# if the entry exists in the new tree but not the old, delete it
# otherwise, merge the entries
# @olddns contains the dns in the old dse.ldif, including ones that
# may also be in the new dse.ldif
# @newdns contains dns that are only in the new dse.ldif
for my $dn (@olddns, @newdns) {
my $oldent = $olddse{$dn};
my $newent = $newdse{$dn};
my $outputent;
if ($oldent && !$newent) {
# may have to fix up some values in the old entry
fixAttrsInEntry($oldent, $inst);
# output $oldent
$outputent = $oldent;
} elsif (!$oldent && $newent) {
next if ($dn =~ /o=deleteAfterMigration/i);
# output $newent
$outputent = $newent;
} else { #merge
# $newent will contain the merged entry
mergeEntries($oldent, $newent, $inst);
$outputent = $newent;
}
# special fix for rootDSE - perldap doesn't like "" for a dn
if (! $outputent->getDN()) {
my $ary = $outputent->getLDIFrecords();
shift @$ary; # remove "dn"
shift @$ary; # remove the empty dn value
print $dsefh "dn:\n";
print $dsefh (Mozilla::LDAP::LDIF::pack_LDIF (78, $ary), "\n");
} else {
Mozilla::LDAP::LDIF::put_LDIF($dsefh, 78, $outputent);
}
}
close $dsefh;
return $tmpdse;
}
sub migrateDS {
my $mig = shift;
$pkgname = $mig->{pkgname}; # set globals
$oldsroot = $mig->{oldsroot}; # set globals
# for each instance
foreach my $inst (@{$mig->{instances}}) {
if (-f "@instconfigdir@/$inst/dse.ldif") {
$mig->msg($WARN, 'instance_already_exists', "@instconfigdir@/$inst/dse.ldif");
next;
}
# set instance specific defaults
my $newdbdir = "@localstatedir@/lib/$pkgname/$inst/db";
my $newcertdir = "@instconfigdir@/$inst";
my $newcldbdir = "@localstatedir@/lib/$pkgname/$inst/cldb";
# extract the information needed for ds_newinst.pl
my $configdir = "$oldsroot/$inst/config";
my $inf = createInfFromConfig($configdir, $inst);
debug(2, "Using inffile $inf->{filename} created from $configdir\n");
# create the new instance
my ($rc, $output) = createDSInstance($inf);
unlink($inf->{filename});
if ($rc) {
$mig->msg($FATAL, 'error_creating_dsinstance', $rc, $output);
return 0;
} else {
$mig->msg('created_dsinstance', $output);
}
# copy over the files/directories
# copy the databases
copyDatabases($oldsroot, $inst, $newdbdir);
# copy the security related files
$mig->migrateSecurityFiles($inst, $newcertdir);
# copy the repl changelog database
copyChangelogDB($oldsroot, $inst, $newcldbdir);
# merge the old info into the new dse.ldif
my $tmpdse = mergeDseLdif($oldsroot, $inst);
# get user/group of new dse
my ($dev, $ino, $mode, $uid, $gid, @rest) = stat "@instconfigdir@/$inst/dse.ldif";
# save the original new dse.ldif
system("cp -p @instconfigdir@/$inst/dse.ldif @instconfigdir@/$inst/dse.ldif.premigrate");
# copy the new one
system("cp $tmpdse @instconfigdir@/$inst/dse.ldif");
# change owner/group
chmod $mode, "@instconfigdir@/$inst/dse.ldif";
chown $uid, $gid, "@instconfigdir@/$inst/dse.ldif";
# remove the temp one
unlink($tmpdse);
}
return 1;
}
#############################################################################
# Mandatory TRUE return value.
#
1;
--- NEW FILE Migration.pm.in ---
# 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
#
###########################
#
# This perl module provides a way to set up a new installation after
# the binaries have already been extracted. This is typically after
# using native packaging support to install the package e.g. RPM,
# pkgadd, depot, etc. This script will show the license, readme,
# dsktune, then run the usual setup pre and post installers.
#
##########################
package Migration;
use Setup;
use Exporter ();
@ISA = qw(Exporter Setup);
@EXPORT = qw();
@EXPORT_OK = qw();
# tempfiles
use File::Temp qw(tempfile tempdir);
# hostname
use Net::Domain qw(hostfqdn);
# 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 Getopt::Long;
use File::Temp qw(tempfile tempdir);
use SetupLog;
use Util;
# process command line options
Getopt::Long::Configure(qw(bundling)); # bundling allows -ddddd
sub VersionMessage {
print "@capbrand@ Directory Server Migration Program Version @PACKAGE_VERSION@\n";
}
sub HelpMessage {
print <<EOF;
INTRODUCTION
This script will copy instances (data and configuration) from the old
server root directory to their new FHS locations. This script does a
copy only - the data in the old instances will be left untouched. The
old instances must be shutdown first to ensure that the databases are
copied safely. The new instances will not be started by migration,
but can be started after running migration.
USAGE
$0 [--options] -- [args]
options:
--help This message
--version Print the version and exit
--debug Turn on debugging
--oldsroot The old server root directory to migrate from
--actualsroot This is the old location of the old server root. See below.
--silent Use silent setup - no user input
--file=name Use the file 'name' in .inf format to supply the default answers
--keepcache Do not delete the temporary .inf file generated by this program
--logfile Log migration messages to this file - otherwise, a temp file will be used
--instance By default, all directory server instances will be migrated. You can use
this argument to specify one or more (e.g. -i slapd-foo -i slapd-bar) if
you do not want to migrate all of them.
For all options, you can also use the short name e.g. -h, -d, etc. For the -d argument,
specifying it more than once will increase the debug level e.g. -ddddd
args:
You can supply default .inf data in this format:
section.param=value
e.g.
General.FullMachineName=foo.example.com
or
"slapd.Suffix=dc=example, dc=com"
Values passed in this manner will override values in an .inf file given with the -f argument.
actualsroot:
This is used when you must migrate from one machine to another. The
usual case is that you have mounted the old server root on a different
root directory, either via a network mount, or by copying a tarball
made using a relative directory on the source machine to the
destination machine and untarring it.
For example: machineA is a 32bit machine, and you want to migrate your
servers to a new 64bit machine. Lets assume your old server root on
machineA was /opt/myds, and your new machine also wants to use a
server root of /opt/myds. There are a couple of different ways to
proceed. Either make a tarball of opt/myds from machineA using a
relative path (i.e. NOT /opt/myds) or use NFS to mount
machineA:/opt/myds on a different mount point
(e.g. machineB:/migration/opt/myds).
If you do this, you should give the old "real" server root (/opt/myds)
as the --actualsroot argument, and use /migration/opt/myds for the
--oldsroot argument. That is, the oldsroot is the physical location of
the files on disk. The actualsroot is the old value of the server root
on the source machine.
EOF
}
sub init {
my $self = shift;
$self->{res} = shift;
my ($silent, $inffile, $keep, $preonly, $logfile, $oldsroot, $actualsroot);
my @instances;
GetOptions('help|h|?' => sub { VersionMessage(); HelpMessage(); exit 0 },
'version|v' => sub { VersionMessage(); exit 0 },
'debug|d+' => \$Util::debuglevel,
'silent|s' => \$silent,
'file|f=s' => \$inffile,
'keepcache|k' => \$keep,
'preonly|p' => \$preonly,
'logfile|l=s' => \$logfile,
'oldsroot|o=s' => \$oldsroot,
'actualsroot|a=s' => \$actualsroot,
'instance|i=s' => \@instances
);
my $pkgname = "@package_name@";
# this is the new pkgname which may be something like
# fedora-ds-base - we have to strip off the -suffix
if ($pkgname =~ /-(core|base)$/) {
$pkgname =~ s/-(core|base)$//;
}
my $oldpkgname = $pkgname;
$self->{pkgname} = $pkgname;
$self->{oldsroot} = $oldsroot || "/opt/$oldpkgname";
$self->{actualsroot} = $actualsroot || $oldsroot;
$self->{silent} = $silent;
$self->{inffile} = $inffile;
$self->{keep} = $keep;
$self->{preonly} = $preonly;
$self->{logfile} = $logfile;
$self->{log} = new SetupLog($self->{logfile}, "migrate");
# if user supplied inf file, use that to initialize
if (defined($self->{inffile})) {
$self->{inf} = new Inf($self->{inffile});
} else {
$self->{inf} = new Inf;
}
my $fh;
# create a temp inf file for writing for other processes
# never overwrite the user supplied inf file
($fh, $self->{inffile}) = tempfile("migrateXXXXXX", UNLINK => !$keep,
SUFFIX => ".inf", OPEN => 0,
DIR => File::Spec->tmpdir);
$self->{inf}->{filename} = $self->{inffile};
# see if user passed in default inf values - also, command line
# arguments override those passed in via an inf file - this
# allows the reuse of .inf files with some parameters overridden
for (@ARGV) {
if (/^([\w_-]+)\.([\w_-]+)=(.*)$/) { # e.g. section.param=value
$self->{inf}->{$1}->{$2} = $3;
} else { # error
print STDERR "Error: unknown command line option $_\n";
usage();
exit 1;
}
}
# this is the base config directory - the directory containing
# the slapd-instance instance specific config directories
$self->{configdir} = $ENV{DS_CONFIG_DIR} || "@instconfigdir@";
# get list of instances to migrate
if (! @instances) {
# an instance must be a directory called $oldsroot/slapd-something and the file
# $oldsroot/slapd-something/config/dse.ldif must exist
@instances = grep { -d && -f "$_/config/dse.ldif" && ($_ =~ s,$self->{oldsroot}/,,) }
glob("$self->{oldsroot}/slapd-*");
}
die "No instances found to migrate" unless (@instances);
$self->{instances} = \@instances;
}
sub doExit {
my $self = shift;
$self->msg($FATAL, 'migration_exiting', $self->{log}->{filename});
exit 1;
}
sub migrateSecurityFiles {
my $self = shift;
my $inst = shift;
my $destdir = shift;
my $oldroot = $self->{oldsroot};
if (! -d "$oldroot/alias") {
$self->msg('old_secdir_error', "$oldroot/alias", $!);
return 0;
} elsif (! -d $destdir) {
$self->msg('new_secdir_error', $destdir, $!);
return 0;
} else {
$self->log($INFO, "Copying $oldroot/alias/$inst-cert8.db to $destdir/cert8.db\n");
if (system ("cp -p $oldroot/alias/$inst-cert8.db $destdir/cert8.db")) {
$self->msg($FATAL, 'error_copying_certdb', "$oldroot/alias/$inst-cert8.db",
"$destdir/cert8.db", $!);
return 0;
}
$self->log($INFO, "Copying $oldroot/alias/$inst-key3.db to $destdir/key3.db\n");
if (system ("cp -p $oldroot/alias/$inst-key3.db $destdir/key3.db")) {
$self->msg($FATAL, 'error_copying_keydb', "$oldroot/alias/$inst-key3.db",
"$destdir/key3.db", $!);
return 0;
}
$self->log($INFO, "Copying $oldroot/alias/secmod.db to $destdir/secmod.db\n");
if (system ("cp -p $oldroot/alias/secmod.db $destdir/secmod.db")) {
$self->msg($FATAL, 'error_copying_secmoddb', "$oldroot/alias/secmod.db",
"$destdir/secmod.db", $!);
return 0;
}
if (-f "$oldroot/alias/$inst-pin.txt") {
$self->log($INFO, "Copying $oldroot/alias/$inst-pin.txt to $destdir/pin.txt\n");
if (system ("cp -p $oldroot/alias/$inst-pin.txt $destdir/pin.txt")) {
$self->msg($FATAL, 'error_copying_pinfile', "$oldroot/alias/$inst-pin.txt",
"$destdir/pin.txt", $!);
return 0;
}
} else {
$self->log($INFO, "No $oldroot/alias/$inst-pin.txt to migrate\n");
}
if (-f "$oldroot/shared/config/certmap.conf") {
$self->log($INFO, "Copying $oldroot/shared/config/certmap.conf to $destdir/certmap.conf\n");
if (system ("cp -p $oldroot/shared/config/certmap.conf $destdir/certmap.conf")) {
$self->msg($FATAL, 'error_copying_certmap', "$oldroot/shared/config/certmap.conf",
"$destdir/certmap.conf", $!);
return 0;
}
} else {
$self->log($INFO, "No $oldroot/shared/config/certmap.conf to migrate\n");
}
}
return 1;
}
#############################################################################
# Mandatory TRUE return value.
#
1;
--- NEW FILE migrate-ds.pl.in ---
#!/usr/bin/env perl
# 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
#
###########################
#
# This perl module provides a way to set up a new installation after
# the binaries have already been extracted. This is typically after
# using native packaging support to install the package e.g. RPM,
# pkgadd, depot, etc. This script will show the license, readme,
# dsktune, then run the usual setup pre and post installers.
#
##########################
use lib '@perldir@';
use strict;
use DSMigration;
use Migration;
use Resource;
my $res = new Resource("@propertydir@/migrate-ds.res",
"@propertydir@/setup-ds.res");
my $mig = new Migration($res);
$mig->msg('begin_ds_migration', $mig->{oldsroot});
migrateDS($mig);
$mig->msg('end_ds_migration');
--- NEW FILE migrate-ds.res ---
begin_ds_migration = Beginning migration of directory server instances in %s . . .\n
end_ds_migration = Directory server migration is complete. Please check output and log files for details.\n
migration_exiting = Exiting . . .\nLog file is '%s'\n\n
instance_already_exists = The target directory server instance already exists at %s. Skipping migration.\n\
Index: Setup.pm.in
===================================================================
RCS file: /cvs/dirsec/ldapserver/ldap/admin/src/scripts/Setup.pm.in,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- Setup.pm.in 20 Jun 2007 16:27:50 -0000 1.7
+++ Setup.pm.in 29 Jun 2007 21:12:21 -0000 1.8
@@ -69,6 +69,11 @@
use File::Temp qw(tempfile tempdir);
use SetupLog;
+use Util;
+use Inf;
+
+use strict;
+use vars qw($EXPRESS $TYPICAL $CUSTOM $SILENT);
# the setup types
$EXPRESS = 1;
@@ -111,13 +116,19 @@
sub new {
my $type = shift;
my $self = {};
+ $self = bless $self, $type;
+ $self->init(@_);
+ return $self;
+}
+
+sub init {
+ my $self = shift;
$self->{res} = shift;
- my ($debuglevel, $silent, $inffile, $keep, $preonly, $logfile);
- my @otherargs;
+ my ($silent, $inffile, $keep, $preonly, $logfile);
GetOptions('help|h|?' => sub { VersionMessage(); HelpMessage(); exit 0 },
'version|v' => sub { VersionMessage(); exit 0 },
- 'debug|d+' => \$debuglevel,
+ 'debug|d+' => \$Util::debuglevel,
'silent|s' => \$silent,
'file|f=s' => \$inffile,
'keepcache|k' => \$keep,
@@ -125,7 +136,6 @@
'logfile|l=s' => \$logfile
);
- $self->{debuglevel} = $debuglevel;
$self->{silent} = $silent;
$self->{inffile} = $inffile;
$self->{keep} = $keep;
@@ -162,9 +172,6 @@
# this is the base config directory - the directory containing
# the slapd-instance instance specific config directories
$self->{configdir} = $ENV{DS_CONFIG_DIR} || "@instconfigdir@";
-
- $self = bless $self, $type;
- return $self;
}
# log only goes the the logfile
Index: SetupLog.pm
===================================================================
RCS file: /cvs/dirsec/ldapserver/ldap/admin/src/scripts/SetupLog.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- SetupLog.pm 8 Jun 2007 01:09:16 -0000 1.1
+++ SetupLog.pm 29 Jun 2007 21:12:21 -0000 1.2
@@ -59,11 +59,12 @@
sub new {
my $type = shift;
my $filename = shift;
+ my $prefix = shift || "setup";
my $self = {};
my $fh;
if (!$filename) {
- ($fh, $filename) = tempfile("setupXXXXXX", UNLINK => 0,
+ ($fh, $filename) = tempfile("${prefix}XXXXXX", UNLINK => 0,
SUFFIX => ".log", DIR => File::Spec->tmpdir);
} else {
open LOGFILE, ">$filename" or die "Error: could not open logfile $filename: $!";
Index: Util.pm.in
===================================================================
RCS file: /cvs/dirsec/ldapserver/ldap/admin/src/scripts/Util.pm.in,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Util.pm.in 21 Jun 2007 21:57:23 -0000 1.3
+++ Util.pm.in 29 Jun 2007 21:12:21 -0000 1.4
@@ -47,15 +47,28 @@
@ISA = qw(Exporter);
@EXPORT = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries
process_maptbl check_and_add_entry getMappedEntries
- getHashedPassword);
+ getHashedPassword debug createDSInstance createInfFromConfig);
@EXPORT_OK = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries
process_maptbl check_and_add_entry getMappedEntries
- getHashedPassword);
+ getHashedPassword debug createDSInstance createInfFromConfig);
use strict;
use Socket;
+use File::Temp qw(tempfile tempdir);
+
+$Util::debuglevel = 0;
+# use like this:
+# debug(3, "message");
+# this will only print "message" if $debuglevel is 3 or higher (-ddd on the command line)
+sub debug {
+ my ($level, @rest) = @_;
+ if ($level <= $Util::debuglevel) {
+ print STDERR "+" x $level, @rest;
+ }
+}
+
# return true if the given port number is available, false otherwise
sub portAvailable {
my $port = shift;
@@ -89,10 +102,6 @@
return ($dn =~ /^[0-9a-zA-Z_-]+=.*$/);
}
-sub debug {
-# print @_, "\n";
-}
-
# delete the subtree starting from the passed entry
sub delete_all
{
@@ -217,9 +226,18 @@
my $verbose = $context->[2];
my @ctypes = $aentry->getValues("changetype");
my $sentry = $conn->search($aentry->{dn}, "base", "(objectclass=*)", 0, ("*", "aci"));
+ if ($sentry) {
+ debug(3, "check_and_add_entry: Found entry " . $sentry->getDN() . "\n");
+ } else {
+ debug(3, "check_and_add_entry: Entry not found " . $aentry->{dn} .
+ " error " . $conn->getErrorString() . "\n");
+ }
do
{
my $needtoadd;
+ my @addtypes; # list of attr types for mod add
+ my @reptypes; # list of attr types for mod replace
+ my @deltypes; # list of attr types for mod delete
my $MOD_NONE = 0;
my $MOD_ADD = 1;
my $MOD_REPLACE = 2;
@@ -248,19 +266,18 @@
{
$needtoadd = 0;
$needtomod = $MOD_ADD;
+ @addtypes = keys %{$aentry}; # add all attrs
}
elsif ( $sentry && $sentry->{dn} )
{
# $fresh || $rc == -1
# an entry having the same DN exists, but the attributes do not
# match. remove the entry and the subtree underneath.
- if ( $verbose )
- {
- print "Deleting an entry dn: $sentry->{dn} ...\n";
- }
+ debug(1, "Deleting an entry dn: $sentry->{dn} ...\n");
$rc = delete_all($conn, $sentry);
if ( 0 != $rc )
{
+ debug(1, "Error deleting $sentry->{dn}\n");
return 0;
}
}
@@ -270,28 +287,10 @@
$needtoadd = 0;
if ( $sentry )
{
- my @atypes = $aentry->getValues("add");
- if ( 0 <= $#atypes )
- {
- $needtomod = $MOD_ADD;
- }
- else
- {
- @atypes = $aentry->getValues("replace");
- if ( 0 <= $#atypes )
- {
- $needtomod = $MOD_REPLACE;
- }
- else
- {
- @atypes = $aentry->getValues("delete");
- if ( 0 <= $#atypes )
- {
- print "\"delete\" is not supported; ignoring...\n";
- }
- $needtomod = $MOD_NONE;
- }
- }
+ @addtypes = $aentry->getValues("add");
+ @reptypes = $aentry->getValues("replace");
+ @deltypes = $aentry->getValues("delete");
+ $needtomod = $MOD_REPLACE;
}
else
{
@@ -305,63 +304,62 @@
my $rc = $conn->getErrorCode();
if ( $rc != 0 )
{
- print "ERROR: adding an entry $aentry->{dn} failed, error code: $rc\n";
+ my $string = $conn->getErrorString();
+ print "ERROR: adding an entry $aentry->{dn} failed, error: $string\n";
print "[entry]\n";
$aentry->printLDIF();
$conn->close();
return 0;
}
- debug("Entry $aentry->{dn} is added\n");
+ debug(1, "Entry $aentry->{dn} is added\n");
}
elsif ( 0 < $needtomod ) # $sentry exists
{
+ my $attr;
if ( $needtomod == $MOD_SPECIAL )
{
- foreach my $attr ( keys %speciallist )
+ debug(3, "Doing MOD_SPECIAL for entry $aentry->{dn}\n");
+ foreach $attr ( keys %speciallist )
{
foreach my $nval ( @{$aentry->{$attr}} )
{
$sentry->addValue( $attr, $nval );
}
}
- $conn->update($sentry);
}
- elsif ( $needtomod == $MOD_ADD )
+ foreach $attr ( @addtypes )
{
- foreach my $attr ( keys %{$aentry} )
- {
- next if $attr =~ /add|changetype/;
- foreach my $nval ( @{$aentry->{$attr}} )
- {
- $sentry->addValue( $attr, $nval );
- }
- }
- $conn->update($sentry);
+ debug(3, "Adding attr=$attr values=" . $aentry->getValues($attr) . " to entry $aentry->{dn}\n");
+ $sentry->addValue( $attr, $aentry->getValues($attr) );
}
- elsif ( $needtomod == $MOD_REPLACE )
+ foreach $attr ( @reptypes )
{
- my $entry = new Mozilla::LDAP::Entry();
- $entry->setDN($aentry->getDN());
- foreach my $attr ( keys %{$aentry} )
+ debug(3, "Replacing attr=$attr values=" . $aentry->getValues($attr) . " to entry $aentry->{dn}\n");
+ $sentry->setValues($attr, $aentry->getValues($attr));
+ }
+ foreach $attr ( @deltypes )
+ {
+ # removeValue takes a single value only
+ if (!$aentry->size($attr))
{
- next if $attr =~ /replace|changetype/;
- foreach my $nval ( @{$aentry->{$attr}} )
+ debug(3, "Deleting attr=$attr from entry $aentry->{dn}\n");
+ $sentry->remove($attr); # just delete the attribute
+ }
+ else
+ {
+ debug(3, "Deleting attr=$attr values=" . $aentry->getValues($attr) . " from entry $aentry->{dn}\n");
+ foreach my $val ($aentry->getValues($attr))
{
- $entry->addValue( $attr, $nval );
+ $sentry->removeValue($attr, $val);
}
}
- $conn->update($entry);
- }
- else
- {
- print "ERROR: needtomod == $needtomod is not supported.\n";
- $conn->close();
- return 0;
}
+ $conn->update($sentry);
my $rc = $conn->getErrorCode();
if ( $rc != 0 )
{
- print "ERROR: updating an entry $sentry->{dn} failed, error code: $rc\n";
+ my $string = $conn->getErrorString();
+ print "ERROR: updating an entry $sentry->{dn} failed, error: $string\n";
print "[entry]\n";
$aentry->printLDIF();
$conn->close();
@@ -455,7 +453,7 @@
foreach my $ldiffile (@{$ldiffiles}) {
open(MYLDIF, "< $ldiffile") or die "Can't open $ldiffile : $!";
my $in = new Mozilla::LDAP::LDIF(*MYLDIF);
- debug("Processing $ldiffile ...");
+ debug(1, "Processing $ldiffile ...\n");
ENTRY: while (my $entry = Mozilla::LDAP::LDIF::readOneEntry($in)) {
# first, fix the DN
my $dn = $entry->getDN();
@@ -709,4 +707,55 @@
return $hashedpwd;
}
+sub createDSInstance {
+ my $inf = shift;
+# find ds_newinst.pl - in same directory as this script or in PATH
+ my $ds_newinst;
+ ($ds_newinst = $0) =~ s|/[^/]+$|/ds_newinst.pl|;
+ if (! -x $ds_newinst) {
+ $ds_newinst = "@bindir@/ds_newinst.pl";
+ }
+ if (! -x $ds_newinst) {
+ $ds_newinst = "ds_newinst.pl"; # just get from path
+ }
+ $? = 0; # clear error condition
+ my $output = `$ds_newinst $inf->{filename}`;
+ return ($?, $output);
+}
+
+# this creates an Inf suitable for passing to createDSInstance
+sub createInfFromConfig {
+ my $configdir = shift;
+ my $inst = shift;
+ my $fname = "$configdir/dse.ldif";
+ my $id;
+ ($id = $inst) =~ s/^slapd-//;
+ open( DSELDIF, "$fname" ) || die "Can't open $fname: $!";
+ my ($outfh, $inffile) = tempfile(SUFFIX => '.inf');
+ my $in = new Mozilla::LDAP::LDIF(*DSELDIF) ;
+ while (my $ent = readOneEntry $in) {
+ my $dn = $ent->getDN();
+ if ($dn =~ /cn=config/) {
+ print $outfh "[General]\n";
+ print $outfh "FullMachineName = ", $ent->getValues('nsslapd-localhost'), "\n";
+ print $outfh "SuiteSpotUserID = ", $ent->getValues('nsslapd-localuser'), "\n";
+ print $outfh "ServerRoot = @serverdir@\n";
+ print $outfh "[slapd]\n";
+ print $outfh "RootDN = ", $ent->getValues('nsslapd-rootdn'), "\n";
+ print $outfh "RootDNPwd = ", $ent->getValues('nsslapd-rootpw'), "\n";
+ print $outfh "ServerPort = ", $ent->getValues('nsslapd-port'), "\n";
+ print $outfh "ServerIdentifier = $id\n";
+ print $outfh "Suffix = o=deleteAfterMigration\n";
+ print $outfh "start_server= 0\n";
+ last;
+ }
+ }
+ close $outfh;
+ close DSELDIF;
+
+ my $inf = new Inf($inffile);
+
+ return $inf;
+}
+
1;
Index: setup-ds.pl.in
===================================================================
RCS file: /cvs/dirsec/ldapserver/ldap/admin/src/scripts/setup-ds.pl.in,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- setup-ds.pl.in 20 Jun 2007 22:08:39 -0000 1.2
+++ setup-ds.pl.in 29 Jun 2007 21:12:21 -0000 1.3
@@ -45,6 +45,7 @@
use Inf;
use Resource;
use DialogManager;
+use Util;
my $res = new Resource("@propertydir@/setup-ds.res");
@@ -68,6 +69,11 @@
$setup->{inf}->write();
}
-system("@bindir@/ds_newinst.pl $setup->{inffile}");
+my ($rc, $output) = createDSInstance($setup->{inf});
+if ($rc) {
+ $setup->msg($FATAL, 'error_creating_dsinstance', $rc, $output);
+} else {
+ $setup->msg('created_dsinstance', $output);
+}
$setup->doExit();
Index: setup-ds.res.in
===================================================================
RCS file: /cvs/dirsec/ldapserver/ldap/admin/src/scripts/setup-ds.res.in,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- setup-ds.res.in 19 Jun 2007 18:24:57 -0000 1.4
+++ setup-ds.res.in 29 Jun 2007 21:12:21 -0000 1.5
@@ -87,3 +87,5 @@
error_creating_suffix = Could not create the suffix '%s'. Error: %s\n\n
setup_exiting = Exiting . . .\nLog file is '%s'\n\n
+error_creating_dsinstance = Error: Could not create directory server instance. Error code %s. Output:\n%s\n
+created_dsinstance = Your new DS instance was successfully created. Output:\n%s\n
More information about the Fedora-directory-commits
mailing list