tools/rb/find-comptr-leakers.pl

Tue, 06 Jan 2015 21:39:09 +0100

author
Michael Schloh von Bennewitz <michael@schloh.com>
date
Tue, 06 Jan 2015 21:39:09 +0100
branch
TOR_BUG_9701
changeset 8
97036ab72558
permissions
-rwxr-xr-x

Conditionally force memory storage according to privacy.thirdparty.isolate;
This solves Tor bug #9701, complying with disk avoidance documented in
https://www.torproject.org/projects/torbrowser/design/#disk-avoidance.

michael@0 1 #!/usr/bin/perl -w
michael@0 2 #
michael@0 3 # This Source Code Form is subject to the terms of the Mozilla Public
michael@0 4 # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0 5 # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0 6
michael@0 7 # Script loosely based on Chris Waterson's find-leakers.pl and make-tree.pl
michael@0 8
michael@0 9 use 5.004;
michael@0 10 use strict;
michael@0 11 use Getopt::Long;
michael@0 12
michael@0 13 # GetOption will create $opt_object, so ignore the
michael@0 14 # warning that gets spit out about those vbls.
michael@0 15 GetOptions("object=s", "list", "help");
michael@0 16
michael@0 17 # use $::opt_help twice to eliminate warning...
michael@0 18 ($::opt_help) && ($::opt_help) && die qq{
michael@0 19 usage: find-comptr-leakers.pl < logfile
michael@0 20 --object <obj> Examine only object <obj>
michael@0 21 --list Only list leaked objects
michael@0 22 --help This message :-)
michael@0 23 };
michael@0 24
michael@0 25 if ($::opt_object) {
michael@0 26 warn "Examining only object $::opt_object (THIS IS BROKEN)\n";
michael@0 27 } else {
michael@0 28 warn "Examining all objects\n";
michael@0 29 }
michael@0 30
michael@0 31 my %allocs = ( );
michael@0 32 my %counter;
michael@0 33 my $id = 0;
michael@0 34
michael@0 35 my $accumulating = 0;
michael@0 36 my $savedata = 0;
michael@0 37 my $class;
michael@0 38 my $obj;
michael@0 39 my $sno;
michael@0 40 my $op;
michael@0 41 my $cnt;
michael@0 42 my $ptr;
michael@0 43 my $strace;
michael@0 44
michael@0 45 sub save_data {
michael@0 46 # save the data
michael@0 47 if ($op eq 'nsCOMPtrAddRef') {
michael@0 48 push @{ $allocs{$sno}->{$ptr} }, [ +1, $strace ];
michael@0 49 }
michael@0 50 elsif ($op eq 'nsCOMPtrRelease') {
michael@0 51 push @{ $allocs{$sno}->{$ptr} }, [ -1, $strace ];
michael@0 52 my $sum = 0;
michael@0 53 my @ptrallocs = @{ $allocs{$sno}->{$ptr} };
michael@0 54 foreach my $alloc (@ptrallocs) {
michael@0 55 $sum += @$alloc[0];
michael@0 56 }
michael@0 57 if ( $sum == 0 ) {
michael@0 58 delete($allocs{$sno}{$ptr});
michael@0 59 }
michael@0 60 }
michael@0 61 }
michael@0 62
michael@0 63 LINE: while (<>) {
michael@0 64 if (/^</) {
michael@0 65 chop; # avoid \n in $ptr
michael@0 66 my @fields = split(/ /, $_);
michael@0 67
michael@0 68 ($class, $obj, $sno, $op, $cnt, $ptr) = @fields;
michael@0 69
michael@0 70 $strace = "";
michael@0 71
michael@0 72 if ($::opt_list) {
michael@0 73 save_data();
michael@0 74 } elsif (!($::opt_object) || ($::opt_object eq $obj)) {
michael@0 75 $accumulating = 1;
michael@0 76 }
michael@0 77 } elsif ( $accumulating == 1 ) {
michael@0 78 if ( /^$/ ) {
michael@0 79 # if line is empty
michael@0 80 $accumulating = 0;
michael@0 81 save_data();
michael@0 82 } else {
michael@0 83 $strace = $strace . $_;
michael@0 84 }
michael@0 85 }
michael@0 86 }
michael@0 87 if ( $accumulating == 1) {
michael@0 88 save_data();
michael@0 89 }
michael@0 90
michael@0 91 foreach my $serial (keys(%allocs)) {
michael@0 92 foreach my $comptr (keys( %{$allocs{$serial}} )) {
michael@0 93 my $sum = 0;
michael@0 94 my @ptrallocs = @{ $allocs{$serial}->{$comptr} };
michael@0 95 foreach my $alloc (@ptrallocs) {
michael@0 96 $sum += @$alloc[0];
michael@0 97 }
michael@0 98 print "Object ", $serial, " held by ", $comptr, " is ", $sum, " out of balance.\n";
michael@0 99 unless ($::opt_list) {
michael@0 100 print "\n";
michael@0 101 foreach my $alloc (@ptrallocs) {
michael@0 102 if (@$alloc[0] == +1) {
michael@0 103 print "Put into nsCOMPtr at:\n";
michael@0 104 } elsif (@$alloc[0] == -1) {
michael@0 105 print "Released from nsCOMPtr at:\n";
michael@0 106 }
michael@0 107 print @$alloc[1]; # the stack trace
michael@0 108 print "\n";
michael@0 109 }
michael@0 110 print "\n\n";
michael@0 111 }
michael@0 112 }
michael@0 113 }
michael@0 114

mercurial