vcs.maemo.org Git - maemian/blob - nokia-lintian/collection/objdump-info

   1 #!/usr/bin/perl -w
   2 # objdump-info -- lintian collection script
   3
   4 # The original shell script version of this script is
   5 # Copyright (C) 1998 Christian Schwarz
   6 #
   7 # This version, including support for etch's binutils, is
   8 # Copyright (C) 2008 Adam D. Barratt
   9 #
  10 # This program is free software; you can redistribute it and/or modify
  11 # it under the terms of the GNU General Public License as published by
  12 # the Free Software Foundation; either version 2 of the License, or
  13 # (at your option) any later version.
  14 #
  15 # This program is distributed in the hope that it will be useful,
  16 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 # GNU General Public License for more details.
  19 #
  20 # You should have received a copy of the GNU General Public License
  21 # along with this program.  If not, you can find it on the World Wide
  22 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  23 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  24 # MA 02110-1301, USA.
  25
  26 use strict;
  27
  28 # Sanity check
  29 unless (-f "fields/package") {
  30     print STDERR "error: collection script called in wrong directory!\n";
  31     exit 2;
  32 }
  33
  34 my $failed = 0;
  35
  36 open (FILES, '<', "file-info")
  37     or fail("cannot open file-info: $!");
  38
  39 open (OUT, '>', "objdump-info")
  40     or fail("cannot open objdump-info: $!");
  41
  42 open(PIPE, '-|', "dpkg-query -W -f='\${Version}\n' binutils")
  43     or fail("unable to run dpkg-query: $!");
  44 my $binutils_version = <PIPE>;
  45 chomp $binutils_version;
  46 close PIPE;
  47
  48 chdir ("unpacked")
  49     or fail ("unable to chdir to unpacked: $!\n");
  50
  51 while (<FILES>) {
  52     if (m/^(.+?):\s.*ELF/) {
  53         my $bin = $1;
  54
  55         print OUT "-- $bin\n";
  56
  57         system("head $bin | grep -q 'packed.*with.*UPX'");
  58         print OUT "objdump: $bin: Packed with UPX" if $? == 0;
  59
  60         if (open(PIPE, '-|', "readelf -l $bin 2>&1")) {
  61             local $/;
  62             local $_ = <PIPE>;
  63             print OUT $_;
  64             close PIPE;
  65         }
  66
  67         system("objdump -T $bin >/dev/null 2>&1");
  68         if ($? == 0) {
  69             # Seems happy so slurp the full output
  70             if (open(PIPE, '-|', "objdump --headers --private-headers -T $bin 2>&1")) {
  71                 local $/;
  72                 local $_ = <PIPE>;
  73                 print OUT $_;
  74                 close PIPE;
  75             }
  76         } elsif ($binutils_version !~ m/^2\.17/) {
  77             # etch's binutils (2.17) can't read 64-bit binaries on 32-bit
  78             # platforms so we special-case that below
  79             #
  80             # Otherwise we allow the two specific errors "Invalid operation" and
  81             # "File format not recognized" as the checks scripts handle them
  82
  83             # From the original script:
  84             # If the objdump error is "Invalid operation", we handle it later
  85             # in the check script, since this is the expected output (for now)
  86             # on detached debugging information in /usr/lib/debug.
  87
  88             $failed = 1;
  89             if (open(PIPE, '-|', "objdump --headers --private-headers -T $bin 2>&1")) {
  90                 while(<PIPE>) {
  91                     $failed = 0 if m/Invalid operation$/;
  92                     $failed = 0 if m/File format not recognized$/;
  93
  94                     print OUT $_;
  95                 }
  96                 close PIPE;
  97             }
  98
  99             last if $failed;
 100         } else {
 101             # We're using etch's binutils so attempt to build an output file
 102             # in the expected format without using objcopy; we lose some
 103             # data but none that our later checks actually use
 104             my @sections;
 105             my @symbol_versions;
 106
 107             if (system("readelf -l $bin 2>&1 | grep -q 'Error: Not an ELF file'") == 0) {
 108                 print OUT "objdump: $bin: File format not recognized\n";
 109                 next;
 110             } elsif (open(PIPE, '-|', "readelf -W -l -t -d -V $bin")) {
 111                 my $section = '';
 112                 my %program_headers;
 113
 114                 while(<PIPE>) {
 115                     chomp;
 116                     if (m/^Program Headers:/) {
 117                         $section = 'PH';
 118                         print OUT "$_\n";
 119                     } elsif (m/^Section Headers:/) {
 120                         $section = 'SH';
 121                         print OUT "$_\n";
 122                     } elsif (m/^Dynamic section at offset .*:/) {
 123                         $section = 'DS';
 124                         print OUT "$_\n";
 125                     } elsif (m/^Version symbols section /) {
 126                         $section = 'VS';
 127                     } elsif (m/^\s*$/) {
 128                         $section = '';
 129                     } elsif (m/^\s*(\S+)\s*(?:(?:\S+\s+){4})\S+\s(...)/
 130                              and $section eq 'PH') {
 131                         my ($header, $flags) = ($1, $2);
 132                         $header =~ s/^GNU_//g;
 133                         next if $header eq 'Type';
 134
 135                         my $newflags = '';
 136                         $newflags .= ($flags =~ m/R/) ? 'r' : '-';
 137                         $newflags .= ($flags =~ m/W/) ? 'w' : '-';
 138                         $newflags .= ($flags =~ m/E/) ? 'x' : '-';
 139
 140                         $program_headers{$header} = $newflags;
 141
 142                         print OUT "  $header off 0x0 X 0x0 X 0x0\n  flags $newflags\n";
 143                     } elsif (m/^\s*\[(\d+)\]\s*(\S+)(?:\s|\Z)/
 144                              and $section eq 'SH') {
 145                         $sections[$1] = $2;
 146                     } elsif (m/^\s*0x(?:[0-9A-F]+)\s+\((.*?)\)\s+(\S.*)\Z/i
 147                              and $section eq 'DS') {
 148                         my ($type, $value) = ($1, $2);
 149
 150                         $value =~ s/^(?:Shared library|Library soname): \[(.*)\]/$1/;
 151                         print OUT "  $type   $value\n";
 152                     } elsif (m/^\s*[0-9A-F]+:\s*(\S+)\s*\((\S+)\)\s/i
 153                              and $section eq 'VS') {
 154                         while (m/\s(\S+)\s*\((\S+)\)(\s|\Z)/gc) {
 155                             my ($vernum, $verstring) = ($1, $2);
 156                             push @symbol_versions, $verstring;
 157                         }
 158                     } elsif (m/^There is no dynamic section in this file/
 159                              and exists $program_headers{DYNAMIC}) {
 160                         # The headers declare a dynamic section but it's
 161                         # empty. Generate the same error as objdump,
 162                         # the checks scripts special-case the string.
 163                         print OUT "\n\nobjdump: $bin: Invalid operation\n";
 164                     }
 165                 }
 166                 close PIPE;
 167             }
 168
 169             if (open(PIPE, '-|', "readelf -W -s -D $bin")) {
 170                 print OUT "DYNAMIC SYMBOL TABLE:\n";
 171
 172                 while(<PIPE>) {
 173                     last if m/^Symbol table of/;
 174
 175                     if (m/^\s*(\d+)\s+\d+:\s*[0-9a-f]+\s+\d+\s+(?:(?:\S+\s+){3})(\S+)\s+(.*)\Z/) {
 176                         my ($symnum, $seg, $sym, $ver) = ($1, $2, $3, '');
 177
 178                         if ($sym =~ m/^(.*)@(.*)$/) {
 179                             $sym = $1;
 180                             $ver = $2;
 181                         } else {
 182                             $ver = $symbol_versions[$symnum];
 183
 184                             if ($ver eq '*local*' or $ver eq '*global*') {
 185                                 if ($seg eq 'UND') {
 186                                     $ver = '   ';
 187                                 } else {
 188                                     $ver = 'Base';
 189                                 }
 190                             }
 191                         }
 192
 193                         if ($seg =~ m/^\d+$/ and defined $sections[$seg]) {
 194                             $seg = $sections[$seg];
 195                         }
 196
 197                         print OUT "00      XX $seg  000000  $ver  $sym\n";
 198                     }
 199                 }
 200
 201                 close PIPE;
 202             }
 203         }
 204     }
 205 }
 206 close FILES;
 207 close OUT;
 208
 209 exit $failed;
 210
 211 sub fail {
 212     if ($_[0]) {
 213         print STDERR "internal error: $_[0]\n";
 214     } elsif ($!) {
 215         print STDERR "internal error: $!\n";
 216     } else {
 217         print STDERR "internal error.\n";
 218     }
 219     exit 1;
 220 }