Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

(self-deprecated) slack updater

by mwp (Hermit)
on Jan 12, 2001 at 05:22 UTC ( #51274=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info Alakaboo, aka
Mike Pastore <pastorem@mediaone.net>
Description:

Deprecated: If you're looking for a script to do this for you, I highly recommend autoslack, written by David Cantrell (of the Slackware Team). It can be found in the unsupported directory on any slackware mirror.

A relatively simple script that I'm writing which scans a local, uninstalled copy of Slackware 7.1 and updates the packages from a slackware-current mirror. Very rough around the edges, so be gentle. Gives you the option of installing downloaded packages but is not integrated with /var/adm/packages info in this version. Useful to a point, mostly written for myself only because Patrick Volkerdeing & Co. are writing a script named 'autoslack' (in Perl!) with the same exact functionality, 'cept probably better! I was just impatient.

Good example of Digest::MD5, following our recent discussions!

#!/usr/bin/perl
#################################################
# Updater script for a local, uninstalled copy
# of a Slackware 7.1 distribution.
# Author:   Mike Pastore <pastorem@mediaone.net>
# File:     slackupd.pl
# Version:  0.8.0
# Modified: 01/11/2001
#################################################
# To Do:
# 1) More robust installer
# 2) Integration with /var/adm/packages (ie,
#    update an INSTALLED copy of Slack)
# 3) Use GetOpts or similar package, add options
#    for auto-install, auto-commit, etc.
# 4) user root check
#################################################

use strict;
#use warnings 'all';
use LWP::Simple qw(get getstore);
use Digest::MD5;

# global user variables
our $tmp = '/tmp';
our $mirror = 'ftp://ftp.freesoftware.com' .
              '/pub/slackware/slackware-current/slakware';

local $| = 1; # enable auto-flush

my $all_pkg = int($ARGV[0] eq "-a"); # get bool val
my($target, $source) = # set target (local) and source (remote)
    map { s/\/+$//; $_ } @ARGV[$all_pkg .. $all_pkg + 1];
$source ||= $mirror; # default to mirror

# usage rules
my @rules = (
    [ -d $target, "No such file or directory: $target" ],
    [ !$source || (defined $source &&
          $source =~ /^ftp:\/\// && $source =~ /slakware$/),
      "Invalid mirror path: $source" ]
);

# build error message
my $err;
for(@rules) {
    $err .= $_->[1]."\n" unless $_->[0];
}

# usage error
die <<USAGE if $err;
$err
Usage:
    slackupd.pl [-a] /path/to/slakware 
        [ftp://mirror.com/path/to/slakware]

Options:
    -a: update all packages
        by default only updates packages found under 
        /path/to/slakware, unless tree is empty

USAGE

# global program variables
my %counts = (remote => 0, local => 0, updated => 0);
my @tarballs = ();

# build list of current packages
opendir(PRUNE, $target)
    or die "Unable to read target directory: $!\n";
my %packages = map { $_ => 1 } 
    grep { !/^\./ && -d "$target/$_" } readdir(PRUNE);
closedir(PRUNE);

print "Reading remote CHECKSUMs from $source:\n";
my $md5_list = get($source . "/CHECKSUMS.md5");
die "The location you specified \"$source\" does not have a checksum
file. Please choose another mirror, or check your path.\n"
    unless defined $md5_list;

# parse slurped file/checksum list and build LoH
for(split /\n/, $md5_list) {
    next unless /^([a-z0-9]+?)\s+\.\/(\S+?)\/(\S+?)$/;
    next unless($all_pkg || $packages{$2});

    push @tarballs, {
        update      => (! -e "$target/$2/$3"), # update if DNE
        package     => $2,
        filename    => $3,
        checksum    => $1,
        hexdigest   => undef
    };

    $counts{remote}++ && print '.';
}
print " ($counts{remote} remote packages)\n\n";

print "Generating local CHECKSUMs for $target:\n";
# verify checksums for files not already marked for updating
for(grep !($_->{update}), @tarballs) {
    my $digest = $_->{hexdigest} =
       &hexdigest(join '/', $target, $_->{package}, $_->{filename});
    $_->{update} = ($digest ne $_->{checksum});
    $counts{local}++ && print '.';
}
print " ($counts{local} local packages)\n\n";

print "Download packages [". do {
    local $" = ','; "@{[ keys %packages ]}"
} ."]:\n";

# download tarballs to our temp target
mkdir("$tmp/slakware", 0777);
&retrieve($_) && $counts{updated}++
    for(grep $_->{update}, @tarballs);

unless($counts{updated} > 0) {
    print "No tarballs to update, none fetched.\n";
    exit;
}

print "Updating FILE_LIST, CHECKSUMS, README, etc...\n";
getstore("$source/$_", "/tmp/slakware/$_")
    for('CHECKSUMS', 'CHECKSUMS.md5', 'FILE_LIST', 'makeflop', 
        'MANIFEST.gz', 'README');

print "\nCommit? (Overwrite tree with new packages) [y/N] ";
my $prompt = <STDIN>;
unless($prompt =~ /^y/i) {
    print "\nPackages can be found in $tmp/slakware\n";
} else {
    print "\nUpdating directory tree...\n";
    system("cp -R $tmp/slakware/* $target");
}

print "\nInstall packages? (installpkg) [Y/n] ";
$prompt = <STDIN>;
if($prompt =~ /^n/i) {
    print "Alrighty then!\n";
    exit;
}

for(grep $_->{update}, @tarballs) {
    my($package, $filename) =
        @$_{'package', 'filename'};

    print "Install $package/$filename? [y/N] ";
    my $prompt = <STDIN>;
    if($prompt =~ /^y/i) {
        system('installpkg', "$tmp/slakware/$package/$filename");
    }
}

sub hexdigest {
    my $file = shift;

    local *TARBALL;
    open(TARBALL, $file)
        or die "Unable to open file for checksum: $!\n";
    binmode(TARBALL);

    Digest::MD5->new->addfile(*TARBALL)->hexdigest;
}

sub retrieve {
    my $tarball = shift;
    my($package, $filename) =
        @$tarball{'package', 'filename'};
    my $local = "$tmp/slakware/$package";
    my $remote = "$source/$package";

    # create target directory if needed
    mkdir($local, 0777) if(! -d $local);

    print "retrieving $package/$filename...";
    # check to see if the file already exists
    if(-e "$local/$filename") {
        print " already exists!";
        my $checksum = &hexdigest(join '/', $local, $filename);
        if($checksum eq $tarball->{checksum}) {
            print " checksum verified, skipping file";
            $tarball->{update} = 0;
        } else {
            print " invalid checksum, overwriting";
        }
    }

    my $count = 0;
    FETCH: while($tarball->{update} && ++$count < 3) {
        my $filepath = join('/', $local, $filename);
        getstore("$remote/$filename", $filepath)
            or next FETCH;

        my $checksum = &hexdigest($filepath);
        if($checksum eq $tarball->{checksum}) {
            print " (@{[ -s $filepath ]} bytes OK)";
            last FETCH;
        } else {
            unlink $filepath;
        }
    } continue {
        warn "\nUnable to download package, continuing...\n";
    }

    print "\n";
}

Comment on (self-deprecated) slack updater
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://51274]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chilling in the Monastery: (13)
As of 2015-07-29 20:51 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (269 votes), past polls