tools/footprint/leak-gauge.pl@97036ab72558
tools/footprint/leak-gauge.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 # vim:sw=4:ts=4:et:
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 # $Id: leak-gauge.pl,v 1.8 2008/02/08 19:55:03 dbaron%dbaron.org Exp $
8 # This script is designed to help testers isolate and simplify testcases
9 # for many classes of leaks (those that involve large graphs of core
10 # data structures) in Mozilla-based browsers. It is designed to print
11 # information about what has leaked by processing a log taken while
12 # running the browser. Such a log can be taken over a long session of
13 # normal browsing and then the log can be processed to find sites that
14 # leak. Once a site is known to leak, the logging can then be repeated
15 # to figure out under what conditions the leak occurs.
16 #
17 # The way to create this log is to set the environment variables:
18 # NSPR_LOG_MODULES=DOMLeak:5,DocumentLeak:5,nsDocShellLeak:5,NodeInfoManagerLeak:5
19 # NSPR_LOG_FILE=nspr.log (or any other filename of your choice)
20 # in your shell and then run the program.
21 # * In a Windows command prompt, set environment variables with
22 # set VAR=value
23 # * In an sh-based shell such as bash, set environment variables with
24 # export VAR=value
25 # * In a csh-based shell such as tcsh, set environment variables with
26 # setenv VAR value
27 #
28 # Then, after you have exited the browser, run this perl script over the
29 # log. Either of the following commands should work:
30 # perl ./path/to/leak-gauge.pl nspr.log
31 # cat nspr.log | perl ./path/to/leak-gauge.pl
32 # and it will tell you which of certain core objects leaked and the URLs
33 # associated with those objects.
36 # Nobody said I'm not allowed to write my own object system in perl. No
37 # classes here. Just objects and methods.
38 sub call {
39 my $func = shift;
40 my $obj = shift;
41 my $funcref = ${$obj}{$func};
42 &$funcref($obj, @_);
43 }
45 # A hash of objects (keyed by the first word of the line in the log)
46 # that have two public methods, handle_line and dump (to be called using
47 # call, above), along with any private data they need.
48 my $handlers = {
49 "DOMWINDOW" => {
50 count => 0,
51 windows => {},
52 handle_line => sub($$) {
53 my ($self, $line) = @_;
54 my $windows = ${$self}{windows};
55 if ($line =~ /^([0-9a-f]*) (\S*)/) {
56 my ($addr, $verb, $rest) = ($1, $2, $');
57 if ($verb eq "created") {
58 $rest =~ / outer=([0-9a-f]*)$/ || die "outer expected";
59 my $outer = $1;
60 ${$windows}{$addr} = { outer => $1 };
61 ++${$self}{count};
62 } elsif ($verb eq "destroyed") {
63 delete ${$windows}{$addr};
64 } elsif ($verb eq "SetNewDocument") {
65 $rest =~ /^ (.*)$/ || die "URI expected";
66 my $uri = ($1);
67 ${${$windows}{$addr}}{$uri} = 1;
68 }
69 }
70 },
71 dump => sub ($) {
72 my ($self) = @_;
73 my $windows = ${$self}{windows};
74 foreach my $addr (keys(%{$windows})) {
75 my $winobj = ${$windows}{$addr};
76 my $outer = delete ${$winobj}{outer};
77 print "Leaked " . ($outer eq "0" ? "outer" : "inner") .
78 " window $addr " .
79 ($outer eq "0" ? "" : "(outer $outer) ") .
80 "at address $addr.\n";
81 foreach my $uri (keys(%{$winobj})) {
82 print " ... with URI \"$uri\".\n";
83 }
84 }
85 },
86 summary => sub($) {
87 my ($self) = @_;
88 my $windows = ${$self}{windows};
89 print 'Leaked ' . keys(%{$windows}) . ' out of ' .
90 ${$self}{count} . " DOM Windows\n";
91 }
92 },
93 "DOCUMENT" => {
94 count => 0,
95 docs => {},
96 handle_line => sub($$) {
97 my ($self, $line) = @_;
98 # This doesn't work; I don't have time to figure out why not.
99 # my $docs = ${$self}{docs};
100 my $docs = ${$handlers}{"DOCUMENT"}{docs};
101 if ($line =~ /^([0-9a-f]*) (\S*)/) {
102 my ($addr, $verb, $rest) = ($1, $2, $');
103 if ($verb eq "created") {
104 ${$docs}{$addr} = {};
105 ++${$self}{count};
106 } elsif ($verb eq "destroyed") {
107 delete ${$docs}{$addr};
108 } elsif ($verb eq "ResetToURI" ||
109 $verb eq "StartDocumentLoad") {
110 $rest =~ /^ (.*)$/ || die "URI expected";
111 my $uri = $1;
112 my $doc_info = ${$docs}{$addr};
113 ${$doc_info}{$uri} = 1;
114 if (exists(${$doc_info}{"nim"})) {
115 ${$doc_info}{"nim"}{$uri} = 1;
116 }
117 }
118 }
119 },
120 dump => sub ($) {
121 my ($self) = @_;
122 my $docs = ${$self}{docs};
123 foreach my $addr (keys(%{$docs})) {
124 print "Leaked document at address $addr.\n";
125 foreach my $uri (keys(%{${$docs}{$addr}})) {
126 print " ... with URI \"$uri\".\n" unless $uri eq "nim";
127 }
128 }
129 },
130 summary => sub($) {
131 my ($self) = @_;
132 my $docs = ${$self}{docs};
133 print 'Leaked ' . keys(%{$docs}) . ' out of ' .
134 ${$self}{count} . " documents\n";
135 }
136 },
137 "DOCSHELL" => {
138 count => 0,
139 shells => {},
140 handle_line => sub($$) {
141 my ($self, $line) = @_;
142 my $shells = ${$self}{shells};
143 if ($line =~ /^([0-9a-f]*) (\S*)/) {
144 my ($addr, $verb, $rest) = ($1, $2, $');
145 if ($verb eq "created") {
146 ${$shells}{$addr} = {};
147 ++${$self}{count};
148 } elsif ($verb eq "destroyed") {
149 delete ${$shells}{$addr};
150 } elsif ($verb eq "InternalLoad" ||
151 $verb eq "SetCurrentURI") {
152 $rest =~ /^ (.*)$/ || die "URI expected";
153 my $uri = $1;
154 ${${$shells}{$addr}}{$uri} = 1;
155 }
156 }
157 },
158 dump => sub ($) {
159 my ($self) = @_;
160 my $shells = ${$self}{shells};
161 foreach my $addr (keys(%{$shells})) {
162 print "Leaked docshell at address $addr.\n";
163 foreach my $uri (keys(%{${$shells}{$addr}})) {
164 print " ... which loaded URI \"$uri\".\n";
165 }
166 }
167 },
168 summary => sub($) {
169 my ($self) = @_;
170 my $shells = ${$self}{shells};
171 print 'Leaked ' . keys(%{$shells}) . ' out of ' .
172 ${$self}{count} . " docshells\n";
173 }
174 },
175 "NODEINFOMANAGER" => {
176 count => 0,
177 nims => {},
178 handle_line => sub($$) {
179 my ($self, $line) = @_;
180 my $nims = ${$self}{nims};
181 if ($line =~ /^([0-9a-f]*) (\S*)/) {
182 my ($addr, $verb, $rest) = ($1, $2, $');
183 if ($verb eq "created") {
184 ${$nims}{$addr} = {};
185 ++${$self}{count};
186 } elsif ($verb eq "destroyed") {
187 delete ${$nims}{$addr};
188 } elsif ($verb eq "Init") {
189 $rest =~ /^ document=(.*)$/ ||
190 die "document pointer expected";
191 my $doc = $1;
192 if ($doc ne "0") {
193 my $nim_info = ${$nims}{$addr};
194 my $doc_info = ${$handlers}{"DOCUMENT"}{docs}{$doc};
195 foreach my $uri (keys(%{$doc_info})) {
196 ${$nim_info}{$uri} = 1;
197 }
198 ${$doc_info}{"nim"} = $nim_info;
199 }
200 }
201 }
202 },
203 dump => sub ($) {
204 my ($self) = @_;
205 my $nims = ${$self}{nims};
206 foreach my $addr (keys(%{$nims})) {
207 print "Leaked content nodes associated with node info manager at address $addr.\n";
208 foreach my $uri (keys(%{${$nims}{$addr}})) {
209 print " ... with document URI \"$uri\".\n";
210 }
211 }
212 },
213 summary => sub($) {
214 my ($self) = @_;
215 my $nims = ${$self}{nims};
216 print 'Leaked content nodes within ' . keys(%{$nims}) . ' out of ' .
217 ${$self}{count} . " documents\n";
218 }
219 }
220 };
222 while (<>) {
223 # strip off initial "-", thread id, and thread pointer; separate
224 # first word and rest
225 if (/^\-?[0-9]*\[[0-9a-f]*\]: (\S*) ([^\n\r]*)[\n\r]*$/) {
226 my ($handler, $data) = ($1, $2);
227 if (defined(${$handlers}{$handler})) {
228 call("handle_line", ${$handlers}{$handler}, $data);
229 }
230 }
231 }
233 foreach my $key (keys(%{$handlers})) {
234 call("dump", ${$handlers}{$key});
235 }
236 print "Summary:\n";
237 foreach my $key (keys(%{$handlers})) {
238 call("summary", ${$handlers}{$key});
239 }
