pkg-get: change some function signatures

pkg-repgen: avoid losing metadata in pkg_single()

update TODO and README
This commit is contained in:
John McQuah 2023-06-22 11:10:24 -04:00
parent 252c46d87e
commit 5d700a78e9
4 changed files with 114 additions and 102 deletions

46
README
View File

@ -67,8 +67,8 @@ repository and html index are sorted lexographically according to the
current setting for $LANG. When multiple versions of a package are found
within the active collections, pkg-get will install the latest version in
the first collection that contains any such package. This behaviour is akin
to how prt-get handles dups, but with additional logic to account for dups
within the same collection.
to how prt-get handles dups, but with additional logic to account for
different versions of the built package within the same collection.
'pkg-get depends' and 'prt-get quickdep' do not handle more than one port,
unlike the corresponding commands in prt-get. Therefore it is not as
@ -77,22 +77,21 @@ before running a 'depinst' operation with multiple targets.
The limitation above would have been mitigated by a --test switch.
Alas, such a switch is also absent from the design of pkg-get. Use
the --test switch with prt-get itself, for the closest approximation
of previewing the outcome from a 'pkg-get depinst' operation.
the --test switch with prt-get itself, for the closest preview
of what would happen during a 'pkg-get depinst' operation.
'pkg-get dependent' does not support the --recursive option. Other
useful prt-get commands (grpinst, fsearch, deptree, listorphans, ls,
cat, edit, cache) have no counterpart in pkg-get. Of these omissions,
only the 'grpinst' command is of possible interest for binary package
management; the unimplemented commands and options are just as easily
delegated to prt-get itself. If you want a Perl implementation that does
provide these missing commands, consider the script written by user
farkuhar [1].
management; the unimplemented commands and options are better handled
by prt-get itself. If you want a Perl implementation that does provide
these missing commands, consider the script written by user farkuhar [1].
pkg-get only makes use of the hard dependencies listed by the port
maintainer, not any of the eager linking that might have occurred on the
build machine. As a result, 'pkg-get depinst foo' might omit some of the
packages needed by 'foo'. User ppetrov^ has contributed some helper scripts
build machine. As a result, 'pkg-get depinst $foo' might omit some of the
packages needed by $foo. User ppetrov^ has contributed some helper scripts
to facilitate the fixing of these broken binaries; visit the site [2] to
download them.
@ -104,23 +103,28 @@ operation). You can work around these omissions by avoiding 'depinst'
entirely, and manually performing the desired 'install' transactions (once
you have a clear sense of what the actual runtime dependencies are).
These gaps in pkg-get's design highlight an awkward fact about trying to erect
an infrastructure for binary package management upon a foundation designed for
compiling source code (the ports tree). Inheriting the Pkgfile's lack of
separation between build-time and runtime dependencies, pkg-get will unwittingly
recurse through all the dependencies (in a 'depinst' transaction) and install
packages that you might not really need. Hence the suggestion to consider
avoiding 'depinst', running only 'install' and the helper script written
by ppetrov^ [2].
These gaps in pkg-get's design highlight an awkward fact about trying to
erect an infrastructure for binary package management upon a foundation
designed for compiling source code (the ports tree). Inheriting the
Pkgfile's lack of separation between build-time and runtime dependencies,
pkg-get will unwittingly recurse through all the dependencies (in a 'depinst'
transaction) and install packages that you might not really need. Hence the
suggestion to consider avoiding 'depinst'. But pairing 'install' with the
helper script written by ppetrov^ [2] might not be enough to ensure zero
breakage, since revdep does not detect every runtime dependency. In the
end, you might have to manually interpolate between the (maximal) footprint
recommended by 'pkg-get depinst' and the (minimal) footprint recommended by
'revlibpkg' [2].
In handling any new hard dependencies added by the maintainer since
the previous version of a package, pkg-get performs a sysup in the same
manner as the original prt-get (i.e., new dependencies are not injected
by default). With binary packages there's no need to carry out the
installation in any particular order, so the lack of dependency injection is
actually less of a problem for pkg-get than it was for prt-get. Running
ppetrov^'s script [2] should help identify the packages you will need to
install to fix any breakage.
actually less of a problem for pkg-get than it was for prt-get. Combining
'pkg-get depends $foo | grep "\[ \]"' with the output of 'revlibpkg $foo'
should help identify the packages you will need to install to fix any
breakage in $foo.
[1] https://git.sdf.org/jmq/Documentation/src/branch/master/scripts/prt-auf
[2] https://github.com/slackalaxy/depsck

