App-Fetchware
view release on metacpan or search on metacpan
bin/fetchware view on Meta::CPAN
# $VERSION is managed by dzil; therefore, I use eval to access it at
# run time instead of compile time, so that I can test fetchware without
# running dzil test.
'version|V' => sub { eval 'say "Fetchware version $fetchware::VERSION"; '; exit 0},
'help|h|?' => \&cmd_help,
'verbose|v' => \$verbose,
'quiet|q' => \$quiet,
# Expose File::Temp's KEEP_ALL flag, and an easy feature to implement
# that lets users easily ensure the tempdir stays around when needed.
'keep-temp|K' => \$File::Temp::KEEP_ALL,
###BUGALERT### dry-run functionality is *not* implemented!!!
#'dry-run|d' => \$dry_run,
);
# Getopt::Long is *only* used to determine dash and double dash style options
# such as -v, --verbose, --help, -h, -?, etc....
#
# Below the first argument to fetchware is used to determine what fetchware
# does. If nothing is specified then help is printed.
###BUGALERT### Add a loop around @ARGV to support multiple Fetchwarefiles
#or fetchware packages ending in .fpkg.
eval { # Trap any fatal errors.
vmsg 'Entering main eval{} block to trap errors.';
###BUGALERT### Should trapped exceptions with this eval cause fetchware
#to cd to $original_cwd and then exit, so that the File::Temp's END
#block can delete fetchware's source dir???
# Or fetchware could print the path of this source dir and close, and
# tell the user that they can clean it up with fetchware clean??
# Also, add cmdline options to control what to do when this happens???
vmsg 'Determining which command to run based on command line options.';
my $command;
@ARGV ? ($command = shift @ARGV) : ($command = '');
if ($command eq 'install') {
cmd_install(@ARGV);
} elsif ($command eq 'uninstall') {
cmd_uninstall(@ARGV);
} elsif ($command eq 'new') {
cmd_new(@ARGV);
} elsif ($command eq 'upgrade') {
cmd_upgrade(@ARGV);
} elsif ($command eq 'upgrade-all') {
cmd_upgrade_all(@ARGV);
} elsif ($command eq 'list') {
cmd_list(@ARGV);
} elsif ($command eq 'look') {
cmd_look(@ARGV);
} elsif ($command eq 'clean') {
cmd_clean(@ARGV);
} elsif ($command eq 'help') {
cmd_help(@ARGV);
} else {
cmd_help(@ARGV);
}
# Exit success, because if any of the main subroutines run into any
# problems they die() exceptions, which get caught in eval above, and
# warn()ed below, and fetchware exits 1 for failure.
vmsg 'Fetchware ran successfully! Exiting with status of 0 for success!';
exit 0;
};
# If a fatal error was thrown print it to STDERR and exit indicating failure.
if ($@) {
# Set File::Temp's $KEEP_ALL so user can troubleshoot what happend
# without having to bother to use --keep-all.
$File::Temp::KEEP_ALL = 1;
msg <<EOM;
Fetchware threw an exception! Exiting with an exit status of 1 for failure.
Fetchware failed inside directory [@{[cwd()]}].
EOM
warn $@;
exit 1;
}
}
###BUGALERT### cmd_install() does *not* actually do this. Consider implementing
#it.
#If no filename was
#provided or the filename doesn't exist then, cmd_install() calls new() to create
#and install a new fetchware package.
sub cmd_install {
# These variables must be shared back to the parent from the child using
# pipe_{write,read}_newline().
my $P_build_path;
###BUGALERT### After verifying basic functionality of cmd_install wrap
#subroutine contents in a for my $filename (pop @ARGV) loop to try to
#install all given arguments that arn't command line options as parsed by
#GetOpt::Long.
### Add this loop in run(), so there is just one loop to test.
my $filename = shift;
my $output;
if (defined($filename) and -e $filename) {
msg "Starting fetchware install to install [$filename]";
# If a fpkg extract out the Fetchwarefile into a scalar, and if not a
# fetchware package to go ahead and open for reading only the Fetchware
# right now while we're perhaps still root, so we can be sure we can
# still access it.
my $fetchwarefile;
if ($filename =~ /\.fpkg$/) {
$fetchwarefile = extract_fetchwarefile($filename);
vmsg <<EOM;
Extracting out Fetchwarefile from [$filename] to [$$fetchwarefile]
EOM
} else {
my $fh = safe_open($filename, <<EOD);
fetchware: Fetchware failed to open the filename you specified to fetchware
install [$filename]. The OS error was [$!].
EOD
vmsg "Opened file [$filename] for slurping.";
# Add a \ to turn the slurped scalar into a scalar ref for calling
# parse_fetchwarefile() properly.
$fetchwarefile = \do {local $/; <$fh>};
vmsg "Slurped [$filename] into fetchware: [$$fetchwarefile]";
bin/fetchware view on Meta::CPAN
sub parse_fetchwarefile {
my $fetchwarefile = shift;
# Arg $fetchwarefile must be a SCALAR ref.
die <<EOD unless ref($fetchwarefile) eq 'SCALAR';
fetchware: parse_fetchwarefile() was called with the wrong arguments. It only
accepts and scalar references of the text of your fetchwarefile.
EOD
# Ensure the $fetchwarefile has a use App::Fetchware somewhere in it. And be
# sure to support fetchware extensions such as App::FetchwareX::HTMLPageSync.
die <<EOD unless $$fetchwarefile =~ /^\s*use\s+App::FetchwareX?(::)?/m;
fetchware: The fetchwarefile you provided did not have a [use App::Fetchware]
line in it. This line is required, because it is an important part of how
fetchware uses Perl for its configuration file. Your fetchware file was.
[$$fetchwarefile]
EOD
# Do the potentially evil eval. No Safe compartment or use ops is used. This
# is one gigantic security hole; however, it is also how fetchware works :)
#
# safe_open() is used to ensure that the file the user provides is "safe" to
# use, and is the limit of fetchware's safety features.
eval $$fetchwarefile;
die <<EOD if $@;
fetchware: run-time error. fetchware failed to execute the Fetchwarefile
[$$fetchwarefile] you provieded on the command line or that was packaged
with your Fetchware package (*.fpkg). The error was [$@].
EOD
# Ensure that the specified App::Fetchware implementation exports the proper
# subroutines.
my %api_subs = (
start => 1,
lookup => 1,
download => 1,
verify => 1,
unarchive => 1,
build => 1,
install => 1,
uninstall => 1,
upgrade => 1,
check_syntax => 1,
end => 1,
);
# Determine if all of the @api_subs are in sublist, the list of all subs in
# the current package.
# Code adapted from Perl Cookbook pg. 129.
my (%union, %intersection);
for my $element (keys %api_subs, sublist()) {
$union{$element}++ && $intersection{$element}++;
}
# Compares the number of %intersection's to the number of %api_subs, and if
# they're *not* equal throw an exception, so the user knows which API subs
# are not set up right.
if ( (grep {exists $api_subs{$_} and exists $intersection{$_}
and $api_subs{$_} eq $intersection{$_}}
keys %api_subs) != scalar keys %api_subs) {
my @missing_api_subs;
for my $api_sub (keys %api_subs) {
if (not exists $intersection{$api_sub}
or not defined $intersection{$api_sub}
or ($intersection{$api_sub} == 0)
) {
push @missing_api_subs, $api_sub;
}
}
die <<EOD;
fetchware: The App::Fetchware module you choose in your fetchwarefile does not
properly export the necessary subroutines fetchware needs it to. These include:
start(), lookup(), download(), verify, unarchive(), build(), install(),
uninstall(), and end().
The missing subroutines are [@missing_api_subs].
EOD
}
# Call App::Fetchware's check_syntax() (or a App::Fetchware extension's).
check_syntax();
return 'Evaled config file successfully';
}
sub create_fetchware_package {
my ($fetchwarefile,
$unarchived_package_path,
$dir_for_new_fpkg) = @_;
# chdir() to my cwd's parent directory, because my cwd is currently on linux
# /tmp/fetchware-kd883ejfe/program-1.2, and I need the program-1.2 part to
# be in the archive's @file_list. This needs to happen even when dropping
# privs, because drop_privs() chdir()'s before it forks putting both parent
# and child in the same directory.
my $previous_cwd = cwd();
my $new_dir = dir(cwd())->parent();
chdir($new_dir) or die <<EOD;
fetchware: run-time error. Fetchware failed to change it's working
directory to
[$new_dir] from [$previous_cwd]. The os error was [$!].
EOD
# Turn something like /tmp/fetchware-djdjkd8382/package-1.2/Fetchware (with
# the "Fetchwarefile" filename only sometimes being there) into just
# "package-1.2"
my $pc = dir($unarchived_package_path);
my $last_dir = $pc->dir_list(-1, 1);
my $fetchware_package_name = "$last_dir.fpkg";
# The dir the new fpkg goes in is the current working directory, or a user
# provided alternate path to store it in.
$dir_for_new_fpkg //= cwd();
# Calculate the full absolute path of the fetchware package I create below.
my $fetchware_package_full_path
bin/fetchware view on Meta::CPAN
so that you don't have to mess with creating one manually in a text editor.
=item install
Fetchware's install runs whatever fetchware API subroutines it needs to use, see
the section L<INTERNAL LIBRARY SUBROUTINES> for more. Then, install() will parse
a user provided Fetchwarefile or a Fetchwarefile fetchware finds in a fetchware
package. The act of parsing the Fetchwarefile will import the App::Fetchware API
subroutines into fetchware's namespace. This gives fetchware access to
App::Fetchwares API or whatever extension may have been used. Then, the API
subroutines are run providing whatever arguments they need and storing whatever
their important return values may be in a variable to probably later be given to
a later API subroutine as an argument.
=item upgrade
Cleverly reusues the same API subroutines that install uses, but in the middle
of all that uses the upgrade() API subroutine to determine if a newer version is
available. The upgrade() API subroutine allows Fetchware extensions to modify
how Fetcwhare determines if a new version is available to support using git or
something else to determine this.
=item uninstall
Uninstall parses the Fetcwharefile of the installed pacakges you specified. Then
it runs whatever C<uninstall_commands> you specified or the default,
C<make uninstall> if you specified none. Then the installed package is deleted
from the fetchware database.
=item list
List just globs all files in the fetchware database directory as returned by
fetchware_database_path(), and prints them to STDOUT. It does not let you
specify a Perl regex, or a keyword or anything yet, because I'm currently unsure
about the security ramifications of doing so. This feature may be added in the
future.
=item look
look just does the first part of install(). It parses whatever Fetchwarefile it
gets passed to it, then it does the start(), lookup(), download(), verify(), and
unarchive() parts of install(). Then look prints the path of this directory, and
exits.
=item clean
Clean just deletes all fetchware temp files and directories in the system
temp_dir. These files and directories all start with C<fetchware-*> or
C<Fetchwarefile-*>.
=item help
Just prints a simple, short, concise help message.
=back
=head2 How fetchware interfaces with App::Fetchware
Fetchware interfaces with App::Fetchware using the parse_fetchwarefile() API
subroutine. This subroutine simply eval()'s your Fetchwarefile and traps any
errors, and then rethrows that exception adding a helpful message about what
happened in addition to passing along the original problem from Perl.
The act of eval()ing your Fetchwarefile causes Perl to parse and execute as it
would any other Perl program. Only because its inside an eval any subroutines
that are imported are imported in the the caller of eval()'s package. In this
case fetchware.
Fetchware takes advantage of this by requiring all Fetchwarefile's to have a
C<use App::Fetchware...;> line. This line is what imports the default imports of
App::Fetchware into fetchware, which include App::Fetchware's API subroutines.
=head2 How fetchware intefaces with a fetchware extension
As explained above parse_fetchwarefile() eval()'s your Fetchwarefile, and this
causes Perl to parse and execute it. And any imports are imported into the
caller's package, which is fetchware.
That's how fetchware receives App::Fetchware's API subroutines, and it is also
how fetchware receives a fetchware extensions API subroutines, the fetchware
extension is simply use()d inside your Fetchwarefile instead of the default one
of App::Fetchware. Instead of:
use App::Fetchware;
You would write:
use App::FetchwareX::HTMLPageSync;
To use the fetchware extension HTMLPageSync.
=head1 INTERNAL SUBROUTINES IMPLEMENTING FETCHWARE COMMANDS
Below are all of subroutines that implement fetchware's main command line
options such as C<fetchware install> or C<fetchware new> and so on. These main
subroutines are called based on the options you pass to fetchware from the
command line.
=head2 cmd_install()
my $installed_fetchware_package_path = cmd_install($filename|@ARGV)
cmd_install() implements fetchware's install command, which installs a package
based on the specified Fetchwarefile or fetchware package.
=head2 cmd_uninstall()
my $uninstall_package_path = cmd_uninstall($uninstall_package_path|@ARGV);
Uninstalls the given package. Note the given package does B<not> have to be an
exact match, but it does have to be unique if you have two versions of the same
software installed such as httpd-2.2 and httpd-2.4. In that case you'd have to
specify the version number as well.
=over
=item LIMITATION
cmd_uninstall() unlike cmd_install() does not accept Fetchwarefiles as an
argument to uninstall a fetchware package! Instead, you must provide the name
and perhaps the name and version number of an already installed software
bin/fetchware view on Meta::CPAN
that it has at least one line beginning with C<use App::Fetchware>.
It also checks to see that the eval of the provided $fetchwarefile actually
winds up importing all of fetchware's API subroutines into fetchware's namespace.
Then it runs check_syntax() to check the $fetchwarefile's syntax. Typically this
only involves running config() a bunch of times to check that configuration
options that don't belong together arn't used together.
Returns true on success and dies with an error message if it fails.
=head2 create_fetchware_package()
# Most uses should just use this.
my $fetchware_package_full_path
=
create_fetchware_package($fetchwarefile, $unarchived_package_path);
# But some uses in test suites thanks to safe_open() need to be able to
# specify where they should write the new fetchware package's path to.
my $fetchware_package_full_path
=
create_fetchware_package($fetchwarefile,
$unarchived_package_path
$path_to_new_fpkg);
Creates a fetchware package, ending in .fpkg, using $unarchived_package_path, as
the directory to archive. Also, adds the C<Fetchwarefile> stored in the
scalar $fetchwarefile argument to the fethware package that is created.
You can specify an optional $path_to_new_fpkg, which will be a directory where
create_fetchware_package() will write the new fetchware package to.
Returns the full pathname to the fetchware package that was created.
=head2 fetchware_database_path()
my $fetchware_database_path = fetchware_database_path();
Returns the correct path for the fetchware package database based on operating
system and if super user or not.
Also, supports user customizable fetchware database paths via the
C<FETCHWARE_DATABASE_PATH> environment variable, and the
C<fetchware_database_path> Fetchwarefile configuration file. If both are
specified C<fetchware_database_path> is prefered over
C<FETCHWARE_DATABASE_PATH>.
=head2 determine_fetchware_package_path()
my $fetchware_package_filename = determine_fetchware_package_path($fetchware_package);
Looks up the $fetchware_package in C<fetchware_database_path()>, and returns the
full path to that given $fetchware_package.
=over
=item NOTE
determine_fetchware_package_path() could potentially come up with more than one
result if you have multiple versions of apache or other similarly named packages
installed at the same time. If this happens an exception is thrown asking the
user to specify a more specific name to query the fetchware database with.
=back
=head2 extract_fetchwarefile()
my $fetchwarefile = extract_fetchwarefile($fetchware_package_path);
Extracts out the Fetchwarefile of the provided fetchware package as specified by
$fetchware_package_path, and returns the content of the Fetchwarefile as a
scalar reference. Throws an exception if it it fails.
=head2 copy_fpkg_to_fpkg_database()
my $fetchware_package_path = copy_fpkg_to_fpkg_database($fetchwarefile_path);
Installs (just copies) the specified fetchware package to the fetchware
database, which is /var/log/fetchware on UNIX, C:\FETCHWARE on Windows with
root or Administrator. All others are whatever L<File::HomeDir> says. For Unix
or Unix-like systems such as linux, L<File::HomeDir> will put your own user
fetchware database independent of the system-wide one in C</var/log/fetchware>
in C<~/.local/share/Perl/dist/fetchware/>. This correctly follows some sort of
standard. XDG or FreeDesktop perhaps?
Creates the directory the fetchware database is stored in if it does not already
exist.
Returns the full path of the copied fetchware package.
=head2 uninstall_fetchware_package_from_database()
uninstall_fetchware_package_from_database($uninstall_package_name);
Deletes the specified $uninstall_package_name from the fetchware package
database. Throws an exception on error.
=head1 THE FETCHWARE PACKAGE
Like other package managers, fetchware has its own package format:
=over
=item *
It ends with a C<.fpkg> file extension.
=item *
The package path, the location of the unarchived downloaded program, is simply
archived again using L<Archive::Tar>, and compressed with gzip.
=item *
But before the package path is archived the currently used Fetchwarefile is
copied into the current directory, so that it is included with your fetchware
package:
./Fetchwarefile
httpd-2.2.x
httpd-2.2.x/README
( run in 0.835 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )