pkg-get/scripts/pkg-get.pl

#!/usr/bin/env perl
#
# pkg-get - A binary package management utility for CRUX Linux
# Copyright (C) 2004-2006 Simone Rota <sip@varlock.com>
# Copyright (C) 2006-2023 by CRUX team (http://crux.nu)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

use warnings;
use strict;
use Getopt::Long;
use Digest::file qw(digest_file_hex);

my $VERSION = "0.4.8";
my $CFGFILE = "/etc/pkg-get.conf";
my $LOCKFILE = "/var/lib/pkg/pkg-get.locker";
my $PKGDB    = "/var/lib/pkg/db" ;

$SIG{HUP} = \&trap; $SIG{INT} = \&trap;
$SIG{QUIT} = \&trap; $SIG{TERM} = \&trap;

# Global vars
my @repos = (); # package repositories
my @donetasks; my @failtasks; my @prevtasks; my %pptasks; my %readmetasks;
my $curraction = ""; my %deps; my @dependencies; my %missingdeps;
my %locked; my %installed;

# CL Options
my $download_only; my $pre_install; my $post_install;
my $install_scripts; my $filter = ""; my $all; my $unused;
my $aargs=""; my $ignore_md5sum; my $force; my $root;
GetOptions("do"=>\$download_only,
            "pre-install"=>\$pre_install, "post-install"=>\$post_install,
            "install-scripts"=>\$install_scripts, "all"=>\$all,
            "filter=s"=>\$filter, "config=s"=>\$CFGFILE, "aargs=s"=>\$aargs,
            "f"=>\$force, "im"=>\$ignore_md5sum, "margs=s"=>\$unused,
            "rargs=s"=>\$unused, "r=s"=>\$root);

