#!/usr/bin/perl
# **********************************************************
# Copyright (c) 2005-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.
## bugtitle.pl
## by Derek Bruening
## March 2005
##
## produces a bug title from a forensic file
## uses address_query.pl and wld.pl as helpers
##
## by default does an explicit glob if input filename as a * in it
## (since we have users in shells and perls that don't glob!)
## -noglob disables that; -glob causes explicit glob of all input filenames
##
## if updated copy to \\10.1.5.11\QA-Shares\QA\tools
###########################################################################
## Examples of type of output:
##
## > bugtitle.pl bug_4106_dllhost/dllhost.exe.2964.00000000.html
## CRASH 7100d818 (21113 dllhost.exe) place_fragment:fcache.c(1476)
##
## > bugtitle.pl bug_3749_connon/CanoScan_N650U_N656U_CSUv571a.exe.3424.00000000.html
## VIOLATION NZHB.5166.B (21131 CanoScan_N650U_N656U_CSUv571a.exe) symcjit.dll ---> HEAP section
##
## > bugtitle.pl SmaService.exe.2104.00000000.xml
## VIOLATION NGSU.4493.B (30216 SmaService.exe) 0x7c2e4e8d (ADVAPI32.dll .text rx) => 0x0017b356 (heap rw)
##
## > bugtitle.pl codemod.exe.1416.00000000.xml
## VIOLATION QXMA.5800.A (custom codemod.exe) 0x004013ee (codemod.exe .text rx) => 0x0012ff60 (stack rw)
##
## > bugtitle.pl /work/studies/dgc/detectmode-nonativeexec/dotnet-serialization.exe/serialization.exe.136.00000172.xml
## VIOLATION QKNR.0769.C (custom serialization.exe) 0x791d721e (mscorwks.dll .text rx) => 0x7999cb28 (NULL|mscorlib.dll .text rx)
##
## > bugtitle.pl bug_4243_deadlock/inetinfo.exe.2020.00000000.html
## TIMEOUT (21129 inetinfo.exe)
##
## > bugtitle.pl sqlservr.exe.3048.00000000.xml
## OUT OF MEMORY (30118 sqlservr.exe) MB: 2047 RAM, 8 avail, 2169(^2215)/3940 commit
##
## > bugtitle.pl bug_3749_connon/build_21132/CanoScan_N650U_N656U_CSUv571a.exe.4064.00000000.html
## ASSERT (21132 CanoScan_N650U_N656U_CSUv571a.exe) win32/os.c:3263 is_native_thread_state_valid(trec->dcontext, (app_pc)cxt->Eip, (byte *)cxt->Esp)
##
###########################################################################
## Examples showing that type of slash doesn't matter (though backslashes
## must be doubled within cygwin):
##
## > bugtitle.pl \\\\10.1.5.10\\bugs\\bug_3978_w3wpcrash\\w3wp.exe.1124.00000000.html
## CRASH 7001588e (21102 w3wp.exe) vm_area_add_fragment:vmareas.c(4466)
##
## > bugtitle.pl //10.1.5.10/bugs/bug_3978_w3wpcrash/w3wp.exe.1124.00000000.html
## CRASH 7001588e (21102 w3wp.exe) vm_area_add_fragment:vmareas.c(4466)
##
###########################################################################
## Examples from cmd shell:
##
## C:\derek\dr\tools>perl bugtitle.pl \\10.1.5.10\bugs\bug_3978_w3wpcrash\w3wp.exe.1124.00000000.html
## CRASH 7001588e (21102 w3wp.exe) vm_area_add_fragment:vmareas.c(4466)
##
## c:\>perl c:/derek/dr/tools/bugtitle.pl \\10.1.5.10\bugs\bug_3749_connon\CanoScan_N650U_N656U_CSUv571a.exe.3424.00000000.html
## VIOLATION NZHB.5166.B (21131 CanoScan_N650U_N656U_CSUv571a.exe) symcjit.dll ---> HEAP section
###########################################################################
$tools = $ENV{'DYNAMORIO_TOOLS'};
if ($tools eq "") {
# use same dir this script sits in
$tools = $0;
if ($tools =~ /[\\\/]/) {
$tools =~ s/^(.+)[\\\/][\w\.]+$/\1/;
$tools =~ s/\\/\\\\/g;
} else {
$tools = "./";
}
# address_query needs DYNAMORIO_TOOLS set to find DRload.exe
$ENV{'DYNAMORIO_TOOLS'} = $tools;
}
# may not be on cygwin, so explicitly invoke perl
$addrquery = "perl $tools/address_query.pl";
$vioquery = "perl $tools/wld/wld.pl -security_violation";
# parameters
$usage = "Usage: $0 [-b <build_dir_base>] [-d <path-to-dynamorio.dll>] [-v] [-a] [-q] [-glob] [-noglob] <forensic_file>\n";
$verbose = 0;
$quiet = 0;
$DRdll = "";
$builddir = "";
$globall = 0;
$noglob = 0;
$analyze = 0;
while ($#ARGV >= 0) {
if ($ARGV[0] eq '-v') {
$verbose = 1;
} elsif ($ARGV[0] eq '-q') {
$quiet = 1;
} elsif ($ARGV[0] eq '-a') {
$analyze = 1;
} elsif ($ARGV[0] eq '-glob') {
$globall = 1;
} elsif ($ARGV[0] eq '-noglob') {
$noglob = 1;
} elsif ($ARGV[0] eq '-b') {
die $usage if ($#ARGV <= 0);
shift;
$builddir = $ARGV[0];
$builddir =~ s|\\|/|g; # normalize
unless (-d "$builddir") {
die "$err No directory $builddir\n";
}
} elsif ($ARGV[0] eq '-d') {
die $usage if ($#ARGV <= 0);
shift;
$DRdll = $ARGV[0];
$DRdll =~ s|\\|/|g; # normalize
unless (-f "$DRdll") {
die "$err No file $DRdll\n";
}
} elsif ($ARGV[0] =~ /^-/) {
die $usage;
} else {
# rest should be forensic file names
last;
}
shift;
}
die $usage if ($#ARGV < 0);
$multiple = ($#ARGV > 0);
while ($#ARGV >= 0) {
my $filearg = $ARGV[0];
# make it easy for users w/ non-globbing shell and non-globbing perl to
# pass *, w/o double-globbing and messing up escaped chars for other users
if (!$noglob && ($globall || $filearg =~ /\*/)) {
# FIXME: must convert from \ to / BEFORE the glob -- yet don't
# want to ruin escaped chars! It's a tradeoff: is \* a directory delimiter
# followed by metachar *, or is it an escaped * trying to be literal?
# In everyday usage we assume no escaped *'s!
# If we didn't care for \* directory delim we might do:
# $filearg =~ s|\\\\|//|g; # next rule won't get both slashes so need this rule
# $filearg =~ s|\\([\w\d])|/\1|g; # \ to / only if before a normal char
$filearg =~ s|\\|/|g; # assume \ is dir delim, no support for \ as escape char
@files = glob($filearg);
print "globbing: \"$filearg\" => \"@files\"\n" if ($verbose);
if ($#files < 0) {
# if glob comes up empty, don't use its results (to get error msg)
@files = ($filearg);
}
} else {
@files = ($filearg);
}
$multiple = $multiple || $#files > 0;
foreach $file (@files) {
print "processing \"$file\"\n" if ($verbose);
$file =~ s|\\|/|g; # normalize
unless (-f "$file") {
die "Error: No forensic file $file\n";
}
if ($multiple) {
print "\n$file:\n";
}
process_file($file);
}
shift;
}
sub process_file($) {
my ($file) = @_;
my $prefix = "<unknown type>";
my $suffix = ""; # ok to be empty
my $build_num = "<unknown build>";
my $app = "<unknown app>";
open(IN, "< $file") || die "Error: couldn't open $file\n";
while (<IN>) {
# Handle CR
s/\r//;
# Type of bug
if (/^Execution security violation/) {
$prefix = "VIOLATION";
if ($file =~ /\.html/) {
# use wld for html files
$vioinfo = `$vioquery $file`;
# example: Security violation detected from symcjit.dll ---> HEAP section
$vioinfo =~ /Security violation detected from (.+)/m;
$suffix = $1;
# wld.pl likes to put extra spaces in!
$suffix =~ s/(\s)\s+/\1/g;
$suffix =~ s/^\s+//;
} # else we hit the source and target-properties below
}
elsif (/Threat ID:\s*([^\s\<]+)/) {
$threat = $1;
$prefix .= " $threat";
if ($threat =~ /c0000017/) {
$prefix .= " V";
}
elsif ($threat =~ /c0000012d/) {
$prefix .= " P";
}
}
elsif (/<dll\s+range=\"0x(\w+)-0x(\w+)\"\s*name=\"([^\"]+)\"/) {
$dll_name[$num_dlls] = $3;
$dll_start[$num_dlls] = hex($1);
$dll_end[$num_dlls] = hex($2);
$num_dlls++;
}
elsif (/<source-properties/) {
# for hot patch violations, source isn't relevant; see case 7686
if (!($threat =~ /[PH]$/)) {
$suffix = &address_properties();
}
}
elsif (/<target-properties/) {
# for hot patch violations, target isn't relevant; see case 7686
if (!($threat =~ /[PH]$/)) {
$suffix .= " => " . &address_properties();
}
}
elsif (/^Unrecoverable error at PC 0x([0-9A-Za-z]+)/) {
# w/ multiple files, need local here so we look at each
# crash separately
my $symdll;
$addr = $1;
if ($addr =~ /^15/) {
$lib = "debug";
} else {
$lib = "release";
}
if ($DRdll eq "") {
$symdll = &findDRdll($builddir, $build_num, $lib);
} else {
# if dr dll passed to us, use it for every file
$symdll = $DRdll;
}
$prefix = "CRASH $addr";
$suffix = "[error acquiring line number]";
if ($symdll ne "") {
my $query = "$addrquery";
$query .= " -raw" if ($verbose);
print "invoking \"$query $symdll $addr\"\n" if ($verbose);
$sym = `$query $symdll $addr`;
print "addrquery returned: $sym\n" if ($verbose);
if ($sym =~ m|([\w\./]+\(\d+\))|m) {
$line = $1;
$sym =~ /dynamorio!(.+)\+/m;
$func = $1;
$suffix = "$func:$line";
} else {
print "Unable to find address in $symdll\n";
# We found the dll, but couldn't find the address.
# Is likely an exception in generated code.
$suffix = "<exception in generated code>";
}
} else {
print "Error locating dynamorio.dll $build_num\n";
}
}
elsif (/^Internal SecureCore Error: (.*)/) {
$prefix = "ASSERT";
$suffix = $1;
}
elsif (/^CURIOSITY : (.*)/) {
$prefix = "CURIOSITY";
$suffix = $1;
}
elsif (/^Timeout expired/) {
$prefix = "TIMEOUT";
}
elsif (/^Out of memory/) {
$prefix = "OUT OF MEMORY";
}
elsif (($analyze || $prefix =~ /MEMORY/) && /<basic-information>/) {
$_ = <IN>;
/\d+ \d+ \d+ (\d+) \d+ \d+ \d+/;
$ram = $1 * 4/1024;
$suffix .= sprintf("%u RAM, ", $ram);
}
elsif (($analyze || $prefix =~ /MEMORY/) && /num_threads:/) {
/num_threads: (\d+)/;
$ThreadCount = $1;
$suffix .= sprintf(", %d Thr", $ThreadCount);
if ($ThreadCount > 1000) {
$suffix .= "ead PILE!";
}
}
elsif (($analyze || $prefix =~ /MEMORY/) && /<vm-counters>/) {
$_ = <IN>;
($PeakVirtualSize,
$VirtualSize,
$PageFaultCount,
$PeakWorkingSetSize,
$WorkingSetSize,
$QuotaPeakPagedPoolUsage,
$QuotaPagedPoolUsage)
= split / /, $_;
$_ = <IN>;
($QuotaPeakNonPagedPoolUsage,
$QuotaNonPagedPoolUsage,
$PagefileUsage,
$PeakPagefileUsage)
= split / /, $_;
# matching drview names (e.g. PagefileUsage is Priv) */
print "KB: " .
$PeakVirtualSize/1024 . " PVSz," .
$VirtualSize/1024 . " VSz," .
$PeakPagefileUsage/1024 . " PPriv," .
$PagefileUsage/1024 . " Priv," .
$PeakWorkingSetSize/1024 . " PWSS," .
$WorkingSetSize/1024 . " WSS," .
$PageFaultCount/1 . " Fault," .
$QuotaPeakPagedPoolUsage/1024 . " PPage," .
$QuotaPagedPoolUsage/1024 . " Page," .
$QuotaPeakNonPagedPoolUsage/1024 . " PNonP," .
$QuotaNonPagedPoolUsage/1024 . " NonP" .
"\n" if ($verbose);
# note that pre 4.3 core writes these counters as %d (case 10481)
# whlie we want to convert them to uint's here
if ($VirtualSize < 0) {
$VirtualSize += 0x100000000; # 2^32
}
if ($PagefileUsage < 0) {
$PagefileUsage += 0x100000000; # 2^32
}
if ($PeakWorkingSetSize < 0) {
$PeakWorkingSetSize += 0x100000000; # 2^32
}
# all in MB
$suffix .= sprintf("MB: %u VSz, %u Priv, %u PWSS; ",
$VirtualSize/1024/1024,
$PagefileUsage/1024/1024,
$PeakWorkingSetSize/1024/1024);
}
elsif (($analyze || $prefix =~ /MEMORY/) && /<performance-information>/) {
# skip 1st line
<IN>;
# this line has what we want
$_ = <IN>;
/-?\d+ -?\d+ -?\d+ (\d+) (\d+) (\d+) (\d+)/;
# don't expect these to be negative
$avail = $1 * 4/1024;
$commit = $2 * 4/1024;
$limit = $3 * 4/1024;
$peak = $4 * 4/1024;
$suffix .= sprintf("%u avail, %u(^%u)/%u commit",
$avail, $commit, $peak, $limit);
}
# Build version
elsif (/^Generated by SecureCore [^,]+,\s*(.+)/) {
$build_string = $1;
if ($build_string =~ /build ([0-9]+)/) {
$build_num = $1;
} else {
# FIXME: grab path from reg keys and try that path on local host?
$build_num = "custom";
}
}
# Process Name
#
# violation
elsif (/^Short[\s\-]Qualified[\s\-]Name[:=]\s*\"?([^\"\n]+)\"?/i) {
$app = $1; # short qualified name
}
# crash
elsif (/^\s*Name\s?=\s*\"?([^\"\n]+)\"?/i) {
$app = $1; # full qualified name
$app =~ s/.*[\\\/]//; # remove path
}
# 2.1 compatibility, let better name finding (above) override since we make
# assumptions (that may not always hold) about name mangling here
elsif ($app =~ /^<unknown app>$/) {
if (/^Command Line:\s*(.+)/) {
$app = $1; # full cmdline
if ($app !~ /svchost.exe/) {
# remove args
$app =~ s/(\.exe)\W+.*$/\1/;
# remove quotes
$app =~ s/\"//g;
}
$app =~ s/.*[\\\/]//; # remove path
}
}
}
close(IN);
print "$prefix ($build_num $app) $suffix\n";
}
sub findDRdll($,$,$) {
my ($builddir, $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 ($builddir ne "") {
unshift @try, $builddir;
}
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;
}
# examples:
# 0x04932af4 (stack rx)
# 0x003b2f76 (heap rw)
# 0x79b99773 (NULL|mscorlib.dll .data rwx)"
sub address_properties() {
my $address = "";
my $module = "";
my $section = "";
my $protect = "";
my $type = "";
while (<IN>) {
# Handle CR
s/\r//;
if (/address=.*\"([^\"]+)\"/) {
$address = $1;
} elsif (/module=.*\"([^\"]+)\"/) {
$module = $1;
} elsif (/sec_name=.*\"([^\"]+)\"/) {
$section = $1;
} elsif (/State=.* FREE/) {
$protect = 'free';
} elsif ($protect ne 'free' && /Protect=.*\"\w+ ([^\"]+)\"/) {
$protect = $1;
$protect =~ s/-//g;
} elsif (/Type=.*\"\w+ ([^\"]+)\"/) {
$type = $1;
if ($type =~ /IMAGE/i) {
# if no export name get file name from module list
if ($module =~ /\(none\)/) {
# brute force
# FIXME: use nice interval data structure
$address =~ /0x(\w+)/;
my $addrval = hex($1);
for ($i=0; $i<$num_dlls; $i++) {
if ($addrval >= $dll_start[$i] &&
$addrval < $dll_end[$i]) {
$module = "NULL|" . $dll_name[$i];
}
}
}
$module .= " $section";
} else {
if ($threat =~ /\.A$/) {
$module = "stack";
} else {
$module = "heap";
}
}
# we assume we'll see a Type line else we'll loop to the end!
last;
}
}
return "$address ($module $protect)";
}