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

857 lines
34 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 %olog = ( write => "disabled", mode => "overwrite", rm_on_success => "yes",
file => "/var/log/pkgbuild/%n.log" );
my $prtconf = "/etc/prt-get.conf"; my @bldirs = parse_prt_conf($prtconf);
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(.*)\n/; }
close (DB);
}
if ($action =~ /^(diff|quickdiff|listlocked|depends|deptree|remove|install|update|depinst|grpinst|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);
} 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|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) 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";
foreach my $fh (keys %hits) {
chomp($hits{$fh});
@fmatch = split /\s/, $hits{$fh};
foreach my $fileN (@fmatch) { printf $strf, $fh, $fileN; }
}
} 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|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 $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 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|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 = 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{runscripts} = $1 if /^runscripts\s+(yes|no)/;
$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{file} = $1 if /^logfile\s+(.*)\s*(#|$)/;
$prtcache = $1 if /^cachefile\s+(.*)\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 {
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;
printf CACHE "\n";
} 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[12] = (grep /^$p$/, keys %V_INST) ? "yes" : "no";
$pstats[13] = (grep /^$p$/, @LOCKED) ? "yes" : "no";
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 $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>; chomp($V_REPO{$p});
$V_REPO{$p} .= <$cf>; $DESC{$p} = <$cf>;
$deps = <$cf>;
chomp($deps, $DESC{$p}, $V_REPO{$p});
$DEPENDS{$p} = ($deps ne "") ? $deps : " ";
$DEPENDS{$p} =~ s/, / /g; $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";
$V_REPO{$p} .= ($rrel) ? "-$rrel" : "-1";
$DEPENDS{$p} = ($rdeps) ? $rdeps : "";
$DEPENDS{$p} =~ s/, / /g; $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);
$Dependencies =~ s/, / /g; $Dependencies =~ s/,/ /g;
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=();
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 = 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 (($subset eq "dependent") and (! find_port_by_name($seed,1,1,0))) {
print "$seed not found in the ports tree.\n"; return;
}
$seed =~ s/\+/\\\+/g; # workaround for any port with a plus sign in its name
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 (! $V_REPO{$s}) { 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 %pdirs;
my %builtpkg; my %mkcmd; my %addcmd; my %status; my %logfile; my %pvars;
my $PKGMK=$opkg{makecommand}; my $PKGADD=$opkg{addcommand};
my $SUDO="/usr/bin/doas"; my $FAKEROOT="/usr/bin/fakeroot";
# prepend commands with sudo/doas/fakeroot if the effective user id is not root
$SUDO = (-x $SUDO) ? $SUDO : "/usr/bin/sudo";
$FAKEROOT = (-x $FAKEROOT) ? $FAKEROOT : $SUDO;
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 { ($V_REPO{$_}) } @targets if ($type eq "grpinst");
# exempt any locked ports from an update operation
%EXEMPT = map { $_ => 1 } @LOCKED;
%WANTED = map { $_ => 1 } @requested;
if ($action =~ /^(update|install|depinst)$/) {
@targets = grep {(! $EXEMPT{$_}) or ($WANTED{$_})} @targets;
}
# first determine the directories from which pkgmk must be called,
# the package that will appear after a successful build,
# and where to save the build log.
my ($COMPRESSION, $PKG_DIR) = parse_pkgmk_conf();
foreach my $t (@targets) {
$opkg{$t} = $opkg{margs}; $pvars{'%n'}=$t;
$opkg{$t} =~ s/-f// unless ($WANTED{$t});
$pvars{'%p'} = find_port_by_name($t,1,1,0); $pdirs{$t} = $pvars{'%p'};
($pvars{'%v'}, $pvars{'%r'}) = (get_pkgfile_fields($pvars{'%p'}))[0,1];
$builtpkg{$t} = ($PKG_DIR) ? "$PKG_DIR/$t#$pvars{'%v'}-$pvars{'%r'}.pkg.tar.$COMPRESSION" : "$pvars{'%p'}/$t#$pvars{'%v'}-$pvars{'%r'}.pkg.tar.$COMPRESSION";
$builtpkg{$t} =~ s/\$name/$t/g; $builtpkg{$t} =~ s/\$\{name\}/$t/g;
$mkcmd{$t} = "$PKGMK -d $opkg{$t}";
$addcmd{$t} = "$PKGADD -u $builtpkg{$t}";
$status{$t} = "not done";
if ($olog{write} eq "enabled") {
$logfile{$t} = $olog{file};
$logfile{$t} =~ s/(%n|%v|%r|%p)/$pvars{$1}/g;
$mkcmd{$t} .= ($olog{mode} eq "append") ? " 2>&1 |/usr/bin/tee -a $logfile{$t}"
: " 2>&1 |/usr/bin/tee $logfile{$t}";
}
}
# 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} = "echo \"skipped build ($t up to date)\"" if ((-f $builtpkg{$t}) and
((-M $builtpkg{$t}) < (-M "$pdirs{$t}/Pkgfile")) and ($opkg{$t} !~ /-f/));
$mkcmd{$t} = "" if ((port_diff("utd",$t)==0) and !($WANTED{$t}));
$mkcmd{$t} = "" if (($V_INST{$t}) and ($type =~ /^(install|depinst)$/) and ($opkg{$t} !~ /-f/));
}
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. " unless ($logfile{$t});
$status{$t} .= (! log_failure($logfile{$t})) ? "build ok. " : "build failed. " if ($logfile{$t});
$status{$t} = ( $mkcmd{$t} =~ /skipped/ ) ? "build skipped. " : $status{$t};
if (($status{$t} =~ /build ok/) or ($mkcmd{$t} =~ /up to date/)) {
$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. ";
unlink($logfile{$t}) if (($logfile{$t}) and ($olog{rm_on_success} eq "yes"));
}
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"));
}
sub log_failure {
my $lf=shift; local $/=""; my $failed=0;
open(FH,$lf) or return 0;
while (<FH>) { $failed=1 if m/=====> ERROR: /; }
close(FH); return $failed;
}
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) {
next if grep /^$p$/, @LOCKED;
$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 parse_pkgmk_conf {
my $CONF="/etc/pkgmk.conf"; my $COMPRESSION; my $PKG_DIR="";
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/#(.*)$//; # remove same-line comments like this one
$COMPRESSION =~ s/"//g; # remove double-quotes (thanks jaeger!)
} else { $COMPRESSION = "gz"; }
$PKG_DIR =~ s/"//g;
return $COMPRESSION, $PKG_DIR;
}
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 ports and their dependencies
update [opt] <port1 port2...> update ports and their dependencies
grpinst [opt] <port1 port2...> install these ports, do not resolve 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
--test do not actually run pkgmk/pkgadd, just print the commands on STDOUT
EOF
exit;
}
Reference in New Issue View Git Blame Copy Permalink