10
TODO
View File

@ -8,13 +8,13 @@ TODO file for pkg-get
- allow 'depends' and 'quickdep' to process multiple arguments
- allow 'sysup' to inject new dependencies
- add a --test switch (?)
- let the user control whether pkg-repgen prints the metadata only for the
latest built package, or for all the versions in the directory
- add support for aliases (?)
- allow 'sysup' to inject new dependencies (?)
- add a --test switch (?)
- add an --ignore switch (?)
- switch from MD5 to a different hash function (?)

View File

@ -80,7 +80,7 @@ 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 =~ /^(depends|quickdep)$/) { depends($1); last SWITCH; }
if ($command =~ /^(install|update)$/) { upinst(@ARGV); last SWITCH; }
if ($command eq "dependent") { dependent(); last SWITCH; }
if ($command eq "depinst") { depinst(); last SWITCH; }
@ -150,20 +150,19 @@ sub readconfig {
# Populate a hash of locked packages
sub get_locked {
open (my $fL, $LOCKFILE) or return;
while (<$fL>) { $locked{$_} = 1; }
while (<$fL>) { chomp; $locked{$_} = 1; }
close ($fL);
}
# Parse a line describing a package
sub parsepackage {
my @p = split(/\:/, $_[0]);
my $type=shift; 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.*//;
my ($N, $V) = ($p[0] =~ m/(.*)\#(.*\.pkg\.tar.*)/) ? ($1, $2) : ("","");
($type ne "light") or return ('name' => $N);
my $R = ($V =~ m/^.*-(\w*)\.pkg\.tar.*/) ? $1 : 0;
$V =~ s/-\w*\.pkg\.tar.*//;
my %pkg = ( 'name' => $N, 'version' => $V, 'release' => $R);
if (not $_[2]) {$_[2] = $_[1]};
$pkg{'path'} = $_[1];
$pkg{'url'} = $_[2];
@ -178,15 +177,6 @@ sub parsepackage {
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 = @_;
@ -252,11 +242,10 @@ sub printresults {
my $action;
my $pkg;
my @readme;
my $goterror = 0;
if (@donetasks) {
@readme = grep { ($readmetasks{$_}) } @donetasks;
print "\n-- Packages $okaction\n";
foreach my $task(@donetasks) {
if ($readmetasks{$task}) {push(@readme, $task)}
print "$task" . $pptasks{$task}."\n";
}
}
@ -280,20 +269,17 @@ sub printresults {
}
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"
print join(", ",@readme);
print "\n";
}
(! @donetasks) or (@failtasks) or ($_[0]) or
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);
open(DB, $PKGDB) or exiterr("could not open ".$PKGDB);
while (<DB>) {
my ($name, $version, @files) = split /\n/, $_;
$installed{$name} = $version;
@ -346,7 +332,7 @@ sub getpackage {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url);
my %pkg = parsepackage("full",$_, $dir, $url);
next if ($pkg{'name'} ne $pkgname);
$found = 1;
push @maybe, join("^", $pkg{'path'}, $pkg{'url'},
@ -439,25 +425,20 @@ sub installpkg {
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);}
if ($root) {$aa = $aa."-r ".$root." ";}
if ($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);}
if ($install_scripts or $post_install) {doscript("post",%pkg);}
return 1;
}
# Execute pre- or post-install script
sub doscript {
my ($when, %pkg) = @_;
($pkg{$when . "_install"} eq "yes") or return;
my $cmd = ($root) ? "chroot $root " : "";
$cmd .= "/bin/bash $pkg{'path'}/PKGINST $pkg{'name'} $when";
if (system($cmd) == 0) {
@ -473,8 +454,7 @@ sub doscript {
# No pun intended ##########################################################
sub version {
print "pkg-get $VERSION ";
print "by Simone Rota <sip\@varlock.com>\n";
print "pkg-get $VERSION by Simone Rota <sip\@varlock.com>\n";
}
# Show brief help ##########################################################
@ -534,7 +514,7 @@ sub info {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url);
my %pkg = parsepackage("full",$_, $dir, $url);
if ($pkg{'name'} eq $arg) {
($type ne "info") or printinfo(%pkg);
($type ne "readme") or printreadme(%pkg);
@ -550,18 +530,19 @@ sub info {
# List packages containing given string (name/description) #################
sub search {
my $arg = $ARGV[1];
my $type = ($ARGV[0] =~ /^d/) ? "desc" : "name";
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($_, $dir, $url);
my %pkg = parsepackage($parsetype,$_, $dir, $url);
next if ($found{$pkg{'name'}});
(index($pkg{'name'}, $arg) < 0) or $found{$pkg{'name'}} = 1;
(! $found{$pkg{'name'}}) or ($found{$pkg{'name'}}==1)
or ($type ne "desc") or (index($pkg{'description'}, $arg) < 0)
or ($parsetype ne "full")
or (index($pkg{'description'}, $arg) < 0)
or $found{$pkg{'name'}} = 1;
}
close(REPO);
@ -579,7 +560,7 @@ sub list {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url);
my %pkg = parsepackage("light",$_, $dir, $url);
$found{$pkg{'name'}} = 1;
}
close(REPO);
@ -638,7 +619,7 @@ sub dolock {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackagelight($_);
my %pkg = parsepackage("light",$_);
if ($pkg{'name'} eq $arg) {
$found = 1;
open(LCK, ">> $LOCKFILE")
@ -684,7 +665,7 @@ sub doprintf {
open(REPO, "$dir/PKGREPO") or exiterr("could not open $dir/PKGREPO");
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url);
my %pkg = parsepackage("full",$_, $dir, $url);
next if ($found{$pkg{'name'}});
(! $filter) or $filter =~ s/\*/\.\*/;
if (($filter) and ($pkg{'name'} !~ /^$filter$/)) {
@ -727,7 +708,7 @@ sub diff {
my @multip=();
while (<REPO>) {
chomp;
my %pkg = parsepackage($_, $dir, $url);
my %pkg = parsepackage("full",$_, $dir, $url);
next if ( ($found{$pkg{'name'}}) or (! $installed{$pkg{'name'}}) );
next if ( ($locked{$pkg{'name'}}) and (! $all) );
my $lastcol = ($locked{$pkg{'name'}}) ? "locked" : "";
@ -740,7 +721,6 @@ sub diff {
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;
@ -769,19 +749,19 @@ sub dup {
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'};
my %pkg = parsepackage("full",$_, $dir, $url);
$found{$pkg{'name'}} .= "###$pkg{'path'}/$pkg{'name'}#"
. "$pkg{'version'}-$pkg{'release'}"
. ".pkg.tar.$compress";
}
close(REPO);
}
foreach my $key (sort keys %found) {
my $value = $found{$key};
$value =~ s/^\#\#\#//;
if (rindex($value, "###") >=0){
(index($value, "###") > 0) or next;
print "* $key\n";
my @d = split(/\#\#\#/, $value);
foreach my $dup(@d){ print " $dup\n"; }
}
foreach my $dup(split(/\#\#\#/, $value)) { print " $dup\n"; }
}
}
@ -790,7 +770,7 @@ 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"}
(! @dependencies) or (! $checkver) or print "-- dependencies ([i] = installed, [u] = updatable)\n";
print join($j, @dependencies);
if ((%missingdeps) and ($j ne " ")) {
print "\n-- missing packages\n";
@ -803,8 +783,7 @@ sub depends {
# Show packages directly depending from given package ######################
sub dependent {
my $arg = $ARGV[1];
my %dp;
my $arg = $ARGV[1]; my %dp;
getinstalled() unless (($all) or (%installed));
foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo);
@ -832,18 +811,31 @@ sub upinst {
my ($cmd, @args) = @_; my $aa;
($curraction, $aa) = ($cmd =~ /^up/) ? ("updated","-u") : ("installed","");
if ($root) {
foreach my $repo(@repos) {
my ($dir, $url) = split(/\|/, $repo);
open(my $host, "$dir/PKGINST") or next;
open(my $mount, ">$root$dir/PKGINST");
while (<$host>) { print $mount $_; }
close($mount);
close($host);
}
}
getinstalled() if (! %installed);
foreach my $pkgname(@args) {
my %pkg = getpackage($pkgname);
my %pkg = getpackage($pkgname); my $failed=0;
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);
} elsif (downloadpkg(%pkg)) {
($download_only) or installpkg($aa, %pkg) or $failed=1;
($failed == 1) ? push(@failtasks, "where $cmd failed,$pkgname")
: push(@donetasks, $pkgname);
} else {
push(@failtasks, "where $cmd failed,$pkgname");
push(@failtasks, "where download failed,$pkgname");
}
}
printresults();

View File

@ -36,7 +36,6 @@ if ($#ARGV >= 0) { # single packages
foreach my $name (sort @ARGV) {
my @hits = glob("$name#*.pkg.tar.$compress");
push(@packages,@hits);
$isDup{$name} = 1 if ($#hits > 0);
}
} else {
@packages = @dirlist;
@ -48,7 +47,7 @@ our %pname = map { $_ => $_ } @packages;
foreach my $p (@packages) { $pname{$p} =~ s/\#.*//; }
# ... or to look up the successor when merging old metadata files
my %followR; my %followH; my @queue = @packages;
my %followR; my %followH; my %followD; my @queue = @packages;
while (my $q = shift @queue) {
($#queue < 0) or ($pname{$q} ne $pname{$queue[0]}) or $isDup{$q} = 1;
}
@ -99,17 +98,18 @@ sub pkg_single {
print "+ Updating specified entries in $mf\n";
}
while (my $p =shift @packages) {
PACKAGE: while (my $p =shift @packages) {
my ($pver, $url, $du, $md5, $desc, $ppr, $pdeps, $date) = metadata($p);
($firstrun{"PKGREPO"}==0) or printf $nR "%-s:%-s:%-s:%-s:%-s\n",
$p, $du, $md5, $desc, $ppr;
($firstrun{"PKGDEPS"}==0) or ($pdeps eq "")
($firstrun{"PKGDEPS"}==0) or ($pdeps eq "") or ($isDup{$p})
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
if ($firstrun{"index.html"} == 1) {
$count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
}
($firstrun{"PKGREPO"}*$firstrun{"PKGDEPS"}*$firstrun{"index.html"}==0) or next PACKAGE;
# Pop entries from the old repository until we reach an entry
# that would come after the current package.
@ -131,6 +131,10 @@ sub pkg_single {
last if ($oname ge $pname{$p});
}
# if the current package comes after everything in the old repository,
# just append its metadata
($followR{$pname{$p}}) or printf $nR "%-s:%-s:%-s:%-s:%-s\n", $p, $du, $md5, $desc, $ppr;
# Likewise for the html index
while ( ($firstrun{"index.html"}==0) and $oline=<$oH> ) {
chomp($oline);
@ -149,8 +153,13 @@ sub pkg_single {
last if ($oname ge $pname{$p});
}
if (! $followH{$pname{$p}}) {
$count++;
htmlrow($nH,$count,$pname{$p},$url,$pver,$desc,$date);
}
# Likewise for the dependency map, but avoid creating duplicate entries
while ($firstrun{"PKGDEPS"}==0 and $oline = <$oD>) {
while ( ($firstrun{"PKGDEPS"}==0) and $oline = <$oD> ) {
chomp($oline); $oname = $oline;
$oname =~ s/\s*\:.*//;
if ($oname lt $pname{$p}) {
@ -158,19 +167,26 @@ sub pkg_single {
} elsif ( ($pdeps ne "") and (! $isDup{$p}) ) {
printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
}
printf $nD "$oline\n" if ($oname gt $pname{$p});
if ($oname gt $pname{$p}) {
$followD{$pname{$p}} = $oline;
print $nD "$oline\n";
}
last if ($oname ge $pname{$p});
}
# if the current package comes after everything in the old depmap,
# just append its metadata
($followD{$pname{$p}}) or ($isDup{$p}) or ($pdeps eq "")
or printf $nD "%-30s : %-s\n", $pname{$p}, $pdeps;
# after reaching the last in a sequence of dups, copy the
# successor line from the old {html index, repository}
if ( (! $isDup{$p}) and ($isDup{$pname{$p}}) and ($followH{$pname{$p}}) ) {
if ( (! $isDup{$p}) and ($followH{$pname{$p}}) ) {
$count++;
$followH{$pname{$p}} =~ s/class="(even|odd)"/class="$parity{($count %2)}"/;
print $nH $followH{$pname{$p}};
}
($isDup{$p}) or (! $isDup{$pname{$p}}) or (! $followR{$pname{$p}})
or print $nR $followR{$pname{$p}};
($isDup{$p}) or (! $followR{$pname{$p}}) or print $nR $followR{$pname{$p}};
# Restart the loop with the next package in the queue
}