This patch addresses the design flaw pointed out by Vitaly in 2016,
where two independent interpreters were reading the same file(s)
and coming to different conclusions about the location of the built
package. The coupling between programs is now much more fragile,
though. Only by ensuring stability of the user-facing layer
(specifically how the success of a build is reported) can we guarantee a
regex match with the current pattern. Changes to the user-facing layer
of pkgmk will require corresponding changes to the regex matching here.
Commit 4145a63e (delegate to pkgmk) also addressed the problem of two
independent parsers, but that solution is no longer viable when pkgmk is
invoked under rootlesskit. Defining in /etc/prt-get.conf the line
"addcommand doas /usr/bin/pkgadd" leads to problems when pkgmk inside a
user namespace is told to run this addcommand on the built package.
Specifically, inside the user namespace the file /etc/doas.conf appears
to have the wrong owner. Rather than fiddle with /etc/subuid and
/etc/subgid to fix the apparent owner, it seems more viable in the long
run to revert the delegate-to-pkgmk solution, and move the eventual
pkgadd invocation back to the parent process.
1009 lines
40 KiB
Perl
Executable File
1009 lines
40 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# prt-auf --- add/update frontend to CRUX pkgutils (offers mostly the same
|
|
# user experience as prt-get except for the slight delay
|
|
# entailed by Perl having to compile this file on startup)
|
|
#
|
|
# distributed under the same license as the pkgutils,
|
|
# https://crux.nu/gitweb/?p=tools/pkgutils.git;a=blob_plain;f=COPYING;hb=HEAD
|
|
#
|
|
use warnings;
|
|
use strict;
|
|
|
|
################### Initialize global variables #######################
|
|
my $title="prt-auf"; my $version=0.51; my $cache_ver="V5.1";
|
|
my $CONFDIR="/var/lib/pkg"; my $prtalias="/etc/prt-get.aliases";
|
|
my $pkgdb="$CONFDIR/db"; my $prtlocker="$CONFDIR/prt-get.locker";
|
|
my $prtcache="$CONFDIR/prt-get.cache"; my $altroot=""; my %LOCKED; my %ALIASES;
|
|
my @allports; my %V_REPO; my %V_INST; my %DESC; my %DEPENDS; my %SOFTDEPS;
|
|
my @results; my $strf; my $ind; my $hh; my $portpath; my $built_pkg;
|
|
my %osearch = ( cache=>0, regex=>0, path=>0, exact=>0, verbose=>0 );
|
|
my %odepends = ( inject=>1, soft=>0, tree=>0, recursive=>0, all=>0 );
|
|
my %opkg = ( margs=>"", aargs=>"", rargs=>"", run_scripts=>"no",
|
|
pre_install=>"no", post_install=>"no", scriptcommand=>"/bin/sh",
|
|
removecommand=>"/usr/bin/pkgrm", addcommand=>"/usr/bin/pkgadd",
|
|
makecommand=>"/usr/bin/pkgmk", nolock=>0, test=>"no", group=>"no" );
|
|
my %olog = ( write => "disabled", mode => "overwrite", rm_on_success => "yes",
|
|
rm_on_uninst => "no", file => "/var/log/pkgbuild/%n.log" );
|
|
my $prtconf = "/etc/prt-get.conf";
|
|
|
|
################### Process the given command #########################
|
|
my ($action, @query) = parse_args(@ARGV);
|
|
if ($0 =~ /cache$/) { $osearch{cache} = 1; }
|
|
if (($0 =~ /cache$/) and ($action eq "cache")) {
|
|
print "cannot create cache from a cache!\nUse $title instead.\n";
|
|
exit 0;
|
|
}
|
|
my @bldirs = parse_prt_conf($prtconf);
|
|
my @basedirs = @{$bldirs[0]}; my @localports = @{$bldirs[1]};
|
|
|
|
# load some data structures into memory for the actions that need them
|
|
|
|
get_locked_and_aliased();
|
|
|
|
if (($action !~ /^(fsearch|isinst|current|sync)$/) and ($osearch{cache}==0)) {
|
|
@allports = list_ports();
|
|
fill_hashes_from_pkgfiles();
|
|
}
|
|
if ($osearch{cache}==1) { fill_hashes_from_cache(); }
|
|
|
|
if ($action !~ /^(search|dsearch|fsearch|info|dup|ls|readme|cat|sync)$/) {
|
|
open (DB, "$altroot$pkgdb") or die "Could not open package database!\n";
|
|
local $/="";
|
|
while (<DB>) { $V_INST{$1} = $2 if m/^(.*)\n(.*)\n/; }
|
|
close (DB);
|
|
}
|
|
|
|
############## Branch based on the requested action #################
|
|
|
|
if ($action eq "path") { @results = find_port_by_name($query[0],1,1,0);
|
|
} elsif ($action eq "search") { @results = find_port_by_name(@query,0,$osearch{path},1);
|
|
} elsif ($action eq "fsearch") { $hh = find_port_by_file(".footprint", @query);
|
|
} elsif ($action eq "dsearch") { @results = find_port_by_desc(@query);
|
|
} elsif ($action eq "info") { $portpath = find_port_by_name(@query,1,1,0);
|
|
@results = get_pkgfile_fields($portpath,"all") if ($portpath);
|
|
} elsif ($action eq "cache") { printf_ports("CACHE",@allports);
|
|
} elsif ($action eq "printf") { @results = ($osearch{filter}) ?
|
|
find_port_by_name($osearch{filter},0,1,1) : @allports;
|
|
printf_ports($query[0],@results);
|
|
} elsif ($action eq "lock") { port_lock(@query);
|
|
} elsif ($action eq "unlock") { port_unlock(@query);
|
|
} elsif ($action eq "ls") { port_ls(@query);
|
|
} elsif ($action =~ /^(cat|edit|readme)$/) { port_edit($1,@query);
|
|
} elsif ($action =~ /^(depends|quickdep)$/) { @results=deporder($1,@query);
|
|
} elsif ($action =~ /^dep(endent|tree)$/) { @results=list_ports($action,@query);
|
|
} elsif ($action eq "install") { @results = up_inst(@query);
|
|
} elsif ($action eq "dup") { $ind=find_dups(@query);
|
|
} elsif ($action eq "remove") { $ind=uninstall(@query);
|
|
} elsif ($action eq "sync") { sync(@query);
|
|
} elsif ($action =~ /^(isinst|current|sysup)$/) { ($ind, @results) = port_diff($1,@query);
|
|
} elsif ($action =~ /(.*)diff$/) { ($ind, @results) = port_diff($1);
|
|
} elsif ($action =~ /^list(.*)/) { @results = list_ports($1,@query);
|
|
} elsif ($action eq "help") { print_help();
|
|
} elsif ($action eq "version") { print "$title $version\n";
|
|
} else { printf "Unsupported command '$action'.\n"; }
|
|
|
|
#################### Post-transaction reports #######################
|
|
$strf = "%s\n";
|
|
if (($action =~ /^(listinst|listorphans|dependent)/)
|
|
and ($odepends{tree}==0)) {
|
|
foreach my $result (sort @results) {
|
|
$result = ($osearch{verbose}==1) ? " $result: $V_INST{$result}" : " $result";
|
|
$result = ($osearch{verbose}>1) ? " $result: $V_INST{$result}\n$DESC{$result}\n" : $result;
|
|
printf $strf, $result;
|
|
}
|
|
} elsif ($action =~ /^(list|search|dsearch|path)/) {
|
|
foreach my $result (@results) {
|
|
next if ((! $result) or ($result =~ /^\s*$/));
|
|
$result =~ s/.*\/(.*)$/$1/ if (($action ne "path") and ($osearch{path}==0));
|
|
$result .= " $V_REPO{$result}" if (($osearch{verbose}==1) and ($action ne "path"));
|
|
$result .= " $V_REPO{$result}\n$DESC{$result}\n" if (($osearch{verbose}>1) and ($action ne "path"));
|
|
printf $strf, $result;
|
|
}
|
|
} elsif ($action =~ /^(fsearch)/) {
|
|
my %hits = %{$hh}; $strf = "%20s %s\n"; my @fmatch;
|
|
printf $strf, "Found in", "Matching File" if (%hits);
|
|
foreach my $fh (keys %hits) {
|
|
chomp($hits{$fh});
|
|
@fmatch = split /\s/, $hits{$fh};
|
|
foreach my $fileN (@fmatch) { printf $strf, $fh, $fileN; }
|
|
}
|
|
} elsif ($action =~ /^(current|isinst|dup|diff|quickdiff)$/) {
|
|
my $format = "%20s %15s %20s\n";
|
|
if ($ind == 0) {
|
|
($action !~ /diff$/) or print "No differences found\n";
|
|
($action =~ /^(current|isinst)/) or exit 0;
|
|
} elsif ($action eq "diff") {
|
|
printf $format, "Port", "Installed", "Available in Repo"
|
|
}
|
|
foreach (@results) {
|
|
if ($action =~ /^(current|isinst)$/) { print "$_\n"; next; }
|
|
my ($diffN, $diffI, $diffR) = split / /;
|
|
next if (($osearch{filter}) and ($diffN !~ /$osearch{filter}/));
|
|
next if (($LOCKED{$diffN}) and ($odepends{all}==0));
|
|
$diffR = ($LOCKED{$diffN}) ? "LOCKED" : $diffR;
|
|
printf "$format", $diffN, $diffI, $diffR if ($action eq "diff");
|
|
printf "%s ", $diffN if ($action eq "quickdiff");
|
|
}
|
|
print "\n" if ($action eq "quickdiff");
|
|
exit $ind;
|
|
} elsif ($action =~ /^(depends|quickdep)$/) {
|
|
print "-- dependency list ([i] = installed, [u] = updateable)\n" if ($action =~ /^dep/);
|
|
my $strf="%3s %s\n"; my $dep; my $missing=0;
|
|
foreach $dep (@results) {
|
|
if ($dep =~ /MISSING/) {
|
|
$missing=1; print "-- missing packages\n"; next;
|
|
}
|
|
next if (! $dep);
|
|
if ($action ne "quickdep") {
|
|
$ind = (grep { $_ eq $dep } keys %V_INST) ? "[i]" : "[ ]";
|
|
($ind eq "[ ]") or (! $V_REPO{$dep}) or ($V_REPO{$dep} eq $V_INST{$dep}) or $ind = "[u]";
|
|
$dep .= " $V_REPO{$dep}" if (($osearch{verbose}==1) and ($V_REPO{$dep}));
|
|
$dep .= " $V_REPO{$dep}\n$DESC{$dep}" if (($osearch{verbose}>1) and ($V_REPO{$dep}) and ($DESC{$dep}));
|
|
}
|
|
printf $strf, $ind, $dep unless ($action eq "quickdep");
|
|
printf "%s ", $dep if ($action eq "quickdep");
|
|
}
|
|
print "\n" if ($action eq "quickdep");
|
|
} elsif ($action eq "info") {
|
|
$strf = "%14s: %-s\n";
|
|
exit 1 if ($#results < 0);
|
|
my @fields = ("Name", "Repository", "Version", "Release", "Description",
|
|
"Dependencies", "URL", "Optional Deps", "Maintainer",
|
|
"Readme", "PreInstall", "PostInstall");
|
|
for (my $i=0; $i<9; $i++) {
|
|
printf $strf, $fields[$i], $results[$i]
|
|
unless ($results[$i] =~ /^\s*$/);
|
|
}
|
|
} elsif ($action eq "remove") {
|
|
my @removed = @$ind;
|
|
print "Ports removed:\n" if (@removed);
|
|
foreach my $p (@removed) { print "$p\n"; }
|
|
} elsif ($action =~ /^(install|sysup)$/) {
|
|
my @ok = @{$results[0]}; my %ok_pre = %{$results[1]};
|
|
my %ok_post = %{$results[2]}; my @ok_readme = @{$results[3]};
|
|
my @not_ok = @{$results[4]}; my @missing = @{$results[5]}; my $note;
|
|
if ($opkg{test} eq "yes") {
|
|
print "\n$action successful.\n" unless ((@not_ok) or (@missing));
|
|
print "*** prt-auf: test mode end\n\n";
|
|
}
|
|
if (($opkg{test} eq "no") and (@ok)) {
|
|
print "Successful ports:\n";
|
|
foreach my $k (@ok) {
|
|
$note = ($ok_pre{$k}) ? " pre: ok. " : "";
|
|
$note .= ($ok_post{$k}) ? " post: ok. " : "";
|
|
($note) ? print " $k ($note)\n" : print " $k\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
if (@ok_readme) {
|
|
print "Ports with README files:\n ";
|
|
print join("\n ", @ok_readme); print "\n";
|
|
}
|
|
if (@not_ok) {
|
|
print "Ports with pkgmk/pkgadd failures:\n ";
|
|
print join("\n ", @not_ok); print "\n";
|
|
}
|
|
if (@missing) {
|
|
print "Ports not found in the repositories:\n ";
|
|
print join("\n ", @missing); print "\n";
|
|
}
|
|
}
|
|
|
|
# Done!
|
|
|
|
#################### Begin Subroutines #######################
|
|
sub parse_args {
|
|
my @query;
|
|
while (my $arg = shift) {
|
|
if (! $action) {
|
|
if ($arg =~ /^(search|dsearch|fsearch|path|info|list|remove)$/) { $action = $1;
|
|
} elsif ($arg =~ /^(install|update|depinst)$/) { $action = "install";
|
|
} elsif ($arg eq "sysup") { $action = "sysup"; $opkg{nolock}=0;
|
|
} elsif ($arg eq "grpinst") { $action = "install"; $opkg{group} = "yes";
|
|
print "Warning: grpinst is obsolescent, using install --group\n";
|
|
} elsif ($arg =~ /^(lock|unlock|listlocked|current|isinst)$/) { $action = $1;
|
|
} elsif ($arg =~ /^(diff|quickdiff|printf|listinst|listorphans)$/) {
|
|
$action = $1; $odepends{tree} = 0;
|
|
} elsif ($arg =~ /^(depends|quickdep|dup|dependent|sync)$/) { $action = $1;
|
|
} elsif ($arg eq "deptree") { $action = $arg; $odepends{tree} = 1;
|
|
} elsif ($arg =~ /^(readme|cat|edit|ls|help|version|cache)$/) { $action = $1; }
|
|
} elsif ($arg eq "--tree") { $odepends{tree} = 1;
|
|
} elsif ($arg eq "--all") { $odepends{all} = 1;
|
|
} elsif ($arg eq "--nodeps") { $odepends{inject} = 0;
|
|
} elsif ($arg eq "--depsort") { $odepends{inject} = 1;
|
|
} elsif ($arg eq "--recursive") { $odepends{recursive} = 1;
|
|
} elsif ($arg eq "--cache") { $osearch{cache} = 1;
|
|
} elsif ($arg =~ /^--config=(.+)$/) { $prtconf = $1;
|
|
} elsif ($arg eq "--path") { $osearch{path} = 1;
|
|
} elsif ($arg eq "--regex") { $osearch{regex} = 1;
|
|
} elsif ($arg =~ /^--filter=(.+)/) { $osearch{filter} = $1;
|
|
} elsif ($arg eq "-v") { $osearch{verbose} += 1;
|
|
} elsif ($arg eq "-vv") { $osearch{verbose} += 2;
|
|
} elsif ($arg eq "--test") { $opkg{test} = "yes";
|
|
} elsif ($arg eq "--group") { $opkg{group} = "yes";
|
|
} elsif ($arg eq "--pre-install") { $opkg{pre_install} = "yes";
|
|
} elsif ($arg eq "--post-install") { $opkg{post_install} = "yes";
|
|
} elsif ($arg eq "--run-scripts") { $opkg{run_scripts} = "yes";
|
|
} elsif ($arg eq "--softdeps") { $odepends{soft} = "yes";
|
|
} elsif ($arg eq "-fr") { $opkg{margs} .= " -f"; $odepends{inject} = 0;
|
|
} elsif ($arg eq "-fi") { $opkg{aargs} .= " -f";
|
|
} elsif ($arg =~ /^(-uf|-if|-us|-is|-ns|-kw)$/) { $opkg{margs} .= " $1";
|
|
} elsif ($arg =~ /^--margs=(.+)/) { $opkg{margs} .= $1;
|
|
} elsif ($arg =~ /^--install-root=(.+)$/) { $altroot=$1;
|
|
} elsif ($arg =~ /^--aargs=(-r|--root)=(.+)/) { $altroot=$2;
|
|
} elsif ($arg =~ /^--rargs=(-r|--root)=(.+)/) { $altroot=$2;
|
|
} elsif ($arg =~ /^--aargs=(.+)/) { $opkg{aargs} .= " $1";
|
|
} elsif ($arg =~ /^--rargs=(.+)/) { $opkg{rargs} .= " $1";
|
|
} elsif ($arg =~ /^-/) {
|
|
print "'$arg' is not a recognized option.\n";
|
|
} else { push (@query, $arg); }
|
|
}
|
|
if (! $action) { print_help(); }
|
|
if (($#query > -1) and
|
|
($action =~ /^(diff|quickdiff|cache|sysup)/)) {
|
|
print "warning: $1 takes no arguments; ignoring those given.\n";
|
|
}
|
|
if (($#query > 0) and
|
|
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
|
|
print "warning: $1 takes only one argument; ignoring all but the first.\n";
|
|
}
|
|
if ((! @query) and
|
|
($action =~ /^(search|dsearch|fsearch|info|readme|path|ls)$/)) {
|
|
print "$1 requires an argument.\n"; exit 1;
|
|
}
|
|
if (($#query != 0) and
|
|
($action =~ /^(deptree|dependent)$/)) {
|
|
print "$1 requires exactly one argument.\n"; exit 1;
|
|
}
|
|
if (($#query < 0) and
|
|
($action =~ /^(install|update|depinst|remove)$/)) {
|
|
print "$1 requires at least one argument.\n"; exit 1;
|
|
}
|
|
if (($osearch{verbose} > 0) and ($action eq "dup")) {
|
|
push @query, "%n:\n%p1/%n %v1 > %p2/%n %v2";
|
|
}
|
|
return $action, @query;
|
|
}
|
|
|
|
sub parse_prt_conf {
|
|
my @basedirs; my @localports; my $conf = shift;
|
|
|
|
open(PORTS, $conf) or die "could not open $conf";
|
|
while (<PORTS>) { chomp;
|
|
if ( /^prtdir\s+/ ) {
|
|
my $line = $_;
|
|
$line =~ s/^prtdir\s+//; #remove the leading directive
|
|
$line =~ s/#.*$//; #strip inline comments like this one
|
|
$line =~ s/\s+//g; #collapse all whitespace, even if in a path!
|
|
if ( $line !~ /:/ ) {
|
|
push @basedirs, $line if (-d $line);
|
|
} else {
|
|
my @a = split(/:/, $line);
|
|
my @b = split(/,/, $a[1]);
|
|
while ( my $c = pop @b ) {
|
|
my $port = $a[0] . "/" . $c;
|
|
push @localports, $port if (-d $port);
|
|
}
|
|
}
|
|
}
|
|
$opkg{run_scripts} = $1 if /^runscripts\s+(yes|no)/;
|
|
$opkg{scriptcommand} = $1 if /^runscriptcommand\s+(.*)(#|$)/;
|
|
$opkg{makecommand} = $1 if /^makecommand\s+(.*)(#|$)/;
|
|
$opkg{addcommand} = $1 if /^addcommand\s+(.*)(#|$)/;
|
|
$opkg{removecommand} = $1 if /^removecommand\s+(.*)(#|$)/;
|
|
$olog{write} = $1 if /^writelog\s+(enabled|disabled)/;
|
|
$olog{mode} = $1 if /^logmode\s+(append|overwrite)/;
|
|
$olog{rm_on_success} = $1 if /^rmlog_on_success\s+(no|yes)/;
|
|
$olog{rm_on_uninst} = $1 if /^rmlog_on_uninst\s+(no|yes)/;
|
|
$olog{file} = $1 if /^logfile\s+(.*)\s*(#|$)/;
|
|
$odepends{soft} = $1 if /^softdeps\s+(no|yes)/;
|
|
$prtcache = $1 if /^cachefile\s+(.*)\s*(#|$)/;
|
|
}
|
|
close(PORTS);
|
|
return \@basedirs, \@localports;
|
|
}
|
|
|
|
sub sync {
|
|
my $sup_path = "/etc/ports";
|
|
my @OPT_COLLECTIONS=@_; my @drivers;
|
|
opendir(my $drv, "$sup_path/drivers") or return;
|
|
foreach my $d (sort(readdir($drv))) {
|
|
next if ($d =~ /^\./) or (! -x "$sup_path/drivers/$d");
|
|
push @drivers, $d;
|
|
}
|
|
closedir($drv);
|
|
if ($#drivers < 0) {
|
|
print("No valid ports drivers. Aborting sync.\n"); return;
|
|
}
|
|
if ($#OPT_COLLECTIONS >= 0) { # Update selected collections
|
|
foreach my $coll (@OPT_COLLECTIONS) {
|
|
if (! glob("$sup_path/$coll.*")) {
|
|
print("$coll not configured in $sup_path!\n"); next;
|
|
}
|
|
foreach my $suffix (@drivers) {
|
|
system("$sup_path/drivers/$suffix","$sup_path/$coll.$suffix") if (-f "$sup_path/$coll.$suffix");
|
|
}
|
|
}
|
|
} else { # Update all collections
|
|
foreach my $driver (@drivers) {
|
|
while (my $active = glob("$sup_path/*.$driver")) {
|
|
system("$sup_path/drivers/$driver",$active);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub find_dups {
|
|
my %seen; my $format=shift; my @dupinfo; my @info1; my $dupstr; my @hits;
|
|
foreach my $pp (@allports) { my $pn = (split /\//, $pp)[-1]; $seen{$pn}++; }
|
|
my @dups = grep { $seen{$_} > 1 } keys %seen;
|
|
my %subscripts = ( "%n"=>0, "%p1"=>1, "%v1"=>2, "%u1"=>3, "%M1"=>4,
|
|
"%p2"=>5, "%v2"=>6, "%u2"=>7, "%M2"=>8 );
|
|
if (($osearch{verbose}==0) and (! $format)) {
|
|
foreach my $dup (@dups) { print "$dup\n"; }
|
|
} elsif (($osearch{verbose}>0) and (! $format)) {
|
|
foreach my $dup (@dups) {
|
|
@hits = grep /\/$dup$/, @allports;
|
|
print "$hits[0] > $hits[1]\n" if $osearch{verbose}==1;
|
|
printf "* %s\n"x(1+$#hits), @hits if $osearch{verbose}>1;
|
|
}
|
|
} else { # the user has given us a format string; let's respect it
|
|
foreach my $dup (@dups) {
|
|
@hits = grep /\/$dup$/, @allports;
|
|
@dupinfo = (get_pkgfile_fields($hits[0],"all"))[1,2,6,8];
|
|
@info1 = (get_pkgfile_fields($hits[1],"all"))[1,2,6,8];
|
|
push(@dupinfo,@info1); unshift(@dupinfo,$dup);
|
|
$dupstr = "$format\n";
|
|
$dupstr =~
|
|
s/(%n|%p1|%v1|%u1|%M1|%p2|%v2|%u2|%M2)/$dupinfo[$subscripts{$1}]/g;
|
|
$dupstr =~ s/\\n/\n/g;
|
|
$dupstr =~ s/\\t/\t/g;
|
|
print $dupstr;
|
|
}
|
|
}
|
|
return 1+$#dups;
|
|
}
|
|
|
|
sub get_locked_and_aliased {
|
|
if (-f "$altroot$prtalias") {
|
|
open (AL, "$altroot$prtalias");
|
|
while (<AL>) { $ALIASES{$1} = $2 if m/^\s*(.*)\s*:\s*(.*)/; }
|
|
close (AL);
|
|
}
|
|
if (-f "$altroot$prtlocker") {
|
|
open (LK, "$altroot$prtlocker");
|
|
while (<LK>) { chomp; $LOCKED{$_}=1 unless /^\s*$/; }
|
|
close (LK);
|
|
}
|
|
}
|
|
|
|
sub who_aliased_to {
|
|
my $target = shift; my $match = qr/(^| )$target( |$)/is;
|
|
my @substitutes = grep { defined $V_INST{$_} } keys %ALIASES;
|
|
@substitutes = grep { $ALIASES{$_} =~ $match } @substitutes;
|
|
my $who = (@substitutes) ? $substitutes[0] : undef ;
|
|
return $who;
|
|
}
|
|
|
|
sub printf_ports {
|
|
my @pstats; my $p; my $inputf=shift; my @targets=@_;
|
|
my @pos; my @outfields; my $outputf; my %FS = ( "t"=>"\t", "n"=>"\n" );
|
|
my %subscripts = ( "n"=>0, "p"=>1, "v"=>2, "r"=>3, "d"=>4, "e"=>5, "u"=>6,
|
|
"P"=>7, "M"=>8, "R"=>9, "E"=>10, "O"=>11, "l"=>12, "i"=>13);
|
|
if ($inputf eq "CACHE") {
|
|
open (CACHE,'>',$prtcache) or die "cannot create a new cache file";
|
|
print CACHE "V5.1\n";
|
|
my %cached;
|
|
foreach my $pp (@targets) {
|
|
$p = (split /\//, $pp)[-1]; next if ($cached{$p});
|
|
@pstats = get_pkgfile_fields($pp,"all");
|
|
printf CACHE "%s\n"x($#pstats+1), @pstats;
|
|
printf CACHE "\n"; $cached{$p}=1;
|
|
} close (CACHE);
|
|
print "cache created.\n";
|
|
} else {
|
|
@outfields = split /(\\t|\\n)/, $inputf;
|
|
|
|
foreach (@outfields) {
|
|
if (m/\\(t|n)/) { $outputf .= $FS{$1}; next; }
|
|
$strf = $_;
|
|
s/%(p|n|v|r|d|e|u|P|M|R|E|O|l|i)/_Z_$subscripts{$1}/g;
|
|
push @pos, grep { s/([0-9]+)(.*)/$1/ } (split /_Z_/, $_);
|
|
$strf =~ s/%(p|n|v|r|d|e|u|P|M|R|E|O|l|i)/%s/g;
|
|
$outputf .= $strf;
|
|
}
|
|
|
|
foreach my $pp (@targets) {
|
|
$p = (split /\//, $pp)[-1];
|
|
@pstats = get_pkgfile_fields($pp,"all");
|
|
$pstats[12] = ($LOCKED{$p}) ? "yes" : "no";
|
|
$pstats[13] = ($V_INST{$p}) ? "yes" : "no";
|
|
($pstats[13] eq "no") or ($V_INST{$p} eq $V_REPO{$p}) or $pstats[13] = "diff";
|
|
printf STDOUT $outputf, @pstats[@pos];
|
|
}
|
|
}
|
|
}
|
|
|
|
sub fill_hashes_from_cache {
|
|
open (my $cf,$prtcache) or die "cannot use $prtcache as a cache!\n";
|
|
my $p; my $parent; my $deps; my $softDeps;
|
|
my $ignored=<$cf>; chomp($ignored);
|
|
($ignored eq "$cache_ver") or die "incompatible cache format; regenerate by running $0 cache";
|
|
|
|
while (1) {
|
|
$p = <$cf>; last unless defined $p;
|
|
chomp($p); $parent = <$cf>; chomp($parent);
|
|
push @allports, "$parent/$p";
|
|
$V_REPO{$p} = <$cf>; chomp($V_REPO{$p});
|
|
$V_REPO{$p} .= "-".<$cf>; $DESC{$p} = <$cf>;
|
|
$deps = <$cf>; $ignored=<$cf>; $softDeps = <$cf>;
|
|
chomp($deps, $softDeps, $DESC{$p}, $V_REPO{$p});
|
|
$DEPENDS{$p} = $deps; $SOFTDEPS{$p} = $softDeps;
|
|
for (my $i=8; $i<13; $i++) { $ignored = <$cf>; }
|
|
}
|
|
close ($cf);
|
|
}
|
|
|
|
sub fill_hashes_from_pkgfiles {
|
|
foreach my $pp (@allports) {
|
|
my $p = (split /\//, $pp)[-1];
|
|
|
|
if (! $V_REPO{$p}) { # only populate hashes with the first port found
|
|
my ($rver, $rrel, $rdesc, $rdeps, $rsoftdeps) = get_pkgfile_fields($pp);
|
|
$V_REPO{$p} = $rver;
|
|
$V_REPO{$p} .= "-$rrel";
|
|
$DEPENDS{$p} = $rdeps;
|
|
$SOFTDEPS{$p} = $rsoftdeps;
|
|
$DESC{$p} = $rdesc;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub get_pkgfile_fields {
|
|
my ($descrip, $url, $maintainer, $Version, $Release)=('','','',0,1);
|
|
my ($readme, $preInstall, $postInstall, $Dependencies, $SoftDeps)=("no","no","no",'','');
|
|
my $portpath = shift; my $Name = (split /\//, $portpath)[-1];
|
|
my $pkgfile = "$portpath/Pkgfile";
|
|
|
|
$readme = "yes" if (-f "$portpath/README") or (-f "$portpath/README.md");
|
|
$preInstall = "yes" if (-f "$portpath/pre-install");
|
|
$postInstall = "yes" if (-f "$portpath/post-install");
|
|
$portpath =~ s/\/[^\/]+?$//; # now it should be called repository path!
|
|
|
|
open(PF,$pkgfile) or die "Cannot open $pkgfile for reading!\n";
|
|
while (<PF>) {
|
|
chomp;
|
|
if (s/^# Description:\s*(.*)/$1/) { $descrip = $_; }
|
|
elsif (s/^# URL:\s*(.*)/$1/) { $url = $_; }
|
|
elsif (s/^version=(.*)/$1/) { $Version = $_; }
|
|
elsif (s/^release=(.*)/$1/) { $Release = $_; }
|
|
elsif (s/^# Depends (O|o)n:\s*(.*)/$2/) { $Dependencies = $_; }
|
|
elsif (s/^# (Optional|Nice to have):\s*(.*)/$2/) { $SoftDeps = $_; }
|
|
elsif (s/^# Maintainer:\s*(.*)/$1/) { $maintainer = $_; }
|
|
else {}
|
|
} close(PF);
|
|
|
|
if (($Version =~ m/\$\(.*\)/) or ($Version =~ m/`.*`/)) {
|
|
open(ECHO,"-|","bash -c \'source $pkgfile; echo \$version\'");
|
|
while(<ECHO>) { chomp; $Version = $_; }
|
|
close(ECHO);
|
|
}
|
|
|
|
$Dependencies =~ s/,(| )/ /g;
|
|
$SoftDeps =~ s/,(| )/ /g; $SoftDeps =~ s/(\051|\050)//g;
|
|
if (shift) {
|
|
return $Name, $portpath, $Version, $Release, $descrip, $Dependencies,
|
|
$url, $SoftDeps, $maintainer, $readme, $preInstall, $postInstall;
|
|
} else { return $Version, $Release, $descrip, $Dependencies, $SoftDeps; }
|
|
}
|
|
|
|
sub find_port_by_file { # for now only used to search footprints, but can be generalized
|
|
my $portfile = shift; my $query = shift; my ($lp, $candidate, $fh); my %hits=();
|
|
my $linewanted = qr/$query/is;
|
|
LOCALENTRY: foreach $lp (@localports) {
|
|
open ($fh, "$lp/$portfile") or die "cannot open $portfile for $lp\n";
|
|
while (<$fh>) {
|
|
$hits{$lp} .= (split /\s/, $_)[2]." " if $_ =~ $linewanted;
|
|
} close ($fh);
|
|
}
|
|
foreach my $collection (@basedirs) {
|
|
my $prefix = ( $osearch{path} == 1 ) ? "$collection/" : "";
|
|
opendir (DIR, $collection) or return;
|
|
PORTENTRY: foreach $candidate (sort(readdir(DIR))) {
|
|
next if (! -f "$collection/$candidate/$portfile");
|
|
open ($fh, "$collection/$candidate/$portfile") or die "cannot open $portfile in $candidate\n";
|
|
while (<$fh>) {
|
|
$hits{"$prefix$candidate"} .= (split /\s/, $_)[2]." " if $_ =~ $linewanted;
|
|
} close ($fh);
|
|
} closedir(DIR);
|
|
}
|
|
return \%hits;
|
|
}
|
|
|
|
sub find_port_by_desc {
|
|
my $query=shift;
|
|
my @hits = grep { (/$query/i) or ($DESC{$_} =~ /$query/i) } keys %DESC;
|
|
return @hits;
|
|
}
|
|
|
|
sub find_port_by_name {
|
|
my $query = shift; my $exact=shift; my $fullpath=shift; my $exhaustive=shift;
|
|
$query =~ s/\+/\\\+/g unless (($action =~ /^(search|dsearch)$/) and ($osearch{regex}==1));
|
|
$query =~ s/\./\\\./g unless (($action =~ /^(search|dsearch)$/) and ($osearch{regex}==1));
|
|
my $pattern = ($exact==1) ? qr/^$query$/s : qr/$query/is;
|
|
my %names_only = map { ($_ => (split /\//, $_)[-1]) } @allports;
|
|
my @hits = grep { $names_only{$_} =~ $pattern } @allports;
|
|
@hits = map { $names_only{$_} } @hits if $fullpath==0;
|
|
|
|
return @hits if ($exhaustive==1);
|
|
return $hits[0] if ($exhaustive==0);
|
|
}
|
|
|
|
sub uninstall {
|
|
my $PKGRM = $opkg{removecommand};
|
|
my @targets = grep { defined $V_INST{$_} } @_;
|
|
my @rubbish = grep { ! defined $V_INST{$_} } @_;
|
|
foreach my $r (@rubbish) { print "$r not installed; ignoring.\n"; }
|
|
my @removed;
|
|
if (($altroot ne "") and ($opkg{rargs} !~ m/(-r|--root)/)) {
|
|
$opkg{rargs} .= " -r $altroot";
|
|
}
|
|
foreach my $t (@targets) {
|
|
($opkg{test} eq "no") ? system("$PKGRM $opkg{rargs} $t") : print "$PKGRM $opkg{rargs} $t\n";
|
|
next if ($?>>8 != 0);
|
|
push @removed, $t;
|
|
if (($LOCKED{$t}) and ($opkg{test} eq "no")) { port_unlock($t); }
|
|
if ($olog{rm_on_uninst} eq "yes") {
|
|
my $log_t = $olog{file};
|
|
my $rt = $1 if ($V_INST{$t} =~ m/.*-([0-9]+)$/);
|
|
my $vt = $V_INST{$t}; $vt =~ s/-$rt//;
|
|
my %pvars = ( '%n' => $t, '%v' => $vt, '%r' => $rt );
|
|
$log_t =~ s/(%n|%v|%r)/$pvars{$1}/g;
|
|
(! -f $log_t) or unlink $log_t or print "failed to delete $log_t\n";
|
|
}
|
|
}
|
|
return \@removed;
|
|
}
|
|
|
|
sub port_lock {
|
|
my %oldlocks = map { $_ => "L" } keys %LOCKED;
|
|
my @newlocks = grep { ! defined $oldlocks{$_} } @_;
|
|
if (@newlocks) {
|
|
open (LK,'>>',$prtlocker) or die "cannot open $prtlocker for writing.\n";
|
|
foreach my $lp (@newlocks) {
|
|
print LK "$lp\n";
|
|
print STDOUT "$lp locked.\n";
|
|
} close (LK);
|
|
}
|
|
}
|
|
|
|
sub port_unlock {
|
|
my %unlocks = map { $_ => "U" } @_;
|
|
my @newlocks = grep { ! defined $unlocks{$_} } keys(%LOCKED);
|
|
open (LL, '>', $prtlocker."-tmp");
|
|
foreach my $nl (@newlocks) { print LL "$nl\n" unless $nl =~ /^\s*$/; }
|
|
close (LL);
|
|
rename ($prtlocker."-tmp",$prtlocker);
|
|
}
|
|
|
|
sub list_ports {
|
|
my @found; my $subset = shift;
|
|
|
|
if (! $subset) { # default action: list all valid ports
|
|
foreach my $collection (@basedirs) {
|
|
opendir (DIR, $collection) or next;
|
|
foreach my $port (sort(readdir DIR)) {
|
|
next if (! -f "$collection/$port/Pkgfile");
|
|
push (@found, "$collection/$port");
|
|
} closedir (DIR);
|
|
}
|
|
foreach my $lp (@localports) {
|
|
push (@found, $lp) if (-f "$lp/Pkgfile");
|
|
}
|
|
} elsif ($subset eq "inst") { @found = keys %V_INST;
|
|
} elsif ($subset eq "locked") { @found = keys %LOCKED;
|
|
} elsif ($subset =~ /^(orphans|dependent|deptree)$/) {
|
|
my $seed; my $sseed;
|
|
our @searchspace=(($subset eq "orphans") or ($odepends{all} == 0)) ?
|
|
keys %V_INST : keys %V_REPO ;
|
|
@searchspace = grep { defined $DEPENDS{$_} } @searchspace;
|
|
|
|
if ($subset =~ /^dep/) {
|
|
$seed=shift; $sseed = $seed;
|
|
if (! find_port_by_name($seed,1,1,0)) {
|
|
print "$seed not found in the ports tree.\n"; return;
|
|
}
|
|
# workaround for any port with a plus sign in its name
|
|
$sseed =~ s/\+/\\\+/g
|
|
}
|
|
|
|
if ($subset eq "orphans") {
|
|
my %not_orphans = map { $_ => 0 } keys %V_INST;
|
|
foreach my $port (@searchspace) {
|
|
map { $not_orphans{$_} = 1 } split(/[ ,]+/, $DEPENDS{$port});
|
|
if (($odepends{soft} eq "yes") and ($SOFTDEPS{$port})) {
|
|
map { $not_orphans{$_} = 1 } split(/[ ,]+/, $SOFTDEPS{$port});
|
|
}
|
|
}
|
|
foreach my $al (keys %ALIASES) {
|
|
$not_orphans{$al} = 1 if (($not_orphans{$ALIASES{$al}}) and ($not_orphans{$ALIASES{$al}} == 1));
|
|
}
|
|
@found = grep { ($not_orphans{$_} == 0) } keys %V_INST;
|
|
} elsif (($subset eq "dependent") and ($odepends{recursive}==0)) {
|
|
@found = grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
|
|
if ($odepends{soft} eq "yes") {
|
|
push (@found, grep
|
|
{ " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace);
|
|
}
|
|
if ($odepends{tree}==1) { unshift (@found, "$seed"); }
|
|
} elsif ($subset =~ /^dep(endent|tree)/) {
|
|
our $direction = ($subset eq "deptree") ? "fwd" : "rev";
|
|
my $header = (($subset eq "deptree") and ($odepends{tree} == 1)) ?
|
|
"-- dependencies ([i] = installed, '-->' = already shown)":
|
|
"-- reverse dependencies ('-->' = already shown)";
|
|
if (($direction eq "fwd") and ($odepends{soft} eq "yes")) {
|
|
$header =~ s/installed,/installed, [s] = installed softdep,/;
|
|
}
|
|
($odepends{tree} == 0) or print "$header\n";
|
|
|
|
our $indent=" "; our $height=0;
|
|
our $ind; our %seen; our @lineage; my @fosters=(); my @children=();
|
|
$ind = ($V_INST{$seed}) ? "[i]" : "[ ]";
|
|
print "$ind $seed\n" if ($odepends{tree}==1);
|
|
$seen{$sseed} = 1;
|
|
if ($direction eq "rev") {
|
|
@children = grep { " $DEPENDS{$_} " =~ / $sseed / } @searchspace;
|
|
} elsif ($DEPENDS{$seed}) {
|
|
@children = split /[ ,]+/, $DEPENDS{$seed};
|
|
}
|
|
|
|
if (($odepends{soft} eq "yes") and ($direction eq "rev")) {
|
|
@fosters = grep { " $SOFTDEPS{$_} " =~ / $sseed / } @searchspace;
|
|
} elsif (($odepends{soft} eq "yes") and ($SOFTDEPS{$sseed})) {
|
|
@fosters = grep { ($V_INST{$_}) } split /[ ,]+/, $SOFTDEPS{$sseed};
|
|
}
|
|
|
|
foreach my $sd (@children) { recurse_tree(0,$sd,$direction); }
|
|
foreach my $sd (@fosters) { recurse_tree(1,$sd,$direction); }
|
|
|
|
sub recurse_tree {
|
|
my $greedy = shift; my $s = shift; my $direction=shift;
|
|
my %curdeps=(); my @optionals=();
|
|
my $ps = (($seen{$s}) and ($odepends{all} !=1)) ? "-->\n" : "\n";
|
|
$ind = ($V_INST{$s}) ? "[i]" : "[ ]";
|
|
$ind = (($ind eq "[i]") and ($greedy)) ? "[s]" : $ind;
|
|
print $ind.(${indent}x(1+$height))."$s".$ps if ($odepends{tree}==1);
|
|
return if (($seen{$s}) and ($odepends{all} !=1));
|
|
$seen{$s} = 1;
|
|
if ($direction eq "rev") {
|
|
%curdeps = map {$_ => 0} grep { " $DEPENDS{$_} " =~ / $s / } @searchspace;
|
|
} elsif ($DEPENDS{$s}) {
|
|
%curdeps = map {$_ => 0} split /[ ,]+/, $DEPENDS{$s};
|
|
}
|
|
if (($odepends{soft} eq "yes") and ($direction eq "rev")) {
|
|
@optionals = grep { " $SOFTDEPS{$_} " =~ / $s / } @searchspace;
|
|
} elsif (($odepends{soft} eq "yes") and ($SOFTDEPS{$s})) {
|
|
@optionals = grep { ($V_INST{$_}) } split /[ ,]+/, $SOFTDEPS{$s};
|
|
}
|
|
map {$curdeps{$_} = 1} @optionals;
|
|
|
|
foreach my $dc (keys %curdeps) {
|
|
if (grep /^$dc$/, @lineage) {
|
|
print "Warning: dependency cycle => "
|
|
.$dc."\n" unless ($greedy|$curdeps{$dc});
|
|
return;
|
|
}
|
|
push (@lineage, $dc);
|
|
$height = $#lineage+1;
|
|
recurse_tree($greedy|$curdeps{$dc},$dc,$direction);
|
|
pop(@lineage);
|
|
$height = $#lineage+1;
|
|
}
|
|
}
|
|
delete $seen{$seed} if ($odepends{tree} == 0);
|
|
@found = sort(keys %seen);
|
|
} # possibilities for the recursive switch have been exhausted
|
|
} # possibilities for the filter have been exhausted
|
|
my $filter = shift; my $linewanted;
|
|
return @found if ( ((! $subset) and (! $filter))
|
|
or (($subset) and ($subset =~ /^(orphans|locked)$/))
|
|
or ((! $subset) and (! $osearch{filter})) );
|
|
if ($osearch{filter}) { return grep {$_ =~ /$osearch{filter}/} @found; }
|
|
if ($filter) {
|
|
$filter =~ s/\*/.*/g;
|
|
$linewanted = qr/^$filter$/is;
|
|
return grep {$_ =~ $linewanted} @found;
|
|
} else {
|
|
return @found;
|
|
}
|
|
}
|
|
|
|
sub port_diff { # find differences between the pkgdb and the repo
|
|
my $dtype=shift; my @argq=@_; my @outfile=(); my $retval=0;
|
|
|
|
if ($dtype !~ /^(current|isinst|utd)/) {
|
|
foreach my $p (sort(keys %V_INST)) {
|
|
if (($V_REPO{$p}) and ($V_REPO{$p} ne $V_INST{$p})) {
|
|
$retval++ unless ($LOCKED{$p});
|
|
($dtype =~ /^(quick|sysup)/) ? push @outfile, "$p" :
|
|
push @outfile, "$p $V_INST{$p} $V_REPO{$p}";
|
|
} elsif ((! $V_REPO{$p}) and ($dtype !~ /^(quick|sysup)/)) {
|
|
$retval++;
|
|
push @outfile, "$p $V_INST{$p} MISSING";
|
|
}
|
|
}
|
|
} elsif ($dtype eq "utd") { my $q=shift(@argq);
|
|
if (! $V_INST{$q}) { $retval--;
|
|
} elsif (($V_REPO{$q}) and ($V_INST{$q} ne $V_REPO{$q})) { $retval++;
|
|
} else {}
|
|
} elsif ($dtype =~ /^(current|isinst)$/) {
|
|
foreach my $q (@argq) {
|
|
if ( (! $V_INST{$q}) and (! who_aliased_to($q)) ) {
|
|
push @outfile, "$q: not installed"; $retval++;
|
|
} elsif ($V_INST{$q}) {
|
|
push @outfile, "$V_INST{$q}" if ($dtype eq "current");
|
|
push @outfile, "$q is installed." if ($dtype eq "isinst");
|
|
} else {
|
|
push @outfile, "$q is provided by package ".who_aliased_to($q)
|
|
if ($dtype eq "isinst");
|
|
push @outfile, "Package $q not installed" if ($dtype eq "current");
|
|
}
|
|
}
|
|
}
|
|
return $retval, @outfile if ($dtype !~ /^(utd|sysup)/);
|
|
return $retval if ($dtype ne "sysup");
|
|
|
|
# proceed with the sysup operation
|
|
my @results = up_inst(@outfile);
|
|
return $retval, @results;
|
|
}
|
|
|
|
sub deporder { # returns a sorted list of packages required.
|
|
my $type=shift; my @seeds=@_; our @treewalk=(); our %missing; our @result;
|
|
our %given = map { $_ => 1 } @seeds; our %imark=(); our %fmark=();
|
|
|
|
# determine the minimal set of targets needed to satisfy all dependencies
|
|
foreach my $t (@seeds) { recurse_deptree(0,$t); }
|
|
|
|
sub recurse_deptree {
|
|
my $greedy=shift; my $s=shift; my %curdeps=();
|
|
|
|
# early return if this node has been visited already
|
|
if ($fmark{$s}) { return; }
|
|
|
|
# detect targets that have been dropped from the repositories
|
|
if (! $V_REPO{$s}) { $missing{$s}=1; $fmark{$s}=0; return; }
|
|
|
|
# dependency cycle detection
|
|
if ($imark{$s}) {
|
|
return if ($greedy == 1);
|
|
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
|
|
(! $DEPENDS{$s}) or %curdeps = map { $_ => $greedy } split /[ ,]+/, $DEPENDS{$s};
|
|
|
|
# if the user toggles --softdeps, consider the optional dependencies
|
|
# that are already installed or are given on the command line
|
|
if (($odepends{soft} eq "yes") and ($SOFTDEPS{$s})) {
|
|
foreach (grep { ($V_INST{$_}) or ($given{$_}) }
|
|
split /[ ,]+/, $SOFTDEPS{$s}) { $curdeps{$_} = 1; }
|
|
}
|
|
|
|
foreach my $sd (keys %curdeps) {
|
|
my $subit = who_aliased_to($sd);
|
|
if ($subit) {
|
|
recurse_deptree($curdeps{$sd},$subit);
|
|
} else {
|
|
recurse_deptree($curdeps{$sd},$sd);
|
|
}
|
|
}
|
|
delete $imark{$s}; pop(@treewalk);
|
|
$fmark{$s} = 1;
|
|
push(@result, $s);
|
|
}
|
|
|
|
if ((keys %missing > 0) and ($type ne "quickdep")) { push (@result, "MISSING", sort(keys %missing)); }
|
|
return @result;
|
|
}
|
|
|
|
sub up_inst { # returns scalar references to six arrays
|
|
my @requested=@_; my @sortedList; my @targets; my %pdirs; my %builtpkg;
|
|
my %mkcmd; my %addcmd; my $rs_cmd; my %logfile; my %pvars; my $status;
|
|
my %ok; my @missing; my %not_ok; my %ok_pre; my %ok_post; my @ok_readme=();
|
|
my $ord=0; my $PKGADD = $opkg{addcommand}; my $SH=$opkg{scriptcommand};
|
|
|
|
$PKGADD .= " $opkg{aargs}" if ($opkg{aargs});
|
|
if (($altroot ne "") and ($opkg{aargs} !~ m/(-r|--root)/)) {
|
|
$PKGADD .= " --install-root \"$altroot\"";
|
|
}
|
|
|
|
# resolve dependencies unless --nodeps was given,
|
|
# but put glibc{,-32} at the front of the queue
|
|
if ($odepends{inject}==1) {
|
|
@sortedList = deporder("quickdep", @requested);
|
|
@targets=grep { !m/^glibc(|-32)$/ } @sortedList;
|
|
unshift @targets, grep { m/^glibc(|-32)$/ } @sortedList;
|
|
} else {
|
|
@targets = grep { ($V_REPO{$_}) } @requested;
|
|
}
|
|
@missing = grep { (! $V_REPO{$_}) } @requested;
|
|
|
|
# omit the ports that appear up to date, unless a rebuild is forced
|
|
if ("$opkg{margs} $opkg{aargs}" !~ m/-f/) {
|
|
@targets = grep {( (! $V_INST{$_})
|
|
or ($V_REPO{$_} ne $V_INST{$_}) )} @targets;
|
|
}
|
|
|
|
# exempt any locked ports from being updated
|
|
@targets = grep {(! $LOCKED{$_})} @targets if ($opkg{nolock}==0);
|
|
|
|
# first determine the directories from which pkgmk must be called,
|
|
# and where to save the build log.
|
|
foreach my $t (@targets) {
|
|
$opkg{$t} = $opkg{margs}; $pvars{'%n'}=$t;
|
|
$opkg{$t} =~ s/-f// unless (grep /^$t$/, @requested);
|
|
$pdirs{$t} = find_port_by_name($t,1,1,0);
|
|
$pvars{'%p'} = $pdirs{$t};
|
|
$pvars{'%v'} = $1 if ( $V_REPO{$t} =~ m/(.+)-[0-9]+$/ );
|
|
$pvars{'%r'} = $1 if ( $V_REPO{$t} =~ m/-([0-9]+)$/ );
|
|
$mkcmd{$t} = "$opkg{makecommand} -d $opkg{$t} 2>&1";
|
|
$addcmd{$t} = ($V_INST{$t}) ? "$PKGADD -u" : $PKGADD;
|
|
if ($olog{write} eq "enabled") {
|
|
$logfile{$t} = $olog{file};
|
|
$logfile{$t} =~ s/(%n|%v|%r|%p)/$pvars{$1}/g;
|
|
}
|
|
}
|
|
|
|
if ($opkg{test} eq "yes") { print("*** prt-auf: test mode\n\n");
|
|
print "-- Packages changed\n"; }
|
|
|
|
# build each package
|
|
BUILDLOG: foreach my $t (@targets) {
|
|
if ($opkg{test} eq "yes") {
|
|
print("$t");
|
|
("$opkg{run_scripts} $opkg{pre_install}" !~ /yes/) or
|
|
(! -f "$pdirs{$t}/pre-install") or print(" (+pre)");
|
|
("$opkg{run_scripts} $opkg{post_install}" !~ /yes/) or
|
|
(! -f "$pdirs{$t}/post-install") or print(" (+post)");
|
|
print("\n");
|
|
next BUILDLOG;
|
|
} else {
|
|
$ord += 1;
|
|
}
|
|
if (("$opkg{run_scripts} $opkg{pre_install}" =~ /yes/) and (-f "$altroot$pdirs{$t}/pre-install")) {
|
|
$rs_cmd="$SH $pdirs{$t}/pre-install";
|
|
($altroot eq "") or $rs_cmd = "chroot $altroot $rs_cmd";
|
|
(system("$rs_cmd")==0) ? $ok_pre{$t} = $ord : delete $ok_pre{$t};
|
|
}
|
|
chdir("$pdirs{$t}") or $not_ok{$t} = $ord;
|
|
if ($not_ok{$t}) { next BUILDLOG; }
|
|
if ($olog{write} eq "enabled") {
|
|
($olog{mode} eq "append") ? open(BFH,'>>',$logfile{$t}) : open(BFH,'>',$logfile{$t});
|
|
}
|
|
open(my $mkProc,"-|","$mkcmd{$t}");
|
|
while(my $bl=<$mkProc>) {
|
|
print $bl;
|
|
($olog{write} ne "enabled") or print BFH $bl;
|
|
if ($bl =~ /=======> (Building|Package) '(.*)' (succeeded|is up to date).*/) {
|
|
$addcmd{$t} .= " $2";
|
|
$ok{$t} = $ord;
|
|
}
|
|
}
|
|
close($mkProc);
|
|
($olog{write} ne "enabled") or close(BFH);
|
|
if (($ok{$t}) and (system($addcmd{$t})==0)) {
|
|
push (@ok_readme, $t) if (-f "README");
|
|
unlink($logfile{$t})
|
|
if ( ($logfile{$t}) and ($olog{rm_on_success} eq "yes") );
|
|
} else {
|
|
$not_ok{$t} = $ord;
|
|
delete $ok{$t};
|
|
}
|
|
if (($ok{$t}) and ("$opkg{run_scripts} $opkg{post_install}" =~ /yes/) and (-f "$altroot$pdirs{$t}/post-install")) {
|
|
$rs_cmd="$SH post-install";
|
|
($altroot eq "") or $rs_cmd="chroot $altroot $rs_cmd";
|
|
(system("$rs_cmd")==0) ? $ok_post{$t}=$ord : delete $ok_post{$t};
|
|
}
|
|
last if (($opkg{group} eq "yes") and ($not_ok{$t}));
|
|
}
|
|
|
|
my @ok = sort { return ($ok{$a} < $ok{$b}) ? -1 : 1; } keys %ok;
|
|
my @not_ok = sort { return ($not_ok{$a} < $not_ok{$b}) ? -1 : 1; } keys %not_ok;
|
|
return \@ok, \%ok_pre, \%ok_post, \@ok_readme, \@not_ok, \@missing;
|
|
}
|
|
|
|
sub port_ls {
|
|
my $port=shift; my $pp=find_port_by_name($port,1,1,0);
|
|
return if (! defined $pp);
|
|
opendir (DIR,$pp) or die "Cannot open $pp for directory listing!\n";
|
|
foreach my $l (sort(readdir(DIR))) {
|
|
next if (($l eq ".") or ($l eq ".."));
|
|
print "$l\n";
|
|
} closedir (DIR);
|
|
}
|
|
|
|
sub port_edit {
|
|
my $type=shift; my $port=shift;
|
|
my $file=shift; my $pp=find_port_by_name($port,1,1,0);
|
|
return if (! defined $pp);
|
|
my $EDITOR = ($ENV{EDITOR}) ? $ENV{EDITOR} : "/usr/bin/vi";
|
|
|
|
if ($type eq "readme") {
|
|
port_edit("cat",$port,"README") if (-f "$pp/README");
|
|
port_edit("cat",$port,"README.md") if (-f "$pp/README.md");
|
|
}
|
|
|
|
if ($type eq "edit") {
|
|
exec ($EDITOR,"$pp/$file") if (($file) and (-f "$pp/$file"));
|
|
exec ($EDITOR,"$pp/Pkgfile") if ((! $file) or (! -f "$pp/$file"));
|
|
}
|
|
|
|
if ($type eq "cat") {
|
|
if (($file) and (-f "$pp/$file")) {
|
|
open (PF, "$pp/$file") or die "Could not open $pp/$file.\n";
|
|
while (<PF>) { print $_ ; }
|
|
close (PF);
|
|
} else {
|
|
open (PF, "$pp/Pkgfile") or die "Could not open $pp/Pkgfile.\n";
|
|
while (<PF>) { print $_ ; }
|
|
close (PF);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub print_help { print <<EOF;
|
|
Usage: prt-auf <action> [options] <search term|port name>
|
|
where the actions include:
|
|
|
|
SEARCH
|
|
search <expr> show port names containing <expr>
|
|
dsearch <expr> show ports containing <expr> in the name or description
|
|
fsearch <pattern> show ports that provide filenames matching <pattern>
|
|
|
|
DIFFERENCES / DEPENDENCIES
|
|
quickdiff show outdated packages on a single line, separated by spaces
|
|
quickdep <port> show the dependencies needed by <port>, on a single line
|
|
deptree <port> show dependency tree for <port>
|
|
dependent <port> show installed packages which depend on <port>
|
|
|
|
INSTALL, UPDATE and REMOVAL
|
|
install [opt] <port1 port2...> install/update ports in the listed order
|
|
depinst [opt] <port1 port2...> install/update ports and their dependencies
|
|
remove [opt] <port1 port2...> remove ports
|
|
lock <port1 port2...> lock each <port> at its current version
|
|
unlock <port1 port2...> release the lock on each <port>
|
|
sysup update all outdated ports, except those that are locked
|
|
|
|
GENERAL INFORMATION
|
|
list ports in the active repositories
|
|
listinst ports currently installed
|
|
listlocked ports that are locked at their current version
|
|
listorphans installed ports that no other port claims as a hard dependency
|
|
dup ports that appear more than once in the active collections
|
|
info <port> version, description, dependencies of <port>
|
|
path <port> location from which pkgmk would be called to build <port>
|
|
cat <port> <file> the contents of <port>/<file> on STDOUT
|
|
isinst <port> whether port is installed
|
|
current <port> installed version of port
|
|
|
|
COMMON OPTIONS
|
|
-v show version in listing
|
|
-vv show version and decription in listing
|
|
--path print path to port if appropriate (search, list, depends)
|
|
--regex treat search term as a Perl-compatible regular expression
|
|
--cache use a cache file
|
|
--group stop the install/update operation if any port fails
|
|
--softdeps when sorting the targets, consider optional dependencies too
|
|
--nodeps do not inject or sort by dependencies
|
|
--test do not actually run pkgmk/pkgadd, just print the affected ports
|
|
EOF
|
|
exit;
|
|
}
|