# COREinfo.ctl: Extracts Core Dump Information
# $Id: COREinfo.ctl,v 1.7 2013/12/16 07:51:45 RDA Exp $
# ARCS: $Header: /home/cvs/cvs/RDA_8/src/scripting/lib/collect/OS/COREinfo.ctl,v 1.7 2013/12/16 07:51:45 RDA Exp $
#
# Change History
# 20131212  KRA  Fix spell.

=for stopwords COREinfo

=head1 NAME

OS:COREinfo - Extracts Core Dump Information

=head1 DESCRIPTION

This module extracts relevant information from a core dump file.

The following macros are available:

=cut

# Make the module persistent and share macros
keep $KEEP_BLOCK,@SHARE_MACROS
var @SHARE_MACROS = ('can_analyze_core','analyze_core','run_coreadm')

# Initialisation
keep $CORE_DEBUG,$CORE_INFO,$CORE_PFLAGS,$CORE_PLDD,$CORE_PMAP,$CORE_SEP,\
     $CORE_TYPE,%CORE_OPT
if !$CORE_INFO
{var $CORE_INFO = true

 # Define some variables that are shared between macros
 var $CORE_DEBUG
 var $CORE_PFLAGS
 var $CORE_PLDD
 var $CORE_PMAP
 var $CORE_SEP = cond(match(getOsName(),'aix'),",\s*","'")
 var $CORE_TYPE
 var %CORE_OPT = ('gdb',' -quiet')

 # Find a debugger
 if or(isUnix(),isCygwin())
 {macro find_command
  {if ?findCommand($arg[0],true)
   {var $pgm = last
    if ?testFile('x',$pgm)
     return quote($pgm)
   }
   return undef
  }

  if match(getOsName(),'solaris|sunos')
  {if find_command('pstack')
   {var $CORE_DEBUG  = last
    var $CORE_PFLAGS = find_command('pflags')
    var $CORE_PLDD   = find_command('pldd')
    var $CORE_PMAP   = find_command('pmap')
   }
  }
  if !$CORE_DEBUG
  {if and(match($osn,'aix'),compare('valid',first(command('oslevel')),'4.3'))
    var @dbg = ('dbx','gdb','mdb','adb','sdb')
   else
    var @dbg = ('gdb','mdb','adb','sdb','dbx')
   loop $CORE_TYPE (@dbg)
   {if find_command($CORE_TYPE)
    {var $CORE_DEBUG = last
     break
    }
   }
  }
 }
}

=head2 can_analyze_core()

This macro indicates which command has been found to analyze core
dumps. Otherwise, it returns an undefined value.

=cut

macro can_analyze_core
{import $CORE_DEBUG
 keep $CORE_DEBUG
 return $CORE_DEBUG
}

=head2 analyze_core($dmp...)

This macro analyzes all core dumps specified as arguments. For each dump, it
determines the location of the corresponding executable first and then extracts
the stack information.

=cut