# use compression-mode defined in pkgmk.conf
our $compress = "gz";
open CONFIG, "/etc/pkgmk.conf" or die "Could not open /etc/pkgmk.conf";
while (<CONFIG>) {
    $compress = $1 if m/^PKGMK_COMPRESSION_MODE=(.*)(#|$)/;
}
close CONFIG;
$compress =~ s/['" ]//g;

if ($root) {
    $LOCKFILE = $root.$LOCKFILE ;
    $PKGDB = $root.$PKGDB;
}

# Get command, verify it's valid
my $command = getcommand(@ARGV);
if (index($command,"Error: ") eq 0 ) {
    $command =~ s/Error\: //;
    exiterr($command);
}

readconfig();
get_locked() unless ($command =~
    /^(info|help|readme|search|dsearch|list|path|depend|current|isinst)$/);

SWITCH: {
    if ($command eq "version") { version(); last SWITCH; }
    if ($command eq "sync") { sync(); last SWITCH; }
    if ($command =~ /^(info|path|readme)$/) { info($1); last SWITCH; }
    if ($command eq "help") { help(); last SWITCH; }
    if ($command =~ /^(d|)search$/) { search(); last SWITCH; }
    if ($command eq "list") { list(); last SWITCH; }
    if ($command eq "remove") { remove(); last SWITCH; }
    if ($command eq "listinst") { listinst(); last SWITCH; }
    if ($command eq "lock") { dolock(); last SWITCH; }
    if ($command eq "unlock") { unlock(); last SWITCH; }
    if ($command eq "listlocked") { listlocked(); last SWITCH; }
    if ($command eq "printf") { doprintf(); last SWITCH; }
    if ($command =~ /^(isinst|current)$/) { current(); last SWITCH; }
    if ($command =~ /^(diff|quickdiff|sysup)$/) { diff($1); last SWITCH; }
    if ($command eq "dup") { dup(); last SWITCH; }
    if ($command =~ /^(depends|quickdep)$/) { depends(); last SWITCH; }
    if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
    if ($command eq "dependent") { dependent(); last SWITCH; }
    if ($command eq "depinst") { depinst(); last SWITCH; }
}

############################################################################
# Support functions
############################################################################

# Exit with error
sub exiterr {
    my ($msg) = @_;
    print "pkg-get: $msg\n";
    exit 1;
}

sub trap {
    printresults(1);
    die("\npkg-get: interrupted\n");
}

# Get command, return an error if not in the list of allowed commands
sub getcommand {
    my ($givencmd, $givenarg) = @_;
    if (not $givenarg){$givenarg = ""};
    if (not $givencmd){
        return "Error: no command given. try pkg-get help for more information";
    }

    my @allowed = ("depinst:", "install:", "sysup", "diff", "update:",
                   "depends:", "info:", "sync", "version", "help",
                   "quickdep:", "dependent:", "list", "listinst", "isinst:",
                   "search:", "dsearch:", "lock:", "unlock:", "listlocked",
                   "quickdiff", "printf:", "remove:", "readme:", "dup",
                   "path:", "current:");

    (grep { ($_ eq $givencmd) } @allowed)
     or ((grep { ($_ eq "${givencmd}:") } @allowed) and ($givenarg ne ""))
     or return "Error: improper command '$givencmd $givenarg'. Try pkg-get help for more information";

    return $givencmd;
}

# Parse the configuration file
sub readconfig {
    open(CFG, $CFGFILE) 
        or exiterr("could not open $CFGFILE");
    while (<CFG>) {
        chomp;
        if ( /^pkgdir\s+/ ) {
            my $repo = $_;
            $repo =~ s/^pkgdir\s+//;
            $repo =~ s/#.*$//;
            $repo =~ s/\s+$//;
            push @repos, $repo;
        } elsif (/^runscripts\s+/) {
            my $rs = $_;
            $rs =~ s/^runscripts\s+//;
            $rs =~ s/#.*$//;
            $rs =~ s/\s+$//;
            if ($rs eq "yes") {$install_scripts = 1};
        }
    }
    close(CFG);
}

# Populate a hash of locked packages
sub get_locked {
    open (my $fL, $LOCKFILE) or return;
    while (<$fL>) { $locked{$_} = 1; }
    close ($fL);
}

# Parse a line describing a package
sub parsepackage {
    my @p = split(/\:/, $_[0]);
    if ($#p < 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
    my %pkg = ( 'name' => $p[0], 'version' => $p[0], 'release' => $p[0] );
    $pkg{'name'} =~ s/\#.*//;
    $pkg{'version'} =~ s/.*\#//;
    $pkg{'version'} =~ s/-\w*\.pkg\.tar.*//;
    $pkg{'release'} =~ s/^.*-//;
    $pkg{'release'} =~ s/\.pkg\.tar.*//;
    if (not $_[2]) {$_[2] = $_[1]}; 
    $pkg{'path'} = $_[1];
    $pkg{'url'} = $_[2];
    $pkg{'url'} =~ s/\/$//;
    $pkg{'url'} .= "/$p[0]";
    $pkg{'size'} = $p[1];
    $pkg{'md5sum'} = $p[2];
    $pkg{'description'} = $p[3];
    $pkg{'pre_install'} = $p[4];
    $pkg{'post_install'} = $p[5];
    $pkg{'readme'} = $p[6];
    return %pkg;
}

# Parse a line describing a package (just the name)
sub parsepackagelight {
    my @p = split(/\:/, $_[0]);
    if ($#p < 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
    my %pkg;
    $pkg{'name'} = $1 if ($p[0] =~ m/^(.*)\#/);
    return %pkg;
}

# Print info about the given package
sub printinfo {
    my %pkg = @_;
    print "Name        : " . $pkg{'name'} . "\n";
    print "Version     : " . $pkg{'version'} . "\n";
    print "Release     : " . $pkg{'release'} . "\n";
    print "Description : " . $pkg{'description'} . "\n";
    print "URL         : " . $pkg{'url'} . "\n";
    print "Md5sum      : " . $pkg{'md5sum'} . "\n";
    print "Size        : " . $pkg{'size'} . "\n";
    my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
    if ($deps ne "") { print "Depends on  : $deps\n";};
    my $files = "";
    if ($pkg{'readme'} eq "yes") {$files .= "README,"};
    if ($pkg{'pre_install'} eq "yes") {$files .= "pre-install,"};
    if ($pkg{'post_install'} eq "yes") {$files .= "post-install,"};
    $files =~ s/\,$//;
    if ($files ne "") { print "Files       : $files\n";};
}

# Get direct dependencies for package
sub getdirectdeps {
    my ($pkgname, $dir) = @_;
    open(DEPS, "$dir/PKGDEPS") 
        or exiterr("could not open $dir/PKGDEPS");
    while (<DEPS>) {
        chomp;
        if ( /^\Q$pkgname\E\s+/ ) {
            my $dep = $_;
            $dep =~ s/^.*\: //;
            close(DEPS);
            return $dep;
        }
    }
    close(DEPS);
    return "";
}

# Prints the README file to stdout
sub printreadme {
    my %pkg = @_;
    my ($found, $finished) = (0, 0);
    open(READ, "$pkg{'path'}/PKGREAD") 
        or exiterr("could not open $pkg{'path'}/PKGREAD");
    while (<READ>) {
        chomp;
        if (($found == 1) and ( /PKGREADME\:/ )) {
            $finished = 1;
        } elsif ($found == 1) {
            print "$_\n";
        } elsif ( /PKGREADME\: $pkg{'name'}$/ ) {
            $found = 1;
        }
    last if ($finished == 1);
    }
    close(READ);
}

# Print results for multiple package operations
sub printresults {
    my $okaction = $curraction;
    my $curr = "";
    my $action;
    my $pkg;
    my @readme;
    my $goterror = 0;
    if (@donetasks) {
        print "\n-- Packages $okaction\n";
        foreach my $task(@donetasks) {
            if ($readmetasks{$task}) {push(@readme, $task)}
            print "$task" . $pptasks{$task}."\n";
        }
    }
    if (@prevtasks) {
        if ($okaction eq "installed") {
            print "\n-- Packages installed before this run (ignored)\n";
        } else {
            print "\n-- Packages not previously installed (ignored)\n";
        }
        foreach my $task(@prevtasks) { print "$task\n"; }
    }
    if (@failtasks) {
        foreach my $task(sort @failtasks) {
            ($action, $pkg) = split(/,/,$task);
            if ($curr ne $action) {
                print "\n-- Packages $action\n";
                $curr = $action;
            }
            print "$pkg\n";
        }
    }
    if (@readme) {
        print "\n-- $okaction packages with README file\n";
        foreach my $task(@readme) {
            print "$task" . $pptasks{$task}."\n";
        }
    }
    if(@donetasks and not @failtasks and not $_[0]) {
        print "\npkg-get: $okaction successfully\n"
    }
}

# Get the list of installed packages
sub getinstalled {
    local $/ = ""; # read files paragraph-wise; see ``perldoc perlvar''
    open(DB, $PKGDB) 
        or exiterr("could not open ".$PKGDB);
    while (<DB>) {
        my ($name, $version, @files) = split /\n/, $_;
        $installed{$name} = $version;
    }
    close(DB);
}

# Print formatted info for given package
sub formattedprint {
    my %pkg = @_;
    my $fmt = $ARGV[1];
    $fmt =~ s|%n|$pkg{'name'}|;
    $fmt =~ s|%p|$pkg{'path'}|;
    $fmt =~ s|%v|$pkg{'version'}|;
    $fmt =~ s|%r|$pkg{'release'}|;
    $fmt =~ s|%d|$pkg{'description'}|;
    $fmt =~ s|%u|$pkg{'url'}|;
    $fmt =~ s|%R|$pkg{'readme'}|;
    $fmt =~ s|%E|$pkg{'pre_install'}|;
    $fmt =~ s|%O|$pkg{'post_install'}|;
    $fmt =~ s|%M|None|; # for prt-get compatibility
    $fmt =~ s|%P|None|; # for prt-get compatibility
    $fmt =~ s|\\n|\n|;
    $fmt =~ s|\\t|\t|;
    if (index($fmt,"%e") >=0) {
        my $deps = getdirectdeps($pkg{'name'}, $pkg{'path'});
        $fmt =~ s|%e|$deps|;
    }
    if (index($fmt,"%l") >=0) {
        my $locked = ($locked{$pkg{'name'}}) ? "yes" : "no";
        $fmt =~ s|%l|$locked|;
    }
    if (index($fmt,"%i") >=0) {
        (%installed) or getinstalled();
        my $inst = ($installed{$pkg{'name'}}) ? "yes" : "no";
        ($inst eq "no") or
        ($installed{$pkg{'name'}} eq "$pkg{'version'}-$pkg{'release'}")
            or $inst = "diff";
        $fmt =~ s|%i|$inst|;
    }
    print "$fmt";
}

# Get package from the repo(s)
sub getpackage {
    my $pkgname = $_[0];
    my $found; my @maybe; my %repver; my %res;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            next if ($pkg{'name'} ne $pkgname);
            $found = 1;
            push @maybe, join("^", $pkg{'path'}, $pkg{'url'},
            $pkg{'version'}, $pkg{'release'}, $pkg{'description'},
            $pkg{'md5sum'}, $pkg{'size'},
            $pkg{'pre_install'}, $pkg{'post_install'}, $pkg{'readme'});
            ( ($repver{$pkgname}) and 
              ($repver{$pkgname} gt "$pkg{'version'}-$pkg{'release'}") )
             or $repver{$pkgname} = "$pkg{'version'}-$pkg{'release'}";
        }
        close (REPO);
        while (my $match = shift @maybe) {
            my ($p,$u,$v,$r,$d,$m,$s,$E,$O,$R) = split /\^/, $match;
            next if ("$v-$r" lt $repver{$pkgname});
            %res = ('name' => $pkgname, 'path' => $p, 
                    'url' => $u, 'version' => $v, 'release' => $r,
                    'description' => $d, 'md5sum' => $m, 'size' => $s,
            'pre_install' => $E, 'post_install' => $O, 'readme' => $R);
        }
        last if ($found);
    }
    return %res;
}

# Get short status for package, e.g. [i] 
sub getshortstatus {
    my %pkg = @_;
    ($installed{$pkg{'name'}}) or return "[ ]";
    ($installed{$pkg{'name'}} =~ /^$pkg{'version'}-$pkg{'release'}/) or return "[u]";
    return "[i]";
}

# Get (recursive) dependencies for pkgname
sub getdependencies {
    my ($pkgname, $checkver, $pkgparent) = @_;
    my $depstring = "";

    # no need to continue if there's already a value for this key
    return if ($deps{$pkgname});
    
    my %pkg = getpackage($pkgname);
    if (%pkg) {
        my $ddeps = getdirectdeps($pkg{'name'}, $pkg{'path'});
        my @d = split(/,/, $ddeps);
        foreach my $dep(@d) {
            getdependencies($dep, $checkver, $pkgname);
        }
        $depstring = getshortstatus(%pkg)." " if ($checkver);
        $depstring .= $pkgname;
        $deps{$pkgname} = $depstring;
        push(@dependencies, $depstring);
    } else {
        return 0 if ($pkgparent eq "");
        $missingdeps{$pkgname} = $pkgparent;
    }
}

# Download given package (if needed), check md5sum
sub downloadpkg {
    my %pkg = @_;
    my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
    if (-f $fullpath) {
        my $md5 = digest_file_hex($fullpath,"MD5");
        if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
            print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n"; 
            print STDERR "required : $pkg{'md5sum'}\n"; 
            print STDERR "found : $md5\n"; 
            return 0;
        }
        return 1;
    } else {
        return 1 if ($pkg{'url'} eq ""); # repo is local and pkg does not exist
        my $url = $pkg{'url'};
        $url =~ s/\#/\%23/;
        system ("curl --retry 3 --retry-delay 3 -o $fullpath $url") == 0 or return 0;
        my $md5 = digest_file_hex($fullpath,"MD5");
        if ($md5 ne $pkg{'md5sum'} and not $ignore_md5sum) {
            print STDERR "=======> ERROR: md5sum mismatch for $pkg{'name'}:\n"; 
            print STDERR "required : $pkg{'md5sum'}\n"; 
            print STDERR "found : $md5\n"; 
            return 0;
        }
    }
    return 1;
}

# Install given package
sub installpkg {
    my ($upgrade, %pkg) = @_;
    my $aa = $aargs." ";
    if ($pkg{'readme'} eq "yes") {$readmetasks{$pkg{'name'}} = 1};
    $pptasks{$pkg{'name'}} = "";
    if ($download_only) {return 1;}
    if ($force){$aa = $aa."-f ";}
    if ($root) {
    $aa = $aa."-r ".$root." ";
        (-f "$root/$pkg{'path'}/PKGINST") or
        system("install -D $pkg{'path'}/PKGINST $root/$pkg{'path'}/PKGINST")
    or die "Failed to copy PKGINST to $root, aborting.\n";
    }
    if ($pkg{'pre_install'} eq "yes" and ($install_scripts or $pre_install)) {doscript("pre",%pkg);}    
    my $fullpath = $pkg{'path'}."/".$pkg{'name'}."#".$pkg{'version'}."-".$pkg{'release'}.".pkg.tar.$compress";
    print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath\n";
    system ("/usr/bin/pkgadd $upgrade $aa$fullpath") == 0 or return 0;
    if ($pkg{'post_install'} eq "yes" and ($install_scripts or $post_install)) {doscript("post",%pkg);} 
    return 1;
}

# Execute pre- or post-install script
sub doscript {
    my ($when, %pkg) = @_;
    my $cmd = ($root) ? "chroot $root " : "";
    $cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when";
    if (system($cmd) == 0) {
        $pptasks{$pkg{'name'}} .= " [$when: ok]";
    } else {
        $pptasks{$pkg{'name'}} .= " [$when: failed]";
    }
}

############################################################################
# Main functions (commands)
############################################################################

# No pun intended ##########################################################
sub version {
    print "pkg-get $VERSION ";
    print "by Simone Rota <sip\@varlock.com>\n";
}

# Show brief help ##########################################################
sub help {
    print "Usage: pkg-get command <package1> [package2 ... packageN] [options]

Some command:
  sync      synchronize with the repository
  depinst   install package and its dependencies
  info      info about package
  sysup     update all outdated packages
  diff      list all outdated packages

Some option:
  -do   download only
  --install-scripts   use install scripts
  -r <root>  use <root> for pkgadd

Example:
  pkg-get install sqlite pysqlite

For other commands and samples, see the pkg-get(8) man page\n";
}

# Sync with the remote server(s) ###########################################
sub sync {
    my $dlerror = 0;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        next if (not $url);
        print "Updating collection $dir\n";
        (-d $dir) or mkdir($dir) or exiterr("cannot create $dir");
        for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
            (! -f "$dir/$f") or rename("$dir/$f", "$dir/$f.old") or exiterr("cannot write to $dir");
            if (system("curl -s --output-dir $dir -o $f $url/$f") != 0) {
                print " cannot retrieve $f\n";
                $dlerror=1;
            }
        }
        if ($dlerror) { # restore backup repo
            for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
                (! -f "$dir/$f.old") or rename("$dir/$f.old", "$dir/$f") or exiterr("cannot write to $dir");
            }
        } else { # remove backup repo
            for my $f ("PKGREPO", "PKGDEPS", "PKGREAD", "PKGINST") {
                (! -f "$dir/$f.old") or unlink("$dir/$f.old") or exiterr("cannot write to $dir");
            }
        }
    }
}

