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