NetNews Usenet Archive 1992 #19/NN_1992_19.iso/spool/comp/lang/perl/5710

Text File | 1992-09-03 | 4.6 KB | 146 lines

Newsgroups: comp.lang.perl
Path: sparky!uunet!gatech!darwin.sura.net!uvaarpa!mmdf
From: Alan Stebbens <[e-mail]>
Subject: Update on "panicanal": now "traceanal" w/improvements
Message-ID: <[e-mail]>
Sender: [e-mail] (Mail System)
Reply-To: [e-mail]
Organization: The Internet
Date: Thu, 3 Sep 1992 19:33:15 GMT
Lines: 134

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        <[e-mail]>             [phone]
     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;
}