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 31use strict; 32use warnings; 33 34use File::Basename; 35use Getopt::Long; 36 37sub runLeaks($); 38sub parseLeaksOutput(\@); 39sub removeMatchingRecords(\@$\@); 40sub reportError($); 41 42sub 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 104exit(main()); 105 106# Returns the output of the leaks tool in list form. 107sub 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 } 121sub 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 198sub 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 216sub reportError($) 217{ 218 my ($errorMessage) = @_; 219 220 print STDERR basename($0) . ": $errorMessage\n"; 221} 222