tools/rb/find-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.

     1 #!/usr/bin/perl -w
     2 #
     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/.
     7 use strict;
     9 my %allocs;
    10 my %classes;
    11 my %counter;
    13 LINE: while (<>) {
    14     next LINE if (! /^</);
    16     my @fields = split(/ /, $_);
    17     my $class = shift(@fields);
    18     my $obj   = shift(@fields);
    19     my $sno   = shift(@fields);
    20     my $op    = shift(@fields);
    21     my $cnt   = shift(@fields);
    23     # for AddRef/Release $cnt is the refcount, for Ctor/Dtor it's the size
    25     if ($op eq 'AddRef' && $cnt == 1) {
    26         # Example: <nsStringBuffer> 0x01AFD3B8 1 AddRef 1
    28         $allocs{$obj} = ++$counter{$class}; # the order of allocation
    29         $classes{$obj} = $class;
    30     }
    31     elsif ($op eq 'Release' && $cnt == 0) {
    32         # Example: <nsStringBuffer> 0x01AFD3B8 1 Release 0
    34         delete($allocs{$obj});
    35         delete($classes{$obj});
    36     }
    37     elsif ($op eq 'Ctor') {
    38         # Example: <PStreamNotifyParent> 0x08880BD0 8 Ctor (20)
    40         $allocs{$obj} = ++$counter{$class};
    41         $classes{$obj} = $class;
    42     }
    43     elsif ($op eq 'Dtor') {
    44         # Example: <PStreamNotifyParent> 0x08880BD0 8 Dtor (20)
    46         delete($allocs{$obj});
    47         delete($classes{$obj});
    48     }
    49 }
    52 sub sort_by_value {
    53     my %x = @_;
    54     sub _by_value($) { my %x = @_; $x{$a} cmp $x{$b}; } 
    55     sort _by_value keys(%x);
    56 } 
    59 foreach my $key (&sort_by_value(%allocs)) {
    60     # Example: 0x03F1D818 (2078) @ <nsStringBuffer>
    61     print "$key (", $allocs{$key}, ") @ ", $classes{$key}, "\n";
    62 }

mercurial