view release on metacpan or  search on metacpan

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

sub digest_verify {
    my ($digest_type, $download_path, $package_path) = @_;

    # Turn SHA-1 into sha1 & MD5 into md5.
    my $digest_ext = $digest_type;
    $digest_ext = lc $digest_type;
    $digest_ext =~ s/-//g;
##subify get_sha_sum()
    my $digest_file;
    # Obtain a sha sum file.
    if (defined config("${digest_ext}_url")) {
        my (undef, undef, $path, undef, undef) = uri_split($download_path);
        my ($scheme, $auth, undef, undef, undef) =
            uri_split(config("${digest_ext}_url"));
        my $digest_url = uri_join($scheme, $auth, $path, undef, undef);
        msg "Downloading $digest_ext digest using [$digest_url.$digest_ext]";
        $digest_file = no_mirror_download_file("$digest_url.$digest_ext");
    } else {
        eval {
            my (undef, undef, $path, undef, undef) = uri_split($download_path);
            my ($scheme, $auth, undef, undef, undef) =
                uri_split(config('lookup_url'));
            my $digest_url = uri_join($scheme, $auth, $path, undef, undef);
            msg "Downloading $digest_ext digest using [$digest_url.$digest_ext]";
            $digest_file = no_mirror_download_file("$digest_url.$digest_ext");
        };
        if ($@) {
            die <<EOD;
App-Fetchware: Fetchware was unable to download the $digest_type sum it needs to
download to properly verify you software package. This is a fatal error, because
failing to verify packages is a perferable default over potentially installin
compromised ones. If failing to verify your software package is ok to you, then
you may disable verification by adding verify_failure_ok 'On'; to your
Fetchwarefile. See perldoc App::Fetchware.
EOD
        }
    }
    
###BUGALERT###subify calc_sum()
    # Open the downloaded software archive for reading.
    my $package_fh = safe_open($package_path, <<EOD);
App-Fetchware: run-time error. Fetchware failed to open the file it downloaded
while trying to read it in order to check its MD5 sum. The file was
[$package_path]. See perldoc App::Fetchware.
EOD

    # Do Digest type checking myself, because until Digest.pm 1.17,
    # Digest->new() could run any Perl code you specify or a user does causing
    # the security hole. Instead of use Digest 1.17, just avoid it altogether.
    my $digest;
    if ($digest_type eq 'MD5') {
        $digest = Digest::MD5->new();
    } elsif ($digest_type eq 'SHA-1') {
        $digest = Digest::SHA->new();
    } else {
        die <<EOD;
EOD
    }

    # Digest requires the filehandle to have binmode set.
    binmode $package_fh;

    my $calculated_digest;
    eval {
        # Add the file for digesting.
        $digest->addfile($package_fh);
        # Actually digest it.
        $calculated_digest = $digest->hexdigest();
    };
    if ($@) {
        die <<EOD;
App-Fetchware: run-time error. Digest::$digest_type croak()ed an error [$@].
See perldoc App::Fetchware.
EOD
    }

    close $package_fh or die <<EOD;
App-Fetchware: run-time error Fetchware failed to close the file
[$package_path] after opening it for reading. See perldoc App::Fetchware.
EOD

###subify compare_sums();
    # Open the downloaded software archive for reading.
    my $digest_fh = safe_open($digest_file, <<EOD);
App-Fetchware: run-time error. Fetchware failed to open the $digest_type file it
downloaded while trying to read it in order to check its $digest_type sum. The file was
[$digest_file]. See perldoc App::Fetchware.
EOD
    # Will only check the first checksum it finds.
    while (<$digest_fh>) {
        next if /^\s+$/; # skip whitespace only lines just in case.
        my @fields = split ' '; # Defaults to $_, which is filled in by <>

        # Search the @fields for a regex that is either 32 hex for md5 or 40 hex
        # for sha1.
        my ($checksum) = grep /^[0-9a-f]{32}(?:[0-9a-f]{8})?$/i, @fields;

        # Skip trying to verify the $checksum if we failed to find it in this
        # line, and instead skip to the next line in the checksum file to try to
        # find a $checksum.
        next unless defined $checksum;

        if ($checksum eq $calculated_digest) {
            return 'Package verified';
        # Sometimes a = is appended to make it 32bits.
        } elsif ("$checksum=" eq $calculated_digest) {
            return 'Package verified';
        }
    }
    close $digest_fh;

    # Return failure, because fetchware failed to verify by checksum
    return undef;
}




sub unarchive {
    my $package_path = shift;