1#!/usr/bin/env perl
2#***************************************************************************
3#                                  _   _ ____  _
4#  Project                     ___| | | |  _ \| |
5#                             / __| | | | |_) | |
6#                            | (__| |_| |  _ <| |___
7#                             \___|\___/|_| \_\_____|
8#
9# Copyright (C) 1998 - 2013, Daniel Stenberg, <daniel@haxx.se>, et al.
10#
11# This software is licensed as described in the file COPYING, which
12# you should have received as part of this distribution. The terms
13# are also available at http://curl.haxx.se/docs/copyright.html.
14#
15# You may opt to use, copy, modify, merge, publish, distribute and/or sell
16# copies of the Software, and permit persons to whom the Software is
17# furnished to do so, under the terms of the COPYING file.
18#
19# This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
20# KIND, either express or implied.
21#
22###########################################################################
23#
24# Example input:
25#
26# MEM mprintf.c:1094 malloc(32) = e5718
27# MEM mprintf.c:1103 realloc(e5718, 64) = e6118
28# MEM sendf.c:232 free(f6520)
29
30my $mallocs=0;
31my $callocs=0;
32my $reallocs=0;
33my $strdups=0;
34my $wcsdups=0;
35my $showlimit;
36
37while(1) {
38    if($ARGV[0] eq "-v") {
39        $verbose=1;
40        shift @ARGV;
41    }
42    elsif($ARGV[0] eq "-t") {
43        $trace=1;
44        shift @ARGV;
45    }
46    elsif($ARGV[0] eq "-l") {
47        # only show what alloc that caused a memlimit failure
48        $showlimit=1;
49        shift @ARGV;
50    }
51    else {
52        last;
53    }
54}
55
56my $maxmem;
57
58sub newtotal {
59    my ($newtot)=@_;
60    # count a max here
61
62    if($newtot > $maxmem) {
63        $maxmem= $newtot;
64    }
65}
66
67my $file = $ARGV[0];
68
69if(! -f $file) {
70    print "Usage: memanalyze.pl [options] <dump file>\n",
71    "Options:\n",
72    " -l  memlimit failure displayed\n",
73    " -v  Verbose\n",
74    " -t  Trace\n";
75    exit;
76}
77
78open(FILE, "<$file");
79
80if($showlimit) {
81    while(<FILE>) {
82        if(/^LIMIT.*memlimit$/) {
83            print $_;
84            last;
85        }
86    }
87    close(FILE);
88    exit;
89}
90
91
92my $lnum=0;
93while(<FILE>) {
94    chomp $_;
95    $line = $_;
96    $lnum++;
97    if($line =~ /^LIMIT ([^ ]*):(\d*) (.*)/) {
98        # new memory limit test prefix
99        my $i = $3;
100        my ($source, $linenum) = ($1, $2);
101        if($trace && ($i =~ /([^ ]*) reached memlimit/)) {
102            print "LIMIT: $1 returned error at $source:$linenum\n";
103        }
104    }
105    elsif($line =~ /^MEM ([^ ]*):(\d*) (.*)/) {
106        # generic match for the filename+linenumber
107        $source = $1;
108        $linenum = $2;
109        $function = $3;
110
111        if($function =~ /free\((\(nil\)|0x([0-9a-f]*))/) {
112            $addr = $2;
113            if($1 eq "(nil)") {
114                ; # do nothing when free(NULL)
115            }
116            elsif(!exists $sizeataddr{$addr}) {
117                print "FREE ERROR: No memory allocated: $line\n";
118            }
119            elsif(-1 == $sizeataddr{$addr}) {
120                print "FREE ERROR: Memory freed twice: $line\n";
121                print "FREE ERROR: Previously freed at: ".$getmem{$addr}."\n";
122            }
123            else {
124                $totalmem -= $sizeataddr{$addr};
125                if($trace) {
126                    print "FREE: malloc at ".$getmem{$addr}." is freed again at $source:$linenum\n";
127                    printf("FREE: %d bytes freed, left allocated: $totalmem bytes\n", $sizeataddr{$addr});
128                }
129
130                newtotal($totalmem);
131                $frees++;
132
133                $sizeataddr{$addr}=-1; # set -1 to mark as freed
134                $getmem{$addr}="$source:$linenum";
135
136            }
137        }
138        elsif($function =~ /malloc\((\d*)\) = 0x([0-9a-f]*)/) {
139            $size = $1;
140            $addr = $2;
141
142            if($sizeataddr{$addr}>0) {
143                # this means weeeeeirdo
144                print "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n";
145                print "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n";
146            }
147
148            $sizeataddr{$addr}=$size;
149            $totalmem += $size;
150
151            if($trace) {
152                print "MALLOC: malloc($size) at $source:$linenum",
153                " makes totally $totalmem bytes\n";
154            }
155
156            newtotal($totalmem);
157            $mallocs++;
158
159            $getmem{$addr}="$source:$linenum";
160        }
161        elsif($function =~ /calloc\((\d*),(\d*)\) = 0x([0-9a-f]*)/) {
162            $size = $1*$2;
163            $addr = $3;
164
165            $arg1 = $1;
166            $arg2 = $2;
167
168            if($sizeataddr{$addr}>0) {
169                # this means weeeeeirdo
170                print "Mixed debug compile, rebuild curl now\n";
171            }
172
173            $sizeataddr{$addr}=$size;
174            $totalmem += $size;
175
176            if($trace) {
177                print "CALLOC: calloc($arg1,$arg2) at $source:$linenum",
178                " makes totally $totalmem bytes\n";
179            }
180
181            newtotal($totalmem);
182            $callocs++;
183
184            $getmem{$addr}="$source:$linenum";
185        }
186        elsif($function =~ /realloc\((\(nil\)|0x([0-9a-f]*)), (\d*)\) = 0x([0-9a-f]*)/) {
187            my ($oldaddr, $newsize, $newaddr) = ($2, $3, $4);
188
189            $totalmem -= $sizeataddr{$oldaddr};
190            if($trace) {
191                printf("REALLOC: %d less bytes and ", $sizeataddr{$oldaddr});
192            }
193            $sizeataddr{$oldaddr}=0;
194
195            $totalmem += $newsize;
196            $sizeataddr{$newaddr}=$newsize;
197
198            if($trace) {
199                printf("%d more bytes ($source:$linenum)\n", $newsize);
200            }
201
202            newtotal($totalmem);
203            $reallocs++;
204
205            $getmem{$oldaddr}="";
206            $getmem{$newaddr}="$source:$linenum";
207        }
208        elsif($function =~ /strdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
209            # strdup(a5b50) (8) = df7c0
210
211            $dup = $1;
212            $size = $2;
213            $addr = $3;
214            $getmem{$addr}="$source:$linenum";
215            $sizeataddr{$addr}=$size;
216
217            $totalmem += $size;
218
219            if($trace) {
220                printf("STRDUP: $size bytes at %s, makes totally: %d bytes\n",
221                       $getmem{$addr}, $totalmem);
222            }
223
224            newtotal($totalmem);
225            $strdups++;
226        }
227        elsif($function =~ /wcsdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
228            # wcsdup(a5b50) (8) = df7c0
229
230            $dup = $1;
231            $size = $2;
232            $addr = $3;
233            $getmem{$addr}="$source:$linenum";
234            $sizeataddr{$addr}=$size;
235
236            $totalmem += $size;
237
238            if($trace) {
239                printf("WCSDUP: $size bytes at %s, makes totally: %d bytes\n",
240                       $getmem{$addr}, $totalmem);
241            }
242
243            newtotal($totalmem);
244            $wcsdups++;
245        }
246        else {
247            print "Not recognized input line: $function\n";
248        }
249    }
250    # FD url.c:1282 socket() = 5
251    elsif($_ =~ /^FD ([^ ]*):(\d*) (.*)/) {
252        # generic match for the filename+linenumber
253        $source = $1;
254        $linenum = $2;
255        $function = $3;
256
257        if($function =~ /socket\(\) = (\d*)/) {
258            $filedes{$1}=1;
259            $getfile{$1}="$source:$linenum";
260            $openfile++;
261        }
262        elsif($function =~ /socketpair\(\) = (\d*) (\d*)/) {
263            $filedes{$1}=1;
264            $getfile{$1}="$source:$linenum";
265            $openfile++;
266            $filedes{$2}=1;
267            $getfile{$2}="$source:$linenum";
268            $openfile++;
269        }
270        elsif($function =~ /accept\(\) = (\d*)/) {
271            $filedes{$1}=1;
272            $getfile{$1}="$source:$linenum";
273            $openfile++;
274        }
275        elsif($function =~ /sclose\((\d*)\)/) {
276            if($filedes{$1} != 1) {
277                print "Close without open: $line\n";
278            }
279            else {
280                $filedes{$1}=0; # closed now
281                $openfile--;
282            }
283        }
284    }
285    # FILE url.c:1282 fopen("blabla") = 0x5ddd
286    elsif($_ =~ /^FILE ([^ ]*):(\d*) (.*)/) {
287        # generic match for the filename+linenumber
288        $source = $1;
289        $linenum = $2;
290        $function = $3;
291
292        if($function =~ /f[d]*open\(\"(.*)\",\"([^\"]*)\"\) = (\(nil\)|0x([0-9a-f]*))/) {
293            if($3 eq "(nil)") {
294                ;
295            }
296            else {
297                $fopen{$4}=1;
298                $fopenfile{$4}="$source:$linenum";
299                $fopens++;
300            }
301        }
302        # fclose(0x1026c8)
303        elsif($function =~ /fclose\(0x([0-9a-f]*)\)/) {
304            if(!$fopen{$1}) {
305                print "fclose() without fopen(): $line\n";
306            }
307            else {
308                $fopen{$1}=0;
309                $fopens--;
310            }
311        }
312    }
313    # GETNAME url.c:1901 getnameinfo()
314    elsif($_ =~ /^GETNAME ([^ ]*):(\d*) (.*)/) {
315        # not much to do
316    }
317
318    # ADDR url.c:1282 getaddrinfo() = 0x5ddd
319    elsif($_ =~ /^ADDR ([^ ]*):(\d*) (.*)/) {
320        # generic match for the filename+linenumber
321        $source = $1;
322        $linenum = $2;
323        $function = $3;
324
325        if($function =~ /getaddrinfo\(\) = (\(nil\)|0x([0-9a-f]*))/) {
326            my $add = $2;
327            if($add eq "(nil)") {
328                ;
329            }
330            else {
331                $addrinfo{$add}=1;
332                $addrinfofile{$add}="$source:$linenum";
333                $addrinfos++;
334            }
335            if($trace) {
336                printf("GETADDRINFO ($source:$linenum)\n");
337            }
338        }
339        # fclose(0x1026c8)
340        elsif($function =~ /freeaddrinfo\(0x([0-9a-f]*)\)/) {
341            if(!$addrinfo{$1}) {
342                print "freeaddrinfo() without getaddrinfo(): $line\n";
343            }
344            else {
345                $addrinfo{$1}=0;
346                $addrinfos--;
347            }
348            if($trace) {
349                printf("FREEADDRINFO ($source:$linenum)\n");
350            }
351        }
352
353    }
354    else {
355        print "Not recognized prefix line: $line\n";
356    }
357}
358close(FILE);
359
360if($totalmem) {
361    print "Leak detected: memory still allocated: $totalmem bytes\n";
362
363    for(keys %sizeataddr) {
364        $addr = $_;
365        $size = $sizeataddr{$addr};
366        if($size > 0) {
367            print "At $addr, there's $size bytes.\n";
368            print " allocated by ".$getmem{$addr}."\n";
369        }
370    }
371}
372
373if($openfile) {
374    for(keys %filedes) {
375        if($filedes{$_} == 1) {
376            print "Open file descriptor created at ".$getfile{$_}."\n";
377        }
378    }
379}
380
381if($fopens) {
382    print "Open FILE handles left at:\n";
383    for(keys %fopen) {
384        if($fopen{$_} == 1) {
385            print "fopen() called at ".$fopenfile{$_}."\n";
386        }
387    }
388}
389
390if($addrinfos) {
391    print "IPv6-style name resolve data left at:\n";
392    for(keys %addrinfofile) {
393        if($addrinfo{$_} == 1) {
394            print "getaddrinfo() called at ".$addrinfofile{$_}."\n";
395        }
396    }
397}
398
399if($verbose) {
400    print "Mallocs: $mallocs\n",
401    "Reallocs: $reallocs\n",
402    "Callocs: $callocs\n",
403    "Strdups:  $strdups\n",
404    "Wcsdups:  $wcsdups\n",
405    "Frees: $frees\n",
406    "Allocations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups)."\n";
407
408    print "Maximum allocated: $maxmem\n";
409}
410