817 lines
28 KiB
Perl
Executable File
817 lines
28 KiB
Perl
Executable File
#!/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);
|
|
use File::Path;
|
|
|
|
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 %depmap; my %locked; my %checksumsize;
|
|
my %fullpath; my %remote; my %prepostread; my %description;
|
|
my %instver; my %repver; my %shortstatus;
|
|
|
|
# CL Options
|
|
my $download_only; my $pre_install; my $post_install; my $root="";
|
|
my $install_scripts; my $all; my $filter = ""; my $unused;
|
|
my $aargs=""; my $ignore_md5sum; my $force; my $force_reinst;
|
|
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,
|
|
"fr"=>\$force_reinst, "rargs=s"=>\$unused, "r=s"=>\$root);
|
|
|
|
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 =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
|
|
if ($command eq "dependent") { dependent(); last SWITCH; }
|
|
if ($command =~ /^(depends|quickdep)$/) { load_depmap(); depends($1); last SWITCH; }
|
|
if ($command eq "depinst") { load_depmap(); 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 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/, $_;
|
|
$instver{$name} = $version;
|
|
}
|
|
close(DB);
|
|
}
|
|
|
|
# Populate a hash of locked packages
|
|
sub get_locked {
|
|
open (my $fL, $LOCKFILE) or return;
|
|
while (<$fL>) { chomp; $locked{$_} = 1; }
|
|
close ($fL);
|
|
}
|
|
|
|
# Populate hashes for the available packages
|
|
# (requires a previous run of getinstalled)
|
|
sub load_repos {
|
|
(%instver) or ($command eq "list") or getinstalled();
|
|
foreach my $repo(@repos) {
|
|
my ($dir, $url) = split(/\|/, $repo);
|
|
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
|
|
while (<REPO>) {
|
|
chomp;
|
|
my ($filename,$du,$checksum,$desc,$pre,$post,$read)=split(/:/,$_);
|
|
my $pkgname = $filename;
|
|
$pkgname =~ s/#.*//;
|
|
next if ($repver{$pkgname}); # only consider the first matching entry
|
|
$repver{$pkgname} = $1 if ($filename =~ m/.*#(.*)\.pkg\.tar\./);
|
|
|
|
# no need to populate the remaining hashes if the user only asked for a list
|
|
next if ($command eq "list");
|
|
$remote{$pkgname} = ($url) ? $url : "";
|
|
$fullpath{$pkgname} = "$dir/$filename";
|
|
$checksumsize{$pkgname} = "$du:$checksum";
|
|
($command ne "info") or $description{$pkgname} = $desc;
|
|
$prepostread{$pkgname} = "$pre:$post:$read";
|
|
if (! $instver{$pkgname}) {
|
|
$shortstatus{$pkgname} = "[ ]";
|
|
} elsif ($instver{$pkgname} eq $repver{$pkgname}) {
|
|
$shortstatus{$pkgname} = "[i]";
|
|
} else {
|
|
$shortstatus{$pkgname} = "[u]";
|
|
}
|
|
}
|
|
close (REPO);
|
|
}
|
|
}
|
|
|
|
# Parse a line describing a package
|
|
sub parsepackage {
|
|
my $type=shift; my @p = split(/\:/, $_[0]);
|
|
if ($#p < 6) {exiterr("$_[1]/PKGREPO appears to be in wrong format!\nAborting.")};
|
|
my ($N, $V, $C) = ($p[0] =~ m/(.*)\#(.*)\.pkg\.tar\.(bz2|gz|lz|xz|zstd)$/) ? ($1, $2, $3) : ("","","");
|
|
($type ne "light") or return ('name' => $N);
|
|
my $R = ($V =~ m/^.*-(\w)$/) ? $1 : 0;
|
|
$V =~ s/-\w$//;
|
|
my %pkg = ( 'name' => $N, 'version' => $V, 'release' => $R, 'compression' => $C );
|
|
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;
|
|
}
|
|
|
|
# Print info about the given package
|
|
sub printinfo {
|
|
my $pkgname = shift;
|
|
my ($path, $version, $release) = ($1,$2,$3)
|
|
if ($fullpath{$pkgname} =~ m/(.*)\/$pkgname#(.*)-([0-9]*)\.pkg\.tar/);
|
|
my ($du, $md5sum) = ($1,$2) if ($checksumsize{$pkgname} =~ m/([0-9]*):(.*)/);
|
|
my $url = ($remote{$pkgname}) ? $remote{$pkgname} : $path;
|
|
print "Name : " . $pkgname . "\n";
|
|
print "Version : " . $version . "\n";
|
|
print "Release : " . $release . "\n";
|
|
print "Description : " . $description{$pkgname} . "\n";
|
|
print "URL : " . $url . "\n";
|
|
print "Md5sum : " . $md5sum . "\n";
|
|
print "Size : " . $du . "\n";
|
|
my $deps = ($depmap{$pkgname}) ? $depmap{$pkgname} : "";
|
|
($deps eq "") or print "Depends on : $deps\n";
|
|
my $files = "";
|
|
if ($prepostread{$pkgname} =~ /:yes$/) {$files .= "README,"};
|
|
if ($prepostread{$pkgname} =~ /^yes:/) {$files .= "pre-install,"};
|
|
if ($prepostread{$pkgname} =~ /:yes:/) {$files .= "post-install,"};
|
|
$files =~ s/\,$//;
|
|
($files eq "") or print "Files : $files\n";
|
|
}
|
|
|
|
# Prints the README file to stdout
|
|
sub printreadme {
|
|
my $pkgname = shift;
|
|
my ($found, $finished) = (0, 0);
|
|
my $path = $fullpath{$pkgname};
|
|
$path =~ s/[^\/]*$//;
|
|
open(READ, "$path/PKGREAD")
|
|
or exiterr("could not open $path/PKGREAD");
|
|
while (<READ>) {
|
|
chomp;
|
|
if ( ($found == 1) and (/PKGREADME\:/) ) {
|
|
$finished = 1;
|
|
} elsif ($found == 1) {
|
|
print "$_\n";
|
|
} elsif ( /PKGREADME\: $pkgname$/ ) {
|
|
$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;
|
|
if (@donetasks) {
|
|
@readme = grep { ($readmetasks{$_}) } @donetasks;
|
|
print "\n-- Packages $okaction\n";
|
|
foreach my $task(@donetasks) {
|
|
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";
|
|
print join(", ",@readme);
|
|
print "\n";
|
|
}
|
|
(! @donetasks) or (@failtasks) or ($_[0]) or
|
|
print "\npkg-get: $okaction successfully\n";
|
|
}
|
|
|
|
|
|
|
|
# Initialize a hash of dependencies
|
|
sub load_depmap {
|
|
foreach my $repo(@repos) {
|
|
my ($dir, $url) = split(/\|/, $repo);
|
|
open(DEPS, "$dir/PKGDEPS") or exiterr("could not open $dir/PKGDEPS");
|
|
while (<DEPS>) {
|
|
chomp;
|
|
my ($pkgname,$pkgdep) = ($1,$2) if ( m/([^\s]*)\s*:\s*(.*)$/ );
|
|
next if ($depmap{$pkgname});
|
|
$depmap{$pkgname} = $pkgdep;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Return a sorted list of packages required to satisfy all dependencies.
|
|
sub deporder {
|
|
my $type=shift; my @seeds=@_; our @treewalk=(); our @result; our %missing;
|
|
our %given = map { $_ => 1 } @seeds; our %imark=(); our %fmark=();
|
|
|
|
foreach my $t (@seeds) { recurse_deptree($t,""); }
|
|
|
|
sub recurse_deptree {
|
|
my $s=shift; my $pkgparent=shift; my %curdeps=();
|
|
|
|
# early return if this node has been visited already
|
|
if ($fmark{$s}) { return; }
|
|
|
|
# detect targets that are not present among the repositories
|
|
if (! $repver{$s}) {
|
|
$missing{$pkgparent} .= "$s from $pkgparent;";
|
|
$fmark{$s}=0;
|
|
return;
|
|
}
|
|
|
|
# dependency cycle detection
|
|
if ($imark{$s}) {
|
|
print "Dependency cycle found: ";
|
|
foreach (@treewalk) { print "$_ => "; }
|
|
print "$s\n";
|
|
return;
|
|
}
|
|
|
|
push(@treewalk, $s); $imark{$s}=1;
|
|
|
|
# assemble the list of dependencies that must be visited next
|
|
(! $depmap{$s}) or %curdeps = map { $_ => 1 } split / /, $depmap{$s};
|
|
|
|
foreach my $sd (keys %curdeps) {
|
|
recurse_deptree($sd,$s);
|
|
}
|
|
delete $imark{$s}; pop(@treewalk);
|
|
$fmark{$s} = 1;
|
|
push(@result, $s);
|
|
}
|
|
|
|
if ((%missing) and ($type ne "quick")) {
|
|
push (@result, "--- missing deps:");
|
|
foreach my $mdep (sort(keys %missing)) {
|
|
push (@result, split /;/, $missing{$mdep});
|
|
}
|
|
}
|
|
return @result;
|
|
}
|
|
|
|
# Download given package (if needed), check md5sum
|
|
sub downloadpkg {
|
|
my $pkgname = shift;
|
|
my $url = "$remote{$pkgname}";
|
|
if ($url) {
|
|
$url =~ s/\#/\%23/;
|
|
} else {
|
|
my $saved = (-f $fullpath{$pkgname}) ? 1 : 0;
|
|
return $saved;
|
|
}
|
|
my $downloadcmd = "curl --retry 3 --retry-delay 3 -o $fullpath{$pkgname} $url";
|
|
(! $force_reinst) or system ($downloadcmd) == 0 or return 0;
|
|
(-f $fullpath{$pkgname}) or system ($downloadcmd) == 0 or return 0;
|
|
# by now there should be a file in the expected location
|
|
my $md5found = digest_file_hex($fullpath{$pkgname},"MD5");
|
|
my $md5expected = $1 if ($checksumsize{$pkgname} =~ m/:(.*)/);
|
|
if ($md5found ne $md5expected and not $ignore_md5sum) {
|
|
print STDERR "=======> ERROR: md5sum mismatch for $pkgname:\n";
|
|
print STDERR "required : $md5expected\n";
|
|
print STDERR "found : $md5found\n";
|
|
return 0;
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
# Install given package
|
|
sub installpkg {
|
|
my ($upgrade, $pkgname) = @_;
|
|
my $aa = $aargs." ";
|
|
if ($prepostread{$pkgname} =~ m/:yes$/) {$readmetasks{$pkgname} = 1};
|
|
$pptasks{$pkgname} = "";
|
|
if ($force){$aa = $aa."-f ";}
|
|
if ($root ne "") {$aa = $aa."-r ".$root." ";}
|
|
if ($install_scripts and $prepostread{$pkgname} =~ m/^yes/) {doscript("pre",$pkgname);}
|
|
print "pkg-get: /usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}\n";
|
|
system ("/usr/bin/pkgadd $upgrade $aa$fullpath{$pkgname}") == 0 or return 0;
|
|
if ($install_scripts and $prepostread{$pkgname} =~ m/:yes:/) {doscript("post",$pkgname);}
|
|
return 1;
|
|
}
|
|
|
|
# Execute pre- or post-install script
|
|
sub doscript {
|
|
my ($when, $pkgname) = @_;
|
|
my $path = $fullpath{$pkgname};
|
|
$path =~ s/[^\/]*$//;
|
|
my $cmd = ($root ne "") ? "chroot $root " : "";
|
|
$cmd .= "/bin/bash $path/PKGINST $pkgname $when";
|
|
if ((-e "$root$path/PKGINST") and (system($cmd) == 0)) {
|
|
$pptasks{$pkgname} .= " [$when: ok]";
|
|
} else {
|
|
$pptasks{$pkgname} .= " [$when: failed]";
|
|
}
|
|
}
|
|
|
|
############################################################################
|
|
# Main functions (commands)
|
|
############################################################################
|
|
|
|
# No pun intended ##########################################################
|
|
sub version {
|
|
print "pkg-get $VERSION 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/readme/path for specific packages ####################################
|
|
sub info {
|
|
my ($type, @args) = @ARGV;
|
|
(%repver) or load_repos();
|
|
($type ne "info") or load_depmap();
|
|
foreach my $arg (@args) {
|
|
($fullpath{$arg}) or next;
|
|
if ($type eq "info") {
|
|
printinfo($arg);
|
|
} elsif ($type eq "readme") {
|
|
printreadme($arg);
|
|
} else {
|
|
my $path = $fullpath{$arg};
|
|
$path =~ s/[^\/]*$//;
|
|
print $path . "\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
# List packages containing given string (name/description) #################
|
|
sub search {
|
|
my $arg = $ARGV[1];
|
|
my $parsetype = ($ARGV[0] =~ /^d/) ? "full" : "light";
|
|
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($parsetype,$_, $dir, $url);
|
|
next if ($found{$pkg{'name'}});
|
|
(index($pkg{'name'}, $arg) < 0) or ($parsetype eq "full") or $found{$pkg{'name'}} = 1;
|
|
($parsetype ne "full") 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 ##############################################
|
|
# (requires a previous run of load_repos)
|
|
sub list {
|
|
(%repver) or load_repos();
|
|
foreach my $key(sort keys %repver) { print "$key\n"; }
|
|
}
|
|
|
|
# Remove given packages ####################################################
|
|
sub remove {
|
|
$curraction = "removed";
|
|
shift(@ARGV);
|
|
my $cmd = "/usr/bin/pkgrm";
|
|
$cmd .= " -r $root" if ($root ne "");
|
|
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 (! %instver);
|
|
foreach my $key (sort keys %instver) { print "$key\n"; }
|
|
}
|
|
|
|
# Print package version, or install status #################################
|
|
sub current {
|
|
getinstalled() if (! %instver);
|
|
my $type = shift(@ARGV); my $result;
|
|
foreach my $pkg(@ARGV) {
|
|
if ($instver{$pkg}) {
|
|
$result = ($type eq "current") ? ": version $instver{$pkg}\n"
|
|
: " is installed\n";
|
|
} else {
|
|
$result = " not installed\n";
|
|
}
|
|
print "Package " . $pkg . $result;
|
|
}
|
|
}
|
|
|
|
# Lock given packages ######################################################
|
|
sub dolock {
|
|
shift(@ARGV);
|
|
open(LCK, ">> $LOCKFILE") or exiterr("could not write to lock file");
|
|
foreach my $arg(@ARGV) {
|
|
if ($locked{$arg}) {
|
|
print "Already locked: $arg\n"; next;
|
|
}
|
|
print LCK "$arg\n";
|
|
}
|
|
close(LCK);
|
|
}
|
|
|
|
# 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 %printed;
|
|
my $fmt = $ARGV[1];
|
|
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("full",$_, $dir, $url);
|
|
next if ($printed{$pkg{'name'}});
|
|
(! $filter) or $filter =~ s/\*/\.\*/;
|
|
if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
|
|
$printed{$pkg{'name'}} = 1; next;
|
|
}
|
|
my $printstring = $fmt;
|
|
$printstring =~ s|%n|$pkg{'name'}|;
|
|
$printstring =~ s|%p|$pkg{'path'}|;
|
|
$printstring =~ s|%v|$pkg{'version'}|;
|
|
$printstring =~ s|%r|$pkg{'release'}|;
|
|
$printstring =~ s|%d|$pkg{'description'}|;
|
|
$printstring =~ s|%u|$pkg{'url'}|;
|
|
$printstring =~ s|%R|$pkg{'readme'}|;
|
|
$printstring =~ s|%E|$pkg{'pre_install'}|;
|
|
$printstring =~ s|%O|$pkg{'post_install'}|;
|
|
$printstring =~ s|%M|None|; # for prt-get compatibility
|
|
$printstring =~ s|%P|None|; # for prt-get compatibility
|
|
$printstring =~ s|\\n|\n|;
|
|
$printstring =~ s|\\t|\t|;
|
|
if (index($printstring,"%e") >=0) {
|
|
my $deps = $depmap{$pkg{'name'}};
|
|
$printstring =~ s|%e|$deps|;
|
|
}
|
|
if (index($printstring,"%l") >=0) {
|
|
my $locked = ($locked{$pkg{'name'}}) ? "yes" : "no";
|
|
$printstring =~ s|%l|$locked|;
|
|
}
|
|
if (index($printstring,"%i") >=0) {
|
|
(%instver) or getinstalled();
|
|
my $inst = ($instver{$pkg{'name'}}) ? "yes" : "no";
|
|
($inst eq "no") or
|
|
($instver{$pkg{'name'}} eq "$repver{$pkg{'name'}}")
|
|
or $inst = "diff";
|
|
$printstring =~ s|%i|$inst|;
|
|
}
|
|
print $printstring;
|
|
$printed{$pkg{'name'}} = 1;
|
|
}
|
|
close(REPO);
|
|
}
|
|
}
|
|
|
|
# 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";
|
|
(%instver) 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("full",$_, $dir, $url);
|
|
next if ( ($found{$pkg{'name'}}) or (! $instver{$pkg{'name'}}) );
|
|
next if ( ($locked{$pkg{'name'}}) and (! $all) );
|
|
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
|
|
($lastcol eq "locked") or $lastcol = ($instver{$pkg{'name'}}
|
|
eq $pkg{'version'}."-".$pkg{'release'}) ? "uptodate" :
|
|
$pkg{'version'}."-".$pkg{'release'};
|
|
push @multip, "$pkg{'name'}^$instver{$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("full",$_, $dir, $url);
|
|
$found{$pkg{'name'}} .= "###$pkg{'path'}/$pkg{'name'}#"
|
|
. "$pkg{'version'}-$pkg{'release'}"
|
|
. ".pkg.tar.$pkg{'compression'}";
|
|
}
|
|
close(REPO);
|
|
}
|
|
foreach my $key (sort keys %found) {
|
|
my $value = $found{$key};
|
|
$value =~ s/^\#\#\#//;
|
|
(index($value, "###") > 0) or next;
|
|
print "* $key\n";
|
|
foreach my $dup(split(/\#\#\#/, $value)) { print " $dup\n"; }
|
|
}
|
|
}
|
|
|
|
# Show list of dependencies for package ####################################
|
|
sub depends {
|
|
my ($j, $type) = ($ARGV[0] =~ /^quick/) ? (" ","quick") : ("\n","full");
|
|
($type eq "quick") or (%instver) or getinstalled();
|
|
(%repver) or load_repos();
|
|
my @args = @ARGV; shift @args;
|
|
my @result=deporder($type,@args) or exiterr("package '$ARGV[1]' not found");
|
|
(! @result) or ($type = "quick") or print "-- dependencies ([i] = installed, [u] = updatable)\n";
|
|
foreach my $res (@result) { print $res . $j; }
|
|
($type ne "quick") or print "\n";
|
|
}
|
|
|
|
# Show packages directly depending from given package ######################
|
|
sub dependent {
|
|
my $arg = $ARGV[1]; my %dp;
|
|
getinstalled() unless (($all) or (%instver));
|
|
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 (! $instver{$res}));
|
|
}
|
|
}
|
|
|
|
# Install or update given package ##########################################
|
|
sub upinst {
|
|
my ($cmd, @args) = @_; my $aa;
|
|
($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");
|
|
|
|
if ($root ne "") {
|
|
foreach my $repo(@repos) {
|
|
my ($dir, $url) = split(/\|/, $repo);
|
|
( -e "$root$dir" ) or make_path("$root$dir");
|
|
( -d "$root$dir" ) or next;
|
|
open(my $host, "$dir/PKGINST") or next;
|
|
open(my $mount, ">$root$dir/PKGINST");
|
|
while (<$host>) { print $mount $_; }
|
|
close($mount);
|
|
close($host);
|
|
}
|
|
}
|
|
|
|
getinstalled() if (! %instver);
|
|
load_repos() if (! %repver);
|
|
|
|
foreach my $pkgname(@args) {
|
|
my $failed=0;
|
|
if (not $repver{$pkgname}) {
|
|
push(@failtasks, "not found,$pkgname");
|
|
} elsif ( ($cmd . $shortstatus{$pkgname})
|
|
=~ /^(update. |install.u|install.i)/ ) {
|
|
push(@prevtasks, "$pkgname");
|
|
} elsif ( (($cmd . $shortstatus{$pkgname}) =~ /^update.i/) and (! $force_reinst) ) {
|
|
push(@prevtasks, "$pkgname");
|
|
} elsif (downloadpkg($pkgname)) {
|
|
($download_only) or installpkg($aa, $pkgname) or $failed=1;
|
|
($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
|
|
: push(@donetasks, $pkgname);
|
|
} else {
|
|
push(@failtasks, "where download failed,$pkgname");
|
|
}
|
|
}
|
|
printresults();
|
|
}
|
|
|
|
# Install given package, along with dependencies ###########################
|
|
sub depinst {
|
|
my @toinst;
|
|
$curraction = "installed";
|
|
my @args = @ARGV; shift(@args);
|
|
getinstalled() if (! %instver);
|
|
(%repver) or load_repos();
|
|
|
|
my @maybeinst = deporder("quick",@args);
|
|
foreach my $pkg (@maybeinst) {
|
|
next if (($locked{$pkg}) or (! $repver{$pkg}));
|
|
if (! $instver{$pkg}) {
|
|
push(@toinst, $pkg);
|
|
}
|
|
}
|
|
upinst("install",@toinst) if (@toinst);
|
|
}
|