From: Alan Stebbens <aks%anywhere@hub.ucsb.edu>
Subject: Update on "panicanal": now "traceanal" w/improvements
Reply-To: aks%anywhere@hub.ucsb.edu
Organization: The Internet
Date: Thu, 3 Sep 1992 19:33:15 GMT

This is an improvement on the Perl program I sent a few days ago called
"panicanal"; it has been improved since then, and its name has been
changed to better reflect its function: "traceanal".  It looks for
traceback messages in the named file, /var/adm/messages, by default
(stdin is given with a file arg of '-'), and passes the addresses to
"adb" for symbolic decoding against the kernel (/vmunix).  You should
even be able to do: "dmesg | traceanal -"

It now supports a "summary" option (-s or -summary), which provides a
summary of the tracebacks found in the file.

As you might guess, the motivation for this script to help diagnose an
apparent kernel bug that we are currently experiencing, in the form of
spurious or random faults on one of our sparc1stations.  Not
incidentally, we are running it as a relatively loaded NFS fileserver
with four 1.7GB SCSI drives.  We've totally eliminated the hardware as
being the fault.

Enjoy.

Alan Stebbens        <aks@hub.ucsb.edu>             (805) 893-3221
     Center for Computational Sciences and Engineering (CCSE)
          University of California, Santa Barbara (UCSB)
           3111 Engineering I, Santa Barbara, CA 93106

============================= cut here ===================================
#!/bin/perl -s
# traceanal [-a] [-s] [file]
#
# $Revision: 1.3 $ $Date: 1992/09/03 18:44:57 $
# Alan K. Stebbens, CCSE, UCSB
#
# Do analysis of vmunix tracebacks as written in file (default is
# /var/adm/messages).
#
# If -a given, do all dumps, otherwise, interact with the user
# If STDOUT is not a tty, assume -a.
#
# If -s given, do a summary of the dumps.
#
$all = $a     unless $all;
$summary = $s unless $summary;

$dumpfile = '/var/adm/messages' unless $dumpfile = shift;
die "$dumpfile doesn't exist" unless ($dumpfile eq '-') || -f $dumpfile;

$KEEP_LINES = 6;

$interact = !($all || $summary) && -t && $dumpfile ne '-';	# set interaction flag

open(DUMP,$dumpfile) || die "Can't read $dumpfile because $!\n";
$defans = 'n';				# initial default answer is 'no'
select(STDOUT);
$| = 1;					# flush all STDOUT
while (<DUMP>) {
    push(@lines,$_);
    shift(@lines) if $#lines > $KEEP_LINES;	# keep only so many lines
    next if !/Begin traceback\.\.\./;	# loop until the traceback starts
    $header = $1 if /^(.*)Begin traceback\.\.\./;
    @lines = grep(s/$header//,@lines);	# remove the headers
    @lines = grep(chop($_),@lines);	# remove the newlines
    $what = '';
    $pidinfo = '';
    foreach (@lines) {			# look for the reason
	if (!$what) {
	    $what = $1 if /^panic:\s*(\S.*)/ || 
			  /^([A-Z -]+)/ || 
			  /^syncing file systems\.+[ \d]*([A-Z -]+)/;
	}
	if (!$pidinfo) {
	    $pidinfo = $1 if /^(pid \d+,.*)/;
	}
	last if $what && $pidinfo;	# quit when both found
    }
    $mon = '';
    ($mon, $day, $time, $host, $proc) = split(' ',$header) if $header;
    @trace = @lines;			# setup the trace data
    @lines = ();
    while (<DUMP>) {
	chop;
	last unless s/$header//;	# strip header
	push(@trace,$_);		# add to trace data
	last if /End traceback\.\.\./;
    }
    printf "\n" unless $summary;
    printf "Traceback";
    printf " on $mon $day at $time" if $mon;
    printf " on $host" if $host;
    $pidinfo =~ s/: $what//;		# avoid duplicate stuff
    printf " : $what, $pidinfo" if $summary || $interact;
    printf "\n";
    if ($interact) {
	printf "Analyze (ynq)? [$defans]";
	exit unless $ans = <STDIN>;
	chop($ans);
	$ans = $defans unless $ans;
	$defans = $ans;			# new default
	exit     if !index('quit',$ans);
	next unless !index('yes',$ans);
    }
    &analyze unless $summary;
}
close DUMP;
exit;

sub analyze {
    local($_);

    $addr = '';
    $tmp = "/tmp/$$.anal";
    open(TMP,">$tmp") || die "Can't open $tmp because $!\n";
    @addrs = ();
    foreach (@trace) {
	printf "%s\n",$_;
	next unless /Called from ([0-9a-f]+),/ || /pc=0x([0-9a-f]+),/;
	$addr = $1;
	print TMP "$addr?i\n";
	push(@addrs,$addr);
    }
    close TMP;
    $| = 1;			# flush STDOUT
    open(ADB,"adb /vmunix < $tmp|") || die "Can't open pipe from adb because $!\n";
    while (<ADB>) {
	chop;
	next if /^\s*$/;
	$addr = shift @addrs;
	if (!/text address not found/) {
	    ($symaddr,$instr) = ($1,$2) if /^([^:]+:)\s+(.*)/;
	    printf "%s: %-30s %s\n",$addr,$symaddr,$instr;
	}
    }
    close ADB;
    unlink $tmp;
}
Newsgroups: comp.lang.perl