summaryrefslogtreecommitdiff
path: root/utilities/ovs-parse-leaks.in
diff options
context:
space:
mode:
Diffstat (limited to 'utilities/ovs-parse-leaks.in')
-rwxr-xr-xutilities/ovs-parse-leaks.in285
1 files changed, 285 insertions, 0 deletions
diff --git a/utilities/ovs-parse-leaks.in b/utilities/ovs-parse-leaks.in
new file mode 100755
index 000000000..4e06847c2
--- /dev/null
+++ b/utilities/ovs-parse-leaks.in
@@ -0,0 +1,285 @@
+#! @PERL@
+
+use strict;
+use warnings;
+
+if (grep($_ eq '--help', @ARGV)) {
+ print <<EOF;
+$0, for parsing leak checker logs
+usage: $0 [BINARY] < LOG
+where LOG is a file produced by an Open vSwitch program's --check-leaks option
+ and BINARY is the binary that wrote LOG.
+EOF
+ exit 0;
+}
+
+die "$0: zero or one arguments required; use --help for help\n" if @ARGV > 1;
+die "$0: $ARGV[0] does not exist" if @ARGV > 0 && ! -e $ARGV[0];
+
+our ($binary);
+our ($a2l) = search_path("addr2line");
+my ($no_syms) = "symbols will not be translated";
+if (!@ARGV) {
+ print "no binary specified; $no_syms\n";
+} elsif (! -e $ARGV[0]) {
+ print "$ARGV[0] does not exist; $no_syms";
+} elsif (!defined($a2l)) {
+ print "addr2line not found in PATH; $no_syms";
+} else {
+ $binary = $ARGV[0];
+}
+
+our ($objdump) = search_path("objdump");
+print "objdump not found; dynamic library symbols will not be translated\n"
+ if !defined($objdump);
+
+our %blocks;
+our @segments;
+while (<STDIN>) {
+ my $ptr = "((?:0x)?[0-9a-fA-F]+|\\(nil\\))";
+ my $callers = ":((?: $ptr)+)";
+ if (/^malloc\((\d+)\) -> $ptr$callers$/) {
+ allocated($., $2, $1, $3);
+ } elsif (/^claim\($ptr\)$callers$/) {
+ claimed($., $1, $2);
+ } elsif (/realloc\($ptr, (\d+)\) -> $ptr$callers$/) {
+ my ($callers) = $4;
+ freed($., $1, $callers);
+ allocated($., $3, $2, $callers);
+ } elsif (/^free\($ptr\)$callers$/) {
+ freed($., $1, $2);
+ } elsif (/^segment: $ptr-$ptr $ptr [-r][-w][-x][sp] (.*)/) {
+ add_segment(hex($1), hex($2), hex($3), $4);
+ } else {
+ print "stdin:$.: syntax error\n";
+ }
+}
+if (%blocks) {
+ my $n_blocks = scalar(keys(%blocks));
+ my $n_bytes = 0;
+ $n_bytes += $_->{SIZE} foreach values(%blocks);
+ print "$n_bytes bytes in $n_blocks blocks not freed at end of run\n";
+ my %blocks_by_callers;
+ foreach my $block (values(%blocks)) {
+ my ($trimmed_callers) = trim_callers($block->{CALLERS});
+ push (@{$blocks_by_callers{$trimmed_callers}}, $block);
+ }
+ foreach my $callers (sort {@{$b} <=> @{$a}} (values(%blocks_by_callers))) {
+ $n_blocks = scalar(@{$callers});
+ $n_bytes = 0;
+ $n_bytes += $_->{SIZE} foreach @{$callers};
+ print "$n_bytes bytes in these $n_blocks blocks were not freed:\n";
+ my $i = 0;
+ my $max = 5;
+ foreach my $block (sort {$a->{LINE} <=> $b->{LINE}} (@{$callers})) {
+ printf "\t%d-byte block at 0x%08x allocated on stdin:%d\n",
+ $block->{SIZE}, $block->{BASE}, $block->{LINE};
+ last if $i++ > $max;
+ }
+ print "\t...and ", $n_blocks - $max, " others...\n"
+ if $n_blocks > $max;
+ print "The blocks listed above were allocated by:\n";
+ print_callers("\t", ${$callers}[0]->{CALLERS});
+ }
+}
+sub interp_pointer {
+ my ($s_ptr) = @_;
+ return $s_ptr eq '(nil)' ? 0 : hex($s_ptr);
+}
+
+sub allocated {
+ my ($line, $s_base, $size, $callers) = @_;
+ my ($base) = interp_pointer($s_base);
+ return if !$base;
+ my ($info) = {LINE => $line,
+ BASE => $base,
+ SIZE => $size,
+ CALLERS => $callers};
+ if (exists($blocks{$base})) {
+ print "In-use address returned by allocator:\n";
+ print "\tInitial allocation:\n";
+ print_block("\t\t", $blocks{$base});
+ print "\tNew allocation:\n";
+ print_block("\t\t", $info);
+ }
+ $blocks{$base} = $info;
+}
+
+sub claimed {
+ my ($line, $s_base, $callers) = @_;
+ my ($base) = interp_pointer($s_base);
+ return if !$base;
+ if (exists($blocks{$base})) {
+ $blocks{$base}{LINE} = $line;
+ $blocks{$base}{CALLERS} = $callers;
+ } else {
+ printf "Claim asserted on not-in-use block 0x%08x by:\n", $base;
+ print_callers('', $callers);
+ }
+}
+
+sub freed {
+ my ($line, $s_base, $callers) = @_;
+ my ($base) = interp_pointer($s_base);
+ return if !$base;
+
+ if (!delete($blocks{$base})) {
+ printf "Bad free of not-allocated address 0x%08x on stdin:%d by:\n", $base, $line;
+ print_callers('', $callers);
+ }
+}
+
+sub print_block {
+ my ($prefix, $info) = @_;
+ printf '%s%d-byte block at 0x%08x allocated on stdin:%d by:' . "\n",
+ $prefix, $info->{SIZE}, $info->{BASE}, $info->{LINE};
+ print_callers($prefix, $info->{CALLERS});
+}
+
+sub print_callers {
+ my ($prefix, $callers) = @_;
+ foreach my $pc (split(' ', $callers)) {
+ print "$prefix\t", lookup_pc($pc), "\n";
+ }
+}
+
+our (%cache);
+sub lookup_pc {
+ my ($s_pc) = @_;
+ if (defined($binary)) {
+ my ($pc) = hex($s_pc);
+ my ($output) = "$s_pc: ";
+ if (!exists($cache{$pc})) {
+ open(A2L, "$a2l -fe $binary --demangle $s_pc|");
+ chomp(my $function = <A2L>);
+ chomp(my $line = <A2L>);
+ close(A2L);
+ if ($function eq '??') {
+ ($function, $line) = lookup_pc_by_segment($pc);
+ }
+ $line =~ s/^(\.\.\/)*//;
+ $line = "..." . substr($line, -25) if length($line) > 28;
+ $cache{$pc} = "$s_pc: $function ($line)";
+ }
+ return $cache{$pc};
+ } else {
+ return "$s_pc";
+ }
+}
+
+sub trim_callers {
+ my ($in) = @_;
+ my (@out);
+ foreach my $pc (split(' ', $in)) {
+ my $xlated = lookup_pc($pc);
+ if ($xlated =~ /\?\?/) {
+ push(@out, "...") if !@out || $out[$#out] ne '...';
+ } else {
+ push(@out, $pc);
+ }
+ }
+ return join(' ', @out);
+}
+
+sub search_path {
+ my ($target) = @_;
+ for my $dir (split (':', $ENV{PATH})) {
+ my ($file) = "$dir/$target";
+ return $file if -e $file;
+ }
+ return undef;
+}
+
+sub add_segment {
+ my ($vm_start, $vm_end, $vm_pgoff, $file) = @_;
+ for (my $i = 0; $i <= $#segments; $i++) {
+ my ($s) = $segments[$i];
+ next if $vm_end <= $s->{START} || $vm_start >= $s->{END};
+ if ($vm_start <= $s->{START} && $vm_end >= $s->{END}) {
+ splice(@segments, $i, 1);
+ --$i;
+ } else {
+ $s->{START} = $vm_end if $vm_end > $s->{START};
+ $s->{END} = $vm_start if $vm_start <= $s->{END};
+ }
+ }
+ push(@segments, {START => $vm_start,
+ END => $vm_end,
+ PGOFF => $vm_pgoff,
+ FILE => $file});
+ @segments = sort { $a->{START} <=> $b->{START} } @segments;
+}
+
+sub binary_search {
+ my ($array, $value) = @_;
+ my $l = 0;
+ my $r = $#{$array};
+ while ($l <= $r) {
+ my $m = int(($l + $r) / 2);
+ my $e = $array->[$m];
+ if ($value < $e->{START}) {
+ $r = $m - 1;
+ } elsif ($value >= $e->{END}) {
+ $l = $m + 1;
+ } else {
+ return $e;
+ }
+ }
+ return undef;
+}
+
+sub read_sections {
+ my ($file) = @_;
+ my (@sections);
+ open(OBJDUMP, "$objdump -h $file|");
+ while (<OBJDUMP>) {
+ my $ptr = "([0-9a-fA-F]+)";
+ my ($name, $size, $vma, $lma, $file_off)
+ = /^\s*\d+\s+(\S+)\s+$ptr\s+$ptr\s+$ptr\s+$ptr/
+ or next;
+ push(@sections, {START => hex($file_off),
+ END => hex($file_off) + hex($size),
+ NAME => $name});
+ }
+ close(OBJDUMP);
+ return [sort { $a->{START} <=> $b->{START} } @sections ];
+}
+
+our %file_to_sections;
+sub segment_to_section {
+ my ($file, $file_offset) = @_;
+ if (!defined($file_to_sections{$file})) {
+ $file_to_sections{$file} = read_sections($file);
+ }
+ return binary_search($file_to_sections{$file}, $file_offset);
+}
+
+sub address_to_segment {
+ my ($pc) = @_;
+ return binary_search(\@segments, $pc);
+}
+
+sub lookup_pc_by_segment {
+ return ('??', 0) if !defined($objdump);
+
+ my ($pc) = @_;
+ my ($segment) = address_to_segment($pc);
+ return ('??', 0) if !defined($segment) || $segment->{FILE} eq '';
+
+ my ($file_offset) = $pc - $segment->{START} + $segment->{PGOFF};
+ my ($section) = segment_to_section($segment->{FILE}, $file_offset);
+ return ('??', 0) if !defined($section);
+
+ my ($section_offset) = $file_offset - $section->{START};
+ open(A2L, sprintf("%s -fe %s --demangle --section=$section->{NAME} 0x%x|",
+ $a2l, $segment->{FILE}, $section_offset));
+ chomp(my $function = <A2L>);
+ chomp(my $line = <A2L>);
+ close(A2L);
+
+ return ($function, $line);
+}
+
+# Local Variables:
+# mode: perl
+# End:
View Lorry Controller Status