Home | History | Annotate | Download | only in Scripts 
      1 #!/usr/bin/perl
      2 
      3 # Copyright (C) 2007 Apple Inc. All rights reserved.
      4 #
      5 # Redistribution and use in source and binary forms, with or without
      6 # modification, are permitted provided that the following conditions
      7 # are met:
      8 #
      9 # 1.  Redistributions of source code must retain the above copyright
     10 #     notice, this list of conditions and the following disclaimer. 
     11 # 2.  Redistributions in binary form must reproduce the above copyright
     12 #     notice, this list of conditions and the following disclaimer in the
     13 #     documentation and/or other materials provided with the distribution. 
     14 # 3.  Neither the name of Apple Computer, Inc. ("Apple") nor the names of
     15 #     its contributors may be used to endorse or promote products derived
     16 #     from this software without specific prior written permission. 
     17 #
     18 # THIS SOFTWARE IS PROVIDED BY APPLE AND ITS CONTRIBUTORS "AS IS" AND ANY
     19 # EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
     20 # WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
     21 # DISCLAIMED. IN NO EVENT SHALL APPLE OR ITS CONTRIBUTORS BE LIABLE FOR ANY
     22 # DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
     23 # (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
     24 # LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
     25 # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
     26 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
     27 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     28 
     29 # Script to run the Mac OS X leaks tool with more expressive '-exclude' lists.
     30 
     31 use strict;
     32 use warnings;
     33 
     34 use File::Basename;
     35 use Getopt::Long;
     36 
     37 sub runLeaks($);
     38 sub parseLeaksOutput(\@);
     39 sub removeMatchingRecords(\@$\@);
     40 sub reportError($);
     41 
     42 sub main()
     43 {
     44     # Read options.
     45     my $usage =
     46         "Usage: " . basename($0) . " [options] pid | executable name\n" .
     47         "  --exclude-callstack regexp   Exclude leaks whose call stacks match the regular expression 'regexp'.\n" .
     48         "  --exclude-type regexp        Exclude leaks whose data types match the regular expression 'regexp'.\n" .
     49         "  --help                       Show this help message.\n";
     50 
     51     my @callStacksToExclude = ();
     52     my @typesToExclude = ();
     53     my $help = 0;
     54 
     55     my $getOptionsResult = GetOptions(
     56         'exclude-callstack:s' => \@callStacksToExclude,
     57         'exclude-type:s' => \@typesToExclude,
     58         'help' => \$help
     59     );
     60     my $pidOrExecutableName = $ARGV[0];
     61 
     62     if (!$getOptionsResult || $help) {
     63         print STDERR $usage;
     64         return 1;
     65     }
     66 
     67     if (!$pidOrExecutableName) {
     68         reportError("Missing argument: pid | executable.");
     69         print STDERR $usage;
     70         return 1;
     71     }
     72 
     73     # Run leaks tool.
     74     my $leaksOutput = runLeaks($pidOrExecutableName);
     75     if (!$leaksOutput) {
     76         return 1;
     77     }
     78 
     79     my $leakList = parseLeaksOutput(@$leaksOutput);
     80     if (!$leakList) {
     81         return 1;
     82     }
     83 
     84     # Filter output.
     85     my $leakCount = @$leakList;
     86     removeMatchingRecords(@$leakList, "callStack", @callStacksToExclude);
     87     removeMatchingRecords(@$leakList, "type", @typesToExclude);
     88     my $excludeCount = $leakCount - @$leakList;
     89 
     90     # Dump results.
     91     print $leaksOutput->[0];
     92     print $leaksOutput->[1];
     93     foreach my $leak (@$leakList) {
     94         print $leak->{"leaksOutput"};
     95     }
     96 
     97     if ($excludeCount) {
     98         print "$excludeCount leaks excluded (not printed)\n";
     99     }
    100 
    101     return 0;
    102 }
    103 
    104 exit(main());
    105 
    106 # Returns the output of the leaks tool in list form.
    107 sub runLeaks($)
    108 {
    109     my ($pidOrExecutableName) = @_;
    110     
    111     my @leaksOutput = `leaks $pidOrExecutableName`;
    112     if (!@leaksOutput) {
    113         reportError("Error running leaks tool.");
    114         return;
    115     }
    116     
    117     return \@leaksOutput;
    118 }
    119 
    120 # Returns a list of hash references with the keys { address, size, type, callStack, leaksOutput }
    121 sub parseLeaksOutput(\@)
    122 {
    123     my ($leaksOutput) = @_;
    124 
    125     # Format:
    126     #   Process 00000: 1234 nodes malloced for 1234 KB
    127     #   Process 00000: XX leaks for XXX total leaked bytes.    
    128     #   Leak: 0x00000000 size=1234 [instance of 'blah']
    129     #       0x00000000 0x00000000 0x00000000 0x00000000 a..d.e.e
    130     #       ...
    131     #       Call stack: leak_caller() | leak() | malloc
    132     #
    133     #   We treat every line except for  Process 00000: and Leak: as optional
    134 
    135     # Newer versions of the leaks output have a header section at the top, with the first line describing the version of the output format.
    136     # If we detect the new format is being used then we eat all of the header section so the output matches the format of older versions.
    137     # FIXME: In the future we may wish to propagate this section through to our output.
    138     if ($leaksOutput->[0] =~ /^leaks Report Version:/) {
    139         while ($leaksOutput->[0] !~ /^Process /) {
    140             shift @$leaksOutput;
    141         }
    142     }
    143 
    144     my ($leakCount) = ($leaksOutput->[1] =~ /[[:blank:]]+([0-9]+)[[:blank:]]+leaks?/);
    145     if (!defined($leakCount)) {
    146         reportError("Could not parse leak count reported by leaks tool.");
    147         return;
    148     }
    149 
    150     my @leakList = ();
    151     for my $line (@$leaksOutput) {
    152         next if $line =~ /^Process/;
    153         next if $line =~ /^node buffer added/;
    154         
    155         if ($line =~ /^Leak: /) {
    156             my ($address) = ($line =~ /Leak: ([[:xdigit:]x]+)/);
    157             if (!defined($address)) {
    158                 reportError("Could not parse Leak address.");
    159                 return;
    160             }
    161 
    162             my ($size) = ($line =~ /size=([[:digit:]]+)/);
    163             if (!defined($size)) {
    164                 reportError("Could not parse Leak size.");
    165                 return;
    166             }
    167 
    168             my ($type) = ($line =~ /'([^']+)'/); #'
    169             if (!defined($type)) {
    170                 $type = ""; # The leaks tool sometimes omits the type.
    171             }
    172 
    173             my %leak = (
    174                 "address" => $address,
    175                 "size" => $size,
    176                 "type" => $type,
    177                 "callStack" => "", # The leaks tool sometimes omits the call stack.
    178                 "leaksOutput" => $line
    179             );
    180             push(@leakList, \%leak);
    181         } else {
    182             $leakList[$#leakList]->{"leaksOutput"} .= $line;
    183             if ($line =~ /Call stack:/) {
    184                 $leakList[$#leakList]->{"callStack"} = $line;
    185             }
    186         }
    187     }
    188     
    189     if (@leakList != $leakCount) {
    190         my $parsedLeakCount = @leakList;
    191         reportError("Parsed leak count($parsedLeakCount) does not match leak count reported by leaks tool($leakCount).");
    192         return;
    193     }
    194 
    195     return \@leakList;
    196 }
    197 
    198 sub removeMatchingRecords(\@$\@)
    199 {
    200     my ($recordList, $key, $regexpList) = @_;
    201     
    202     RECORD: for (my $i = 0; $i < @$recordList;) {
    203         my $record = $recordList->[$i];
    204 
    205         foreach my $regexp (@$regexpList) {
    206             if ($record->{$key} =~ $regexp) {
    207                 splice(@$recordList, $i, 1);
    208                 next RECORD;
    209             }
    210         }
    211         
    212         $i++;
    213     }
    214 }
    215 
    216 sub reportError($)
    217 {
    218     my ($errorMessage) = @_;
    219     
    220     print STDERR basename($0) . ": $errorMessage\n";
    221 }
    222