# Show info/path/readme for the package ####################################
sub info {
    my ($type, $arg) = @ARGV;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            if ($pkg{'name'} eq $arg) {
                ($type ne "info") or printinfo(%pkg);
                ($type ne "readme") or printreadme(%pkg);
                ($type ne "path") or print $pkg{'path'} . "\n";
                close(REPO); return;
            }
        }
        close(REPO);
    }
    print "Package '$arg' not found\n";
}

# List packages containing given string (name/description) #################
sub search {
    my $arg = $ARGV[1];
    my $type = ($ARGV[0] =~ /^d/) ? "desc" : "name";
    my %found;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            next if ($found{$pkg{'name'}});
            (index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
            ($found{$pkg{'name'}}==1) or ($type ne "desc") 
               or (index($pkg{'description'}, $arg) < 0)
                   or $found{$pkg{'name'}} = 1;
        }
        close(REPO);
    }
    foreach my $key (sort keys %found) { print "$key\n"; } 
    if (not %found) { print "No matching packages found\n"; }
}

# List all available packages ##############################################
sub list {
    my $arg = $ARGV[1];
    my %found;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            $found{$pkg{'name'}} = 1;
        }
        close(REPO);
    }
    foreach my $key (sort keys %found) { print "$key\n"; } 
}

# Remove given packages ####################################################
sub remove {
    $curraction = "removed";
    shift(@ARGV);
    my $cmd = "/usr/bin/pkgrm";
    $cmd .= " -r $root" if ($root);
    foreach my $pkg(@ARGV) {
        $pptasks{$pkg} = "";
        if (system("$cmd $pkg")==0) {
            push(@donetasks, $pkg);
        } else {
            push(@failtasks, "where removal failed,$pkg");
        }
    }
    printresults();
}

