--- /dev/null
+# shared-libs -- lintian check script -*- perl -*-
+
+# Copyright (C) 1998 Christian Schwarz
+#
+# 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 http://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 Maemian::shared_libs;
+use strict;
+
+use File::Basename;
+
+use Maemian::Data;
+use Maemian::Relation;
+use Tags;
+use Util;
+
+# Libraries that should only be used in the presence of certain capabilities
+# may be located in subdirectories of the standard ldconfig search path with
+# one of the following names.
+my %hwcap_dir = map { $_ => 1 }
+ qw(i486 i586 i686 cmov tls);
+
+# The following architectures should always have a STACK setting in shared
+# libraries to disable executable stack. Other architectures don't always add
+# this section and therefore can't be checked.
+our %stack_arches = map { $_ => 1 }
+ qw(
+ alpha
+ amd64
+ i386
+ m68k
+ powerpc
+ s390
+ sparc
+ );
+
+our $ldconfig_dirs = Maemian::Data->new('shared-libs/ldconfig-dirs');
+
+sub run {
+
+my $file;
+my $must_call_ldconfig;
+my %SONAME;
+my %sharedobject;
+my @shlibs;
+my @words;
+
+# ---end-of-configuration-part---
+
+my $pkg = shift;
+my $type = shift;
+my $info = shift;
+
+my $objdump = $info->objdump_info;
+
+# 1st step: get info about shared libraries installed by this package
+foreach my $file (sort keys %{$objdump}) {
+ $SONAME{$file} = $objdump->{$file}->{SONAME}[0]
+ if defined $objdump->{$file}->{SONAME};
+}
+
+foreach my $file (sort keys %{$info->file_info}) {
+ next unless length $file;
+ my $fileinfo = $info->file_info->{$file};
+ if ($fileinfo =~ m/^[^,]*\bELF\b/ && $fileinfo =~ m/shared object/) {
+ $sharedobject{$file} = 1;
+ }
+}
+
+# 2nd step: read package contents
+
+for my $cur_file (sort keys %{$info->index}) {
+ # shared library?
+ my $cur_file_data = $info->index->{$cur_file};
+
+ if (exists $SONAME{$cur_file} or
+ (defined $cur_file_data->{link} and exists $SONAME{abs_path(dirname($cur_file)."/".$cur_file_data->{link})})) {
+ # yes!!
+ my ($real_file, $real_perm);
+ if ($SONAME{$cur_file}) {
+ $real_file = $cur_file;
+ $real_perm = $cur_file_data->{operm};
+ } else {
+ $real_file = abs_path(dirname($cur_file)."/".$cur_file_data->{link});
+ $real_perm = $info->index->{$real_file}->{operm} || $cur_file_data->{operm};
+ }
+
+ # Now that we're sure this is really a shared library, report on
+ # non-PIC problems.
+ if ($cur_file eq $real_file and $objdump->{$cur_file}->{TEXTREL}) {
+ tag "shlib-with-non-pic-code", "$cur_file";
+ }
+
+ my @symbol_names = map { @{$_}[2] } @{$objdump->{$cur_file}->{SYMBOLS}};
+ if (grep /^_?exit$/, @symbol_names and !grep /^fork$/, @symbol_names) {
+ tag "shlib-calls-exit", "$cur_file";
+ }
+
+ # don't apply the permission checks to links
+ # since this only results in doubled messages
+ if ($cur_file eq $real_file) {
+ # executable?
+ if ($real_perm & 0100 or $real_perm & 010 or $real_perm & 01) {
+ # yes. But if the library has an INTERP section, it's designed
+ # to do something useful when executed, so don't report an error.
+ tag "shlib-with-executable-bit", $cur_file, sprintf("%04o", $real_perm)
+ unless $objdump->{$real_file}->{INTERP};
+ } elsif ($real_perm != 0644) {
+ # bad permissions
+ tag "shlib-with-bad-permissions", $cur_file, sprintf("%04o", $real_perm);
+ }
+ }
+
+ # Installed in a directory controlled by the dynamic linker? We have
+ # to strip off directories named for hardware capabilities.
+ my $dirname = dirname($cur_file);
+ my $last;
+ do {
+ $dirname =~ s%/([^/]+)$%%;
+ $last = $1;
+ } while ($last && $hwcap_dir{$last});
+ $dirname .= "/$last" if $last;
+ if ($ldconfig_dirs->known($dirname)) {
+ # yes! so postinst must call ldconfig
+ $must_call_ldconfig = $real_file;
+ }
+
+ # executable stack. We can only warn about a missing section on some
+ # architectures. Only warn if there's an Architecture field; if
+ # that's missing, we'll already be complaining elsewhere.
+ if (exists $objdump->{$cur_file}->{OTHER_DATA}) {
+ if (not defined $objdump->{$cur_file}->{STACK}) {
+ if (defined $info->field('architecture')) {
+ my $arch = $info->field('architecture');
+ tag "shlib-without-PT_GNU_STACK-section", $cur_file
+ if $stack_arches{$arch};
+ }
+ } elsif ($objdump->{$cur_file}->{STACK} ne "rw-") {
+ tag "shlib-with-executable-stack", $cur_file;
+ }
+ }
+ } elsif (exists $objdump->{$cur_file}->{OTHER_DATA}
+ && $ldconfig_dirs->known(dirname($cur_file))
+ && exists $sharedobject{$cur_file}) {
+ tag "sharedobject-in-library-directory-missing-soname", "$cur_file";
+ } elsif ($cur_file =~ m/\.la$/ and not defined($cur_file_data->{link})) {
+ local $_;
+ open(LAFILE, "< unpacked/$cur_file")
+ or fail("Could not open unpacked/$cur_file for reading!");
+ while(<LAFILE>) {
+ next unless (m/^libdir='(.+?)'$/);
+ my $actual = $1;
+ $actual =~ s,/+$,,;
+ my ($expected) = ("/$cur_file" =~ m,^(.+)/[^/]+$,);
+
+ # python-central is a special case since the libraries are moved
+ # at install time.
+ next if ($actual =~ m,^/usr/lib/python[\d.]+/site-packages,
+ and $expected =~ m,^/usr/share/pyshared,);
+ tag "incorrect-libdir-in-la-file", $cur_file, "$actual != $expected"
+ unless($expected eq $actual);
+ last;
+ }
+ close(LAFILE);
+ }
+}
+
+close(IN);
+
+# 3rd step: check if shlib symlinks are present and in correct order
+for my $shlib_file (keys %SONAME) {
+ # file found?
+ if (not exists $info->index->{$shlib_file}) {
+ fail("shlib $shlib_file not found in package (should not happen!)");
+ }
+
+ my ($dir, $shlib_name) = $shlib_file =~ m,(.*)/([^/]+)$,;
+
+ # not a public shared library, skip it
+ next unless $ldconfig_dirs->known($dir);
+
+ # symlink found?
+ my $link_file = "$dir/$SONAME{$shlib_file}";
+ if (not exists $info->index->{$link_file}) {
+ tag "ldconfig-symlink-missing-for-shlib", "$link_file $shlib_file $SONAME{$shlib_file}";
+ } else {
+ # $link_file really another file?
+ if ($link_file eq $shlib_file) {
+ # the library file uses its SONAME, this is ok...
+ } else {
+ # $link_file really a symlink?
+ if (exists $info->index->{$link_file}->{link}) {
+ # yes.
+
+ # $link_file pointing to correct file?
+ if ($info->index->{$link_file}->{link} eq $shlib_name) {
+ # ok.
+ } else {
+ tag "ldconfig-symlink-referencing-wrong-file",
+ "$link_file -> " . $info->index->{$link_file}->{link} . " instead of $shlib_name";
+ }
+ } else {
+ tag "ldconfig-symlink-is-not-a-symlink", "$shlib_file $link_file";
+ }
+
+ # symlink after shlib?
+ #if ($info->index->{$link_file} < $info->index->{$shlib_file}) {
+ # tag "ldconfig-symlink-before-shlib-in-deb", "$link_file";
+ #}
+ }
+ }
+
+ # determine shlib link name (w/o version)
+ $link_file =~ s/\.so.*$/.so/o;
+
+ # -dev package?
+ if ($pkg =~ m/\-dev$/o) {
+ # yes!!
+
+ # need shlib symlink
+ if (not exists $info->index->{$link_file}) {
+ tag "dev-pkg-without-shlib-symlink", "$shlib_file $link_file";
+ }
+ } else {
+ # no.
+
+ # shlib symlink may not exist.
+ # if shlib doesn't _have_ a version, then $link_file and $shlib_file will
+ # be equal, and it's not a development link, so don't complain.
+ if (exists $info->index->{$link_file} and $link_file ne $shlib_file) {
+ tag "non-dev-pkg-with-shlib-symlink", "$shlib_file $link_file";
+ }
+ }
+}
+
+# 4th step: check shlibs control file
+my $version;
+if (defined $info->field('version')) {
+ $version = $info->field('version');
+}
+my $provides = $pkg . "( = $version)";
+if (defined $info->field('provides')) {
+ $provides .= ", " . $info->field('provides');
+}
+$provides = Maemian::Relation->new($provides);
+
+my %shlibs_control;
+my %symbols_control;
+
+# Libraries with no version information can't be represented by the shlibs
+# format (but can be represented by symbols). We want to warn about them if
+# they appear in public directories. If they're in private directories,
+# assume they're plugins or private libraries and are safe.
+my %unversioned_shlibs;
+for (keys %SONAME) {
+ my $soname = format_soname($SONAME{$_});
+ if ($soname !~ / /) {
+ $unversioned_shlibs{$_} = 1;
+ tag 'shlib-without-versioned-soname', $_, $soname
+ if $ldconfig_dirs->known(dirname($_));
+ }
+}
+@shlibs = grep { !$unversioned_shlibs{$_} } keys %SONAME;
+
+if ($#shlibs == -1) {
+ # no shared libraries included in package, thus shlibs control file should
+ # not be present
+ if (-f 'control/shlibs') {
+ tag "pkg-has-shlibs-control-file-but-no-actual-shared-libs", "";
+ }
+} else {
+ # shared libraries included, thus shlibs control file has to exist
+ if (not -f 'control/shlibs') {
+ if ($type ne 'udeb') {
+ for my $shlib (@shlibs) {
+ # skip it if it's not a public shared library
+ next unless $ldconfig_dirs->known(dirname($shlib));
+ tag "no-shlibs-control-file", "$shlib";
+ }
+ }
+ } else {
+ my %shlibs_control_used;
+ my @shlibs_depends;
+ open(SHLIBS, '<', 'control/shlibs')
+ or fail("cannot open control/shlibs for reading: $!");
+ while (<SHLIBS>) {
+ chop;
+ next if m/^\s*$/ or /^#/;
+
+ # We exclude udebs from the checks for correct shared library
+ # dependencies, since packages may contain dependencies on
+ # other udeb packages.
+ my $udeb="";
+ $udeb = "udeb: " if s/^udeb:\s+//o;
+ @words = split(/\s+/o,$_);
+ my $shlibs_string = $udeb.$words[0].' '.$words[1];
+ if ($shlibs_control{$shlibs_string}) {
+ tag "duplicate-entry-in-shlibs-control-file", $shlibs_string;
+ } else {
+ $shlibs_control{$shlibs_string} = 1;
+ push (@shlibs_depends, join (' ', @words[2 .. $#words]))
+ unless $udeb;
+ }
+ }
+ close(SHLIBS);
+ my $shlib_name;
+ for my $shlib (@shlibs) {
+ $shlib_name = $SONAME{$shlib};
+ $shlib_name = format_soname($shlib_name);
+ $shlibs_control_used{$shlib_name} = 1;
+ $shlibs_control_used{"udeb: ".$shlib_name} = 1;
+ unless (exists $shlibs_control{$shlib_name}) {
+ # skip it if it's not a public shared library
+ next unless $ldconfig_dirs->known(dirname($shlib));
+ # no!!
+ tag "shlib-missing-in-control-file", $shlib_name, 'for', $shlib;
+ }
+ }
+ for $shlib_name (keys %shlibs_control) {
+ tag "unused-shlib-entry-in-control-file", $shlib_name
+ unless $shlibs_control_used{$shlib_name};
+ }
+
+ # Check that all of the packages listed as dependencies in the shlibs
+ # file are satisfied by the current package or its Provides.
+ # Normally, packages should only declare dependencies in their shlibs
+ # that they themselves can satisfy.
+ #
+ # Deduplicate the list of dependencies before warning so that we don't
+ # dupliate warnings.
+ my %seen;
+ @shlibs_depends = grep { !$seen{$_}++ } @shlibs_depends;
+ for my $depend (@shlibs_depends) {
+ unless ($provides->implies($depend)) {
+ tag "shlibs-declares-dependency-on-other-package", $depend;
+ }
+ }
+ }
+}
+
+# 5th step: check symbols control file. Add back in the unversioned shared
+# libraries, since they can still have symbols files.
+if ($#shlibs == -1 and not %unversioned_shlibs) {
+ # no shared libraries included in package, thus symbols control file should
+ # not be present
+ if (-f 'control/symbols') {
+ tag "pkg-has-symbols-control-file-but-no-shared-libs", "";
+ }
+} elsif (not -f 'control/symbols') {
+ if ($type ne 'udeb') {
+ for my $shlib (@shlibs, keys %unversioned_shlibs) {
+ # skip it if it's not a public shared library
+ next unless $ldconfig_dirs->known(dirname($shlib));
+ tag "no-symbols-control-file", "$shlib";
+ }
+ }
+} elsif (open(IN, '<', 'control/symbols')) {
+ my $version_wo_rev = $version;
+ $version_wo_rev =~ s/^(.+)-([^-]+)$/$1/;
+ my ($full_version_count, $full_version_sym) = (0, undef);
+ my ($debian_revision_count, $debian_revision_sym) = (0, undef);
+ my ($soname, $dep_package, $dep);
+ my %symbols_control_used;
+ my @symbols_depends;
+ my $dep_templates = 0;
+ my $meta_info_seen = 0;
+ my $warned = 0;
+ my $symbol_count = 0;
+
+ while (<IN>) {
+ chomp;
+ next if m/^\s*$/ or /^#/;
+
+ if (m/^([^\s|*]\S+)\s\S+\s*(?:\(\S+\s+\S+\)|\#MINVER\#)?/) {
+ # soname, main dependency template
+
+ $soname = $1;
+ s/^\Q$soname\E\s*//;
+ $soname = format_soname($soname);
+
+ if ($symbols_control{$soname}) {
+ tag "duplicate-entry-in-symbols-control-file", $soname;
+ } else {
+ $symbols_control{$soname} = 1;
+ $warned = 0;
+
+ foreach my $part (split /\s*,\s*/) {
+ foreach my $subpart (split /\s*\|\s*/, $part) {
+ $subpart =~ m,^(\S+)\s*(\(\S+\s+\S+\)|#MINVER#)?$,;
+ ($dep_package, $dep) = ($1, $2 || '');
+ if (defined $dep_package) {
+ push @symbols_depends, $dep_package . ' ' . $dep;
+ } else {
+ tag "syntax-error-in-symbols-file", $.
+ unless $warned;
+ $warned = 1;
+ }
+ }
+ }
+ }
+
+ $dep_templates = 0;
+ $meta_info_seen = 0;
+ $symbol_count = 0;
+ } elsif (m/^\|\s+\S+\s*(?:\(\S+\s+\S+\)|#MINVER#)?/) {
+ # alternative dependency template
+
+ $warned = 0;
+
+ if ($meta_info_seen or not defined $soname) {
+ tag "syntax-error-in-symbols-file", $.;
+ $warned = 1;
+ }
+
+ s/^\|\s*//;
+
+ foreach my $part (split /\s*,\s*/) {
+ foreach my $subpart (split /\s*\|\s*/, $part) {
+ $subpart =~ m,^(\S+)\s*(\(\S+\s+\S+\)|#MINVER#)?$,;
+ ($dep_package, $dep) = ($1, $2 || '');
+ if (defined $dep_package) {
+ push @symbols_depends, $dep_package . ' ' . $dep;
+ } else {
+ tag "syntax-error-in-symbols-file", $. unless $warned;
+ $warned = 1;
+ }
+ }
+ }
+
+ $dep_templates++ unless $warned;
+ } elsif (m/^\*\s(\S+):\s\S+/) {
+ # meta-information
+
+ # This should probably be in a hash, but there's
+ # only one supported value currently
+ tag "unknown-meta-field-in-symbols-file", "$1, line $."
+ unless $1 eq 'Build-Depends-Package';
+ tag "syntax-error-in-symbols-file", $.
+ unless defined $soname and $symbol_count == 0;
+
+ $meta_info_seen = 1;
+ } elsif (m/^\s+(\S+)\s(\S+)(?:\s(\S+(?:\s\S+)?))?$/) {
+ # Symbol definition
+
+ tag "syntax-error-in-symbols-file", $.
+ unless defined $soname;
+
+ $symbol_count++;
+ my ($sym, $v, $dep_order) = ($1, $2, $3);
+ $dep_order ||= '';
+
+ if (($v eq $version) and ($version =~ /-/)) {
+ $full_version_sym ||= $sym;
+ $full_version_count++;
+ } elsif (($v =~ /-/) and (not $v =~ /~$/) and ($v ne $version_wo_rev)) {
+ $debian_revision_sym ||= $sym;
+ $debian_revision_count++;
+ }
+
+ if (length $dep_order) {
+ if ($dep_order !~ /^\d+$/ or $dep_order > $dep_templates) {
+ tag "invalid-template-id-in-symbols-file", $.;
+ }
+ }
+ } else {
+ # Unparseable line
+
+ tag "syntax-error-in-symbols-file", $.;
+ }
+ }
+ close IN;
+ if ($full_version_count) {
+ $full_version_count--;
+ my $others = '';
+ if ($full_version_count > 0) {
+ $others = " and $full_version_count others";
+ }
+ tag "symbols-file-contains-current-version-with-debian-revision",
+ "on symbol $full_version_sym$others";
+ }
+ if ($debian_revision_count) {
+ $debian_revision_count--;
+ my $others = '';
+ if ($debian_revision_count > 0) {
+ $others = " and $debian_revision_count others";
+ }
+ tag "symbols-file-contains-debian-revision",
+ "on symbol $debian_revision_sym$others";
+ }
+ my $shlib_name;
+ for my $shlib (@shlibs, keys %unversioned_shlibs) {
+ $shlib_name = $SONAME{$shlib};
+ $shlib_name = format_soname($shlib_name);
+ $symbols_control_used{$shlib_name} = 1;
+ $symbols_control_used{"udeb: ".$shlib_name} = 1;
+ unless (exists $symbols_control{$shlib_name}) {
+ # skip it if it's not a public shared library
+ next unless $ldconfig_dirs->known(dirname($shlib));
+ tag "shlib-missing-in-symbols-control-file", $shlib_name, 'for', $shlib;
+ }
+ }
+ for $shlib_name (keys %symbols_control) {
+ tag "unused-shlib-entry-in-symbols-control-file", $shlib_name
+ unless $symbols_control_used{$shlib_name};
+ }
+
+ # Check that all of the packages listed as dependencies in the symbols
+ # file are satisfied by the current package or its Provides.
+ # Normally, packages should only declare dependencies in their symbols
+ # files that they themselves can satisfy.
+ #
+ # Deduplicate the list of dependencies before warning so that we don't
+ # dupliate warnings.
+ my %seen;
+ @symbols_depends = grep { !$seen{$_}++ } @symbols_depends;
+ for my $depend (@symbols_depends) {
+ unless ($provides->implies($depend)) {
+ tag "symbols-declares-dependency-on-other-package", $depend;
+ }
+ }
+}
+
+# Compare the contents of the shlibs and symbols control files, but exclude
+# from this check shared libraries whose SONAMEs has no version. Those can
+# only be represented in symbols files and aren't expected in shlibs files.
+if (keys %shlibs_control and keys %symbols_control) {
+ for my $key (keys %symbols_control) {
+ unless (exists $shlibs_control{$key} or $key !~ / /) {
+ tag "symbols-declared-but-not-shlib", $key;
+ }
+ }
+}
+
+# 6th step: check pre- and post- control files
+if (-f 'control/preinst') {
+ local $_ = slurp_entire_file('control/preinst');
+ if (/^[^\#]*\bldconfig\b/m) {
+ tag "preinst-calls-ldconfig", ""
+ }
+}
+
+my $we_call_postinst=0;
+if (-f 'control/postinst') {
+ local $_ = slurp_entire_file('control/postinst');
+
+ # Decide if we call ldconfig
+ if (/^[^\#]*\bldconfig\b/m) {
+ $we_call_postinst=1;
+ }
+}
+
+if ($type eq 'udeb') {
+ tag "udeb-postinst-must-not-call-ldconfig"
+ if $we_call_postinst;
+} else {
+ tag "postinst-has-useless-call-to-ldconfig", ""
+ if $we_call_postinst and not $must_call_ldconfig;
+ tag "postinst-must-call-ldconfig", "$must_call_ldconfig"
+ if not $we_call_postinst and $must_call_ldconfig;
+}
+
+if (-f 'control/prerm') {
+ local $_ = slurp_entire_file('control/prerm');
+ if (/^[^\#]*\bldconfig\b/m) {
+ tag "prerm-calls-ldconfig", "";
+ }
+}
+
+if (-f 'control/postrm') {
+ local $_ = slurp_entire_file('control/postrm');
+
+ # Decide if we call ldconfig
+ if (/^[^\#]*\bldconfig\b/m) {
+ tag "postrm-has-useless-call-to-ldconfig", ""
+ unless $must_call_ldconfig;
+ } else {
+ tag "postrm-should-call-ldconfig", "$must_call_ldconfig"
+ if $must_call_ldconfig;
+ }
+
+ # Decide if we do it safely
+ s/\bldconfig\b/BldconfigB/g;
+ s/[ \t]//g;
+ # this one matches code from debhelper
+ s/^if\["\$1"=.?remove.?\];?\n*then\n*BldconfigB//gm;
+ # variations...
+ s/^if\[.?remove.?="\$1"\];?\n*then\n*BldconfigB//gm;
+ s/^\["\$1"=.?remove.?\]\&&BldconfigB//gm;
+ s/^\[.?remove.?="\$1"\]&&BldconfigB//gm;
+ s/remove(?:\|[^)]+)*\).*?BldconfigB.*?(;;|esac)//s;
+
+ if (/^[^\#]*BldconfigB/m) {
+ tag "postrm-unsafe-ldconfig", "";
+ }
+}
+
+}
+
+# make /tmp/baz/baz.txt from /tmp/foo/../bar/../baz/baz.txt
+sub abs_path {
+ my $path = shift;
+ while($path =~ s!/[^/]*/\.\./!/!g){1};
+ return $path;
+}
+
+# Extract the library name and the version from an SONAME and return them
+# separated by a space. This code should match the split_soname function in
+# dpkg-shlibdeps.
+sub format_soname {
+ my $soname = shift;
+
+ # libfoo.so.X.X
+ if ($soname =~ /^(.*)\.so\.(.*)$/) {
+ $soname = "$1 $2";
+ # libfoo-X.X.so
+ } elsif ($soname =~ /^(.*)-(\d.*)\.so$/) {
+ $soname = "$1 $2";
+ }
+
+ return $soname
+}
+
+1;
+
+# Local Variables:
+# indent-tabs-mode: t
+# cperl-indent-level: 4
+# End:
+# vim: syntax=perl sw=4 ts=8
projects / maemian / blobdiff