new script for checking lib dependencies

[Marc Espie <espie_(_at_)_nerim_(_dot_)_net>]

This one works on packages, similarly to find-all-conflicts
and check-common-dirs.

It's not fully tested yet. It takes forever to run it, since it does
extract all files and looks at objdump -p.

It also won't work on a.out systems.

I should probably fold all the tests into one script at some point in
the not so distant future.

#!/usr/bin/perl

# $OpenBSD$
# Copyright (c) 2004 Marc Espie <espie_(_at_)_openbsd_(_dot_)_org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

# check all packages in the current directory, and report common directory
# issues

use strict;
use warnings;

use File::Spec;
use File::Path;
use File::Basename;
use OpenBSD::PackageLocator;
use OpenBSD::PackageInfo;
use OpenBSD::PackingList;
use File::Temp;

package OpenBSD::PackingList;

sub visit
{
	my ($self, $method, @l) = @_;

	if (defined $self->{cvstags}) {
		for my $item (@{$self->{cvstags}}) {
			$item->$method(@l);
		}
	}

	for my $special (OpenBSD::PackageInfo::info_names()) {
		$self->{$special}->$method(@l, 0) if defined $self->{$special};
	}

	for my $unique_item (qw(name no-default-conflict manual-installation extrainfo arch)) {
		$self->{$unique_item}->$method(@l) if defined $self->{$unique_item};
	}
	for my $listname (qw(modules pkgcfl pkgdep newdepend libdepend items)) {
		if (defined $self->{$listname}) {
			for my $item (@{$self->{$listname}}) {
				$item->$method(@l);
			}
		}
	}
	for my $special (OpenBSD::PackageInfo::info_names()) {
		$self->{$special}->$method(@l, 1) if defined $self->{$special};
	}
}

package OpenBSD::PackingElement;
sub check_libs
{
}

package OpenBSD::PackingElement::LibDepend;
sub check_libs
{
	my ($item, $t, $where, $handle, $system_libs) = @_;
	$t->{deps}->{$item->{def}} = 1;
}

package OpenBSD::PackingElement::NewDepend;
sub check_libs
{
	&OpenBSD::PackingElement::LibDepend::check_libs;
}

package OpenBSD::PackingElement::FileBase;
use File::Basename;
sub check_libs
{
	my ($item, $t, $where, $handle, $system_libs) = @_;
	my $fullname = File::Spec->canonpath($item->fullname());
	if ($fullname =~ m/(lib[^\/]+\.so\.\d+)\.\d+$/) {
		$t->{has_libs}->{$&} = 1;
		$t->{has_libs}->{$1} = 1;
	}
	my $file = $handle->next();
	$file->{destdir} = $where;
	$file->{cwd} = $item->{cwd};
	$file->{name} = $fullname;
	# this will fail because of links, so we don't care.
	eval { $file->create(); };
	if ($@) {
		return;
	}
	open(my $cmd, "objdump -p $where$fullname 2>/dev/null|");
	local $_;
	while(<$cmd>) {
		if (m/^\s+NEEDED\s+(.*?)\s*$/) {
			my $l = $1;
			$l =~ s,^/usr/local/lib/(lib[^/]+\.so),$1,;
			$t->{need_libs}->{$l} = $fullname unless defined $system_libs->{$l};
		}
	}
	close($cmd);
	unlink($where.$fullname);
}

package main;

sub analyze 
{
	my ($plist, $db, @l) = @_;

	my $where = File::Temp::mkdtemp("/tmp/zoinx.XXXXXXXXXX");
	my $pkgname = $plist->pkgname();
	$db->{$pkgname} = {
		pkgname => $pkgname,
		has_libs => {},
		need_libs => {},
		deps => {},
		walked => 0
	} unless defined $db->{$pkgname};
	my $t = $db->{$pkgname};
	$plist->visit('check_libs', $t, $where, @l);
	rmtree($where);
}

sub walk_libs
{
	my ($entry, $db) = @_;
	return if $entry->{walked};
	for my $dep (keys %{$entry->{deps}}) {
		print "Can't find $dep\n" unless defined $db->{$dep};
		walk_libs($db->{$dep}, $db);
		for my $l (keys %{$db->{$dep}->{has_libs}}) {
			$entry->{has_libs}->{$l} = 1;
		}
		$entry->{walked} = 1;
	}
}

print "Scanning packages\n";
print "-----------------\n";
if (@ARGV==0) {
	@ARGV=(<*.tgz>);
}

my $system_libs = {};
for my $l (glob('{/usr/lib,/usr/X11R6/lib}/lib*.so*')) {
	if ($l =~ m/\/(lib[^\/]+\.so\.\d+\.\d+)$/) {
		$system_libs->{$1} = 1;
	}
}
	
my $db = {};
for my $pkgname (@ARGV) {
	print STDERR "$pkgname:\n";
	my $true_package = OpenBSD::PackageLocator->find($pkgname);
	next unless $true_package;
	my $dir = $true_package->info();
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
	analyze($plist, $db, $true_package, $system_libs);
	$true_package->close();
	rmtree($dir);
}

for my $pkgname (sort keys %$db) {
	my $t = $db->{$pkgname};
	walk_libs($t, $db);
	my @l = ();
	for my $lib (sort keys %{$t->{need_libs}}) {
		next if defined $t->{has_libs}->{$lib};
		push(@l, "$lib (".$t->{need_libs}->{$lib}.")") unless defined $t->{has_libs}->{$lib};
	}
	if (@l != 0) {
		print $pkgname, ": ", join(' ', @l), "\n";
	}
}