src/mp.pl

#!/usr/bin/env perl
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
 
# mp is (mostly) a pure dispatcher: it does not read mp.conf, resolve
# anything, or touch the db itself. it discovers "mp.<command>" scripts
# sitting next to it (so "mp foo" always matches whatever mp.foo scripts
# are actually installed, no hardcoded command list to keep in sync) and
# execs the one matching argv[0], passing every remaining argument through
# untouched -- each mp.<command> parses its own --force/--no-deps/
# --unmask/--yes/-y/--config= via mplib::config::parse_flags, identically,
# so mp itself needs to know what none of those flags mean. a plugin (see
# docs/reference/extensions.btft) is just another mp.<command> file
# sitting right there next to the core ones by the time mp runs --
# dispatch above needs no separate lookup for it -- but mk/b.sh also drops
# a "plugins.list" file naming which of the installed mp.<command>s came
# from plugins/, purely so usage() below can list them separately from
# the core set.
#
# the one deliberate exception: "mp rescue" (below) DOES read /etc/mp.conf
# and touch pkgconf.conf directly, with its own minimal ad hoc parsing
# rather than mplib::config -- an emergency path has to keep working even
# if every mp.<command> and mplib::* module were somehow gone, so it can't
# depend on either.
 
my $BINDIR = $FindBin::Bin;
 
# a plain "KEY=value" (optionally quoted) line lookup against one file --
# NOT mplib::config::load (real config parsing, sections, OVERLAYS=,
# profiles, the works): rescue() below deliberately avoids every
# mplib::* module, unlike every real command, so it keeps working even
# if mplib itself were somehow missing or broken. good enough for the
# handful of top-level keys rescue actually needs.
sub cfgval {
	my ($path, $key, $default) = @_;
	open(my $fh, '<', $path) or return $default;
	while(my $line = <$fh>)
	{
		next unless $line =~ /^\Q$key\E=(.*)$/;
		close($fh);
		(my $v = $1) =~ s/^"(.*)"$/$1/;
		return $v;
	}
	close($fh);
	return $default;
}
 
