| git.druid.rocks | index | druid520 | mp | src/ | mplib/ | config.pm |
src/mplib/config.pm
use v5.16;
package mplib::config;
use strict;
use warnings FATAL => 'all';
use Exporter 'import';
our @EXPORT_OK = qw($CFG load parse_flags load_overlay write_conf set_pkgconf read_conf first_repo_file);
our $CFG;
sub read_conf {
my ($path) = @_;
my (%conf, %pconf);
my $fh;
my $cur;
if(open($fh, '<', $path))
{
while(my $line = <$fh>)
{
chomp $line;
next if $line !~ /\S/ || $line =~ /^\s*#/;
# a "<name>:" header opens (or switches to) that port's section
# (name allows a colon itself, for SLOT references like gcc:12)
if($line =~ /^\s*(?:port\s*:\s*)?(\S+?)\s*:\s*(?:#.*)?$/)
{
$cur = $1;
next;
}
if($line =~ /^\s*([A-Za-z0-9_+-]+)\s*=\s*(.*)$/)
{
my ($k, $v) = ($1, $2);
my $indented = ($line =~ /^\s/ ? 1 : 0);
# a quoted value is a complete, literal string -- '#'
# inside it is NOT a comment marker, so only strip a
# trailing " #comment" from an UNQUOTED value. applying
# the strip unconditionally (the old behavior) silently
# truncated any quoted value containing " #" at all,
# even one write_conf itself just wrote and immediately
# re-quoted for exactly this reason.
if($v =~ /^"(.*)"$/ || $v =~ /^'(.*)'$/)
{
$v = $1;
}
else
{
$v =~ s/\s+#.*$//;
}
# an unindented key=value is global and closes any section.
$cur = undef unless $indented;
if(defined $cur)
{
$pconf{$cur}{$k} = $v;
}
else
{
$conf{$k} = $v;
}
}
}
close($fh);
}
return (\%conf, \%pconf);
}
sub apply_conf {
my ($conf, $pconf, $confdb, $pconfdb) = @_;
my $ov = $conf->{OVERLAYS};
for my $k (keys %$conf)
{
$confdb->{$k} = $conf->{$k};
}
for my $p (keys %$pconf)
{
$pconfdb->{$p} = $pconf->{$p};
}
if(defined $ov && $ov ne '')
{
# one shared $seen across the sibling list: a diamond (two
# siblings both pulling the same child) is a legitimate shape,
# and the child must apply exactly once, at its first mention --
# applying it again via the later sibling would overwrite that
# sibling's own keys with the child's (the "harmless no-op"
# assumption load_overlay's comment makes only holds when the
# child sets no key the parents also set).
my %ovseen;
for my $f (split ' ', $ov)
{
load_overlay($f, $confdb, $pconfdb, \%ovseen);
}
}
return;
}
# quotes a value for write_conf so it round-trips through read_conf
# exactly, whatever it contains -- an unquoted value with a space+'#'
# (e.g. "-O2 #tuned") would otherwise be silently truncated by
# read_conf's inline-comment stripping on the very next read, even
# though write_conf never actually wrote a comment there. prefers double
# quotes; falls back to single quotes if the value itself contains a
# literal '"' (and no "'"); dies for the narrow remaining case this
# format genuinely can't represent (a value with both quote characters,
# or an embedded newline, which would corrupt read_conf's line-oriented
# section/key structure on the next read regardless of quoting).
sub quote_conf_value {
my ($v) = @_;
die("pkgconf.conf: value cannot contain a newline: $v\n") if $v =~ /\n/;
return qq("$v") unless $v =~ /"/;
return qq('$v') unless $v =~ /'/;
die("pkgconf.conf: value contains both \" and ', cannot be safely quoted: $v\n");
}
# write a "<name>:" / indented "KEY=val" file exactly matching read_conf's
# own grammar, so anything written here reads back identically -- used
# only for pkgconf.conf (see set_pkgconf below), a file mp itself fully
# owns and regenerates, so there is no user formatting/comments to
# preserve, only correct round-tripping. a section with no keys left is
# simply omitted -- that's how "unset" makes an empty section disappear.
sub write_conf {
my ($path, $pconf) = @_;
my $fh;
open($fh, '>', $path) or die("cannot write $path: $!\n");
for my $name (sort keys %$pconf)
{
my @keys = sort keys %{$pconf->{$name}};
next unless @keys;
print $fh "$name:\n";
for my $k (@keys)
{
print $fh "\t$k=" . quote_conf_value($pconf->{$name}{$k}) . "\n";
}
print $fh "\n";
}
close($fh);
return;
}
# the single primitive every hold/mask/use "sugar" command uses: read the
# mp-managed per-package overlay ($CFG->{WD}/pkgconf.conf, loaded at
# highest precedence by load() below), set-or-delete one key in one
# "<canon>:" section, write it back. $value undef deletes the key (and
# the whole section header if that was its last key).
sub set_pkgconf {
my ($canon, $key, $value) = @_;
my $path = "$CFG->{WD}/pkgconf.conf";
my (undef, $pconf) = read_conf($path);
if(defined $value && $value ne '')
{
$pconf->{$canon}{$key} = $value;
}
else
{
delete $pconf->{$canon}{$key};
delete $pconf->{$canon} unless %{$pconf->{$canon} || {}};
}
write_conf($path, $pconf);
# also mirror the change into $CFG->{pconf} itself, not just the file
# on disk: pkgconf.conf is loaded as an overlay straight into
# $CFG->{pconf} (load()'s own "highest precedence" call, above), so
# writing here without also updating the in-memory copy left any
# SAME-PROCESS read-back after this call (pconf_lookup/enabled_use,
# both keyed off $CFG->{pconf} directly) seeing the state from
# BEFORE this write, not after. every existing caller of this
# function (mp use/hold/mask/conflicts) never actually read anything
# back afterward in the same process, so this staleness was real but
# silent -- only surfaced once mplib::resolve::apply_use_requirement
# needed to set a USE override and have code later in that SAME
# install_pkg call (resolve_slot's own pkg_slot_use composition, in
# particular) immediately see the new state, not next run's.
if(defined $value && $value ne '')
{
$CFG->{pconf}{$canon}{$key} = $value;
}
else
{
delete $CFG->{pconf}{$canon}{$key};
delete $CFG->{pconf}{$canon} unless %{$CFG->{pconf}{$canon} || {}};
}
return;
}
sub load_overlay {
my ($path, $confdb, $pconfdb, $seen) = @_;
$seen ||= {};
# a repeat load of the same path is either a true OVERLAYS cycle or a
# harmless diamond (two overlays both pulling in one shared file) --
# either way, stop recursing rather than dying, since a diamond is a
# legitimate config shape and re-applying the same keys again would be
# a no-op anyway.
return if $seen->{$path}++;
my ($c, $pc) = read_conf($path);
for my $k (keys %$c)
{
$confdb->{$k} = $c->{$k};
}
for my $p (keys %$pc)
{
$pconfdb->{$p} = { %{($pconfdb->{$p} || {})}, %{$pc->{$p}} };
}
if(defined $c->{OVERLAYS} && $c->{OVERLAYS} ne '')
{
for my $f (split ' ', $c->{OVERLAYS})
{
load_overlay($f, $confdb, $pconfdb, $seen);
}
}
return;
}
# strip and return the shared global flags (--force/-f, --no-deps,
# --unmask, --config=<file>) from @ARGV; every mp.<cmd> script calls this
# once at the top so flag handling is identical everywhere without mp
# itself (the dispatcher) needing to know what any flag means.
sub parse_flags {
my ($argv) = @_;
my %flags = (FORCE => 0, NODEPS => 0, UNMASK => 0, DRYRUN => 0, INPLACE => 0, RESUME => 0, YES => 0, CLIOVERLAY => []);
for(my $i = 0; $i < @$argv; $i = $i + 1)
{
if($argv->[$i] eq '--force' || $argv->[$i] eq '-f')
{
$flags{FORCE} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] eq '--yes' || $argv->[$i] eq '-y')
{
$flags{YES} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] eq '--no-deps')
{
$flags{NODEPS} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] eq '--inplace')
{
$flags{INPLACE} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] eq '--resume')
{
$flags{RESUME} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] eq '--unmask')
{
$flags{UNMASK} = 1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] =~ /^--config=(.+)$/)
{
push @{$flags{CLIOVERLAY}}, $1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
elsif($argv->[$i] =~ /^--sysroot=(.+)$/)
{
$flags{SYSROOT} = $1;
splice(@$argv, $i, 1);
$i = $i - 1;
}
}
return \%flags;
}
# REPO_<name>=<git-url> declares one named ports repo; REPO_<name>_BRANCH=
# and REPO_<name>_PRIORITY=<n> are optional per-repo metadata (branch to
# clone/track; priority is "lower wins" -- same convention as pkg_pref --
# default 50, ties broken by name). every port/class/profile/sysroot-
# overlay lookup searches CUSTOM_PORTS first, then every repo in priority
# order, first match wins -- a straight generalization of the old
# single-PORTS_REPO/CUSTOM_PORTS precedence to any number of independently
# configured repos. zero REPO_* keys at all falls back to one repo (named
# "main", at the historical default URL) so an unconfigured system still
# bootstraps with no config file at all. $ENV{REPO_<name>} overrides an
# already-declared repo's URL, same spirit as PORTS_DIR/CUSTOM_PORTS_DIR's
# own env overrides just below.
sub _parse_repos {
my ($conf, $portsdir) = @_;
my %repos;
for my $k (keys %$conf)
{
next unless $k =~ /^REPO_(\w+)$/;
my $name = $1;
# a metadata key (REPO_<name>_BRANCH/_PRIORITY) also matches
# ^REPO_(\w+)$ itself (\w includes '_') -- skip it here, it's
# picked up by name below once every REPO_<name>=<url> key (the
# only thing that actually DECLARES a repo) has been seen.
next if $name =~ /_(?:BRANCH|PRIORITY)$/;
$repos{$name}{url} = $conf->{$k};
}
for my $name (keys %repos)
{
my $b = $conf->{"REPO_${name}_BRANCH"};
$repos{$name}{branch} = $b if defined $b && $b ne '';
my $p = $conf->{"REPO_${name}_PRIORITY"};
$repos{$name}{priority} = (defined $p && $p ne '') ? $p : 50;
$repos{$name}{url} = $ENV{"REPO_$name"} if defined $ENV{"REPO_$name"} && $ENV{"REPO_$name"} ne '';
}
unless(%repos)
{
$repos{main} = {
url => $ENV{REPO_main} || 'git://git.druid.rocks/druid520/ports.git',
priority => 50,
};
}
my @ordered = sort { $repos{$a}{priority} <=> $repos{$b}{priority} || $a cmp $b } keys %repos;
# a lone repo (the overwhelmingly common case: either zero-config, or
# one explicit REPO_<name>=) lives directly AT $portsdir, exactly
# where the old single-PORTS_REPO scheme always cloned it (so
# $portsdir/ports/<cat>/<name>, an existing checkout, a running
# PORTS_DIR=/usr/ports env var, and this whole tree's own test suite
# all keep working with zero migration). only once a SECOND repo is
# configured does every repo (this one included) move to its own
# $portsdir/repos/<name> -- a one-time re-clone the first time
# REPO_extra=... (or a third, fourth, ...) is added, not something a
# single-repo setup ever pays for.
my $single = @ordered == 1;
return [ map {
my $dir = $single ? $portsdir : "$portsdir/repos/$_";
{ name => $_, url => $repos{$_}{url}, branch => $repos{$_}{branch},
priority => $repos{$_}{priority}, dir => $dir, ports => "$dir/ports" };
} @ordered ];
}
# first existing "<repo-dir>/$relpath" across $repos (an arrayref of
# {dir=>...} hashes, already in priority order, as returned by
# _parse_repos/stored at $CFG->{REPOS}) -- the shared "search every
# configured ports repo, first match wins" primitive behind profile/
# sysroot-overlay lookups here and class lookups in mplib::portformat.
sub first_repo_file {
my ($repos, $relpath) = @_;
for my $r (@$repos)
{
my $p = "$r->{dir}/$relpath";
return $p if -f $p;
}
return undef;
}
# load config + apply flags, populate and return $CFG (also cached there
# for every other mplib::* module to read via "use mplib::config qw($CFG);").
# call once, near the top of each mp.<cmd> script, after parse_flags().
sub load {
my ($flags) = @_;
$flags ||= { FORCE => 0, NODEPS => 0, UNMASK => 0, DRYRUN => 0, YES => 0, CLIOVERLAY => [] };
my ($sysconf, $sysports) = read_conf('/etc/mp.conf');
my ($userconf, $userports) = $ENV{HOME} ? read_conf("$ENV{HOME}/.mp.conf") : ({}, {});
my %conf;
my %pconf;
apply_conf($sysconf, $sysports, \%conf, \%pconf);
apply_conf($userconf, $userports, \%conf, \%pconf);
{
# shared visit set across the cli overlay list, same diamond
# rationale as apply_conf's own OVERLAYS loop just above.
my %ovseen;
for my $f (@{$flags->{CLIOVERLAY}})
{
load_overlay($f, \%conf, \%pconf, \%ovseen);
}
}
# PROFILE=<name> (set by any of the above) pulls in a shippable, named
# overlay from the ports tree itself, at the LOWEST precedence -- it
# only fills in keys nothing above already set, like a distro base
# profile you can still override locally. a profile can itself set
# PROFILE=<other> to chain to a further base profile, one hop lower in
# precedence each time (e.g. "server" filling in from "minimal") --
# walked in a loop rather than the single non-recursive read this used
# to be, which silently ignored a profile's own PROFILE= key entirely.
# computed here (once), rather than where it used to live further
# down, so PORTS_DIR's own default can live under it (see $pdir) --
# everything mp manages (db/manifest/stage/hooks AND, now, every
# configured ports repo) then defaults under one root instead of
# spreading across $WD and a separately-defaulted /usr/ports.
my $basewd = $ENV{WD} || $conf{WD} || '/usr/mp';
my $pdir = $ENV{PORTS_DIR} || $conf{PORTS_DIR} || "$basewd/repos";
# bootstrap-only: %conf hasn't absorbed the PROFILE=/OVERLAYS= chain
# yet, so this can't see a repo a profile itself declares -- good
# enough to walk PROFILE= itself (below), which needs SOME resolved
# repo list to search; recomputed for real, from the fully-merged
# %conf, once that chain is done (see $repos below).
my $profile_repos = _parse_repos(\%conf, $pdir);
my $pname = $conf{PROFILE};
my %pseen;
while(defined $pname && $pname ne '')
{
# a straight chain (each profile names at most one next-hop), not
# a general graph like OVERLAYS/@sets -- so unlike those, ANY
# repeat here is unambiguously a real cycle, never a legitimate
# diamond, and deserves a loud failure rather than a silent stop.
die("PROFILE=$pname chains back to itself\n") if $pseen{$pname}++;
# searched across every configured repo in priority order (same
# as a port/class lookup), not just a single fixed PORTS_DIR --
# a profile can ship from any repo, not only the highest-priority
# one.
my $ppath = first_repo_file($profile_repos, "profiles/$pname/mp.conf");
# read_conf silently returns empty hashes for a missing file (same
# as a genuinely empty-but-present profile), so a typo'd PROFILE=
# would otherwise fall through with zero diagnostic -- not
# mplib::util::note() here, to avoid a circular use (util.pm
# itself uses mplib::config), so this matches note()'s "warn: "
# convention by hand instead.
print STDERR "warn: PROFILE=$pname not found (searched: "
. join(', ', map { "$_->{dir}/profiles/$pname/mp.conf" } @$profile_repos) . ").\n"
unless defined $ppath;
my ($pc2, $pp2) = defined $ppath ? read_conf($ppath) : ({}, {});
for my $k (keys %$pc2)
{
$conf{$k} = $pc2->{$k} unless exists $conf{$k};
}
for my $p (keys %$pp2)
{
for my $k (keys %{$pp2->{$p}})
{
$pconf{$p}{$k} = $pp2->{$p}{$k} unless exists $pconf{$p}{$k};
}
}
$pname = $pc2->{PROFILE};
}
# both recomputed against the fully-merged %conf (the PROFILE=/
# OVERLAYS= chain above may have contributed its own WD=/PORTS_DIR=/
# REPO_<name>=) -- $basewd and $pdir/$profile_repos above only
# existed to bootstrap that same chain and are done being used now.
$basewd = $ENV{WD} || $conf{WD} || '/usr/mp';
my $portsdir = $ENV{PORTS_DIR} || $conf{PORTS_DIR} || "$basewd/repos";
my $repos = _parse_repos(\%conf, $portsdir);
# a named sysroot (sysroots/<name>.conf, sibling to profiles/classes/)
# is a config overlay at the HIGHEST precedence -- loaded last, so it
# wins over /etc/mp.conf, ~/.mp.conf, --config= overlays and PROFILE=
# alike -- typically setting its own INSTPREFIX (and optionally
# TARGET_*/ARCH/MICROARCH) for whatever gets installed "into" it.
# db/manifest/stage live under a name-specific WD subdirectory
# regardless of what the overlay itself sets, so a sysroot's package
# tracking is always fully isolated from the default root's, and from
# every other sysroot's.
if(defined $flags->{SYSROOT} && $flags->{SYSROOT} ne '')
{
# same repo-priority search as PROFILE= just above, instead of a
# single fixed PORTS_DIR/sysroots/<name>.conf.
my $spath = first_repo_file($repos, "sysroots/$flags->{SYSROOT}.conf");
load_overlay($spath, \%conf, \%pconf) if defined $spath;
}
$CFG = {
conf => \%conf,
pconf => \%pconf,
WD => (defined $flags->{SYSROOT} && $flags->{SYSROOT} ne '')
? "$basewd/sysroots/$flags->{SYSROOT}" : $basewd,
PORTS_DIR => $portsdir,
REPOS => $repos,
CUSTOM_PORTS => $ENV{CUSTOM_PORTS_DIR} || $conf{CUSTOM_PORTS_DIR} || '/usr/local/ports',
MPX => $ENV{MP_BACKEND} || $conf{MP_BACKEND} || '/usr/local/libexec/mp/mpx',
# a sysroot's own MP_PREFIX wins even over an inherited $ENV{MP_PREFIX}
# (unlike the plain no-sysroot case just below it): --sysroot=<name>
# is a deliberate, specific request, so it shouldn't lose to whatever
# ambient env var happens to already be set from an outer context.
INSTPREFIX => (defined $flags->{SYSROOT} && $flags->{SYSROOT} ne '' && defined $conf{MP_PREFIX} && $conf{MP_PREFIX} ne '')
? $conf{MP_PREFIX} : ($ENV{MP_PREFIX} || $conf{MP_PREFIX} || '/usr/local'),
SHELL => $ENV{SHELL} || $conf{SHELL} || '/bin/sh',
HOOKSDIR => $ENV{HOOKS_DIR} || $conf{HOOKS_DIR} || undef,
GLOBAL_DEPS => (defined $conf{GLOBAL_DEPS} && $conf{GLOBAL_DEPS} ne '') ? $conf{GLOBAL_DEPS} : '%libc %shell %coreutils',
SYSROOT => $flags->{SYSROOT},
FORCE => $flags->{FORCE},
DRYRUN => $flags->{DRYRUN},
NODEPS => $flags->{NODEPS},
UNMASK => $flags->{UNMASK},
INPLACE => $flags->{INPLACE},
RESUME => $flags->{RESUME},
YES => $flags->{YES},
CLIOVERLAY => $flags->{CLIOVERLAY},
};
$CFG->{DBFILE} = "$CFG->{WD}/db";
$CFG->{MANDIR} = "$CFG->{WD}/manifest";
$CFG->{HOOKSDIR} = "$CFG->{WD}/hooks" unless defined $CFG->{HOOKSDIR};
# an mp-managed overlay (see mplib::config::set_pkgconf) written by the
# hold/mask/use sugar commands -- highest precedence of all, so it's
# never silently shadowed by hand-edited config. root-scoped like
# db/manifest above: a --sysroot=<name> invocation gets its own,
# already-correct since $CFG->{WD} above is already the sysroot's.
load_overlay("$CFG->{WD}/pkgconf.conf", $CFG->{conf}, $CFG->{pconf});
$ENV{MP_PREFIX} = $CFG->{INSTPREFIX};
$ENV{MP_TARGET} = $conf{TARGET} ? $conf{TARGET} : 'native';
return $CFG;
}
1;