plugins/devtest.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(fail note ok slot_key bare_name try_soft strip_flag_value);
use mplib::db qw(read_db read_lines);
use mplib::version qw(parse_dep_token);
use mplib::resolve qw(init find_portdir pkgconf install_pkg remove_pkg clean_pkg resolved_db_key);
use mplib::portformat qw(resolve_slot);
 
# one command for the exact cycle every real bug this session was caught
# by: clean-stage + install + a real binary landed and runs + remove +
# confirm nothing's left. exists specifically to stop hitting the two
# things that wasted the most time doing this by hand: testing a stale
# copy because a leftover stage dir made mpx reuse it instead of a fresh
# clone, and "already installed, skipping" against a package that's
# actually a stale db entry with zero files on disk (this tree's own
# long-lived sandbox had ~229 of exactly that).
#
# usage: mp devtest <port> [--keep] [--try="binary --flag"] [--dir=<root>]
#   --keep   skip the remove step at the end (so you can poke at the
#            result yourself) -- still does the clean-stage-first step.
#   --try    run this exact command (relative to no particular cwd) as
#            the smoke check instead of the auto-guessed one; pass an
#            empty string ("--try=") to skip the smoke check entirely.
#   --dir    also search <root> (the same way CUSTOM_PORTS_DIR already
#            is, first, ahead of every configured repo) -- install_pkg/
#            remove_pkg below resolve the port the exact same way "mp
#            install" itself does, so this is enough for a full real
#            install/remove cycle against a port scaffolded via
#            "mp new --dir=<root>", with nothing added to any repo.
 
my $flags = mplib::config::parse_flags(\@ARGV);
mplib::config::load($flags);
my $dir = strip_flag_value(\@ARGV, 'dir');
$CFG->{CUSTOM_PORTS} = $dir if defined $dir;
fail("usage: mp devtest <port> [--keep] [--try=\"binary --flag\"] [--dir=<root>]") unless defined $ARGV[0];
init();
 
my $keep = 0;
my $trycmd;
my $try_given = 0;
for(my $i = 0; $i < @ARGV; $i = $i + 1)
{
	if($ARGV[$i] eq '--keep')
	{
		$keep = 1;
		splice(@ARGV, $i, 1);
		$i = $i - 1;
	}
	elsif($ARGV[$i] =~ /^--try=(.*)$/)
	{
		$trycmd = $1;
		$try_given = 1;
		splice(@ARGV, $i, 1);
		$i = $i - 1;
	}
}
 
my $reqname = $ARGV[0];
my $tok = parse_dep_token($reqname);
my $portdir = find_portdir($tok->{name}, $tok->{slot});
fail("port $reqname not found") unless $portdir;
my $pc = pkgconf($portdir);
my $slot  = resolve_slot($pc, $pc->{pkg_name});
my $canon = slot_key($pc->{pkg_name}, $slot);
 
print STDERR "=== devtest $canon ===\n";
 
# step 1: whatever state this package is in right now (really installed,
# a stale ghost db entry, or a leftover stage dir from a previous failed
# attempt), get to a clean slate before the real test even starts --
# every one of these is a no-op if there's genuinely nothing there.
try_soft(sub { remove_pkg($canon, read_db()); });
try_soft(sub { clean_pkg($canon); });
 
# step 2: the real install, through the exact same code path "mp
# install" itself uses -- no special-cased test mode, so a pass here
# means exactly what a real "mp install" would have done.
my $install_ok = try_soft(sub { install_pkg($canon, read_db(), {}, 1); });
print STDERR $install_ok ? "install: ok\n" : "install: FAIL\n";
 
# captured now (before remove even runs) -- read_lines on the manifest
# AFTER remove tells you nothing new (mpx deletes the manifest file
# itself once del.sh's script exits 0, whether or not that script
# actually removed every file it names -- exactly the ruby bug this
# session: del.sh ran clean, exited 0, and never touched 6 of its own
# symlinks). the only real signal is checking every path THIS install
# actually created still exists on disk after remove claims to be done.
my @installed_files = $install_ok ? read_lines("$CFG->{MANDIR}/$canon") : ();
 
# step 3: best-effort smoke check -- did a real binary land, and does it
# at least run without crashing outright. informational only: plenty of
# legitimate tools have no --version/--help (or would try to actually DO
# something on either, e.g. start a daemon), so a probe that finds
# nothing runnable is reported, never treated as a failure.
my $smoke_note = 'skipped';
if($install_ok && (!$try_given || $trycmd ne ''))
{
	my @bins = grep { m{^s?bin/[^/]+$} } @installed_files;
	if($trycmd)
	{
		my ($tryname) = split ' ', $trycmd;
		if(-x "$CFG->{INSTPREFIX}/bin/$tryname")
		{
			my $rc = system("$CFG->{INSTPREFIX}/bin/$trycmd >/dev/null 2>&1");
			$smoke_note = ($rc == 0) ? "ran ok: $trycmd" : "tried, no clean exit: $trycmd";
		}
		else
		{
			$smoke_note = "$CFG->{INSTPREFIX}/bin/$tryname isn't there or isn't executable";
		}
	}
	elsif(@bins)
	{
		my @found;
		for my $rel (@bins)
		{
			my $path = "$CFG->{INSTPREFIX}/$rel";
			next unless -x $path && !-d $path;
			my $ran = 0;
			for my $flag (qw(--version -V --help -h))
			{
				my $rc = system("$path $flag >/dev/null 2>&1");
				if($rc == 0) { $ran = 1; last; }
			}
			push @found, "$rel" . ($ran ? '' : ' (no --version/-V/--help/-h worked -- may still be fine)');
		}
		$smoke_note = @found ? join(', ', @found) : 'no bin/ entries in the manifest to try';
	}
	else
	{
		$smoke_note = 'no bin/ entries in the manifest (a library-only port? pass --try= to silence this)';
	}
}
elsif(!$install_ok)
{
	$smoke_note = 'n/a (install failed)';
}
print STDERR "smoke: $smoke_note\n";
 
# step 4: remove, through the same real code path, unless --keep.
my $remove_ok = 1;
if($keep)
{
	print STDERR "remove: skipped (--keep)\n";
}
else
{
	$remove_ok = try_soft(sub { remove_pkg($canon, read_db()); });
	print STDERR $remove_ok ? "remove: ok\n" : "remove: FAIL\n";
 
	# step 5: did remove actually clean up, or just report success while
	# leaving files behind (ruby's exact bug this session: del.sh ran
	# clean, exited 0, mpx deleted the manifest -- and 6 of its own
	# symlinks were still sitting on disk, with nothing about "remove: ok"
	# showing it). the manifest is gone either way once del.sh exits 0;
	# the only real signal is checking every path THIS install actually
	# put there is really gone now.
	my @left = grep { -e "$CFG->{INSTPREFIX}/$_" || -l "$CFG->{INSTPREFIX}/$_" } @installed_files;
	if(@left)
	{
		print STDERR "clean: FAIL -- still on disk after remove: " . join(', ', @left) . "\n";
		$remove_ok = 0;
	}
	else
	{
		print STDERR "clean: ok\n";
	}
}
 
my $overall = $install_ok && $remove_ok;
print STDERR $overall ? "\nok: $canon devtest passed.\n" : "\nerr: $canon devtest FAILED.\n";
exit($overall ? 0 : 1);