plugins/doctor.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);
use mplib::util qw(note ok try_soft split_slot_key);
use mplib::db qw(read_db);
use mplib::resolve qw(init find_portdir remove_pkg);
 
# diagnoses the stale-db-entry problem this session hit repeatedly in its
# own long-lived sandbox: a package marked "installed" in the db with no
# manifest at all -- "mp install" then silently no-ops ("already
# installed, skipping") against something that isn't actually there.
#
# NOT every no-manifest entry is a ghost, though -- mplib::resolve's own
# comments already document the tolerated case (installed before manifest
# tracking existed at all), and this session confirmed it for real
# (cmake, in this same sandbox, genuinely installed and working, no
# manifest). so this never assumes: for each no-manifest entry, it
# actually looks for something on disk plausibly belonging to that
# package (a same-named binary, or -- for a slotted entry -- its own
# prefix directory) before calling it a ghost. --fix only ever removes
# entries that passed that check and still found nothing.
#
# usage: mp doctor [--fix]
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
init();
 
my $fix = 0;
for(my $i = 0; $i < @ARGV; $i = $i + 1)
{
	next unless $ARGV[$i] eq '--fix';
	$fix = 1;
	splice(@ARGV, $i, 1);
	$i = $i - 1;
}
 
my $db = read_db();
my @ghosts;
my @ambiguous;
my $tracked = 0;
 
for my $canon (sort keys %$db)
{
	if(-e "$CFG->{MANDIR}/$canon")
	{
		$tracked = $tracked + 1;
		next;
	}
	my ($base, $slot) = split_slot_key($canon);
	my @candidates = ("$CFG->{INSTPREFIX}/bin/$base", "$CFG->{INSTPREFIX}/sbin/$base");
	push @candidates, "$CFG->{INSTPREFIX}/$base-$slot" if $slot && $slot ne '0';
	# a still-existing port's own pkg_name occasionally differs in case/
	# punctuation from its db canon in edge cases -- find_portdir is the
	# authoritative "does this still even resolve to a real port" check,
	# independent of the filesystem guesses above.
	my $has_port = find_portdir($base) ? 1 : 0;
	my $found = (grep { -e $_ || -l $_ } @candidates) ? 1 : 0;
 
	if($found)
	{
		push @ambiguous, $canon;
	}
	else
	{
		push @ghosts, $canon;
	}
}
 
print "installed (db): " . scalar(keys %$db) . "\n";
print "  with a manifest: $tracked\n";
print "  no manifest, something plausible on disk (left alone -- probably pre-manifest-tracking): "
    . scalar(@ambiguous) . "\n";
print "    $_\n" for @ambiguous;
print "  no manifest, nothing found on disk (ghost -- likely stale state): " . scalar(@ghosts) . "\n";
print "    $_\n" for @ghosts;
 
unless(@ghosts)
{
	ok('nothing to fix');
	exit 0;
}
 
if($fix)
{
	print "\nfixing:\n";
	for my $canon (@ghosts)
	{
		if(try_soft(sub { remove_pkg($canon, read_db()); }))
		{
			ok("$canon cleared");
		}
		else
		{
			note("$canon: remove_pkg failed, left as-is");
		}
	}
}
else
{
	print "\nrun with --fix to clear the ghost entries above (each one just runs the\n";
	print "same \"mp remove --force\" you'd run by hand -- nothing touches the ambiguous list).\n";
}