Utilities cleanup

This is the final patch in a series mostly devoted to clean up of the
common library. After application of this patch pkicommon will be in
it's proposed form.

A large proportion of this patch is devoted to replacing the use of UNIX
shell commands to perform basic file system operations with built in
Perl functions. The other items in this patch are things which didn't
logically fit into any of the other patches.

The rationale for eschewing the use of shell commands where possible
is:

1) shell commands are OS specific, not all UN*X variants have the same
behavior.

2) shell commands are available only on UN*X variants.

3) the built in Perl functions are portable across most OS's

4) the built in Perl functions have better error handling and
reporting

5) the built in Perl functions are more efficient since they don't
need to spawn a shell to do one simple operation, instead they call
into the native OS library in the same process/thread.

6) the built in Perl functions are not subject to shell interpretation
thus making their use more robust. It's not unusual to have to
properly quote arguments when using a shell to protect against
unintended interpretation by the shell. Or worse to expose the
application to injection attacks where expanding a shell command
results in an untended operation performed with root privileges.

Also, many of the commands which used the Perl backtick operator to
perform a shell operation were not properly detecting if the command
failed. The backtick operator returns the stdout of the executed shell
command and discards stderr. The old code would capture the result of
the backtick operator (stdout), test to see if it was the empty string
and if so concluded the command succeeded. This is not correct, one
needs to check the exit status to determine success/failure. If an
error did occur the command probably wrote to stderr, but stderr is
discarded by the backtick operator. All this is documented in the patch
which added the run_command() utility.

For those routines for which there wasn't a Perl built-in equivalent
the code was changed to call run_command() instead of using the
backtick operator.

Each of the utility routines which creates/copies files/directories
had their parameter list expanded to accept optional specification of
the permission and ownership to be applied to the file system
object. This allows one call to replace multiple calls to utility
routines which ultimately makes the code in pkicreate smaller, less
verbose, easier to read and more robust.

The code used to parse an initscript was removed
(extract_chkconfig_parameters_from_start_stop_script()), it wasn't
called and I'm at a loss for why this would have been needed in the
first place. Also the parametrization of the start/stop positions is
changing as we move closer to LSB. The global variable
chkconfig_fields was also removed. It was only used in the routine
extract_chkconfig_parameters_from_start_stop_script(). What's up with
these global variables which should be private to the subroutine
utilizing them?

Many routines had logging added to them for tracing purposes. A call
to emit() with the subroutine name and parameters.

Many routines had the dry run check added to them. If $dry_run is true
they emit their tracing information and then return success.

Many routines had calls to add_install_info() added to them. This is
used to record the installation actions being performed.

Code that formerly had used shell commands to operate recursively on
directories now instead iterate over the contents of the directories
invoking our utilities, this allows us to use our primitives which
record the installation action. For example rather than
copy_directory() doing a "cp -r src dst" we walk the tree and invoke
our own create_directory() and copy_file() routines which are
responsible for recording the operation and doing such things as
setting permissions and ownership.

Comments referencing arg0, arg1, etc. were removed or edited (see
previous patch for parameter list clean up for an explanation).

Some functions were renamed to better reflect their actual operation
as would be understood by a system administrator.
e.g. give_file_to() became set_owner_group(), give_directory_to()
became set_owner_group_on_directory_contents().

A utility called set_permissions() was added as well as a utility
called set_file_props() which sets permissions and ownership with a
single call.

The routines move_file() and move_directory() were removed. They were
using the deprecated shell methodology but were never called by any
code. Rather than re-implement them I just removed them, if we need
these again in the future we can add them back with the preferred Perl
methodology.

A potential bug was fixed in copy_directory(). The logic used to
enumerate the set of destination directories which needed to be
created had a logic flaw. If a source directory was empty it wouldn't
get created in the destination. This occurred because the previous
logic was to enumerate all the source files to be copied and generate
a set of directories from those, but if a directory was empty it
wouldn't show up in the file list. The new logic is to independently
enumerate both directories and files in the src tree, this makes the
directory list complete.

Add utility to return the initscript name, get_registry_initscript_name().


git-svn-id: svn+ssh://svn.fedorahosted.org/svn/pki/trunk@1545 c9f7a03b-bd48-0410-a16d-cbbf54688b0b

1 files changed, 410 insertions, 416 deletions

diff --git a/pki/base/setup/pkicommon b/pki/base/setup/pkicommon
index b6690a17..9f00971f 100755
--- a/pki/base/setup/pkicommon
+++ b/pki/base/setup/pkicommon
@@ -71,16 +71,13 @@ if (($^O ne 'Windows_NT') && ($^O ne 'MSWin32')) {
 # Perl Modules
 ##############################################################
 
-# "File/Copy.pm", "FileHandle.pm", "Getopt/Long.pm",
-# "Socket.pm", and "Sys/Long.pm" are all part of the
-# standard Perl library and should therefore always be
-# available
-use File::Copy;
+use Sys::Hostname;
 use FileHandle;
 use Getopt::Long;
 use Socket;
-use Sys::Hostname;
-
+use File::Copy;
+use File::Basename;
+use File::Path qw(make_path remove_tree);
 
 ##############################################################
 # Shared Default Values
@@ -260,12 +257,6 @@ $verbose = 0;
 # or if actions are only reported (dry_run == true).
 $dry_run = 0;
 
-# chkconfig parameters (Linux ONLY)
-if ($^O eq "linux") {
-    @chkconfig_fields = ();
-}
-
-
 ##############################################################
 # Local Variables
 ##############################################################
@@ -776,7 +767,6 @@ sub setup_platform_dependent_parameters()
 }
 
 
