scripts/dpkg-gensymbols.pl

   1 #!/usr/bin/perl
   2 #
   3 # dpkg-gensymbols
   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, see <http://www.gnu.org/licenses/>.
  17
  18 use strict;
  19 use warnings;
  20
  21 use Dpkg;
  22 use Dpkg::Arch qw(get_host_arch);
  23 use Dpkg::Shlibs qw(@librarypaths);
  24 use Dpkg::Shlibs::Objdump;
  25 use Dpkg::Shlibs::SymbolFile;
  26 use Dpkg::Gettext;
  27 use Dpkg::ErrorHandling;
  28 use Dpkg::Control::Info;
  29 use Dpkg::Changelog::Parse;
  30 use Dpkg::Path qw(check_files_are_the_same);
  31
  32 textdomain("dpkg-dev");
  33
  34 my $packagebuilddir = 'debian/tmp';
  35
  36 my $sourceversion;
  37 my $stdout;
  38 my $oppackage;
  39 my $compare = 1; # Bail on missing symbols by default
  40 my $input;
  41 my $output;
  42 my $template_mode = 0; # non-template mode by default
  43 my $debug = 0;
  44 my $host_arch = get_host_arch();
  45
  46 sub version {
  47     printf _g("Debian %s version %s.\n"), $progname, $version;
  48
  49     printf _g("
  50 Copyright (C) 2007 Raphael Hertzog.
  51 ");
  52
  53     printf _g("
  54 This is free software; see the GNU General Public Licence version 2 or
  55 later for copying conditions. There is NO warranty.
  56 ");
  57 }
  58
  59 sub usage {
  60     printf _g(
  61 "Usage: %s [<option> ...]
  62
  63 Options:
  64   -p<package>              generate symbols file for package.
  65   -P<packagebuilddir>      temporary build dir instead of debian/tmp.
  66   -e<library>              explicitely list libraries to scan.
  67   -v<version>              version of the packages (defaults to
  68                            version extracted from debian/changelog).
  69   -c<level>                compare generated symbols file with the
  70                            reference file in the debian directory.
  71                            Fails if difference are too important
  72                            (level goes from 0 for no check, to 4
  73                            for all checks). By default checks at
  74                            level 1.
  75   -I<file>                 force usage of <file> as reference symbols
  76                            file instead of the default file.
  77   -O<file>                 write to <file>, not .../DEBIAN/symbols.
  78   -O                       write to stdout, not .../DEBIAN/symbols.
  79   -t                       write in template mode (tags are not
  80                            processed and included in output).
  81   -d                       display debug information during work.
  82   -h, --help               show this help message.
  83       --version            show the version.
  84 "), $progname;
  85 }
  86
  87 my @files;
  88 while (@ARGV) {
  89     $_ = shift(@ARGV);
  90     if (m/^-p([-+0-9a-z.]+)$/) {
  91         $oppackage = $1;
  92     } elsif (m/^-c(\d)?$/) {
  93         $compare = defined($1) ? $1 : 1;
  94     } elsif (m/^-d$/) {
  95         $debug = 1;
  96     } elsif (m/^-v(.+)$/) {
  97         $sourceversion = $1;
  98     } elsif (m/^-e(.+)$/) {
  99         my $file = $1;
 100         if (-e $file) {
 101             push @files, $file;
 102         } else {
 103             push @files, glob($file);
 104         }
 105     } elsif (m/^-p(.*)/) {
 106         error(_g("Illegal package name \`%s'"), $1);
 107     } elsif (m/^-P(.+)$/) {
 108         $packagebuilddir = $1;
 109         $packagebuilddir =~ s{/+$}{};
 110     } elsif (m/^-O$/) {
 111         $stdout = 1;
 112     } elsif (m/^-I(.+)$/) {
 113         $input = $1;
 114     } elsif (m/^-O(.+)$/) {
 115         $output = $1;
 116     } elsif (m/^-t$/) {
 117         $template_mode = 1;
 118     } elsif (m/^-(h|-help)$/) {
 119         usage();
 120         exit(0);
 121     } elsif (m/^--version$/) {
 122         version();
 123         exit(0);
 124     } else {
 125         usageerr(_g("unknown option \`%s'"), $_);
 126     }
 127 }
 128
 129 umask 0022; # ensure sane default permissions for created files
 130
 131 if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
 132     $compare = $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL};
 133 }
 134
 135 if (not defined($sourceversion)) {
 136     my $changelog = changelog_parse();
 137     $sourceversion = $changelog->{"Version"};
 138 }
 139 if (not defined($oppackage)) {
 140     my $control = Dpkg::Control::Info->new();
 141     my @packages = map { $_->{'Package'} } $control->get_packages();
 142     @packages == 1 ||
 143         error(_g("must specify package since control info has many (%s)"),
 144               "@packages");
 145     $oppackage = $packages[0];
 146 }
 147
 148 my $symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch);
 149 my $ref_symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch);
 150 # Load source-provided symbol information
 151 foreach my $file ($input, $output, "debian/$oppackage.symbols.$host_arch",
 152     "debian/symbols.$host_arch", "debian/$oppackage.symbols",
 153     "debian/symbols")
 154 {
 155     if (defined $file and -e $file) {
 156         print "Using references symbols from $file\n" if $debug;
 157         $symfile->load($file);
 158         $ref_symfile->load($file) if $compare;
 159         last;
 160     }
 161 }
 162
 163 # Scan package build dir looking for libraries
 164 if (not scalar @files) {
 165     PATH: foreach my $path (@librarypaths) {
 166         my $libdir = "$packagebuilddir$path";
 167         $libdir =~ s{/+}{/}g;
 168         lstat $libdir;
 169         next if not -d _;
 170         next if -l _; # Skip directories which are symlinks
 171         # Skip any directory _below_ a symlink as well
 172         my $updir = $libdir;
 173         while (($updir =~ s{/[^/]*$}{}) and
 174                not check_files_are_the_same($packagebuilddir, $updir)) {
 175             next PATH if -l $updir;
 176         }
 177         opendir(DIR, "$libdir") ||
 178             syserr(_g("Can't read directory %s: %s"), $libdir, $!);
 179         push @files, grep {
 180             /(\.so\.|\.so$)/ && -f $_ &&
 181             Dpkg::Shlibs::Objdump::is_elf($_);
 182         } map { "$libdir/$_" } readdir(DIR);
 183         close(DIR);
 184     }
 185 }
 186
 187 # Merge symbol information
 188 my $od = Dpkg::Shlibs::Objdump->new();
 189 foreach my $file (@files) {
 190     print "Scanning $file for symbol information\n" if $debug;
 191     my $objid = $od->parse($file);
 192     unless (defined($objid) && $objid) {
 193         warning(_g("Objdump couldn't parse %s\n"), $file);
 194         next;
 195     }
 196     my $object = $od->get_object($objid);
 197     if ($object->{SONAME}) { # Objects without soname are of no interest
 198         print "Merging symbols from $file as $object->{SONAME}\n" if $debug;
 199         if (not $symfile->has_object($object->{SONAME})) {
 200             $symfile->create_object($object->{SONAME}, "$oppackage #MINVER#");
 201         }
 202         $symfile->merge_symbols($object, $sourceversion);
 203     } else {
 204         print "File $file doesn't have a soname. Ignoring.\n" if $debug;
 205     }
 206 }
 207 $symfile->clear_except(keys %{$od->{objects}});
 208
 209 # Write out symbols files
 210 if ($stdout) {
 211     $output = _g("<standard output>");
 212     $symfile->save("-", package => $oppackage,
 213                    template_mode => $template_mode, with_deprecated => 0);
 214 } else {
 215     unless (defined($output)) {
 216         unless($symfile->is_empty()) {
 217             $output = "$packagebuilddir/DEBIAN/symbols";
 218             mkdir("$packagebuilddir/DEBIAN") if not -e "$packagebuilddir/DEBIAN";
 219         }
 220     }
 221     if (defined($output)) {
 222         print "Storing symbols in $output.\n" if $debug;
 223         $symfile->save($output, package => $oppackage,
 224                        template_mode => $template_mode, with_deprecated => 0);
 225     } else {
 226         print "No symbol information to store.\n" if $debug;
 227     }
 228 }
 229
 230 # Check if generated files differs from reference file
 231 my $exitcode = 0;
 232 if ($compare) {
 233     use File::Temp;
 234     use Digest::MD5;
 235     # Compare
 236     if (my @libs = $symfile->get_new_libs($ref_symfile)) {
 237         warning(_g("new libraries appeared in the symbols file: %s"), "@libs");
 238         $exitcode = 4 if ($compare >= 4);
 239     }
 240     if (my @libs = $symfile->get_lost_libs($ref_symfile)) {
 241         warning(_g("some libraries disappeared in the symbols file: %s"), "@libs");
 242         $exitcode = 3 if ($compare >= 3);
 243     }
 244     if ($symfile->get_new_symbols($ref_symfile)) {
 245         unless ($symfile->used_wildcards()) {
 246             # Wildcards are used to replace many additional symbols, so we
 247             # have no idea if this is really true, so don't say it and
 248             # don't check it
 249             warning(_g("some new symbols appeared in the symbols file: %s"),
 250                     _g("see diff output below"));
 251             $exitcode = 2 if ($compare >= 2);
 252         }
 253     }
 254     if (my @syms = $symfile->get_lost_symbols($ref_symfile)) {
 255         my $list = _g("see diff output below");
 256         if ($symfile->used_wildcards()) {
 257             # If wildcards are used, we don't get a diff, so list
 258             # explicitely symbols which are lost
 259             $list = "\n";
 260             my $cur_soname = "";
 261             foreach my $sym (sort { $a->{soname} cmp $b->{soname} or
 262                                     $a->get_symboltempl() cmp $b->get_symboltempl() } @syms) {
 263                 if ($cur_soname ne $sym->{soname}) {
 264                     $list .= $sym->{soname} . "\n";
 265                     $cur_soname = $sym->{soname};
 266                 }
 267                 $list .= " " . $sym->get_symbolname() . "\n";
 268             }
 269         }
 270         warning(_g("some symbols disappeared in the symbols file: %s"), $list);
 271         $exitcode = 1 if ($compare >= 1);
 272     }
 273     unless ($symfile->used_wildcards()) {
 274         # If wildcards are not used, we can compare symbols files before
 275         # and after
 276         my $before = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX');
 277         my $after = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX');
 278         $ref_symfile->dump($before, package => $oppackage, template_mode => 1);
 279         $symfile->dump($after, package => $oppackage, template_mode => 1);
 280         seek($before, 0, 0); seek($after, 0, 0);
 281         my ($md5_before, $md5_after) = (Digest::MD5->new(), Digest::MD5->new());
 282         $md5_before->addfile($before);
 283         $md5_after->addfile($after);
 284         # Output diffs between symbols files if any
 285         if ($md5_before->hexdigest() ne $md5_after->hexdigest()) {
 286             if (defined($ref_symfile->{file})) {
 287                 warning(_g("%s doesn't match completely %s"),
 288                         $output, $ref_symfile->{file});
 289             } else {
 290                 warning(_g("no debian/symbols file used as basis for generating %s"),
 291                         $output);
 292             }
 293             my ($a, $b) = ($before->filename, $after->filename);
 294             my $diff_label = sprintf("%s (%s %s)",
 295             ($ref_symfile->{file}) ? $ref_symfile->{file} : "new_symbol_file",
 296             $oppackage, $host_arch);
 297             system("diff", "-u", "-L", $diff_label, $a, $b) if -x "/usr/bin/diff";
 298         }
 299     }
 300 }
 301 exit($exitcode);