view release on metacpan or  search on metacpan

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

        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;
App-Fetchware-Util: Failed to close $readonly pipe in parent. Os error [$!].
EOD

                # Just block waiting for the child to finish.
                waitpid($kidpid, 0);
                # If the child failed ($? >> 8 != 0), then the parent should
                # fail as well, because the child only exists to drop privs with
                # the ability to still at a later time execute something as root
                # again, so the fork is needed, because once you drop privs
                # you can't get them back, and you don't want to be able to for
                # security reasons.
                if (($? >> 8) != 0) {
                    # Note this message is only vmsg()'d instead of die()'d,
                    # because if its printed always, it could confuse users.
                    # Because priv_drop()ing is the default, this error would be
                    # seen all the time making getting confused by it likely.
                    vmsg <<EOM;
App-Fetchware-Util: An error occured forcing fetchware to exit while fetchware
has forked to drop its root priviledges to avoid downloading files and building
programs as root. Root priviledges are only maintained to install the software
in a system directory requiring root access. The error that caused the child to
fail will have already been printed above by the child.
EOM
                    msg <<EOM;
For help troublehsooting fetchware failed inside directory:
@{[cwd()]}
EOM
                    # Keep all of fetchware's temporary files and directories
                    # around so the user has access to them, so they can be
                    # troubleshooted to see what caused the failure. 
                    $File::Temp::KEEP_ALL = 1;
                    # Exit non-zero indicating failure, because whatever the
                    # child did failed, and the child's main eval {} in
                    # bin/fetchware caught that failure, printed it to the
                    # screen, and exit()ed non-zero for failure. And since the
                    # child failed ($? >> 8 != 0), the parent should fail too.
                    exit 1;
                # If successful, return to the child a ref of @output to caller.
                } else {
                    return \$output;
                }
            # Fork succeeded, child code goes here.
            } else {
                close $readonly or die <<EOD;
App-Fetchware-Util: Failed to close $readonly pipe in child. Os error [$!].
EOD
                # Drop privs.
                # drop_privileges() dies on an error just let drop_privs() caller
                # catch it.
                my ($uid, $gid) = drop_privileges($regular_user); 


                # Execute the coderef that is supposed to be done as non-root.
                $child_code->($writeonly);

                # Now close the pipe, to avoid creating a dead pipe causing a
                # SIGPIPE to be sent to the parent.
                close $writeonly or die <<EOD;
App-Fetchware-Util: Failed to close $writeonly pipe in child. Os error [$!].
EOD

                # Exit success, because failure is only indicated by a thrown
                # exception that bin/fetchware's main eval {} will catch, print,
                # and exit non-zero indicating failure.
                # Use POSIX's _exit() to avoid calling END{} blocks. This *must*
                # be done to prevent File::Temp's END{} block from attempting to
                # delete the temp directory that the parent still needs to
                # finish installing or uninstalling. The parent's END{} block's
                # will still be called, so this just turns off the child
                # deleting the temp dir not the parent.
                _exit 0;
            }
        }    
    # Non-Unix OSes just execute the $child_code.
    } else {
        return $dont_drop_privs->($child_code);
    }
}




###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/;