diff options
Diffstat (limited to '')
-rw-r--r-- | lib/Lintian/Check/Libraries/Shared/Links.pm | 167 |
1 files changed, 167 insertions, 0 deletions
diff --git a/lib/Lintian/Check/Libraries/Shared/Links.pm b/lib/Lintian/Check/Libraries/Shared/Links.pm new file mode 100644 index 0000000..e25d3fd --- /dev/null +++ b/lib/Lintian/Check/Libraries/Shared/Links.pm @@ -0,0 +1,167 @@ +# libraries/shared/links -- lintian check script -*- perl -*- + +# Copyright (C) 1998 Christian Schwarz +# Copyright (C) 2018-2019 Chris Lamb <lamby@debian.org> +# Copyright (C) 2021 Felix Lechner +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, you can find it on the World Wide +# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +# MA 02110-1301, USA. + +package Lintian::Check::Libraries::Shared::Links; + +use v5.20; +use warnings; +use utf8; + +use Const::Fast; +use List::SomeUtils qw(none); + +const my $ARROW => q{->}; + +use Moo; +use namespace::clean; + +with 'Lintian::Check'; + +has development_packages => ( + is => 'rw', + lazy => 1, + default => sub { + my ($self) = @_; + + my @development_packages; + + for my $installable ($self->group->get_installables) { + + push(@development_packages, $installable) + if $installable->name =~ /-dev$/ + && $installable->relation('strong') + ->satisfies($self->processable->name); + } + + return \@development_packages; + } +); + +sub visit_installed_files { + my ($self, $item) = @_; + + return + unless $item->is_file; + + # shared library + return + unless @{$item->elf->{SONAME} // [] }; + + my $soname = $item->elf->{SONAME}[0]; + + my @ldconfig_folders = @{$self->data->architectures->ldconfig_folders}; + return + if none { $item->dirname eq $_ } @ldconfig_folders; + + my $installed = $self->processable->installed; + + my $versioned_name = $item->dirname . $soname; + my $versioned_item = $installed->lookup($versioned_name); + + my $unversioned_name = $versioned_name; + # libtool "-release" variant + $unversioned_name =~ s/-[\d\.]+\.so$/.so/; + # determine shlib link name (w/o version) + $unversioned_name =~ s/\.so.+$/.so/; + + $self->pointed_hint('lacks-versioned-link-to-shared-library', + $item->pointer, $versioned_name) + unless defined $versioned_item; + + $self->pointed_hint( + 'ldconfig-symlink-referencing-wrong-file', + $versioned_item->pointer,'should point to', + $versioned_item->link,'instead of',$item->basename + ) + if $versioned_name ne $item->name + && defined $versioned_item + && $versioned_item->is_symlink + && $versioned_item->link ne $item->basename; + + $self->pointed_hint( + 'ldconfig-symlink-is-not-a-symlink', + $versioned_item->pointer,'should point to', + $item->name + ) + if $versioned_name ne $item->name + && defined $versioned_item + && !$versioned_item->is_symlink; + + # shlib symlink may not exist. + # if shlib doesn't _have_ a version, then $unversioned_name and + # $item->name will be equal, and it's not a development link, + # so don't complain. + $self->pointed_hint( + 'link-to-shared-library-in-wrong-package', + $installed->lookup($unversioned_name)->pointer, + $item->name + ) + if $unversioned_name ne $item->name + && defined $installed->lookup($unversioned_name); + + # If the shared library is in /lib, we have to look for + # the dev symlink in /usr/lib + $unversioned_name = "usr/$unversioned_name" + unless $item->name =~ m{^usr/}; + + my @dev_links; + for my $dev_installable (@{$self->development_packages}) { + for my $dev_item (@{$dev_installable->installed->sorted_list}) { + + next + unless $dev_item->is_symlink; + + next + unless $dev_item->name =~ m{^ usr/lib/ }x; + + # try absolute first + my $resolved = $installed->resolve_path($dev_item->link); + + # otherwise relative + $resolved + = $installed->resolve_path($dev_item->dirname . $dev_item->link) + unless defined $resolved; + + next + unless defined $resolved; + + push(@dev_links, $dev_item) + if $resolved->name eq $item->name; + } + } + + # found -dev package; library needs a symlink + $self->pointed_hint('lacks-unversioned-link-to-shared-library', + $item->pointer, "example: $unversioned_name") + if @{$self->development_packages} + && (none { $_->name =~ m{ [.]so $}x } @dev_links); + + return; +} + +1; + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: +# vim: syntax=perl sw=4 sts=4 sr et |