App-Fetchware
view release on metacpan or search on metacpan
lib/App/Fetchware/Util.pm view on Meta::CPAN
###BUGALERT### Add Test::Wrap support to msg() and vmsg() so that they will
#inteligently rewrap any text they receive so newly filled in variables won't
#screw up the wrapping.
sub msg (@) {
# If fetchware was not run in quiet mode, -q.
unless (defined $fetchware::quiet and $fetchware::quiet > 0) {
# print are arguments. Use say if the last one doesn't end with a
# newline. $#_ is the last subscript of the @_ variable.
if ($_[$#_] =~ /\w*\n\w*\z/) {
print @_;
} else {
say @_;
}
# Quiet mode is turned on.
} else {
# Don't print anything.
return;
}
}
sub vmsg (@) {
# If fetchware was not run in quiet mode, -q.
###BUGALERT### Can I do something like:
#eval "use constant quiet => 0;" so that the iffs below can be resolved at
#run-time to make vmsg() and msg() faster???
unless (defined $fetchware::quiet and $fetchware::quiet > 0) {
# If verbose is also turned on.
if (defined $fetchware::verbose and $fetchware::verbose > 0) {
# print our arguments. Use say if the last one doesn't end with a
# newline. $#_ is the last subscript of the @_ variable.
if ($_[$#_] =~ /\w*\n\w*\z/) {
print @_;
} else {
say @_;
}
}
# Quiet mode is turned on.
} else {
# Don't print anything.
return;
}
}
###BUGALERT### Add support for dry-run functionality!!!!
sub run_prog {
my (@args) = @_;
# Kill weird "Insecure dependency in system while running with -T switch."
# fatal exceptions by clearing the taint flag with a regex. I'm not actually
# running in taint mode, but it bizarrely thinks I am.
for my $arg (@args) {
if ($arg =~ /(.*)/) {
$arg = $1;
} else {
die <<EOD;
php.Fetchwarefile: Match anything pattern match failed! Huh! This shouldn't
happen, and is probably a bug.
EOD
}
}
# Use Text::ParseWords quotewords() subroutine to deal with spliting the
# arguments on whitespace, and to properly quote and keep single and double
# quotes.
my $program;
($program, @args) = map {quotewords('\s+', 1, $_)} @args;
# If fetchware is run without -q.
unless (defined $fetchware::quiet and $fetchware::quiet > 0) {
local $" = '][';
vmsg <<EOM;
Running command [$program] with options [@args].
EOM
system($program, @args) == 0 or die <<EOD;
fetchware: run-time error. Fetchware failed to execute the specified program
[$program] with the arguments [@args]. The OS error was [$!], and the return
value was [@{[$? >> 8]}]. Please see perldoc App::Fetchware::Diagnostics.
EOD
# If fetchware is run with -q.
} else {
# Use a piped open() to capture STDOUT, so that STDOUT is not printed to
# the terminal like it usually is therby "quiet"ing it.
# If not on Windows use safer open call that doesn't work on Windows.
unless (is_os_type('Windows', $^O)) {
open(my $fh, '-|', "$program", @args) or die <<EOD;
fetchware: run-time error. Fetchware failed to execute the specified program
while capturing its input to prevent it from being copied to the screen, because
you ran fetchware with it's --quite or -q option. The program was [$program],
and its arguments were [@args]. OS error [$!], and exit value [$?]. Please see
perldoc App::Fetchware::Diagnostics.
EOD
# Close $fh, to cause perl to wait for the command to do its
# outputing to STDOUT.
close $fh;
# We're on Windows.
} else {
open(my $fh, '-|', "$program @args") or die <<EOD;
fetchware: run-time error. Fetchware failed to execute the specified program
while capturing its input to prevent it from being copied to the screen, because
you ran fetchware with it's --quite or -q option. The program was [$program],
and its arguments were [@args]. OS error [$!], and exit value [$?]. Please see
perldoc App::Fetchware::Diagnostics.
EOD
# Close $fh, to cause perl to wait for the command to do its
# outputing to STDOUT.
close $fh;
}
}
}
lib/App/Fetchware/Util.pm view on Meta::CPAN
App-Fetchware: run-time error. HTTP::Tiny failed to download a file or directory
listingfrom your provided url [$http_url]. HTTP status code
[$response->{status} $response->{reason}] HTTP headers
[@{[Data::Dumper::Dumper($response->{headers})]}].
See man App::Fetchware.
EOD
# In this case the content is binary, so it will mess up your terminal.
#diag($response->{content}) if length $response->{content};
die <<EOD unless length $response->{content};
App-Fetchware: run-time error. The url [$http_url] you provided downloaded
nothing. HTTP status code [$response->{status} $response->{reason}]
HTTP headers [@{[Data::Dumper::Dumper($response)]}].
See man App::Fetchware.
EOD
# Must convert the worthless $response->{content} variable into a real file
# on the filesystem. Note: start() should have cd()d us into a suitable
# tempdir.
my $path = $http_url;
$path =~ s!^http://!!;
# Determine filename from the $path.
my ($volume, $directories, $filename) = splitpath($path);
# If $filename is empty string, then its probably a index directory listing.
$filename ||= 'index.html';
###BUGALERT### Need binmode() on Windows???
###BUGALERT### Switch to safe_open()????
open(my $fh, '>', $filename) or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to open a file necessary for
fetchware to store HTTP::Tiny's output. Os error [$!]. See perldoc
App::Fetchware.
EOD
# Write HTTP::Tiny's downloaded file to a real file on the filesystem.
print $fh $response->{content};
close $fh
or die <<EOS;
App-Fetchware: run-time error. Fetchware failed to close the file it created to
save the content it downloaded from HTTP::Tiny. This file was [$filename]. OS
error [$!]. See perldoc App::Fetchware.
EOS
# The caller needs the $filename to determine the $package_path later.
return $filename;
}
sub download_file_url {
my $url = shift;
$url =~ s!^file://!!; # Strip useless URL scheme.
# Prepend original_cwd() only if the $url is *not* absolute, which will mess
# it up.
$url = catdir(original_cwd(), $url) unless file_name_is_absolute($url);
# Download the file:// URL to the current directory, which should already be
# in $temp_dir, because of start()'s chdir().
#
# Don't forget to clear taint. Fetchware does *not* run in taint mode, but
# for some reason, bug?, File::Copy checks if data is tainted, and then
# retaints it if it is already tainted, but for some reason I get "Insecure
# dependency" taint failure exceptions when drop priving. The fix is to
# always untaint my data as done below.
###BUGALERT### Investigate this as a possible taint bug in perl or just
#File::Copy. Perhaps the cause is using File::Copy::cp(copy) after drop
#priving with data from root?
$url =~ /(.*)/;
my $untainted_url = $1;
my $cwd = cwd();
$cwd =~ /(.*)/;
my $untainted_cwd = $1;
cp($untainted_url, $untainted_cwd) or die <<EOD;
App::Fetchware: run-time error. Fetchware failed to copy the download URL
[$untainted_url] to the working directory [$untainted_cwd]. Os error [$!].
EOD
# Return just file filename of the downloaded file.
return file($url)->basename();
}
###BUGALERT### safe_open() does not check extended file perms such as ext*'s
#crazy attributes, linux's (And other Unixs' too) MAC stuff or Windows NT's
#crazy file permissions. Could use Win32::Perms for just Windows, but its not
#on CPAN. And what about the other OSes.
###BUGALERT### Consier moving this to CPAN??? File::SafeOpen????
sub safe_open {
my $file_to_check = shift;
my $open_fail_message = shift // <<EOE;
Failed to open file [$file_to_check]. OS error [$!].
EOE
my %opts = @_;
my $fh;
# Open the file first.
unless (exists $opts{MODE} and defined $opts{MODE}) {
open $fh, '<', $file_to_check or die $open_fail_message;
} else {
open $fh, $opts{MODE}, $file_to_check or die $open_fail_message;
}
my $info = stat($fh);# or goto STAT_ERROR;
# Owner must be either me (whoever runs fetchware) or superuser. No one else
# can be trusted.
if(($info->uid() != 0) && ($info->uid() != $<)) {
die <<EOD;
App-Fetchware-Util: The file fetchware attempted to open is not owned by root or
the person who ran fetchware. This means the file could have been dangerously
altered, or it's a simple permissions problem. Do not simly change the
ownership, and rerun fetchware. Please check that the file [$file_to_check] has
not been tampered with, correct the ownership problems and try again.
EOD
}
# Check if group and other can write $fh.
# Use 066 to detect read or write perms.
###BUGALERT### What does this actually test?????
if ($info->mode() & 022) { # Someone else can write this $fh.
die <<EOD
App-Fetchware-Util: The file fetchware attempted to open [$file_to_check] is
writable by someone other than just the owner. Fetchwarefiles and fetchware
packages must only be writable by the owner. Do not only change permissions to
fix this error. This error may have allowed someone to alter the contents of
your Fetchwarefile or fetchware packages. Ensure the file was not altered, then
change permissions to 644.
lib/App/Fetchware/Util.pm view on Meta::CPAN
###BUGALERT### Add quotemeta() support to pipe parsers to help prevent attacks.
{ # Bareblock just for the $MAGIC_NUMBER.
# Determine $front_magic
my $front_magic;
$front_magic = int(rand(8128389023));
# For no particular reason convert the random integer into hex, because I
# never store something in decimal and then exact same thing in hex.
$front_magic = $front_magic . sprintf("%x", $front_magic);
# Run srand() again to change random number generator between rand() calls.
# Not really necessary, but should make it harder to guess correct magic
# numbers.
srand(time());
# Same a $front_magic.
my $back_magic = int(rand(986487516));
# Octal this time :) for no real reason.
$back_magic = $back_magic . sprintf("%o", $back_magic);
my $MAGIC_NUMBER = $front_magic
. 'MAGIC_NUMBER_REPLACING_NEWLINE'
. $back_magic;
sub write_dropprivs_pipe {
my $write_pipe = shift;
for my $a_var (@_) {
die <<EOD if $a_var =~ /$MAGIC_NUMBER/;
fetchware: Huh? [$a_var] has fetchware's MAGIC_NUMBER in it? This shouldn't
happen, and messes up fetchware's simple IPC. You should never see this error,
because it's not a particuarly magic number if anybody actually uses it. This is
most likely a bug, so please report it.
EOD
# Write to the $write_pipe, but use the $MAGIC_NUMBER instead of just
# newline.
print $write_pipe $a_var . $MAGIC_NUMBER;
}
}
sub read_dropprivs_pipe {
my $output = shift;
die <<EOD if ref($output) ne 'SCALAR';
App-Fetchware-Util: pipe_read_newling() was called with an output variable
[$output] that was not a scalar reference. It must be a scalar reference.
EOD
my @variables;
for my $variable (split(/$MAGIC_NUMBER/, $$output)) {
# And some error handling just in case.
die <<EOD if not defined $variable;
fetchware: Huh? The child failed to write the proper variable back to the
parent! The variable is [$variable]. This should be defined but it is
not!
EOD
# Clear possibly tainted variables. It's a weird bug that makes no
# sense. I don't turn -t or -T on, so what gives??? If you're curious
# try commenting out the taint clearing code below, and running the
# t/bin-fetchware-install.t test file (Or any other ones that call
# drop_privs().).
my $untainted;
# Need the m//ms options to match strings with newlines in them.
if ($variable =~ /(.*)/ms) {
$untainted = $1;
} else {
die <<EOD;
App::Fetchware::Util: Untaint failed! Huh! This just shouldn't happen! It's
probably a bug.
EOD
}
# Push $untainted instead of just $variable, because I want to return
# untatined data instead of potentially tainted data.
push @variables, $untainted;
}
return @variables;
}
###BUGALERT### Add some pipe parsers that use Storable too.
} # End $MAGIC_NUMBER bare block.
sub do_nothing {
return;
}
{ # 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);
( run in 0.709 second using v1.01-cache-2.11-cpan-39bf76dae61 )