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

   1 #!/usr/bin/perl -w
   2 # objdump-info -- maemian 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         } else {
  77             $failed = 1;
  78             my $invalidop = 0;
  79             my $objdumpout = '';
  80             if (open(PIPE, '-|', "objdump --headers --private-headers -T $bin 2>&1")) {
  81                 while(<PIPE>) {
  82                     $objdumpout .= $_;
  83                     if (m/Invalid operation$/) {
  84                         $invalidop = 1;
  85                         $failed = 0;
  86                     } elsif (m/File format not recognized$/) {
  87                         $failed = 0;
  88                     } elsif (m/File truncated$/) {
  89                         $failed = 0;
  90                     }
  91                 }
  92                 close PIPE;
  93             }
  94
  95             last if $failed;
  96
  97             if ($invalidop or $binutils_version !~ m/^2\.17/) {
  98                 # If we're using a binutils newer than etch's then either
  99                 # "invalid operation" or "file format not recognized"
 100                 # are simply passed through to the checks scripts
 101                 # which handle the output themselves
 102                 #
 103                 # If objdump returned "invalid operation" and we are
 104                 # using etch's binutils then the readelf code will tend
 105                 # to produce false positives so we just return the
 106                 # objdump output and let the scripts handle it
 107
 108                 print OUT $objdumpout;
 109             } elsif (system("readelf -l $bin 2>&1 | grep -q 'Error: Not an ELF file'") == 0) {
 110                 print OUT "objdump: $bin: File format not recognized\n";
 111             } else {
 112                 # We're using etch's binutils so attempt to build an output
 113                 # file in the expected format without using objdump; we lose
 114                 # some data but none that our later checks actually use
 115
 116                 my @sections;
 117                 my @symbol_versions;
 118
 119                 if (open(PIPE, '-|', "readelf -W -l -t -d -V $bin")) {
 120                     my $section = '';
 121                     my %program_headers;
 122
 123                     while(<PIPE>) {
 124                         chomp;
 125                         if (m/^Program Headers:/) {
 126                             $section = 'PH';
 127                             print OUT "$_\n";
 128                         } elsif (m/^Section Headers:/) {
 129                             $section = 'SH';
 130                             print OUT "$_\n";
 131                         } elsif (m/^Dynamic section at offset .*:/) {
 132                             $section = 'DS';
 133                             print OUT "$_\n";
 134                         } elsif (m/^Version symbols section /) {
 135                             $section = 'VS';
 136                         } elsif (m/^\s*$/) {
 137                             $section = '';
 138                         } elsif (m/^\s*(\S+)\s*(?:(?:\S+\s+){4})\S+\s(...)/
 139                               and $section eq 'PH') {
 140                             my ($header, $flags) = ($1, $2);
 141                             $header =~ s/^GNU_//g;
 142                             next if $header eq 'Type';
 143
 144                             my $newflags = '';
 145                             $newflags .= ($flags =~ m/R/) ? 'r' : '-';
 146                             $newflags .= ($flags =~ m/W/) ? 'w' : '-';
 147                             $newflags .= ($flags =~ m/E/) ? 'x' : '-';
 148
 149                             $program_headers{$header} = $newflags;
 150
 151                             print OUT "  $header off 0x0 X 0x0 X 0x0\n  flags $newflags\n";
 152                         } elsif (m/^\s*\[(\d+)\]\s*(\S+)(?:\s|\Z)/
 153                               and $section eq 'SH') {
 154                             $sections[$1] = $2;
 155                         } elsif (m/^\s*0x(?:[0-9A-F]+)\s+\((.*?)\)\s+(\S.*)\Z/i
 156                               and $section eq 'DS') {
 157                             my ($type, $value) = ($1, $2);
 158
 159                             $value =~ s/^(?:Shared library|Library soname): \[(.*)\]/$1/;
 160                             print OUT "  $type   $value\n";
 161                         } elsif (m/^\s*[0-9A-F]+:\s+(\S+)\s*(?:\((\S+)\))?(\s|\Z)/i
 162                               and $section eq 'VS') {
 163                             while (m/([0-9A-F]+h?)\s*(?:\((\S+)\))?(\s|\Z)/gci) {
 164                                 my ($vernum, $verstring) = ($1, $2);
 165                                 $verstring ||= '';
 166                                 if ($vernum =~ m/h$/) {
 167                                     $verstring = "($verstring)";
 168                                 }
 169                                 push @symbol_versions, $verstring;
 170                             }
 171                         } elsif (m/^There is no dynamic section in this file/
 172                               and exists $program_headers{DYNAMIC}) {
 173                             # The headers declare a dynamic section but it's
 174                             # empty. Generate the same error as objdump,
 175                             # the checks scripts special-case the string.
 176                             print OUT "\n\nobjdump: $bin: Invalid operation\n";
 177                         }
 178                     }
 179                     close PIPE;
 180                 }
 181
 182                 if (open(PIPE, '-|', "readelf -W -s -D $bin")) {
 183                     print OUT "DYNAMIC SYMBOL TABLE:\n";
 184
 185                     while(<PIPE>) {
 186                         last if m/^Symbol table of/;
 187
 188                         if (m/^\s*(\d+)\s+\d+:\s*[0-9a-f]+\s+\d+\s+(?:(?:\S+\s+){3})(\S+)\s+(.*)\Z/) {
 189                             my ($symnum, $seg, $sym, $ver) = ($1, $2, $3, '');
 190
 191                             if ($sym =~ m/^(.*)@(.*)$/) {
 192                                 $sym = $1;
 193                                 $ver = $2;
 194                             } elsif (@symbol_versions == 0) {
 195                                 # No versioned symbols...
 196                                 $ver = '';
 197                             } else {
 198                                 $ver = $symbol_versions[$symnum];
 199
 200                                 if ($ver eq '*local*' or $ver eq '*global*') {
 201                                     if ($seg eq 'UND') {
 202                                         $ver = '   ';
 203                                     } else {
 204                                         $ver = 'Base';
 205                                     }
 206                                 } elsif ($ver eq '()') {
 207                                     $ver = '(Base)';
 208                                 }
 209                             }
 210
 211                             if ($seg =~ m/^\d+$/ and defined $sections[$seg]) {
 212                                 $seg = $sections[$seg];
 213                             }
 214
 215                             print OUT "00      XX $seg  000000  $ver  $sym\n";
 216                         }
 217                     }
 218
 219                     close PIPE;
 220                 }
 221             }
 222         }
 223     }
 224 }
 225
 226 close FILES;
 227 close OUT;
 228
 229 exit $failed;
 230
 231 sub fail {
 232     if ($_[0]) {
 233         print STDERR "internal error: $_[0]\n";
 234     } elsif ($!) {
 235         print STDERR "internal error: $!\n";
 236     } else {
 237         print STDERR "internal error.\n";
 238     }
 239     exit 1;
 240 }