leak-analyze

radius协议源码÷The Radius Stack will connect to a Radius Server. This stack implementation is built upo

#!/usr/bin/perl
# (c) 1999 Erwin S. Andreasen <[e-mail]>
# Homepage: http://www.andreasen.org/LeakTracer/

require "getopts.pl";
use FileHandle;
use IPC::Open2;
use Expect;

&Getopts("l");
die "You must supply at least one argument.\n" unless $#ARGV >= 0;

$ExeFile = shift @ARGV;
$LeaksFile = $#ARGV >= 0 ? shift @ARGV : "leak.out";
open (LEAKS, $LeaksFile) or die "Could not open leaks data file $LeaksFile: $!";

if ($#ARGV >= 0) {
    $BreakOn = shift @ARGV;
    # Rest in @ARGV are program arguments
}

$n = $u = 0;
while (<LEAKS>) {
    if(!/^0/) {
	next;
    }
#    print "a\n";
    chomp;

    push(@lines, $_);

    #       1                2       3          4
#    if (/^\s*(0x)?[0-9a-f]+\s+(0x)?([0-9a-f]+)\s+(\d+)/) {
    @a = split(/\s+/);
    # get the first thing -- this is the alloc'ed address
    $alloc_addr = shift(@a);
    # get the last thing -- this is the number of bytes
    $size = pop(@a);

    # the rest of the data is the call stack -- we need to trace out
    # common call stacks, or something.

    $addr = $a[2];
#    $addr =~ s/^0x//;

    foreach(@a) {
	$addr_array{$_} = 1;
    }

#    print $addr;
#    $addr = $3;

    $u++ if not exists $Size{$addr};
    $Size{$addr} += $size;
    $Count{$addr}++;
    $n++;
}

print STDERR "Gathered $n ($u unique) points of data.\n";

close (LEAKS);

&start_gdb();

if(!$opt_l) {
    foreach (sort keys %Size) {
	print "$Count{$_}/$Size{$_}/", &get_address($_), "\n";
    }
} else {

    foreach(@lines) {
	@a = split(/\s+/);
	$alloc_addr = shift(@a);
	$size = pop(@a);
	
	print "---\n";
	
	shift(@a);
	shift(@a);
	print "Count: $Count{$a[0]}\n";
	print "Size:  $Size{$a[0]}\n";
	
	foreach(reverse (@a)) {
	    print "  ", &get_address($_), "\n";
	}
    }
}


sub get_address {
    local($address) = $_[0];

    if(!$name_array{$address}) {
	$name_array{$address} = "$address: ?";
#	print "Getting $address\n";
	print $process "l \*$address\r";
	($matched_pattern_position, $error,
	 $successfully_matching_string, $before_match, $after_match)
	  = $process->expect(10, "(gdb)");
	$x = $before_match;

#	print ">>> $x\n";

	if($x =~ s/(0x[0-9a-f]*) is in (.*)\n//) {
	    $y = $1;
	    $j = $2;
#	    print "|||| $y: $j\n";
	    $j =~ y/\r//d;
	    $name_array{$y} = "$y: $j";
	}
    }
    return $name_array{$address};
}

&stop_gdb();




sub start_gdb {
    # Change set listsize 2 to something else to show more lines
    $process = Expect->spawn("gdb --nw $ExeFile 2>&1");
    $process->log_stdout(0);

    $process->expect(60, "(gdb)");

    print $process "set listsize 2\r";

    $process->expect(60,"(gdb)");

    print $process "set height 0\r";
    $process->expect(60,"(gdb)");

    if (defined($BreakOn)) {
	print $process "break $BreakOn\n";
	print $process "run ", join(" ", @ARGV), " \n";
    }
}

sub stop_gdb {
    if (defined($BreakOn)) {
	print $process "kill\n";
    }
    
    close ($process);
}