vcs.maemo.org Git - maemian/blob - checks/shared-libs

   1 # shared-libs -- lintian check script -*- perl -*-
   2
   3 # Copyright (C) 1998 Christian Schwarz
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, you can find it on the World Wide
  17 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  19 # MA 02110-1301, USA.
  20
  21 package Maemian::shared_libs;
  22 use strict;
  23
  24 use File::Basename;
  25
  26 use Maemian::Data;
  27 use Maemian::Relation;
  28 use Tags;
  29 use Util;
  30
  31 # Libraries that should only be used in the presence of certain capabilities
  32 # may be located in subdirectories of the standard ldconfig search path with
  33 # one of the following names.
  34 my %hwcap_dir = map { $_ => 1 }
  35     qw(i486 i586 i686 cmov tls);
  36
  37 # The following architectures should always have a STACK setting in shared
  38 # libraries to disable executable stack.  Other architectures don't always add
  39 # this section and therefore can't be checked.
  40 our %stack_arches = map { $_ => 1 }
  41     qw(
  42        alpha
  43        amd64
  44        i386
  45        m68k
  46        powerpc
  47        s390
  48        sparc
  49       );
  50
  51 our $ldconfig_dirs = Maemian::Data->new('shared-libs/ldconfig-dirs');
  52
  53 sub run {
  54
  55 my $file;
  56 my $must_call_ldconfig;
  57 my %SONAME;
  58 my %sharedobject;
  59 my @shlibs;
  60 my @words;
  61
  62 # ---end-of-configuration-part---
  63
  64 my $pkg = shift;
  65 my $type = shift;
  66 my $info = shift;
  67
  68 my $objdump = $info->objdump_info;
  69
  70 # 1st step: get info about shared libraries installed by this package
  71 foreach my $file (sort keys %{$objdump}) {
  72     $SONAME{$file} = $objdump->{$file}->{SONAME}[0]
  73         if defined $objdump->{$file}->{SONAME};
  74 }
  75
  76 foreach my $file (sort keys %{$info->file_info}) {
  77     next unless length $file;
  78     my $fileinfo = $info->file_info->{$file};
  79     if ($fileinfo =~ m/^[^,]*\bELF\b/ && $fileinfo =~ m/shared object/) {
  80         $sharedobject{$file} = 1;
  81     }
  82 }
  83
  84 # 2nd step: read package contents
  85
  86 for my $cur_file (sort keys %{$info->index}) {
  87     # shared library?
  88     my $cur_file_data = $info->index->{$cur_file};
  89
  90     if (exists $SONAME{$cur_file} or
  91         (defined $cur_file_data->{link} and exists $SONAME{abs_path(dirname($cur_file)."/".$cur_file_data->{link})})) {
  92         # yes!!
  93         my ($real_file, $real_perm);
  94         if ($SONAME{$cur_file}) {
  95             $real_file = $cur_file;
  96             $real_perm = $cur_file_data->{operm};
  97         } else {
  98             $real_file = abs_path(dirname($cur_file)."/".$cur_file_data->{link});
  99             $real_perm = $info->index->{$real_file}->{operm} || $cur_file_data->{operm};
 100         }
 101
 102         # Now that we're sure this is really a shared library, report on
 103         # non-PIC problems.
 104         if ($cur_file eq $real_file and $objdump->{$cur_file}->{TEXTREL}) {
 105             tag "shlib-with-non-pic-code", "$cur_file";
 106         }
 107
 108         my @symbol_names = map { @{$_}[2] } @{$objdump->{$cur_file}->{SYMBOLS}};
 109         if (grep /^_?exit$/, @symbol_names and !grep /^fork$/, @symbol_names) {
 110             tag "shlib-calls-exit", "$cur_file";
 111         }
 112
 113         # don't apply the permission checks to links
 114         # since this only results in doubled messages
 115         if ($cur_file eq $real_file) {
 116             # executable?
 117             if ($real_perm & 0100 or $real_perm & 010 or $real_perm & 01) {
 118                 # yes.  But if the library has an INTERP section, it's designed
 119                 # to do something useful when executed, so don't report an error.
 120                 tag "shlib-with-executable-bit", $cur_file, sprintf("%04o", $real_perm)
 121                     unless $objdump->{$real_file}->{INTERP};
 122             } elsif ($real_perm != 0644) {
 123                 # bad permissions
 124                 tag "shlib-with-bad-permissions", $cur_file, sprintf("%04o", $real_perm);
 125             }
 126         }
 127
 128         # Installed in a directory controlled by the dynamic linker?  We have
 129         # to strip off directories named for hardware capabilities.
 130         my $dirname = dirname($cur_file);
 131         my $last;
 132         do {
 133             $dirname =~ s%/([^/]+)$%%;
 134             $last = $1;
 135         } while ($last && $hwcap_dir{$last});
 136         $dirname .= "/$last" if $last;
 137         if ($ldconfig_dirs->known($dirname)) {
 138             # yes! so postinst must call ldconfig
 139             $must_call_ldconfig = $real_file;
 140         }
 141
 142         # executable stack.  We can only warn about a missing section on some
 143         # architectures.  Only warn if there's an Architecture field; if
 144         # that's missing, we'll already be complaining elsewhere.
 145         if (exists $objdump->{$cur_file}->{OTHER_DATA}) {
 146             if (not defined $objdump->{$cur_file}->{STACK}) {
 147                 if (defined $info->field('architecture')) {
 148                     my $arch = $info->field('architecture');
 149                     tag "shlib-without-PT_GNU_STACK-section", $cur_file
 150                         if $stack_arches{$arch};
 151                 }
 152             } elsif ($objdump->{$cur_file}->{STACK} ne "rw-") {
 153                 tag "shlib-with-executable-stack", $cur_file;
 154             }
 155         }
 156     } elsif (exists $objdump->{$cur_file}->{OTHER_DATA}
 157              && $ldconfig_dirs->known(dirname($cur_file))
 158              && exists $sharedobject{$cur_file}) {
 159         tag "sharedobject-in-library-directory-missing-soname", "$cur_file";
 160     } elsif ($cur_file =~ m/\.la$/ and not defined($cur_file_data->{link})) {
 161         local $_;
 162         open(LAFILE, "< unpacked/$cur_file")
 163             or fail("Could not open unpacked/$cur_file for reading!");
 164         while(<LAFILE>) {
 165             next unless (m/^libdir='(.+?)'$/);
 166             my $actual = $1;
 167             $actual =~ s,/+$,,;
 168             my ($expected) = ("/$cur_file" =~ m,^(.+)/[^/]+$,);
 169
 170             # python-central is a special case since the libraries are moved
 171             # at install time.
 172             next if ($actual =~ m,^/usr/lib/python[\d.]+/site-packages,
 173                      and $expected =~ m,^/usr/share/pyshared,);
 174             tag "incorrect-libdir-in-la-file", $cur_file, "$actual != $expected"
 175                 unless($expected eq $actual);
 176             last;
 177         }
 178         close(LAFILE);
 179     }
 180 }
 181
 182 close(IN);
 183
 184 # 3rd step: check if shlib symlinks are present and in correct order
 185 for my $shlib_file (keys %SONAME) {
 186     # file found?
 187     if (not exists $info->index->{$shlib_file}) {
 188         fail("shlib $shlib_file not found in package (should not happen!)");
 189     }
 190
 191     my ($dir, $shlib_name) = $shlib_file =~ m,(.*)/([^/]+)$,;
 192
 193     # not a public shared library, skip it
 194     next unless $ldconfig_dirs->known($dir);
 195
 196     # symlink found?
 197     my $link_file = "$dir/$SONAME{$shlib_file}";
 198     if (not exists $info->index->{$link_file}) {
 199         tag "ldconfig-symlink-missing-for-shlib", "$link_file $shlib_file $SONAME{$shlib_file}";
 200     } else {
 201         # $link_file really another file?
 202         if ($link_file eq $shlib_file) {
 203             # the library file uses its SONAME, this is ok...
 204         } else {
 205             # $link_file really a symlink?
 206             if (exists $info->index->{$link_file}->{link}) {
 207                 # yes.
 208
 209                 # $link_file pointing to correct file?
 210                 if ($info->index->{$link_file}->{link} eq $shlib_name) {
 211                     # ok.
 212                 } else {
 213                     tag "ldconfig-symlink-referencing-wrong-file",
 214                         "$link_file -> " . $info->index->{$link_file}->{link} . " instead of $shlib_name";
 215                 }
 216             } else {
 217                 tag "ldconfig-symlink-is-not-a-symlink", "$shlib_file $link_file";
 218             }
 219
 220             # symlink after shlib?
 221             #if ($info->index->{$link_file} < $info->index->{$shlib_file}) {
 222             #    tag "ldconfig-symlink-before-shlib-in-deb", "$link_file";
 223             #}
 224         }
 225     }
 226
 227     # determine shlib link name (w/o version)
 228     $link_file =~ s/\.so.*$/.so/o;
 229
 230     # -dev package?
 231     if ($pkg =~ m/\-dev$/o) {
 232         # yes!!
 233
 234         # need shlib symlink
 235         if (not exists $info->index->{$link_file}) {
 236             tag "dev-pkg-without-shlib-symlink", "$shlib_file $link_file";
 237         }
 238     } else {
 239         # no.
 240
 241         # shlib symlink may not exist.
 242         # if shlib doesn't _have_ a version, then $link_file and $shlib_file will
 243         # be equal, and it's not a development link, so don't complain.
 244         if (exists $info->index->{$link_file} and $link_file ne $shlib_file) {
 245             tag "non-dev-pkg-with-shlib-symlink", "$shlib_file $link_file";
 246         }
 247     }
 248 }
 249
 250 # 4th step: check shlibs control file
 251 my $version;
 252 if (defined $info->field('version')) {
 253     $version = $info->field('version');
 254 }
 255 my $provides = $pkg . "( = $version)";
 256 if (defined $info->field('provides')) {
 257     $provides .= ", " . $info->field('provides');
 258 }
 259 $provides = Maemian::Relation->new($provides);
 260
 261 my %shlibs_control;
 262 my %symbols_control;
 263
 264 # Libraries with no version information can't be represented by the shlibs
 265 # format (but can be represented by symbols).  We want to warn about them if
 266 # they appear in public directories.  If they're in private directories,
 267 # assume they're plugins or private libraries and are safe.
 268 my %unversioned_shlibs;
 269 for (keys %SONAME) {
 270     my $soname = format_soname($SONAME{$_});
 271     if ($soname !~ / /) {
 272         $unversioned_shlibs{$_} = 1;
 273         tag 'shlib-without-versioned-soname', $_, $soname
 274             if $ldconfig_dirs->known(dirname($_));
 275     }
 276 }
 277 @shlibs = grep { !$unversioned_shlibs{$_} } keys %SONAME;
 278
 279 if ($#shlibs == -1) {
 280     # no shared libraries included in package, thus shlibs control file should
 281     # not be present
 282     if (-f 'control/shlibs') {
 283         tag "pkg-has-shlibs-control-file-but-no-actual-shared-libs", "";
 284     }
 285 } else {
 286     # shared libraries included, thus shlibs control file has to exist
 287     if (not -f 'control/shlibs') {
 288         if ($type ne 'udeb') {
 289             for my $shlib (@shlibs) {
 290                 # skip it if it's not a public shared library
 291                 next unless $ldconfig_dirs->known(dirname($shlib));
 292                 tag "no-shlibs-control-file", "$shlib";
 293             }
 294         }
 295     } else {
 296         my %shlibs_control_used;
 297         my @shlibs_depends;
 298         open(SHLIBS, '<', 'control/shlibs')
 299             or fail("cannot open control/shlibs for reading: $!");
 300         while (<SHLIBS>) {
 301             chop;
 302             next if m/^\s*$/ or /^#/;
 303
 304             # We exclude udebs from the checks for correct shared library
 305             # dependencies, since packages may contain dependencies on
 306             # other udeb packages.
 307             my $udeb="";
 308             $udeb = "udeb: " if s/^udeb:\s+//o;
 309             @words = split(/\s+/o,$_);
 310             my $shlibs_string = $udeb.$words[0].' '.$words[1];
 311             if ($shlibs_control{$shlibs_string}) {
 312                 tag "duplicate-entry-in-shlibs-control-file", $shlibs_string;
 313             } else {
 314                 $shlibs_control{$shlibs_string} = 1;
 315                 push (@shlibs_depends, join (' ', @words[2 .. $#words]))
 316                     unless $udeb;
 317             }
 318         }
 319         close(SHLIBS);
 320         my $shlib_name;
 321         for my $shlib (@shlibs) {
 322             $shlib_name = $SONAME{$shlib};
 323             $shlib_name = format_soname($shlib_name);
 324             $shlibs_control_used{$shlib_name} = 1;
 325             $shlibs_control_used{"udeb: ".$shlib_name} = 1;
 326             unless (exists $shlibs_control{$shlib_name}) {
 327                 # skip it if it's not a public shared library
 328                 next unless $ldconfig_dirs->known(dirname($shlib));
 329                 # no!!
 330                 tag "shlib-missing-in-control-file", $shlib_name, 'for', $shlib;
 331             }
 332         }
 333         for $shlib_name (keys %shlibs_control) {
 334             tag "unused-shlib-entry-in-control-file", $shlib_name
 335                 unless $shlibs_control_used{$shlib_name};
 336         }
 337
 338         # Check that all of the packages listed as dependencies in the shlibs
 339         # file are satisfied by the current package or its Provides.
 340         # Normally, packages should only declare dependencies in their shlibs
 341         # that they themselves can satisfy.
 342         #
 343         # Deduplicate the list of dependencies before warning so that we don't
 344         # dupliate warnings.
 345         my %seen;
 346         @shlibs_depends = grep { !$seen{$_}++ } @shlibs_depends;
 347         for my $depend (@shlibs_depends) {
 348             unless ($provides->implies($depend)) {
 349                 tag "shlibs-declares-dependency-on-other-package", $depend;
 350             }
 351         }
 352     }
 353 }
 354
 355 # 5th step: check symbols control file.  Add back in the unversioned shared
 356 # libraries, since they can still have symbols files.
 357 if ($#shlibs == -1 and not %unversioned_shlibs) {
 358     # no shared libraries included in package, thus symbols control file should
 359     # not be present
 360     if (-f 'control/symbols') {
 361         tag "pkg-has-symbols-control-file-but-no-shared-libs", "";
 362     }
 363 } elsif (not -f 'control/symbols') {
 364     if ($type ne 'udeb') {
 365         for my $shlib (@shlibs, keys %unversioned_shlibs) {
 366             # skip it if it's not a public shared library
 367             next unless $ldconfig_dirs->known(dirname($shlib));
 368             tag "no-symbols-control-file", "$shlib";
 369         }
 370     }
 371 } elsif (open(IN, '<', 'control/symbols')) {
 372     my $version_wo_rev = $version;
 373     $version_wo_rev =~ s/^(.+)-([^-]+)$/$1/;
 374     my ($full_version_count, $full_version_sym) = (0, undef);
 375     my ($debian_revision_count, $debian_revision_sym) = (0, undef);
 376     my ($soname, $dep_package, $dep);
 377     my %symbols_control_used;
 378     my @symbols_depends;
 379     my $dep_templates = 0;
 380     my $meta_info_seen = 0;
 381     my $warned = 0;
 382     my $symbol_count = 0;
 383
 384     while (<IN>) {
 385         chomp;
 386         next if m/^\s*$/ or /^#/;
 387
 388         if (m/^([^\s|*]\S+)\s\S+\s*(?:\(\S+\s+\S+\)|\#MINVER\#)?/) {
 389             # soname, main dependency template
 390
 391             $soname = $1;
 392             s/^\Q$soname\E\s*//;
 393             $soname = format_soname($soname);
 394
 395             if ($symbols_control{$soname}) {
 396                 tag "duplicate-entry-in-symbols-control-file", $soname;
 397             } else {
 398                 $symbols_control{$soname} = 1;
 399                 $warned = 0;
 400
 401                 foreach my $part (split /\s*,\s*/) {
 402                     foreach my $subpart (split /\s*\|\s*/, $part) {
 403                         $subpart =~ m,^(\S+)\s*(\(\S+\s+\S+\)|#MINVER#)?$,;
 404                         ($dep_package, $dep) = ($1, $2 || '');
 405                         if (defined $dep_package) {
 406                             push @symbols_depends, $dep_package . ' ' . $dep;
 407                         } else {
 408                             tag "syntax-error-in-symbols-file", $.
 409                                 unless $warned;
 410                             $warned = 1;
 411                         }
 412                     }
 413                 }
 414             }
 415
 416             $dep_templates = 0;
 417             $meta_info_seen = 0;
 418             $symbol_count = 0;
 419         } elsif (m/^\|\s+\S+\s*(?:\(\S+\s+\S+\)|#MINVER#)?/) {
 420             # alternative dependency template
 421
 422             $warned = 0;
 423
 424             if ($meta_info_seen or not defined $soname) {
 425                 tag "syntax-error-in-symbols-file", $.;
 426                 $warned = 1;
 427             }
 428
 429             s/^\|\s*//;
 430
 431             foreach my $part (split /\s*,\s*/) {
 432                 foreach my $subpart (split /\s*\|\s*/, $part) {
 433                     $subpart =~ m,^(\S+)\s*(\(\S+\s+\S+\)|#MINVER#)?$,;
 434                     ($dep_package, $dep) = ($1, $2 || '');
 435                     if (defined $dep_package) {
 436                         push @symbols_depends, $dep_package . ' ' . $dep;
 437                     } else {
 438                         tag "syntax-error-in-symbols-file", $. unless $warned;
 439                         $warned = 1;
 440                     }
 441                 }
 442             }
 443
 444             $dep_templates++ unless $warned;
 445         } elsif (m/^\*\s(\S+):\s\S+/) {
 446             # meta-information
 447
 448             # This should probably be in a hash, but there's
 449             # only one supported value currently
 450             tag "unknown-meta-field-in-symbols-file", "$1, line $."
 451                 unless $1 eq 'Build-Depends-Package';
 452             tag "syntax-error-in-symbols-file", $.
 453                 unless defined $soname and $symbol_count == 0;
 454
 455             $meta_info_seen = 1;
 456         } elsif (m/^\s+(\S+)\s(\S+)(?:\s(\S+(?:\s\S+)?))?$/) {
 457             # Symbol definition
 458
 459             tag "syntax-error-in-symbols-file", $.
 460                 unless defined $soname;
 461
 462             $symbol_count++;
 463             my ($sym, $v, $dep_order) = ($1, $2, $3);
 464             $dep_order ||= '';
 465
 466             if (($v eq $version) and ($version =~ /-/)) {
 467                 $full_version_sym ||= $sym;
 468                 $full_version_count++;
 469             } elsif (($v =~ /-/) and (not $v =~ /~$/) and ($v ne $version_wo_rev)) {
 470                 $debian_revision_sym ||= $sym;
 471                 $debian_revision_count++;
 472             }
 473
 474             if (length $dep_order) {
 475                 if ($dep_order !~ /^\d+$/ or $dep_order > $dep_templates) {
 476                     tag "invalid-template-id-in-symbols-file", $.;
 477                 }
 478             }
 479         } else {
 480             # Unparseable line
 481
 482             tag "syntax-error-in-symbols-file", $.;
 483         }
 484     }
 485     close IN;
 486     if ($full_version_count) {
 487         $full_version_count--;
 488         my $others = '';
 489         if ($full_version_count > 0) {
 490             $others = " and $full_version_count others";
 491         }
 492         tag "symbols-file-contains-current-version-with-debian-revision",
 493             "on symbol $full_version_sym$others";
 494     }
 495     if ($debian_revision_count) {
 496         $debian_revision_count--;
 497         my $others = '';
 498         if ($debian_revision_count > 0) {
 499             $others = " and $debian_revision_count others";
 500         }
 501         tag "symbols-file-contains-debian-revision",
 502             "on symbol $debian_revision_sym$others";
 503     }
 504     my $shlib_name;
 505     for my $shlib (@shlibs, keys %unversioned_shlibs) {
 506         $shlib_name = $SONAME{$shlib};
 507         $shlib_name = format_soname($shlib_name);
 508         $symbols_control_used{$shlib_name} = 1;
 509         $symbols_control_used{"udeb: ".$shlib_name} = 1;
 510         unless (exists $symbols_control{$shlib_name}) {
 511             # skip it if it's not a public shared library
 512             next unless $ldconfig_dirs->known(dirname($shlib));
 513             tag "shlib-missing-in-symbols-control-file", $shlib_name, 'for', $shlib;
 514         }
 515     }
 516     for $shlib_name (keys %symbols_control) {
 517         tag "unused-shlib-entry-in-symbols-control-file", $shlib_name
 518             unless $symbols_control_used{$shlib_name};
 519     }
 520
 521     # Check that all of the packages listed as dependencies in the symbols
 522     # file are satisfied by the current package or its Provides.
 523     # Normally, packages should only declare dependencies in their symbols
 524     # files that they themselves can satisfy.
 525     #
 526     # Deduplicate the list of dependencies before warning so that we don't
 527     # dupliate warnings.
 528     my %seen;
 529     @symbols_depends = grep { !$seen{$_}++ } @symbols_depends;
 530     for my $depend (@symbols_depends) {
 531         unless ($provides->implies($depend)) {
 532             tag "symbols-declares-dependency-on-other-package", $depend;
 533         }
 534     }
 535 }
 536
 537 # Compare the contents of the shlibs and symbols control files, but exclude
 538 # from this check shared libraries whose SONAMEs has no version.  Those can
 539 # only be represented in symbols files and aren't expected in shlibs files.
 540 if (keys %shlibs_control and keys %symbols_control) {
 541     for my $key (keys %symbols_control) {
 542         unless (exists $shlibs_control{$key} or $key !~ / /) {
 543             tag "symbols-declared-but-not-shlib", $key;
 544         }
 545     }
 546 }
 547
 548 # 6th step: check pre- and post- control files
 549 if (-f 'control/preinst') {
 550     local $_ = slurp_entire_file('control/preinst');
 551     if (/^[^\#]*\bldconfig\b/m) {
 552         tag "preinst-calls-ldconfig", ""
 553     }
 554 }
 555
 556 my $we_call_postinst=0;
 557 if (-f 'control/postinst') {
 558     local $_ = slurp_entire_file('control/postinst');
 559
 560     # Decide if we call ldconfig
 561     if (/^[^\#]*\bldconfig\b/m) {
 562         $we_call_postinst=1;
 563     }
 564 }
 565
 566 if ($type eq 'udeb') {
 567     tag "udeb-postinst-must-not-call-ldconfig"
 568         if $we_call_postinst;
 569 } else {
 570     tag "postinst-has-useless-call-to-ldconfig", ""
 571         if $we_call_postinst and not $must_call_ldconfig;
 572     tag "postinst-must-call-ldconfig", "$must_call_ldconfig"
 573         if not $we_call_postinst and $must_call_ldconfig;
 574 }
 575
 576 if (-f 'control/prerm') {
 577     local $_ = slurp_entire_file('control/prerm');
 578     if (/^[^\#]*\bldconfig\b/m) {
 579         tag "prerm-calls-ldconfig", "";
 580     }
 581 }
 582
 583 if (-f 'control/postrm') {
 584     local $_ = slurp_entire_file('control/postrm');
 585
 586     # Decide if we call ldconfig
 587     if (/^[^\#]*\bldconfig\b/m) {
 588         tag "postrm-has-useless-call-to-ldconfig", ""
 589             unless $must_call_ldconfig;
 590     } else {
 591         tag "postrm-should-call-ldconfig", "$must_call_ldconfig"
 592             if $must_call_ldconfig;
 593     }
 594
 595     # Decide if we do it safely
 596     s/\bldconfig\b/BldconfigB/g;
 597     s/[ \t]//g;
 598     # this one matches code from debhelper
 599     s/^if\["\$1"=.?remove.?\];?\n*then\n*BldconfigB//gm;
 600     # variations...
 601     s/^if\[.?remove.?="\$1"\];?\n*then\n*BldconfigB//gm;
 602     s/^\["\$1"=.?remove.?\]\&&BldconfigB//gm;
 603     s/^\[.?remove.?="\$1"\]&&BldconfigB//gm;
 604     s/remove(?:\|[^)]+)*\).*?BldconfigB.*?(;;|esac)//s;
 605
 606     if (/^[^\#]*BldconfigB/m) {
 607         tag "postrm-unsafe-ldconfig", "";
 608     }
 609 }
 610
 611 }
 612
 613 # make /tmp/baz/baz.txt from /tmp/foo/../bar/../baz/baz.txt
 614 sub abs_path {
 615     my $path = shift;
 616     while($path =~ s!/[^/]*/\.\./!/!g){1};
 617     return $path;
 618 }
 619
 620 # Extract the library name and the version from an SONAME and return them
 621 # separated by a space.  This code should match the split_soname function in
 622 # dpkg-shlibdeps.
 623 sub format_soname {
 624     my $soname = shift;
 625
 626     # libfoo.so.X.X
 627     if ($soname =~ /^(.*)\.so\.(.*)$/) {
 628         $soname = "$1 $2";
 629     # libfoo-X.X.so
 630     } elsif ($soname =~ /^(.*)-(\d.*)\.so$/) {
 631         $soname = "$1 $2";
 632     }
 633
 634     return $soname
 635 }
 636
 637 1;
 638
 639 # Local Variables:
 640 # indent-tabs-mode: t
 641 # cperl-indent-level: 4
 642 # End:
 643 # vim: syntax=perl sw=4 ts=8