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