view release on metacpan or  search on metacpan

t/bin-fetchware-Fetchwarefile.t  view on Meta::CPAN

# mirrors. Fetchware, however, requires one, so the same URL is simply
# duplicated.
lookup_url 'http://nginx.org/download/';
mirror 'http://nginx.org/download/';


# Must add the developers public keys to my own keyring. These keys are
# availabe from http://nginx.org/en/pgp_keys.html Do this with:
# gpg \
# --fetch-keys http://nginx.org/keys/aalexeev.key\
# --fetch-keys http://nginx.org/keys/is.key\
# --fetch-keys http://nginx.org/keys/mdounin.key\
# --fetch-keys http://nginx.org/keys/maxim.key\
# --fetch-keys http://nginx.org/keys/sb.key\
# --fetch-keys http://nginx.org/keys/glebius.key\
# --fetch-keys http://nginx.org/keys/nginx_signing.key
# You might think you could just set gpg_keys_url to the nginx-signing.key key,
# but that won't work, because like apache different releases are signed by
# different people. Perhaps I could change gpg_keys_url to be like mirror where
# you can specify more than one option?
user_keyring 'On';
# user_keyring specifies to use the user's own keyring instead of fetchware's.
# But fetchware drops privileges by default using he user 'nobody.' nobody is
# nobody, so that user account does not have a home directory for gpg to read a
# keyring from. Therefore, I'm using my own account instead.
user 'dly';
# The other option, which is commented out below, is to use root's own keyring,
# and the no_install option to ensure that root uses its own keyring instead of
# nobody's.
# noinstall 'On';
verify_method 'gpg';
EOF

    # Create a tempfile to store the Fetchwarefile in.
    my ($fh, $filename) = tempfile("fetchware-test-$$-XXXXXXXXXXX", TMPDIR => 1,
        UNLINK => 1);
    # Write the $apache_fetchwarefile to disk, so bin/fetchware can access it.
    print $fh $nginx_fetchwarefile;
    close $fh; # Close $fh to ensure its contents make it out to disk.

    # Just execute bin/fetchware install with the newly created
    # apache.Fetchwarefile to test it.
    ok(run_prog(qw!perl -I lib bin/fetchware install!, $filename),
        'Checked Nginx Fetchwarefile success.');
};



