openbsd-ports/infrastructure/package/check-newlib-depends

#!/usr/bin/perl

# $OpenBSD: check-newlib-depends,v 1.9 2005/03/26 11:52:58 espie Exp $
# Copyright (c) 2004 Marc Espie <espie@openbsd.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 library issues

use strict;
use warnings;

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

our ($opt_o, $opt_d);
package OpenBSD::PackingList;

package OpenBSD::PackingElement;
sub check_wantlibs
{
}

sub depwalk
{
}

package OpenBSD::PackingElement::Wantlib;
sub check_wantlibs
{
	my ($item, $t, $where, $handle) = @_;
	my $name = $item->{name};
	$name =~ s/^(.*\/)?(.*)\.(\d+)\.\d+$/$2.$3/;
	$t->{haslib}->{$name} = 1;
}

package OpenBSD::PackingElement::FileBase;
use File::Basename;
sub shellquote
{
	local $_ = shift;
	s/[*?;() #\\'"`\${}]/\\$&/g;
	return $_;
}

sub check_wantlibs
{
	my ($item, $t, $where, $handle) = @_;
	my $fullname = File::Spec->canonpath($item->fullname());
	my $file = $handle->next();
	$file->{destdir} = $where;
	$file->{cwd} = $item->cwd();
	$file->{name} = $fullname;
	my $linux_bin = 0;
	my $freebsd_bin = 0;
	if ($fullname =~ m,^/usr/local/emul/redhat/,) {
		$linux_bin = 1;
	}
	if ($fullname =~ m,^/usr/local/emul/freebsd/,) {
		$freebsd_bin = 1;
	}
	# this will fail because of links, so we don't care.
	eval { $file->create(); };
	unless ($@) {
		my $n = shellquote("$where$fullname");
		my $cmd;
		if ($main::opt_o) {
			open($cmd, "ldd -f 'NEEDED lib%o.so.%m.%n\\n'|");
		} else {
			open($cmd, "objdump -p $n 2>/dev/null|");
		}
		local $_;
		my @l;
		while(<$cmd>) {
			if (m/^\s+NEEDED\s+(.*?)\s*$/) {
				my $lib = $1;
				push(@l, $lib);
				# detect linux binaries
				if ($lib eq 'libc.so.6') {
					$linux_bin = 1;
				}
			}
		}
		close($cmd);
		# okay, we are not OpenBSD, we don't have sensible names
		if ($linux_bin or $freebsd_bin) {
			return;
		}
		for my $lib (@l) {
			# don't look for modules
			next if $lib =~ m/\.so$/;
			$lib =~ s/^(.*\/)?lib(.*)\.so\.(\d+)\.\d+$/$2.$3/;
			$t->{needlib}->{$lib} = $fullname;
		}
	}
	if ($fullname =~ m/^(.*\/)?lib(.*)\.so\.(\d+)\.\d+$/) {
		$t->{haslib}->{"$2.$3"} = 2;
	}
	unlink($where.$fullname);
}

package OpenBSD::PackingElement::Dependency;

sub depwalk
{
	my ($self, $h) = @_;
	$h->{$self->{def}} = 1;
}

package main;

getopts('od:');

my $dependencies = {};

sub register_dependencies
{
	my $plist = shift;
	my $pkgname = $plist->pkgname();
	my $h = {};
	$dependencies->{$pkgname} = $h;
	$plist->visit('depwalk', $h);
}

sub get_plist
{
	my $pkgname = shift;

	my $location = "$opt_d/$pkgname.tgz";

	my $true_package = OpenBSD::PackageLocator->find($pkgname);
	return 0 unless $true_package;
	my $dir = $true_package->info();
	# twice read
	return 0 unless -d $dir;
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
	$true_package->close();
	rmtree($dir);
	register_dependencies($plist);
	OpenBSD::SharedLibs::add_plist_libs($plist);
}

sub report_lib_issue
{
	my ($plist, $lib, $binary) = @_;

	OpenBSD::SharedLibs::add_system_libs('/');
	my $libspec = "$lib.0";
	my $want = $lib;
	for my $dir (qw(/usr /usr/X11R6)) {
		my @r = OpenBSD::SharedLibs::lookup_libspec($dir, $libspec);
		if (grep { $_ eq 'system' } @r) {
			print "Missing system lib: $want ($binary)\n";
			return;
		}
	}

	for my $p (keys %{$dependencies->{$plist->pkgname()}}) {
		next if defined $dependencies->{$p};
		get_plist($p);
	}

	my @r = OpenBSD::SharedLibs::lookup_libspec('/usr/local', $libspec);
	if (@r > 0) {
		for my $p (@r) {
			if (defined $dependencies->{$plist->pkgname()}->{$p}) {
				print "Missing: $want from $p ($binary) (probably LIB_DEPENDS)\n";
				return;
			}
		}
	}
	# okay, let's walk for WANTLIB
	my @todo = (keys %{$dependencies->{$plist->pkgname()}});
	my $done = {};
	while (my $dep = pop @todo) {
		next if $done->{$dep};
		$done->{$dep} = 1;
		get_plist($dep);
		push(@todo, keys %{$dependencies->{$dep}});
	}
	@r = OpenBSD::SharedLibs::lookup_libspec('/usr/local', $libspec);
	if (@r > 0) {
		for my $p (@r) {
			if (defined $done->{$p}) {
				print "Missing: $want from $p ($binary) (reachable through dependencies: WANTLIB)\n";
				return;
			}
		}
		print "Missing $want (coming from ", join(',', @r), " ($binary) (NOT REACHABLE)\n";
		return;
	}
	print "Missing: $want ($binary): NOT REACHABLE\n";
}

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

	my $where = File::Temp::mkdtemp("/tmp/zoinx.XXXXXXXXXX");
	my $pkgname = $plist->pkgname();
	my $t = { haslib => {}, needlib => {} };
	$plist->visit('check_wantlibs', $t, $where, @l);
	if (!defined $dependencies->{$pkgname}) {
		register_dependencies($plist);
		OpenBSD::SharedLibs::add_plist_libs($plist);
	}
	while (my ($lib, $fullname) = each %{$t->{needlib}}) {
		if (!defined $t->{haslib}->{$lib}) {
			report_lib_issue($plist, $lib, $fullname);
		}
		$t->{haslib}->{$lib} = 2;
	}
	while (my ($k, $v) = each %{$t->{haslib}}) {
		next if $v == 2;
		print "Extra: $k\n";
	}
	rmtree($where);
}

my $db = {};
sub do_pkg
{
	my $pkgname = shift;

	print STDERR "$pkgname:\n";
	my $true_package = OpenBSD::PackageLocator->find($pkgname);
	return 0 unless $true_package;
	my $dir = $true_package->info();
	# twice read
	return 0 unless -d $dir;
	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
	analyze($plist, $db, $true_package);
	$true_package->close();
	rmtree($dir);
	$plist->forget();
	return 1;
}


for my $pkgname (@ARGV) {
	do_pkg($pkgname);
}

exit(0);