-# arg0 Library Path
 # no return value
 sub set_library_path
 {
@@ -858,10 +848,9 @@ sub create_user
 {
     my ($username, $groupname) = @_;
 
-    my $command = "";
-    my $report = "";
+    emit(sprintf("create_user(%s)\n", join(", ", @_)), "debug");
 
-    my $result = 0;
+    return 1 if ($dry_run);
 
     if (($username eq $PKI_USER) &&
         ($groupname eq $PKI_GROUP)) {
@@ -922,14 +911,8 @@ sub create_user
         }
     }
 
-    $report = `$command`;
-    if ($report ne "") {
-        emit($report, "error");
-    }
-
-    $result = user_exists($username);
-
-    return $result;
+    return 0 if !run_command($command);
+    return user_exists($username);
 }
 
 
@@ -1104,7 +1087,6 @@ sub add_user_as_a_member_of_group
 }
 
 
-# arg0 username
 # return UID, or
 # return (-1) - user is not in password file
 sub get_UID_from_username
@@ -1145,7 +1127,6 @@ sub get_FQDN
 # Generic "availability" Subroutines
 ##############################################################
 
-# arg0 URL prefix
 # return 1 - URL prefix is known (success)
 # return 0 - URL prefix is unknown (failure)
 sub check_for_valid_url_prefix
@@ -1164,11 +1145,6 @@ sub check_for_valid_url_prefix
     return 0;
 }
 
-# arg0 secure_port
-# arg1 unsecure_port
-# arg2 agent_secure_port
-# arg3 ee_secure_port
-# arg4 admin_secure_port 
 # return 1 - ports are valid (success)
 # return 0 - ports have a conflict (failure)
 sub AreConnectorPortsValid 
@@ -1210,8 +1186,6 @@ sub AreConnectorPortsValid
 }
 
 
-# arg0 username
-# arg1 port
 # return 1 - port is available (success)
 # return 0 - port is unavailable; report an error (failure)
 sub IsLocalPortAvailable
@@ -1316,9 +1290,6 @@ sub IsLocalPortAvailable
 }
 
 
-# arg0 HTTP or LDAP prefix
-# arg1 host
-# arg2 port
 # return 2 - warn that server is unreachable (continue)
 # return 1 - server is reachable (success)
 # return 0 - server is unreachable; report an error (failure)
@@ -1450,7 +1421,6 @@ sub generate_random_string()
 # Generic "password" Subroutines
 ##############################################################
 
-# arg0 password
 # return 1 - success
 # return 0 - failure; report an error
 sub password_quality_checker
@@ -1511,10 +1481,10 @@ sub password_quality_checker
 # Generic "LDAP" Subroutines
 ##############################################################
 
