App-Fetchware
view release on metacpan or search on metacpan
lib/App/Fetchware.pm view on Meta::CPAN
prompt => 'Type in URL of mirror or done to continue: ',
allow => qr!^(ftp|http|file)://!,
);
# Append $first_mirror to $fetchwarefile.
push @mirrors, $first_mirror;
while (1) {
my $mirror_or_done = $term->get_reply(
prompt => 'Type in URL of mirror or done to continue: ',
default => 'done',
allow => qr!(^(ftp|http|file)://)|done!,
);
if ($mirror_or_done eq 'done') {
last;
} else {
# Append $mirror_or_done to $fetchwarefile.
push @mirrors, $mirror_or_done;
}
}
}
return {mirror => \@mirrors};
}
sub get_verification {
my ($term, $filename_listing, $lookup_url) = @_;
my %options;
my %available_verify_methods;
# Determine what types of verification are available.
for my $file_and_timestamp (@$filename_listing) {
if ($file_and_timestamp->[0] =~ /\.(asc|sig|sign)$/) {
$available_verify_methods{gpg}++;
} elsif ($file_and_timestamp->[0] =~ /\.sha1?$/) {
$available_verify_methods{sha1}++;
} elsif ($file_and_timestamp->[0] =~ /\.md5$/) {
$available_verify_methods{md5}++;
}
}
my $verify_configed_flag = 0;
#If gpg is available prefer it over the others.
if (exists $available_verify_methods{gpg}
and defined $available_verify_methods{gpg}
and $available_verify_methods{gpg} > 0
) {
msg <<EOM;
gpg digital signatures found. Using gpg verification.
EOM
$options{verify_method} = 'gpg';
# Search for a KEYS file to use to import the author's keys.
if (grep {$_->[0] eq 'KEYS'} @$filename_listing) {
msg <<EOM;
KEYS file found using lookup_url. Adding gpg_keys_url to your Fetchwarefile.
EOM
# Add 'KEYS' or '/KEYS' to $lookup_url's path.
my ($scheme, $auth, $path, $query, $fragment) =
uri_split($lookup_url);
$path = catfile($path, 'KEYS');
$lookup_url = uri_join($scheme, $auth, $path, $query, $fragment);
$options{gpg_keys_url} = $lookup_url;
$verify_configed_flag++;
} else {
msg <<EOM;
KEYS file *not* found!
EOM
# Since autoconfiguration of KEYS failed, try asking the user if
# they would like to import the author's key themselves into their
# own keyring and have fetchware use that.
if (
$term->ask_yn(prompt =>
q{Would you like to import the author's key yourself after fetchware completes? },
default => 'n',
print_me => <<EOP,
Automatic KEYS file discovery failed. Fetchware needs the author's keys to
download and import into its own keyring, or you may specify the option
user_keyring, which if true will cause fetchware to use the user who runs
fetchware's keyring instead of fetchware's own keyring. But you, the user, needs
to import the author's keys into your own gpg keyring. You can do this now in a
separate shell, or after you finish configuring this Fetchwarefile. Just run the
command [gpg --import <name of file>].
EOP
)
) {
$options{user_keyring} = 'On';
$verify_configed_flag++;
}
# And if the user does not want to, then fallback to sha1 and/or md5
# if they're defined, which is done below.
}
}
# Only try sha1 and md5 if gpg failed.
unless ($verify_configed_flag == 1) {
if (exists $available_verify_methods{sha1}
and defined $available_verify_methods{sha1}
and $available_verify_methods{sha1} > 0
) {
msg <<EOM;
SHA1 checksums found. Using SHA1 verification.
EOM
$options{verify_method} = 'sha1';
} elsif (exists $available_verify_methods{md5}
and defined $available_verify_methods{md5}
and $available_verify_methods{md5} > 0
) {
msg <<EOM;
MD5 checksums found. Using MD5 verification.
EOM
$options{verify_method} = 'md5';
} else {
# Print a huge long nasty warning even include links to news stories
# of mirrors actually getting hacked and serving malware, which
# would be detected and prevented with proper verification enabled.
# Ask user if they would like to continue installing fetchware even if
lib/App/Fetchware.pm view on Meta::CPAN
#the rest of the API subs like I've done to lookup and download.
###BUGALERT### NOT TESTED!!! There is no t/App-Fetchware-uninstall.t test
#file!!! cmd_uninstall(), which uses uninstall(), is tested, but not uninstall()
#directly!!!
sub uninstall {
my $build_path = shift;
msg "Uninstalling package unarchived at path [$build_path]";
chdir_unless_already_at_path($build_path);
if (defined config('uninstall_commands')) {
vmsg 'Uninstalling using user specified uninstall commands.';
run_star_commands(config('uninstall_commands'));
} else {
# Set up configure_options and prefix, and then run ./configure, because
# Autotools uses full paths that ./configure sets up, and these paths
# change from install time to uninstall time.
vmsg q{Uninstalling using AutoTool's default of make uninstall};
vmsg q{Running AutoTool's default ./configure};
run_configure();
if (defined config('make_options')) {
vmsg <<EOM;
Running AutoTool's default make uninstall with user specified make options.
EOM
run_prog('make', config('make_options'), 'uninstall');
} else {
vmsg <<EOM;
Running AutoTool's default make uninstall.
EOM
run_prog('make', 'uninstall');
}
}
msg <<EOM;
Package uninstalled from system, but still installed in Fetchware's database.
EOM
# Return success.
return 'uninstall succeeded';
}
sub upgrade {
my ($download_path, $fetchware_package_path) = @_;
# I only need the basename.
my $download_path_basename = file($download_path)->basename();
my $upgrade_name_basename =
file( $fetchware_package_path)->basename();
vmsg <<EOM;
Shortened the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] into just their basenames.
EOM
# Strip trailing garbage to normalize their names, so that they can be
# compared to each other.
###BUGALERT### This comparision is quite fragile. Figure out a better way to
#do this!!!
$upgrade_name_basename =~ s/\.fpkg$//;
$download_path_basename
=~ s/(\.(?:zip|tgz|tbz|txz|fpkg)|(?:\.tar\.(gz|bz2|xz|Z)?))$//;
vmsg <<EOM;
Striped the new download url [$download_path_basename] and the installed
package's [$upgrade_name_basename] of their file extensions.
EOM
# Check if $upgrade_name_basename and $download_path_basename are eq, and if
# they are return false indicating that this program should not be upgraded,
# because the version available for upgrading is the same as the currently
# installed version.
return 0 if $upgrade_name_basename eq $download_path_basename;
# Transform both competing filenames into a string of version numbers.
# Use lookup_by_versionstring() to determine which version of the same
# program is "newer."
my $sorted_file_names = lookup_by_versionstring(
[
[$upgrade_name_basename, 'placeholder'],
[$download_path_basename, 'placeholder'],
]
);
if ($sorted_file_names->[0][0] eq $download_path_basename
# Make sure cmd_upgrade() does not upgrade when the latest version is
# the same as the currently installed version ($upgrade_name_basename).
and $sorted_file_names->[0][0] ne $upgrade_name_basename) {
# The latest version we can download ($download_path_basename) is newer
# than the currently installed version ($upgrade_name_basename), so we
# should upgrade.
return 1;
} else {
# Currenlty installed version ($upgrade_name_basename) is equal to the
# latest version available for download ($download_path_basename), so
# return false indicating that we sould not upgrade.
return 0;
}
}
sub check_syntax {
# Use check_config_options() to run config() a bunch of times to check the
# already parsed Fetchwarefile.
return check_config_options(
BothAreDefined => [ [qw(build_commands)],
[qw(prefix configure_options make_options)] ],
Mandatory => [ 'program', <<EOM ],
App-Fetchware: Your Fetchwarefile must specify a program configuration
option. Please add one, and try again.
EOM
Mandatory => [ 'mirror', <<EOM ],
App-Fetchware: Your Fetchwarefile must specify a mirror configuration
option. Please add one, and try again.
EOM
lib/App/Fetchware.pm view on Meta::CPAN
# 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 6 elements over, so it should be the sixth index
# in the @right array below (remember to start counting from 0.).
my @right = $h->right();
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 proper $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
msg 'File downloaded successfully.';
# Determine $filename from $download_path
my @paths = split('/', $download_path);
my ($filename) = grep /php/, @paths;
vmsg "Filename determined to be [$filename]";
open(my $fh, '>', $filename) or die <<EOD;
php.Fetchwarefile: Failed to open [$filename] for writing. OS error [$!].
EOD
print $fh $response->{content};
close $fh or die <<EOD;
php.Fetchwarefile: Huh close($filename) failed! OS error [$!].
EOD
my $package_path = determine_package_path($temp_dir, $filename);
vmsg "Package path determined to be [$package_path].";
return $package_path
};
# The above lookup hook parses out the md5sum on the php downloads.php web
# site, and stores it in $md5sum, which is used in the the verify hook below.
hook verify => sub {
# Don't need the $download_path, because lookup above did that work for us.
# $package_path is the actual php file that we need to ensure its md5
# matches the one lookup determined.
my ($download_path, $package_path) = @_;
msg "Verifying [$package_path] using md5.";
dir <<EOD if not defined $md5sum;
php.Fetchwarefile: lookup failed to figure out the md5sum for verify to use to
verify that the php version [$package_path] matches the proper md5sum.
The md5sum was [$md5sum].
( run in 1.744 second using v1.01-cache-2.11-cpan-b16cb0d3907 )