macro analyze_core
{import $CORE_DEBUG,$CORE_PFLAGS,$CORE_PLDD,$CORE_PMAP,$CORE_SEP,$CORE_TYPE,\
        $TOP,%CORE_OPT
 keep $CORE_DEBUG,$CORE_PFLAGS,$CORE_PLDD,$CORE_PMAP,$CORE_SEP,$CORE_TYPE,\
      %CORE_OPT

 # Abort when no debugger has been found
 if !$CORE_DEBUG
  return

 # Initialize the debugger input file
 if compare('eq',$CORE_TYPE,'gdb')
 {var $inp = createTemp('debug')
  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')
  call closeTemp('debug')
 }
 elsif compare('eq',$CORE_TYPE,'mdb')
 {var $inp = createTemp('debug')
  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 compare('eq',$CORE_TYPE,'adb')
 {var $inp = createTemp('debug')
  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')
  call closeTemp('debug')
 }
 elsif compare('eq',$CORE_TYPE,'sdb')
 {var $inp = createTemp('debug')
  call writeTemp('debug','t')
  call writeTemp('debug','quit')
  call closeTemp('debug')
 }
 elsif compare('eq',$CORE_TYPE,'dbx')
 {var $inp = createTemp('debug')
  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')
 }
 else
  var $inp = undef

 # Generate the report
 loop $dmp (@arg)
 {write '---+ ',$dmp
  if ?testFile('r',$dmp)
  {# Try to extract the program name that produced the core
   var $pgm = field($CORE_SEP,1,command(concat('file ',quote($dmp))))

   # List the environment, what we know so far
   write '|*Core file*|',encode($dmp),' |'
   write '|*Program  *|',encode($pgm),' |'

   # Extract information from the core file
   if $CORE_TYPE
   {# Extract possible executables from the corefile
    var ($flg,%exe) = ()
    loop $exe ($pgm,\
               catFile(dirname($dmp),$pgm),\
               grepCommand(concat('strings ',quote($dmp)),\
                           concat('^(.*\/)?',$pgm,'$')))
    {var $exe = replace($exe,'^\.\/+')
     if ?testFile('x',$exe)
     {next ?testDir('d',$exe)
      var $exe{$exe} = 1
      var $flg = true
     }
    }

    # Try them individually to extract a stack trace.
    if $flg
    {loop $exe (keys(%exe))
     {prefix
       write '---## Core extraction be attempted with ',encode($exe)
      call writeCommand(concat($CORE_DEBUG,\
                               $CORE_OPT{$CORE_TYPE},' ',quote($exe),' ',\
                               quote($dmp),' <',$inp))
      if hasOutput(true)
       write $TOP
     }
    }
    else
     write '** Program not found.**%BR%',$TOP
   }
   else
   {# If pstack is available, just call the code and be done with it.
    prefix
     write '---### pstack Output'
    call writeCommand(concat($CORE_DEBUG,' ',quote($dmp)))
    if hasOutput(true)
     write $TOP

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

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

    # If we found pldd, run it
    if $CORE_PLDD
    {prefix
      write '---### pldd Output'
     call writeCommand(concat($CORE_PLDD,' ',quote($dmp)))
     if hasOutput(true)
      write $TOP
    }
   }
  }
  else
  {write '** Not readable.**%BR%'
   call statFile('b',$dmp)
   write $TOP
  }
 }

 # Remove the temporary debug file
 if $inp
  call unlinkTemp('debug')
}

=for stopwords coreadm

=head2 S<run_coreadm($pat)>

This macro writes the global and per process F<coreadm> command output into the
current report. The processes for which the F<coreadm> command is to be run,
are selected based on a regular expression.

=cut

macro run_coreadm
{var ($pat) = @arg
 import $TOP

 if ?findCommand('coreadm')
 {var $cmd = last
  debug ' Inside run_coreadm, getting global coreadm pattern'
  write '---+ Global Core Dump Pattern'
  call writeCommand($cmd)
  write $TOP

  debug ' Inside run_coreadm, getting per-process coreadm pattern'
  var $PS_EF
  run OS:OSsunos('PS')
  loop $lin (grepCommand(concat($PS_EF,' -o pid,args'),$pat))
  {var ($pid,$val) = split('\s+',trim($lin),2)
   if match($pid,'\d')
    var $prc{$pid} = concat($pid,'-',$val)
  }
  loop $pid (keys(%prc))
  {if loadCommand(concat($cmd,' ',$pid))
   {loop $lin (getLines())
    {var (undef, $pat) = split(':',$lin,2)
     var $pat = trim($pat)
     var $lst{$pat} = join('%BR%',$lst{$pat},$prc{$pid})
    }
   }
  }
  if %lst
  {write '---+ Per Process Core Dump Pattern'
   write '|*Core File Pattern*|*Processes*|'
   loop $key (keys(%lst))
    write '|',$key,'|',$lst{$key},'|'
   write $TOP
  }
 }
}

=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, 2016, Oracle and/or its affiliates. All rights reserved.

=head1 TRADEMARK NOTICE

Oracle and Java are registered trademarks of Oracle and/or its
affiliates. Other names may be trademarks of their respective owners.

=cut