App-Fetchware

 view release on metacpan or  search on metacpan

bin/fetchware  view on Meta::CPAN

    # 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]";
    }

    # Must parse the Fetchwarefile in the parent, so that the parent has access
    # to the imported subroutines and modified fetchware configuration (%CONFIG)
    # just as the child does.
    parse_fetchwarefile($fetchwarefile);
    vmsg "Parsed Fetchwarefile [$$fetchwarefile].";


    # start() runs as root before the fork, because it uses
    # App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
    # subroutine uses a variable to store an open filehandle to a
    # "fetchware.sem" semaphore file. This filehandle must stay open and locked
    # using flock, because otherwise a "fetchware clean" run could delete the
    # temporary directory out from under fetchware. Therefore, the parent must
    # open this semaphore, because the child if it runs start() will close this
    # file handle when it exits causing cleanup_tempdir() to freak out when
    # end() is called.
    my $temp_dir = start();

        # Drop privs, so only install() and  end() are called with root perms
        $output = drop_privs(
        sub {
            my $write_pipe = shift;

            # Run the App::Fetchware API subroutines to do everything to install
            # the program, but be mindful of drop_privs() requiring this coderef
            # to use write_dropprivs_pipe() to communicate needed changes back to
            # the parent process, for example, $P_build_path--the parent needs to
            # chdir() to that directory before it tries to execute install().

            ###BUGALERT### install installs no matter if the program is already
            #installed!!! Change this to parse out the package from the
            #download_urlif possible, compare with the one in the fetchware
            #package database, and call exit right here if the current version
            #is already installed unless of course --force is used!!!
            my $download_url = lookup();

            my $package_path = download($temp_dir, $download_url);

            ###BUGALERT### Add support for caching the key files gpg creates to
            #the fetchwarefile, and for actually using them later on inside the
            #fpkg.
            verify($download_url, $package_path);

            $P_build_path = unarchive($package_path);

            build($P_build_path);

            # Tell the parent, root, process the values of the variables the
            # child calculated in this coderef, and write them across this pipe
            # back to the parent
            write_dropprivs_pipe($write_pipe, $P_build_path);
        }, config('user')
        ); # End drop_privs().

        # Read from the pipe the child, the drop_privs()ed process, writes to to
        # read the necessary values that correspond to the variables that the
        # child must communicate back to the parent, so the parent can continue
        # processing as though no fork()ing or priv dropping took place.
        ($P_build_path)
            = read_dropprivs_pipe($output);

        my $installed_fetchware_package_path;
        if (not config('no_install')) {
            install($P_build_path);

            vmsg "Creating Fetchware package from [@{[cwd()]}].";
            my $fetchware_package_path
                =
                create_fetchware_package($fetchwarefile, cwd());
            vmsg "Created fetchware package at [$fetchware_package_path].";

            vmsg 'Installing created fetchware package to fetchware database.';
            $installed_fetchware_package_path
                = copy_fpkg_to_fpkg_database($fetchware_package_path);
            vmsg <<EOM;
Installed created fetchware package to [$installed_fetchware_package_path]
EOM
        }

        end();

        # Return the path of the created and installed fetchware package.
        return $installed_fetchware_package_path;
    } else {
        ###BUGALERT### Replace with warn for proposed for loop above to work???
        die <<EOD;
fetchware: You called fetchware install incorrectly. You must also specify
either a Fetchwarefile or a fetchware package that ends with [.fpkg].
EOD
    }
}




