view release on metacpan or  search on metacpan

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

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