utils/wvcrashread

   1 #!/usr/bin/perl
   2 #
   3 # Worldvisions Weaver Software:
   4 #   Copyright (C) 2005 Net Integration Technologies, Inc.
   5 #
   6 # Post-process WvCrash output using GDB, to try to figure out exactly
   7 # which line things died upon.
   8 #
   9 # The advantage of using this programme over a plain stack dump is
  10 # that it is clever enough to figure out relative offsets to a
  11 # function, so you don't need the exact same object file as the one
  12 # that crashed.  With extra cleverness, we even span symbol manging
  13 # across different versions of G++.
  14
  15 use strict;
  16 use warnings;
  17
  18 use Cwd;
  19 use File::Basename;
  20 use File::Find ();
  21 use FileHandle;
  22 use IPC::Open2;
  23
  24 my $DEBUG = $ENV{DEBUG};
  25 sub debug
  26 {
  27     print(STDERR @_) if $DEBUG;
  28 }
  29
  30 sub find_programme($)
  31 {
  32     my $target = shift(@_);
  33
  34     return $target if (-f $target && -x $target);
  35
  36     my $result;
  37     my $endtime = time() + 20;  # Stop searching after 20 seconds.
  38     my $cwd = cwd();            # Save the working dir so we can go back.
  39
  40     my $wanted = sub {
  41         if ($_ eq $target && -f $_ && -x $_) {
  42             $result = $File::Find::name;
  43             die;                # Break out of the File::Find::find.
  44         }
  45         elsif (time() > $endtime){
  46             die;                # Took too long.
  47         }
  48     };
  49
  50     # Traverse desired filesystems
  51     eval {
  52         File::Find::find({wanted => $wanted,
  53                           follow_fast => 1,
  54                           follow_skip => 2}, '.');
  55     };
  56     chdir($cwd);
  57     return $result;
  58 }
  59
  60 sub gdb_init($)
  61 {
  62     my ($programme) = @_;
  63
  64     my $gdb_prompt = qr/(?:\(gdb\) )+/;
  65     my $gdb_flush = "echo \\n\n"; # Flush gdb's stdout
  66
  67     my $gdb_addr = sub ($$$) {
  68         my ($Reader, $Writer, $function) = @_;
  69
  70         debug("-> info addr $function\n");
  71         print($Writer "info addr $function\n");
  72         print($Writer $gdb_flush);
  73         my $first = 0;
  74         while (<$Reader>)
  75         {
  76             debug("<- $_");
  77             if (/^$gdb_prompt\s*Symbol "(.*?)" is .* (0x[0-9A-Fa-f]+)/) {
  78                 return ($1, $2);
  79             }
  80             last if (/^$gdb_prompt$/ && $first);
  81             $first = 1;
  82         }
  83
  84         # Returns the human-readable function name, and the starting address
  85         return ($function, undef);
  86     };
  87
  88     my $gdb_line = sub ($$$$)
  89     {
  90         my ($Reader, $Writer, $addr, $offset) = @_;
  91
  92         debug("-> info line *$addr+$offset\n");
  93         print($Writer "info line *$addr+$offset\n");
  94         print($Writer $gdb_flush);
  95         my $first = 0;
  96         while (<$Reader>) {
  97             debug("<- $_");
  98             if (/^$gdb_prompt\s*Line ([0-9]+) of "(.*?)" starts at /) {
  99                 return ($2, $1);
 100             }
 101             last if (/^$gdb_prompt$/ && $first);
 102             $first = 1;
 103         }
 104
 105         # Returns the filename and line number.
 106         return (undef, undef);
 107     };
 108
 109     # Initialise GDB
 110     my ($Reader, $Writer);
 111     debug("gdb '$programme'\n");
 112     my $pid = open2($Reader, $Writer, "gdb '$programme' 2>&1") or die;
 113     print($Writer "set width 2000\n");
 114     print($Writer "set height 20000\n");
 115     print($Writer "break main\n");
 116     print($Writer "run\n");
 117     print($Writer $gdb_flush);
 118     while (<$Reader>) {
 119         debug("<- $_");
 120         last if (/^$gdb_prompt$/);
 121     }
 122
 123     return sub ($) {
 124         my ($string) = @_;
 125
 126         # Parse the input string.
 127         my ($binary, $absolute) = ($string =~ /^(.*?)([\[\(].*)/);
 128         my ($function, $offset) = ($absolute =~ /^\((.*?)\+(.*?)\)/);
 129         $absolute =~ s/.*\[(.*?)\].*/$1/;
 130
 131         my ($file, $line) = ("--", "--");
 132
 133         unless (defined($function)) {
 134             $function = "file: $binary";
 135         }
 136         else {
 137             my $addr;
 138
 139             # Try with the mangled function name
 140             ($function, $addr) = &$gdb_addr($Reader, $Writer, $function);
 141
 142             unless (defined($addr))
 143             {
 144                 # Try with c++filt mangled function
 145                 my $filtered = `c++filt '$function'` or return ($function,
 146                                                               undef, undef);
 147                 chomp($filtered);
 148                 # Turn () into (void) for old GDB
 149                 $filtered =~ s/(?<!operator)\(\)/(void)/g;
 150                 ($function, $addr) = &$gdb_addr($Reader, $Writer, $filtered);
 151
 152                 unless (defined($addr))
 153                 {
 154                     # Try turning (void) into () for new GDB
 155                     $function =~ s/\(void\)/()/g;
 156                     ($function, $addr) = &$gdb_addr($Reader, $Writer,
 157                                                     $function);
 158                 }
 159
 160                 return ($function, undef, undef) unless (defined($addr));
 161             }
 162
 163             ($file, $line) = &$gdb_line($Reader, $Writer, $addr, $offset);
 164             $file = "--" unless defined($file);
 165             $line = "--" unless defined($line);
 166         }
 167
 168         return ($function, $file, $line);
 169     };
 170 }
 171
 172 # Main variables
 173 my $programme;                  # Base name of the programme
 174 my $programme_path;             # Relative path to the location of programme
 175 my $signum;                     # Signal number that it died on
 176 my $gdb_parse;                  # Handle to GDB conversation
 177
 178 # Main programme
 179 my $state = "begin";
 180 while (my $string = <>)
 181 {
 182     chomp($string);
 183
 184     # We drive a state machine here, to figure out what we should do next.
 185     STATE: for ($state)
 186     {
 187         if (/begin/)
 188         {
 189             undef $programme;
 190             undef $signum;
 191             # We will want to skip anything that isn't the beginning
 192             # of a WvCrash file.
 193             if ($string =~ / dying on signal \d+/)
 194             {
 195                 $state = "new";
 196                 goto STATE;
 197             }
 198         }
 199         elsif (/new/)
 200         {
 201             # Extract the information out of the first line of the header.
 202             if ($string =~ /^(.*?) dying on signal (\d+)(.*)?/)
 203             {
 204                 $programme = $1;
 205                 $signum = $2;
 206                 my $signame = $3 || "";
 207                 my $version = "";
 208                 if ($programme =~ s/\s+\((.*)\)//) {
 209                     $version = " ($1)" if $1;
 210                 }
 211                 $programme = basename($programme); # Relative path
 212                 print("$programme$version dying on signal $signum$signame\n");
 213                 if ($programme_path = find_programme($programme)) {
 214                     $state = "header";
 215                 }
 216                 else {
 217                     $state = "missing";
 218                 }
 219             }
 220         }
 221         elsif (/header/)
 222         {
 223             # We don't actually have much of a header right now, so this
 224             # merely transitions to the backtrace.
 225             if ($string =~ /^Backtrace:/)
 226             {
 227                 unless (defined($programme) && defined($signum)) {
 228                     $state = "corrupt";
 229                 }
 230                 else
 231                 {
 232                     $gdb_parse = gdb_init($programme_path);
 233                     $state = "backtrace";
 234                 }
 235             }
 236             # Echo back header information.  It's not important to parse,
 237             # but it might be nice to display.
 238             print "$string\n";
 239         }
 240         elsif (/backtrace/)
 241         {
 242             # Keep reading backtrace information until we stop seeing
 243             # stack traces.
 244             if ($string =~ /\[0x[0-9A-Fa-f]+\]$/)
 245             {
 246                 my ($function, $file, $line) = &$gdb_parse($string);
 247
 248                 # Eat up some extra spaces
 249                 $function =~ s/,\s+/,/g;
 250                 $function =~ s/\s+\*/*/g;
 251                 $function =~ s/\s+&/&/g;
 252                 $function =~ s/\s+&/&/g;
 253                 $function =~ s/\s+\(/\(/g;
 254
 255                 $state = "backtrace";
 256                 if (not defined($file)) {
 257                     printf("%-40s --:--\n", $function);
 258                 }
 259                 else {
 260                     printf("%-40s %s:%s\n", $function, $file, $line);
 261                 }
 262             }
 263             else
 264             {
 265                 $state = "begin";
 266                 goto STATE;
 267             }
 268         }
 269         elsif (/missing/)
 270         {
 271             print(STDERR
 272                   "Could not find the '$programme' program!  ",
 273                   "Aborting.\n");
 274             exit(1);
 275         }
 276         elsif (/corrupt/)
 277         {
 278             print(STDERR "Unrecognized WvCrash output.  Aborting.\n");
 279             exit(1);
 280         }
 281         else
 282         {
 283             die("Internal wvcrashread error.  Aborting.");
 284         }
 285     }
 286 }