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
389-commits@lists.fedoraproject.org