# emergency recovery: rebuilds mp from source and reinstalls EVERY
# mp.<command> and mplib::* module, unconditionally -- no USE-flag gating
# at all, since the whole point is recovering from having gated one of
# them (install/update/use/reinstall/commands, most critically) out of
# existence. lives directly in mp.pl itself, dispatched exactly like
# help/version above rather than as a separate mp.<command> file, so it
# can never itself be excluded by any USE flag -- "mp" (this file) is the
# one thing add.sh always installs unconditionally and del.sh never
# removes, on purpose, for exactly this reason.
#
# the git url isn't hardcoded here a second time: it's read straight out
# of meta/mp's own add.sh/pkg.conf (the ports tree's own single source of
# truth for where mp's source actually comes from), found the same
# minimal way every lookup here works -- plain WD=/PORTS_DIR= lines in
# /etc/mp.conf, falling back to this project's own documented defaults
# if either is unset or the file itself is missing.
sub rescue {
	my $wd       = cfgval('/etc/mp.conf', 'WD', '/usr/mp');
	my $portsdir = cfgval('/etc/mp.conf', 'PORTS_DIR', "$wd/repos");
	my $prefix   = $ENV{MP_PREFIX} || cfgval('/etc/mp.conf', 'MP_PREFIX', '/usr/local');
 
	# single-repo layout (ports/<cat>/<name>, this project's own default
	# and overwhelmingly common case) first; a multi-repo setup instead
	# keeps each configured repo under $portsdir/repos/<name>/ports --
	# checked second since it's the less common shape.
	my ($portdir) = grep { -f "$_/add.sh" || -f "$_/pkg.conf" }
	    ("$portsdir/ports/meta/mp", glob("$portsdir/repos/*/ports/meta/mp"));
	unless($portdir)
	{
		print STDERR "err: rescue: can't find meta/mp's own recipe under $portsdir "
		    . "(or its repos/*/ports) -- can't tell where mp's own source comes from.\n";
		exit 1;
	}
 
	my $url;
	if(open(my $pfh, '<', "$portdir/pkg.conf"))
	{
		local $/;
		($url) = (<$pfh>) =~ /^pkg_fetch="git:([^@"]+)/m;
		close($pfh);
	}
	if(!$url && open(my $afh, '<', "$portdir/add.sh"))
	{
		local $/;
		my $add = <$afh>;
		close($afh);
		if($add =~ /^\s*git\s+clone\s+(.*)$/m)
		{
			my @tok = split ' ', $1;
			shift @tok while @tok && $tok[0] =~ /^-/;
			$url = $tok[0];
		}
	}
	unless($url)
	{
		print STDERR "err: rescue: found $portdir, but no git url in its pkg_fetch or add.sh's own git clone line.\n";
		exit 1;
	}
 
	print STDERR "rescue: cloning $url ...\n";
	my $tmp = "/tmp/mp-rescue.$$";
	system('rm', '-rf', $tmp);
	if(system('git', 'clone', '--quiet', '--depth', '1', $url, $tmp) != 0)
	{
		print STDERR "err: rescue: git clone failed.\n";
		exit 1;
	}
 
	print STDERR "rescue: building ...\n";
	unless(-f "$tmp/mk/b.sh" && system("cd \Q$tmp\E && sh mk/b.sh >&2") == 0)
	{
		print STDERR "err: rescue: build failed.\n";
		system('rm', '-rf', $tmp);
		exit 1;
	}
 
	print STDERR "rescue: reinstalling every command and extension, unconditionally ...\n";
	system('mkdir', '-p', "$prefix/bin/mplib", "$prefix/libexec/mp");
	system("cp \Q$tmp/mpx\E \Q$prefix/libexec/mp/mpx\E && chmod +x \Q$prefix/libexec/mp/mpx\E");
	system("cp \Q$tmp/mp\E \Q$prefix/bin/mp\E && chmod +x \Q$prefix/bin/mp\E");
	for my $f (glob("$tmp/mp.*"))
	{
		next unless -x $f && !-d $f;
		my $dest = "$prefix/bin/" . (split m{/}, $f)[-1];
		system("cp \Q$f\E \Q$dest\E && chmod +x \Q$dest\E");
	}
	for my $f (glob("$tmp/mplib/*.pm"))
	{
		my $dest = "$prefix/bin/mplib/" . (split m{/}, $f)[-1];
		system("cp \Q$f\E \Q$dest\E");
	}
	system('rm', '-rf', $tmp);
 
	# a broken USE= override for "mp" itself (exactly what gets you here
	# in the first place: "-commands"/"-install" persisted, so the NEXT
	# ordinary reinstall/update would just strip everything straight back
	# out again) is the other half of really being unstuck, not just the
	# files -- WD/pkgconf.conf is the one and only place that lives,
	# entirely mp-managed, and safe to just clear here.
	my $pkgconf = "$wd/pkgconf.conf";
	if(open(my $fh, '<', $pkgconf))
	{
		my @lines = <$fh>;
		close($fh);
		my @out;
		my $skipping = 0;
		for my $line (@lines)
		{
			if($line =~ /^mp:\s*$/) { $skipping = 1; next; }
			$skipping = 0 if $skipping && $line =~ /^\S/;
			push @out, $line unless $skipping;
		}
		if(@out != @lines && open(my $ofh, '>', $pkgconf))
		{
			print $ofh @out;
			close($ofh);
			print STDERR "rescue: cleared mp's own USE= override in $pkgconf.\n";
		}
	}
 
	print STDERR "rescue: done -- every core command and extension reinstalled, USE-flag state reset to defaults.\n";
	return;
}
 
