File Coverage

blib/lib/Paranoid/Filesystem.pm

Criterion	Covered	Total	%
statement	326	408	79.9
branch	142	228	62.2
condition	31	60	51.6
subroutine	29	31	93.5
pod	16	16	100.0
total	544	743	73.2

# Paranoid::Filesystem -- Filesystem support for paranoid programs
#
# $Id: lib/Paranoid/Filesystem.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
#
# This software is free software.  Similar to Perl, you can redistribute it
# and/or modify it under the terms of either:
#
#   a)     the GNU General Public License
#           as published by the
#          Free Software Foundation ; either version 1
#          , or any later version
#          , or
#   b)     the "Artistic License 2.0
#          ",
#
# subject to the following additional term:  No trademark rights to
# "Paranoid" have been or are conveyed under any of the above licenses.
# However, "Paranoid" may be used fairly to describe this unmodified
# software, in good faith, but not as a trademark.
#
# (c) 2005 - 2020, Arthur Corliss ([e-mail])
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com)
#
#####################################################################

#####################################################################
#
# Environment definitions
#
#####################################################################

package Paranoid::Filesystem;

use 5.008;

use strict;
use warnings;
use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
use base qw(Exporter);
use Cwd qw(realpath);
use Errno qw(:POSIX);
use Fcntl qw(:DEFAULT :seek :flock :mode);
use Paranoid;
use Paranoid::Debug qw(:all);
use Paranoid::Process qw(ptranslateUser ptranslateGroup);
use Paranoid::Input;
use Paranoid::IO;
use Paranoid::Glob;

($VERSION) = ( q$Revision: 2.10 $ =~ /(\d+(?:\.\d+)+)/sm );

@EXPORT = qw(
    preadDir     psubdirs    pfiles
    pmkdir       prm         prmR      ptouch
    ptouchR      pchmod      pchmodR   pchown
    pchownR      pwhich
    );
@EXPORT_OK = (
    @EXPORT, qw(
        ptranslateLink
        pcleanPath
        ptranslatePerms
        ) );
%EXPORT_TAGS = ( all => [@EXPORT_OK], );

use constant PERMMASK => 0777;

#####################################################################
#
# Module code follows
#
#####################################################################

