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\(0x([0-9a-f]*)/) {
112            $addr = $1;
113            if(!exists $sizeataddr{$addr}) {
114                print "FREE ERROR: No memory allocated: $line\n";
115            }
116            elsif(-1 == $sizeataddr{$addr}) {
117                print "FREE ERROR: Memory freed twice: $line\n";
118                print "FREE ERROR: Previously freed at: ".$getmem{$addr}."\n";
119            }
120            else {
121                $totalmem -= $sizeataddr{$addr};
122                if($trace) {
123                    print "FREE: malloc at ".$getmem{$addr}." is freed again at $source:$linenum\n";
124                    printf("FREE: %d bytes freed, left allocated: $totalmem bytes\n", $sizeataddr{$addr});
125                }
126
127                newtotal($totalmem);
128                $frees++;
129
130                $sizeataddr{$addr}=-1; # set -1 to mark as freed
131                $getmem{$addr}="$source:$linenum";
132
133            }
134        }
135        elsif($function =~ /malloc\((\d*)\) = 0x([0-9a-f]*)/) {
136            $size = $1;
137            $addr = $2;
138
139            if($sizeataddr{$addr}>0) {
140                # this means weeeeeirdo
141                print "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n";
142                print "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n";
143            }
144
145            $sizeataddr{$addr}=$size;
146            $totalmem += $size;
147
148            if($trace) {
149                print "MALLOC: malloc($size) at $source:$linenum",
150                " makes totally $totalmem bytes\n";
151            }
152
153            newtotal($totalmem);
154            $mallocs++;
155
156            $getmem{$addr}="$source:$linenum";
157        }
158        elsif($function =~ /calloc\((\d*),(\d*)\) = 0x([0-9a-f]*)/) {
159            $size = $1*$2;
160            $addr = $3;
161
162            $arg1 = $1;
163            $arg2 = $2;
164
165            if($sizeataddr{$addr}>0) {
166                # this means weeeeeirdo
167                print "Mixed debug compile, rebuild curl now\n";
168            }
169
170            $sizeataddr{$addr}=$size;
171            $totalmem += $size;
172
173            if($trace) {
174                print "CALLOC: calloc($arg1,$arg2) at $source:$linenum",
175                " makes totally $totalmem bytes\n";
176            }
177
178            newtotal($totalmem);
179            $callocs++;
180
181            $getmem{$addr}="$source:$linenum";
182        }
183        elsif($function =~ /realloc\((\(nil\)|0x([0-9a-f]*)), (\d*)\) = 0x([0-9a-f]*)/) {
184            my ($oldaddr, $newsize, $newaddr) = ($2, $3, $4);
185
186            $totalmem -= $sizeataddr{$oldaddr};
187            if($trace) {
188                printf("REALLOC: %d less bytes and ", $sizeataddr{$oldaddr});
189            }
190            $sizeataddr{$oldaddr}=0;
191
192            $totalmem += $newsize;
193            $sizeataddr{$newaddr}=$newsize;
194
195            if($trace) {
196                printf("%d more bytes ($source:$linenum)\n", $newsize);
197            }
198
199            newtotal($totalmem);
200            $reallocs++;
201
202            $getmem{$oldaddr}="";
203            $getmem{$newaddr}="$source:$linenum";
204        }
205        elsif($function =~ /strdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
206            # strdup(a5b50) (8) = df7c0
207
208            $dup = $1;
209            $size = $2;
210            $addr = $3;
211            $getmem{$addr}="$source:$linenum";
212            $sizeataddr{$addr}=$size;
213
214            $totalmem += $size;
215
216            if($trace) {
217                printf("STRDUP: $size bytes at %s, makes totally: %d bytes\n",
218                       $getmem{$addr}, $totalmem);
219            }
220
221            newtotal($totalmem);
222            $strdups++;
223        }
224        elsif($function =~ /wcsdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) {
225            # wcsdup(a5b50) (8) = df7c0
226
227            $dup = $1;
228            $size = $2;
229            $addr = $3;
230            $getmem{$addr}="$source:$linenum";
231            $sizeataddr{$addr}=$size;
232
233            $totalmem += $size;
234
235            if($trace) {
236                printf("WCSDUP: $size bytes at %s, makes totally: %d bytes\n",
237                       $getmem{$addr}, $totalmem);
238            }
239
240            newtotal($totalmem);
241            $wcsdups++;
242        }
243        else {
244            print "Not recognized input line: $function\n";
245        }
246    }
247    # FD url.c:1282 socket() = 5
248    elsif($_ =~ /^FD ([^ ]*):(\d*) (.*)/) {
249        # generic match for the filename+linenumber
250        $source = $1;
251        $linenum = $2;
252        $function = $3;
253
254        if($function =~ /socket\(\) = (\d*)/) {
255            $filedes{$1}=1;
256            $getfile{$1}="$source:$linenum";
257            $openfile++;
258        }
259        elsif($function =~ /socketpair\(\) = (\d*) (\d*)/) {
260            $filedes{$1}=1;
261            $getfile{$1}="$source:$linenum";
262            $openfile++;
263            $filedes{$2}=1;
264            $getfile{$2}="$source:$linenum";
265            $openfile++;
266        }
267        elsif($function =~ /accept\(\) = (\d*)/) {
268            $filedes{$1}=1;
269            $getfile{$1}="$source:$linenum";
270            $openfile++;
271        }
272        elsif($function =~ /sclose\((\d*)\)/) {
273            if($filedes{$1} != 1) {
274                print "Close without open: $line\n";
275            }
276            else {
277                $filedes{$1}=0; # closed now
278                $openfile--;
279            }
280        }
281    }
282    # FILE url.c:1282 fopen("blabla") = 0x5ddd
283    elsif($_ =~ /^FILE ([^ ]*):(\d*) (.*)/) {
284        # generic match for the filename+linenumber
285        $source = $1;
286        $linenum = $2;
287        $function = $3;
288
289        if($function =~ /f[d]*open\(\"(.*)\",\"([^\"]*)\"\) = (\(nil\)|0x([0-9a-f]*))/) {
290            if($3 eq "(nil)") {
291                ;
292            }
293            else {
294                $fopen{$4}=1;
295                $fopenfile{$4}="$source:$linenum";
296                $fopens++;
297            }
298        }
299        # fclose(0x1026c8)
300        elsif($function =~ /fclose\(0x([0-9a-f]*)\)/) {
301            if(!$fopen{$1}) {
302                print "fclose() without fopen(): $line\n";
303            }
304            else {
305                $fopen{$1}=0;
306                $fopens--;
307            }
308        }
309    }
310    # GETNAME url.c:1901 getnameinfo()
311    elsif($_ =~ /^GETNAME ([^ ]*):(\d*) (.*)/) {
312        # not much to do
313    }
314
315    # ADDR url.c:1282 getaddrinfo() = 0x5ddd
316    elsif($_ =~ /^ADDR ([^ ]*):(\d*) (.*)/) {
317        # generic match for the filename+linenumber
318        $source = $1;
319        $linenum = $2;
320        $function = $3;
321
322        if($function =~ /getaddrinfo\(\) = (\(nil\)|0x([0-9a-f]*))/) {
323            my $add = $2;
324            if($add eq "(nil)") {
325                ;
326            }
327            else {
328                $addrinfo{$add}=1;
329                $addrinfofile{$add}="$source:$linenum";
330                $addrinfos++;
331            }
332            if($trace) {
333                printf("GETADDRINFO ($source:$linenum)\n");
334            }
335        }
336        # fclose(0x1026c8)
337        elsif($function =~ /freeaddrinfo\(0x([0-9a-f]*)\)/) {
338            if(!$addrinfo{$1}) {
339                print "freeaddrinfo() without getaddrinfo(): $line\n";
340            }
341            else {
342                $addrinfo{$1}=0;
343                $addrinfos--;
344            }
345            if($trace) {
346                printf("FREEADDRINFO ($source:$linenum)\n");
347            }
348        }
349
350    }
351    else {
352        print "Not recognized prefix line: $line\n";
353    }
354}
355close(FILE);
356
357if($totalmem) {
358    print "Leak detected: memory still allocated: $totalmem bytes\n";
359
360    for(keys %sizeataddr) {
361        $addr = $_;
362        $size = $sizeataddr{$addr};
363        if($size > 0) {
364            print "At $addr, there's $size bytes.\n";
365            print " allocated by ".$getmem{$addr}."\n";
366        }
367    }
368}
369
370if($openfile) {
371    for(keys %filedes) {
372        if($filedes{$_} == 1) {
373            print "Open file descriptor created at ".$getfile{$_}."\n";
374        }
375    }
376}
377
378if($fopens) {
379    print "Open FILE handles left at:\n";
380    for(keys %fopen) {
381        if($fopen{$_} == 1) {
382            print "fopen() called at ".$fopenfile{$_}."\n";
383        }
384    }
385}
386
387if($addrinfos) {
388    print "IPv6-style name resolve data left at:\n";
389    for(keys %addrinfofile) {
390        if($addrinfo{$_} == 1) {
391            print "getaddrinfo() called at ".$addrinfofile{$_}."\n";
392        }
393    }
394}
395
396if($verbose) {
397    print "Mallocs: $mallocs\n",
398    "Reallocs: $reallocs\n",
399    "Callocs: $callocs\n",
400    "Strdups:  $strdups\n",
401    "Wcsdups:  $wcsdups\n",
402    "Frees: $frees\n",
403    "Allocations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups)."\n";
404
405    print "Maximum allocated: $maxmem\n";
406}
407