openbsd-ports/infrastructure/package/check-lib-depends
espie 6a74e2e1de don't look at symlinks. if they point inside fake, then we get the file
anyways. if they point outside of it, they don't make sense until
installed, and we got the file anyways...
2010-03-20 17:05:44 +00:00

711 lines
14 KiB
Perl
Executable File

#!/usr/bin/perl
# $OpenBSD: check-lib-depends,v 1.18 2010/03/20 17:05:44 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 OpenBSD::LibSpec;
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 lookup_library
{
my ($dir, $spec) = @_;
my $libspec = OpenBSD::LibSpec->from_string($spec);
my $r = OpenBSD::SharedLibs::lookup_libspec($dir, $libspec);
if (!defined $r) {
return ();
} else {
return map {$_->origin} @$r;
}
}
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 = lookup_library($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 = lookup_library('/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 = lookup_library('/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 if -l $_;
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);