traceback-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/

# severely hacked up by bryan k. ogawa <[e-mail]>

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 : "traceback.out";
open (LEAKS, $LeaksFile) or die "Could not open leaks data file $LeaksFile: $!";

&start_gdb();

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

$n = $u = 0;

$start_collect = 0;

while (<LEAKS>) {

    # file format is this:

    # ptr>
    #   sptr: traceback.....
    #   sptr: traceback.....

    chomp;
#    if(/^0x[0-9a-f]*\>/) {
	$start_collect = 1;
 #   }
    
    if($start_collect && s/^  0x[0-9a-f]*: //) {
	# this is an address line -- cache and go!
	$count_hash{$_}++;
    }
}

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

close (LEAKS);

foreach $traceback (sort keys %count_hash) {
    # for each of these, dump it out
    print "Instances: $count_hash{$traceback}\n";

    @a = split(/ /, $traceback);
    # kill the first 4, because they're all the same
    splice(@a, 0, 4);
    foreach(@a) {
	print &get_address($_), "\n";
    }
}

&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);
}

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";
	    $name_array{$y} = "$y: $j";
	}
    }
    return $name_array{$address};
}

__END__

if(!$opt_l) {

    foreach (sort keys %Size) {
	$address = $_;
	print Writer "l \*$_\n";
	print "Count: $Count{$_} / Size: $Size{$_}\n";
	
    
	$flag = 0;
	while(!$flag && ($x = <Reader>)) {
	    #	print $x, "\n";
	    if($x =~ /is in/) {
		print $x;
	    }
	    if($x =~ /$address/) {
		#	if($x =~ /\(gdb\)/) {
		$flag = 1;
	    }
	}

#echo \\nAllocations: $Count{$_} / Size: $Size{$_} $Comment{$_}\\n\nl \*0x$_\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";
	}
	
	#    print $addr;
	#    $addr = $3;
	
	
	
    }
}