src/sysroot.pl

#!/usr/bin/env perl
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use mplib::config qw($CFG load first_repo_file);
use mplib::util qw(note ok fail backend);
use mplib::db qw(read_db write_db write_manifest read_lines read_linkdeps write_linkdeps_for);
use mplib::resolve qw(init);
 
# mp sysroot install <name> [pkg...]
#
# folds a named sysroot's own installed packages onto the live root, in
# place: every file its manifest(s) list is copied over (atomically,
# per file -- see mpx's own "merge" command), its db/manifest/linkdeps
# entries are copied into the live root's, and that's it. deliberately
# NOT a sync: a live-root package the sysroot doesn't have is left
# completely alone, on purpose -- this overlays a built environment onto
# the running one, it doesn't try to make the two identical. HOLD on the
# live side is deliberately not consulted either: naming a sysroot here
# is itself the explicit, one-time action HOLD exists to gate against
# happening by accident (a routine "mp update world" silently touching
# something pinned) -- not a fit for this command at all.
#
# this is the other half of the same primitive "mp reinstall --inplace"
# uses for a single package (see mplib::resolve::reinstall_pkg): build
# the WHOLE replacement first, entirely outside the live root (a sysroot
# is just a fully independent WD/db/manifest/INSTPREFIX -- see
# mplib::resolve::with_sysroot_scope's own comment), then fold it over
# once it's known good. the live root's old files are never removed
# first the way a normal reinstall's del.sh-then-add.sh cycle would --
# see the languages/perl5 port's own del.sh/pkg.conf comments for the
# real incident (a self-hosting package bricking mp itself mid-reinstall)
# that made generalizing this worthwhile instead of hand-protecting one
# port at a time.
my $flags = mplib::config::parse_flags(\@ARGV);
load($flags);
fail("usage: mp sysroot install <name> [pkg...]")
    unless @ARGV >= 2 && $ARGV[0] eq 'install';
shift @ARGV;
my $name = shift @ARGV;
my @only = @ARGV;
 
fail("sysroot '$name' not found (no repos/*/sysroots/$name.conf)")
    unless first_repo_file($CFG->{REPOS}, "sysroots/$name.conf");
 
# same save/swap/restore shape as with_sysroot_scope, just for the whole
# invocation instead of one package: read everything needed out of the
# sysroot's own, fully independent config, then restore before touching
# the live root at all.
my $live = $CFG;
load({ %$flags, SYSROOT => $name });
fail("sysroot '$name' has the same MP_PREFIX as the live root ($CFG->{INSTPREFIX}) -- refusing to merge a tree onto itself")
    if $CFG->{INSTPREFIX} eq $live->{INSTPREFIX};
my $src_prefix   = $CFG->{INSTPREFIX};
my $src_mandir   = $CFG->{MANDIR};
my $src_db       = read_db();
my $src_linkdeps = read_linkdeps();
$CFG = $live;
 
my @pkgs = @only ? @only : sort keys %$src_db;
fail("sysroot '$name' has nothing installed") unless @pkgs;
 
init();
my $live_db = read_db();
for my $canon (@pkgs)
{
	fail("'$canon' is not installed in sysroot '$name'") unless $src_db->{$canon};
	my $manfile = "$src_mandir/$canon";
	unless(-f $manfile)
	{
		note("'$canon': no manifest in sysroot '$name', skipping (db entry copied, files not touched)");
		$live_db->{$canon} = $src_db->{$canon};
		next;
	}
	note("merging $canon from sysroot '$name'");
	backend('merge', $src_prefix, $CFG->{INSTPREFIX}, $manfile);
	write_manifest($canon, [read_lines($manfile)]);
	$live_db->{$canon} = $src_db->{$canon};
	if($src_linkdeps->{$canon})
	{
		write_linkdeps_for($canon, [sort keys %{$src_linkdeps->{$canon}}]);
	}
	ok("$canon merged from sysroot '$name'");
}
write_db($live_db);