view release on metacpan or  search on metacpan

lib/App/Fetchware/Util.pm  view on Meta::CPAN

    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>);

lib/App/Fetchware/Util.pm  view on Meta::CPAN

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 [$!].
    EOE

    # To open for writing instead of reading 
    my $fh = safe_open($file_to_check, <<EOE, MODE => '>');
    App-Fetchware-Extension???: Failed to open file [$file_to_check]! Because of
    OS error [$!].
    EOE

safe_open() takes $file_to_check and does a bunch of file checks on that