-# arg0 tokendb hostname - LDAP server name or IP address (default: localhost)
-# arg1 tokendb port - LDAP server TCP port number (default: 389)
-# arg2 tokendb password - bind passwd (for simple authentication)
-# arg3 tokendb file - read modifications from file (default: standard input)
+# hostname - LDAP server name or IP address (default: localhost)
+# port - LDAP server TCP port number (default: 389)
+# password - bind passwd (for simple authentication)
+# file - read modifications from file (default: standard input)
 # no return value
 sub LDAP_add
 {
@@ -1524,6 +1494,10 @@ sub LDAP_add
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("LDAP_add(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1545,10 +1519,10 @@ sub LDAP_add
 }
 
 
-# arg0 tokendb hostname - LDAP server name or IP address (default: localhost)
-# arg1 tokendb port - LDAP server TCP port number (default: 389)
-# arg2 tokendb password - bind passwd (for simple authentication)
-# arg3 tokendb file - read modifications from file (default: standard input)
+# hostname - LDAP server name or IP address (default: localhost)
+# port - LDAP server TCP port number (default: 389)
+# password - bind passwd (for simple authentication)
+# file - read modifications from file (default: standard input)
 # no return value
 sub LDAP_modify
 {
@@ -1558,6 +1532,10 @@ sub LDAP_modify
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("LDAP_modify(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1582,8 +1560,8 @@ sub LDAP_modify
 # Generic "Security Databases" Subroutines
 ##############################################################
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 password file - Specify the password file
+# instance path - Security databases directory (default is ~/.netscape)
+# password file - Specify the password file
 # no return value
 sub certutil_create_databases
 {
@@ -1593,6 +1571,10 @@ sub certutil_create_databases
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_create_databases(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1617,10 +1599,10 @@ sub certutil_create_databases
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to look for cert (default is internal,
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to look for cert (default is internal,
 #              use "all" to look for cert on all tokens)
-# arg2 nickname - The nickname of the cert to delete
+# nickname - The nickname of the cert to delete
 # no return value
 sub certutil_delete_cert
 {
@@ -1630,6 +1612,10 @@ sub certutil_delete_cert
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_delete_cert(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1649,10 +1635,10 @@ sub certutil_delete_cert
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to generate key (default is internal)
-# arg2 subject - Specify the subject name (using RFC1485)
-# arg3 password file - Specify the password file
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to generate key (default is internal)
+# subject - Specify the subject name (using RFC1485)
+# password file - Specify the password file
 # no return value
 sub certutil_generate_CSR
 {
@@ -1662,6 +1648,10 @@ sub certutil_generate_CSR
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_generate_CSR(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1692,15 +1682,15 @@ sub certutil_generate_CSR
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to store the certificate
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to store the certificate
 #              (default is internal)
-# arg2 serial number - Cert serial number
-# arg3 validity period - Months valid (default is 3)
-# arg4 subject - Specify the subject name (using RFC1485)
-# arg5 issuer name - The nickname of the issuer cert
-# arg6 nickname - Specify the nickname of the server certificate
-# arg7 trust args - Set the certificate trust attributes:
+# serial number - Cert serial number
+# validity period - Months valid (default is 3)
+# subject - Specify the subject name (using RFC1485)
+# issuer name - The nickname of the issuer cert
+# nickname - Specify the nickname of the server certificate
+# trust args - Set the certificate trust attributes:
 #                        p      valid peer
 #                        P      trusted peer (implies p)
 #                        c      valid CA
@@ -1709,9 +1699,9 @@ sub certutil_generate_CSR
 #                        u      user cert
 #                        w      send warning
 #                        g      make step-up cert
-# arg8 noise file - Specify the noise file to be used
+# noise file - Specify the noise file to be used
 #                   (to introduce randomness during key generation)
-# arg9 password file - Specify the password file
+# password file - Specify the password file
 # no return value
 sub certutil_generate_self_signed_cert
 {
@@ -1723,6 +1713,10 @@ sub certutil_generate_self_signed_cert
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_generate_self_signed_cert(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1769,11 +1763,11 @@ sub certutil_generate_self_signed_cert
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to store the certificate
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to store the certificate
 #              (default is internal)
-# arg2 nickname - Specify the nickname of the server certificate
-# arg3 trust args - Set the certificate trust attributes:
+# nickname - Specify the nickname of the server certificate
+# trust args - Set the certificate trust attributes:
 #                        p      valid peer
 #                        P      trusted peer (implies p)
 #                        c      valid CA
@@ -1783,7 +1777,7 @@ sub certutil_generate_self_signed_cert
 #                        w      send warning
 #                        g      make step-up cert
 #                    (e. g. - Server Cert 'u,u,u', CA Cert 'CT,CT,CT')
-# arg4 cert - The certificate encoded in ASCII (RFC1113)
+# cert - The certificate encoded in ASCII (RFC1113)
 # no return value
 sub certutil_import_cert
 {
@@ -1791,6 +1785,10 @@ sub certutil_import_cert
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_import_cert(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1813,10 +1811,10 @@ sub certutil_import_cert
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to look for cert (default is internal,
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to look for cert (default is internal,
 #              use "all" to look for cert on all tokens)
-# arg2 nickname - Pretty print named cert (list all if unspecified)
+# nickname - Pretty print named cert (list all if unspecified)
 # no return value
 sub certutil_print_cert
 {
@@ -1826,6 +1824,10 @@ sub certutil_print_cert
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_print_cert(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1856,8 +1858,8 @@ sub certutil_print_cert
 
 
 # no return value
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token - Name of token in which to look for certs (default is internal,
+# instance path - Security databases directory (default is ~/.netscape)
+# token - Name of token in which to look for certs (default is internal,
 #              use "all" to list certs on all tokens)
 sub certutil_list_certs
 {
@@ -1867,6 +1869,10 @@ sub certutil_list_certs
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("certutil_list_certs(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -1885,9 +1891,9 @@ sub certutil_list_certs
 }
 
 
-# arg0 instance path - Security databases directory (default is ~/.netscape)
-# arg1 token   - Add the named token to the module database
-# arg2 library - The name of the file (.so or .dll) containing the
+# instance path - Security databases directory (default is ~/.netscape)
+# token   - Add the named token to the module database
+# library - The name of the file (.so or .dll) containing the
 #                implementation of PKCS #11
 # no return value
 sub modutil_add_token
@@ -1898,6 +1904,10 @@ sub modutil_add_token
 
     my $original_library_path = get_library_path();
 
+    emit(sprintf("modutil_add_token(%s)\n", join(", ", @_)), "debug");
+
+    return if ($dry_run);
+
     set_library_path($default_security_libraries . $path_sep
                     . $default_system_user_libraries . $path_sep
                     . $default_system_libraries . $path_sep
@@ -2011,17 +2021,13 @@ sub emit
     my $force_emit = 0;
     my $log_entry = "";
 
+    $type = "debug" if !defined($type);
+
     if ($type eq "error" || $type eq "info") {
         $force_emit = 1;
     }
 
-    if ($type eq "") {
-        $type = "debug";
-    }
-
-    if ($string eq "") {
-        return;
-    }
+    return if !$string;
 
     my $stamp = get_time_stamp();
 
@@ -2187,186 +2193,219 @@ sub is_file_empty
 # Return 1 if success, 0 if failure
 sub create_empty_file
 {
-    my ($file) = @_;
+    my ($path, $permissions, $owner, $group, $uninstall_action) = @_;
 
-    if (is_Windows()) {
-        open(FILE, "> $file");
+    emit(sprintf("create_empty_file(%s, %s, %s, %s, %s)\n",
+                 $path,
+                 defined($permissions) ? sprintf("%o", $permissions) : "",
+                 $owner, $group, $uninstall_action), "debug");
+
+    $uninstall_action = 'remove' unless defined($uninstall_action);
+    add_install_info($path, 'file', $uninstall_action);
+
+    if (!$dry_run) {
+        if (!open(FILE, "> $path")) {
+            emit("Cannot create empty file \"$path\" ($!)", 'error');
+            return 0;
+        }
         close(FILE);
-    } else {
-        my $rv = 0;
+    }
 
-        $rv = `touch $file`;
+    if (defined($permissions)) {
+        return 0 if !set_permissions($path, $permissions);
     }
 
-    return;
+    if (defined($owner) && defined($group)) {
+        return 0 if !set_owner_group($path, $owner, $group);
+    }
+
+    return 1;
 }
 
 
 # Return 1 if success, 0 if failure
 sub create_file
 {
-    my ($file, $message) = @_;
+    my ($path, $contents, $permissions, $owner, $group, $uninstall_action) = @_;
 
-    $command = "";
+    emit(sprintf("create_file(%s, %s, %s, %s, %s)\n",
+                 $path,
+                 defined($permissions) ? sprintf("%o", $permissions) : "",
+                 $owner, $group, $uninstall_action), "debug");
 
-    if (is_Windows()) {
-        if ($message eq "") {
-            open(FILE, "> $file");
-            close(FILE);
-        } else {
-            open(FILE, "> $file");
-            print(FILE $message);
+    $uninstall_action = 'remove' unless defined($uninstall_action);
+    add_install_info($path, 'file', $uninstall_action);
+
+    if (!$dry_run) {
+        if (!open(FILE, "> $path")) {
+            emit("could not create file \"$path\" ($!)\n", 'error');
+            return 0;
+        }
+        print(FILE $contents);
             close(FILE);
         }
-    } else {
-        my $rv = 0;
-
-        if ($message eq "") {
-            $rv = `touch $file`;
-            if (!$rv) {
-                emit("create_file():  unable to create empty file called "
-                    . "$file.\n",
-                      "error");
+
+    if (defined($permissions)) {
+        return 0 if !set_permissions($path, $permissions);
             }
-        } else {
-            $command = "echo '$message' > $file";
 
-            system($command);
-        }
+    if (defined($owner) && defined($group)) {
+        return 0 if !set_owner_group($path, $owner, $group);
     }
 
-    return;
+    return 1;
 }
 
 
 # Return 1 if success, 0 if failure
-sub move_file
+sub copy_file
 {
-    my ($file, $dest) = @_;
+    my ($src_path, $dst_path, $permissions, $owner, $group, $uninstall_action) = @_;
 
-    my $result = 0;
+    emit(sprintf("copy_file(%s, %s, %s, %s, %s, %s)\n",
+                 $src_path, $dst_path,
+                 defined($permissions) ? sprintf("%o", $permissions) : "",
+                 $owner, $group, $uninstall_action), "debug");
+
+    $uninstall_action = 'remove' unless defined($uninstall_action);
+    add_install_info($dst_path, 'file', $uninstall_action);
 
-    if (!is_path_valid($file)) {
-        emit("move_file():  illegal source path => $file.\n",
+    if (!is_path_valid($src_path)) {
+        emit("copy_file():  illegal src path => \"$src_path\".\n",
               "error");
+        remove_install_info($dst_path);
         return 0;
     }
 
-    if (!is_path_valid($dest)) {
-        emit("move_file():  illegal destination path => $dest.\n",
+    if (!is_path_valid($dst_path)) {
+        emit("copy_file():  illegal dst path => \"$dst_path\".\n",
               "error");
+        remove_install_info($dst_path);
         return 0;
     }
 
-    $result = `mv $file $dest`;
-    if ($result == 0) {
-        return 1;
+    if (!$dry_run) {
+        if (!copy($src_path, $dst_path)) {
+            emit("copy_file(): \"$src_path\" => \"$dst_path\" ($!)\n", "error");
+            remove_install_info($dst_path);
+        return 0;
+    }
     }
 
-    emit("move_file():  failed moving file $file to $dest.\n",
-          "error");
+    if (defined($permissions)) {
+        return 0 if !set_permissions($dst_path, $permissions);
+    }
 
-    return 0;
+    if (defined($owner) && defined($group)) {
+        return 0 if !set_owner_group($dst_path, $owner, $group);
+    }
+
+    return 1;
 }
 
 
 # Return 1 if success, 0 if failure
-sub copy_file
+sub remove_file
 {
-    my ($source_path, $dest_path) = @_;
-
+    my ($path) = @_;
     my $result = 0;
 
-    if (!is_path_valid($source_path)) {
-        emit("copy_file():  illegal source path => $source_path.\n",
-              "error");
-        return 0;
-    }
+    emit(sprintf("remove_file(%s)\n", join(", ", @_)), "debug");
 
-    if (!is_path_valid($dest_path)) {
-        emit("copy_file():  illegal destination path => $dest_path.\n",
-              "error");
+    add_install_info($path, 'file', 'remove', 'remove');
+
+    return 1 if ($dry_run);
+
+    if (!unlink($path)) {
+        emit("remove_file(): failed to remove file \"$path\" ($!)\n", "error");
         return 0;
     }
 
-    $result = `cp -f $source_path $dest_path`;
-    if ($result == 0) {
         return 1;
     }
 
-    emit("copy_file():  failed copying file from $source_path to "
-        . "$dest_path.\n",
-          "error");
+# set_permissions(path_glob, permissions)
+# Return 1 if success, 0 if failure
+sub set_permissions
+{
+    my ($path_glob, $permissions) = @_;
+    my (@paths, $errstr, $result, $count);
 
-    return 0;
-}
+    $errstr = undef;
+    $count = 0;
+    $result = 1;
 
+    emit(sprintf("set_permissions(%s, %s)\n",
+                 $path_glob,
+                 defined($permissions) ? sprintf("%o", $permissions) : ""), "debug");
 
-# Return 1 if success, 0 if failure
-sub remove_file
-{
-    my ($file) = @_;
+    return 1 if ($dry_run);
 
-    my $result = 0;
+    @paths = glob($path_glob);
 
-    if ($file eq "") {
-        # file is NULL
-        return 1;
+    if (($count = chmod($permissions, @paths)) != @paths) {
+        $errstr = "$!";
+        $result = 0;
+        emit(sprintf("failed to set permission (%o) on \"%s\" => (%s), %d out of %d failed, \"%s\"\n",
+                     $permissions, $path_glob, "@paths", @paths - $count, @paths+0, $errstr), 'error');
     }
-
-    if (!file_exists($file)) {
-        return 1;
+    return $result;
     }
 
-    $result = `rm -f $file`;
-    if ($result == 0) {
-        return 1;
-    }
+# set_owner_group(path_glob, owner, group)
+# Return 1 if success, 0 if failure
+sub set_owner_group
+{
+    my ($path_glob, $owner, $group) = @_;
+    my (@paths, $errstr, $result, $count);
+    my ($uid, $gid);
 
-    emit("remove_file():  failed to remove file $file.\n",
-          "error");
+    $errstr = undef;
+    $count = 0;
+    $result = 1;
 
-    return 0;
-}
+    emit(sprintf("set_owner_group(%s)\n", join(", ", @_)), "debug");
+
+    return 1 if ($dry_run);
 
+    $uid   = getpwnam($owner);
+    $gid   = getgrnam($group);
+    @paths = glob($path_glob);
 
+    if (($count = chown($uid, $gid, @paths)) != @paths) {
+        $errstr = "$!";
+        $result = 0;
+        emit(sprintf("failed to set ownership (%s) on \"%s\" => (%s), %d out of %d failed, \"%s\"\n",
+                     "${owner}:${group}", $path_glob, "@paths", @paths - $count, @paths+0, $errstr), 'error');
+    }
+    return $result;
+}
+
+# set_file_props(path_glob, permissions, owner, group)
 # Return 1 if success, 0 if failure
-sub give_file_to
+sub set_file_props
 {
-    my ($file, $new_user, $new_group) = @_;
+    my ($path_glob, $permissions, $owner, $group) = @_;
+    my (@paths, $tmp_result, $result);
 
-    my $result = 0;
+    $result = 1;
 
-    if ($file eq "" || !file_exists($file)) {
-        emit("give_file_to():  invalid file specified.\n",
-              "error");
-        return 0;
-    }
+    emit(sprintf("set_file_props(%s %s %s %s)\n",
+                 $path_glob,
+                 defined($permissions) ? sprintf("%o", $permissions) : "",
+                 $owner, $group), "debug");
 
-    if ($new_user eq "" || $new_group eq "") {
-        emit("give_file_to():  file $file needs a user and group!\n",
-              "error");
-        return 0;
-    }
+    return 1 if ($dry_run);
 
-    $result = `chgrp $new_group $file`;
-    if ($result) {
-        emit("give_file_to():  can't change file $file ownership to "
-            . "group $new_group!\n",
-              "error");
-        return 0;
-    }
+    $tmp_result = set_permissions($path_glob, $permissions);
+    $result = 0 if !$tmp_result;
 
-    $result = `chown $new_user $file`;
-    if ($result) {
-        emit("give_file_to():  can't change file $file ownership to "
-            . "user $new_user!\n",
-              "error");
-        return 0;
+    $tmp_result = set_owner_group($path_glob, $owner, $group);
+    $result = 0 if !$tmp_result;
+
+    return $result;
     }
 
-    return 1;
-}
 
 
 ##############################################################
@@ -2700,77 +2739,59 @@ sub is_directory_empty
 # Return 1 if success, 0 if failure
 sub create_directory
 {
-    my ($dir) = @_;
+    my ($dir, $permissions, $owner, $group, $uninstall_action) = @_;
+    my $result = 1;
+    my $errors;
 
-    my $result = 0;
+    emit(sprintf("create_directory(%s, %s, %s, %s, %s)\n",
+                 $dir,
+                 defined($permissions) ? sprintf("%o", $permissions) : "",
+                 $owner, $group, $uninstall_action), "debug");
 
-    if ($dir eq "") {
-        # directory is NULL
-        # Just return success
-        return 1;
-    }
-
-    $result = `mkdir -p $dir`;
-    if ($result == 0) {
-        return 1;
-    }
+    $uninstall_action = 'remove' unless defined($uninstall_action);
+    add_install_info($dir, 'dir', $uninstall_action);
 
-    emit("create_directory():  failed creating directory $dir.\n",
-          "error");
+    return 1 if ($dry_run);
 
-    return 0;
+    if (!directory_exists($dir)) {
+        make_path($dir, {error => \$errors});
+        if (@$errors) {
+            my ($error, $path, $errstr);
+            $result = 0;
+            for $error (@$errors) {
+                ($path, $errstr) = %$error;
+                if ($path eq '') {
+                    emit("create_directory(): dir=\"$dir\" \"$errstr\"\n", "error");
 }
-
-
-# Return 1 if success, 0 if failure
-sub move_directory
-{
-    my ($dir, $dest) = @_;
-
-    my $result = 0;
-
-    if (!is_path_valid($dir)) {
-        emit("move_directory():  illegal source path => $dir.\n",
-              "error");
-        return 0;
-    }
-
-    if (!is_path_valid($dest)) {
-        emit("move_directory():  illegal destination path => $dest.\n",
-              "error");
-        return 0;
+                else {
+                    remove_install_info($path);
+                    emit("create_directory(): dir=\"$dir\" path=\"$path\" \"$errstr\"\n", "error");
+                }
+            }
+        }
     }
 
-    if (!directory_exists($dest)) {
-        $result = create_directory($dest);
-        if (!$result) {
-          emit("move_directory():  failed moving dir $dir to new $dest.\n",
-                "error");
-          return 0;
+    if ($result) {
+        if (defined($permissions)) {
+            return 0 if !set_permissions($dir, $permissions);
         }
-    }
 
-    $result = `mv $dir $dest`;
-    if ($result == 0) {
-        return 1;
+        if (defined($owner) && defined($group)) {
+            return 0 if !set_owner_group($dir, $owner, $group);
+        }
     }
 
-    emit("move_directory():  failed moving dir $dir to $dest.\n",
-          "error");
-
-    return 0;
+    return $result;
 }
 
-# arg0 src directory
-# arg1 dst path
-# return 1 - successfully copied directory, or
-# return 0 - failed copying directory
+# Return 1 if success, 0 if failure
 sub copy_directory
 {
-    my($src_dir_path, $dst_dir_path, $uninstall_action) = @_;
+    my ($src_dir_path, $dst_dir_path,
+       $dir_permissions, $file_permissions,
+       $owner, $group, $uninstall_action) = @_;
     my($result);
-    my($paths, $path, $src_path, $dst_path);
-    my(%dst_dirs, $dst_dir);
+    my ($files, $sub_dirs, $path, $src_path, $dst_path);
 
     $uninstall_action = 'remove' unless defined($uninstall_action);
     $result = 1;
@@ -2778,11 +2799,12 @@ sub copy_directory
     $src_dir_path = normalize_path($src_dir_path);
     $dst_dir_path = normalize_path($dst_dir_path);
 
-    if ($verbose > 1) {
-        emit(sprintf("%s(%s)\n", (caller(0))[3], join(', ', @_)));
-    }
+    emit(sprintf("copy_directory(%s, %s, %s, %s, %s, %s, %s)\n",
+                 $src_dir_path, $dst_dir_path,
+                 defined($dir_permissions) ? sprintf("%o", $dir_permissions) : "",
+                 defined($dir_permissions) ? sprintf("%o", $dir_permissions) : "",
+                 $owner, $group, $uninstall_action), "debug");
 
-    emit("copy_directory(): $src_dir_path => $dst_dir_path\n", "debug");
     if (!is_path_valid($src_dir_path)) {
         emit("copy_directory():  illegal src path => $src_dir_path.\n",
               "error");
@@ -2801,27 +2823,29 @@ sub copy_directory
         return 1;
     }
 
-    # Get list of files under the src dir
-    $paths = get_directory_files($src_dir_path, {'strip_dir' => 1});
+    # Get list of directories under the src dir
+    $sub_dirs = get_directory_files($src_dir_path,
+                                    {'strip_dir' => 1, 'include_dirs' => 1, 'include_files' => 0});
     
+    # Get list of files under the src dir
+    $files = get_directory_files($src_dir_path,
+                                 {'strip_dir' => 1, 'include_dirs' => 0, 'include_files' => 1});
     
     # Assure each destination directory exists
-    $dst_dirs{$dst_dir_path}++;
-    for $path (@$paths) {
+    return 0 if !create_directory($dst_dir_path,
+                                  $dir_permissions, $owner, $group, $uninstall_action);
+    for $path (@$sub_dirs) {
         $dst_path = "${dst_dir_path}/${path}";
-        $dst_dir = dirname($dst_path);
-        $dst_dirs{$dst_dir}++;
-    }
-
-    for $dst_dir (keys %dst_dirs) {
-        return 0 if !create_directory($dst_dir);
+        return 0 if !create_directory($dst_path, $dir_permissions,
+                                      $owner, $group, $uninstall_action);
     }
 
     # Copy each file
-    for $path (@$paths) {
+    for $path (@$files) {
         $src_path = "${src_dir_path}/${path}";
         $dst_path = "${dst_dir_path}/${path}";
-        if (!copy_file($src_path, $dst_path)) {
+        if (!copy_file($src_path, $dst_path, 
+                       $file_permissions, $owner, $group, $uninstall_action)) {
             $result = 0;
         }
     }
@@ -2846,16 +2870,14 @@ sub remove_directory
     my($dir, $remove_contents) = @_;
     my($errors, $result);
 
+    emit(sprintf("remove_directory(%s)\n", join(", ", @_)), "debug");
+
     $remove_contents = 0 unless defined($remove_contents);
     $result = 1;
 
-    emit("remove_directory(): \"$dir\"\n", "debug");
     add_install_info($dir, 'dir', 'remove', 'remove');
 
-    if ($dry_run || $verbose > 1) {
-        emit(sprintf("%s(%s)\n", (caller(0))[3], join(', ', @_)));
-        return 1 if ($dry_run);
-    }
+    return 1 if ($dry_run);
 
     if (!is_path_valid($dir)) {
         emit("remove_directory(): specified invalid directory $dir.\n",
@@ -2900,42 +2922,38 @@ sub remove_directory
 
 
 # Return 1 if success, 0 if failure
-sub give_directory_to
+sub set_owner_group_on_directory_contents
 {
-    my ($directory, $new_user, $new_group) = @_;
+    my ($dir, $owner, $group, $recursive) = @_;
+    my ($result, $paths, $path);
 
-    my $result = 0;
+    $recursive = $recursive // 1;
+    $result = 1;
 
-    if ($directory eq "" || !directory_exists($directory)) {
-        emit("give_directory_to():  invalid directory specified.\n",
-              "error");
-        return 0;
-    }
+    emit(sprintf("set_owner_group_on_directory_contents(%s)\n", join(", ", @_)), "debug");
 
-    if ($new_user eq "" || $new_group eq "") {
-        emit("give_directory_to():  directory $directory needs a user "
-            . "and group!\n",
+    return 1 if ($dry_run);
+
+    if ($dir eq "" || !directory_exists($dir)) {
+        emit("set_owner_group_on_directory_contents(): invalid directory specified.\n",
               "error");
         return 0;
     }
 
-    $result = `chgrp -R $new_group $directory`;
-    if ($result) {
-        emit("give_directory_to():  can't change directory $directory "
-            . "ownership to group $new_group!\n",
+    if ($owner eq "" || $group eq "") {
+        emit("set_owner_group_on_directory_contents(): directory $dir needs a user and group!\n",
               "error");
         return 0;
     }
 
-    $result = `chown -R $new_user $directory`;
-    if ($result) {
-        emit("give_directory_to():  can't change directory $directory "
-            . "ownership to user $new_user!\n",
-              "error");
-        return 0;
+    $paths = get_directory_files($dir, {'recursive'    => $recursive,
+                                        'include_dirs' => 1});
+
+    for $path (@$paths) {
+        $result = 0 if !set_owner_group($path, $owner, $group);
     }
 
-    return 1;
+    return $result;
 }
 
 
@@ -2945,7 +2963,7 @@ sub give_directory_to
 
 # return 1 - exists, or
 # return 0 - DOES NOT exist
-sub symbolic_link_exists
+sub symlink_exists
 {
     my ($symlink) = @_;
 
@@ -2967,110 +2985,107 @@ sub symbolic_link_exists
 
 
 # Return 1 if success, 0 if failure
-sub create_symbolic_link
+sub create_symlink
 {
-    my ($symlink, $dest_path) = @_;
+    my ($symlink, $dst_path, $owner, $group, $uninstall_action) = @_;
 
-    my $result = 0;
+    emit(sprintf("create_symlink(%s)\n", join(", ", @_)), "debug");
 
+    $uninstall_action = 'remove' unless defined($uninstall_action);
+    add_install_info($symlink, 'symlink', $uninstall_action);
+
+    return 1 if ($dry_run);
 
-    if (symbolic_link_exists($symlink)) {
+    if (symlink_exists($symlink)) {
         # delete symbolic link so that we can recreate link for upgrades
-        $result = `rm -rf $symlink`;
+        if (unlink($symlink) != 1) {
+            emit("create_symlink(): could not remove existing link \"$symlink\"\n", 'error');
+            remove_install_info($symlink);
+            return 0;
+        }
     }
 
     if (!is_path_valid($symlink)) {
-        emit("create_symbolic_link():  invalid source path => $symlink.\n",
-              "error");
+        emit("create_symlink(): invalid path \"$symlink\"\n", "error");
+        remove_install_info($symlink);
         return 0;
     }
 
-    if (!is_path_valid($dest_path) || !entity_exists($dest_path)) {
-        emit("create_symbolic_link():  illegal destination path => "
-            . "$dest_path.\n",
-              "error");
+    if (!is_path_valid($dst_path) || !entity_exists($dst_path)) {
+        emit("create_symlink(): illegal dst path \"$dst_path\"\n", "error");
+        remove_install_info($symlink);
         return 0;
     }
 
-    $result = `ln -s $dest_path $symlink`;
-    if ($result == 0) {
-        return 1;
+    if (!symlink($dst_path, $symlink)) {
+        emit("create_symlink(): failed \"$symlink\" => \"$dst_path\" ($!)\n", "error");
+        remove_install_info($symlink);
+        return 0;
     }
 
-    emit("create_symbolic_link():  failed creating symbolic link "
-        . "$symlink to destination directory $dest_path.\n",
-          "error");
-
-    return 0;
+    if (defined($owner) && defined($group)) {
+        # The Perl Lchown package implements lchown, but it's not currently available
+        # as an RPM so use a system command instead. :-(
+        return 0 if !set_owner_group_on_symlink($symlink, $owner, $group);
+    }
+    return 1;
 }
 
 
 # Return 1 if success, 0 if failure
-sub remove_symbolic_link
+sub remove_symlink
 {
     my ($symlink) = @_;
-
     my $result = 0;
 
+    emit(sprintf("remove_symlink(%s)\n", join(", ", @_)), "debug");
+
+    add_install_info($symlink, 'symlink', 'remove', 'remove');
+
+    return 1 if ($dry_run);
+
     if ($symlink eq "") {
         # symlink is NULL
         return 1;
     }
 
-    if (!symbolic_link_exists($symlink)) {
+    if (!symlink_exists($symlink)) {
         return 1;
     }
 
-    $result = `rm -f $symlink`;
-    if ($result == 0) {
-        return 1;
+    if (unlink($symlink) != 1) {
+        emit("remove_symlink(): failed \"$symlink\" ($!)\n", "error");
+        return 0;
     }
 
-    emit("remove_symbolic_link():  failed to remove symbolic_link "
-        . "$symlink.\n",
-          "error");
-
-    return 0;
+    return 1;
 }
 
 
 # Return 1 if success, 0 if failure
-sub give_symbolic_link_to
+sub set_owner_group_on_symlink
 {
-    my ($symlink, $new_user, $new_group) = @_;
+    my ($symlink, $owner, $group) = @_;
 
-    my $result = 0;
+    emit(sprintf("set_owner_group_on_symlink(%s)\n", join(", ", @_)), "debug");
 
-    if ($symlink eq "" || !symbolic_link_exists($symlink)) {
-        emit("give_symbolic_link_to():  invalid symbolic link specified.\n",
-              "error");
-        return 1;
-    }
-
-    if ($new_user eq "" || $new_group eq "") {
-        emit("give_symbolic_link_to():  symbolic link $symlink needs a "
-            . "user and group!\n",
-              "error");
-        return 0;
-    }
+    return 1 if ($dry_run);
 
-    $result = `chgrp -h $new_group $symlink`;
-    if ($result) {
-        emit("give_symbolic_link_to():  can't change symbolic link $symlink "
-            . "ownership to group $new_group!\n",
+    if ($symlink eq "" || !symlink_exists($symlink)) {
+        emit("set_owner_group_on_symlink(): invalid symbolic link specified \"$symlink\"\n",
               "error");
-        return 0;
+        return 1;
     }
 
-    $result = `chown -h $new_user $symlink`;
-    if ($result) {
-        emit("give_symbolic_link_to():  can't change symbolic link $symlink "
-            . "ownership to user $new_user!\n",
+    if ($owner eq "" || $group eq "") {
+        emit("set_owner_group_on_symlink(): symbolic link \"$symlink\" needs a user and group!\n",
               "error");
         return 0;
     }
 
-    return 1;
+    # The Perl Lchown package implements lchown, but it's not currently available
+    # as an RPM so use a system command instead. :-(
+    return run_command("chown --no-dereference ${owner}:${group} $symlink");
 }
 
 
@@ -3079,85 +3094,38 @@ sub give_symbolic_link_to
 ##############################################################
 
 if ($^O eq "linux") {
-    # return ($runtime, $start_priority, $stop_priority)
-    sub extract_chkconfig_parameters_from_start_stop_script
-    {
-        my ($pki_start_stop_script_instance_file_path) = @_;
-
-        # Extract "chkconfig" options from start/stop script
-        my $inf = new FileHandle;
-
-        $inf->open("<$pki_start_stop_script_instance_file_path") or
-        die "Could not open $pki_start_stop_script_instance_file_path\n";
-
-        while (<$inf>) {
-            my $line = $_;
-            chomp($line);
-            if ($line =~ "^#.*chkconfig:") {
-                # "# chkconfig: <runlevel> <start_priority> <stop_priority>"
-                @chkconfig_fields = split(' ', $line);
-
-                # determine instance runlevel
-                if (("$chkconfig_fields[2]" ne $DEFAULT_RUNLEVEL) &&
-                    (substr("$chkconfig_fields[2]", 0) != "0")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "1")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "2")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "3")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "4")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "5")    &&
-                    (substr("$chkconfig_fields[2]", 0) != "6")) {
-                    $chkconfig_fields[2] = $DEFAULT_RUNLEVEL;
-                }
-
-                # determine instance start priority
-                if (($chkconfig_fields[3] < 0) && 
-                    ($chkconfig_fields[3] > $DEFAULT_START_PRIORITY)) {
-                    $chkconfig_fields[3] = $DEFAULT_START_PRIORITY;
-                }
-
-                # determine instance stop priority
-                if (($chkconfig_fields[4] < 0) && 
-                    ($chkconfig_fields[4] > $DEFAULT_STOP_PRIORITY)) {
-                    $chkconfig_fields[4] = $DEFAULT_STOP_PRIORITY;
-                }
-            }
-        }
-
-        return($chkconfig_fields[2],
-                $chkconfig_fields[3],
-                $chkconfig_fields[4]);
-    }
-
-
-    # no return
+    # Return 1 if success, 0 if failure
     sub register_pki_instance_with_chkconfig
     {
         my ($pki_instance_name) = @_;
+        my ($command, $exit_status, $result);
 
-        my $command = "";
-
-        $command = "/sbin/chkconfig" . " "
-                 . "--add" . " "
-                 . $pki_instance_name;
-
-        system($command);
-
+        $result = 1;
+        $command = "/sbin/chkconfig --add $pki_instance_name";
+        if (run_command($command)) {
         emit("Registered '$pki_instance_name' with '/sbin/chkconfig'.\n");
+        } else {
+            $result = 0;
+            emit("Failed to register '$pki_instance_name' with '/sbin/chkconfig'.\n", 'error');
+        }
+        return $result;
     }
 
-
-    # no return
+    # Return 1 if success, 0 if failure
     sub deregister_pki_instance_with_chkconfig
     {
         my ($pki_instance_name) = @_;
+        my ($command, $exit_status, $result);
 
-        my $command = "";
-
-        $command = "/sbin/chkconfig" . " "
-                 . "--del" . " "
-                 . $pki_instance_name;
-
-        system($command);
+        $result = 1;
+        $command = "/sbin/chkconfig --del $pki_instance_name";
+        if (run_command($command)) {
+            emit("Registered '$pki_instance_name' with '/sbin/chkconfig'.\n");
+        } else {
+            $result = 0;
+            emit("Failed to deregister '$pki_instance_name' with '/sbin/chkconfig'.\n", 'error');
+        }
+        return $result;
     }
 }
 
@@ -3242,5 +3210,31 @@ sub run_command
     return 1;
 }
 
-1;
+##############################################################
+# Generic PKI Subroutines
+##############################################################
+
+sub get_registry_initscript_name
+{
+    my ($subsystem_type) = @_;
+    my ($pki_initscript);
+
+    if ($subsystem_type eq $CA) {
+        $pki_initscript = $CA_INIT_SCRIPT;
+    } elsif($subsystem_type eq $KRA) {
+        $pki_initscript = $KRA_INIT_SCRIPT;
+    } elsif($subsystem_type eq $OCSP) {
+        $pki_initscript = $OCSP_INIT_SCRIPT;
+    } elsif($subsystem_type eq $RA) {
+        $pki_initscript = $RA_INIT_SCRIPT;
+    } elsif($subsystem_type eq $TKS) {
+        $pki_initscript = $TKS_INIT_SCRIPT;
+    } elsif($subsystem_type eq $TPS) {
+        $pki_initscript = $TPS_INIT_SCRIPT;
+    } else {
+        die "unknown subsystem type \"$subsystem_type\"";
+    }
+
+}
 
+1;