Paranoid
view release on metacpan or search on metacpan
lib/Paranoid/Filesystem.pm view on Meta::CPAN
# 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
# <https://www.gnu.org/licenses/gpl-1.0.html> as published by the
# Free Software Foundation <http://www.fsf.org/>; either version 1
# <https://www.gnu.org/licenses/gpl-1.0.html>, or any later version
# <https://www.gnu.org/licenses/license-list.html#GNUGPL>, or
# b) the "Artistic License 2.0
# <https://opensource.org/licenses/Artistic-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 (corliss@digitalmages.com)
# (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) {
lib/Paranoid/Filesystem.pm view on Meta::CPAN
# 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__
=head1 NAME
Paranoid::Filesystem - Filesystem Functions
=head1 VERSION
$Id: lib/Paranoid/Filesystem.pm, 2.10 2022/03/08 00:01:04 acorliss Exp $
=head1 SYNOPSIS
use Paranoid::Filesystem;
$rv = pmkdir("/foo/{a1,b2}");
$rv = preadDir("/tmp", @entries);
$rv = psubdirs("/etc", @dirList);
$rv = pfiles("/etc", @filesList);
$rv = ptouch("/foo/*", $tstamp);
$rv = ptouchR("/foo", $tstamp, $follow, %errors);
$rv = pchmod("/foo", $perms);
$rv = pchmodR("/foo", $perms, $follow, %errors);
$rv = pchown("/foo", $user, $group);
$rv = pchownR("/foo", $user, $group, $follow, %errors);
$rv = prm("/foo");
$rv = prmR("/foo", 1, %errors);
$fullname = pwhich('ls');
$cleaned = pcleanPath($filename);
$noLinks = ptranslateLink("/etc/foo/bar.conf");
$rv = ptranslatePerms("ug+rwx");
$filename = pwhich('ls');
=head1 DESCRIPTION
This module provides a few functions to make accessing the filesystem a little
easier, while instituting some safety checks. If you want to enable debug
tracing into each function you must set B<PDEBUG> to at least 9.
B<pcleanPath>, B<ptranslateLink>, and B<ptranslatePerms> are only exported
if this module is used with the B<:all> target.
=head1 IMPORT LISTS
This module exports the following symbols by default:
preadDir psubdirs pfiles pmkdir prm prmR ptouch
ptouchR pchmod pchmodR pchown pchownR pwhich
The following specialized import lists also exist:
List Members
--------------------------------------------------------
all @defaults ptranslateLink pcleanPath
ptranslatePerms
=head1 SUBROUTINES/METHODS
=head2 pmkdir
$rv = pmkdir("/foo/{a1,b2}");
$rv = pmkdir("/foo", 0750);
$rv = pmkdir("/foo", 0750, %errors);
This function simulates a 'mkdir -p {path}', returning false if it fails for
any reason other than the directory already being present. The second
argument (permissions) is optional, but if present should be an octal number.
Shell-style globs are supported as the path argument.
If you need to make a directory that includes characters which would normally
be interpreted as shell expansion characters you can offer a B<Paranoid::Glob>
object as the path argument instead. Creating such an object while passing it
a I<literal> value will prevent any shell expansion from happening.
This method also allows you to call B<pmkdir> with a list of directories to
create, rather than just relying upon shell expansion to construct the list.
=head2 prm
$rv = prm("/foo");
$rv = prm("/foo", %errors);
This function unlinks non-directories and rmdir's directories.
File arguments are processed through L<Paranoid::Glob> and expanded into
multiple targets if globs are detected. You can also use a Paranoid::Glob
object with a multitude of entities to delete instead of a string.
The optional second argument is a hash in which any error messages is stored
(with the file/directory name as the key). Attempting to delete something
that's not present is not considered a failure.
=head2 prmR
$rv = prmR("/foo");
$rv = prmR("/foo", 1);
$rv = prmR("/foo", 1, %errors);
This function works the same as B<prm> but performs a recursive delete,
similar to "rm -r" on the command line. An optional second argument determines
if symbolic links are followed and the targets also recursively deleted.
=head2 preadDir
$rv = preadDir("/tmp", @entries);
$rv = preadDir("/tmp", @entries, 1);
This function populates the passed array with the contents of the specified
lib/Paranoid/Filesystem.pm view on Meta::CPAN
This translates symbolic mode notation into an octal number. It fed invalid
permissions it will return undef. It understands the following symbols:
u permissions apply to user
g permissions apply to group
o permissions apply to all others
r read privileges
w write privileges
x execute privileges
s setuid/setgid (depending on u/g)
t sticky bit
B<EXAMPLES>
# Add user executable privileges
$perms = (stat "./foo")[2];
chmod $perms | ptranslatePerms("u+x"), "./foo";
# Remove all world privileges
$perms = (stat "./bar")[2];
chmod $perms ^ ptranslatePerms("o-rwx"), "./bar";
B<NOTE:> If this function is called with a numeric representation of
permissions, it will return them as-is. This allows for this function to be
called indiscriminately where you might be given permissions in either format,
but ultimately want them only in numeric presentation.
=head2 pchmod
$rv = pchmod("/foo", $perms);
$rv = pchmod("/foo", $perms, %errors);
This function takes a given permission and applies it to every file given to
it. The permission can be an octal number or symbolic notation (see
I<ptranslatePerms> for specifics). If symbolic notation is used the
permissions will be applied relative to the current permissions on each
file. In other words, it acts exactly like the B<chmod> program.
File arguments are processed through L<Paranoid::Glob> and expanded into
multiple targets if globs are detected. or you can hand it a glob object
directly.
The error message from each failed operation will be placed into the passed
hash using the filename as the key.
The return value will be true unless any errors occur during the actual
chmod operation including attempting to set permissions on non-existent
files.
=head2 pchmodR
$rv = pchmodR("/foo", $perms);
$rv = pchmodR("/foo", $perms, $follow);
$rv = pchmodR("/foo", $perms, $follow, %errors);
This function works the same as B<pchmod>, but offers one additional
argument (the third argument), boolean, which indicates whether or not the
command should follow symlinks.
=head2 pchown
$rv = pchown("/foo", $user);
$rv = pchown("/foo", $user, $group);
$rv = pchown("/foo", $user, $group, %errors);
This function takes a user and/or a named group or ID and applies it to
every file given to it. If either the user or group is undefined it leaves
that portion of ownership unchanged.
File arguments are processed through L<Paranoid::Glob> and expanded into
multiple targets if globs are detected, or you can hand it a populated glob
object directly.
The error message from each failed operation will be placed into the passed
hash using the filename as the key.
The return value will be true unless any errors occur during the actual
chown operation including attempting to set permissions on non-existent
files.
=head2 pchownR
$rv = pchownR("/foo", $user);
$rv = pchownR("/foo", $user, $group);
$rv = pchownR("/foo", $user, $group, $follow);
$rv = pchownR("/foo", $user, $group, $follow, %errors);
This function works the same as B<pchown>, but requires one additional
argument (the fourth argument), boolean, which indicates whether or not the
command should follow symlinks.
=head2 pwhich
$fullname = pwhich('ls');
This function tests each directory in your path for a binary that's both
readable and executable by the effective user. It will return only one
match, stopping the search on the first match. If no matches are found it
will return undef.
=head1 DEPENDENCIES
=over
=item o
L<Cwd>
=item o
L<Errno>
=item o
L<Fcntl>
=item o
L<Paranoid>
=item o
L<Paranoid::Debug>
=item o
L<Paranoid::Glob>
=item o
L<Paranoid::Input>
=item o
L<Paranoid::IO>
=item o
L<Paranoid::Process>
=back
=head1 BUGS AND LIMITATIONS
B<ptranslateLink> is probably pointless for 99% of the uses out there, you're
better off using B<Cwd>'s B<realpath> function instead. The only thing it can
do differently is translating a single link itself, without translating any
additional symlinks found in the preceding path. But, again, you probably
( run in 0.839 second using v1.01-cache-2.11-cpan-5511b514fd6 )