| #!/usr/bin/env perl |
| #*************************************************************************** |
| # _ _ ____ _ |
| # Project ___| | | | _ \| | |
| # / __| | | | |_) | | |
| # | (__| |_| | _ <| |___ |
| # \___|\___/|_| \_\_____| |
| # |
| # Copyright (C) Daniel Stenberg, <daniel@haxx.se>, et al. |
| # |
| # This software is licensed as described in the file COPYING, which |
| # you should have received as part of this distribution. The terms |
| # are also available at https://curl.se/docs/copyright.html. |
| # |
| # You may opt to use, copy, modify, merge, publish, distribute and/or sell |
| # copies of the Software, and permit persons to whom the Software is |
| # furnished to do so, under the terms of the COPYING file. |
| # |
| # This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY |
| # KIND, either express or implied. |
| # |
| # SPDX-License-Identifier: curl |
| # |
| ########################################################################### |
| # |
| # Example input: |
| # |
| # MEM mprintf.c:1094 malloc(32) = e5718 |
| # MEM mprintf.c:1103 realloc(e5718, 64) = e6118 |
| # MEM sendf.c:232 free(f6520) |
| |
| package memanalyzer; |
| |
| use strict; |
| use warnings; |
| |
| BEGIN { |
| use base qw(Exporter); |
| |
| our @EXPORT = qw( |
| memanalyze |
| ); |
| } |
| |
| my $memsum; |
| my $maxmem; |
| |
| sub newtotal { |
| my ($newtot)=@_; |
| # count a max here |
| |
| if($newtot > $maxmem) { |
| $maxmem = $newtot; |
| } |
| } |
| |
| sub memanalyze { |
| my ($file, $verbose, $trace, $showlimit) = @_; |
| my @res; |
| |
| my $mallocs = 0; |
| my $callocs = 0; |
| my $reallocs = 0; |
| my $strdups = 0; |
| my $wcsdups = 0; |
| my $sockets = 0; |
| |
| $memsum = 0; # the total number of memory allocated over the lifetime |
| $maxmem = 0; # the high water mark |
| |
| open(my $fileh, "<", $file) or return (); |
| |
| if($showlimit) { |
| while(<$fileh>) { |
| if(/^LIMIT.*memlimit$/) { |
| push @res, $_; |
| last; |
| } |
| } |
| close($fileh); |
| return @res; |
| } |
| |
| my %sizeataddr; |
| my %getmem; |
| |
| my $totalmem = 0; |
| my $frees = 0; |
| |
| my $dup; |
| my $size; |
| my $addr; |
| |
| my %filedes; |
| my %getfile; |
| |
| my %fopen; |
| my %fopenfile; |
| my $openfile = 0; |
| my $fopens = 0; |
| |
| my %addrinfo; |
| my %addrinfofile; |
| my $addrinfos = 0; |
| |
| my $source; |
| my $linenum; |
| my $function; |
| |
| my $lnum = 0; |
| |
| while(<$fileh>) { |
| chomp $_; |
| my $line = $_; |
| $lnum++; |
| if($line =~ /^BT/) { |
| # back-trace, ignore |
| } |
| elsif($line =~ /^LIMIT ([^ ]*):(\d*) (.*)/) { |
| # new memory limit test prefix |
| my $i = $3; |
| my ($source, $linenum) = ($1, $2); |
| if($trace && ($i =~ /([^ ]*) reached memlimit/)) { |
| push @res, "LIMIT: $1 returned error at $source:$linenum\n"; |
| } |
| } |
| elsif($line =~ /^MEM ([^ ]*):(\d*) (.*)/) { |
| # generic match for the filename+linenumber |
| $source = $1; |
| $linenum = $2; |
| $function = $3; |
| |
| if($function =~ /free\((\(nil\)|0x([0-9a-f]*))/) { |
| $addr = $2; |
| if($1 eq "(nil)") { |
| ; # do nothing when free(NULL) |
| } |
| elsif(!exists $sizeataddr{$addr}) { |
| push @res, "FREE ERROR: No memory allocated: $line\n"; |
| } |
| elsif(-1 == $sizeataddr{$addr}) { |
| push @res, "FREE ERROR: Memory freed twice: $line\n"; |
| push @res, "FREE ERROR: Previously freed at: $getmem{$addr}\n"; |
| } |
| else { |
| $totalmem -= $sizeataddr{$addr}; |
| if($trace) { |
| push @res, "FREE: malloc at $getmem{$addr} is freed again at $source:$linenum\n"; |
| push @res, "FREE: $sizeataddr{$addr} bytes freed, left allocated: $totalmem bytes\n"; |
| } |
| |
| newtotal($totalmem); |
| $frees++; |
| |
| $sizeataddr{$addr}=-1; # set -1 to mark as freed |
| $getmem{$addr}="$source:$linenum"; |
| } |
| } |
| elsif($function =~ /malloc\((\d*)\) = 0x([0-9a-f]*)/) { |
| $size = $1; |
| $addr = $2; |
| |
| if($sizeataddr{$addr} && $sizeataddr{$addr}>0) { |
| # this means weeeeeirdo |
| push @res, "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n"; |
| push @res, "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n"; |
| } |
| |
| $sizeataddr{$addr} = $size; |
| $totalmem += $size; |
| $memsum += $size; |
| |
| if($trace) { |
| push @res, "MALLOC: malloc($size) at $source:$linenum makes totally $totalmem bytes\n"; |
| } |
| |
| newtotal($totalmem); |
| $mallocs++; |
| |
| $getmem{$addr}="$source:$linenum"; |
| } |
| elsif($function =~ /calloc\((\d*),(\d*)\) = 0x([0-9a-f]*)/) { |
| $size = $1 * $2; |
| $addr = $3; |
| |
| my $arg1 = $1; |
| my $arg2 = $2; |
| |
| if($sizeataddr{$addr} && $sizeataddr{$addr}>0) { |
| # this means weeeeeirdo |
| push @res, "Mixed debug compile ($source:$linenum at line $lnum), rebuild curl now\n"; |
| push @res, "We think $sizeataddr{$addr} bytes are already allocated at that memory address: $addr!\n"; |
| } |
| |
| $sizeataddr{$addr} = $size; |
| $totalmem += $size; |
| $memsum += $size; |
| |
| if($trace) { |
| push @res, "CALLOC: calloc($arg1,$arg2) at $source:$linenum makes totally $totalmem bytes\n"; |
| } |
| |
| newtotal($totalmem); |
| $callocs++; |
| |
| $getmem{$addr}="$source:$linenum"; |
| } |
| elsif($function =~ /realloc\((\(nil\)|0x([0-9a-f]*)), (\d*)\) = 0x([0-9a-f]*)/) { |
| my ($oldaddr, $newsize, $newaddr) = ($2, $3, $4); |
| my $oldsize = '-'; |
| |
| if($oldaddr) { |
| $oldsize = $sizeataddr{$oldaddr} ? $sizeataddr{$oldaddr} : 0; |
| |
| $totalmem -= $oldsize; |
| if($trace) { |
| } |
| $sizeataddr{$oldaddr} = 0; |
| |
| $getmem{$oldaddr} = ""; |
| } |
| |
| $totalmem += $newsize; |
| $memsum += $newsize; |
| $sizeataddr{$newaddr} = $newsize; |
| |
| if($trace) { |
| push @res, "REALLOC: $oldsize less bytes and $newsize more bytes ($source:$linenum)\n"; |
| } |
| |
| newtotal($totalmem); |
| $reallocs++; |
| |
| $getmem{$newaddr}="$source:$linenum"; |
| } |
| elsif($function =~ /strdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) { |
| # strdup(a5b50) (8) = df7c0 |
| |
| $dup = $1; |
| $size = $2; |
| $addr = $3; |
| $getmem{$addr} = "$source:$linenum"; |
| $sizeataddr{$addr} = $size; |
| |
| $totalmem += $size; |
| $memsum += $size; |
| |
| if($trace) { |
| push @res, "STRDUP: $size bytes at $getmem{$addr}, makes totally: $totalmem bytes\n"; |
| } |
| |
| newtotal($totalmem); |
| $strdups++; |
| } |
| elsif($function =~ /wcsdup\(0x([0-9a-f]*)\) \((\d*)\) = 0x([0-9a-f]*)/) { |
| # wcsdup(a5b50) (8) = df7c0 |
| |
| $dup = $1; |
| $size = $2; |
| $addr = $3; |
| $getmem{$addr}="$source:$linenum"; |
| $sizeataddr{$addr}=$size; |
| |
| $totalmem += $size; |
| $memsum += $size; |
| |
| if($trace) { |
| push @res, "WCSDUP: $size bytes at $getmem{$addr}, makes totally: $totalmem bytes\n"; |
| } |
| |
| newtotal($totalmem); |
| $wcsdups++; |
| } |
| else { |
| push @res, "Not recognized input line: $function\n"; |
| } |
| } |
| # FD url.c:1282 socket() = 5 |
| elsif($_ =~ /^FD ([^ ]*):(\d*) (.*)/) { |
| # generic match for the filename+linenumber |
| $source = $1; |
| $linenum = $2; |
| $function = $3; |
| |
| if($function =~ /socket\(\) = (\d*)/) { |
| $filedes{$1} = 1; |
| $getfile{$1} = "$source:$linenum"; |
| $openfile++; |
| $sockets++; # number of socket() calls |
| } |
| elsif($function =~ /socketpair\(\) = (\d*) (\d*)/) { |
| $filedes{$1} = 1; |
| $getfile{$1} = "$source:$linenum"; |
| $openfile++; |
| $filedes{$2} = 1; |
| $getfile{$2} = "$source:$linenum"; |
| $openfile++; |
| } |
| elsif($function =~ /accept\(\) = (\d*)/) { |
| $filedes{$1} = 1; |
| $getfile{$1} = "$source:$linenum"; |
| $openfile++; |
| } |
| elsif($function =~ /sclose\((\d*)\)/) { |
| if($filedes{$1} != 1) { |
| push @res, "Close without open: $line\n"; |
| } |
| else { |
| $filedes{$1}=0; # closed now |
| $openfile--; |
| } |
| } |
| } |
| # FILE url.c:1282 fopen("blabla") = 0x5ddd |
| elsif($_ =~ /^FILE ([^ ]*):(\d*) (.*)/) { |
| # generic match for the filename+linenumber |
| $source = $1; |
| $linenum = $2; |
| $function = $3; |
| |
| if($function =~ /f[d]*open\(\"(.*)\",\"([^\"]*)\"\) = (\(nil\)|0x([0-9a-f]*))/) { |
| if($3 eq "(nil)") { |
| ; |
| } |
| else { |
| $fopen{$4} = 1; |
| $fopenfile{$4} = "$source:$linenum"; |
| $fopens++; |
| } |
| } |
| # fclose(0x1026c8) |
| elsif($function =~ /fclose\(0x([0-9a-f]*)\)/) { |
| if(!$fopen{$1}) { |
| push @res, "fclose() without fopen(): $line\n"; |
| } |
| else { |
| $fopen{$1} = 0; |
| $fopens--; |
| } |
| } |
| } |
| # GETNAME url.c:1901 getnameinfo() |
| elsif($_ =~ /^GETNAME ([^ ]*):(\d*) (.*)/) { |
| # not much to do |
| } |
| |
| # ADDR url.c:1282 getaddrinfo() = 0x5ddd |
| elsif($_ =~ /^ADDR ([^ ]*):(\d*) (.*)/) { |
| # generic match for the filename+linenumber |
| $source = $1; |
| $linenum = $2; |
| $function = $3; |
| |
| if($function =~ /getaddrinfo\(\) = (\(nil\)|0x([0-9a-f]*))/) { |
| my $add = $1; |
| if($add eq "(nil)") { |
| ; |
| } |
| else { |
| $addrinfo{$add} = 1; |
| $addrinfofile{$add} = "$source:$linenum"; |
| $addrinfos++; |
| } |
| if($trace) { |
| push @res, "GETADDRINFO ($source:$linenum)\n"; |
| } |
| } |
| # fclose(0x1026c8) |
| elsif($function =~ /freeaddrinfo\((0x[0-9a-f]*)\)/) { |
| my $addr = $1; |
| if(!$addrinfo{$addr}) { |
| push @res, "freeaddrinfo() without getaddrinfo(): $line\n"; |
| } |
| else { |
| $addrinfo{$addr} = 0; |
| $addrinfos--; |
| } |
| if($trace) { |
| push @res, "FREEADDRINFO ($source:$linenum)\n"; |
| } |
| } |
| } |
| else { |
| push @res, "Not recognized prefix line: $line\n"; |
| } |
| } |
| close($fileh); |
| |
| if($totalmem) { |
| push @res, "Leak detected: memory still allocated: $totalmem bytes\n"; |
| |
| for(keys %sizeataddr) { |
| $addr = $_; |
| $size = $sizeataddr{$addr}; |
| if($size > 0) { |
| push @res, "At $addr, there is $size bytes.\n"; |
| push @res, " allocated by $getmem{$addr}\n"; |
| } |
| } |
| } |
| |
| if($openfile) { |
| for(keys %filedes) { |
| if($filedes{$_} == 1) { |
| push @res, "Open file descriptor created at $getfile{$_}.\n"; |
| } |
| } |
| } |
| |
| if($fopens) { |
| push @res, "Open FILE handles left at:\n"; |
| for(keys %fopen) { |
| if($fopen{$_} == 1) { |
| push @res, "fopen() called at $fopenfile{$_}.\n"; |
| } |
| } |
| } |
| |
| if($addrinfos) { |
| push @res, "IPv6-style name resolve data left at:\n"; |
| for(keys %addrinfofile) { |
| if($addrinfo{$_} == 1) { |
| push @res, "getaddrinfo() called at $addrinfofile{$_}.\n"; |
| } |
| } |
| } |
| |
| if($verbose) { |
| push @res, |
| "Mallocs: $mallocs\n", |
| "Reallocs: $reallocs\n", |
| "Callocs: $callocs\n", |
| "Strdups: $strdups\n", |
| "Wcsdups: $wcsdups\n", |
| "Frees: $frees\n", |
| "Sockets: $sockets\n", |
| "Allocations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups)."\n", |
| "Operations: ".($mallocs + $callocs + $reallocs + $strdups + $wcsdups + $sockets)."\n", |
| "Maximum allocated: $maxmem\n", |
| "Total allocated: $memsum\n"; |
| } |
| |
| return @res; |
| } |
| |
| 1; |
