#!/usr/bin/perl

# $OpenBSD: check-newlib-depends,v 1.19 2006/11/11 13:11:45 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, $opt_f);
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 ($@ or defined $item->{symlink}) {
		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/;
			if ($main::opt_f) {
			    if (!defined $t->{needlib}->{$lib}) {
				$t->{needlib}->{$lib} = [];
			    }
			    push(@{$t->{needlib}->{$lib}}, $fullname);
			} else {
			    $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}} = $self->{pkgpath};
}

package main;

getopts('od:f');

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, $pkgpath) = @_;

	# try physical package
	if (defined $opt_d) {
		my $location = "$opt_d/$pkgname.tgz";

		my $true_package = OpenBSD::PackageLocator->find($pkgname);
		if ($true_package) {
			my $dir = $true_package->info();
			# twice read
			if (-d $dir) {
				my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
				$true_package->close();
				rmtree($dir);
				return $plist;
			}
		}
	}
	# ask the ports tree
	my $portsdir = $ENV{PORTSDIR} || "/usr/ports";
	my $make = $ENV{MAKE} || "make";
	open my $fh, "cd $portsdir && env -i SUBDIR=$pkgpath ECHO_MSG=: make print-plist |" or return undef;
	my $plist = OpenBSD::PackingList->read($fh);
	close $fh;
	return $plist;
}

sub handle_dependency
{
	my ($pkgname, $pkgpath) = @_;
	my $plist = get_plist($pkgname, $pkgpath);

	if (!defined $plist || !defined $plist->pkgname()) {
		print "Error: can't solve dependency for $pkgname/$pkgpath\n";
		print "Error: use -d directory or set the PORTSDIR correctly\n";
		return;
	}

	register_dependencies($plist);
	OpenBSD::SharedLibs::add_plist_libs($plist);
}

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

	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";
			$want =~ s/\.\d+$//;
			$r->{wantlib}->{$want} = 1;
			return;
		}
	}

	while (my ($p, $pkgpath) = each %{$dependencies->{$plist->pkgname()}}) {
		next if defined $dependencies->{$p};
		handle_dependency($p, $pkgpath);
	}

	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 = %{$dependencies->{$plist->pkgname()}};
	my $done = {};
	while (@todo >= 2) {
		my $path = pop @todo;
		my $dep = pop @todo;
		next if $done->{$dep};
		$done->{$dep} = 1;
		handle_dependency($dep, $path)
		    	unless defined $dependencies->{$dep};
		push(@todo, %{$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";
				$want =~ s/\.\d+$//;
				$r->{wantlib}->{$want} = 1;
				return;
			}
		}
		print "Missing $want (coming from ", join(',', @r), " ($binary) (NOT REACHABLE)\n";
		return;
	}
	print "Missing: $want ($binary): NOT REACHABLE\n";
}

sub print_list
{
	my ($head, $h) = @_;

	my $line = "";
	for my $k (sort keys %$h) {
		if (length $line > 50) {
			print $head, $line, "\n";
			$line = "";
		}
		$line .= ' '.$k;
	}
	if ($line ne '') {
		print $head, $line, "\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);
	}
	my $r = { wantlib => {}, libdepends => {}, wantlib2 => {} };
	for my $lib (sort keys %{$t->{needlib}}) {
		my $fullname = $t->{needlib}->{$lib};
		$fullname = $fullname->[0] if $opt_f;
		if (!defined $t->{haslib}->{$lib}) {
			report_lib_issue($plist, $lib, $fullname, $r);
		}
		$t->{haslib}->{$lib} = 2;
	}
	for my $k (sort keys %{$t->{haslib}}) {
		my $v = $t->{haslib}->{$k};
		next if $v == 2;
		print "Extra: $k\n";
	}
	print_list("\tWANTLIB +=", $r->{wantlib});
	if ($opt_f) {
	    for my $lib (sort keys %{$t->{needlib}}) {
		    print "$lib:\t\n";
		    for my $binary (sort @{$t->{needlib}->{$lib}}) {
			    print "\t$binary\n";
		    }
	    }
	}
	rmtree($where);
}

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

	print "\n$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();
	$true_package->wipe_info();
	$plist->forget();
	return 1;
}


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

exit(0);