sub cmd_uninstall {

    my $uninstall_package_path = shift;

bin/fetchware  view on Meta::CPAN

    #version numbers, and the one lookup() says to download will be installed
    #regardless.
    msg "Upgrading installed fetchware package [$upgrade_name].";

    $P_fetchware_package_path = determine_fetchware_package_path($upgrade_name);
    vmsg <<EOM;
Determined already installed fetchware package's path to be [$P_fetchware_package_path].
EOM

    # Parse out the Fetchwarefile from the fetchware package stored in the
    # fetchware database directory.
    my $fetchwarefile;
    if ($P_fetchware_package_path =~ /\.fpkg$/) {
        $fetchwarefile
            = extract_fetchwarefile($P_fetchware_package_path);            
        vmsg "Extracted Fetchwarefile temporarily into [$fetchwarefile]";
    } else {
        die <<EOD;
fetchware: fetchware upgrade failed to extract the Fetchwarefile from the
fetchware package that should be stored in fetchware's database.
EOD
    }

    # Must parse the Fetchwarefile in the parent, so that the parent has access
    # to the imported subroutines and modified fetchware configuration (%CONFIG)
    # just as the child does.
    parse_fetchwarefile($fetchwarefile);
    vmsg "Parsed Fetchwarefile [$$fetchwarefile].";

    # start() runs as root before the fork, because it uses
    # App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
    # subroutine uses a variable to store an open filehandle to a
    # "fetchware.sem" semaphore file. This filehandle must stay open and locked
    # using flock, because otherwise a "fetchware clean" run could delete the
    # temporary directory out from under fetchware. Therefore, the parent must
    # open this semaphore, because the child if it runs start() will close this
    # file handle when it exits causing cleanup_tempdir() to freak out when
    # end() is called.
    my $temp_dir = start();

    # Drop privs, so only install() is called with root permissions
    my $output = drop_privs(
    sub {
        my $write_pipe = shift;

        ###BUGALERT### Have lookup() replace the timestamp of what we should
        #download too to make upgrade() be able to use the lookup_by_timestamp
        #algorithm too, which is a better default anyway.
        $P_download_path = lookup();

        # Call upgrade() to determine if the currently available version
        # ($P_download_path) is newer than the currenlty installed version
        # ($P_fetchware_package_path).
        my $P_upgrade = upgrade($P_download_path, $P_fetchware_package_path);

        if ($P_upgrade) {
            msg 'New version available upgrading now.';

            my $package_path = download($temp_dir, $P_download_path);

            ###BUGALERT### Add support for caching the key files gpg creates to the
            #fetchwarefile, and for actually using them later on inside the fpkg.
            verify($P_download_path, $package_path);

            $P_build_path = unarchive($package_path);
            build($P_build_path);
        } else {
            # If a new version is not available, then the child should do
            # nothing, and let the parent call end() to clean up below.

            # Set $P_build_path to something that will fail, and give a decent
            # error message just in case.
            $P_build_path = 'Build Path not set because upgrade not needed.';
        }

        # Tell the parent, root, process the values of the variables the
        # child calculated in this coderef, and write them across this pipe
        # back to the parent
        write_dropprivs_pipe($write_pipe,
            $P_upgrade,
            $P_build_path,
            $P_download_path,
            $P_fetchware_package_path
        );
    }, config('user')
    ); # End drop_privs()

    # Read from the pipe the child, the drop_privs()ed process, writes to to
    # read the necessary values that correspond to the variables that the
    # child must communicate back to the parent, so the parent can continue
    # processing as though no fork()ing or priv dropping took place.
    ($P_upgrade,
    $P_build_path,
    $P_download_path,
    $P_fetchware_package_path) = read_dropprivs_pipe($output);

    # Test if a new version is available again due to drop_priv() ending
    # half way through this if statement.
    if ($P_upgrade) {
        install($P_build_path);

        my $updated_fetchware_package_path
            =
            create_fetchware_package($fetchwarefile, cwd());
        vmsg <<EOM;
Created a new fetchware package for the newly installed upgraded fetchware
package [$updated_fetchware_package_path].
EOM

        uninstall_fetchware_package_from_database($P_fetchware_package_path);
        vmsg 'Uninstalled the old fetchware package from the fetchware database.';

        my $installed_fetchware_package_path
            = copy_fpkg_to_fpkg_database($updated_fetchware_package_path);
        vmsg <<EOM;
Installed new fetchware package to fetchware package database
[$installed_fetchware_package_path].
EOM

        end();

bin/fetchware  view on Meta::CPAN

###BUGALERT### Fix the bug that prevents look from check for an installed
#package first, then a filename or fetchwarefile.
sub cmd_look {
    my $filename = shift;

    my $P_look_path;

    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]";
    }

    # Must parse the Fetchwarefile in the parent, so that the parent has access
    # to the imported subroutines and modified fetchware configuration (%CONFIG)
    # just as the child does.
    parse_fetchwarefile($fetchwarefile);
    vmsg "Parsed Fetchwarefile [$$fetchwarefile].";

    # start() runs as root before the fork, because it uses
    # App::Fetchware::Util's create_tempdir() to create a $temp_dir. This
    # subroutine uses a variable to store an open filehandle to a
    # "fetchware.sem" semaphore file. This filehandle must stay open and locked
    # using flock, because otherwise a "fetchware clean" run could delete the
    # temporary directory out from under fetchware. Therefore, the parent must
    # open this semaphore, because the child if it runs start() will close this
    # file handle when it exits causing cleanup_tempdir() to freak out when
    # end() is called.
    #
    # Call start() with an option to have it keep the temp dir, and not
    # have File::Temp clean it up with an END handler.
    my $temp_dir = start(KeepTempDir => 1);

    # Drop privs to match up with cmd_install()'s behavior.
    my $output = drop_privs(
    sub {
        my $write_pipe = shift;

        msg 'Downloading and unarchiving specified distribution.';

        my $download_url = lookup();

        my $package_path = download(cwd(), $download_url);

        ###BUGALERT### Add support for caching the key files gpg creates to
        #the fetchwarefile, and for actually using them later on inside the
        #fpkg.
        verify($download_url, $package_path);

        my $build_path = unarchive($package_path);

        # end() is *not* run, because the point of look is to lookup,
        # download, and unarchive, and then actually "look" at the files,
        # and running end() would delete them.

        # Compose the $P_look_path. A simple catfile($temp_dir, $build_path)
        # should work, but don't forget about drop_privs() extra temporary
        # directory when run as root! To avoid this problem of the $P_look_path
        # being wrong when run as root due to the extra temporary directory;
        # instead, of a simple catfile(...) replace the last file portion of
        # $package_path, with $build_path.
        $P_look_path = catfile(dir($package_path)->parent(), $build_path);
        msg <<EOM;
Your package's contents are at [$P_look_path]. Please run [fetchware clean] to
delete these files and any other files fetchware may have left behind when you
are finished looking inside this package.
EOM

        # Tell the parent, root, process the values of the variables the
        # child calculated in this coderef, and write them across this pipe
        # back to the parent
        write_dropprivs_pipe($write_pipe, $P_look_path);

        # Does not need to execute anything as root, because cmd_look() does not
        # install anything or even call end(), because the suer is supposed to
        # look at its output in the tempdir it prints out.
    }, config('user')
    ); # End drop_privs()

    # Read from the pipe the child, the drop_privs()ed process, writes to to
    # read the necessary values that correspond to the variables that the
    # child must communicate back to the parent, so the parent can continue
    # processing as though no fork()ing or priv dropping took place.
    ($P_look_path)
        = read_dropprivs_pipe($output);

    return $P_look_path;
}



sub cmd_list {
    my @installed_packages = glob catfile(fetchware_database_path(), '*');
    
    if (@installed_packages == 0) {
        msg 'No fetchware packages are currently installed.';
        return;
    }

    msg 'Listing all currently installed packages:';
    for my $fetchware_package (@installed_packages) {
        # Clean up $fetchware_package.
        $fetchware_package = file($fetchware_package)->basename();
        $fetchware_package =~ s/\.fpkg$//;