App-Fetchware

 view release on metacpan or  search on metacpan

bin/fetchware  view on Meta::CPAN

        # I annoying must open the file before I can see if I can lock it or
        # not.
        my $sem_lock_file = catfile($temp_dir, 'fetchware.sem');
        my $fh_sem;
        if (open $fh_sem, '>', $sem_lock_file) {
            vmsg "Successfully created [fetchware.sem] semaphore lock file.";
        } else {
            # Test if the lockfile has the same owner uid as this running perl
            # process, and if they differ skip deleting this one, because we
            # lack the perms to do it anyway.
            if ($> != (stat($sem_lock_file))[4]) {
                msg "Skipping file [$sem_lock_file], because a different user created it.";
                next;
            } else {
                die <<EOD;
App-Fetchware-Util: Failed to create [$sem_lock_file] 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 [$!].

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

sub file_parse_filelist {
    my $file_listing = shift;

    for my $file (@$file_listing) {
        my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size, $atime,$mtime,$ctime,
            $blksize,$blocks)
            = stat($file) or die <<EOD;
App-Fetchware: Fetchware failed to stat() the file [$file] while trying to parse
your local [file://] lookup_url. The OS error was [$!]. This should not happen,
and is either a bug in fetchware or some sort of race condition.
EOD

        # Replace scalar filename with a arrayref of the filename with its
        # assocated timestamp for later processing for lookup().
        # 
        # Use Path::Class's file() constructor & basename() method to strip out
        # all unneeded directory information leaving just the file's name.
        # Add all of the timestamp numbers together, so that only one numberical

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

App-Fetchware-Util: The directory that fetchware is trying to use to determine
if a new version of the software is availabe cannot be opened. This directory is
[$local_lookup_url], and the OS error is [$!].
EOD
    while (my $filename = readdir($dh)) {
        # Trim the useless '.' and '..' Unix convention fake files from the listing.
        unless ($filename eq '.' or $filename eq '..') {
            # Turn the relative filename into a full pathname.
            #
            # Full pathnames are required, because lookup()'s
            # file_parse_filelist() stat()s each file using just their filename,
            # and if it's relative instead of absolute these stat() checks will
            # fail.
            my $full_path = catfile($local_lookup_url, $filename);
            push @file_listing, $full_path;
        }
    }

    closedir $dh;

    # Throw another exception if the directory contains nothing.
    # Awesome, clever, and simple Path::Class based "is dir empty" test courtesy
    # of tobyinc on PerlMonks (http://www.perlmonks.org/?node_id=934482).
    my $pc_local_lookup_url = dir($local_lookup_url);
    die <<EOD if $pc_local_lookup_url->stat() && !$pc_local_lookup_url->children();
App-Fetchware-Util: The directory that fetchware is trying to use to determine
if a new version of the software is available is empty. This directory is
[$local_lookup_url].
EOD

    return \@file_listing;
}

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

    my $fh;


    # Open the file first.
    unless (exists $opts{MODE} and defined $opts{MODE}) {
        open $fh, '<', $file_to_check or die $open_fail_message;
    } else {
        open $fh, $opts{MODE}, $file_to_check or die $open_fail_message;
    }

    my $info = stat($fh);# or goto STAT_ERROR;

    # Owner must be either me (whoever runs fetchware) or superuser. No one else
    # can be trusted.
    if(($info->uid() != 0) && ($info->uid() != $<)) {
        die <<EOD;
App-Fetchware-Util: The file fetchware attempted to open is not owned by root or
the person who ran fetchware. This means the file could have been dangerously
altered, or it's a simple permissions problem. Do not simly change the
ownership, and rerun fetchware. Please check that the file [$file_to_check] has
not been tampered with, correct the ownership problems and try again.

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

        # Return, by being the last statement, the list of parent dirs for
        # $file_to_check.
        @dirs;
    };
    # Who cares if _PC_CHOWN_RESTRICTED is set, check all parent dirs anyway,
    # because if say /home was 777, then anyone (other) can change any child
    # file in any directory above /home now anyway even if _PC_CHOWN_RESTRICTED
    # is set.
    for my $dir (@directories) {

        my $info = stat($dir);# or goto STAT_ERROR;

        # Owner must be either me (whoever runs fetchware) or superuser. No one
        # else can be trusted.
        if(($info->uid() != 0) && ($info->uid() != $<)) {
            die <<EOD;
App-Fetchware-Util: The file fetchware attempted to open is not owned by root or
the person who ran fetchware. This means the file could have been dangerously
altered, or it's a simple permissions problem. Do not simly change the
ownership, and rerun fetchware. Please check that the file [$file_to_check] has
not been tampered with, correct the ownership problems and try again.

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

        }

    }
    # Return the proven above "safe" file handle.
    return $fh;

    # Use cool C style goto error handling. It beats copy and paste, and the
    # horrible contortions needed for "structured programming."
    STAT_ERROR: {
    die <<EOD;
App-Fetchware-Util: stat($fh) filename [$file_to_check] failed! This just
shouldn't happen unless of course the file you specified does not exist. Please
ensure files you specify when you run fetchware actually exist.
EOD
    }
}



sub drop_privs {
    my $child_code = shift;

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

        # 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