# List installed packages ##################################################
sub listinst {
    getinstalled() if (! %installed);
    foreach my $key (sort keys %installed) { print "$key\n"; } 
}

# Print package version, or install status #################################
sub current {
    getinstalled() if (! %installed);
    my $type = shift(@ARGV); my $result;
    foreach my $pkg(@ARGV) {
        if ($installed{$pkg}) {
            $result = ($type eq "current") ? ": version $installed{$pkg}\n"
                       : " is installed\n";
        } else {
            $result = " not installed\n";
        }
        print "Package " . $pkg . $result;
    }
}

# Lock given packages ######################################################
sub dolock {
    shift(@ARGV);
    foreach my $arg(@ARGV) {
        if ($locked{$arg}) {
            print "Already locked: $arg\n"; next;
        }
        my $found = 0;
        foreach my $repo(@repos) {
            my ($dir, $url) = split(/\|/, $repo);
            open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
            while (<REPO>) {
                chomp;
                my %pkg = parsepackagelight($_);
                if ($pkg{'name'} eq $arg) {
                    $found = 1;
                    open(LCK, ">> $LOCKFILE") 
                        or exiterr("could not write to lock file");
                    print LCK "$arg\n";
                    close(LCK);
                }
                last if ($found);
            }
            close(REPO);
            last if ($found);
        }
        if  ($found == 0) {print "Package '$arg' not found\n"};
    }
}

