From c11f1818c19233bdb6e54823b0c1352d4377fb75 Mon Sep 17 00:00:00 2001 From: Rich Megginson Date: Mon, 21 Sep 2009 15:30:00 -0600 Subject: 389-ds-base/glibmm24: conflicting perl provides https://bugzilla.redhat.com/show_bug.cgi?id=523476 Resolves: bug 523476 Bug Description: 389-ds-base/glibmm24: conflicting perl provides Reviewed by: nhosoi (Thanks!) Files: see diff Fix Description: Rename "Util" to "DSUtil" Platforms tested: Fedora 11 x86_64 Flag Day: no Doc impact: no --- ldap/admin/src/scripts/DSCreate.pm.in | 4 +- ldap/admin/src/scripts/DSDialogs.pm | 2 +- ldap/admin/src/scripts/DSMigration.pm.in | 3 +- ldap/admin/src/scripts/DSUpdate.pm.in | 2 +- ldap/admin/src/scripts/DSUpdateDialogs.pm | 2 +- ldap/admin/src/scripts/DSUtil.pm.in | 980 ++++++++++++++++++++++++++++++ ldap/admin/src/scripts/FileConn.pm | 2 +- ldap/admin/src/scripts/Migration.pm.in | 4 +- ldap/admin/src/scripts/Setup.pm.in | 4 +- ldap/admin/src/scripts/SetupDialogs.pm.in | 2 +- ldap/admin/src/scripts/Util.pm.in | 980 ------------------------------ ldap/admin/src/scripts/remove-ds.pl.in | 4 +- ldap/admin/src/scripts/setup-ds.pl.in | 2 +- 13 files changed, 995 insertions(+), 996 deletions(-) create mode 100644 ldap/admin/src/scripts/DSUtil.pm.in delete mode 100644 ldap/admin/src/scripts/Util.pm.in (limited to 'ldap/admin/src/scripts') diff --git a/ldap/admin/src/scripts/DSCreate.pm.in b/ldap/admin/src/scripts/DSCreate.pm.in index a7ab5fae..f351a21b 100644 --- a/ldap/admin/src/scripts/DSCreate.pm.in +++ b/ldap/admin/src/scripts/DSCreate.pm.in @@ -44,7 +44,7 @@ ########################## package DSCreate; -use Util; +use DSUtil; use Inf; use FileConn; @@ -198,7 +198,7 @@ sub changeOwnerMode { sub makeDSDirs { my $inf = shift; - my $verbose = ($Util::debuglevel > 0); + my $verbose = ($DSUtil::debuglevel > 0); my $mode = getMode($inf, 7); my @errs; diff --git a/ldap/admin/src/scripts/DSDialogs.pm b/ldap/admin/src/scripts/DSDialogs.pm index 22fe512a..6583ff9e 100644 --- a/ldap/admin/src/scripts/DSDialogs.pm +++ b/ldap/admin/src/scripts/DSDialogs.pm @@ -44,7 +44,7 @@ use Net::Domain qw(hostname hostfqdn); use DialogManager; use Setup; use Dialog; -use Util; +use DSUtil; my $dsport = new Dialog ( $TYPICAL, diff --git a/ldap/admin/src/scripts/DSMigration.pm.in b/ldap/admin/src/scripts/DSMigration.pm.in index c661d2c1..c0a7614d 100644 --- a/ldap/admin/src/scripts/DSMigration.pm.in +++ b/ldap/admin/src/scripts/DSMigration.pm.in @@ -48,7 +48,7 @@ package DSMigration; use Migration; -use Util; +use DSUtil; use Inf; use DSCreate; @@ -75,7 +75,6 @@ use Exporter; 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 diff --git a/ldap/admin/src/scripts/DSUpdate.pm.in b/ldap/admin/src/scripts/DSUpdate.pm.in index 23f33899..20bb40d1 100644 --- a/ldap/admin/src/scripts/DSUpdate.pm.in +++ b/ldap/admin/src/scripts/DSUpdate.pm.in @@ -44,7 +44,7 @@ ########################## package DSUpdate; -use Util; +use DSUtil; use Inf; use FileConn; use DSCreate qw(setDefaults createInstanceScripts); diff --git a/ldap/admin/src/scripts/DSUpdateDialogs.pm b/ldap/admin/src/scripts/DSUpdateDialogs.pm index 32185b88..18e85c39 100644 --- a/ldap/admin/src/scripts/DSUpdateDialogs.pm +++ b/ldap/admin/src/scripts/DSUpdateDialogs.pm @@ -43,7 +43,7 @@ use strict; use DialogManager; use Setup; use Dialog; -use Util; +use DSUtil; use FileConn; my @updateadmindialogs; diff --git a/ldap/admin/src/scripts/DSUtil.pm.in b/ldap/admin/src/scripts/DSUtil.pm.in new file mode 100644 index 00000000..b92efa40 --- /dev/null +++ b/ldap/admin/src/scripts/DSUtil.pm.in @@ -0,0 +1,980 @@ +# 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 +# + +package DSUtil; + +use Mozilla::LDAP::Conn; +use Mozilla::LDAP::Utils qw(normalizeDN); +use Mozilla::LDAP::API qw(:constant ldap_explode_dn ldap_err2string) ; # Direct access to C API +use Mozilla::LDAP::LDIF; + +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries + process_maptbl check_and_add_entry getMappedEntries addErr + getHashedPassword debug createInfFromConfig shellEscape + isValidServerID isValidUser makePaths getLogin remove_tree remove_pidfile); +@EXPORT_OK = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries + process_maptbl check_and_add_entry getMappedEntries addErr + getHashedPassword debug createInfFromConfig shellEscape + isValidServerID isValidUser makePaths getLogin remove_tree remove_pidfile); + +use strict; + +use Socket; + +use File::Temp qw(tempfile tempdir); +use File::Basename qw(dirname); +use File::Path qw(rmtree); + +use Carp; + +$DSUtil::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 <= $DSUtil::debuglevel) { + print STDERR "+" x $level, @rest; + } +} + +# return true if the given port number is available, false otherwise +sub portAvailable { + my $port = shift; + my $proto = getprotobyname('tcp'); + my $rc = socket(SOCK, PF_INET, SOCK_STREAM, $proto); + if ($rc == 1) { + setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, 1); + $rc = bind(SOCK, sockaddr_in($port, INADDR_ANY)); + } + close(SOCK); + return $rc and ($rc == 1); +} + +# returns a randomly assigned port number, or -1 +# if not able to find an available port +sub getAvailablePort { + my $MINPORT = 1024; + my $MAXPORT = 65535; + + srand( time() ^ ($$ + ($$ << 15)) ); + while (1) { + my $port = $MINPORT + int(rand($MAXPORT-$MINPORT)); + + if (portAvailable($port)) { + return $port; + } + } +} + +sub isValidDN { + my $dn = shift; + return ($dn =~ /^[0-9a-zA-Z_-]+=.*$/); +} + +sub isValidServerID { + my $servid = shift; + my $validchars = '#%:\w@_-'; + return $servid =~ /^[$validchars]+$/o; +} + +# we want the name of the effective user id of this process e.g. if someone did +# an su root, we want getLogin to return "root" not the originating id (getlogin) +# in perl, $> is the effective numeric user id - we need to turn it into a string +# use confess here because if we cannot determine the user, something is really, +# really wrong and we need to abort immediately +sub getLogin { + return (getpwuid($>))[0] || $ENV{USER} || confess "Error: could not determine the current user ID: $!"; +} + +sub isValidUser { + my $user = shift; + # convert numeric uid to string + my $strans = $user; + if ($user =~ /^\d+$/) { # numeric - convert to string + $strans = getpwuid $user; + if (!$strans) { + return ("dialog_ssuser_error", $user); + } + } + if ($> != 0) { # if not root, the user must be our uid + my $username = getLogin; + if ($strans ne $username) { + return ("dialog_ssuser_must_be_same", $username); + } + } else { # user is root - verify id + my $nuid = getpwnam $strans; + if (!defined($nuid)) { + return ("dialog_ssuser_error", $user); + } + if (!$nuid) { + debug(0, "Warning: using root as the server user id. You are strongly encouraged to use a non-root user.\n"); + } + } + + return (); +} + +# delete the subtree starting from the passed entry +sub delete_all +{ + my ($conn, $bentry) = @_; + my $sentry = $conn->search($bentry->{dn}, + "subtree", "(objectclass=*)", 0, ("dn")); + my @mystack = (); + while ($sentry) { + push @mystack, $sentry->getDN(); + $sentry = $conn->nextEntry(); + } + # reverse order + my $dn = pop @mystack; + while ($dn) { + $conn->delete($dn); + my $rc = $conn->getErrorCode(); + if ( $rc != 0 ) { + debug(1, "ERROR: unable to delete entry $dn, error code: $rc:" . $conn->getErrorString() . "\n"); + return 1; + } + $dn = pop @mystack; + } + return 0; +} + +# if the entry does not exist on the server, add the entry. +# otherwise, do nothing +# you can use this as the callback to getMappedEntries, so +# that for each entry in the ldif file being processed, you +# can call this subroutine to add or update the entry +# use like this: +# getMappedEntries($mapper, \@ldiffiles, \&check_and_add_entry, +# [$conn, $fresh, $verbose]); +# where $conn is a perldap Conn +# $fresh if true will update the entry if it exists +# $verbose prints out more info +sub check_and_add_entry +{ + my ($context, $aentry, $errs) = @_; + my $conn = $context->[0]; + my $fresh = $context->[1]; + 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"); + if (! @ctypes) { # entry exists, and this is not a modify op + debug(3, "check_and_add_entry: skipping entry " . $sentry->getDN() . "\n"); + return 1; # ignore - return success + } + } else { + debug(3, "check_and_add_entry: Entry not found " . $aentry->{dn} . + " error " . $conn->getErrorString() . "\n"); + if (@ctypes) { # uh oh - attempt to del/mod an entry that doesn't exist + debug(3, "check_and_add_entry: attepting to @ctypes the entry " . $aentry->{dn} . + " that does not exist\n"); + return 1; # ignore - return success + } + } + do + { + 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 $OP_NONE = 0; + my $OP_ADD = 1; + my $OP_MOD = 2; + my $OP_DEL = 3; + # $op stores either of the above $OP_ values + my $op = $OP_NONE; + if ( 0 > $#ctypes ) # aentry: complete entry + { + $op = $OP_ADD; # just add the entry + } + else # aentry: modify format + { + if ( $sentry ) + { + if ( "delete" eq lc($ctypes[0]) ) + { + $op = $OP_DEL; + } + else + { + @addtypes = $aentry->getValues("add"); + @reptypes = $aentry->getValues("replace"); + @deltypes = $aentry->getValues("delete"); + $op = $OP_MOD; + } + } + else + { + $op = $OP_NONE; + } + } + + if ( $OP_ADD == $op ) + { + $conn->add($aentry); + my $rc = $conn->getErrorCode(); + if ( $rc != 0 ) + { + my $string = $conn->getErrorString(); + push @{$errs}, 'error_adding_entry', $aentry->{dn}, $string; + debug(1, "ERROR: adding an entry $aentry->{dn} failed, error: $string\n"); + $aentry->printLDIF(); + $conn->close(); + return 0; + } + debug(1, "Entry $aentry->{dn} is added\n"); + } + elsif ( $OP_DEL == $op ) + { + my $rc = delete_all($conn, $sentry); + if ( 0 != $rc ) + { + push @{$errs}, 'error_deleteall_entries', $sentry->{dn}, $conn->getErrorString(); + debug(1, "Error deleting $sentry->{dn}\n"); + return 0; + } + debug(1, "Entry $aentry->{dn} is deleted\n"); + } + elsif ( 0 < $op ) # modify op + { + my $attr; + my @errsToIgnore; + if (@addtypes) { + push @errsToIgnore, LDAP_TYPE_OR_VALUE_EXISTS; + } + foreach $attr ( @addtypes ) + { + foreach my $val ($aentry->getValues($attr)) + { + debug(3, "Adding attr=$attr value=$val to entry $aentry->{dn}\n"); + $sentry->addValue( $attr, $val ); + } + } + foreach $attr ( @reptypes ) + { + my @vals = $aentry->getValues($attr); + debug(3, "Replacing attr=$attr values=" . $aentry->getValues($attr) . " to entry $aentry->{dn}\n"); + $sentry->setValues($attr, @vals); + } + if (@deltypes) { + push @errsToIgnore, LDAP_NO_SUCH_ATTRIBUTE; + } + foreach $attr ( @deltypes ) + { + # removeValue takes a single value only + if (!$aentry->size($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)) + { + $sentry->removeValue($attr, $val); + } + } + } + $conn->update($sentry); + my $rc = $conn->getErrorCode(); + if ( $rc != 0 ) + { + my $string = $conn->getErrorString(); + debug(1, "ERROR: updating an entry $sentry->{dn} failed, error: $string\n"); + if (grep /^$rc$/, @errsToIgnore) { + debug(1, "Ignoring error $rc returned by adding @addtypes deleting @deltypes\n"); + } else { + push @{$errs}, 'error_updating_entry', $sentry->{dn}, $string; + $aentry->printLDIF(); + $conn->close(); + return 0; + } + } + } + if ( $sentry ) + { + $sentry = $conn->nextEntry(); # supposed to have no more entries + } + } until ( !$sentry ); +out: + return 1; +} + +# the default callback used with getMappedEntries +# just adds the given entry to the given list +sub cbaddent { + my $list = shift; + my $ent = shift; + push @{$list}, $ent; + return 1; +} + +# given a mapper and a list of LDIF files, produce a list of +# perldap Entry objects which have had their tokens subst-ed +# with values from the mapper +# An optional callback can be supplied. Each entry will be +# given to this callback. The callback should return a list +# of localizable errors. If no callback is supplied, the +# entries will be returned in a list. +# Arguments: +# mapper - a hash ref - the keys are the tokens to replace +# and the values are the replacements +# ldiffiles - an array ref - the list of LDIF files to +# operate on +# errs - an array ref - this is filled in with the +# errors encountered in processing - this is +# suitable for passing to setup->msg or +# Resource->getText +# callback (optional) - a code ref - a ref to a subroutine +# that will be called with each entry - see below +# context (optional) - this will be passed as the first +# argument to your given callback - see below +# Callback: +# The callback sub will be called for each entry after +# the entry has been converted. The callback will be +# called with the given context as the first argument +# and the Mozilla::LDAP::Entry as the second argument, +# and an errs array ref as the third argument. The +# callback should return true to continue processing, +# or false if a fatal error was encountered that should +# abort processing of any further. +# Errors: +# This function should return an array of errors in the +# format described below, for use with Resource::getText() +# or Setup::msg() +# Return: +# The return value is a list of entries. +# Example usage: +# sub handle_entries { +# my $context = shift; +# my $entry = shift; +# my $errs = shift; +# .... do something with entry .... +# .... if $context is Mozilla::LDAP::Conn, $conn->add($entry); ... +# .... report errors .... +# if ($fatalerror) { +# push @{$errs}, 'error_token', arg1, arg2, ...; +# return 0; +# } else { +# return 1; +# } +# } +# $mapper = {foo => 'bar', baz => 'biff'}; +# @ldiffiles = ('foo.ldif', 'bar.ldif', ..., 'biff.ldif'); +# $conn = new Mozilla::LDAP::Conn(...); +# my @errs; +# @entries = getMappedEntries($mapper, \@ldiffiles, \@errs, \&handle_entries, $conn); +# Note that this will return 0 entries since a callback was used. +# The simpler example is this: +# @entries = getMappedEntries($mapper, \@ldiffiles, \@errs); +# +sub getMappedEntries { + my $mapper = shift; + my $ldiffiles = shift; + my $errs = shift; + my $callback = shift || \&cbaddent; # default - just add entry to @entries + my @entries = (); + my $context = shift || \@entries; + my $error; + + if (!ref($ldiffiles)) { + $ldiffiles = [ $ldiffiles ]; + } + + foreach my $ldiffile (@{$ldiffiles}) { + if (!open(MYLDIF, "< $ldiffile")) { + push @{$errs}, "error_opening_ldiftmpl", $ldiffile, $!; + return 0; + } + my $in = new Mozilla::LDAP::LDIF(*MYLDIF); + debug(1, "Processing $ldiffile ...\n"); + ENTRY: while (my $entry = Mozilla::LDAP::LDIF::readOneEntry($in)) { + # first, fix the DN + my $dn = $entry->getDN(); + my $origdn = $dn; + while ( $dn =~ /%([\w_-]+)%/ ) { + if (exists($mapper->{$1})) { + $dn =~ s{%([\w_-]+)%}{$mapper->{$1}}ge; + } else { + push @{$errs}, 'error_mapping_token_ldiftmpl', $dn, $ldiffile, $1; + $error = 1; + last ENTRY; + } + } + $entry->setDN($dn); + # next, fix all of the values in all of the attributes + foreach my $attr (keys %{$entry}) { + my @newvalues = (); + foreach my $value ($entry->getValues($attr)) { + # Need to repeat to handle nested subst + my $origvalue = $value; + while ( $value =~ /%([\w_-]+)%/ ) { + if (exists($mapper->{$1})) { + $value =~ s{%([\w_-]+)%}{$mapper->{$1}}ge; + } else { + push @{$errs}, 'error_mapping_token_ldiftmpl', $dn, $ldiffile, $1; + debug(1, "ERROR: \"$origvalue\" mapped to \"$value\".\n"); + $error = 1; + last ENTRY; + } + } + push @newvalues, $value; + } + $entry->setValues( $attr, @newvalues ); + } + + if (!&{$callback}($context, $entry, $errs)) { + debug(1, "ERROR: There was an error processing entry ". $entry->getDN(). "\n"); + debug(1, "Cannot continue processing entries.\n"); + $error = 1; + last ENTRY; + } + + } + close(MYLDIF); + last if ($error); # do not process any more ldiffiles if an error occurred + } + + return @entries; +} + +# you should only use this function if you know for sure +# that the suffix and backend do not already exist +# use addSuffix instead +sub newSuffixAndBackend { + my $context = shift; + my $suffix = shift; + my $bename = shift; + my $nsuffix = normalizeDN($suffix); + my @errs; + + my $dn = "cn=$bename, cn=ldbm database, cn=plugins, cn=config"; + my $entry = new Mozilla::LDAP::Entry(); + $entry->setDN($dn); + $entry->setValues('objectclass', 'top', 'extensibleObject', 'nsBackendInstance'); + $entry->setValues('cn', $bename); + $entry->setValues('nsslapd-suffix', $nsuffix); + $context->add($entry); + my $rc = $context->getErrorCode(); + if ($rc) { + return ('error_creating_suffix_backend', $suffix, $bename, $context->getErrorString()); + } + + $entry = new Mozilla::LDAP::Entry(); + $dn = "cn=\"$nsuffix\", cn=mapping tree, cn=config"; + $entry->setDN($dn); + $entry->setValues('objectclass', 'top', 'extensibleObject', 'nsMappingTree'); + $entry->setValues('cn', "\"$nsuffix\""); + $entry->setValues('nsslapd-state', 'backend'); + $entry->setValues('nsslapd-backend', $bename); + $context->add($entry); + $rc = $context->getErrorCode(); + if ($rc) { + return ('error_creating_suffix', $suffix, $context->getErrorString()); + } + + return (); +} + +sub findbecb { + my $entry = shift; + my $attrs = shift; + return $entry->hasValue('objectclass', $attrs->[0], 1) && + $entry->hasValue('cn', $attrs->[1], 1); +} + +sub findBackend { + my $context = shift; + my $bename = shift; + my $ent; + if (ref($context) eq 'Mozilla::LDAP::Conn') { + $ent = $context->search("cn=ldbm database,cn=plugins,cn=config", "one", + "(&(objectclass=nsBackendInstance)(cn=$bename)") + } else { + $ent = $context->search("cn=ldbm database,cn=plugins,cn=config", "one", + \&findbecb, ['nsBackendInstance', $bename]) + } +} + +sub findsuffixcb { + my $entry = shift; + my $attrs = shift; + return $entry->hasValue('cn', $attrs->[0], 1) || + $entry->hasValue('cn', $attrs->[1], 1); +} + +sub findSuffix { + my $context = shift; + my $suffix = shift; + my $nsuffix = normalizeDN($suffix); + my $ent; + if (ref($context) eq 'Mozilla::LDAP::Conn') { + $ent = $context->search("cn=mapping tree,cn=config", "one", + "(|(cn=\"$suffix\")(cn=\"$nsuffix\"))"); + } else { + $ent = $context->search("cn=mapping tree,cn=config", "one", + \&findsuffixcb, ["\"$suffix\"", "\"$nsuffix\""]) + } +} + +sub getUniqueBackendName { + my $context = shift; + my $bename = "backend"; + my $index = 0; + my $ent = findBackend($context, ($bename . $index)); + while ($ent) { + ++$index; + $ent = findBackend($context, ($bename . $index)); + } + + return $bename.$index; +} + +sub addSuffix { + my $context = shift; # Conn + my $suffix = shift; + my $bename = shift; # optional + my $ent; + + if ($bename && ($ent = findBackend($context, $bename))) { + return ('backend_already_exists', $bename, $ent->getDN()); + } + + if ($ent = findSuffix($context, $suffix)) { + return ('suffix_already_exists', $suffix, $ent->getDN()); + } + + if (!$bename) { + $bename = getUniqueBackendName($context); + } + + my @errs = newSuffixAndBackend($context, $suffix, $bename); + + return @errs; +} + +# process map table +# [map table sample] +# fqdn = FullMachineName +# hostname = `use Sys::Hostname; $returnvalue = hostname();` +# ds_console_jar ="%normbrand%-ds-%ds_version%.jar" +# +# * If the right-hand value is in ` (backquote), the value is eval'ed by perl. +# The output should be stored in $returnvalue to pass to the internal hash. +# * If the right-hand value is in " (doublequote), the value is passed as is. +# * If the right-hand value is not in any quote, the value should be found +# in either of the setup inf file (static) or the install inf file (dynamic). +# * Variables surrounded by @ (e.g., @admin_confdir@) are replaced with the +# system path at the compile time. +# * The right-hand value can contain variables surrounded by % (e.g., %asid%) +# which refers the right-hand value (key) of this map file. +# The %token% tokens are replaced in getMappedEntries +sub process_maptbl +{ + my ($mapper, $errs, @infdata) = @_; + my @deferredkeys = (); + + if (defined($mapper->{""})) { + $mapper = $mapper->{""}; # side effect of Inf with no sections + } + + KEY: foreach my $key (keys %{$mapper}) + { + my $value = $mapper->{$key}; + if ($value =~ /^\"/) + { + $value =~ tr/\"//d; # value is a regular double quoted string - remove quotes + $mapper->{$key} = $value; + } + elsif ($value =~ /^\`/) + { + push @deferredkeys, $key; # process these last + } + else + { + # get the value from one of the Inf passed in + # they $value could be pure Key or Key:"default_value" + my ($key_value, $default_value) = split(/:/, $value, 2); + my $infsection; + foreach my $thisinf (@infdata) + { + foreach my $section0 (keys %{$thisinf}) + { + $infsection = $thisinf->{$section0}; + next if (!ref($infsection)); + if (defined($infsection->{$key_value})) + { + $mapper->{$key} = $infsection->{$key_value}; + next KEY; + } + } + } + if (!defined($infsection->{$value})) + { + if ($default_value ne "") + { + $default_value =~ tr/\"//d; # default_value is a regular double quoted string - remove quotes + $mapper->{$key} = $default_value; + } + else + { + push @{$errs}, ['no_mapvalue_for_key', $value, $key]; + return {}; + } + } + } + } + + # we have to process the perl expressions to eval last, because those + # expressions may use mappings defined elsewhere in the file, and we are not + # guaranteed of the order in which hash keys are enumerated + foreach my $key (@deferredkeys) { + my $value = $mapper->{$key}; + $value =~ tr/\`//d; # value is a perl expression to eval + my $returnvalue; # set in eval expression + eval $value; + $mapper->{$key} = $returnvalue; # perl expression sets $returnvalue + } + + return $mapper; +} + +# given a string, escape the characters in the string +# so that it can be safely passed to the shell via +# the system() call or `` backticks +sub shellEscape { + my $val = shift; + # first, escape the double quotes and slashes + $val =~ s/([\\"])/\\$1/g; # " font lock fun + # next, escape the rest of the special chars + my $special = '!$\' @#%^&*()|[\]{};:<>?/`'; + $val =~ s/([$special])/\\$1/g; + + return $val; +} + +sub getHashedPassword { + my $pwd = shift; + my $alg = shift; + + if ($pwd =~ /\{\w+\}.+/) { + return $pwd; # already hashed + } + + my $cmd = "@bindir@/pwdhash"; + if ($alg) { + $cmd .= " -s $alg"; + } + $cmd .= " " . shellEscape($pwd); + my $hashedpwd = `$cmd`; + chomp($hashedpwd); + + return $hashedpwd; +} + +# this creates an Inf suitable for passing to createDSInstance +# except that it has a bogus suffix +sub createInfFromConfig { + my $configdir = shift; + my $inst = shift; + my $errs = shift; + my $fname = "$configdir/dse.ldif"; + my $id; + ($id = $inst) =~ s/^slapd-//; + if (! -f $fname || ! -r $fname) { + push @{$errs}, "error_opening_dseldif", $fname, $!; + return 0; + } + my $conn = new FileConn($fname, 1); + if (!$conn) { + push @{$errs}, "error_opening_dseldif", $fname, $!; + return 0; + } + + my $ent = $conn->search("cn=config", "base", "(objectclass=*)"); + if (!$ent) { + push @{$errs}, "error_opening_dseldif", $fname, $!; + $conn->close(); + return 0; + } + + my ($outfh, $inffile) = tempfile(SUFFIX => '.inf'); + if (!$outfh || !$inffile) { + push @{$errs}, "error_opening_tempinf", $fname, $!; + if ($outfh) { + close $outfh; + } + $conn->close(); + return 0; + } + print $outfh "[General]\n"; + print $outfh "FullMachineName = ", $ent->getValues('nsslapd-localhost'), "\n"; + print $outfh "SuiteSpotUserID = ", $ent->getValues('nsslapd-localuser'), "\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"; + + my $suffix; + $ent = $conn->search("cn=ldbm database,cn=plugins,cn=config", + "one", "(objectclass=*)"); + if (!$ent) { + push @{$errs}, "error_opening_dseldif", $fname, $!; + close $outfh; + $conn->close(); + return 0; + } + # use the userRoot suffix if available + while ($ent) { + $suffix = $ent->getValues('nsslapd-suffix'); + last if ($ent->hasValue('cn', 'userRoot', 1)); + $ent = $conn->nextEntry(); + } + + # we also need the instance dir + $ent = $conn->search("cn=config", "base", "(objectclass=*)"); + if (!$ent) { + push @{$errs}, "error_opening_dseldif", $fname, $!; + close $outfh; + $conn->close(); + return 0; + } + my $inst_dir = $ent->getValue('nsslapd-instancedir'); + + $conn->close(); + + if ($inst_dir) { + print $outfh "inst_dir = $inst_dir\n"; + } + print $outfh "Suffix = $suffix\n"; + close $outfh; + + my $inf = new Inf($inffile); + + return $inf; +} + +# like File::Path mkpath, except we can set the owner and perm +# of each new path and parent path created +sub makePaths { + my ($path, $mode, $user, $group) = @_; + my $uid = getpwnam $user; + my $gid = -1; # default to leave it alone + my $mode_string = ""; + + if ($group) { + $gid = getgrnam $group; + } + my @dirnames = ($path); + my $parent = $path; + for ($parent = dirname($parent); + $parent and ($parent ne "/"); + $parent = dirname($parent)) { + unshift @dirnames, $parent; + } + for my $dir (@dirnames) { + next if (-d $dir); + $! = 0; # clear + mkdir $dir, $mode; + if ($!) { + return ('error_creating_directory', $dir, $!); + } + chown $uid, $gid, $dir; + if ($!) { + return ('error_chowning_directory', $dir, $!); + } + chmod $mode, $dir; + $mode_string = sprintf "%lo", $mode; + debug(1, "makePaths: created directory $dir mode $mode_string user $user group $group\n"); + debug(2, "\t" . `ls -ld $dir`); + } + + return (); +} + +# remove_tree($centry, $key, $instname, [$isparent, [$dontremove]]) +# $centry: entry to look for the path to be removed +# $key: key to look for the path in the entry +# $instname: instance name "slapd-" to check the path +# $isparent: specify 1 to remove from the parent dir +# $dontremove: pattern not to be removed (e.g., ".db$") +sub remove_tree +{ + my $centry = shift; + my $key = shift; + my $instname = shift; + my $isparent = shift; + my $dontremove = shift; + my @errs = (); # a list of array refs - each array ref is suitable for passing to Resource::getText + + foreach my $path ( @{$centry->{$key}} ) + { + my $rmdir = ""; + my $rc = 0; + if ( 1 == $isparent ) + { + $rmdir = dirname($path); + } + else + { + $rmdir = $path; + } + if ( -d $rmdir && $rmdir =~ /$instname/ ) + { + if ( "" eq "$dontremove" ) + { + $rc = rmtree($rmdir); + if ( 0 == $rc ) + { + push @errs, [ 'error_removing_path', $rmdir, $! ]; + debug(1, "Warning: $rmdir was not removed. Error: $!\n"); + } + } + else + { + # Skip the dontremove files + $rc = opendir(DIR, $rmdir); + if ($rc) + { + while (defined(my $file = readdir(DIR))) + { + next if ( "$file" =~ /$dontremove/ ); + next if ( "$file" eq "." ); + next if ( "$file" eq ".." ); + my $rmfile = $rmdir . "/" . $file; + my $rc0 = rmtree($rmfile); + if ( 0 == $rc0 ) + { + push @errs, [ 'error_removing_path', $rmfile, $! ]; + debug(1, "Warning: $rmfile was not removed. Error: $!\n"); + } + } + closedir(DIR); + } + my $newrmdir = $rmdir . ".removed"; + my $rc1 = 1; + if ( -d $newrmdir ) + { + $rc1 = rmtree($newrmdir); + if ( 0 == $rc1 ) + { + push @errs, [ 'error_removing_path', $newrmdir, $! ]; + debug(1, "Warning: $newrmdir was not removed. Error: $!\n"); + } + } + if ( 0 < $rc1 ) + { + rename($rmdir, $newrmdir); + } + } + } + } + + return @errs; # a list of array refs - if (!@errs) then success +} + +sub remove_pidfile +{ + my ($type, $instdir, $instname) = @_; + my $serv_id; + my $run_dir; + my $product_name; + my $pidfile; + + # Get the serv_id from the start-slapd script. + unless(open(INFILE,"$instdir/start-slapd")) { + print("Cannot open start-slapd file for reading "); return 0; + } + my $line; + while($line = ) { + if ($line =~ /start-dirsrv /g) { + my @servline=split(/start-dirsrv /, $line); + @servline=split(/\s+/, $servline[1]); + $serv_id=$servline[0]; + } + } + close(INFILE); + + # Get the run_dir and product_name from the instance initconfig script. + unless(open(INFILE,"@initconfigdir@/@package_name@-$serv_id")) { + print("Couldn't open @initconfigdir@/@package_name@-$serv_id "); return 0; + } + while($line = ) { + if ($line =~ /RUN_DIR=/g) { + my @rundir_line=split(/RUN_DIR=+/, $line); + @rundir_line=split(/;/, $rundir_line[1]); + $run_dir = $rundir_line[0]; + chop($run_dir); + } elsif ($line =~ /PRODUCT_NAME=/g) { + my @product_line=split(/PRODUCT_NAME=+/, $line); + @product_line=split(/;/, $product_line[1]); + $product_name = $product_line[0]; + chop($product_name); + } + } + close(INFILE); + + # Construct the pidfile name as follows: + # PIDFILE=$RUN_DIR/$PRODUCT_NAME-$SERV_ID.pid + # STARTPIDFILE=$RUN_DIR/$PRODUCT_NAME-$SERV_ID.startpid + if ($type eq "PIDFILE") { + $pidfile = $run_dir . "/" . $product_name . "-" . $serv_id . ".pid"; + } elsif ($type eq "STARTPIDFILE") { + $pidfile = $run_dir . "/" . $product_name . "-" . $serv_id . ".startpid"; + } + + if ( -e $pidfile && $pidfile =~ /$instname/ ) + { + unlink($pidfile); + } +} + +1; + +# emacs settings +# Local Variables: +# mode:perl +# indent-tabs-mode: nil +# tab-width: 4 +# End: diff --git a/ldap/admin/src/scripts/FileConn.pm b/ldap/admin/src/scripts/FileConn.pm index bead2a48..ac6055d4 100644 --- a/ldap/admin/src/scripts/FileConn.pm +++ b/ldap/admin/src/scripts/FileConn.pm @@ -46,7 +46,7 @@ use Mozilla::LDAP::API qw(:constant ldap_explode_dn ldap_err2string); # Direct a use Mozilla::LDAP::Utils qw(normalizeDN); use Mozilla::LDAP::LDIF; -use Util qw(debug); +use DSUtil qw(debug); require Exporter; @ISA = qw(Exporter Mozilla::LDAP::Conn); diff --git a/ldap/admin/src/scripts/Migration.pm.in b/ldap/admin/src/scripts/Migration.pm.in index 65ea1acf..44613a80 100644 --- a/ldap/admin/src/scripts/Migration.pm.in +++ b/ldap/admin/src/scripts/Migration.pm.in @@ -71,7 +71,7 @@ use Getopt::Long; use File::Temp qw(tempfile tempdir); use SetupLog; -use Util; +use DSUtil; # process command line options Getopt::Long::Configure(qw(bundling)); # bundling allows -ddddd @@ -184,7 +184,7 @@ sub init { GetOptions('help|h|?' => sub { VersionMessage(); HelpMessage(); exit 0 }, 'version|v' => sub { VersionMessage(); exit 0 }, - 'debug|d+' => \$Util::debuglevel, + 'debug|d+' => \$DSUtil::debuglevel, 'silent|s' => \$silent, 'file|f=s' => \$inffile, 'keepcache|k' => \$keep, diff --git a/ldap/admin/src/scripts/Setup.pm.in b/ldap/admin/src/scripts/Setup.pm.in index 5927d40b..021a99c7 100644 --- a/ldap/admin/src/scripts/Setup.pm.in +++ b/ldap/admin/src/scripts/Setup.pm.in @@ -69,7 +69,7 @@ use Getopt::Long; use File::Temp qw(tempfile tempdir); use SetupLog; -use Util; +use DSUtil; use Inf; use strict; @@ -130,7 +130,7 @@ sub init { GetOptions('help|h|?' => sub { VersionMessage(); HelpMessage(); exit 0 }, 'version|v' => sub { VersionMessage(); exit 0 }, - 'debug|d+' => \$Util::debuglevel, + 'debug|d+' => \$DSUtil::debuglevel, 'silent|s' => \$silent, 'file|f=s' => \$inffile, 'keepcache|k' => \$keep, diff --git a/ldap/admin/src/scripts/SetupDialogs.pm.in b/ldap/admin/src/scripts/SetupDialogs.pm.in index 29d327a9..e925c4b2 100644 --- a/ldap/admin/src/scripts/SetupDialogs.pm.in +++ b/ldap/admin/src/scripts/SetupDialogs.pm.in @@ -44,7 +44,7 @@ use DialogManager; use Setup; use Dialog; use Net::Domain qw(hostfqdn); -use Util; +use DSUtil; my $welcome = new DialogYesNo ( $EXPRESS, diff --git a/ldap/admin/src/scripts/Util.pm.in b/ldap/admin/src/scripts/Util.pm.in deleted file mode 100644 index 29f268f5..00000000 --- a/ldap/admin/src/scripts/Util.pm.in +++ /dev/null @@ -1,980 +0,0 @@ -# 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 -# - -package Util; - -use Mozilla::LDAP::Conn; -use Mozilla::LDAP::Utils qw(normalizeDN); -use Mozilla::LDAP::API qw(:constant ldap_explode_dn ldap_err2string) ; # Direct access to C API -use Mozilla::LDAP::LDIF; - -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries - process_maptbl check_and_add_entry getMappedEntries addErr - getHashedPassword debug createInfFromConfig shellEscape - isValidServerID isValidUser makePaths getLogin remove_tree remove_pidfile); -@EXPORT_OK = qw(portAvailable getAvailablePort isValidDN addSuffix getMappedEntries - process_maptbl check_and_add_entry getMappedEntries addErr - getHashedPassword debug createInfFromConfig shellEscape - isValidServerID isValidUser makePaths getLogin remove_tree remove_pidfile); - -use strict; - -use Socket; - -use File::Temp qw(tempfile tempdir); -use File::Basename qw(dirname); -use File::Path qw(rmtree); - -use Carp; - -$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; - my $proto = getprotobyname('tcp'); - my $rc = socket(SOCK, PF_INET, SOCK_STREAM, $proto); - if ($rc == 1) { - setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, 1); - $rc = bind(SOCK, sockaddr_in($port, INADDR_ANY)); - } - close(SOCK); - return $rc and ($rc == 1); -} - -# returns a randomly assigned port number, or -1 -# if not able to find an available port -sub getAvailablePort { - my $MINPORT = 1024; - my $MAXPORT = 65535; - - srand( time() ^ ($$ + ($$ << 15)) ); - while (1) { - my $port = $MINPORT + int(rand($MAXPORT-$MINPORT)); - - if (portAvailable($port)) { - return $port; - } - } -} - -sub isValidDN { - my $dn = shift; - return ($dn =~ /^[0-9a-zA-Z_-]+=.*$/); -} - -sub isValidServerID { - my $servid = shift; - my $validchars = '#%:\w@_-'; - return $servid =~ /^[$validchars]+$/o; -} - -# we want the name of the effective user id of this process e.g. if someone did -# an su root, we want getLogin to return "root" not the originating id (getlogin) -# in perl, $> is the effective numeric user id - we need to turn it into a string -# use confess here because if we cannot determine the user, something is really, -# really wrong and we need to abort immediately -sub getLogin { - return (getpwuid($>))[0] || $ENV{USER} || confess "Error: could not determine the current user ID: $!"; -} - -sub isValidUser { - my $user = shift; - # convert numeric uid to string - my $strans = $user; - if ($user =~ /^\d+$/) { # numeric - convert to string - $strans = getpwuid $user; - if (!$strans) { - return ("dialog_ssuser_error", $user); - } - } - if ($> != 0) { # if not root, the user must be our uid - my $username = getLogin; - if ($strans ne $username) { - return ("dialog_ssuser_must_be_same", $username); - } - } else { # user is root - verify id - my $nuid = getpwnam $strans; - if (!defined($nuid)) { - return ("dialog_ssuser_error", $user); - } - if (!$nuid) { - debug(0, "Warning: using root as the server user id. You are strongly encouraged to use a non-root user.\n"); - } - } - - return (); -} - -# delete the subtree starting from the passed entry -sub delete_all -{ - my ($conn, $bentry) = @_; - my $sentry = $conn->search($bentry->{dn}, - "subtree", "(objectclass=*)", 0, ("dn")); - my @mystack = (); - while ($sentry) { - push @mystack, $sentry->getDN(); - $sentry = $conn->nextEntry(); - } - # reverse order - my $dn = pop @mystack; - while ($dn) { - $conn->delete($dn); - my $rc = $conn->getErrorCode(); - if ( $rc != 0 ) { - debug(1, "ERROR: unable to delete entry $dn, error code: $rc:" . $conn->getErrorString() . "\n"); - return 1; - } - $dn = pop @mystack; - } - return 0; -} - -# if the entry does not exist on the server, add the entry. -# otherwise, do nothing -# you can use this as the callback to getMappedEntries, so -# that for each entry in the ldif file being processed, you -# can call this subroutine to add or update the entry -# use like this: -# getMappedEntries($mapper, \@ldiffiles, \&check_and_add_entry, -# [$conn, $fresh, $verbose]); -# where $conn is a perldap Conn -# $fresh if true will update the entry if it exists -# $verbose prints out more info -sub check_and_add_entry -{ - my ($context, $aentry, $errs) = @_; - my $conn = $context->[0]; - my $fresh = $context->[1]; - 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"); - if (! @ctypes) { # entry exists, and this is not a modify op - debug(3, "check_and_add_entry: skipping entry " . $sentry->getDN() . "\n"); - return 1; # ignore - return success - } - } else { - debug(3, "check_and_add_entry: Entry not found " . $aentry->{dn} . - " error " . $conn->getErrorString() . "\n"); - if (@ctypes) { # uh oh - attempt to del/mod an entry that doesn't exist - debug(3, "check_and_add_entry: attepting to @ctypes the entry " . $aentry->{dn} . - " that does not exist\n"); - return 1; # ignore - return success - } - } - do - { - 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 $OP_NONE = 0; - my $OP_ADD = 1; - my $OP_MOD = 2; - my $OP_DEL = 3; - # $op stores either of the above $OP_ values - my $op = $OP_NONE; - if ( 0 > $#ctypes ) # aentry: complete entry - { - $op = $OP_ADD; # just add the entry - } - else # aentry: modify format - { - if ( $sentry ) - { - if ( "delete" eq lc($ctypes[0]) ) - { - $op = $OP_DEL; - } - else - { - @addtypes = $aentry->getValues("add"); - @reptypes = $aentry->getValues("replace"); - @deltypes = $aentry->getValues("delete"); - $op = $OP_MOD; - } - } - else - { - $op = $OP_NONE; - } - } - - if ( $OP_ADD == $op ) - { - $conn->add($aentry); - my $rc = $conn->getErrorCode(); - if ( $rc != 0 ) - { - my $string = $conn->getErrorString(); - push @{$errs}, 'error_adding_entry', $aentry->{dn}, $string; - debug(1, "ERROR: adding an entry $aentry->{dn} failed, error: $string\n"); - $aentry->printLDIF(); - $conn->close(); - return 0; - } - debug(1, "Entry $aentry->{dn} is added\n"); - } - elsif ( $OP_DEL == $op ) - { - my $rc = delete_all($conn, $sentry); - if ( 0 != $rc ) - { - push @{$errs}, 'error_deleteall_entries', $sentry->{dn}, $conn->getErrorString(); - debug(1, "Error deleting $sentry->{dn}\n"); - return 0; - } - debug(1, "Entry $aentry->{dn} is deleted\n"); - } - elsif ( 0 < $op ) # modify op - { - my $attr; - my @errsToIgnore; - if (@addtypes) { - push @errsToIgnore, LDAP_TYPE_OR_VALUE_EXISTS; - } - foreach $attr ( @addtypes ) - { - foreach my $val ($aentry->getValues($attr)) - { - debug(3, "Adding attr=$attr value=$val to entry $aentry->{dn}\n"); - $sentry->addValue( $attr, $val ); - } - } - foreach $attr ( @reptypes ) - { - my @vals = $aentry->getValues($attr); - debug(3, "Replacing attr=$attr values=" . $aentry->getValues($attr) . " to entry $aentry->{dn}\n"); - $sentry->setValues($attr, @vals); - } - if (@deltypes) { - push @errsToIgnore, LDAP_NO_SUCH_ATTRIBUTE; - } - foreach $attr ( @deltypes ) - { - # removeValue takes a single value only - if (!$aentry->size($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)) - { - $sentry->removeValue($attr, $val); - } - } - } - $conn->update($sentry); - my $rc = $conn->getErrorCode(); - if ( $rc != 0 ) - { - my $string = $conn->getErrorString(); - debug(1, "ERROR: updating an entry $sentry->{dn} failed, error: $string\n"); - if (grep /^$rc$/, @errsToIgnore) { - debug(1, "Ignoring error $rc returned by adding @addtypes deleting @deltypes\n"); - } else { - push @{$errs}, 'error_updating_entry', $sentry->{dn}, $string; - $aentry->printLDIF(); - $conn->close(); - return 0; - } - } - } - if ( $sentry ) - { - $sentry = $conn->nextEntry(); # supposed to have no more entries - } - } until ( !$sentry ); -out: - return 1; -} - -# the default callback used with getMappedEntries -# just adds the given entry to the given list -sub cbaddent { - my $list = shift; - my $ent = shift; - push @{$list}, $ent; - return 1; -} - -# given a mapper and a list of LDIF files, produce a list of -# perldap Entry objects which have had their tokens subst-ed -# with values from the mapper -# An optional callback can be supplied. Each entry will be -# given to this callback. The callback should return a list -# of localizable errors. If no callback is supplied, the -# entries will be returned in a list. -# Arguments: -# mapper - a hash ref - the keys are the tokens to replace -# and the values are the replacements -# ldiffiles - an array ref - the list of LDIF files to -# operate on -# errs - an array ref - this is filled in with the -# errors encountered in processing - this is -# suitable for passing to setup->msg or -# Resource->getText -# callback (optional) - a code ref - a ref to a subroutine -# that will be called with each entry - see below -# context (optional) - this will be passed as the first -# argument to your given callback - see below -# Callback: -# The callback sub will be called for each entry after -# the entry has been converted. The callback will be -# called with the given context as the first argument -# and the Mozilla::LDAP::Entry as the second argument, -# and an errs array ref as the third argument. The -# callback should return true to continue processing, -# or false if a fatal error was encountered that should -# abort processing of any further. -# Errors: -# This function should return an array of errors in the -# format described below, for use with Resource::getText() -# or Setup::msg() -# Return: -# The return value is a list of entries. -# Example usage: -# sub handle_entries { -# my $context = shift; -# my $entry = shift; -# my $errs = shift; -# .... do something with entry .... -# .... if $context is Mozilla::LDAP::Conn, $conn->add($entry); ... -# .... report errors .... -# if ($fatalerror) { -# push @{$errs}, 'error_token', arg1, arg2, ...; -# return 0; -# } else { -# return 1; -# } -# } -# $mapper = {foo => 'bar', baz => 'biff'}; -# @ldiffiles = ('foo.ldif', 'bar.ldif', ..., 'biff.ldif'); -# $conn = new Mozilla::LDAP::Conn(...); -# my @errs; -# @entries = getMappedEntries($mapper, \@ldiffiles, \@errs, \&handle_entries, $conn); -# Note that this will return 0 entries since a callback was used. -# The simpler example is this: -# @entries = getMappedEntries($mapper, \@ldiffiles, \@errs); -# -sub getMappedEntries { - my $mapper = shift; - my $ldiffiles = shift; - my $errs = shift; - my $callback = shift || \&cbaddent; # default - just add entry to @entries - my @entries = (); - my $context = shift || \@entries; - my $error; - - if (!ref($ldiffiles)) { - $ldiffiles = [ $ldiffiles ]; - } - - foreach my $ldiffile (@{$ldiffiles}) { - if (!open(MYLDIF, "< $ldiffile")) { - push @{$errs}, "error_opening_ldiftmpl", $ldiffile, $!; - return 0; - } - my $in = new Mozilla::LDAP::LDIF(*MYLDIF); - debug(1, "Processing $ldiffile ...\n"); - ENTRY: while (my $entry = Mozilla::LDAP::LDIF::readOneEntry($in)) { - # first, fix the DN - my $dn = $entry->getDN(); - my $origdn = $dn; - while ( $dn =~ /%([\w_-]+)%/ ) { - if (exists($mapper->{$1})) { - $dn =~ s{%([\w_-]+)%}{$mapper->{$1}}ge; - } else { - push @{$errs}, 'error_mapping_token_ldiftmpl', $dn, $ldiffile, $1; - $error = 1; - last ENTRY; - } - } - $entry->setDN($dn); - # next, fix all of the values in all of the attributes - foreach my $attr (keys %{$entry}) { - my @newvalues = (); - foreach my $value ($entry->getValues($attr)) { - # Need to repeat to handle nested subst - my $origvalue = $value; - while ( $value =~ /%([\w_-]+)%/ ) { - if (exists($mapper->{$1})) { - $value =~ s{%([\w_-]+)%}{$mapper->{$1}}ge; - } else { - push @{$errs}, 'error_mapping_token_ldiftmpl', $dn, $ldiffile, $1; - debug(1, "ERROR: \"$origvalue\" mapped to \"$value\".\n"); - $error = 1; - last ENTRY; - } - } - push @newvalues, $value; - } - $entry->setValues( $attr, @newvalues ); - } - - if (!&{$callback}($context, $entry, $errs)) { - debug(1, "ERROR: There was an error processing entry ". $entry->getDN(). "\n"); - debug(1, "Cannot continue processing entries.\n"); - $error = 1; - last ENTRY; - } - - } - close(MYLDIF); - last if ($error); # do not process any more ldiffiles if an error occurred - } - - return @entries; -} - -# you should only use this function if you know for sure -# that the suffix and backend do not already exist -# use addSuffix instead -sub newSuffixAndBackend { - my $context = shift; - my $suffix = shift; - my $bename = shift; - my $nsuffix = normalizeDN($suffix); - my @errs; - - my $dn = "cn=$bename, cn=ldbm database, cn=plugins, cn=config"; - my $entry = new Mozilla::LDAP::Entry(); - $entry->setDN($dn); - $entry->setValues('objectclass', 'top', 'extensibleObject', 'nsBackendInstance'); - $entry->setValues('cn', $bename); - $entry->setValues('nsslapd-suffix', $nsuffix); - $context->add($entry); - my $rc = $context->getErrorCode(); - if ($rc) { - return ('error_creating_suffix_backend', $suffix, $bename, $context->getErrorString()); - } - - $entry = new Mozilla::LDAP::Entry(); - $dn = "cn=\"$nsuffix\", cn=mapping tree, cn=config"; - $entry->setDN($dn); - $entry->setValues('objectclass', 'top', 'extensibleObject', 'nsMappingTree'); - $entry->setValues('cn', "\"$nsuffix\""); - $entry->setValues('nsslapd-state', 'backend'); - $entry->setValues('nsslapd-backend', $bename); - $context->add($entry); - $rc = $context->getErrorCode(); - if ($rc) { - return ('error_creating_suffix', $suffix, $context->getErrorString()); - } - - return (); -} - -sub findbecb { - my $entry = shift; - my $attrs = shift; - return $entry->hasValue('objectclass', $attrs->[0], 1) && - $entry->hasValue('cn', $attrs->[1], 1); -} - -sub findBackend { - my $context = shift; - my $bename = shift; - my $ent; - if (ref($context) eq 'Mozilla::LDAP::Conn') { - $ent = $context->search("cn=ldbm database,cn=plugins,cn=config", "one", - "(&(objectclass=nsBackendInstance)(cn=$bename)") - } else { - $ent = $context->search("cn=ldbm database,cn=plugins,cn=config", "one", - \&findbecb, ['nsBackendInstance', $bename]) - } -} - -sub findsuffixcb { - my $entry = shift; - my $attrs = shift; - return $entry->hasValue('cn', $attrs->[0], 1) || - $entry->hasValue('cn', $attrs->[1], 1); -} - -sub findSuffix { - my $context = shift; - my $suffix = shift; - my $nsuffix = normalizeDN($suffix); - my $ent; - if (ref($context) eq 'Mozilla::LDAP::Conn') { - $ent = $context->search("cn=mapping tree,cn=config", "one", - "(|(cn=\"$suffix\")(cn=\"$nsuffix\"))"); - } else { - $ent = $context->search("cn=mapping tree,cn=config", "one", - \&findsuffixcb, ["\"$suffix\"", "\"$nsuffix\""]) - } -} - -sub getUniqueBackendName { - my $context = shift; - my $bename = "backend"; - my $index = 0; - my $ent = findBackend($context, ($bename . $index)); - while ($ent) { - ++$index; - $ent = findBackend($context, ($bename . $index)); - } - - return $bename.$index; -} - -sub addSuffix { - my $context = shift; # Conn - my $suffix = shift; - my $bename = shift; # optional - my $ent; - - if ($bename && ($ent = findBackend($context, $bename))) { - return ('backend_already_exists', $bename, $ent->getDN()); - } - - if ($ent = findSuffix($context, $suffix)) { - return ('suffix_already_exists', $suffix, $ent->getDN()); - } - - if (!$bename) { - $bename = getUniqueBackendName($context); - } - - my @errs = newSuffixAndBackend($context, $suffix, $bename); - - return @errs; -} - -# process map table -# [map table sample] -# fqdn = FullMachineName -# hostname = `use Sys::Hostname; $returnvalue = hostname();` -# ds_console_jar ="%normbrand%-ds-%ds_version%.jar" -# -# * If the right-hand value is in ` (backquote), the value is eval'ed by perl. -# The output should be stored in $returnvalue to pass to the internal hash. -# * If the right-hand value is in " (doublequote), the value is passed as is. -# * If the right-hand value is not in any quote, the value should be found -# in either of the setup inf file (static) or the install inf file (dynamic). -# * Variables surrounded by @ (e.g., @admin_confdir@) are replaced with the -# system path at the compile time. -# * The right-hand value can contain variables surrounded by % (e.g., %asid%) -# which refers the right-hand value (key) of this map file. -# The %token% tokens are replaced in getMappedEntries -sub process_maptbl -{ - my ($mapper, $errs, @infdata) = @_; - my @deferredkeys = (); - - if (defined($mapper->{""})) { - $mapper = $mapper->{""}; # side effect of Inf with no sections - } - - KEY: foreach my $key (keys %{$mapper}) - { - my $value = $mapper->{$key}; - if ($value =~ /^\"/) - { - $value =~ tr/\"//d; # value is a regular double quoted string - remove quotes - $mapper->{$key} = $value; - } - elsif ($value =~ /^\`/) - { - push @deferredkeys, $key; # process these last - } - else - { - # get the value from one of the Inf passed in - # they $value could be pure Key or Key:"default_value" - my ($key_value, $default_value) = split(/:/, $value, 2); - my $infsection; - foreach my $thisinf (@infdata) - { - foreach my $section0 (keys %{$thisinf}) - { - $infsection = $thisinf->{$section0}; - next if (!ref($infsection)); - if (defined($infsection->{$key_value})) - { - $mapper->{$key} = $infsection->{$key_value}; - next KEY; - } - } - } - if (!defined($infsection->{$value})) - { - if ($default_value ne "") - { - $default_value =~ tr/\"//d; # default_value is a regular double quoted string - remove quotes - $mapper->{$key} = $default_value; - } - else - { - push @{$errs}, ['no_mapvalue_for_key', $value, $key]; - return {}; - } - } - } - } - - # we have to process the perl expressions to eval last, because those - # expressions may use mappings defined elsewhere in the file, and we are not - # guaranteed of the order in which hash keys are enumerated - foreach my $key (@deferredkeys) { - my $value = $mapper->{$key}; - $value =~ tr/\`//d; # value is a perl expression to eval - my $returnvalue; # set in eval expression - eval $value; - $mapper->{$key} = $returnvalue; # perl expression sets $returnvalue - } - - return $mapper; -} - -# given a string, escape the characters in the string -# so that it can be safely passed to the shell via -# the system() call or `` backticks -sub shellEscape { - my $val = shift; - # first, escape the double quotes and slashes - $val =~ s/([\\"])/\\$1/g; # " font lock fun - # next, escape the rest of the special chars - my $special = '!$\' @#%^&*()|[\]{};:<>?/`'; - $val =~ s/([$special])/\\$1/g; - - return $val; -} - -sub getHashedPassword { - my $pwd = shift; - my $alg = shift; - - if ($pwd =~ /\{\w+\}.+/) { - return $pwd; # already hashed - } - - my $cmd = "@bindir@/pwdhash"; - if ($alg) { - $cmd .= " -s $alg"; - } - $cmd .= " " . shellEscape($pwd); - my $hashedpwd = `$cmd`; - chomp($hashedpwd); - - return $hashedpwd; -} - -# this creates an Inf suitable for passing to createDSInstance -# except that it has a bogus suffix -sub createInfFromConfig { - my $configdir = shift; - my $inst = shift; - my $errs = shift; - my $fname = "$configdir/dse.ldif"; - my $id; - ($id = $inst) =~ s/^slapd-//; - if (! -f $fname || ! -r $fname) { - push @{$errs}, "error_opening_dseldif", $fname, $!; - return 0; - } - my $conn = new FileConn($fname, 1); - if (!$conn) { - push @{$errs}, "error_opening_dseldif", $fname, $!; - return 0; - } - - my $ent = $conn->search("cn=config", "base", "(objectclass=*)"); - if (!$ent) { - push @{$errs}, "error_opening_dseldif", $fname, $!; - $conn->close(); - return 0; - } - - my ($outfh, $inffile) = tempfile(SUFFIX => '.inf'); - if (!$outfh || !$inffile) { - push @{$errs}, "error_opening_tempinf", $fname, $!; - if ($outfh) { - close $outfh; - } - $conn->close(); - return 0; - } - print $outfh "[General]\n"; - print $outfh "FullMachineName = ", $ent->getValues('nsslapd-localhost'), "\n"; - print $outfh "SuiteSpotUserID = ", $ent->getValues('nsslapd-localuser'), "\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"; - - my $suffix; - $ent = $conn->search("cn=ldbm database,cn=plugins,cn=config", - "one", "(objectclass=*)"); - if (!$ent) { - push @{$errs}, "error_opening_dseldif", $fname, $!; - close $outfh; - $conn->close(); - return 0; - } - # use the userRoot suffix if available - while ($ent) { - $suffix = $ent->getValues('nsslapd-suffix'); - last if ($ent->hasValue('cn', 'userRoot', 1)); - $ent = $conn->nextEntry(); - } - - # we also need the instance dir - $ent = $conn->search("cn=config", "base", "(objectclass=*)"); - if (!$ent) { - push @{$errs}, "error_opening_dseldif", $fname, $!; - close $outfh; - $conn->close(); - return 0; - } - my $inst_dir = $ent->getValue('nsslapd-instancedir'); - - $conn->close(); - - if ($inst_dir) { - print $outfh "inst_dir = $inst_dir\n"; - } - print $outfh "Suffix = $suffix\n"; - close $outfh; - - my $inf = new Inf($inffile); - - return $inf; -} - -# like File::Path mkpath, except we can set the owner and perm -# of each new path and parent path created -sub makePaths { - my ($path, $mode, $user, $group) = @_; - my $uid = getpwnam $user; - my $gid = -1; # default to leave it alone - my $mode_string = ""; - - if ($group) { - $gid = getgrnam $group; - } - my @dirnames = ($path); - my $parent = $path; - for ($parent = dirname($parent); - $parent and ($parent ne "/"); - $parent = dirname($parent)) { - unshift @dirnames, $parent; - } - for my $dir (@dirnames) { - next if (-d $dir); - $! = 0; # clear - mkdir $dir, $mode; - if ($!) { - return ('error_creating_directory', $dir, $!); - } - chown $uid, $gid, $dir; - if ($!) { - return ('error_chowning_directory', $dir, $!); - } - chmod $mode, $dir; - $mode_string = sprintf "%lo", $mode; - debug(1, "makePaths: created directory $dir mode $mode_string user $user group $group\n"); - debug(2, "\t" . `ls -ld $dir`); - } - - return (); -} - -# remove_tree($centry, $key, $instname, [$isparent, [$dontremove]]) -# $centry: entry to look for the path to be removed -# $key: key to look for the path in the entry -# $instname: instance name "slapd-" to check the path -# $isparent: specify 1 to remove from the parent dir -# $dontremove: pattern not to be removed (e.g., ".db$") -sub remove_tree -{ - my $centry = shift; - my $key = shift; - my $instname = shift; - my $isparent = shift; - my $dontremove = shift; - my @errs = (); # a list of array refs - each array ref is suitable for passing to Resource::getText - - foreach my $path ( @{$centry->{$key}} ) - { - my $rmdir = ""; - my $rc = 0; - if ( 1 == $isparent ) - { - $rmdir = dirname($path); - } - else - { - $rmdir = $path; - } - if ( -d $rmdir && $rmdir =~ /$instname/ ) - { - if ( "" eq "$dontremove" ) - { - $rc = rmtree($rmdir); - if ( 0 == $rc ) - { - push @errs, [ 'error_removing_path', $rmdir, $! ]; - debug(1, "Warning: $rmdir was not removed. Error: $!\n"); - } - } - else - { - # Skip the dontremove files - $rc = opendir(DIR, $rmdir); - if ($rc) - { - while (defined(my $file = readdir(DIR))) - { - next if ( "$file" =~ /$dontremove/ ); - next if ( "$file" eq "." ); - next if ( "$file" eq ".." ); - my $rmfile = $rmdir . "/" . $file; - my $rc0 = rmtree($rmfile); - if ( 0 == $rc0 ) - { - push @errs, [ 'error_removing_path', $rmfile, $! ]; - debug(1, "Warning: $rmfile was not removed. Error: $!\n"); - } - } - closedir(DIR); - } - my $newrmdir = $rmdir . ".removed"; - my $rc1 = 1; - if ( -d $newrmdir ) - { - $rc1 = rmtree($newrmdir); - if ( 0 == $rc1 ) - { - push @errs, [ 'error_removing_path', $newrmdir, $! ]; - debug(1, "Warning: $newrmdir was not removed. Error: $!\n"); - } - } - if ( 0 < $rc1 ) - { - rename($rmdir, $newrmdir); - } - } - } - } - - return @errs; # a list of array refs - if (!@errs) then success -} - -sub remove_pidfile -{ - my ($type, $instdir, $instname) = @_; - my $serv_id; - my $run_dir; - my $product_name; - my $pidfile; - - # Get the serv_id from the start-slapd script. - unless(open(INFILE,"$instdir/start-slapd")) { - print("Cannot open start-slapd file for reading "); return 0; - } - my $line; - while($line = ) { - if ($line =~ /start-dirsrv /g) { - my @servline=split(/start-dirsrv /, $line); - @servline=split(/\s+/, $servline[1]); - $serv_id=$servline[0]; - } - } - close(INFILE); - - # Get the run_dir and product_name from the instance initconfig script. - unless(open(INFILE,"@initconfigdir@/@package_name@-$serv_id")) { - print("Couldn't open @initconfigdir@/@package_name@-$serv_id "); return 0; - } - while($line = ) { - if ($line =~ /RUN_DIR=/g) { - my @rundir_line=split(/RUN_DIR=+/, $line); - @rundir_line=split(/;/, $rundir_line[1]); - $run_dir = $rundir_line[0]; - chop($run_dir); - } elsif ($line =~ /PRODUCT_NAME=/g) { - my @product_line=split(/PRODUCT_NAME=+/, $line); - @product_line=split(/;/, $product_line[1]); - $product_name = $product_line[0]; - chop($product_name); - } - } - close(INFILE); - - # Construct the pidfile name as follows: - # PIDFILE=$RUN_DIR/$PRODUCT_NAME-$SERV_ID.pid - # STARTPIDFILE=$RUN_DIR/$PRODUCT_NAME-$SERV_ID.startpid - if ($type eq "PIDFILE") { - $pidfile = $run_dir . "/" . $product_name . "-" . $serv_id . ".pid"; - } elsif ($type eq "STARTPIDFILE") { - $pidfile = $run_dir . "/" . $product_name . "-" . $serv_id . ".startpid"; - } - - if ( -e $pidfile && $pidfile =~ /$instname/ ) - { - unlink($pidfile); - } -} - -1; - -# emacs settings -# Local Variables: -# mode:perl -# indent-tabs-mode: nil -# tab-width: 4 -# End: diff --git a/ldap/admin/src/scripts/remove-ds.pl.in b/ldap/admin/src/scripts/remove-ds.pl.in index d82a1816..1d10a91a 100755 --- a/ldap/admin/src/scripts/remove-ds.pl.in +++ b/ldap/admin/src/scripts/remove-ds.pl.in @@ -23,7 +23,7 @@ use strict; use File::Basename; use File::Path; -use Util; +use DSUtil; use Resource; use DSCreate qw(removeDSInstance); @@ -48,7 +48,7 @@ while ($i <= $#ARGV) { $i++; $instname = $ARGV[$i]; } elsif ("$ARGV[$i]" eq "-d") { - $Util::debuglevel++; + $DSUtil::debuglevel++; } else { &usage; exit(1); } diff --git a/ldap/admin/src/scripts/setup-ds.pl.in b/ldap/admin/src/scripts/setup-ds.pl.in index aad6bfc8..266d3965 100644 --- a/ldap/admin/src/scripts/setup-ds.pl.in +++ b/ldap/admin/src/scripts/setup-ds.pl.in @@ -46,7 +46,7 @@ use SetupLog; use Inf; use Resource; use DialogManager; -use Util; +use DSUtil; use DSCreate; use DSUpdate; -- cgit