michael@0: #!/usr/bin/perl -w
michael@0: # vim:sw=4:ts=4:et:
michael@0: # This Source Code Form is subject to the terms of the Mozilla Public
michael@0: # License, v. 2.0. If a copy of the MPL was not distributed with this
michael@0: # file, You can obtain one at http://mozilla.org/MPL/2.0/.
michael@0: 
michael@0: # $Id: leak-gauge.pl,v 1.8 2008/02/08 19:55:03 dbaron%dbaron.org Exp $
michael@0: # This script is designed to help testers isolate and simplify testcases
michael@0: # for many classes of leaks (those that involve large graphs of core
michael@0: # data structures) in Mozilla-based browsers.  It is designed to print
michael@0: # information about what has leaked by processing a log taken while
michael@0: # running the browser.  Such a log can be taken over a long session of
michael@0: # normal browsing and then the log can be processed to find sites that
michael@0: # leak.  Once a site is known to leak, the logging can then be repeated
michael@0: # to figure out under what conditions the leak occurs.
michael@0: #
michael@0: # The way to create this log is to set the environment variables:
michael@0: #   NSPR_LOG_MODULES=DOMLeak:5,DocumentLeak:5,nsDocShellLeak:5,NodeInfoManagerLeak:5
michael@0: #   NSPR_LOG_FILE=nspr.log     (or any other filename of your choice)
michael@0: # in your shell and then run the program.
michael@0: # * In a Windows command prompt, set environment variables with
michael@0: #     set VAR=value
michael@0: # * In an sh-based shell such as bash, set environment variables with
michael@0: #     export VAR=value
michael@0: # * In a csh-based shell such as tcsh, set environment variables with
michael@0: #     setenv VAR value
michael@0: #
michael@0: # Then, after you have exited the browser, run this perl script over the
michael@0: # log.  Either of the following commands should work:
michael@0: #   perl ./path/to/leak-gauge.pl nspr.log
michael@0: #   cat nspr.log | perl ./path/to/leak-gauge.pl
michael@0: # and it will tell you which of certain core objects leaked and the URLs
michael@0: # associated with those objects.
michael@0: 
michael@0: 
michael@0: # Nobody said I'm not allowed to write my own object system in perl.  No
michael@0: # classes here.  Just objects and methods.
michael@0: sub call {
michael@0:     my $func = shift;
michael@0:     my $obj = shift;
michael@0:     my $funcref = ${$obj}{$func};
michael@0:     &$funcref($obj, @_);
michael@0: }
michael@0: 
michael@0: # A hash of objects (keyed by the first word of the line in the log)
michael@0: # that have two public methods, handle_line and dump (to be called using
michael@0: # call, above), along with any private data they need.
michael@0: my $handlers = {
michael@0:     "DOMWINDOW" => {
michael@0:         count => 0,
michael@0:         windows => {},
michael@0:         handle_line => sub($$) {
michael@0:             my ($self, $line) = @_;
michael@0:             my $windows = ${$self}{windows};
michael@0:             if ($line =~ /^([0-9a-f]*) (\S*)/) {
michael@0:                 my ($addr, $verb, $rest) = ($1, $2, $');
michael@0:                 if ($verb eq "created") {
michael@0:                     $rest =~ / outer=([0-9a-f]*)$/ || die "outer expected";
michael@0:                     my $outer = $1;
michael@0:                     ${$windows}{$addr} = { outer => $1 };
michael@0:                     ++${$self}{count};
michael@0:                 } elsif ($verb eq "destroyed") {
michael@0:                     delete ${$windows}{$addr};
michael@0:                 } elsif ($verb eq "SetNewDocument") {
michael@0:                     $rest =~ /^ (.*)$/ || die "URI expected";
michael@0:                     my $uri = ($1);
michael@0:                     ${${$windows}{$addr}}{$uri} = 1;
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         dump => sub ($) {
michael@0:             my ($self) = @_;
michael@0:             my $windows = ${$self}{windows};
michael@0:             foreach my $addr (keys(%{$windows})) {
michael@0:                 my $winobj = ${$windows}{$addr};
michael@0:                 my $outer = delete ${$winobj}{outer};
michael@0:                 print "Leaked " . ($outer eq "0" ? "outer" : "inner") .
michael@0:                       " window $addr " .
michael@0:                       ($outer eq "0" ? "" : "(outer $outer) ") .
michael@0:                       "at address $addr.\n";
michael@0:                 foreach my $uri (keys(%{$winobj})) {
michael@0:                     print " ... with URI \"$uri\".\n";
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         summary => sub($) {
michael@0:             my ($self) = @_;
michael@0:             my $windows = ${$self}{windows};
michael@0:             print 'Leaked ' . keys(%{$windows}) . ' out of ' .
michael@0:                   ${$self}{count} . " DOM Windows\n";
michael@0:         }
michael@0:     },
michael@0:     "DOCUMENT" => {
michael@0:         count => 0,
michael@0:         docs => {},
michael@0:         handle_line => sub($$) {
michael@0:             my ($self, $line) = @_;
michael@0:             # This doesn't work; I don't have time to figure out why not.
michael@0:             # my $docs = ${$self}{docs};
michael@0:             my $docs = ${$handlers}{"DOCUMENT"}{docs};
michael@0:             if ($line =~ /^([0-9a-f]*) (\S*)/) {
michael@0:                 my ($addr, $verb, $rest) = ($1, $2, $');
michael@0:                 if ($verb eq "created") {
michael@0:                     ${$docs}{$addr} = {};
michael@0:                     ++${$self}{count};
michael@0:                 } elsif ($verb eq "destroyed") {
michael@0:                     delete ${$docs}{$addr};
michael@0:                 } elsif ($verb eq "ResetToURI" ||
michael@0:                          $verb eq "StartDocumentLoad") {
michael@0:                     $rest =~ /^ (.*)$/ || die "URI expected";
michael@0:                     my $uri = $1;
michael@0:                     my $doc_info = ${$docs}{$addr};
michael@0:                     ${$doc_info}{$uri} = 1;
michael@0:                     if (exists(${$doc_info}{"nim"})) {
michael@0:                         ${$doc_info}{"nim"}{$uri} = 1;
michael@0:                     }
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         dump => sub ($) {
michael@0:             my ($self) = @_;
michael@0:             my $docs = ${$self}{docs};
michael@0:             foreach my $addr (keys(%{$docs})) {
michael@0:                 print "Leaked document at address $addr.\n";
michael@0:                 foreach my $uri (keys(%{${$docs}{$addr}})) {
michael@0:                     print " ... with URI \"$uri\".\n" unless $uri eq "nim";
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         summary => sub($) {
michael@0:             my ($self) = @_;
michael@0:             my $docs = ${$self}{docs};
michael@0:             print 'Leaked ' . keys(%{$docs}) . ' out of ' .
michael@0:                   ${$self}{count} . " documents\n";
michael@0:         }
michael@0:     },
michael@0:     "DOCSHELL" => {
michael@0:         count => 0,
michael@0:         shells => {},
michael@0:         handle_line => sub($$) {
michael@0:             my ($self, $line) = @_;
michael@0:             my $shells = ${$self}{shells};
michael@0:             if ($line =~ /^([0-9a-f]*) (\S*)/) {
michael@0:                 my ($addr, $verb, $rest) = ($1, $2, $');
michael@0:                 if ($verb eq "created") {
michael@0:                     ${$shells}{$addr} = {};
michael@0:                     ++${$self}{count};
michael@0:                 } elsif ($verb eq "destroyed") {
michael@0:                     delete ${$shells}{$addr};
michael@0:                 } elsif ($verb eq "InternalLoad" ||
michael@0:                          $verb eq "SetCurrentURI") {
michael@0:                     $rest =~ /^ (.*)$/ || die "URI expected";
michael@0:                     my $uri = $1;
michael@0:                     ${${$shells}{$addr}}{$uri} = 1;
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         dump => sub ($) {
michael@0:             my ($self) = @_;
michael@0:             my $shells = ${$self}{shells};
michael@0:             foreach my $addr (keys(%{$shells})) {
michael@0:                 print "Leaked docshell at address $addr.\n";
michael@0:                 foreach my $uri (keys(%{${$shells}{$addr}})) {
michael@0:                     print " ... which loaded URI \"$uri\".\n";
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         summary => sub($) {
michael@0:             my ($self) = @_;
michael@0:             my $shells = ${$self}{shells};
michael@0:             print 'Leaked ' . keys(%{$shells}) . ' out of ' .
michael@0:                   ${$self}{count} . " docshells\n";
michael@0:         }
michael@0:     },
michael@0:     "NODEINFOMANAGER" => {
michael@0:         count => 0,
michael@0:         nims => {},
michael@0:         handle_line => sub($$) {
michael@0:             my ($self, $line) = @_;
michael@0:             my $nims = ${$self}{nims};
michael@0:             if ($line =~ /^([0-9a-f]*) (\S*)/) {
michael@0:                 my ($addr, $verb, $rest) = ($1, $2, $');
michael@0:                 if ($verb eq "created") {
michael@0:                     ${$nims}{$addr} = {};
michael@0:                     ++${$self}{count};
michael@0:                 } elsif ($verb eq "destroyed") {
michael@0:                     delete ${$nims}{$addr};
michael@0:                 } elsif ($verb eq "Init") {
michael@0:                     $rest =~ /^ document=(.*)$/ ||
michael@0:                         die "document pointer expected";
michael@0:                     my $doc = $1;
michael@0:                     if ($doc ne "0") {
michael@0:                         my $nim_info = ${$nims}{$addr};
michael@0:                         my $doc_info = ${$handlers}{"DOCUMENT"}{docs}{$doc};
michael@0:                         foreach my $uri (keys(%{$doc_info})) {
michael@0:                             ${$nim_info}{$uri} = 1;
michael@0:                         }
michael@0:                         ${$doc_info}{"nim"} = $nim_info;
michael@0:                     }
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         dump => sub ($) {
michael@0:             my ($self) = @_;
michael@0:             my $nims = ${$self}{nims};
michael@0:             foreach my $addr (keys(%{$nims})) {
michael@0:                 print "Leaked content nodes associated with node info manager at address $addr.\n";
michael@0:                 foreach my $uri (keys(%{${$nims}{$addr}})) {
michael@0:                     print " ... with document URI \"$uri\".\n";
michael@0:                 }
michael@0:             }
michael@0:         },
michael@0:         summary => sub($) {
michael@0:             my ($self) = @_;
michael@0:             my $nims = ${$self}{nims};
michael@0:             print 'Leaked content nodes within ' . keys(%{$nims}) . ' out of ' .
michael@0:                   ${$self}{count} . " documents\n";
michael@0:         }
michael@0:     }
michael@0: };
michael@0: 
michael@0: while (<>) {
michael@0:     # strip off initial "-", thread id, and thread pointer; separate
michael@0:     # first word and rest
michael@0:     if (/^\-?[0-9]*\[[0-9a-f]*\]: (\S*) ([^\n\r]*)[\n\r]*$/) {
michael@0:         my ($handler, $data) = ($1, $2);
michael@0:         if (defined(${$handlers}{$handler})) {
michael@0:             call("handle_line", ${$handlers}{$handler}, $data);
michael@0:         }
michael@0:     }
michael@0: }
michael@0: 
michael@0: foreach my $key (keys(%{$handlers})) {
michael@0:     call("dump", ${$handlers}{$key});
michael@0: }
michael@0: print "Summary:\n";
michael@0: foreach my $key (keys(%{$handlers})) {
michael@0:     call("summary", ${$handlers}{$key});
michael@0: }