jmq/Documentation
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
03ee5c7c99
Documentation/scripts/prt-auf

851 lines
32 KiB
Perl
Executable File
Raw Blame History

#!/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.5;
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 @LOCKED; my %ALIASES; my %DEPENDS;
my @allports; my %V_REPO; my %V_INST; my %DESC;
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 = ( tree => 0, recursive => 0, all => 0 );
my %opkg = ( margs => "", aargs => "", rargs => "", runscripts => "yes",
makecommand => "/usr/bin/pkgmk", addcommand => "/usr/bin/pkgadd",
removecommand => "/usr/bin/pkgrm", test => "no" );
my @bldirs = parse_prt_conf();
my @basedirs = @{$bldirs[0]}; my @localports = @{$bldirs[1]};
################### Process the given command #########################
my ($action, @query) = parse_args(@ARGV);
# load some data structures into memory for the actions that need them
if ($action !~ /^(fsearch|isinst|current)$/) {
@allports = list_ports();
fill_hashes_from_pkgfiles() unless ($action eq "printf");
}
if ($osearch{cache}==1) { fill_hashes_from_cache(); }
if ($action !~ /^(quickdep|search|dsearch|fsearch|info|dup|readme|cat)$/) {
open (DB, $pkgdb) or die "Could not open package database!\n";
local $/="";
while (<DB>) { $V_INST{$1} = $2 if m/^(.*)\n(.*)-[0-9]+\n/; }
close (DB);
}
if ($action =~ /^(diff|quickdiff|listlocked|depends|deptree|remove|install|update|depinst|sysup)$/) {
get_locked_and_aliased();
}
############## Branch based on the requested action #################
if ($action eq "path") { @results = find_port_by_name(@query,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[-1]);
} 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[0]);
} elsif ($action =~ /^(cat|edit|readme)$/) { port_edit($1,@query);
} elsif ($action =~ /^(depends|deptree|quickdep)$/) { @results=deporder($1,@query);
} elsif ($action eq "dependent") { @results=list_ports("dependent",@query);
} elsif ($action eq "sysup") { @results = sysup();
} elsif ($action =~ /^(install|update|depinst|grpinst)$/) {
@results = up_inst($1,@query);
} elsif ($action eq "dup") { $ind=find_dups(@query);
} elsif ($action eq "remove") { $ind=uninstall(@query);
} elsif ($action =~ /^(isinst|current)$/) { $ind = port_diff($1,@query);
} elsif ($action =~ /(.*)diff$/) { $ind = port_diff($1);
} elsif ($action =~ /^list(.*)/) { @results = list_ports($1);
} 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)/)
or (($action eq "dependent") and ($odepends{all}==0))) {
foreach my $result (@results) {
$result .= " $V_INST{$result}" if $osearch{verbose}==1;
$result .= " $V_INST{$result}\n$DESC{$result}\n" if $osearch{verbose}>1;
printf "$strf", $result;
}
} elsif ($action =~ /^(list|search|dsearch|path|dependent)/) {
exit 1 if ($#results < 0);
foreach my $result (@results) {
chomp($result); next if ($result =~ /^\s*$/);
$result =~ s/.*\/(.*)$/$1/ if (($action ne "path") and ($osearch{path}==0));
$result .= " $V_REPO{$result}" if $osearch{verbose}==1;
$result .= " $V_REPO{$result}\n$DESC{$result}\n" if $osearch{verbose}>1;
printf $strf, $result;
}
} elsif ($action =~ /^(fsearch)/) {
my %hits = %{$hh}; $strf = "%20s %s\n";
printf $strf, "Found in", "Matching File";
foreach my $fh (keys %hits) {
chomp($hits{$fh});
printf $strf, $fh, (split /\s/, $hits{$fh})[-1];
}
} elsif ($action =~ /^(diff|quickdiff|current|isinst|dup)$/) {
exit $ind;
} elsif ($action =~ /^(depends|deptree|quickdep)$/) {
print "-- dependencies ([i] = installed, [a] = provided by an alias)\n" if ($action =~ /^dep/);
my $indent=($action eq "deptree") ? " " : "";
my @installed=keys %V_INST unless ($action eq "quickdep");
my %seen; my $strf="%3s %s\n"; my $depline; my $dep; my $missing=0;
foreach $depline (@results) {
if ($depline =~ /MISSING/) { $missing=1; print "-- missing packages\n"; next; }
my $cleandep = $depline;
$cleandep =~ s/ .provided by .*// if ($action eq "deptree");
$dep = (split / /, $cleandep)[-1];
next if (($seen{$dep}) and ($odepends{all}==0));
$seen{$dep}=1;
if ($action ne "quickdep") {
$ind = (grep { $_ eq $dep } @installed) ? "[i]" : "[ ]";
if ($ind ne "[i]") {
$ind = (who_aliased_to($dep)) ? "[a]" : $ind;
}
}
$depline .= " $V_REPO{$dep}" if $osearch{verbose}==1;
$depline .= " $V_REPO{$dep}\n$DESC{$dep}" if $osearch{verbose}>1;
printf "$strf", $ind, $depline 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", "Packager", "Maintainer",
"Readme", "PreInstall", "PostInstall");
for (my $i=0; $i<7; $i++) { printf $strf, $fields[$i], $results[$i]; }
printf $strf, $fields[8], $results[8];
} elsif ($action eq "remove") {
my %removed = %$ind;
my @successes = grep { $removed{$_}==1 } keys %removed;
my @failures = grep { $removed{$_}==0 } keys %removed;
print "Ports removed:\n" if (@successes);
foreach my $p (@successes) { print "$p\n"; }
} elsif ($action =~ /^(install|update|depinst|grpinst)$/) {
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 $note;
if (($opkg{test} eq "no") and (@ok)) {
print "Successful ports:\n";
foreach my $k (@ok) {
$note = (grep /^$k$/, @ok_pre) ? " pre: ok. " : "";
$note .= (grep /^$k$/, @ok_post) ? " post: ok. " : "";
$note = ((grep /^$k$/, @ok_pre) or (grep /^$k$/, @ok_post))? "($note)" : "";
print " $k $note\n";
}
print "\n";
}
if (($opkg{test} eq "no") and (@ok_readme)) {
print "Successful ports with README files:\n";
foreach (@ok_readme) { print " $_\n"; }
print "\n";
}
if (($opkg{test} eq "no") and (@not_ok)) {
print "Ports with pkgmk/pkgadd failures:\n";
foreach (@not_ok) { print " $_\n"; }
print "\n";
}
} else {}
# Done!
#################### Begin Subroutines #######################
sub parse_args {
my @query;
$osearch{cache} = 1 if ($0 =~ /cache$/);
while (my $arg = shift) {
if ($arg =~ /^(search|dsearch|fsearch|path|info|list|remove)$/) { $action = $1;
} elsif ($arg =~ /^(install|update|depinst|grpinst|sysup)$/) { $action = $1;
} elsif ($arg =~ /^(lock|unlock|listlocked|current|isinst)$/) { $action = $1;
} elsif ($arg =~ /^(diff|quickdiff|printf|listinst|listorphans)$/) { $action = $1;
} elsif ($arg =~ /^(depends|deptree|quickdep|dependent|dup)$/) { $action = $1;
} elsif ($arg =~ /^(readme|cat|edit|ls|help|version|cache)$/) { $action = $1;
} elsif ($arg eq "--tree") { $odepends{tree} = 1; $odepends{recursive} = 1;
} elsif ($arg eq "--all") { $odepends{all} = 1;
} elsif ($arg eq "--recursive") { $odepends{recursive} = 1;
} elsif ($arg eq "--cache") { $osearch{cache} = 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 "-fr") { $opkg{margs} .= " -f";
} elsif ($arg =~ /^(-uf|-if|-us|-is|-ns|-kw)$/) { $opkg{margs} .= " $1";
} elsif ($arg =~ /^--margs=(.*)/) { $opkg{margs} .= $1;
} elsif ($arg =~ /^--aargs=(-r|--root)=(.*)/) { $opkg{aargs} .= "$1 $2";
} elsif ($arg =~ /^--rargs=(-r|--root)=(.*)/) { $opkg{rargs} .= "$1 $2";
} 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|list|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 last.\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|grpinst|remove)$/)) {
print "$1 requires at least one argument.\n"; exit 1;
}
return $action, @query;
}
sub parse_prt_conf {
my @basedirs; my @localports; my $conf = "/etc/prt-get.conf";
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{runscripts} = $1 if /^runscripts\s+(.*)#/;
$opkg{makecommand} = $1 if /^makecommand\s+(.*)#/;
$opkg{addcommand} = $1 if /^addcommand\s+(.*)#/;
$opkg{removecommand} =$1 if /^removecommand\s+(.*)#/;
}
close(PORTS);
return \@basedirs, \@localports;
}
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;
print $dupstr;
}
}
return 1+$#dups;
}
sub get_locked_and_aliased {
local $/ = "\n";
if (-f $prtalias) {
open (AL, $prtalias);
while (<AL>) { $ALIASES{$1} = $2 if m/^\s*(.*)\s*:\s*(.*)/; }
close (AL);
}
if (-f $prtlocker) {
open (LK, $prtlocker) or return;
while (<LK>) { push (@LOCKED, $_) unless /^\s*$/; }
close (LK);
}
}
sub who_aliased_to {
my $target = shift;
my @substitutes = grep { defined $V_INST{$_} } keys %ALIASES;
@substitutes = grep { $ALIASES{$_} eq $target } @substitutes;
my $who = (@substitutes) ? $substitutes[0] : undef ;
return $who;
}
sub printf_ports {
my $FS; my @pstats; my $p; my $inputf=shift; my @targets=@_;
my @pos; my $strf; my $outputf;
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\n";
foreach my $pp (@targets) {
$p = (split /\//, $pp)[-1];
@pstats = (get_pkgfile_fields($pp,"all"));
printf CACHE "%s\n"x($#pstats+1), @pstats;
} close (CACHE);
print "cache created.\n";
} else {
$strf = $inputf;
$strf =~ s/(%p|%n|%v|%r|%d|%e|%u|%P|%M|%R|%E|%O|%l|%i)/_Z_$subscripts{$1}/g;
@pos = grep { s/([0-9]+)(.*)/$1/ } (split /_Z_/, $strf);
$outputf = "$inputf\n";
$outputf =~ s/(%p|%n|%v|%r|%d|%e|%u|%P|%M|%R|%E|%O|%l|%i)/%-14s/g;
foreach my $pp (@targets) {
$p = (split /\//, $pp)[-1];
@pstats = get_pkgfile_fields($pp,"all");
$pstats[11] = grep /^$p$/, keys %V_INST;
$pstats[12] = grep /^$p$/, @LOCKED;
printf STDOUT $outputf, @pstats[@pos];
}
}
}
sub fill_hashes_from_cache {
open (my $cf,$prtcache) or die "cannot use $prtcache as a cache!\n";
local $/="\n"; my $p; my $deps;
my $ignored=<$cf>; # first line only contains the cache format version
while (1) {
$p = <$cf>; last unless defined $p;
chomp($p);
$ignored = <$cf>; $V_REPO{$p} = <$cf>;
$ignored = <$cf>; $DESC{$p} = <$cf>;
$deps = <$cf>;
chomp($deps, $DESC{$p}, $V_REPO{$p});
$DEPENDS{$p} = ($deps ne "") ? $deps : " ";
$DEPENDS{$p} =~ s/,/ /g;
for (my $i=6; $i<13; $i++) { $ignored = <$cf>; }
}
close ($cf);
}
sub fill_hashes_from_pkgfiles {
foreach my $pp (@allports) {
my $p = (split /\//, $pp)[-1];
my ($rver, $rrel, $rdesc, $rdeps) = get_pkgfile_fields($pp);
$V_REPO{$p} = ($rver) ? $rver : "0";
$DEPENDS{$p} = ($rdeps) ? $rdeps : "";
$DEPENDS{$p} =~ s/,/ /g;
$DESC{$p} = ($rdesc) ? $rdesc : "";
}
}
sub get_pkgfile_fields {
my ($descrip, $url, $maintainer, $packager, $Version, $Release)=('','','','','',0,0);
my ($readme, $preInstall, $postInstall, $Dependencies)=("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 on:\s*(.*)/$1/) { $Dependencies = $_; }
elsif (s/^# Packager:\s*(.*)/$1/) { $packager = $_; }
elsif (s/^# Maintainer:\s*(.*)/$1/) { $maintainer = $_; }
else {}
} close(PF);
if (shift) {
return $Name, $portpath, $Version, $Release, $descrip, $Dependencies, $url,
$packager, $maintainer, $readme, $preInstall, $postInstall;
} else { return $Version, $Release, $descrip, $Dependencies; }
}
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=();
$query =~ s/\+/\\\+/g unless ($osearch{regex}==1);
$query =~ s/\./\\\./g unless ($osearch{regex}==1);
my $linewanted = qr/$query/is;
LOCALENTRY: foreach $lp (@localports) {
open ($fh, "$lp/$portfile") or die "cannot open $portfile for $lp\n";
while (<$fh>) {
next LOCALENTRY if $hits{$lp};
$hits{$lp} = $_ 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>) {
next PORTENTRY if $hits{"$prefix$candidate"};
$hits{"$prefix$candidate"}=$_ if $_ =~ $linewanted;
} close ($fh);
} closedir(DIR);
}
return \%hits;
}
sub find_port_by_desc {
my $query=shift;
$query =~ s/\+/\\\+/g unless ($osearch{regex}==1);
$query =~ s/\./\\\./g unless ($osearch{regex}==1);
my @hits = grep { $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 ($osearch{regex}==1);
$query =~ s/\./\\\./g unless ($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 = map { $_ => 0 } @targets;
foreach my $t (@targets) {
($opkg{test} eq "no") ? system($PKGRM,$opkg{rargs},$t) : print "$PKGRM $opkg{rargs} $t\n";
$removed{$t}=1 if ($?>>8 == 0);
if ((grep /^$t$/, @LOCKED) and ($opkg{test} eq "no")) { port_unlock($t); }
}
return \%removed;
}
sub port_lock {
my %oldlocks = map { $_ => "L" } @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{$_} } @LOCKED;
open (LL, '>', $prtlocker."-tmp");
foreach my $nl (@newlocks) { print LL "$nl\n" unless $nl =~ /^\s*$/; }
close (LL);
system ("mv",$prtlocker."-tmp",$prtlocker);
}
sub list_ports {
my @found; my $subset = shift;
our $indent="0 "; our $height=0; our @descendants=(); our @outfile;
if (! $subset) { # empty arg: 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=@LOCKED;
} elsif ($subset =~ /^(orphans|dependent)$/) {
my $seed=shift;
if ( ((! $seed) and ($subset eq "dependent")) or
((shift @_) and ($subset eq "dependent")) ) {
print "dependent requires exactly one argument.\n";
return;
}
if (($subset eq "dependent") and (! find_port_by_name($seed,1,1,0))) {
print "$seed not found in the ports tree.\n"; return;
}
our @searchspace=(($subset eq "orphans") or ($odepends{all}==0)) ?
keys %V_INST : keys %DEPENDS;
@searchspace = grep { defined $DEPENDS{$_} } @searchspace;
if ($subset eq "orphans") {
my $inst_deps="";
foreach my $port (@searchspace) {
$inst_deps .= " $DEPENDS{$port} " if ($DEPENDS{$port});
}
@found = grep { $inst_deps !~ / $_ / } @searchspace;
} elsif (($subset eq "dependent") and ($odepends{recursive}==0)) {
@found = grep { " $DEPENDS{$_} " =~ / $seed / } @searchspace;
} elsif (($subset eq "dependent") and ($odepends{recursive}==1)) {
push @outfile, "$seed";
my @children = grep { " $DEPENDS{$_} " =~ / $seed / } @searchspace;
foreach my $sd (@children) { recurse_offtree($sd); }
sub recurse_offtree {
my $s = shift; push @outfile, (${indent}x(1+$height))."$s";
my @offspring = grep { " $DEPENDS{$_} " =~ / $s / } @searchspace;
foreach my $dc (@offspring) {
if (grep /^$dc$/, @descendants) {
print "Warning: cyclic dependencies found!\n";
return;
}
push (@descendants, $dc);
$height = 1+$#descendants;
recurse_offtree($dc);
pop(@descendants);
$height = 1+$#descendants;
}
}
my %seen;
@outfile = grep { !m/^\s*$/ } @outfile;
@outfile = sort(@outfile) unless ($odepends{tree}==1);
@found = ($odepends{tree}==1) ? grep { s/0 / /g } @outfile :
grep !$seen{$_}++, grep { s/0 //g } @outfile;
unshift (@found, $seed);
}
# possibilities for the recursive switch have been exhausted
else { }
} # possibilities for the filter have been exhausted
else { }
return @found if ((! $subset) or ($subset =~ /^(orphans|dependent|locked)$/));
if (! $osearch{filter}) { return @found; }
else { return grep {$_ !~ /$osearch{filter}/} @found; }
}
sub port_diff { # returns a scalar indicating how many differences were found
my $dtype=shift; my $lastcol;
my @argq=@_; my $retval=0; my $format="%30s %20s %20s\n";
if ($dtype !~ /^(current|isinst|utd)/) {
printf "$format", "Port", "Installed", "In Repository" if (! $dtype);
foreach my $p (keys %V_INST) {
next if (($osearch{filter}) and ($p !~ /$osearch{filter}/));
next if ((grep /$p/, @LOCKED) and ($odepends{all}==0));
$lastcol = ($V_REPO{$p}) ? $V_REPO{$p} : "MISSING!";
if ($lastcol ne $V_INST{$p}) {
printf "$format", $p, $V_INST{$p}, $lastcol if (! $dtype);
printf "%s ", $p if ($dtype eq "quick" and $lastcol ne "MISSING!");
}
}
printf "\n" if ($dtype eq "quick");
} elsif ($dtype eq "utd") {
while (my $q=shift(@argq) and $retval==0) {
$retval-- if (! $V_INST{$q});
$retval++ if (($V_INST{$q}) and ($V_REPO{$q}) and ($V_INST{$q} ne $V_REPO{$q}));
}
} elsif ($dtype =~ /^(current|isinst)$/) {
foreach my $q (@argq) {
if (! $V_INST{$q}) {
print "$q: not installed\n"; $retval++;
} else {
print "$q: version $V_INST{$q}\n" if ($dtype eq "current");
print "$q is installed.\n" if ($dtype eq "isinst");
}
}
} else {}
return $retval;
}
sub deporder {
# returns an indented list if called with first arg "deptree",
# otherwise returns a flattened list, pruned of duplicates.
# Recursion does NOT continue beyond a dependency satisfied by an alias.
my $format=shift; our $indent="0 "; our $height=0; our @seeds = @_;
our @ancestry=(); our @outfile=(); our @missing; my %installable; my %seen;
foreach my $s (@seeds) {
if (find_port_by_name($s,1,0,0)) { $installable{$s} = 1;
} else { $installable{$s} = 0;
print "$s not found in the ports tree; ignoring.\n";
}
}
foreach my $s (grep { $installable{$_}==1 } @seeds) {
recurse_deptree($s);
}
sub recurse_deptree {
my $s = shift;
if (! grep /$s$/, @allports) { push @missing, "$s"; return; }
my $substitute = who_aliased_to($s);
my $note = ($substitute) ? " (provided by $substitute)" : "";
push @outfile, (${indent}x(1+$height))."$s$note";
my $depstr = $DEPENDS{$s} unless ($substitute);
if ($depstr) {
my @sdeps = split /[ ,]/, $depstr;
foreach my $sd (@sdeps) {
if (grep /^$sd$/, @ancestry) {
print "Warning: cyclic dependency found!\n";
print ((join " => ", @ancestry)."$sd\n");
return;
}
push (@ancestry,$sd);
$height = 1+$#ancestry;
recurse_deptree($sd);
pop @ancestry;
$height = 1+$#ancestry;
}
}
}
if ($format eq "deptree") {
@outfile = grep { s/0 / /g; !m/^\s*$/; } @outfile;
} else {
@outfile = grep !$seen{$_}++,
(grep { s/0 //g; s/ .provided by .*//g; !m/^\s*$/; } sort(@outfile));
}
return @outfile unless ($#missing >= 0);
return @outfile, "MISSING", @missing if ($#missing >= 0);
}
sub up_inst { # returns scalar references to five arrays;
my $type=shift; my @requested=@_; my %EXEMPT; my %WANTED;
my $PKGMK=$opkg{makecommand}; my $PKGADD=$opkg{addcommand};
my $SUDO="/usr/bin/doas"; my $FAKEROOT="/usr/bin/fakeroot";
$SUDO = (-x $SUDO) ? $SUDO : "/usr/bin/sudo";
$SUDO = (-x $SUDO) ? $SUDO : "/usr/bin/su -c";
$FAKEROOT = (-x $FAKEROOT) ? $FAKEROOT : $SUDO;
# prepend commands with sudo/doas/fakeroot if the effective user id is not root
if ($> != 0) { $PKGADD = "$SUDO $PKGADD"; }
# $PKGMK = "$FAKEROOT $PKGMK"; }
# resolve all dependencies unless the command was 'grpinst'
my @targets=($type eq "grpinst") ? @_ : deporder("quickdep",@_);
# filter out the invalid ports if deporder() didn't do so already
@targets = grep { (join " ", @allports) =~ / $_ / } @targets if ($type eq "grpinst");
# exempt any locked ports from an sysup operation
%EXEMPT = map { $_ => 1 } @LOCKED;
%WANTED = map { $_ => 1 } @requested;
if ($action eq "sysup") { @targets = grep {! $EXEMPT{$_}} @targets;
} else {
@targets = grep {(! $EXEMPT{$_}) or ($WANTED{$_})} @targets;
}
# first determine the directories from which pkgmk must be called
# and the package that will appear after a successful build
my %pdirs; my %builtpkg; my %mkcmd; my %addcmd; my %status;
foreach my $t (@targets) {
$opkg{$t} = $opkg{margs};
$opkg{$t} =~ s/-f// if !(grep /$t/, @requested);
$pdirs{$t} = find_port_by_name($t,1,1,0);
$builtpkg{$t} = find_built_pkg($t);
$mkcmd{$t} = "$PKGMK -d $opkg{$t}";
$addcmd{$t} = "$PKGADD -u $builtpkg{$t}";
$status{$t} = "not done";
}
# build each package, unless already installed or satisfied by an alias
foreach my $t (@targets) {
if (who_aliased_to($t)) {
$mkcmd{$t} = "echo \"skipped build ($t provided by an alias)\"";
} else {
$mkcmd{$t} = "" if ((port_diff("utd",$t)==0) and ($opkg{margs} !~ /-f/));
$mkcmd{$t} = "" if (($type eq "install") and ($V_INST{$t}) and ($opkg{margs} !~ /-f/));
$mkcmd{$t} = "echo \"skipped build ($t up to date)\"" if ((-f $builtpkg{$t}) and
((-M $builtpkg{$t}) < (-M "$pdirs{$t}/Pkgfile")));
}
if ($mkcmd{$t}) {
if ((-f "$pdirs{$t}/pre-install") and ($opkg{runscripts} eq "yes")) {
system("sh","$pdirs{$t}/pre-install") unless ($opkg{test} eq "yes");
$status{$t} += ( $?>>8 == 0 ) ? "pre-install ok. " : "pre-install failed. ";
}
($opkg{test} eq "no") ? chdir $pdirs{$t} : print "cd $pdirs{$t}\n";
($opkg{test} eq "no") ? system("$mkcmd{$t}") : print "$mkcmd{$t}\n";
$status{$t} .= ( $?>>8 == 0 ) ? "build ok. " : "build failed. ";
$status{$t} = ( $mkcmd{$t} =~ /skipped/ ) ? "build skipped. " : $status{$t};
if ($status{$t} =~ /build ok/) {
$addcmd{$t} =~ s/ -u / / if (port_diff("utd",$t)<0);
($opkg{test} eq "no") ? system("$addcmd{$t}") : print "$addcmd{$t}\n";
$status{$t} .= ( $?>>8 == 0 ) ? "pkgadd ok. " : "pkgadd failed. ";
}
if (($status{$t} =~ /pkgadd ok/) and (-f "$pdirs{$t}/post-install")
and ($opkg{runscripts} eq "yes")) {
system("sh","$pdirs{$t}/post-install") unless ($opkg{test} eq "yes");
$status{$t} .= ( $?>>8 == 0 ) ? "post-install ok. " : "post-install failed. ";
}
}
last if (($status{$t} =~ /failed/) and ($type eq "grpinst"));
}
my @ok = grep { $status{$_} =~ /pkgadd ok/ } @targets;
my @ok_pre = grep { $status{$_} =~ /pre-install ok/ } @targets;
my @ok_post = grep { $status{$_} =~ /post-install ok/ } @ok;
my @ok_readme = grep -f $pdirs{$_}."/README", @ok;
my @not_ok = grep { $status{$_} =~ /(pkgadd|build) failed/ } @targets;
return \@ok, \@ok_pre, \@ok_post, \@ok_readme, \@not_ok;
}
sub sysup {
my @targets; my $v_repo;
foreach my $p (keys %V_INST) {
$v_repo = ($V_REPO{$p}) ? $V_REPO{$p} : "MISSING" ;
push @targets, $p if (($v_repo ne $V_INST{$p}) and ($v_repo ne "MISSING"));
}
return up_inst("sysup",@targets);
}
sub find_built_pkg {
my $target = shift; my $CONF="/etc/pkgmk.conf"; local $/="\n";
my $COMPRESSION; my $PKG_DIR; my $portpath = (find_port_by_name($target,1,1,0));
my ($version, $release) = (get_pkgfile_fields($portpath))[0,1];
open (CF,$CONF) or return;
while (<CF>) {
$COMPRESSION=$1 if m/^PKGMK_COMPRESSION_MODE=(.*)/;
$PKG_DIR=$1 if m/^PKGMK_PACKAGE_DIR=(.*)/;
} close (CF);
if ($COMPRESSION) {
$COMPRESSION =~ s/"//g;
$COMPRESSION =~ s/'//g;
} else { $COMPRESSION = "gz"; }
if ($PKG_DIR) {
$PKG_DIR =~ s/"//g; $PKG_DIR =~ s/'//g;
$PKG_DIR =~ s/\$\{name\}/$target/g;
$PKG_DIR =~ s/\$name/$target/g;
} else { $PKG_DIR = $portpath; }
return "$PKG_DIR/$target#$version-$release.pkg.tar.$COMPRESSION";
}
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",$pp,"README") if (-f "$pp/README");
port_edit("cat",$pp,"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 ports and their dependencies
update [opt] <port1 port2...> update ports and their dependencies
remove [opt] <port1 port2...> remove ports
GENERAL INFORMATION
list ports in the active repositories
listinst ports currently installed
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>
ls <port> the files in the <port> directory
cat <port> <file> the contents of <port>/<file> on STDOUT
isinst <port> whether port is installed
current <port> installed version of port
SYSTEM UPDATE
sysup update all outdated ports, except those that are locked
lock <port1 port2...> lock each <port> at its current version
unlock <port1 port2...> release the lock on each <port>
listlocked list locked ports
COMMON OPTIONS
-v show version in listing
-vv show version and decription in listing
--path print path to port if appropriate (search, list, depends)
--cache use a cache file
--test do not actually run pkgmk/pkgadd, just print the commands on STDOUT
EOF
}
Reference in New Issue View Git Blame Copy Permalink