# Unlock given packages ####################################################
sub unlock {
    shift(@ARGV);
    foreach my $arg(@ARGV) {
        if (! $locked{$arg}) {
            print "Not locked previously: $arg\n"; next;
        } else {
            delete $locked{$arg};
        }
    }
    open(my $fL, ">$LOCKFILE") or exiterr("could not write to lock file");
    foreach (sort keys %locked) { print $fL "$_\n"; }
    close($fL);
}

# List locked packages #####################################################
sub listlocked {
    foreach (sort keys %locked) { print "$_\n"; }
}

# Print formatted info #####################################################
sub doprintf {
    my %repver; my %found;
    foreach my $repo(@repos) {
        my @toprint=();
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            next if ($found{$pkg{'name'}});
            (! $filter) or $filter =~ s/\*/\.\*/;
            if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
                $found{$pkg{'name'}} = 1; next;
            }

            push @toprint, join("^", $pkg{'name'}, $pkg{'path'}, $pkg{'url'},
            $pkg{'version'}, $pkg{'release'}, $pkg{'description'},
            $pkg{'md5sum'}, $pkg{'size'},
            $pkg{'pre_install'}, $pkg{'post_install'}, $pkg{'readme'});

            ( ($repver{$pkg{'name'}}) and 
              ($repver{$pkg{'name'}} gt "$pkg{'version'}-$pkg{'release'}") )
             or $repver{$pkg{'name'}} = "$pkg{'version'}-$pkg{'release'}";
        }
        close(REPO);

        while (my $tpp = shift @toprint) {
            my ($n,$p,$u,$v,$r,$d,$m,$s,$E,$O,$R) = split /\^/, $tpp;
            my %printpkg = ('name' => $n, 'path' => $p, 
            'url' => $u, 'version' => $v, 'release' => $r,
            'description' => $d, 'md5sum' => $m, 'size' => $s,
            'pre_install' => $E, 'post_install' => $O, 'readme' => $R);
            next if ("$v-$r" lt $repver{$n});
            formattedprint(%printpkg);
            $found{$n} = 1;
        }
    }
}