subtest 'test PHP Fetchwarefile success' => sub {

    my $php_fetchwarefile = <<'EOF';
use App::Fetchware qw(
    :OVERRIDE_LOOKUP
    :OVERRIDE_DOWNLOAD
    :OVERRIDE_VERIFY
    :DEFAULT
);
use App::Fetchware::Util ':UTIL';
use HTML::TreeBuilder;
use URI::Split qw(uri_split uri_join);
use Data::Dumper;
use HTTP::Tiny;

program 'php';

lookup_url 'http://us1.php.net/downloads.php';
mirror 'http://us1.php.net';
mirror 'http://us2.php.net';
mirror 'http://www.php.net';

# php does *not* use a standard http or ftp mirrors for downloads. Instead, it
# uses its Web site, and some sort of application to download files using URLs
# such as: http://us1.php.net/get/php-5.5.3.tar.bz2/from/this/mirror
#
# Bizarrely a URL like
# http://us1.php.net/get/php-5.5.3.tar.bz2/from/us2.php.net/mirror
# gets you the same page, but on a different mirror. Weirdly, these are direct
# downloads without any HTTP redirects using 300 codes, but direct downloads.
# 
# This is why using fetchware with php you needs a custom lookup handler.
# The files you download are resolved to a [http://us1.php.net/distributions/...]
# directory, but trying to access a apache styple auto index at that url fails
# with a rediret back to downloads.php.
my $md5sum;
hook lookup => sub {
    die <<EOD unless config('lookup_url') =~ m!^http://!;
php.Fetchwarefile: Only http:// lookup_url's and mirrors are supported. Please
only specify a http lookup_url or mirror.
EOD

    msg "Downloading lookup_url [@{[config('lookup_url')]}].";
    my $dir_list = download_dirlist(config('lookup_url'));

    vmsg "Parsing HTML page listing php releases.";
    my $tree = HTML::TreeBuilder->new_from_content($dir_list);

    # This parsing code assumes that the latest version of php is the first one
    # we find, which seems like a dependency that's unlikely to change.
    my $download_path;
    $tree->look_down(
        _tag => 'a',
        sub {
            my $h = shift;
            
            my $link = $h->as_text();

            # Is the link a php download link or something to ignore.
            if ($link =~ /tar\.(gz|bz2|xz)|(tgz|tbz2|txz)/) {

                # Set $download_path to this tags href, which should be
                # something like: /get/php-5.5.3.tar.bz2/from/a/mirror
                if (exists $h->{href} and defined $h->{href}) {
                    $download_path = $h->{href};
                } else {
                    die <<EOD;
php.Fetchwarefile: A path should be found in this link [$link], but there is no
path it in. No href [$h->{href}].
EOD
                }

                # Find and save the $md5sum for the verify hook below.
                # It should be 3 elements over, so it should be the third index
                # in the @right array below (remember to start counting 2 0.).
                my @right = $h->right();
# Left for the next time the page annoyingly, arbitrarily changes :)
#local $Data::Dumper::Maxdepth = 3; # Only show 3 "levels" of crap.
#use Test::More;
#diag("RIGHT[");
#for my $i (0..$#right) {
#    diag("TAG#[$i]");
#    diag explain \@right;
#    diag("ENDTAG#[$i]");
#}
#diag("]");
                my $md5_span_tag = $right[5];
                $md5sum = $md5_span_tag->as_text();
                $md5sum =~ s/md5:\s+//; # Ditch md5 header.
            }
        }
    );

    # Delete the $tree, so perl can garbage collect it.
    $tree = $tree->delete;

    # Determine and return a properl $download_path.
    # Switch it from [/from/a/mirror] to [/from/this/mirror], so the mirror will
    # actually return the file to download.
    $download_path =~ s!/a/!/this/!;

    vmsg "Determined download path to be [$download_path]";
    return $download_path;
};


# I also must hook download(), because fetchware presumes that the filename of
# the downloaded file is the last part of the $path, but that is not the case
# with the path php uses for file downloads, because it ends in mirror, which is
# *not* the name of the file; therefore, I must  hook download() to fix this
# problem.
hook download => sub {
    my ($temp_dir, $download_path) = @_;

    my $http = HTTP::Tiny->new();
    my $response;
    for my $mirror (config('mirror')) {
        my ($scheme, $auth, $path, $query, $fragment) = uri_split($mirror);
        my $url = uri_join($scheme, $auth, $download_path, undef, undef);
        msg <<EOM;
Downloading path [$download_path] using mirror [$mirror].
EOM
        $response = $http->get($url);
        
        # Only download it once.
        last if $response->{success};
    }

    die <<EOD unless $response->{success};
php.Fetchwarefile: Failed to download the download path [$download_path] using
the mirrors [@{[config('mirror')]}]. The response was:
[@{[Dumper($response->{headers})]}].
EOD
    die <<EOD unless length $response->{content};
php.Fetchwarefile: Didn't actually download anything. The length of what was
downloaded is zero. status [$response->{status}] reason [$response->{reason}]
HTTP headers [@{[Dumper($response->{headers})]}].
EOD

t/bin-fetchware-Fetchwarefile.t  view on Meta::CPAN

                push @version_number, (split ' ', $link)[1];
            }
        }
    );

    # Delete the $tree, so perl can garbage collect it.
    $tree = $tree->delete;

    # Only one version should be found.
    die <<EOD if @version_number > 1;
