1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/tools/footprint/leak-gauge.pl Wed Dec 31 06:09:35 2014 +0100
1.3 @@ -0,0 +1,239 @@
1.4 +#!/usr/bin/perl -w
1.5 +# vim:sw=4:ts=4:et:
1.6 +# This Source Code Form is subject to the terms of the Mozilla Public
1.7 +# License, v. 2.0. If a copy of the MPL was not distributed with this
1.8 +# file, You can obtain one at http://mozilla.org/MPL/2.0/.
1.9 +
1.10 +# $Id: leak-gauge.pl,v 1.8 2008/02/08 19:55:03 dbaron%dbaron.org Exp $
1.11 +# This script is designed to help testers isolate and simplify testcases
1.12 +# for many classes of leaks (those that involve large graphs of core
1.13 +# data structures) in Mozilla-based browsers. It is designed to print
1.14 +# information about what has leaked by processing a log taken while
1.15 +# running the browser. Such a log can be taken over a long session of
1.16 +# normal browsing and then the log can be processed to find sites that
1.17 +# leak. Once a site is known to leak, the logging can then be repeated
1.18 +# to figure out under what conditions the leak occurs.
1.19 +#
1.20 +# The way to create this log is to set the environment variables:
1.21 +# NSPR_LOG_MODULES=DOMLeak:5,DocumentLeak:5,nsDocShellLeak:5,NodeInfoManagerLeak:5
1.22 +# NSPR_LOG_FILE=nspr.log (or any other filename of your choice)
1.23 +# in your shell and then run the program.
1.24 +# * In a Windows command prompt, set environment variables with
1.25 +# set VAR=value
1.26 +# * In an sh-based shell such as bash, set environment variables with
1.27 +# export VAR=value
1.28 +# * In a csh-based shell such as tcsh, set environment variables with
1.29 +# setenv VAR value
1.30 +#
1.31 +# Then, after you have exited the browser, run this perl script over the
1.32 +# log. Either of the following commands should work:
1.33 +# perl ./path/to/leak-gauge.pl nspr.log
1.34 +# cat nspr.log | perl ./path/to/leak-gauge.pl
1.35 +# and it will tell you which of certain core objects leaked and the URLs
1.36 +# associated with those objects.
1.37 +
1.38 +
1.39 +# Nobody said I'm not allowed to write my own object system in perl. No
1.40 +# classes here. Just objects and methods.
1.41 +sub call {
1.42 + my $func = shift;
1.43 + my $obj = shift;
1.44 + my $funcref = ${$obj}{$func};
1.45 + &$funcref($obj, @_);
1.46 +}
1.47 +
1.48 +# A hash of objects (keyed by the first word of the line in the log)
1.49 +# that have two public methods, handle_line and dump (to be called using
1.50 +# call, above), along with any private data they need.
1.51 +my $handlers = {
1.52 + "DOMWINDOW" => {
1.53 + count => 0,
1.54 + windows => {},
1.55 + handle_line => sub($$) {
1.56 + my ($self, $line) = @_;
1.57 + my $windows = ${$self}{windows};
1.58 + if ($line =~ /^([0-9a-f]*) (\S*)/) {
1.59 + my ($addr, $verb, $rest) = ($1, $2, $');
1.60 + if ($verb eq "created") {
1.61 + $rest =~ / outer=([0-9a-f]*)$/ || die "outer expected";
1.62 + my $outer = $1;
1.63 + ${$windows}{$addr} = { outer => $1 };
1.64 + ++${$self}{count};
1.65 + } elsif ($verb eq "destroyed") {
1.66 + delete ${$windows}{$addr};
1.67 + } elsif ($verb eq "SetNewDocument") {
1.68 + $rest =~ /^ (.*)$/ || die "URI expected";
1.69 + my $uri = ($1);
1.70 + ${${$windows}{$addr}}{$uri} = 1;
1.71 + }
1.72 + }
1.73 + },
1.74 + dump => sub ($) {
1.75 + my ($self) = @_;
1.76 + my $windows = ${$self}{windows};
1.77 + foreach my $addr (keys(%{$windows})) {
1.78 + my $winobj = ${$windows}{$addr};
1.79 + my $outer = delete ${$winobj}{outer};
1.80 + print "Leaked " . ($outer eq "0" ? "outer" : "inner") .
1.81 + " window $addr " .
1.82 + ($outer eq "0" ? "" : "(outer $outer) ") .
1.83 + "at address $addr.\n";
1.84 + foreach my $uri (keys(%{$winobj})) {
1.85 + print " ... with URI \"$uri\".\n";
1.86 + }
1.87 + }
1.88 + },
1.89 + summary => sub($) {
1.90 + my ($self) = @_;
1.91 + my $windows = ${$self}{windows};
1.92 + print 'Leaked ' . keys(%{$windows}) . ' out of ' .
1.93 + ${$self}{count} . " DOM Windows\n";
1.94 + }
1.95 + },
1.96 + "DOCUMENT" => {
1.97 + count => 0,
1.98 + docs => {},
1.99 + handle_line => sub($$) {
1.100 + my ($self, $line) = @_;
1.101 + # This doesn't work; I don't have time to figure out why not.
1.102 + # my $docs = ${$self}{docs};
1.103 + my $docs = ${$handlers}{"DOCUMENT"}{docs};
1.104 + if ($line =~ /^([0-9a-f]*) (\S*)/) {
1.105 + my ($addr, $verb, $rest) = ($1, $2, $');
1.106 + if ($verb eq "created") {
1.107 + ${$docs}{$addr} = {};
1.108 + ++${$self}{count};
1.109 + } elsif ($verb eq "destroyed") {
1.110 + delete ${$docs}{$addr};
1.111 + } elsif ($verb eq "ResetToURI" ||
1.112 + $verb eq "StartDocumentLoad") {
1.113 + $rest =~ /^ (.*)$/ || die "URI expected";
1.114 + my $uri = $1;
1.115 + my $doc_info = ${$docs}{$addr};
1.116 + ${$doc_info}{$uri} = 1;
1.117 + if (exists(${$doc_info}{"nim"})) {
1.118 + ${$doc_info}{"nim"}{$uri} = 1;
1.119 + }
1.120 + }
1.121 + }
1.122 + },
1.123 + dump => sub ($) {
1.124 + my ($self) = @_;
1.125 + my $docs = ${$self}{docs};
1.126 + foreach my $addr (keys(%{$docs})) {
1.127 + print "Leaked document at address $addr.\n";
1.128 + foreach my $uri (keys(%{${$docs}{$addr}})) {
1.129 + print " ... with URI \"$uri\".\n" unless $uri eq "nim";
1.130 + }
1.131 + }
1.132 + },
1.133 + summary => sub($) {
1.134 + my ($self) = @_;
1.135 + my $docs = ${$self}{docs};
1.136 + print 'Leaked ' . keys(%{$docs}) . ' out of ' .
1.137 + ${$self}{count} . " documents\n";
1.138 + }
1.139 + },
1.140 + "DOCSHELL" => {
1.141 + count => 0,
1.142 + shells => {},
1.143 + handle_line => sub($$) {
1.144 + my ($self, $line) = @_;
1.145 + my $shells = ${$self}{shells};
1.146 + if ($line =~ /^([0-9a-f]*) (\S*)/) {
1.147 + my ($addr, $verb, $rest) = ($1, $2, $');
1.148 + if ($verb eq "created") {
1.149 + ${$shells}{$addr} = {};
1.150 + ++${$self}{count};
1.151 + } elsif ($verb eq "destroyed") {
1.152 + delete ${$shells}{$addr};
1.153 + } elsif ($verb eq "InternalLoad" ||
1.154 + $verb eq "SetCurrentURI") {
1.155 + $rest =~ /^ (.*)$/ || die "URI expected";
1.156 + my $uri = $1;
1.157 + ${${$shells}{$addr}}{$uri} = 1;
1.158 + }
1.159 + }
1.160 + },
1.161 + dump => sub ($) {
1.162 + my ($self) = @_;
1.163 + my $shells = ${$self}{shells};
1.164 + foreach my $addr (keys(%{$shells})) {
1.165 + print "Leaked docshell at address $addr.\n";
1.166 + foreach my $uri (keys(%{${$shells}{$addr}})) {
1.167 + print " ... which loaded URI \"$uri\".\n";
1.168 + }
1.169 + }
1.170 + },
1.171 + summary => sub($) {
1.172 + my ($self) = @_;
1.173 + my $shells = ${$self}{shells};
1.174 + print 'Leaked ' . keys(%{$shells}) . ' out of ' .
1.175 + ${$self}{count} . " docshells\n";
1.176 + }
1.177 + },
1.178 + "NODEINFOMANAGER" => {
1.179 + count => 0,
1.180 + nims => {},
1.181 + handle_line => sub($$) {
1.182 + my ($self, $line) = @_;
1.183 + my $nims = ${$self}{nims};
1.184 + if ($line =~ /^([0-9a-f]*) (\S*)/) {
1.185 + my ($addr, $verb, $rest) = ($1, $2, $');
1.186 + if ($verb eq "created") {
1.187 + ${$nims}{$addr} = {};
1.188 + ++${$self}{count};
1.189 + } elsif ($verb eq "destroyed") {
1.190 + delete ${$nims}{$addr};
1.191 + } elsif ($verb eq "Init") {
1.192 + $rest =~ /^ document=(.*)$/ ||
1.193 + die "document pointer expected";
1.194 + my $doc = $1;
1.195 + if ($doc ne "0") {
1.196 + my $nim_info = ${$nims}{$addr};
1.197 + my $doc_info = ${$handlers}{"DOCUMENT"}{docs}{$doc};
1.198 + foreach my $uri (keys(%{$doc_info})) {
1.199 + ${$nim_info}{$uri} = 1;
1.200 + }
1.201 + ${$doc_info}{"nim"} = $nim_info;
1.202 + }
1.203 + }
1.204 + }
1.205 + },
1.206 + dump => sub ($) {
1.207 + my ($self) = @_;
1.208 + my $nims = ${$self}{nims};
1.209 + foreach my $addr (keys(%{$nims})) {
1.210 + print "Leaked content nodes associated with node info manager at address $addr.\n";
1.211 + foreach my $uri (keys(%{${$nims}{$addr}})) {
1.212 + print " ... with document URI \"$uri\".\n";
1.213 + }
1.214 + }
1.215 + },
1.216 + summary => sub($) {
1.217 + my ($self) = @_;
1.218 + my $nims = ${$self}{nims};
1.219 + print 'Leaked content nodes within ' . keys(%{$nims}) . ' out of ' .
1.220 + ${$self}{count} . " documents\n";
1.221 + }
1.222 + }
1.223 +};
1.224 +
1.225 +while (<>) {
1.226 + # strip off initial "-", thread id, and thread pointer; separate
1.227 + # first word and rest
1.228 + if (/^\-?[0-9]*\[[0-9a-f]*\]: (\S*) ([^\n\r]*)[\n\r]*$/) {
1.229 + my ($handler, $data) = ($1, $2);
1.230 + if (defined(${$handlers}{$handler})) {
1.231 + call("handle_line", ${$handlers}{$handler}, $data);
1.232 + }
1.233 + }
1.234 +}
1.235 +
1.236 +foreach my $key (keys(%{$handlers})) {
1.237 + call("dump", ${$handlers}{$key});
1.238 +}
1.239 +print "Summary:\n";
1.240 +foreach my $key (keys(%{$handlers})) {
1.241 + call("summary", ${$handlers}{$key});
1.242 +}
