plugins/depcheck.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 slot_key bare_name 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 try_pkgconf effective_deps);
use mplib::portformat qw(resolve_slot);
 
# a real, post-build dependency sniffer: runs ldd on every ELF binary/
# library an ALREADY-INSTALLED port's own manifest lists, works out which
# installed package actually owns each linked .so (by checking every
# other package's own manifest for that path), and flags any owner that
# isn't covered by this port's declared pkg_deps -- this is the thing
# mplib::portlint's static check_missing_tool_deps CAN'T see (a real
# runtime link, not just a tool NAME appearing in add.sh's text), and
# would have caught tmux/libevent or postgresql's real library needs
# even if the port's own comments never mentioned the tool by name.
#
# requires the port to be genuinely installed right now (mp devtest
# --keep <port> first, if you just want to check one before removing it
# again).
#
# usage: mp depcheck <port> [--dir=<root>]
#   --dir  also search <root> (the same way CUSTOM_PORTS_DIR already is,
#          first, ahead of every configured repo) -- for reading the
#          port's own pkg_deps/pkg.conf; whether it's genuinely
#          installed is unrelated to --dir at all (that's the db, not
#          the port directory).
 
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 depcheck <port> [--dir=<root>] (must be currently installed -- try: mp devtest --keep <port>)")
    unless defined $ARGV[0];
init();
 
my $tok = parse_dep_token($ARGV[0]);
my $portdir = find_portdir($tok->{name}, $tok->{slot});
fail("port $ARGV[0] not found") unless $portdir;
my $pc = pkgconf($portdir);
my $slot  = resolve_slot($pc, $pc->{pkg_name});
my $canon = slot_key($pc->{pkg_name}, $slot);
 
my @files = read_lines("$CFG->{MANDIR}/$canon");
fail("$canon has no manifest -- it isn't installed right now (mp devtest --keep $ARGV[0] first)")
    unless @files;
 
my $db = read_db();
my @deps = effective_deps($pc, $canon);
my %have_literal = map { $_ => 1 } @deps;
my @tag_deps = map { s/^%//r } grep { /^%/ } @deps;
 
# cache: canon -> pkg_tags of the port that provides it (only computed
# for owners actually encountered below, not the whole tree).
my %tags_of;
sub tags_of {
	my ($owner_canon) = @_;
	return $tags_of{$owner_canon} if exists $tags_of{$owner_canon};
	my $obase = bare_name($owner_canon);
	my $odir = find_portdir($obase);
	my $opc = $odir ? try_pkgconf($odir) : undef;
	return $tags_of{$owner_canon} = $opc ? { map { $_ => 1 } split ' ', ($opc->{pkg_tags} || '') } : {};
}
 
sub satisfied {
	my ($owner_canon) = @_;
	my $obase = bare_name($owner_canon);
	return 1 if $have_literal{$obase} || $have_literal{$owner_canon};
	my $otags = tags_of($owner_canon);
	return 1 if grep { $otags->{$_} } @tag_deps;
	return 0;
}
 
# which installed package owns this INSTPREFIX-relative path, by checking
# every other package's own manifest -- built lazily (only once, on first
# use) since depcheck usually only runs against one port at a time.
my %owner_of;
sub build_owner_index {
	for my $c (keys %$db)
	{
		next if $c eq $canon;
		for my $rel (read_lines("$CFG->{MANDIR}/$c"))
		{
			$owner_of{$rel} = $c;
		}
	}
	return;
}
build_owner_index();
 
my %flagged;
my $nchecked = 0;
for my $rel (@files)
{
	my $path = "$CFG->{INSTPREFIX}/$rel";
	next unless -f $path && !-l $path;
	# quick ELF sniff (first 4 bytes) instead of shelling out to file(1)
	# for every manifest entry -- most of a typical manifest is headers/
	# docs/man pages, not binaries.
	open(my $fh, '<:raw', $path) or next;
	my $magic;
	read($fh, $magic, 4);
	close($fh);
	next unless defined $magic && $magic eq "\x7fELF";
	$nchecked = $nchecked + 1;
	for my $line (`ldd \Q$path\E 2>/dev/null`)
	{
		next unless $line =~ m{=>\s+(\Q$CFG->{INSTPREFIX}\E/\S+)};
		my $libpath = $1;
		(my $rel_lib = $libpath) =~ s{^\Q$CFG->{INSTPREFIX}\E/}{};
		my $owner = $owner_of{$rel_lib};
		next unless defined $owner;
		next if satisfied($owner);
		push @{$flagged{$owner}}, "$rel -> $rel_lib";
	}
}
 
if(!$nchecked)
{
	print "no ELF binaries/libraries in ${canon}'s own manifest to check.\n";
	exit 0;
}
unless(%flagged)
{
	print "ok: every linked library $canon actually uses traces back to a declared dependency ($nchecked file(s) checked).\n";
	exit 0;
}
print "$canon links against packages not covered by its own pkg_deps:\n";
for my $owner (sort keys %flagged)
{
	print "  $owner (via " . join(', ', @{$flagged{$owner}}) . ")\n";
}
print "\nadd " . join(' or ', sort keys %flagged) . " to pkg_deps, or a %tag it provides, if this is a real runtime need.\n";
exit(1);