mariaDB.Fetchwarefile: multiple version numbers detected. You should probably
refine your filter option and try again. Filter [@{[config('filter')]}].
Versions found [@version_number].
EOD

    # Construct a download path using $version_number[0].
    my $filename = 'mariadb-' . $version_number[0] . '.tar.gz';

    # Return a proper $download_path, so That I do not have to hook download(),
    # but can reuse Fetchware's download() subroutine.
    my $weird_prefix = '/mariadb-' . $version_number[0] . '/kvm-tarbake-jaunty-x86/';
    my $download_path = '/pub/mariadb' . $weird_prefix .$filename;
    return $download_path;
};

# Make verify() failing to verify MariaDB ok, because parsing out the MD5 sum
# would require a Web scraper that supports javascript, which HTML::TreeBuilder
# obviously does not.
verify_failure_ok 'On';

# Use build_commands to configure fetchware to use MariaDB's BUILD script to
# build it.
build_commands 'BUILD/compile-pentium64-max';

# Use install_commands to tell fetchware how to install it. I could leave this
# out, but it nicely documents what command is needed to install MariaDB
# properly.
install_commands 'make install';
EOF

    # Create a tempfile to store the Fetchwarefile in.
    my ($fh, $filename) = tempfile("fetchware-test-$$-XXXXXXXXXXX", TMPDIR => 1,
        UNLINK => 1);
    # Write the $apache_fetchwarefile to disk, so bin/fetchware can access it.
    print $fh $mariadb_fetchwarefile;
    close $fh; # Close $fh to ensure its contents make it out to disk.

    # Just execute bin/fetchware install with the newly created
    # apache.Fetchwarefile to test it.
    ok(run_prog(qw!perl -I lib bin/fetchware install!, $filename),
        'Checked MariaDB Fetchwarefile success.');
};



subtest 'test PostgreSQL Fetchwarefile success' => sub {

    my $postgresql_fetchwarefile = <<'EOF';
use App::Fetchware qw(:DEFAULT :OVERRIDE_LOOKUP);
use App::Fetchware::Util ':UTIL';
use Data::Dumper 'Dumper';

use HTML::TreeBuilder;

program 'postgres';

# The Postgres file browser URL lists the available versions of Postgres.
lookup_url 'http://www.postgresql.org/ftp/source/';

# Mirror URL where the file browser links to download them from.
my $mirror = 'http://ftp.postgresql.org';
mirror $mirror;

# The Postgres file browser URL that is used for the lookup_url lists version
# numbers of Postgres like v9.3.0. this lookup hook parses out the list of
# theses numbers, determines the latest one, and constructs a $download_path to
# return for download to use to download based on what I set my mirror to.
hook lookup => sub {
    my $dir_list = no_mirror_download_dirlist(config('lookup_url'));

    my $tree = HTML::TreeBuilder->new_from_content($dir_list);

    # Parse out version number directories.
    my @ver_nums;
    my @list_context = $tree->look_down(
        _tag => 'a',
        sub {
            my $h = shift;

            my $link = $h->as_text();

            # Is this link a version number or something to ignore?
            if ($link =~ /^v\d+\.\d+(.\d+)?$/) {
                # skip version numbers that are beta's, alpha's or release
                # candidates (rc).
                return if $link =~ /beta|alpha|rc/i;
                # Strip useless "v" that just gets in the way later when I
                # create the $download_path.
                $link =~ s/^v//;
                push @ver_nums, $link;
            }
        }
    );

    # Turn @ver_num into the array of arrays that lookup_by_versionstring()
    # needs its arguments to be in.
    my $directory_listing = do {
        my $arrayref_of_arrays_directory_listing = [];
        for my $ver_num (@ver_nums) {
            push @$arrayref_of_arrays_directory_listing,
                [$ver_num];
        }
        $arrayref_of_arrays_directory_listing;
    };
    # Find latest version.
    my $latest_ver = lookup_by_versionstring($directory_listing);

    # Return $download_path.
    my $download_path = '/pub/source/'. "v$latest_ver->[0][0]" .
        "/postgresql-$latest_ver->[0][0].tar.bz2";
    return $download_path;