sub pmkdir ($;$\%) {

    # Purpose:  Simulates a 'mkdir -p' command in pure Perl
    # Returns:  True (1) if all targets were successfully created,
    #           False (0) if there are any errors
    # Usage:    $rv = pmkdir("/foo/{a1,b2}");
    # Usage:    $rv = pmkdir("/foo", 0750);
    # Usage:    $rv = pmkdir("/foo", 0750, %errors);

    my $path = shift;
    my $mode = shift;
    my $eref = shift || {};
    my ( $dirs, $directory, $subdir, @parts, $i );
    my $rv = 1;

    subPreamble( PDLEVEL1, '$;$\%', $path, $mode, $eref );

    # Create a glob object if we weren't handed one.
    if ( defined $path ) {
        $dirs =
            ref $path eq 'Paranoid::Glob'
            ? $path
            : Paranoid::Glob->new( globs => [$path] );
    }

    # Leave Paranoid::Glob's errors in place if there was a problem
    $rv = 0 unless defined $dirs;

    # Set and detaint mode
    if ($rv) {
        $mode = ptranslatePerms( defined $mode ? $mode : umask ^ PERMMASK );
        unless ( detaint( $mode, 'int' ) ) {
            Paranoid::ERROR =
                pdebug( 'invalid mode argument passed', PDLEVEL1 );
            $rv = 0;
        }
    }

    # Start creating directories
    if ($rv) {

        # Iterate over each directory in the glob
        foreach $directory (@$dirs) {
            pdebug( 'processing %s', PDLEVEL2, $directory );

            # Skip directories already present
            next if -d $directory;

            # Otherwise, split so we can backtrack to the first available
            # subdirectory and start creating subdirectories from there
            @parts = split m#/+#s, $directory;
            $i = $parts[0] eq '' ? 1 : 0;
            $i++ while $i < $#parts and -d join '/', @parts[ 0 .. $i ];
            while ( $i <= $#parts ) {
                $subdir = join '/', @parts[ 0 .. $i ];
                unless ( -d $subdir ) {
                    if ( mkdir $subdir, $mode ) {

                        # Make sure perms are applied
                        chmod $mode, $subdir;

                    } else {

                        # Error out and halt all work
                        Paranoid::ERROR = pdebug( 'failed to create %s: %s',
                            PDLEVEL1, $subdir, $! );
                        $rv = 0;
                        last;
                    }
                }
                $i++;
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub prm ($;\%) {

    # Purpose:  Simulates a "rm -f" command in pure Perl
    # Returns:  True (1) if all targets were successfully removed,
    #           False (0) if there are any errors
    # Usage:    $rv = prm("/foo");
    # Usage:    $rv = prm("/foo", %errors);

    my $target = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob, @fstat );

    subPreamble( PDLEVEL1, '$;\%', $target, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    # Start removing files
    if ($rv) {

        # Consolidate the entries
        $glob->consolidate;

        # Iterate over entries
        foreach ( reverse @$glob ) {
            pdebug( 'processing %s', PDLEVEL2, $_ );

            # Stat the file
            @fstat = lstat $_;

            unless (@fstat) {

                # If the file is missing, consider the removal successful and
                # move on.
                next if $! == ENOENT;

                # Report remaining errors (permission denied, etc.)
                $rv = 0;
                $$errRef{$_} = $!;
                Paranoid::ERROR =
                    pdebug( 'failed to remove %s: %s', PDLEVEL1, $_, $! );
                next;
            }

            if ( S_ISDIR( $fstat[2] ) ) {

                # Remove directories
                unless ( rmdir $_ ) {

                    # Record errors
                    $rv = 0;
                    $$errRef{$_} = $!;
                    Paranoid::ERROR =
                        pdebug( 'failed to remove %s: %s', PDLEVEL1, $_, $! );
                }

            } else {

                # Remove all non-directories
                unless ( unlink $_ ) {

                    # Record errors
                    $rv = 0;
                    $$errRef{$_} = $!;
                    Paranoid::ERROR =
                        pdebug( 'failed to remove %s: %s', PDLEVEL1, $_, $! );
                }
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub prmR ($;$\%) {

    # Purpose:  Recursively calls prm to simulate "rm -rf"
    # Returns:  True (1) if all targets were successfully removed,
    #           False (0) if there are any errors
    # Usage:    $rv = prmR("/foo");
    # Usage:    $rv = prmR("/foo", 1);
    # Usage:    $rv = prmR("/foo", 1, %errors);

    my $target = shift;
    my $follow = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob );

    subPreamble( PDLEVEL1, '$;$\%', $target, $follow, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ($rv) {

        # Load the directory tree and execute prm
        $rv = $glob->recurse( $follow, 1 ) && prm( $glob, %$errRef );
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub preadDir ($\@;$) {

    # Purpose:  Populates the passed array ref with a list of all the
    #           directory entries (minus the '.' & '..') in the passed
    #           directory
    # Returns:  True (1) if the read was successful,
    #           False (0) if there are any errors
    # Usage:    $rv = preadDir("/tmp", @entries);
    # Usage:    $rv = preadDir("/tmp", @entries, 1);

    my ( $dir, $aref, $noLinks ) = @_;
    my $rv = 1;
    my $fh;

    subPreamble( PDLEVEL1, '$\@;$', $dir, $aref, $noLinks );
    @$aref = ();

    # Validate directory and exit early, if need be
    unless ( defined $dir and -e $dir and -d _ and -r _ ) {
        $rv = 0;
        Paranoid::ERROR = pdebug( (
                  !defined $dir ? 'undefined value passed as directory name'
                : !-e _         ? 'directory (%s) does not exist'
                : !-d _         ? '%s is not a directory'
                : 'directory (%s) is not readable by the effective user'
            ),
            PDLEVEL1, $dir
            );
    }

    if ($rv) {

        # Read the directory's contents
        $rv = opendir $fh, $dir;

        if ($rv) {

            # Get the list, filtering out '.' & '..'
            foreach ( readdir $fh ) {
                push @$aref, "$dir/$_" unless m/^\.\.?$/s;
            }
            closedir $fh;

            # Filter out symlinks, if necessary
            @$aref = grep { !-l $_ } @$aref if $noLinks;

        } else {
            Paranoid::ERROR = pdebug( 'error opening directory (%s): %s',
                PDLEVEL1, $dir, $! );
        }
    }

    pdebug( 'returning %d entries', PDLEVEL2, scalar @$aref );

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub psubdirs ($\@;$) {

    # Purpose:  Performs a preadDir but filters out all non-directory entries
    #           so that only subdirectory entries are returned.  Can
    #           optionally filter out symlinks to directories as well.
    # Returns:  True (1) if the directory read was successful,
    #           False (0) if there are any errors
    # Usage:    $rv = psubdirs($dir, @entries);
    # Usage:    $rv = psubdirs($dir, @entries, 1);

    my ( $dir, $aref, $noLinks ) = @_;
    my $rv = 0;

    subPreamble( PDLEVEL1, '$\@;$', $dir, $aref, $noLinks );

    # Validate arguments
    $noLinks = 0 unless defined $noLinks;

    # Empty target array and retrieve list
    $rv = preadDir( $dir, @$aref, $noLinks );

    # Filter out all non-directories
    @$aref = grep { -d $_ } @$aref if $rv;

    pdebug( 'returning %d entries', PDLEVEL2, scalar @$aref );

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pfiles ($\@;$) {

    # Purpose:  Performs a preadDir but filters out all directory entries
    #           so that only file entries are returned.  Can
    #           optionally filter out symlinks to files as well.
    # Returns:  True (1) if the directory read was successful,
    #           False (0) if there are any errors
    # Usage:    $rv = pfiles($dir, @entries);
    # Usage:    $rv = pfiles($dir, @entries, 1);

    my ( $dir, $aref, $noLinks ) = @_;
    my $rv = 0;

    subPreamble( PDLEVEL1, '$\@;$', $dir, $aref, $noLinks );

    # Validate arguments
    $noLinks = 0 unless defined $noLinks;

    # Empty target array and retrieve list
    @$aref = ();
    $rv = preadDir( $dir, @$aref, $noLinks );

    # Filter out all non-files
    @$aref = grep { -f $_ } @$aref if $rv;

    pdebug( 'returning %d entries', PDLEVEL2, scalar @$aref );

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pcleanPath ($) {

    # Purpose:  Removes/resolves directory artifacts like '/../', etc.
    # Returns:  Filtered string
    # Usage:    $filename = pcleanPath($filename);

    my $filename = shift;

    subPreamble( PDLEVEL1, '$', $filename );

    if ( defined $filename ) {

        # Strip all //+, /./, and /{parent}/../
        while ( $filename =~ m#/\.?/+#s ) { $filename =~ s#/\.?/+#/#sg }
        while ( $filename =~ m#/(?:(?!\.\.)[^/]{2,}|[^/])/\.\./#s ) {
            $filename =~ s#/(?:(?!\.\.)[^/]{2,}|[^/])/\.\./#/#sg;
        }

        # Strip trailing /. and leading /../
        $filename =~ s#/\.$##s;
        while ( $filename =~ m#^/\.\./#s ) { $filename =~ s#^/\.\./#/#s }

        # Strip any ^[^/]+/../
        while ( $filename =~ m#^[^/]+/\.\./#s ) {
            $filename =~ s#^[^/]+/\.\./##s;
        }

        # Strip any trailing /^[^/]+/..$
        while ( $filename =~ m#/[^/]+/\.\.$#s ) {
            $filename =~ s#/[^/]+/\.\.$##s;
        }
    }

    subPostamble( PDLEVEL1, '$', $filename );

    return $filename;
}

sub ptranslateLink ($;$) {

    # Purpose:  Performs either a full (realpath) or a partial one (last
    #           filename element only) on the passed filename
    # Returns:  Altered filename if successful, undef if there are any
    #           failures
    # Usage:    $filename = ptranslateLink($filename);
    # Usage:    $filename = ptranslateLink($filename, 1);

    my $link           = shift;
    my $fullyTranslate = shift || 0;
    my $nLinks         = 0;
    my ( $i, $target );

    subPreamble( PDLEVEL1, '$;$', $link, $fullyTranslate );

    # Validate link and exit early, if need be
    unless ( defined $link and scalar lstat $link ) {
        Paranoid::ERROR = pdebug( 'link (%s) does not exist on filesystem',
            PDLEVEL1, $link );
        pOut();
        pdebug( 'leaving w/rv: undef', PDLEVEL1 );
        return undef;
    }

    # Check every element in the path for symlinks and translate it if
    # if a full translation was requested
    if ($fullyTranslate) {

        # Resolve the link
        $target = realpath($link);

        # Make sure we got an answer
        if ( defined $target ) {

            # Save the answer
            $link = $target;

        } else {

            # Report our inability to resolve the link
            Paranoid::ERROR =
                pdebug( 'link (%s) couldn\'t be resolved fully: %s',
                PDLEVEL1, $link, $! );
            $link = undef;
        }

    } else {

        # Is the file passed a symlink?
        if ( -l $link ) {

            # Yes it is, let's get the target
            $target = readlink $link;
            pdebug( 'last element is a link to %s', PDLEVEL1, $target );

            # Is the target a relative filename?
            if ( $target =~ m#^(?:\.\.?/|[^/])#s ) {

                # Yupper, replace the filename with the target
                $link =~ s#[^/]+$#$target#s;

            } else {

                # The target is fully qualified, so replace link entirely
                $link = $target;
            }
        }
    }

    $link = pcleanPath($link) if defined $link;

    subPostamble( PDLEVEL1, '$', $link );

    return $link;
}

sub ptouch ($;$\%) {

    # Purpose:  Simulates a "touch" command in pure Perl
    # Returns:  True (1) if all targets were successfully touched,
    #           False (0) if there are any errors
    # Usage:    $rv = ptouch("/foo/*");
    # Usage:    $rv = ptouch("/foo/*", $tstamp);
    # Usage:    $rv = ptouch("/foo/*", $tstamp, %errors);

    my $target = shift;
    my $stamp  = shift;
    my $errRef = shift;
    my $rv     = 1;
    my $irv    = 1;
    my ( $glob, $tglob, $fh );

    subPreamble( PDLEVEL1, '$;$\%', $target, $stamp, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ($rv) {

        # Apply the default timestamp if omitted
        $stamp = time unless defined $stamp;

        unless ( detaint( $stamp, 'int' ) ) {
            Paranoid::ERROR = pdebug( 'Invalid characters in timestamp: %s',
                PDLEVEL2, $stamp );
            $rv = 0;
        }
    }

    # Start touching stuff
    if ($rv) {

        # Consolidate the entries
        $glob->consolidate;

        # Iterate over entries
        foreach $target (@$glob) {
            pdebug( 'processing %s', PDLEVEL2, $target );
            $irv = 1;

            # Create the target if it does not exist
            unless ( -e $target ) {
                pdebug( 'creating empty file (%s)', PDLEVEL2, $target );
                $fh = popen( $target, O_CREAT | O_EXCL | O_RDWR )
                    || popen( $target, O_RDWR );
                if ( defined $fh ) {
                    pclose($target);
                } else {
                    $$errRef{$target} = $!;
                    $irv = $rv = 0;
                }
            }

            # Touch the file
            if ($irv) {
                unless ( utime $stamp, $stamp, $target ) {
                    $$errRef{$target} = $!;
                    $rv = 0;
                }
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub ptouchR ($;$$\%) {

    # Purpose:  Calls ptouch recursively
    # Returns:  True (1) if all targets were successfully touched,
    #           False (0) if there are any errors
    # Usage:    $rv = ptouchR("/foo");
    # Usage:    $rv = ptouchR("/foo", $tstamp);
    # Usage:    $rv = ptouchR("/foo", $tstamp, $follow);
    # Usage:    $rv = ptouchR("/foo", $tstamp, $follow, %errors);

    my $target = shift;
    my $stamp  = shift;
    my $follow = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob );

    subPreamble( PDLEVEL1, '$;$$\%', $target, $stamp, $follow, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ($rv) {

        # Load the directory tree and execute prm
        $rv = $glob->recurse( $follow, 1 )
            && ptouch( $glob, $stamp, %$errRef );
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub ptranslatePerms ($) {

    # Purpose:  Translates symbolic permissions (as supported by userland
    #           chmod, etc.) into the octal permissions.
    # Returns:  Numeric permissions if valid symbolic permissions were passed,
    #           undef otherwise
    # Usage:    $perm = ptranslatePerms('ug+srw');

    my $perm = shift;
    my $rv   = undef;
    my ( @tmp, $o, $p );

    subPreamble( PDLEVEL1, '$', $perm );

    # Validate permissions string
    if ( defined $perm and $perm =~ /^\d+$/s ) {

        if ( $perm =~ /^0/s ) {
            if ( $perm =~ /^0[0-8]{3,4}$/s ) {

                # String representation of octal number
                eval "\$perm = $perm;";
                detaint( $perm, 'int', $p );

            } else {
                pdebug( 'invalid octal presentation: %s', PDLEVEL1, $perm );
            }

        } else {

            # Probably a converted integer already, treat it as verbatim
            detaint( $perm, 'int', $p );
        }

    } elsif ( defined $perm and $perm =~ /^([ugo]+)([+\-])([rwxst]+)$/s ) {

        # Translate symbolic representation
        $o = $p = 00;
        @tmp = ( $1, $2, $3 );
        $o = S_IRWXU if $tmp[0] =~ /u/s;
        $o |= S_IRWXG if $tmp[0] =~ /g/s;
        $o |= S_IRWXO if $tmp[0] =~ /o/s;
        $p = ( S_IRUSR | S_IRGRP | S_IROTH ) if $tmp[2] =~ /r/s;
        $p |= ( S_IWUSR | S_IWGRP | S_IWOTH ) if $tmp[2] =~ /w/s;
        $p |= ( S_IXUSR | S_IXGRP | S_IXOTH ) if $tmp[2] =~ /x/s;
        $p &= $o;
        $p |= S_ISVTX if $tmp[2] =~ /t/s;
        $p |= S_ISGID if $tmp[2] =~ /s/s && $tmp[0] =~ /g/s;
        $p |= S_ISUID if $tmp[2] =~ /s/s && $tmp[0] =~ /u/s;

    } else {

        # Report invalid characters in permission string
        Paranoid::ERROR =
            pdebug( 'invalid permissions (%s)', PDLEVEL1, $perm );

    }
    $rv = $p;

    subPostamble( PDLEVEL1, '$', defined $rv ? sprintf( '%04o', $rv ) : $rv );

    return $rv;
}

sub pchmod ($$;\%) {

    # Purpose:  Simulates a "chmod" command in pure Perl
    # Returns:  True (1) if all targets were successfully chmod'd,
    #           False (0) if there are any errors
    # Usage:    $rv = pchmod("/foo", $perms);
    # Usage:    $rv = pchmod("/foo", $perms, %errors);

    my $target = shift;
    my $perms  = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob, @fstat );
    my ( $ptrans, $cperms, $addPerms, @tmp );

    subPreamble( PDLEVEL1, '$$;\%', $target, $perms, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    # Convert perms if they're symbolic
    if ( defined $perms and defined( $ptrans = ptranslatePerms($perms) ) ) {
        if ( $perms =~ /[ugo]+[+-]/si ) {
            $addPerms = $perms =~ /-/s ? 0 : 1;
        } else {
            $ptrans = undef;
        }
    } else {
        pdebug( 'invalid permissions passed: %s', PDLEVEL1, $perms );
        $rv = 0;
    }

    if ($rv) {

        # Consolidate the entries
        $glob->consolidate;

        # Iterate over entries
        foreach (@$glob) {
            pdebug( 'processing %s', PDLEVEL2, $_ );

            if ( defined $ptrans ) {

                # Get the current file mode
                @fstat = stat $_;
                unless (@fstat) {
                    $rv = 0;
                    $$errRef{$_} = $!;
                    Paranoid::ERROR =
                        pdebug( 'failed to adjust permissions of %s: %s',
                        PDLEVEL1, $_, $! );
                    next;
                }

                # If ptrans is defined we're going to do relative
                # application of permissions
                pdebug(
                    $addPerms
                    ? sprintf( 'adding perms %04o',   $ptrans )
                    : sprintf( 'removing perms %04o', $ptrans ),
                    PDLEVEL2
                    );

                # Get the current permissions
                $cperms = $fstat[2] & PERMMASK;
                pdebug(
                    sprintf( 'current permissions of %s: %04o', $_, $cperms ),
                    PDLEVEL2
                    );
                $cperms =
                    $addPerms
                    ? ( $cperms | $ptrans )
                    : ( $cperms & ( PERMMASK ^ $ptrans ) );
                pdebug( sprintf( 'new permissions of %s: %04o', $_, $cperms ),
                    PDLEVEL2 );
                unless ( chmod $cperms, $_ ) {
                    $rv = 0;
                    $$errRef{$_} = $!;
                    Paranoid::ERROR =
                        pdebug( 'failed to adjust permissions of %s: %s',
                        PDLEVEL1, $_, $! );
                }

            } else {

                # Otherwise, the permissions are explicit
                #
                # Detaint number mode
                if ( detaint( $perms, 'int' ) ) {

                    # Detainted, now apply
                    pdebug(
                        sprintf(
                            'assigning permissions of %04o to %s',
                            $perms, $_
                            ),
                        PDLEVEL2
                        );
                    unless ( chmod $perms, $_ ) {
                        $rv = 0;
                        $$errRef{$_} = $!;
                    }
                } else {

                    # Detainting failed -- report
                    $$errRef{$_} = $!;
                    Paranoid::ERROR =
                        pdebug( 'failed to detaint permissions mode',
                        PDLEVEL1 );
                    $rv = 0;
                }
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pchmodR ($$;$\%) {

    # Purpose:  Recursively calls pchmod
    # Returns:  True (1) if all targets were successfully chmod'd,
    #           False (0) if there are any errors
    # Usage:    $rv = pchmodR("/foo", $perms);
    # Usage:    $rv = pchmodR("/foo", $perms, $follow);
    # Usage:    $rv = pchmodR("/foo", $perms, $follow, %errors);

    my $target = shift;
    my $perms  = shift;
    my $follow = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob );

    subPreamble( PDLEVEL1, '$$;$\%', $target, $perms, $follow, $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ($rv) {

        # Load the directory tree and execute pchmod
        $rv = $glob->recurse( $follow, 1 )
            && pchmod( $glob, $perms, %$errRef );
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pchown ($$;$\%) {

    # Purpose:  Simulates a "chown" command in pure Perl
    # Returns:  True (1) if all targets were successfully owned,
    #           False (0) if there are any errors
    # Usage:    $rv = pchown("/foo", $user);
    # Usage:    $rv = pchown("/foo", $user, $group);
    # Usage:    $rv = pchown("/foo", $user, $group, %errors);

    my $target = shift;
    my $user   = shift;
    my $group  = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob, @fstat );

    subPreamble( PDLEVEL1, '$$;$\%', $target, $user, $group, $errRef );

    # Translate to UID/GID
    $user  = -1 unless defined $user;
    $group = -1 unless defined $group;
    $user  = ptranslateUser($user)   unless $user  =~ /^-?\d+$/s;
    $group = ptranslateGroup($group) unless $group =~ /^-?\d+$/s;
    unless ( defined $user and defined $group ) {
        $rv = 0;
        Paranoid::ERROR =
            pdebug( 'unsuccessful at translating uid/gid', PDLEVEL1 );
    }

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ( $rv and ( $user != -1 or $group != -1 ) ) {

        # Proceed
        pdebug( 'UID: %s GID: %s', PDLEVEL2, $user, $group );

        # Consolidate the entries
        $glob->consolidate;

        # Process the list
        foreach (@$glob) {

            pdebug( 'processing %s', PDLEVEL2, $_ );

            unless ( chown $user, $group, $_ ) {
                $rv = 0;
                $$errRef{$_} = $!;
                Paranoid::ERROR =
                    pdebug( 'failed to adjust ownership of %s: %s',
                    PDLEVEL1, $_, $! );
            }
        }
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pchownR ($$;$$\%) {

    # Purpose:  Calls pchown recursively
    # Returns:  True (1) if all targets were successfully owned,
    #           False (0) if there are any errors
    # Usage:    $rv = pchownR("/foo", $user);
    # Usage:    $rv = pchownR("/foo", $user, $group);
    # Usage:    $rv = pchownR("/foo", $user, $group, $follow);
    # Usage:    $rv = pchownR("/foo", $user, $group, $follow, %errors);

    my $target = shift;
    my $user   = shift;
    my $group  = shift;
    my $follow = shift;
    my $errRef = shift;
    my $rv     = 1;
    my ( $glob, $tglob );

    subPreamble( PDLEVEL1, '$$;$$\%', $target, $user, $group, $follow,
        $errRef );

    # Prep error hash
    $errRef = {} unless defined $errRef;
    %$errRef = ();

    # Create a glob object if we weren't handed one.
    if ( defined $target ) {
        $glob =
            ref $target eq 'Paranoid::Glob'
            ? $target
            : Paranoid::Glob->new( globs => [$target] );
    }
    $rv = 0 unless defined $glob;

    if ($rv) {

        # Load the directory tree and execute pchown
        $rv = $glob->recurse( $follow, 1 )
            && pchown( $glob, $user, $group, %$errRef );
    }

    subPostamble( PDLEVEL1, '$', $rv );

    return $rv;
}

sub pwhich ($) {

    # Purpose:  Simulates a "which" command in pure Perl
    # Returns:  The full path to the requested program if successful
    #           undef if not found
    # Usage:    $filename = pwhich('ls');

    my $binary      = shift;
    my @directories = grep /^.+$/s, split /:/s, $ENV{PATH};
    my $match       = undef;

    subPreamble( PDLEVEL1, '$', $binary );

    # Try to detaint filename
    if ( detaint( $binary, 'filename', $b ) ) {

        # Success -- start searching directories in PATH
        foreach (@directories) {
            pdebug( 'searching %s', PDLEVEL2, $_ );
            if ( -r "$_/$b" && -x _ ) {
                $match = "$_/$b";
                $match =~ s#/+#/#sg;
                last;
            }
        }

    } else {

        # Report detaint failure
        Paranoid::ERROR = pdebug( 'failed to detaint %s', PDLEVEL1, $binary );
    }

    subPostamble( PDLEVEL1, '$', $match );

    return $match;
}

1;

__END__