App-Fetchware
view release on metacpan or search on metacpan
lib/App/Fetchware/Util.pm view on Meta::CPAN
$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.
#
lib/App/Fetchware/Util.pm view on Meta::CPAN
# 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
lib/App/Fetchware/Util.pm view on Meta::CPAN
# 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()
lib/App/Fetchware/Util.pm view on Meta::CPAN
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').
lib/App/Fetchware/Util.pm view on Meta::CPAN
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 {
lib/App/FetchwareX/HTMLPageSync.pm view on Meta::CPAN
temporary directory is available for use.
=back
=back
=head2 start()
my $temp_file = start();
start() creats a temp dir, chmod 700's it, and chdir()'s to it just like the one
in App::Fetchware does. App::FetchwareX::HTMLPageSync
start() is imported use L<App::Fetchware::ExportAPI> from App::Fetchware,
and also exported by App::FetchwareX::HTMLPageSync. This is how
App::FetchwareX::HTMLPageSync "subclasses" App::Fetchware.
=head2 lookup()
my $download_url = lookup();
lib/Test/Fetchware.pm view on Meta::CPAN
specified despite it pretty much always being just '1.00'. It is still
mandatory.
EOD
}
# $destination_directory is a mandatory option, but if the caller does not
# provide one, then simply use a tempdir().
if (not defined $opts{destination_directory}) {
$opts{destination_directory}
= tempdir("fetchware-test-$$-XXXXXXXXXXX", TMPDIR => 1, CLEANUP => 1);
# Don't *only* create the tempdid $destination_directory, also, it must
# be chmod()'d to 755, unless stay_root is set, so that the dropped priv
# user can still access the directory make_test_dist() creates.
chmod 0755, $opts{destination_directory} or die <<EOD;
Test-Fetchware: Fetchware failed to change the permissions of it's testing
destination directory [$opts{destination_directory}] this shouldn't happen, and is
perhaps a bug. The OS error was [$!].
EOD
}
# This %opts check must go before the code below sets fetchwarefile even if
# the user did not supply it. Perhaps separate things should stay separate,
# and %opts and %test_dist_files should both exist for this, but why bother
# duplicating the same information if only one options is annoyed?
if (defined $opts{fetchwarefile} and defined $opts{append_option}) {
lib/Test/Fetchware.pm view on Meta::CPAN
for my $file_to_create (keys %test_dist_files) {
open(my $fh, '>', $file_to_create) or die <<EOD;
fetchware: Run-time error. Fetchware failed to open
[$file_to_create] for writing to create the Configure script that
test-dist needs to work properly. The OS error was [$!].
EOD
print $fh $test_dist_files{$file_to_create};
close $fh;
}
# chmod() ./configure, so it can be executed.
chmod(0755, $configure_path) or die <<EOC;
fetchware: run-time error. fetchware failed to chmod [$configure_path] to add
execute permissions, which ./configure needs. Os error [$!].
EOC
# Create a tar archive of all of the files needed for test-dist.
Archive::Tar->create_archive("$test_dist_filename", COMPRESS_GZIP,
keys %test_dist_files) or die <<EOD;
fetchware: Run-time error. Fetchware failed to create the test-dist archive for
testing [$test_dist_filename] The error was [@{[Archive::Tar->error()]}].
EOD
lib/Test/Fetchware.pm view on Meta::CPAN
sub create_test_fetchwarefile {
my $fetchwarefile_content = shift;
# Use a temp dir outside of the installation directory
my ($fh, $fetchwarefile_path)
=
tempfile("fetchware-$$-XXXXXXXXXXXXXX", TMPDIR => 1, UNLINK => 1);
# Chmod 644 to ensure a possibly dropped priv child can still at least read
# the file. It doesn't need write access just read.
unless (chmod 0644, $fetchwarefile_path
and
# Only Unix drops privs. Nonunix does not.
is_os_type('Unix')
) {
die <<EOD;
fetchware: Failed to chmod 0644, [$fetchwarefile_path]! This is a fatal error,
because if the file is not chmod()ed, then fetchware cannot access the file if
it was created by root, and then tried to read it, but root on Unix dropped
privs. OS error [$!].
EOD
}
# Be sure to add a prefix to the generated Fetchwarefile if fetchware is not
# running as root to ensure that our test installs succeed.
#
# Prepend a newline to ensure that prefix is not added to an existing line.
add_prefix_if_nonroot(sub {
lib/Test/Fetchware.pm view on Meta::CPAN
=back
=over
=item WARNING
When you specify your own $destination_directory, you must also B<ensure> that
it's permissions are C<0755>, because during testing fetchware may drop_privs()
causing it to lose its ability to access the $destination_directory. Therefore,
when specifying your own $destination_directory, please C<chmod> it to to
C<0755> to ensure its child can still access the test distribution in your
$destination_directory.
=back
=head2 md5sum_file()
my $md5sum_fil_path = md5sum_file($archive_to_md5);
Uses Digest::MD5 to generate a md5sum just like the md5sum program does, and
t/App-Fetchware-Util.t view on Meta::CPAN
is_fh($safe_fh, 'checked safe_open() success');
close ($safe_fh);
# Test opening the file for writing.
# The undef is a placeholder for the second arg. The error mesage is not a
# named argument like WRITE is, because despite being optional, it's always
# going to be used in fetchware for more helpful error messages.
is_fh(safe_open($filename, undef,MODE => '>'),
'checked safe_open write success');
chmod 0640, $filename;
is_fh(safe_open($filename), 'checked safe_open() group readable success');
chmod 0604, $filename;
is_fh(safe_open($filename), 'checked safe_open() other readable success');
chmod 0644, $filename;
is_fh(safe_open($filename),
'checked safe_open() group and other readable success');
# Change perms to bad perms and check both group and owner
chmod 0660, $filename;
eval_ok(sub {safe_open($filename)},
qr/App-Fetchware-Util: The file fetchware attempted to open \[/,
'checked safe_open() file group perms unsafe');
# Make a directory inside the tempdir.
mkdir ('testdir') or fail ('Failed to make testing directory [testdir]');
# create a file inside the tempdir.
my ($sdfh, $subdirfilename)
= tempfile("fetchware-test-$$-XXXXXXXXXXXXXXX", DIR => cwd());
note("FILENAME[$subdirfilename]");
# Check for success on the file.
close($sdfh);
my $sfh = safe_open($subdirfilename);
is_fh($sfh, 'checked safe_open() success');
close ($sfh);
# Change perms for group and owner and recheck.
chmod 0640, $subdirfilename;
is_fh(safe_open($subdirfilename), 'checked safe_open() group readable success');
chmod 0604, $subdirfilename;
is_fh(safe_open($subdirfilename), 'checked safe_open() other readable success');
chmod 0644, $subdirfilename;
is_fh(safe_open($subdirfilename),
'checked safe_open() group and other readable success');
# change perms for group and owner of the containing directory you made, and
# recheck.
chmod 0660, $subdirfilename;
eval_ok(sub {safe_open($subdirfilename)},
qr/App-Fetchware-Util: The file fetchware attempted to open \[/,
'checked safe_open() file group perms unsafe');
# chdir back to $original_cwd so File::Temp can delete temp files.
chdir $original_cwd;
};
subtest 'test safe_open() needs root' => sub {
t/App-Fetchware-Util.t view on Meta::CPAN
# Return false
note('ISNOTUNIX');
0
}
};
if ($< == 0 or $> == 0) {
# Use dir from above. #$tempdir and $filename.
# Change group and owner perms on nobody owned dir.
my $parent_dir = dir($filename)->parent();
chmod 0640, $parent_dir;
is_fh(safe_open($parent_dir),
'checked safe_open() group directory readable success');
chmod 0604, $parent_dir;
is_fh(safe_open($parent_dir),
'checked safe_open() other directory readable success');
chmod 0644, $parent_dir;
is_fh(safe_open($parent_dir),
'checked safe_open() group and other directory readable success');
# Repeat for file too.
chmod 0640, $filename;
is_fh(safe_open($filename),
'checked safe_open() group file readable success');
chmod 0604, $filename;
is_fh(safe_open($filename),
'checked safe_open() other file readable success');
chmod 0644, $filename;
is_fh(safe_open($filename),
'checked safe_open() group and other file readable success');
# chown the tempdir to nobody, and check for diff owner.
# This call must happen after other checks, because it will make all
# checks for $filename fail with the expected exception below, and
# that change should just be isolated to this one test; therefore it
# is last.
chown(scalar getpwnam('nobody'), -1, $filename)
or fail("Failed to chown [$filename]!");
t/App-Fetchware-Util.t view on Meta::CPAN
'checked safe_open() wrong owner failure');
# Make a custom tempdir in / the root directory.
my ($fh, $root_filename) =
tempfile("fetchware-root-test-$$-XXXXXXXXXXXXXXX",
DIR => rootdir(),
UNLINK => 1
);
# Test it on a root dir that won't recurse into subdirs, because they're
# arn't any.
chmod 0640, $root_filename;
is_fh(safe_open($root_filename),
'checked safe_open() group file readable success');
chmod 0604, $root_filename;
is_fh(safe_open($root_filename),
'checked safe_open() other file readable success');
chmod 0644, $root_filename;
is_fh(safe_open($root_filename),
'checked safe_open() group and other file readable success');
} else {
note("Should be skipped, because you're not root! [$<] [$>]");
}
};
t/bin-fetchware-command-line.t view on Meta::CPAN
'checked cmd_upgrade() clean up fetchware database path')
if -e $fetchware_package
}
}
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I have create the tempdir, but I must also chmod 755
# this temporary directory to ensure read access if this test file is run as
# root, and then drops its privs without the extra read perms this test will
# fail, because the nobody user will not be able to access this directory's
# 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
note("UPGRADETD[$upgrade_temp_dir]");
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
# Delete all existing httpd fetchware packages in fetchware_database_path(),
t/bin-fetchware-command-line.t view on Meta::CPAN
};
subtest 'test command line upgrade-all' => sub {
# Actually test during user install!!!
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I hav to create the tempdir, but I must also chmod
# 755 this temporary directory to ensuer read access if this test file is
# run as root, and then drops its privs without the extra read perms this
# test will fail, because the nobody user will not be able to access this
# directory's 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_another_dist_path = make_test_dist(file_name => 'another-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
my $old_another_dist_path_md5 = md5sum_file($old_another_dist_path);
t/bin-fetchware-run.t view on Meta::CPAN
# TMPDIR, and then the tempdir should be inside this path that I setup.
local $ENV{TMPDIR} = tempdir("fetchware-test-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
ok(-e $ENV{TMPDIR},
'checked run() TMPDIR setup.');
# For some reason tempdir() ignores your umask, and just creates its
# tempfiles and tempdirs with 0700 perms, which in the case of drop_privs()
# when root blows up, because the regular user that fetchware drop privs too
# can't access a 0700 root only tempdir. So I must change the perms to 0755
# to let the regular user have access.
ok(chmod(0755, $ENV{TMPDIR}),
'checked run() TMPDIR chmod(755).');
my $test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', append_option => q{stay_root 'On'});
ok(-e $test_dist_path, 'checked run() test-dist created.');
my $test_dist_md5 = md5sum_file($test_dist_path);
ok(-e $test_dist_md5, 'checked run() test-dist md5 created.');
verbose_on();
{
t/bin-fetchware-run.t view on Meta::CPAN
'checked cmd_upgrade() clean up fetchware database path')
if -e $fetchware_package
}
}
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I have create the tempdir, but I must also chmod 755
# this temporary directory to ensure read access if this test file is run as
# root, and then drops its privs without the extra read perms this test will
# fail, because the nobody user will not be able to access this directory's
# 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
note("UPGRADETD[$upgrade_temp_dir]");
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
# Delete all existing httpd fetchware packages in fetchware_database_path(),
t/bin-fetchware-run.t view on Meta::CPAN
};
subtest 'test run() upgrade-all' => sub {
# Actually test during user install!!!
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I hav to create the tempdir, but I must also chmod
# 755 this temporary directory to ensuer read access if this test file is
# run as root, and then drops its privs without the extra read perms this
# test will fail, because the nobody user will not be able to access this
# directory's 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_another_dist_path = make_test_dist(file_name => 'another-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir);
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
my $old_another_dist_path_md5 = md5sum_file($old_another_dist_path);
t/bin-fetchware-upgrade-all.t view on Meta::CPAN
__clear_CONFIG();
subtest 'test cmd_upgrade_all() test-dist' => sub {
# Actually test during user install!!!
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I hav to create the tempdir, but I must also chmod
# 755 this temporary directory to ensuer read access if this test file is
# run as root, and then drops its privs without the extra read perms this
# test will fail, because the nobody user will not be able to access this
# directory's 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir,
append_option => qq{user '$ENV{FETCHWARE_NONROOT_USER}';});
my $old_another_dist_path = make_test_dist(file_name => 'another-dist',
ver_num => '1.00', destination_directory => $upgrade_temp_dir,
append_option => qq{user 'ENV{FETCHWARE_NONROOT_USER}';});
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
t/bin-fetchware-upgrade.t view on Meta::CPAN
'checked cmd_upgrade() clean up fetchware database path')
if -e $fetchware_package
}
}
# Create a $temp_dir for make_test_dist() to use. I need to do this, so that
# both the old and new test dists can be in the same directory.
my $upgrade_temp_dir = tempdir("fetchware-$$-XXXXXXXXXX",
CLEANUP => 1, TMPDIR => 1);
# However, not only do I have create the tempdir, but I must also chmod 755
# this temporary directory to ensure read access if this test file is run as
# root, and then drops its privs without the extra read perms this test will
# fail, because the nobody user will not be able to access this directory's
# 700 perms.
chmod 0755, $upgrade_temp_dir or fail(<<EOF);
Failed to chmod(0755, [$upgrade_temp_dir])! This is probably a bug or something?
EOF
note("UPGRADETD[$upgrade_temp_dir]");
my $old_test_dist_path = make_test_dist(file_name => 'test-dist',
ver_num =>'1.00', destination_directory => $upgrade_temp_dir,
append_option => qq{user => 'ENV{FETCHWARE_NONROOT_USER}';});
my $old_test_dist_path_md5 = md5sum_file($old_test_dist_path);
( run in 0.430 second using v1.01-cache-2.11-cpan-496ff517765 )