6 if (grep($_ eq '--help', @ARGV)) {
8 $0, for parsing leak checker logs
9 usage: $0 [BINARY] < LOG
10 where LOG is a file produced by an Open vSwitch program's --check-leaks option
11 and BINARY is the binary that wrote LOG.
16 die "$0: zero or one arguments required; use --help for help\n" if @ARGV > 1;
17 die "$0: $ARGV[0] does not exist" if @ARGV > 0 && ! -e $ARGV[0];
20 our ($a2l) = search_path("addr2line");
21 my ($no_syms) = "symbols will not be translated";
23 print "no binary specified; $no_syms\n";
24 } elsif (! -e $ARGV[0]) {
25 print "$ARGV[0] does not exist; $no_syms";
26 } elsif (!defined($a2l)) {
27 print "addr2line not found in PATH; $no_syms";
32 our ($objdump) = search_path("objdump");
33 print "objdump not found; dynamic library symbols will not be translated\n"
34 if !defined($objdump);
39 my $ptr = "((?:0x)?[0-9a-fA-F]+|\\(nil\\))";
40 my $callers = ":((?: $ptr)+)";
41 if (/^malloc\((\d+)\) -> $ptr$callers$/) {
42 allocated($., $2, $1, $3);
43 } elsif (/^claim\($ptr\)$callers$/) {
45 } elsif (/realloc\($ptr, (\d+)\) -> $ptr$callers$/) {
47 freed($., $1, $callers);
48 allocated($., $3, $2, $callers);
49 } elsif (/^free\($ptr\)$callers$/) {
51 } elsif (/^segment: $ptr-$ptr $ptr [-r][-w][-x][sp] (.*)/) {
52 add_segment(hex($1), hex($2), hex($3), $4);
54 print "stdin:$.: syntax error\n";
58 my $n_blocks = scalar(keys(%blocks));
60 $n_bytes += $_->{SIZE} foreach values(%blocks);
61 print "$n_bytes bytes in $n_blocks blocks not freed at end of run\n";
62 my %blocks_by_callers;
63 foreach my $block (values(%blocks)) {
64 my ($trimmed_callers) = trim_callers($block->{CALLERS});
65 push (@{$blocks_by_callers{$trimmed_callers}}, $block);
67 foreach my $callers (sort {@{$b} <=> @{$a}} (values(%blocks_by_callers))) {
68 $n_blocks = scalar(@{$callers});
70 $n_bytes += $_->{SIZE} foreach @{$callers};
71 print "$n_bytes bytes in these $n_blocks blocks were not freed:\n";
74 foreach my $block (sort {$a->{LINE} <=> $b->{LINE}} (@{$callers})) {
75 printf "\t%d-byte block at 0x%08x allocated on stdin:%d\n",
76 $block->{SIZE}, $block->{BASE}, $block->{LINE};
79 print "\t...and ", $n_blocks - $max, " others...\n"
81 print "The blocks listed above were allocated by:\n";
82 print_callers("\t", ${$callers}[0]->{CALLERS});
87 return $s_ptr eq '(nil)' ? 0 : hex($s_ptr);
91 my ($line, $s_base, $size, $callers) = @_;
92 my ($base) = interp_pointer($s_base);
94 my ($info) = {LINE => $line,
98 if (exists($blocks{$base})) {
99 print "In-use address returned by allocator:\n";
100 print "\tInitial allocation:\n";
101 print_block("\t\t", $blocks{$base});
102 print "\tNew allocation:\n";
103 print_block("\t\t", $info);
105 $blocks{$base} = $info;
109 my ($line, $s_base, $callers) = @_;
110 my ($base) = interp_pointer($s_base);
112 if (exists($blocks{$base})) {
113 $blocks{$base}{LINE} = $line;
114 $blocks{$base}{CALLERS} = $callers;
116 printf "Claim asserted on not-in-use block 0x%08x by:\n", $base;
117 print_callers('', $callers);
122 my ($line, $s_base, $callers) = @_;
123 my ($base) = interp_pointer($s_base);
126 if (!delete($blocks{$base})) {
127 printf "Bad free of not-allocated address 0x%08x on stdin:%d by:\n", $base, $line;
128 print_callers('', $callers);
133 my ($prefix, $info) = @_;
134 printf '%s%d-byte block at 0x%08x allocated on stdin:%d by:' . "\n",
135 $prefix, $info->{SIZE}, $info->{BASE}, $info->{LINE};
136 print_callers($prefix, $info->{CALLERS});
140 my ($prefix, $callers) = @_;
141 foreach my $pc (split(' ', $callers)) {
142 print "$prefix\t", lookup_pc($pc), "\n";
149 if (defined($binary)) {
150 my ($pc) = hex($s_pc);
151 my ($output) = "$s_pc: ";
152 if (!exists($cache{$pc})) {
153 open(A2L, "$a2l -fe $binary --demangle $s_pc|");
154 chomp(my $function = <A2L>);
155 chomp(my $line = <A2L>);
157 if ($function eq '??') {
158 ($function, $line) = lookup_pc_by_segment($pc);
160 $line =~ s/^(\.\.\/)*//;
161 $line = "..." . substr($line, -25) if length($line) > 28;
162 $cache{$pc} = "$s_pc: $function ($line)";
173 foreach my $pc (split(' ', $in)) {
174 my $xlated = lookup_pc($pc);
175 if ($xlated =~ /\?\?/) {
176 push(@out, "...") if !@out || $out[$#out] ne '...';
181 return join(' ', @out);
186 for my $dir (split (':', $ENV{PATH})) {
187 my ($file) = "$dir/$target";
188 return $file if -e $file;
194 my ($vm_start, $vm_end, $vm_pgoff, $file) = @_;
195 for (my $i = 0; $i <= $#segments; $i++) {
196 my ($s) = $segments[$i];
197 next if $vm_end <= $s->{START} || $vm_start >= $s->{END};
198 if ($vm_start <= $s->{START} && $vm_end >= $s->{END}) {
199 splice(@segments, $i, 1);
202 $s->{START} = $vm_end if $vm_end > $s->{START};
203 $s->{END} = $vm_start if $vm_start <= $s->{END};
206 push(@segments, {START => $vm_start,
210 @segments = sort { $a->{START} <=> $b->{START} } @segments;
214 my ($array, $value) = @_;
218 my $m = int(($l + $r) / 2);
219 my $e = $array->[$m];
220 if ($value < $e->{START}) {
222 } elsif ($value >= $e->{END}) {
234 open(OBJDUMP, "$objdump -h $file|");
236 my $ptr = "([0-9a-fA-F]+)";
237 my ($name, $size, $vma, $lma, $file_off)
238 = /^\s*\d+\s+(\S+)\s+$ptr\s+$ptr\s+$ptr\s+$ptr/
240 push(@sections, {START => hex($file_off),
241 END => hex($file_off) + hex($size),
245 return [sort { $a->{START} <=> $b->{START} } @sections ];
248 our %file_to_sections;
249 sub segment_to_section {
250 my ($file, $file_offset) = @_;
251 if (!defined($file_to_sections{$file})) {
252 $file_to_sections{$file} = read_sections($file);
254 return binary_search($file_to_sections{$file}, $file_offset);
257 sub address_to_segment {
259 return binary_search(\@segments, $pc);
262 sub lookup_pc_by_segment {
263 return ('??', 0) if !defined($objdump);
266 my ($segment) = address_to_segment($pc);
267 return ('??', 0) if !defined($segment) || $segment->{FILE} eq '';
269 my ($file_offset) = $pc - $segment->{START} + $segment->{PGOFF};
270 my ($section) = segment_to_section($segment->{FILE}, $file_offset);
271 return ('??', 0) if !defined($section);
273 my ($section_offset) = $file_offset - $section->{START};
274 open(A2L, sprintf("%s -fe %s --demangle --section=$section->{NAME} 0x%x|",
275 $a2l, $segment->{FILE}, $section_offset));
276 chomp(my $function = <A2L>);
277 chomp(my $line = <A2L>);
280 return ($function, $line);