sub plugin_names {
	my %names;
	if(open(my $fh, '<', "$BINDIR/plugins.list"))
	{
		while(my $line = <$fh>)
		{
			chomp $line;
			$names{$line} = 1 if $line =~ /\S/;
		}
		close($fh);
	}
	return \%names;
}
 
sub discover_cmds {
	my @cmds;
	opendir(my $dh, $BINDIR) or return @cmds;
	for my $f (sort readdir($dh))
	{
		next unless $f =~ /^mp\.(.+)$/;
		next unless -f "$BINDIR/$f" && -x "$BINDIR/$f";
		push @cmds, $1;
	}
	closedir($dh);
	return @cmds;
}
 
sub usage {
	my @cmds = discover_cmds();
	my $plugins = plugin_names();
	my @core    = grep { !$plugins->{$_} } @cmds;
	my @plug    = grep { $plugins->{$_} } @cmds;
	print STDERR "usage: mp <command> [pkg...] [--force] [--no-deps] [--unmask] [--yes] [--config=<file>]\n";
	print STDERR "install/update/remove/reinstall/hold/unhold/use/mask/unmask/prune/clean ask\n";
	print STDERR "'[y/N] continue?' at a real terminal before doing anything -- --yes/-y skips\n";
	print STDERR "it (as does anything driving mp non-interactively, e.g. a script or this\n";
	print STDERR "tree's own test suite: the prompt is TTY-gated, silently skipped whenever\n";
	print STDERR "there is no terminal to ask or answer at).\n";
	print STDERR "commands: " . (@core ? join(' ', @core) : '(none found next to mp itself)') . "\n";
	print STDERR "plugins: " . join(' ', @plug) . "\n" if @plug;
	print STDERR "world expands to every installed package; all to every port; \@name to a\n";
	print STDERR "package set (WD/sets/name.set). %tag deps resolve to the lowest-pkg_pref\n";
	print STDERR "provider (or a TARGET_<tag>/TAG_<tag> pin), backtracking to the next\n";
	print STDERR "provider if the first would conflict. per-package '<name>:' config, USE\n";
	print STDERR "flags, HOLD, MASK, hooks, overlays, profiles, dep modification, SLOT, and\n";
	print STDERR "version constraints are all documented in mp.conf.example. writing your own\n";
	print STDERR "plugin command is documented in docs/reference/extensions.btft.\n";
	print STDERR "mp rescue rebuilds and reinstalls every command/extension from source,\n";
	print STDERR "unconditionally (no USE-flag gating) -- an emergency escape hatch if you've\n";
	print STDERR "excluded install/update/use/reinstall (or commands) from a USE flag and have\n";
	print STDERR "no other mp.<command> left to fix it with.\n";
	print STDERR "--version is an alias for the real mp.version command (mp's own version,\n";
	print STDERR "what mpx was actually built with, and this same command/plugin list).\n";
	return;
}
 
my $cmd = shift @ARGV;
# the one flag-shaped spelling dispatch normalizes before the generic
# "look for mp.$cmd" lookup below: mp.version is a real command like any
# other (src/version.pl), discovered and exec'd the identical way, but
# "mp --version" is the conventional spelling most CLI tools accept
# alongside a bare "mp version" -- rewriting it here, once, is simpler
# than teaching the generic dispatch itself about flag-shaped commands.
$cmd = 'version' if defined $cmd && $cmd eq '--version';
 
if($cmd && $cmd eq 'help')
{
	usage();
	exit 0;
}
if($cmd && $cmd eq 'rescue')
{
	rescue();
	exit 0;
}
unless(defined $cmd && -f "$BINDIR/mp.$cmd" && -x "$BINDIR/mp.$cmd")
{
	print STDERR "err: bad usage.\n";
	usage();
	exit 1;
}
 
exec("$BINDIR/mp.$cmd", @ARGV) or do {
	print STDERR "err: cannot execute $BINDIR/mp.$cmd: $!.\n";
	exit 1;
};