|
1 #!/usr/bin/perl |
|
2 # vim:sw=4:ts=4:et: |
|
3 # This Source Code Form is subject to the terms of the Mozilla Public |
|
4 # License, v. 2.0. If a copy of the MPL was not distributed with this |
|
5 # file, You can obtain one at http://mozilla.org/MPL/2.0/. |
|
6 |
|
7 # $Id: fix-linux-stack.pl,v 1.16 2008/05/05 21:51:11 dbaron%dbaron.org Exp $ |
|
8 # |
|
9 # This script uses addr2line (part of binutils) to process the output of |
|
10 # nsTraceRefcnt's Linux stack walking code. This is useful for two |
|
11 # things: |
|
12 # (1) Getting line number information out of |
|
13 # |nsTraceRefcnt::WalkTheStack|'s output in debug builds. |
|
14 # (2) Getting function names out of |nsTraceRefcnt::WalkTheStack|'s |
|
15 # output on optimized builds (where it mostly prints UNKNOWN |
|
16 # because only a handful of symbols are exported from component |
|
17 # libraries). |
|
18 # |
|
19 # Use the script by piping output containing stacks (such as raw stacks |
|
20 # or make-tree.pl balance trees) through this script. |
|
21 |
|
22 use strict; |
|
23 use IPC::Open2; |
|
24 use File::Basename; |
|
25 |
|
26 # XXX Hard-coded to gdb defaults (works on Fedora). |
|
27 my $global_debug_dir = '/usr/lib/debug'; |
|
28 |
|
29 # We record several things for each file encountered. |
|
30 # |
|
31 # - {pipe_read}, {pipe_write}: these constitute a bidirectional pipe to an |
|
32 # addr2line process that gives symbol information for a file. |
|
33 # |
|
34 # - {cache}: this table holds the results of lookups that we've done |
|
35 # previously for (pre-adjustment) addresses, which lets us avoid redundant |
|
36 # calls to addr2line. |
|
37 # |
|
38 # - {address_adjustment}: addr2line wants offsets relative to the base address |
|
39 # for shared libraries, but it wants addresses including the base address |
|
40 # offset for executables. This holds the appropriate address adjustment to |
|
41 # add to an offset within file. See bug 230336. |
|
42 # |
|
43 my %file_infos; |
|
44 |
|
45 sub set_address_adjustment($$) { |
|
46 my ($file, $file_info) = @_; |
|
47 |
|
48 # find out if it's an executable (as opposed to a shared library) |
|
49 my $elftype; |
|
50 open(ELFHDR, '-|', 'readelf', '-h', $file); |
|
51 while (<ELFHDR>) { |
|
52 if (/^\s*Type:\s+(\S+)/) { |
|
53 $elftype = $1; |
|
54 last; |
|
55 } |
|
56 } |
|
57 close(ELFHDR); |
|
58 |
|
59 # If it's an executable, make adjustment the base address. |
|
60 # Otherwise, leave it zero. |
|
61 my $adjustment = 0; |
|
62 if ($elftype eq 'EXEC') { |
|
63 open(ELFSECS, '-|', 'readelf', '-S', $file); |
|
64 while (<ELFSECS>) { |
|
65 if (/^\s*\[\s*\d+\]\s+\.text\s+\w+\s+(\w+)\s+(\w+)\s+/) { |
|
66 # Subtract the .text section's offset within the |
|
67 # file from its base address. |
|
68 $adjustment = hex($1) - hex($2); |
|
69 last; |
|
70 } |
|
71 } |
|
72 close(ELFSECS); |
|
73 } |
|
74 |
|
75 $file_info->{address_adjustment} = $adjustment; |
|
76 } |
|
77 |
|
78 # Files sometimes contain a link to a separate object file that contains |
|
79 # the debug sections of the binary, removed so that a smaller file can |
|
80 # be shipped, but kept separately so that it can be obtained by those |
|
81 # who want it. |
|
82 # See http://sources.redhat.com/gdb/current/onlinedocs/gdb_16.html#SEC154 |
|
83 # for documentation of debugging information in separate files. |
|
84 # On Fedora distributions, these files can be obtained by installing |
|
85 # *-debuginfo RPM packages. |
|
86 sub separate_debug_file_for($) { |
|
87 my ($file) = @_; |
|
88 # We can read the .gnu_debuglink section using either of: |
|
89 # objdump -s --section=.gnu_debuglink $file |
|
90 # readelf -x .gnu_debuglink $file |
|
91 # Since readelf prints things backwards on little-endian platforms |
|
92 # for some versions only (backwards on Fedora Core 6, forwards on |
|
93 # Fedora 7), use objdump. |
|
94 |
|
95 # See if there's a .gnu_debuglink section |
|
96 my $have_debuglink = 0; |
|
97 open(ELFSECS, '-|', 'readelf', '-S', $file); |
|
98 while (<ELFSECS>) { |
|
99 if (/^\s*\[\s*\d+\]\s+\.gnu_debuglink\s+\w+\s+(\w+)\s+(\w+)\s+/) { |
|
100 $have_debuglink = 1; |
|
101 last; |
|
102 } |
|
103 } |
|
104 close(ELFSECS); |
|
105 return '' unless ($have_debuglink); |
|
106 |
|
107 # Determine the endianness of the shared library. |
|
108 my $endian = ''; |
|
109 open(ELFHDR, '-|', 'readelf', '-h', $file); |
|
110 while (<ELFHDR>) { |
|
111 if (/^\s*Data:\s+.*(little|big) endian.*$/) { |
|
112 $endian = $1; |
|
113 last; |
|
114 } |
|
115 } |
|
116 close(ELFHDR); |
|
117 if ($endian ne 'little' && $endian ne 'big') { |
|
118 print STDERR "Warning: could not determine endianness of $file.\n"; |
|
119 return ''; |
|
120 } |
|
121 |
|
122 |
|
123 # Read the debuglink section as an array of words, in hexidecimal. |
|
124 open(DEBUGLINK, '-|', 'objdump', '-s', '--section=.gnu_debuglink', $file); |
|
125 my @words; |
|
126 while (<DEBUGLINK>) { |
|
127 if ($_ =~ /^ [0-9a-f]* ([0-9a-f ]{8}) ([0-9a-f ]{8}) ([0-9a-f ]{8}) ([0-9a-f ]{8}).*/) { |
|
128 push @words, $1, $2, $3, $4; |
|
129 } |
|
130 } |
|
131 close(DEBUGLINK); |
|
132 |
|
133 while (@words[$#words] eq ' ') { |
|
134 pop @words; |
|
135 } |
|
136 |
|
137 if ($#words < 1) { |
|
138 print STDERR "Warning: .gnu_debuglink section in $file too short.\n"; |
|
139 return ''; |
|
140 } |
|
141 |
|
142 my @chars; |
|
143 while ($#words >= 0) { |
|
144 my $w = shift @words; |
|
145 if ($w =~ /^([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})([0-9a-f]{2})$/) { |
|
146 push @chars, $1, $2, $3, $4; |
|
147 } else { |
|
148 print STDERR "Warning: malformed objdump output for $file.\n"; |
|
149 return ''; |
|
150 } |
|
151 } |
|
152 |
|
153 my @hash_bytes = map(hex, @chars[$#chars - 3 .. $#chars]); |
|
154 $#chars -= 4; |
|
155 |
|
156 my $hash; |
|
157 if ($endian eq 'little') { |
|
158 $hash = ($hash_bytes[3] << 24) | ($hash_bytes[2] << 16) | ($hash_bytes[1] << 8) | $hash_bytes[0]; |
|
159 } else { |
|
160 $hash = ($hash_bytes[0] << 24) | ($hash_bytes[1] << 16) | ($hash_bytes[2] << 8) | $hash_bytes[3]; |
|
161 } |
|
162 |
|
163 # The string ends with a null-terminator and then 0 to three bytes |
|
164 # of padding to fill the current 32-bit unit. (This padding is |
|
165 # usually null bytes, but I've seen null-null-H, on Ubuntu x86_64.) |
|
166 my $terminator = 1; |
|
167 while ($chars[$terminator] ne '00') { |
|
168 if ($terminator == $#chars) { |
|
169 print STDERR "Warning: missing null terminator in " . |
|
170 ".gnu_debuglink section of $file.\n"; |
|
171 return ''; |
|
172 } |
|
173 ++$terminator; |
|
174 } |
|
175 if ($#chars - $terminator > 3) { |
|
176 print STDERR "Warning: Excess padding in .gnu_debuglink section " . |
|
177 "of $file.\n"; |
|
178 return ''; |
|
179 } |
|
180 $#chars = $terminator - 1; |
|
181 |
|
182 my $basename = join('', map { chr(hex($_)) } @chars); |
|
183 |
|
184 # Now $basename and $hash represent the information in the |
|
185 # .gnu_debuglink section. |
|
186 #printf STDERR "%x: %s\n", $hash, $basename; |
|
187 |
|
188 my @possible_results = ( |
|
189 dirname($file) . $basename, |
|
190 dirname($file) . '.debug/' . $basename, |
|
191 $global_debug_dir . dirname($file) . '/' . $basename |
|
192 ); |
|
193 foreach my $result (@possible_results) { |
|
194 if (-f $result) { |
|
195 # XXX We should check the hash. |
|
196 return $result; |
|
197 } |
|
198 } |
|
199 |
|
200 return ''; |
|
201 } |
|
202 |
|
203 sub get_file_info($) { |
|
204 my ($file) = @_; |
|
205 my $file_info = $file_infos{$file}; |
|
206 unless (defined $file_info) { |
|
207 my $debug_file = separate_debug_file_for($file); |
|
208 $debug_file = $file if ($debug_file eq ''); |
|
209 |
|
210 my $pid = open2($file_info->{pipe_read}, $file_info->{pipe_write}, |
|
211 '/usr/bin/addr2line', '-C', '-f', '-e', $debug_file); |
|
212 |
|
213 set_address_adjustment($file, $file_info); |
|
214 |
|
215 $file_infos{$file} = $file_info; |
|
216 } |
|
217 return $file_info; |
|
218 } |
|
219 |
|
220 # Ignore SIGPIPE as a workaround for addr2line crashes in some situations. |
|
221 $SIG{PIPE} = 'IGNORE'; |
|
222 |
|
223 select STDOUT; $| = 1; # make STDOUT unbuffered |
|
224 while (<>) { |
|
225 my $line = $_; |
|
226 if ($line =~ /^([ \|0-9-]*)(.*) ?\[([^ ]*) \+(0x[0-9A-F]{1,8})\](.*)$/) { |
|
227 my $before = $1; # allow preservation of balance trees |
|
228 my $badsymbol = $2; |
|
229 my $file = $3; |
|
230 my $address = hex($4); |
|
231 my $after = $5; # allow preservation of counts |
|
232 |
|
233 if (-f $file) { |
|
234 my $file_info = get_file_info($file); |
|
235 my $result = $file_info->{cache}->{$address}; |
|
236 if (not defined $result) { |
|
237 my $address2 = $address + $file_info->{address_adjustment}; |
|
238 my $out = $file_info->{pipe_write}; |
|
239 my $in = $file_info->{pipe_read}; |
|
240 printf {$out} "0x%X\n", $address2; |
|
241 chomp(my $symbol = <$in>); |
|
242 chomp(my $fileandline = <$in>); |
|
243 if (!$symbol || $symbol eq '??') { $symbol = $badsymbol; } |
|
244 if (!$fileandline || $fileandline eq '??:0') { |
|
245 $fileandline = $file; |
|
246 } |
|
247 $result = "$symbol ($fileandline)"; |
|
248 $file_info->{cache}->{$address} = $result; |
|
249 } |
|
250 print "$before$result$after\n"; |
|
251 } else { |
|
252 print STDERR "Warning: File \"$file\" does not exist.\n"; |
|
253 print $line; |
|
254 } |
|
255 |
|
256 } else { |
|
257 print $line; |
|
258 } |
|
259 } |