Tue, 06 Jan 2015 21:39:09 +0100
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 |