# Show or resolve differences between installed and available packages #####
sub diff {
    my $format = shift; my %found; my @diff;
    my $strf= ($format =~ /^quick/) ? "%s " : "%-19s %-19s %-19s\n";
    (%installed) or getinstalled();

    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        my @multip=();
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            next if ( ($found{$pkg{'name'}}) or (! $installed{$pkg{'name'}}) );
            next if ( ($locked{$pkg{'name'}}) and (! $all) );
            my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
            ($lastcol eq "locked") or $lastcol = ($installed{$pkg{'name'}}
            eq $pkg{'version'}."-".$pkg{'release'}) ? "uptodate" :
                   $pkg{'version'}."-".$pkg{'release'};
            push @multip, "$pkg{'name'}^$installed{$pkg{'name'}}^$lastcol";
        }
        close(REPO);
        while (my $mp = shift @multip) {
            my ($mpname, $vinst, $mpinfo) = split /\^/, $mp;
            next if ( (@multip) and ($multip[0] =~ m/^\Q$mpname\E\^/) );

            $found{$mpname} = 1;
            next if ($mpinfo eq "uptodate");
            ($format !~ /^(quick|sysup)/) or push @diff, $mpname;
            ($format =~ /^(quick|sysup)/) or push @diff, join("^",
             $mpname, $vinst, $mpinfo);
        }
    }
    ($#diff < 0) or ($format =~ /^(quick|sysup)/) or
        printf $strf, "Package","Installed", "Available in the repositories";
    if ($format ne "sysup") {
        print "\n";
        foreach my $dl (@diff) { printf $strf, split /\^/, $dl; }
    }
    ($format !~ /^quick/) or ($#diff < 0) or print "\n";
    ($#diff >= 0) or print "No differences found\n";

    # proceed with updates if sysup was requested
    ($#diff < 0) or ($format ne "sysup") or upinst("update", @diff);
}

# Display duplicate packages (found in more than one repo) #################
sub dup {
    my %found;
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
        while (<REPO>) {
            chomp;
            my %pkg = parsepackage($_, $dir, $url);
            $found{$pkg{'name'}} .= "###" . $pkg{'path'}."/". $pkg{'name'}.$pkg{'version'}."-".$pkg{'release'};
        }
        close(REPO);
    }
    foreach my $key (sort keys %found) {
        my $value = $found{$key};
        $value =~ s/^\#\#\#//;
        if (rindex($value, "###") >=0){
            print "* $key\n";
            my @d = split(/\#\#\#/, $value);
            foreach my $dup(@d){ print "  $dup\n"; }
        }
    } 
}

# Show list of dependencies for package ####################################
sub depends {
    my ($j, $checkver) = ($ARGV[0] =~ /^quick/) ? (" ",0) : ("\n",1);
    ($checkver == 0) or (%installed) or getinstalled();
    getdependencies($ARGV[1], $checkver, "") or exiterr("package '$ARGV[1]' not found");
    if ((@dependencies) and ($checkver)) {print "-- dependencies ([i] = installed, [u] = updatable)\n"}
    print join($j, @dependencies);
    if ((%missingdeps) and ($j ne " ")) {
        print "\n-- missing packages\n";
        foreach my $dep(sort keys %missingdeps) {
            print "$dep from $missingdeps{$dep}\n";
        }
    }
    print "\n";
}

# Show packages directly depending from given package ######################
sub dependent {
    my $arg = $ARGV[1];
    my %dp;
    getinstalled() unless (($all) or (%installed));
    foreach my $repo(@repos) {
        my ($dir, $url) = split(/\|/, $repo);
        open(DEPS, "$dir/PKGDEPS") 
            or exiterr("could not open $dir/PKGDEPS");
        while (<DEPS>) {
            chomp;
            my ($maybe, $deplist) = split /\:/;
            # collapse trailing or leading whitespace
            $maybe =~ s/\s+$//; $deplist =~ s/^\s+//;
            # ensure that arg is surrounded by commas, even if appearing at
            # the beginning or the end of the list
            $deplist =~ s/^/\,/; $deplist =~ s/$/\,/;
            $dp{$maybe} = 1 if (index($deplist,",$arg,") >= 0);
        }
        close(DEPS);
    }
    foreach my $res(keys %dp) {
        print "$res\n" unless ((not $all) and (! $installed{$res}));
    }
}

# Install or update given package ##########################################
sub upinst {
    my ($cmd, @args) = @_; my $aa;
    ($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");

    getinstalled() if (! %installed);
    foreach my $pkgname(@args) {
        my %pkg = getpackage($pkgname);
        if (not %pkg) {
            push(@failtasks, "not found,$pkgname");
        } elsif ( ($cmd . getshortstatus(%pkg)) 
            =~ /^(update.i|update. |install.u|install.i)/ ) {
            push(@prevtasks, "$pkgname");
        } elsif (downloadpkg(%pkg) and installpkg($aa, %pkg)) {
            push(@donetasks, $pkgname);
        } else {
            push(@failtasks, "where $cmd failed,$pkgname");
        }
    }
    printresults();
}

# Install given package, along with dependencies ###########################
sub depinst {
    my @toinst; my %seen;
    $curraction = "installed";
    my @args = @ARGV; shift(@args);
    getinstalled() if (! %installed);
    foreach my $pkgname(@args) {
        getdependencies($pkgname, 0, "");
        foreach my $dep(@dependencies) {
            next if ($seen{$dep}); $seen{$dep} = 1;
            next if ($locked{$dep});
            my %pkg = getpackage($dep);
            if ((%pkg) and (getshortstatus(%pkg) eq "[ ]")) {
                push(@toinst, $pkg{'name'});
            }
        }
    }
    upinst("install",@toinst) if (@toinst);
}