# TSTcore.def: Tests Stack Trace Extraction
# $Id: TSTcore.def,v 1.14 2009/02/06 18:22:54 mschenke Exp $
# ARCS: $Header: /u02/webapps/workbench/cvs/RDA_4/src/scripting/lib/modules/TSTcore.def,v 1.14 2009/02/06 18:22:54 mschenke Exp $
#
# Change History
# 20090206  KRA  Encode file names.

=head1 NAME

TSTcore - Tests Stack Trace Extraction

=head1 DESCRIPTION

This test module extracts the stack trace from a system core dump.

=cut

# Initialisation
var $TOC = '%TOC%'
var $TOP = '[[#Top][Back to top]]'

# Get the core file
if getSetting('TST_ARGS')
 var $dmp = last
elsif getEnv('CORE')
 var $dmp = last
elsif getSetting('CORE')
 var $dmp = last
else
{call requestSetting('TSTcore')
 var $dmp = getSetting('CORE')
}

if !testFile('fr',$dmp)
 die 'Missing or invalid file'

# Try to extract the program name that produced the core
var $pgm = field(cond(match(getOsName(),'aix'),",\s*","'"),1,\
                 command(concat('file ',quote($dmp,'x'))))

# Find a debugger
if match(getOsName(),'solaris|sunos')
 var @loc = ('pstack')
else
 var @loc = ()
var $flg = true
var %opt = ('gdb',' -n -q')
loop $typ (@loc,'gdb','mdb','adb','sdb','dbx')
{if findCommand($typ,true)
 {var $dbg = last
  if testFile('x',$dbg)
  {var $flg = false
   break
  }
 }
}
if $flg
 die 'No debugger found'

# List the environment, what we know so far
call setAbbr('CORE')
report concat('c_',basename($dmp))
write '---+!! Stack Trace Extraction Utility'
write 'Version 1.0%BR%Copyright (c) 2005-2009, Oracle. All rights reserved.%BR%'
write $TOC
write '%BR%'
write '|*Core file*|',$dmp,'|'
write '|*Program*|',$pgm,'|'
write '|*Debugger*|',$dbg,'|'
write $TOP

# Extract information from the core file
if match($dbg,'pstack$')
{# If pstack is available, just call the code and be done with it.
 prefix
  write '---+ pstatck Output'
 call writeCommand(concat(quote($dbg,'x'),' ',quote($dmp,'x')))
 if hasOutput(true)
  write $TOP

 # If we found pmap, run it
 if findCommand('pmap')
 {prefix
   write '---+ pmap Output'
  call writeCommand(concat(last,' ',quote($dmp,'x')))
  if hasOutput(true)
   write $TOP
 }

 # If we found pflags, run it
 if findCommand('pflags')
 {prefix
   write '---+ pflags Output'
  call writeCommand(concat(last,' -r ',quote($dmp,'x')))
  if hasOutput(true)
   write $TOP
 }

 # If we found pldd, run it
 if findCommand('pldd')
 {prefix
   write '---+ pldd Output'
  call writeCommand(concat(last,' ',quote($dmp,'x')))
  if hasOutput(true)
   write $TOP
 }
}
else
{# Extract possible executables from the corefile
 var ($flg,%exe) = ()
 loop $fil ($pgm,\
            catFile(dirname($dmp),$pgm),\
            grepCommand(concat('strings ',quote($dmp,'x')),\
            concat('^(.*\/)?',$pgm,'$')))
 {var $fil = replace($fil,'^\.\/')
  if testFile('x',$fil)
  {next testDir('d',$fil)
   var $exe{$fil} = 1
   var $flg = true
  }
 }

 # Try to extract the stack trace
 if $flg
 {# Initialize the debugger input file
  var $inp = createTemp('debug')
  if match($dbg,'gdb$')
  {call writeTemp('debug','echo \n</verbatim>\n---### Stack\n<verbatim>\n')
   call writeTemp('debug','thread apply all where')
   call writeTemp('debug','echo \n</verbatim>\n---### Registers\n<verbatim>\n')
   call writeTemp('debug','info all-registers')
   call writeTemp('debug','q')
  }
  elsif match($dbg,'mdb$')
  {call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Version and Status"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','::version')
   call writeTemp('debug','::status')
   call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Stack"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','::walk thread | ::findstack')
   call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Registers"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','::regs')
  }
  elsif match($dbg,'adb$')
  {call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Stack"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','$c')
   call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Registers"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','$r')
   call writeTemp('debug','$f')
   call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Memory Map"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','$m')
   call writeTemp('debug','!echo "</verbatim>"')
   call writeTemp('debug','!echo "---### Variables"')
   call writeTemp('debug','!echo "<verbatim>"')
   call writeTemp('debug','$v')
   call writeTemp('debug','$q')
  }
  elsif match($dbg,'sdb$')
  {call writeTemp('debug','t')
   call writeTemp('debug','quit')
  }
  elsif match($dbg,'dbx$')
  {call writeTemp('debug','print "</verbatim>"')
   call writeTemp('debug','print "---### Stack"')
   call writeTemp('debug','print "<verbatim>"')
   call writeTemp('debug','where')
   call writeTemp('debug','print "</verbatim>"')
   call writeTemp('debug','print "---### Registers"')
   call writeTemp('debug','print "<verbatim>"')
   call writeTemp('debug','registers')
   call writeTemp('debug','quit')
  }
  call closeTemp('debug')

  # Try them individually to extract a stack trace.
  loop $exe (keys(%exe))
  {prefix
    write '---+ Core Extraction Attempted with ',encode($exe)
   call writeCommand(concat(quote($dbg,'x'),$opt{$typ},' ',quote($exe,'x'),' ',\
                            quote($dmp,'x'),' <',quote($inp,'x')))
   if hasOutput(true)
    write $TOP
  }

  # Remove the temporary debug file
  call unlinkTemp('debug')
 }
 else
  echo 'Program not found'
}
echo "Stack trace extraction done."
if isCreated()
 echo 'Result file: ',renderFile()

=begin credits

=over 10

=item RDA 4.4:  Roger Snowden.

=item RDA 4.12: Francois Lange.

=back

=end credits

=head1 COPYRIGHT NOTICE

Copyright (c) 2002-2009, Oracle. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle, JD Edwards, PeopleSoft, and Siebel are registered trademarks of Oracle
Corporation and/or its affiliates. Other names may be trademarks of their
respective owners.

=cut