App-Fetchware
view release on metacpan or search on metacpan
lib/App/Fetchware/Util.pm view on Meta::CPAN
}
sub drop_privs {
my $child_code = shift;
my $regular_user = shift // 'nobody';
my %opts = @_;
# Need to do this in 2 places.
my $dont_drop_privs = sub {
my $child_code = shift;
my $output;
open my $output_fh, '>', \$output or die <<EOD;
App-Fetchware-Util: fetchware failed to open an internal scalar reference as a
file handle. OS error [$!].
EOD
$child_code->($output_fh);
close $output_fh or die <<EOD;
App-Fetchware-Util: fetchware failed to close an internal scalar reference that
was open as a file handle. OS error [$!].
EOD
return \$output;
};
# Execute $child_code without dropping privs if the user's configuration
# file is configured to force fetchware to "stay_root."
if (config('stay_root')) {
msg <<EOM;
stay_root is set to true. NOT dropping privileges!
EOM
return $dont_drop_privs->($child_code);
}
if (is_os_type('Unix') and ($< == 0 or $> == 0)) {
# cmd_new() needs to skip the creation of this useless directory that it
# does not use. Furthemore, the creation of this extra tempdir is not
# needed by cmd_new(), and this tempdir presumes start() was called
# before drop_privs(), which is always the case except for cmd_new().
#
# But another case where this temp dir's creations should be skipped is
# if start() is overridden with hook() to make start() do something
# other than create a temp dir, because in some cases such as using VCS
# instead of Web sites and mirrors, you do not need to bother with
# creating a tempdir, because the working dir of the repo can be used
# instead. Therefore, if the parent directory is not /^fetchware-$$/,
# then we'll also skip creating the tempd dir, because it most likely
# means that a tempdir is not needed.
$opts{SkipTempDirCreation} = 1
unless file(cwd())->basename() =~ /^fetchware-$$/;
unless (exists $opts{SkipTempDirCreation}
and defined $opts{SkipTempDirCreation}
and $opts{SkipTempDirCreation}) {
# Ensure that $user_temp_dir can be accessed by my drop priv'd child.
# And only try to change perms to 0755 only if perms are not 0755
# already.
my $st = stat(cwd());
unless ((S_IMODE($st->mode) & 0755) >= 0755) {
chmod 0755, cwd() or die <<EOD;
App-Fetchware-Util: Fetchware failed to change the permissions of the current
temporary directory [@{[cwd()]} to 0755. The OS error was [$!].
EOD
}
# Create a new tempdir for the droped prive user to use, and be sure
# to chown it so they can actually write to it as well.
# $new_temp_dir does not have a semaphore file, but its parent
# directory does, which will still keep fetchware clean from
# deleting this directory out from underneath us.
#
# Also note, that cwd() is "blindly" coded here, which makes it a
# "dependency," but drop_privs() is meant to be called after start()
# by fetchware::cmd_*(). It's not meant to be a generic subroutine
# to drop privs, and it's also not really meant to be used by
# fetchware extensions mostly just fetchware itself. Perhaps I
# should move it back to bin/fetchware???
#
# Also also note, that CLEANUP option is *not* specified, because
# that can cause this directory in cases of errors, and you can't
# track down an error in a build script if the directory everything
# is in has been deleted.
my $new_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
DIR => cwd());
# Determine /etc/passwd entry for the "effective" uid of the
# current fetchware process. I should use the "effective" uid
# instead of the "real" uid, because effective uid is used to
# determine what each uid can do, and the real uid is only
# really used to track who the original user was in a setuid
# program.
my ($name, $useless, $uid, $gid, $quota, $comment, $gcos, $dir,
$shell, $expire)
= getpwnam(config('user') // 'nobody');
chown($uid, $gid, $new_temp_dir) or die <<EOD;
App-Fetchware-Util: Fetchware failed to chown [$new_temp_dir] to the user it is
dropping privileges to. This just shouldn't happen, and might be a bug, or
perhaps your system temporary directory is full. The OS error was [$!].
EOD
chmod(0700, $new_temp_dir) or die <<EOD;
App-Fetchware-Util: Fetchware failed to change the permissions of its new
temporary directory [$new_temp_dir] to 0700 that it created, because its
dropping privileges. This just shouldn't happen, and is bug, or perhaps your
system temporary directory is full. The OS error is [$!].
EOD
# And of course chdir() to $new_temp_dir, because everything assumes
# that the cwd() is where everything should be saved and done.
chdir($new_temp_dir) or die <<EOD;
App-Fetchware-Util: Fetchware failed to chdir() to its new temporary directory
[$new_temp_dir]. This shouldn't happen, and is most likely a bug, or perhaps
your system temporary directory is full. The OS error was [$!].
EOD
}
# Open a pipe to allow the child to talk back to the parent.
pipe(READONLY, WRITEONLY) or die <<EOD;
App-Fetchware-Util: Fetchware failed to create a pipe to allow the forked
process to communication back to the parent process. OS error [$!].
EOD
# Turn them into proper lexical file handles.
my ($readonly, $writeonly) = (*READONLY, *WRITEONLY);
# Set up a SIGPIPE handler in case the writer closes the pipe before the
# reader closes their pipe.
$SIG{'PIPE'} = sub {
die <<EOD;
App-Fetchware-Util: Fetchware received a PIPE signal from the OS indicating the
pipe is dead. This should not happen, and is because the child was killed out
from under the parent, or there is a bug. This is a fatal error, because it's
possible the parent needs whatever information the child was going to use the
pipe to send to the parent, and now it is unclear if the proper expected output
has been received or not; therefore, we're just playing it safe and die()ing.
EOD
};
# Code below based on a cool forking idiom by Aristotle.
# (http://blogs.perl.org/users/aristotle/2012/10/concise-fork-idiom.html)
for ( scalar fork ) {
# Fork failed.
# defined() operates on default variable, $_.
if (not defined $_) {
die <<EOD;
App-Fetchware-Util: Fork failed! This shouldn't happen!?! Os error [$!].
EOD
}
# Fork succeeded, Parent code goes here.
my $kidpid = $_;
if ( $kidpid ) {
close $writeonly or die <<EOD;
App-Fetchware-Util: Failed to close $writeonly pipe in parent. Os error [$!].
EOD
my $output;
# Read the child's output until child closes pipe sending EOF.
$output .= $_ while (<$readonly>);
# Close $readonly pipe, because we have received the output from
# the user.
close $readonly or die <<EOD;
lib/App/Fetchware/Util.pm view on Meta::CPAN
{ # Begin scope block for $original_cwd.
# $original_cwd is a scalar variable that stores fetchware's original
# working directory for later use if its needed. It is access with
# original_cwd() below.
my $original_cwd;
# $fh_sem is a semaphore lock file that create_tempdir() creates, and
# cleanup_tempdir() closes clearing the lock. This is used to support
# fetchware clean. The filehandle needs to be declared outside
# create_tempdir()'s scope, because when this filehandle goes out of scope
# the file is closed, and the lock is released, but fetchware needs to keep
# hold of this lock for the life of fetchware to ensure that any fetchware
# clean won't delete this fetchware temporary directory.
my $fh_sem;
###BUGALERT### Add support for the -f/--force option to force deleting fetchware
#temp dirs even if locked.
sub create_tempdir {
my %opts = @_;
msg 'Creating temp dir to use to install your package.';
# Ask for better security.
File::Temp->safe_level( File::Temp::HIGH );
# Create the temp dir in the portable locations as returned by
# File::Spec->tempdir() using the specified template (the weird $$ is this
# processes process id), and cleaning up at program exit.
my $exception = '';
my $temp_dir;
eval {
local $@;
# Determine tempdir()'s arguments.
my @args = ("fetchware-$$-XXXXXXXXXX");#, TMPDIR => 1);
# Specify the caller's TempDir (DIR) if they specify it.
push @args, DIR => $opts{TempDir} if defined $opts{TempDir};
# Specify either system temp directory or user specified directory.
push @args,
(defined $opts{TempDir} ? (DIR => $opts{TempDir}) : (TMPDIR => 1));
# Don't CLEANUP if KeepTempDir is set.
push @args, CLEANUP => 1 if not defined $opts{KeepTempDir};
# Call tempdir() with the @args I've built.
$temp_dir = tempdir(@args);
# Only when we do *not* drop privs...
if (config('stay_root')
or ($< != 0 or $> != 0)
) {
# ...Must chmod 700 so gpg's localized keyfiles are good.
chmod(0700, $temp_dir) or die <<EOD;
App-Fetchware-Util: Fetchware failed to change the permissions of its temporary
directory [$temp_dir] to 0700. This should not happen, and is a bug, or perhaps
your system's temporary directory is full. The OS error was [$!].
EOD
}
$exception = $@;
1; # return true unless an exception is thrown.
} or die <<EOD;
App-Fetchware: run-time error. Fetchware tried to use File::Temp's tempdir()
subroutine to create a temporary file, but tempdir() threw an exception. That
exception was [$exception]. See perldoc App::Fetchware.
EOD
$original_cwd = cwd();
vmsg "Saving original working directory as [$original_cwd]";
# Change directory to $CONFIG{TempDir} to make unarchiving and building happen
# in a temporary directory, and to allow for multiple concurrent fetchware
# runs at the same time.
chdir $temp_dir or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to change its directory to the
temporary directory that it successfully created. This just shouldn't happen,
and is weird, and may be a bug. See perldoc App::Fetchware.
EOD
vmsg "Successfully changed working directory to [$temp_dir].";
# Create 'fetcwhare.sem' - the fetchware semaphore lock file.
open $fh_sem, '>', 'fetchware.sem' or die <<EOD;
App-Fetchware-Util: Failed to create [fetchware.sem] semaphore lock file! This
should not happen, because fetchware is creating this file in a brand new
directory that only fetchware should be accessing. You simply shouldn't see this
error unless some one is messing with fetchware, or perphaps there actually is a
bug? I don't know, but this just shouldn't happen. It's so hard to trigger it to
happen, it can't easily be tested in fetchware's test suite. OS error [$!].
EOD
vmsg "Successfully created [fetchware.sem] semaphore lock file.";
# Now flock 'fetchware.sem.' This should
# Use LOCK_NB so flock won't stupidly wait forever and ever until the lock
# becomes available.
flock $fh_sem, LOCK_EX | LOCK_NB or die <<EOD;
App-Fetchware-Util: Failed to flock [fetchware.sem] semaphore lock file! This
should not happen, because this is being done in a brand new temporary directory
that only this instance of fetchware cares about. This just shouldn't happen. OS
error [$!].
EOD
vmsg "Successfully locked [fetchware.sem] semaphore lock file using flock.";
msg "Temporary directory created [$temp_dir]";
return $temp_dir;
}
sub original_cwd {
return $original_cwd;
}
lib/App/Fetchware/Util.pm view on Meta::CPAN
my $filename = download_ftp_url($url);
Uses Net::FTP to download the specified FTP URL using binary mode.
=head2 download_http_url()
my $filename = download_http_url($url);
Uses HTTP::Tiny to download the specified HTTP URL.
Supports adding extra arguments to HTTP::Tiny's new() constructor. These
arguments are B<not> checked for correctness; instead, they are simply forwarded
to HTTP::Tiny, which does not check them for correctness either. HTTP::Tiny
simply loops over its internal listing of what is arguments should be, and then
accesses the arguments if they exist.
This was really only implemented to allow App::FetchwareX::HTMLPageSync to change
its user agent string to avoid being blocked or freaking out Web developers that
they're being screen scraped by some obnoxious bot as HTMLPageSync is wimpy and
harmless, and only downloads one page.
You would add an argument like this:
download_http_url($http_url, agent => 'Firefox');
See HTTP::Tiny's documentation for what these options are.
=head2 download_file_url()
my $filename = download_file_url($url);
Uses File::Copy to copy ("download") the local file to the current working
directory.
=head1 TEMPDIR SUBROUTINES
These subroutines manage the creation of a temporary directory for you. They
also implement the original_cwd() getter subroutine that returns the current
working directory fetchware was at before create_tempdir() chdir()'d to the
temporary directory you specify. File::Temp's tempdir() is used, and
cleanup_tempdir() manages the C<fetchware.sem> fetchware semaphore file.
=over
=item NOTICE
App::Fetchware::Util's temporary directory creation utilities, create_tempdir(),
original_cwd(), and cleanup_tempdir(), only keep track of one tempdir at a time. If
you create another tempdir with create_tempdir() it will override the value of
original_cwd(), which may mess up other functions that call create_tempdir(),
original_cwd(), and cleanup_tempdir(). Therefore, becareful when you call these
functions, and do B<not> use them inside a fetchware extension if you reuse
App::Fetchware's start() and end(), because App::Fetchware's start() and end()
use these functions, so your use of them will conflict. If you still need to
create a tempdir just call File::Temp's tempdir() directly.
=back
=head2 create_tempdir()
my $temp_dir = create_tempdir();
Creates a temporary directory, chmod 700's it, and chdir()'s into it.
Accepts the fake hash argument C<KeepTempDir => 1>, which tells create_tempdir()
to B<not> delete the temporary directory when the program exits.
Also, accepts C<TempDir =E<gt> '/tmp'> to specify what temporary directory to
use. The default with out this argument is to use tempdir()'s default, which is
whatever File::Spec's tmpdir() says to use.
The C<NoChown =E<gt> 1> option causes create_tempdir() to B<not> chown to
config('user').
=head3 Locking Fetchware's temp directories with a semaphore file.
In order to support C<fetchware clean>, create_tempdir() creates a semaphore
file. The file is used by C<fetchware clean> (via bin/fetchware's cmd_clean())
to determine if another fetchware process out there is currently using this
temporary directory, and if it is not, the file is not currently locked with
flock, then the entire directory is deleted using File::Path's remove_path()
function. If the file is there and locked, then the directory is skipped by
cmd_clean().
cleanup_tempdir() is responsible for unlocking the semaphore file that
create_tempdir() creates. However, the coolest part of using flock is that if
fetchware is killed in any manner whether its C<END> block or File::Temp's
C<END>block run, the OS will still unlock the file, so no edge cases need
handling, because the OS will do them for us!
=head2 original_cwd()
my $original_cwd = original_cwd();
original_cwd() simply returns the value of fetchware's $original_cwd that is
saved inside each create_tempdir() call. A new call to create_tempdir() will
reset this value. Note: App::Fetchware's start() also calls create_tempdir(), so
another call to start() will also reset original_cwd().
=head2 cleanup_tempdir()
cleanup_tempdir();
Cleans up B<any> temporary files or directories that anything in this process used
File::Temp to create. You cannot only clean up one directory or another;
instead, you must just use this sparingly or in an END block although file::Temp
takes care of that for you unless you asked it not to.
It also closes $fh_sem, which is the filehandle of the 'fetchware.sem' file
create_tempdir() opens and I<locks>. By closing it in cleanup_tempdir(), we're
unlocking it. According to MJD's "File Locking Tips and Traps," it's better to
just close the file, then use flock to unlock it.
=head1 SECURITY SUBROUTINES
This section describes Utilty subroutines that can be used for checking security
of files on the file system to see if fetchware should open and use them.
=head2 safe_open()
my $fh = safe_open($file_to_check, <<EOE);
App-Fetchware-Extension???: Failed to open file [$file_to_check]! Because of
OS error [$!].
lib/App/Fetchware/Util.pm view on Meta::CPAN
the file you want to check that has already been open for you. This is done to
prevent race conditions between the time safe_open() checks the file's safety
and the time the caller actually opens the file.
safe_open() also takes an optional second argument that specifies a caller
specific error message that replaces the generic default one.
Fetchware occasionally needs to write files especially in fetchware's new()
command; therefore safe_open() also takes the fake hash argument
C<MODE =E<gt> 'E<gt>'>, which opens the file in a mode specified by the caller.
C<'E<gt>'> is for writing for example. See C<perldoc -f open> for a list of
possible modes.
In fetchware, this subroutine is used to check if every file fetchware
opens is safe to do so. It is based on is_safe() and is_very_safe() from the
Perl Cookbook by Tom Christiansen and Nathan Torkington.
What this subroutine checks:
=over
=item *
It opens the file you give to it as an argument, and all subsequent operations
are done on the opened filehandle to prevent race conditions.
=item *
Then it checks that the owner of the specified file must be either the superuser
or the user who ran fetchware.
=item *
It checks that the mode, as returned by File::stat's overridden stat, is not
writable by group or other. Fancy MAC permissions such as Linux's extfs's
extensions and fancy Windows permissions are B<not> currently checked.
=item *
Then safe_open() stat's each and every parent directory that is in this file's
full path, and runs the same checks that are run above on each parent directory.
=item *
_PC_CHOWN_RESTRICTED is not tested; instead what is_very_safe() does is simply
always done. Because even with A _PC_CHOWN_RESTRICTED test, /home, for example,
could be 777. This is Unix after all, and root can do anything including screw
up permissions on system directories.
=back
If you actually are some sort of security expert, please feel free to
double-check if the list of stuff to check for is complete, and perhaps even the
Perl implementation to see if the subroutine really does check if
safe_open($file_to_check) is actually safe.
=over
=item WARNING
According to L<perlport>'s chmod() documentation, on Win32 perl's Unixish file
permissions arn't supported only "owner" is:
"Only good for changing "owner" read-write access, "group", and "other" bits are
meaningless. (Win32)"
I'm not completely sure this means that under Win32 only owner perms mean
something, or if just chmod()ing group or ther bits don't do anything, but
testing if group and other are rwx does work. This needs testing.
And remember this only applies to Win32, and fetchware has not yet been properly
ported or tested under Win32 yet.
=back
=head2 drop_privs()
my $output = drop_privs(sub {
my $write_pipe = shift;
# Do stuff as $regular_user
...
# Use write_dropprivs_pipe to share variables back to parent.
write_dropprivs_pipe($write_pipe, $var1, $var2, ...);
}, $regular_user
);
# Back in the parent, use read_dropprivs_pipe() to read in whatever
# variables the child shared with us.
my ($var1, $var2, ...) = read_dropprivs_pipe($output);
Forks and drops privs to $regular_user, and then executes whatever is in the
first argument, which should be a code reference. Throws an exception on any
problems with the fork.
It only allows you to specify what the lower priveledged user does. The parent
process's behavior can not be changed. All the parent does:
=over
=item *
Create a pipe to allow the child to communicate any information back to the
parent.
=item *
Read any data the child may write to that pipe.
=item *
After the child has died, collect the child's exit status.
=item *
And return the output the child wrote on the pipe as a scalar reference.
=back
Whatever the child writes is returned. drop_privs() does not use Storable or
JSON or XML or anything. It is up to you to specify how the data is to be
represented and used. However, L<read_dropprivs_pipe()> and
L<write_dropprivs_pipe()> are provided. They provide a simple way to store
multiple variables that can have any character in them including newline. See
their documentation for details.
=over
( run in 1.130 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )