tools/leak-gauge/leak-gauge.pl

   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 }