The Tor Browser / file comparison
comparison: tools/footprint/leak-gauge.pl
tools/footprint/leak-gauge.pl
- changeset 0
- 6474c204b198
equal
deleted
inserted
replaced
| -1:000000000000 | 0:00523dc4abe2 |
|---|---|
| 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/. | |
| 6 | |
| 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. | |
| 34 | |
| 35 | |
| 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 } | |
| 44 | |
| 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 }; | |
| 221 | |
| 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 } | |
| 232 | |
| 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 } |
