view release on metacpan or  search on metacpan

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

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

        # Specify the caller's TempDir (DIR) if they specify it.
        push @args, DIR => $opts{TempDir} if defined $opts{TempDir};

        # Specify either system temp directory or user specified directory.
        push @args,
            (defined $opts{TempDir} ? (DIR => $opts{TempDir}) : (TMPDIR => 1));

        # 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()
subroutine to create a temporary file, but tempdir() threw an exception. That
exception was [$exception]. See perldoc App::Fetchware.
EOD

    $original_cwd = cwd();
    vmsg "Saving original working directory as [$original_cwd]";

    # Change directory to $CONFIG{TempDir} to make unarchiving and building happen
    # in a temporary directory, and to allow for multiple concurrent fetchware
    # runs at the same time.
    chdir $temp_dir or die <<EOD;
App-Fetchware: run-time error. Fetchware failed to change its directory to the
temporary directory that it successfully created. This just shouldn't happen,
and is weird, and may be a bug. See perldoc App::Fetchware.
EOD
    vmsg "Successfully changed working directory to [$temp_dir].";

    # Create 'fetcwhare.sem' - the fetchware semaphore lock file.
    open $fh_sem, '>', 'fetchware.sem' or die <<EOD;
App-Fetchware-Util: Failed to create [fetchware.sem] semaphore lock file! This
should not happen, because fetchware is creating this file in a brand new
directory that only fetchware should be accessing. You simply shouldn't see this
error unless some one is messing with fetchware, or perphaps there actually is a
bug? I don't know, but this just shouldn't happen. It's so hard to trigger it to
happen, it can't easily be tested in fetchware's test suite. OS error [$!].
EOD
    vmsg "Successfully created [fetchware.sem] semaphore lock file.";
    # Now flock 'fetchware.sem.' This should
    # Use LOCK_NB so flock won't stupidly wait forever and ever until the lock
    # becomes available.
    flock $fh_sem, LOCK_EX | LOCK_NB or die <<EOD;
App-Fetchware-Util: Failed to flock [fetchware.sem] semaphore lock file! This
should not happen, because this is being done in a brand new temporary directory
that only this instance of fetchware cares about. This just shouldn't happen. OS
error [$!].
EOD
    vmsg "Successfully locked [fetchware.sem] semaphore lock file using flock.";

    msg "Temporary directory created [$temp_dir]";

    return $temp_dir;
}



    sub original_cwd {
        return $original_cwd;
    }