tools/bugcrash.pl - external/dynamorio - Git at Google

 #!/usr/bin/perl

 # **********************************************************
 # Copyright (c) 2007 VMware, Inc.  All rights reserved.
 # **********************************************************

 # Redistribution and use in source and binary forms, with or without
 # modification, are permitted provided that the following conditions are met:
 #
 # * Redistributions of source code must retain the above copyright notice,
 #   this list of conditions and the following disclaimer.
 #
 # * Redistributions in binary form must reproduce the above copyright notice,
 #   this list of conditions and the following disclaimer in the documentation
 #   and/or other materials provided with the distribution.
 #
 # * Neither the name of VMware, Inc. nor the names of its contributors may be
 #   used to endorse or promote products derived from this software without
 #   specific prior written permission.
 #
 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 # ARE DISCLAIMED. IN NO EVENT SHALL VMWARE, INC. OR CONTRIBUTORS BE LIABLE
 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 # DAMAGE.

 ##
 ## FILE: bugcrash.pl:
 ##
 ## Author: Sam Larsen
 ## Date: Thu Mar 22 19:07:51 2007
 ##
 ## Reads a forensics file and:
 ## - Launches windbg with DRload using the correct base address
 ## - Fills in the DR stack and dcontext dumps from the forensics
 ## - Locates the CONTEXT in the stack dump and sets it
 ##
 ## Preferred usage is just to supply a forensics file, and the script
 ## will try to find windbg and the proper dynamorio.dll from the
 ## nightlies.  However, you can explicitly specify these locations
 ## with the options below.
 ##

 $usage = "Usage: $0 [-v] [-g <debuggerpath>] [-b <build_dir_base>] [-d DRdllpath] <forensic file>\n";

 ##
 ## Get options
 ##
 use Getopt::Long;
 @optl = ("v", "d=s", "b=s", "p=s", "g=s");
 if (!(GetOptions @optl) || $#ARGV != 0) {
     die $usage;
 }

 $verbose = $opt_v;
 $build_dir = $opt_b ? $opt_b : "";
 $forensics = $ARGV[0];


 ##
 ## Locate debugger executable
 ##
 if (!$opt_g) {
     # try to find installation of debugging tools for windows
     $progroot = &win32path2unix($ENV{'PROGRAMFILES'});
     @debugtools = glob("$progroot/Debug*/windbg.exe");
     $debugger = $debugtools[0];
 } else {
     if (-d $opt_g) {
         $debugger = "$opt_g/windbg.exe";
     } else {
         $debugger = $opt_g;
     }
 }

 # -x seems to require o+x so we don't check
 die "ERROR: can't find debugger $debugger\n" if (!-f "$debugger");
 printf "Using debugger at $debugger\n" if ($verbose);


 ##
 ## Locate DRload
 ##
 $DRtools = $ENV{'DYNAMORIO_TOOLS'};
 if ($DRtools eq "") {
     # try same dir this script sits in
     $DRtools = $0;
     if ($DRtools =~ /[\\\/]/) {
         $DRtools =~ s/^(.+)[\\\/][\w\.]+$/\1/;
     } else {
         $DRtools = "./";
     }
 }
 $DRload = "$DRtools/DRload.exe";
 # need win32 path with double backslashes
 # e.g., c:\\\\derek\\\\dr\\\\tools\\\\DRload.exe
 $DRload = &unixpath2win32($DRload);
 die "ERROR: can't find DRload.exe" if (!-f "$DRload");


 ##
 ## Create a script file
 ##
 $tmpdir = $ENV{'TMPDIR'} || $ENV{'TEMP'} || $ENV{'TMP'} || '/tmp';
 die "Cannot find temp directory $tmpdir" if (! -d $tmpdir);
 $script = "$tmpdir/bugcrash-$$.script";
 $winscript = &unixpath2win32($script);
 printf "script file is $script\n" if ($verbose);
 open (OUT, "> $script") || die "ERROR: couldn't open $script";


 ##
 ## Parse forensics file
 ##
 open (IN, "$forensics") ||
     die "ERROR: can't open forensics file $forensics\n";

 $build_num = "";
 $dr_base = "";
 $lib = "";

 $context = "";
 $esp = "";

 while (<IN>) {
     if (!$opt_d && /^Generated by SecureCore [^,]+,\s*(.+)/) {
         my $build_string = $1;
         if ($build_string =~ /build ([0-9]+)/) {
             $build_num = $1;
         } else {
             die "ERROR parsing dynamorio build number\n";
         }
     }
     elsif (!$opt_d && /^Unrecoverable error at PC 0x([0-9A-Za-z]+)/) {
         my $addr = $1;
         if ($addr =~ /^15/) {
             $lib = "debug";
         } elsif ($addr =~ /^71/) {
             $lib = "release";
         } else {
             die "ERROR: can't guess build from PC 0x$addr\n";
         }
     }
     elsif ($_ =~ /^dynamorio\.dll=(0x[0-9a-f]{8})/) {
         die "ERROR locating dynamorio.dll base\n" if ($dr_base ne "");
         $dr_base = $1;
     }
     elsif ($_ =~ /ebp=0x[0-9a-f]{8} esp=(0x[0-9a-f]{8})/) {
         die "ERROR locating esp\n" if ($esp ne "");
         $esp = $1;
     }
     elsif ($_ =~ /^DR Stack: 0x([0-9a-f]{8})/) {
         my $addr = hex($1);
         my $base = $addr;

         printf "DR stack is at 0x%x\n", $base;
         printf OUT ".dvalloc /b 0x%x 0x1000\n", $base;

         while (<IN>) {
             my @bits = split(' ', $_);
             if ($bits[0] =~ /^([0-9a-f]{8})$/) {
                 die "ERROR reading DR stack\n", if (hex($bits[0]) != $addr);
                 for (my $i=1; $i <= $#bits; $i++) {
                     die "ERROR reading DR stack\n" if ($bits[$i] !~ /^[0-9a-f]{8}$/);
                     printf OUT "ed 0x%08x 0x%08x\n", $addr, hex($bits[$i]);

                     # look for the context
                     if ($bits[$i] eq "0001003f") {
                         die "ERROR: found > 1 instances of 0x0001003f on the stack. " .
                             "Can't decipher the context\n" if ($context ne "");
                         $context = $addr;
                     }
                     $addr += 4;
                 }
             }
             else {
                 my $size = $addr - $base;
                 die "ERROR: DR stack is $size bytes; expecting 0x1000\n"
                     if ($size != 0x1000);
                 last;
             }
         }
     }
     elsif ($_ =~ /^current dcontext: 0x([0-9a-f]{8})/) {
         my $addr = hex($1);
         my $base = $addr;

         # The size of the dcontext could vary with the build, so
         # read it first and then output the .dvalloc command
         my $dcontext = "";
         while (<IN>) {
             my @bits = split(' ', $_);
             if ($#bits == 0 && $bits[0] eq "<![CDATA[") {
                 next;
             }
             elsif ($bits[0] =~ /^([0-9a-f]{8})$/) {
                 die "ERROR reading dcontext\n", if (hex($bits[0]) != $addr);
                 for (my $i=1; $i <= $#bits; $i++) {
                     die "ERROR reading dcontext\n" if ($bits[$i] !~ /^[0-9a-f]{8}$/);
                     $dcontext .= sprintf("ed 0x%08x 0x%08x\n", $addr, hex($bits[$i]));
                     $addr += 4;
                 }
             }
             else {
                 my $size = $addr - $base;
                 printf "dcontext is %d bytes at 0x%x\n", $size, $base;
                 printf OUT ".dvalloc /b 0x%x 0x%x\n", $base, $size;
                 printf OUT $dcontext;
                 last;
             }
         }
     }
     elsif ($_ =~ /^\<hotpatching\-information\>/) {
         last;
     }
 }
 die "ERROR: didn't find dynamorio base\n" if ($dr_base eq "");
 die "ERROR: didn't find context\n" if ($context eq "");
 die "ERROR: didn't find esp\n" if ($esp eq "");
 close (IN);


 ##
 ## Fill in context
 ##
 printf OUT "r esp=$esp\n";
 printf OUT ".cxr 0x%08x\n", $context;


 ##
 ## Create a debugger log file
 ##
 $logfile = "$tmpdir/bugcrash-$$.log";
 # start fresh -- no stale results
 system("rm -f $logfile") if (-e $logfile);
 printf "Log file is $logfile\n";
 $win32logfile = &unixpath2win32($logfile);
 printf OUT ".logopen $win32logfile\n";

 close (OUT);


 ##
 ## Locate dynamorio.dll
 ##
 if ($opt_d) {
     $DRdll = $opt_d;
 } else {
     $DRdll = &findDRdll($build_dir, $build_num, $lib);
 }
 die "ERROR: can't find dynamorio.dll\n" if (!-e "$DRdll");
 $DRdllwin32 = &unixpath2win32($DRdll);


 ##
 ## Run the debugger
 ##
 $cmd = "\$><$winscript";
 $cmdline = "\"$debugger\" -g -c \"$cmd\" $DRload -base $dr_base -debugbreak $DRdllwin32";
 printf "$cmdline\n" if ($verbose);
 system("$cmdline") && die "ERROR: couldn't run $cmdline\n";


 sub findDRdll($,$,$) {
     my ($build_dir, $build_num, $lib) = @_;
     # would be nice to use symbol server, but cannot locate
     # based solely on build number w/o querying every dll, or having
     # a symlink set up externally or something.
     my @try = ( "//10.1.5.15/nightly",
                 "//10.1.5.15/nightly_archive" );
     if ($build_dir ne "") {
         unshift @try, $build_dir;
     }
     print "searching these bases: @try\n" if ($verbose);
     # match ver_2_1, ver_2_5, etc., as well as the new dist
     # we avoid {ver*,dist} since that gives two entries regardless of existence
     my $ver = "[vd][ei][rs]*";
     my $missed_at_all = 0;
     foreach $base (@try) {
         my $glob_path = "$base/$build_num/$ver/lib/$lib/dynamorio.dll";
         my @wildcard = glob($glob_path);
         if (@wildcard == 0) {
             print STDERR "couldn't find $glob_path\n" if (!$quiet);
             $missed_at_all = 1;
         }
         foreach $w (@wildcard) {
             print "looking for $w\n" if ($verbose);
             if (-f $w) {
                 # avoid found message if did it 1st try
                 print STDERR "found $w\n" if (!$quiet && $missed_at_all);
                 return $w;
             }
             print STDERR "couldn't find $w\n" if (!$quiet);
             $missed_at_all = 1;
         }
     }
     return "";
 }


 sub unixpath2win32($) {
     my ($p) = @_;
     # use cygpath if available, it will convert /home to c:\cygwin\home, etc.
     $cp = `cygpath -wi \"$p\"`;
     chomp $cp;
     if ($cp eq "") {
         # do it by hand
         # add support for /x => x:
         $p =~ s|^/([a-z])/|\1:/|;
         # forward slash becomes backslash since going through another shell
         $p =~ s|/|\\|g;
     } else {
         $p = $cp;
     }
     # make single backslashes doubles
     $p =~ s|\\{1}|\\\\|g;
     return $p;
 }


 sub win32path2unix($) {
     my ($p) = @_;
     # avoid issues with spaces by using 8.3 names
     $cp = `cygpath -dmi \"$p\"`;
     chomp $cp;
     if ($cp eq "") {
         # do it by hand
         $p =~ s|\\|/|g;
     } else {
         $p = $cp;
     }
     return $p;
 }
	#!/usr/bin/perl

	# **********************************************************
	# Copyright (c) 2007 VMware, Inc. All rights reserved.
	# **********************************************************

	# Redistribution and use in source and binary forms, with or without
	# modification, are permitted provided that the following conditions are met:
	#
	# * Redistributions of source code must retain the above copyright notice,
	# this list of conditions and the following disclaimer.
	#
	# * Redistributions in binary form must reproduce the above copyright notice,
	# this list of conditions and the following disclaimer in the documentation
	# and/or other materials provided with the distribution.
	#
	# * Neither the name of VMware, Inc. nor the names of its contributors may be
	# used to endorse or promote products derived from this software without
	# specific prior written permission.
	#
	# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
	# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
	# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
	# ARE DISCLAIMED. IN NO EVENT SHALL VMWARE, INC. OR CONTRIBUTORS BE LIABLE
	# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
	# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
	# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
	# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
	# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
	# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
	# DAMAGE.

	##
	## FILE: bugcrash.pl:
	##
	## Author: Sam Larsen
	## Date: Thu Mar 22 19:07:51 2007
	##
	## Reads a forensics file and:
	## - Launches windbg with DRload using the correct base address
	## - Fills in the DR stack and dcontext dumps from the forensics
	## - Locates the CONTEXT in the stack dump and sets it
	##
	## Preferred usage is just to supply a forensics file, and the script
	## will try to find windbg and the proper dynamorio.dll from the
	## nightlies. However, you can explicitly specify these locations
	## with the options below.
	##

	$usage = "Usage: $0 [-v] [-g <debuggerpath>] [-b <build_dir_base>] [-d DRdllpath] <forensic file>\n";

	##
	## Get options
	##
	use Getopt::Long;
	@optl = ("v", "d=s", "b=s", "p=s", "g=s");
	if (!(GetOptions @optl) \|\| $#ARGV != 0) {
	die $usage;
	}

	$verbose = $opt_v;
	$build_dir = $opt_b ? $opt_b : "";
	$forensics = $ARGV[0];


	##
	## Locate debugger executable
	##
	if (!$opt_g) {
	# try to find installation of debugging tools for windows
	$progroot = &win32path2unix($ENV{'PROGRAMFILES'});
	@debugtools = glob("$progroot/Debug*/windbg.exe");
	$debugger = $debugtools[0];
	} else {
	if (-d $opt_g) {
	$debugger = "$opt_g/windbg.exe";
	} else {
	$debugger = $opt_g;
	}
	}

	# -x seems to require o+x so we don't check
	die "ERROR: can't find debugger $debugger\n" if (!-f "$debugger");
	printf "Using debugger at $debugger\n" if ($verbose);


	##
	## Locate DRload
	##
	$DRtools = $ENV{'DYNAMORIO_TOOLS'};
	if ($DRtools eq "") {
	# try same dir this script sits in
	$DRtools = $0;
	if ($DRtools =~ /[\\\/]/) {
	$DRtools =~ s/^(.+)[\\\/][\w\.]+$/\1/;
	} else {
	$DRtools = "./";
	}
	}
	$DRload = "$DRtools/DRload.exe";
	# need win32 path with double backslashes
	# e.g., c:\\\\derek\\\\dr\\\\tools\\\\DRload.exe
	$DRload = &unixpath2win32($DRload);
	die "ERROR: can't find DRload.exe" if (!-f "$DRload");


	##
	## Create a script file
	##
	$tmpdir = $ENV{'TMPDIR'} \|\| $ENV{'TEMP'} \|\| $ENV{'TMP'} \|\| '/tmp';
	die "Cannot find temp directory $tmpdir" if (! -d $tmpdir);
	$script = "$tmpdir/bugcrash-$$.script";
	$winscript = &unixpath2win32($script);
	printf "script file is $script\n" if ($verbose);
	open (OUT, "> $script") \|\| die "ERROR: couldn't open $script";


	##
	## Parse forensics file
	##
	open (IN, "$forensics") \|\|
	die "ERROR: can't open forensics file $forensics\n";

	$build_num = "";
	$dr_base = "";
	$lib = "";

	$context = "";
	$esp = "";

	while (<IN>) {
	if (!$opt_d && /^Generated by SecureCore [^,]+,\s*(.+)/) {
	my $build_string = $1;
	if ($build_string =~ /build ([0-9]+)/) {
	$build_num = $1;
	} else {
	die "ERROR parsing dynamorio build number\n";
	}
	}
	elsif (!$opt_d && /^Unrecoverable error at PC 0x([0-9A-Za-z]+)/) {
	my $addr = $1;
	if ($addr =~ /^15/) {
	$lib = "debug";
	} elsif ($addr =~ /^71/) {
	$lib = "release";
	} else {
	die "ERROR: can't guess build from PC 0x$addr\n";
	}
	}
	elsif ($_ =~ /^dynamorio\.dll=(0x[0-9a-f]{8})/) {
	die "ERROR locating dynamorio.dll base\n" if ($dr_base ne "");
	$dr_base = $1;
	}
	elsif ($_ =~ /ebp=0x[0-9a-f]{8} esp=(0x[0-9a-f]{8})/) {
	die "ERROR locating esp\n" if ($esp ne "");
	$esp = $1;
	}
	elsif ($_ =~ /^DR Stack: 0x([0-9a-f]{8})/) {
	my $addr = hex($1);
	my $base = $addr;

	printf "DR stack is at 0x%x\n", $base;
	printf OUT ".dvalloc /b 0x%x 0x1000\n", $base;

	while (<IN>) {
	my @bits = split(' ', $_);
	if ($bits[0] =~ /^([0-9a-f]{8})$/) {
	die "ERROR reading DR stack\n", if (hex($bits[0]) != $addr);
	for (my $i=1; $i <= $#bits; $i++) {
	die "ERROR reading DR stack\n" if ($bits[$i] !~ /^[0-9a-f]{8}$/);
	printf OUT "ed 0x%08x 0x%08x\n", $addr, hex($bits[$i]);

	# look for the context
	if ($bits[$i] eq "0001003f") {
	die "ERROR: found > 1 instances of 0x0001003f on the stack. " .
	"Can't decipher the context\n" if ($context ne "");
	$context = $addr;
	}
	$addr += 4;
	}
	}
	else {
	my $size = $addr - $base;
	die "ERROR: DR stack is $size bytes; expecting 0x1000\n"
	if ($size != 0x1000);
	last;
	}
	}
	}
	elsif ($_ =~ /^current dcontext: 0x([0-9a-f]{8})/) {
	my $addr = hex($1);
	my $base = $addr;

	# The size of the dcontext could vary with the build, so
	# read it first and then output the .dvalloc command
	my $dcontext = "";
	while (<IN>) {
	my @bits = split(' ', $_);
	if ($#bits == 0 && $bits[0] eq "<![CDATA[") {
	next;
	}
	elsif ($bits[0] =~ /^([0-9a-f]{8})$/) {
	die "ERROR reading dcontext\n", if (hex($bits[0]) != $addr);
	for (my $i=1; $i <= $#bits; $i++) {
	die "ERROR reading dcontext\n" if ($bits[$i] !~ /^[0-9a-f]{8}$/);
	$dcontext .= sprintf("ed 0x%08x 0x%08x\n", $addr, hex($bits[$i]));
	$addr += 4;
	}
	}
	else {
	my $size = $addr - $base;
	printf "dcontext is %d bytes at 0x%x\n", $size, $base;
	printf OUT ".dvalloc /b 0x%x 0x%x\n", $base, $size;
	printf OUT $dcontext;
	last;
	}
	}
	}
	elsif ($_ =~ /^\<hotpatching\-information\>/) {
	last;
	}
	}
	die "ERROR: didn't find dynamorio base\n" if ($dr_base eq "");
	die "ERROR: didn't find context\n" if ($context eq "");
	die "ERROR: didn't find esp\n" if ($esp eq "");
	close (IN);


	##
	## Fill in context
	##
	printf OUT "r esp=$esp\n";
	printf OUT ".cxr 0x%08x\n", $context;


	##
	## Create a debugger log file
	##
	$logfile = "$tmpdir/bugcrash-$$.log";
	# start fresh -- no stale results
	system("rm -f $logfile") if (-e $logfile);
	printf "Log file is $logfile\n";
	$win32logfile = &unixpath2win32($logfile);
	printf OUT ".logopen $win32logfile\n";

	close (OUT);


	##
	## Locate dynamorio.dll
	##
	if ($opt_d) {
	$DRdll = $opt_d;
	} else {
	$DRdll = &findDRdll($build_dir, $build_num, $lib);
	}
	die "ERROR: can't find dynamorio.dll\n" if (!-e "$DRdll");
	$DRdllwin32 = &unixpath2win32($DRdll);


	##
	## Run the debugger
	##
	$cmd = "\$><$winscript";
	$cmdline = "\"$debugger\" -g -c \"$cmd\" $DRload -base $dr_base -debugbreak $DRdllwin32";
	printf "$cmdline\n" if ($verbose);
	system("$cmdline") && die "ERROR: couldn't run $cmdline\n";


	sub findDRdll($,$,$) {
	my ($build_dir, $build_num, $lib) = @_;
	# would be nice to use symbol server, but cannot locate
	# based solely on build number w/o querying every dll, or having
	# a symlink set up externally or something.
	my @try = ( "//10.1.5.15/nightly",
	"//10.1.5.15/nightly_archive" );
	if ($build_dir ne "") {
	unshift @try, $build_dir;
	}
	print "searching these bases: @try\n" if ($verbose);
	# match ver_2_1, ver_2_5, etc., as well as the new dist
	# we avoid {ver*,dist} since that gives two entries regardless of existence
	my $ver = "[vd][ei][rs]*";
	my $missed_at_all = 0;
	foreach $base (@try) {
	my $glob_path = "$base/$build_num/$ver/lib/$lib/dynamorio.dll";
	my @wildcard = glob($glob_path);
	if (@wildcard == 0) {
	print STDERR "couldn't find $glob_path\n" if (!$quiet);
	$missed_at_all = 1;
	}
	foreach $w (@wildcard) {
	print "looking for $w\n" if ($verbose);
	if (-f $w) {
	# avoid found message if did it 1st try
	print STDERR "found $w\n" if (!$quiet && $missed_at_all);
	return $w;
	}
	print STDERR "couldn't find $w\n" if (!$quiet);
	$missed_at_all = 1;
	}
	}
	return "";
	}


	sub unixpath2win32($) {
	my ($p) = @_;
	# use cygpath if available, it will convert /home to c:\cygwin\home, etc.
	$cp = `cygpath -wi \"$p\"`;
	chomp $cp;
	if ($cp eq "") {
	# do it by hand
	# add support for /x => x:
	$p =~ s\|^/([a-z])/\|\1:/\|;
	# forward slash becomes backslash since going through another shell
	$p =~ s\|/\|\\\|g;
	} else {
	$p = $cp;
	}
	# make single backslashes doubles
	$p =~ s\|\\{1}\|\\\\\|g;
	return $p;
	}


	sub win32path2unix($) {
	my ($p) = @_;
	# avoid issues with spaces by using 8.3 names
	$cp = `cygpath -dmi \"$p\"`;
	chomp $cp;
	if ($cp eq "") {
	# do it by hand
	$p =~ s\|\\\|/\|g;
	} else {
	$p = $cp;
	}
	return $p;
	}