697 lines
14 KiB
Perl
Executable File
697 lines
14 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# $OpenBSD: check-lib-depends,v 1.16 2008/04/22 21:36:06 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::Find;
|
|
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, $opt_F, $opt_B, $opt_s, $opt_O);
|
|
my $errors = 0;
|
|
|
|
|
|
# FileSource: where we get the files to analyze
|
|
package FileSource;
|
|
|
|
# FakeFileSource : file system
|
|
package FakeFileSource;
|
|
our @ISA=(qw(FileSource));
|
|
sub new
|
|
{
|
|
my ($class, $location) = @_;
|
|
bless {location => $location }, $class
|
|
}
|
|
|
|
sub retrieve
|
|
{
|
|
my ($self, $item) = @_;
|
|
return $self->{location}.$item->fullname;
|
|
}
|
|
|
|
sub skip
|
|
{
|
|
}
|
|
|
|
sub clean
|
|
{
|
|
}
|
|
|
|
# RealFileSource: package archive
|
|
package RealFileSource;
|
|
our @ISA=(qw(FileSource));
|
|
sub new
|
|
{
|
|
my ($class, $handle, $location) = @_;
|
|
bless {handle => $handle, location => $location }, $class;
|
|
}
|
|
|
|
sub prepare_to_extract
|
|
{
|
|
my ($self, $item) = @_;
|
|
require OpenBSD::ArcCheck;
|
|
my $o = $self->{handle}->next;
|
|
$o->{cwd} = $item->cwd;
|
|
if (!$o->check_name($item)) {
|
|
die "Error checking name for $o->{name} vs. $item->{name}\n";
|
|
}
|
|
$o->{name} = $item->fullname;
|
|
$o->{destdir} = $self->{location};
|
|
return $o;
|
|
}
|
|
|
|
sub extracted_name
|
|
{
|
|
my ($self, $item) = @_;
|
|
return $self->{location}.$item->fullname;
|
|
}
|
|
sub retrieve
|
|
{
|
|
my ($self, $item) = @_;
|
|
my $o = $self->prepare_to_extract($item);
|
|
$o->create;
|
|
return $self->extracted_name($item);
|
|
}
|
|
|
|
sub skip
|
|
{
|
|
my ($self, $item) = @_;
|
|
my $o = $self->prepare_to_extract($item);
|
|
$self->{handle}->skip;
|
|
}
|
|
|
|
sub clean
|
|
{
|
|
my ($self, $item) = @_;
|
|
unlink($self->extracted_name($item));
|
|
}
|
|
|
|
# Recorder: how we keep track of which binary uses which library
|
|
package Recorder;
|
|
sub new
|
|
{
|
|
my $class = shift;
|
|
return bless {}, $class;
|
|
}
|
|
|
|
sub reduce_libname
|
|
{
|
|
my ($self, $lib) = @_;
|
|
$lib =~ s/^(.*\/)?lib(.*)\.so\.(\d+)\.\d+$/$2.$3/;
|
|
return $lib;
|
|
}
|
|
|
|
sub libs
|
|
{
|
|
my $self = shift;
|
|
return keys %$self;
|
|
}
|
|
|
|
sub record_rpath
|
|
{
|
|
}
|
|
|
|
# SimpleRecorder: remember one single binary for each library
|
|
package SimpleRecorder;
|
|
our @ISA=(qw(Recorder));
|
|
sub record
|
|
{
|
|
my ($self, $lib, $filename) = @_;
|
|
$self->{$self->reduce_libname($lib)} = $filename;
|
|
}
|
|
|
|
sub binary
|
|
{
|
|
my ($self, $lib) = @_;
|
|
return $self->{$lib};
|
|
}
|
|
|
|
# AllRecorder: remember all binaries for each library
|
|
package AllRecorder;
|
|
our @ISA=(qw(Recorder));
|
|
sub record
|
|
{
|
|
my ($self, $lib, $filename) = @_;
|
|
push(@{$self->{$self->reduce_libname($lib)}}, $filename);
|
|
}
|
|
|
|
sub binaries
|
|
{
|
|
my ($self, $lib) = @_;
|
|
return @{$self->{$lib}};
|
|
}
|
|
sub binary
|
|
{
|
|
my ($self, $lib) = @_;
|
|
return $self->{$lib}->[0];
|
|
}
|
|
|
|
sub dump
|
|
{
|
|
my ($self, $fh) = @_;
|
|
for my $lib (sort $self->libs) {
|
|
print $fh "$lib:\t\n";
|
|
for my $binary (sort $self->binaries($lib)) {
|
|
print $fh "\t$binary\n";
|
|
}
|
|
}
|
|
}
|
|
|
|
package DumpRecorder;
|
|
our @ISA=(qw(Recorder));
|
|
sub record
|
|
{
|
|
my ($self, $lib, $filename) = @_;
|
|
push(@{$self->{$filename}->{libs}}, $lib);
|
|
}
|
|
|
|
sub record_rpath
|
|
{
|
|
my ($self, $path, $filename) = @_;
|
|
push(@{$self->{$filename}->{rpath}}, $path);
|
|
}
|
|
|
|
sub dump
|
|
{
|
|
my ($self, $fh) = @_;
|
|
while (my ($binary, $v) = each %$self) {
|
|
print $fh $binary;
|
|
if (defined $v->{rpath}) {
|
|
print $fh "(", join(':', @{$v->{rpath}}), ")";
|
|
}
|
|
print $fh ": ", join(',', @{$v->{libs}}), "\n";
|
|
}
|
|
}
|
|
|
|
sub retrieve
|
|
{
|
|
my ($self, $filename) = @_;
|
|
open(my $fh, '<', $filename) or die "Can't read $filename: $!";
|
|
local $_;
|
|
while (<$fh>) {
|
|
chomp;
|
|
if (m/^(.*?)\:\s(.*)$/) {
|
|
my ($binary, $libs) = ($1, $2);
|
|
if ($binary =~ m/^(.*)\(.*\)$/) {
|
|
$binary = $1;
|
|
}
|
|
my @libs = split(/,/, $libs);
|
|
$self->{$binary}= \@libs;
|
|
} else {
|
|
print "Can't parse $_\n";
|
|
}
|
|
}
|
|
close $fh;
|
|
}
|
|
|
|
# Issue: intermediate objects that record problems with libraries
|
|
package Issue;
|
|
sub new
|
|
{
|
|
my ($class, $lib, $binary, @packages) = @_;
|
|
bless { lib => $lib, binary => $binary, packages => \@packages },
|
|
$class;
|
|
}
|
|
|
|
sub stringize
|
|
{
|
|
my $self = shift;
|
|
my $string = $self->{lib};
|
|
if (@{$self->{packages}} > 0) {
|
|
$string.=" from ".join(',', @{$self->{packages}});
|
|
}
|
|
return $string." ($self->{binary})";
|
|
}
|
|
|
|
sub do_record_wantlib
|
|
{
|
|
my ($self, $h) = @_;
|
|
my $want = $self->{lib};
|
|
$want =~ s/\.\d+$//;
|
|
$h->{$want} = 1;
|
|
}
|
|
|
|
sub record_wantlib
|
|
{
|
|
}
|
|
|
|
sub print_error_not_reachable
|
|
{
|
|
return 0;
|
|
}
|
|
|
|
package Issue::system_lib;
|
|
our @ISA=(qw(Issue));
|
|
sub print
|
|
{
|
|
my $self = shift;
|
|
print "WANTLIB: ", $self->stringize, " (system lib)\n";
|
|
}
|
|
|
|
sub record_wantlib
|
|
{
|
|
&Issue::do_record_wantlib;
|
|
}
|
|
package Issue::direct_dependency;
|
|
our @ISA=(qw(Issue));
|
|
sub print
|
|
{
|
|
my $self = shift;
|
|
print "LIB_DEPENDS: ", $self->stringize, "\n";
|
|
}
|
|
|
|
package Issue::indirect_dependency;
|
|
our @ISA=(qw(Issue));
|
|
sub print
|
|
{
|
|
my $self = shift;
|
|
print "WANTLIB: ", $self->stringize, "\n";
|
|
}
|
|
|
|
sub record_wantlib
|
|
{
|
|
&Issue::do_record_wantlib;
|
|
}
|
|
|
|
package Issue::not_reachable;
|
|
our @ISA=(qw(Issue));
|
|
sub print
|
|
{
|
|
my $self = shift;
|
|
print "Missing lib: ", $self->stringize, " (NOT REACHABLE)\n";
|
|
}
|
|
|
|
sub print_error_not_reachable
|
|
{
|
|
my $self = shift;
|
|
print "Bogus WANTLIB: ", $self->stringize, " (NOT REACHABLE)\n";
|
|
return 1;
|
|
}
|
|
|
|
package MyFile;
|
|
our @ISA=(qw(OpenBSD::PackingElement::FileBase));
|
|
|
|
sub fullname
|
|
{
|
|
my $self = shift;
|
|
return $self->{name};
|
|
}
|
|
|
|
package OpenBSD::PackingElement;
|
|
sub record_needed_libs
|
|
{
|
|
}
|
|
|
|
sub find_libs
|
|
{
|
|
}
|
|
|
|
sub register_libs
|
|
{
|
|
}
|
|
|
|
sub depwalk
|
|
{
|
|
}
|
|
|
|
package OpenBSD::PackingElement::Wantlib;
|
|
sub register_libs
|
|
{
|
|
my ($item, $t) = @_;
|
|
my $name = $item->{name};
|
|
$name =~ s/^(.*\/)?(.*)\.(\d+)\.\d+$/$2.$3/;
|
|
$t->{$name} = 1;
|
|
}
|
|
|
|
package OpenBSD::PackingElement::Lib;
|
|
|
|
sub register_libs
|
|
{
|
|
my ($item, $t) = @_;
|
|
if ($item->fullname =~ m/^(.*\/)?lib(.*)\.so\.(\d+)\.\d+$/) {
|
|
$t->{"$2.$3"} = 2;
|
|
}
|
|
}
|
|
|
|
package OpenBSD::PackingElement::FileBase;
|
|
use File::Basename;
|
|
sub find_libs
|
|
{
|
|
my ($item, $dest, $special) = @_;
|
|
my $fullname = $item->fullname;
|
|
if (defined $special->{$fullname}) {
|
|
for my $lib (@{$special->{$fullname}}) {
|
|
$dest->record($lib, $fullname);
|
|
}
|
|
}
|
|
}
|
|
|
|
sub record_needed_libs
|
|
{
|
|
my ($item, $dest, $source) = @_;
|
|
my $fullname = File::Spec->canonpath($item->fullname);
|
|
|
|
my $linux_bin = 0;
|
|
my $freebsd_bin = 0;
|
|
if ($fullname =~ m,^/usr/local/emul/(?:redhat|fedora)/,) {
|
|
$linux_bin = 1;
|
|
}
|
|
if ($fullname =~ m,^/usr/local/emul/freebsd/,) {
|
|
$freebsd_bin = 1;
|
|
}
|
|
if ($linux_bin || $freebsd_bin || $item->{symlink} || $item->{link}) {
|
|
$source->skip($item);
|
|
return;
|
|
}
|
|
my $n = $source->retrieve($item);
|
|
my $cmd;
|
|
if ($main::opt_o) {
|
|
open($cmd, "-|", "ldd", "-f", "NEEDED lib%o.so.%m.%n\n", $n) or die "open: $!";
|
|
} else {
|
|
unless (open($cmd, '-|')) {
|
|
open(STDERR, '>', '/dev/null');
|
|
exec('objdump', '-p', $n) or die "exec: $!";
|
|
}
|
|
}
|
|
my @l;
|
|
while(my $line = <$cmd>) {
|
|
if ($line =~ m/^\s+NEEDED\s+(.*?)\s*$/) {
|
|
my $lib = $1;
|
|
push(@l, $lib);
|
|
# detect linux binaries
|
|
if ($lib eq 'libc.so.6') {
|
|
$linux_bin = 1;
|
|
}
|
|
} elsif ($line =~ m/^\s+RPATH\s+(.*)\s*$/) {
|
|
my $p = {};
|
|
for my $path (split /\:/, $1) {
|
|
next if $path eq '/usr/local/lib';
|
|
next if $path eq '/usr/X11R6/lib';
|
|
next if $path eq '/usr/lib';
|
|
$p->{$path} = 1;
|
|
}
|
|
for my $path (keys %$p) {
|
|
$dest->record_rpath($path, $fullname);
|
|
}
|
|
}
|
|
}
|
|
close($cmd);
|
|
# okay, we are not OpenBSD, we don't have sensible names
|
|
unless ($linux_bin or $freebsd_bin) {
|
|
for my $lib (@l) {
|
|
# don't look for modules
|
|
next if $lib =~ m/\.so$/;
|
|
$dest->record($lib, $fullname);
|
|
}
|
|
}
|
|
$source->clean($item);
|
|
}
|
|
|
|
package OpenBSD::PackingElement::Dependency;
|
|
|
|
sub depwalk
|
|
{
|
|
my ($self, $h) = @_;
|
|
$h->{$self->{def}} = $self->{pkgpath};
|
|
}
|
|
|
|
package main;
|
|
|
|
getopts('od:f:B:F:s:O:');
|
|
|
|
my $dependencies = {};
|
|
|
|
sub register_dependencies
|
|
{
|
|
my $plist = shift;
|
|
my $pkgname = $plist->pkgname;
|
|
my $h = {};
|
|
$dependencies->{$pkgname} = $h;
|
|
$plist->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($location);
|
|
if ($true_package) {
|
|
my $dir = $true_package->info;
|
|
if (-d $dir) {
|
|
my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
|
|
$true_package->close;
|
|
rmtree($dir);
|
|
return $plist;
|
|
}
|
|
}
|
|
}
|
|
# ask the ports tree
|
|
print "Asking ports for dependency $pkgname($pkgpath)\n";
|
|
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-with-depends |" 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";
|
|
return;
|
|
}
|
|
|
|
if ($plist->pkgname ne $pkgname) {
|
|
delete $dependencies->{$pkgname};
|
|
for my $p (keys %$dependencies) {
|
|
if ($dependencies->{$p}->{$pkgname}) {
|
|
$dependencies->{$p}->{$plist->pkgname} =
|
|
$dependencies->{$p}->{$pkgname};
|
|
delete $dependencies->{$p}->{$pkgname};
|
|
}
|
|
}
|
|
}
|
|
|
|
register_dependencies($plist);
|
|
OpenBSD::SharedLibs::add_libs_from_plist($plist);
|
|
|
|
return $plist->pkgname;
|
|
}
|
|
|
|
sub report_lib_issue
|
|
{
|
|
my ($plist, $lib, $binary) = @_;
|
|
|
|
OpenBSD::SharedLibs::add_libs_from_system('/');
|
|
my $libspec = "$lib.0";
|
|
my $want = $lib;
|
|
$want =~ s/\.\d+$//;
|
|
for my $dir (qw(/usr /usr/X11R6)) {
|
|
my @r = OpenBSD::SharedLibs::lookup_libspec($dir, $libspec);
|
|
if (grep { $_ eq 'system' } @r) {
|
|
return Issue::system_lib->new($lib, $binary);
|
|
}
|
|
}
|
|
|
|
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}) {
|
|
return Issue::direct_dependency->new($lib, $binary, $p);
|
|
}
|
|
}
|
|
}
|
|
# 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;
|
|
$dep = handle_dependency($dep, $path)
|
|
unless defined $dependencies->{$dep};
|
|
next if !defined $dep;
|
|
$done->{$dep} = 1;
|
|
push(@todo, %{$dependencies->{$dep}});
|
|
}
|
|
@r = OpenBSD::SharedLibs::lookup_libspec('/usr/local', $libspec);
|
|
for my $p (@r) {
|
|
if (defined $done->{$p}) {
|
|
return Issue::indirect_dependency->new($lib, $binary, $p);
|
|
}
|
|
}
|
|
return Issue::not_reachable->new($lib,, $binary, @r);
|
|
}
|
|
|
|
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, $source, @l) = @_;
|
|
|
|
my $pkgname = $plist->pkgname;
|
|
my $needed_libs = $opt_f ? AllRecorder->new : SimpleRecorder->new;
|
|
my $has_libs = {};
|
|
if ($opt_s) {
|
|
my $special = DumpRecorder->new;
|
|
$special->retrieve($opt_s);
|
|
$plist->find_libs($needed_libs, $special);
|
|
} else {
|
|
$plist->record_needed_libs($needed_libs, $source, @l);
|
|
}
|
|
$plist->register_libs($has_libs);
|
|
|
|
if (!defined $dependencies->{$pkgname}) {
|
|
register_dependencies($plist);
|
|
OpenBSD::SharedLibs::add_libs_from_plist($plist);
|
|
}
|
|
my $r = { wantlib => {}, libdepends => {}, wantlib2 => {} };
|
|
for my $lib (sort $needed_libs->libs) {
|
|
my $fullname = $needed_libs->binary($lib);
|
|
if (!defined $has_libs->{$lib}) {
|
|
my $issue = report_lib_issue($plist, $lib, $fullname);
|
|
$issue->print;
|
|
$errors++;
|
|
$issue->record_wantlib($r->{wantlib});
|
|
} elsif ($has_libs->{$lib} == 1) {
|
|
my $issue = report_lib_issue($plist, $lib, $fullname);
|
|
if ($issue->print_error_not_reachable) {
|
|
$errors++;
|
|
}
|
|
}
|
|
$has_libs->{$lib} = 2;
|
|
}
|
|
for my $k (sort keys %$has_libs) {
|
|
my $v = $has_libs->{$k};
|
|
next if $v == 2;
|
|
print "Extra: $k\n";
|
|
}
|
|
print_list("\tWANTLIB +=", $r->{wantlib});
|
|
if ($opt_f) {
|
|
$needed_libs->dump(\*STDOUT);
|
|
}
|
|
}
|
|
|
|
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);
|
|
if ($opt_B) {
|
|
analyze($plist, FakeFileSource->new($opt_B));
|
|
} else {
|
|
my $temp = File::Temp::mkdtemp("/tmp/zoinx.XXXXXXXXXX");
|
|
analyze($plist, RealFileSource->new($true_package, $temp));
|
|
rmtree($temp);
|
|
}
|
|
$true_package->close;
|
|
$true_package->wipe_info;
|
|
$plist->forget;
|
|
return 1;
|
|
}
|
|
|
|
sub do_plist
|
|
{
|
|
my $plist = OpenBSD::PackingList->read(\*STDIN);
|
|
if (!defined $plist->{name}) {
|
|
print STDERR "Error reading plist\n";
|
|
$errors++;
|
|
} else {
|
|
my $pkgname = $plist->pkgname;
|
|
print "\n$pkgname:\n";
|
|
analyze($plist, FakeFileSource->new($opt_B));
|
|
}
|
|
}
|
|
|
|
if ($opt_F) {
|
|
my $recorder = DumpRecorder->new;
|
|
my $cwd = $opt_F;
|
|
my $source = FakeFileSource->new($opt_F);
|
|
File::Find::find({
|
|
wanted => sub {
|
|
return unless -f $_;
|
|
my $name = $_;
|
|
$name =~ s/^\Q$opt_F\E//;
|
|
# XXX hack FileBase object;
|
|
my $i = bless {name => $name}, "MyFile";
|
|
$i->record_needed_libs($recorder, $source);
|
|
},
|
|
no_chdir => 1 }, $opt_F);
|
|
if ($opt_O) {
|
|
open my $fh, '>', $opt_O or die "Can't write to $opt_O: $!";
|
|
$recorder->dump($fh);
|
|
close $fh;
|
|
} else {
|
|
$recorder->dump(\*STDOUT);
|
|
}
|
|
exit(0);
|
|
}
|
|
if (@ARGV == 0 && defined $opt_B) {
|
|
do_plist();
|
|
} else {
|
|
for my $pkgname (@ARGV) {
|
|
do_pkg($pkgname);
|
|
}
|
|
}
|
|
|
|
exit($errors ? 1 : 0);
|