tools/decodecore

   1 #!/usr/bin/tclsh
   2 #
   3 # decode as much as possible an application printk core dump
   4 # to speed debugging, takes an optional romfs-inst.log that is usually
   5 # created in your images directory in order to provide symbols by name
   6 # rather than just addresses.  Can handle multiple core dumps in the input
   7 # file.
   8 #
   9 # the output will do the following:
  10 #
  11 # 1. Find the PC,  if possible and print the symbol and/or address within
  12 #    the application or library as required to debug further.
  13 #
  14 # 2. Find the return address,  if possible and print the symbol and/or
  15 #    address within the application or library as required to debug further.
  16 #
  17 # 3. for every value on the stack,  see if it lies within the application
  18 #    and if so print the text/data address and symbol for it if found. The
  19 #    stack is printed in ascending order so you get a rudimentary stack
  20 #    backtrace
  21 #
  22 # david_mccullough@securecomputing.com
  23 #
  24
  25 package require cmdline
  26 set options {
  27         {m.arg "" "lsmod output"}
  28 }
  29 append usage \
  30 "\[options\] core-dump-text-file \[romfs-inst.log\]\n" \
  31 "       Decode as much as possible from a file containing SH\n" \
  32 "       or ARM core dump traces. The coredump text can be\n" \
  33 "       prefixed with misc junk, ie., syslog infomation.\n" \
  34 "options:"
  35 array set params [::cmdline::getoptions argv $options $usage]
  36
  37 if {[llength $argv] < 1} {
  38         puts [::cmdline::usage $options $usage]
  39         exit 1
  40 }
  41
  42 # some globals, "ra" or return address may not be possible on all archs
  43 set ::coredumps 0
  44
  45 # parse the printk coredump output,  ignoring any leading garbage as found
  46 # in syslog etc
  47
  48 proc load_coredump {filename} {
  49         set f [open $filename]
  50
  51         set stackdump 0
  52         set oops 0
  53
  54         while {[gets $f line] >= 0} {
  55                 if {[regexp -nocase {Internal error: Oops:} $line dummy]
  56                                 || [regexp -nocase {WARNING: at} $line dummy]
  57                                 || [regexp -nocase {Oops\[.*\]:} $line dummy]
  58                                 || [regexp -nocase {snapdog: expired} $line dummy]
  59                                 || [regexp -nocase {Unhandled kernel unaligned access\[.*\]:} $line dummy]} {
  60                         set stackdump 0
  61                         incr ::coredumps
  62                         if {[info exists ::segments(lsmod)]} {
  63                                 set ::segments($::coredumps) $::segments(lsmod)
  64                         } else {
  65                                 set ::segments($::coredumps) {}
  66                         }
  67                         load_segment vmlinux
  68                         if {[info exists ::segments(vmlinux)]} {
  69                                 lappend ::segments($::coredumps) $::segments(vmlinux)
  70                         }
  71                         set ::pc($::coredumps) 0
  72                         set ::ra($::coredumps) 0
  73                         set ::stack($::coredumps) {}
  74                         set ::backtrace($::coredumps) {}
  75                         set oops 1
  76                         continue
  77                 }
  78                 if {[regexp -nocase {STACK DUMP} $line dummy]} {
  79                         set stackdump 1
  80                         incr ::coredumps
  81                         set ::pc($::coredumps) 0
  82                         set ::ra($::coredumps) 0
  83                         set ::backtrace($::coredumps) {}
  84                         set oops 0
  85                         continue
  86                 }
  87
  88                 if {$stackdump && [regexp {^.*(0x)*[0-9a-f]+:([0-9a-fA-F ]+)$} $line dummy dummy2 addrs]} {
  89                         append ::stack($::coredumps) $addrs
  90                         continue
  91                 }
  92                 # MIPS64 stack
  93                 if {$stackdump && [regexp {^ *([ [:xdigit:]]+)$} $line dummy addrs]} {
  94                         append ::stack($::coredumps) "$addrs "
  95                         continue
  96                 }
  97
  98                 if {$oops} {
  99                         # things are backwards in a 2.4 oops at least
 100                         if {[regexp -nocase {Stack:} $line dummy]} {
 101                                 set stackdump 1
 102                                 continue;
 103                         }
 104                         # MIPS64 stack start
 105                         if {[regexp -nocase {Stack : ([ [:xdigit:]]+)$} $line dummy addrs]} {
 106                                 append ::stack($::coredumps) $addrs
 107                                 set stackdump 1
 108                                 continue
 109                         }
 110                         if {[regexp -nocase {Backtrace:} $line dummy]} {
 111                                 set stackdump 0
 112                                 continue;
 113                         }
 114                 } else {
 115                         set stackdump 0
 116                 }
 117
 118                 # The SH program counter
 119                 if {[regexp {PC *: *([0-9a-f]+)} $line dummy val]} {
 120                         set ::pc($::coredumps) 0x$val
 121                 }
 122                 # The ARM program counter
 123                 if {[regexp {pc *: *\[<([0-9a-f]+)>\]} $line dummy val]} {
 124                         set ::pc($::coredumps) 0x$val
 125                 }
 126                 # The i386 program counter
 127                 if {[regexp {EIP:[ 0-9a-fA-F]*:*\[<([0-9a-f]+)>\]} $line dummy val]} {
 128                         set ::pc($::coredumps) 0x$val
 129                 }
 130                 # The MIPS program counter
 131                 if {[regexp {epc *: *([0-9a-f]+)} $line dummy val]} {
 132                         set ::pc($::coredumps) 0x$val
 133                 }
 134                 # The SH return address
 135                 if {[regexp {PR *: *([0-9a-f]+)} $line dummy val]} {
 136                         set ::ra($::coredumps) 0x$val
 137                 }
 138                 # The ARM return address
 139                 if {[regexp {lr *: *[[]<([0-9a-f]+)>\]} $line dummy val]} {
 140                         set ::ra($::coredumps) 0x$val
 141                 }
 142                 # The MIPS return address register
 143                 if {[regexp {^\$24:.* ([0-9a-f]+)$} $line dummy val]} {
 144                         set ::ra($::coredumps) 0x$val
 145                 }
 146                 # The MIPS64 return address register
 147                 if {[regexp {ra *: *([[:xdigit:]]+)} $line dummy val]} {
 148                         set ::ra($::coredumps) 0x$val
 149                 }
 150                 # check for an executable dump segment
 151                 if {[regexp {([0-9a-f]+)-([0-9a-f]+) r[-w][-x]p .* (/[^         ]*)\W*$} $line dummy from to segment]} {
 152                         lappend ::segments($::coredumps) [list $segment 0x$from 0x$to]
 153                 }
 154                 # Function backtrace
 155                 if {[regexp {^Function entered at \[<([0-9a-f]+)>\] from \[\<([0-9a-f]+)>\]$} $line dummy at from]} {
 156                         lappend ::backtrace($::coredumps) [list 0x$at 0x$from]
 157                 }
 158                 # MIPS64 Call trace
 159                 if {[regexp {^(Call Trace:)?\[<([[:xdigit:]]+)>\] 0x([[:xdigit:]]+) *$} $line dummy dummy at from]} {
 160                         lappend ::backtrace($::coredumps) [list 0x$at 0x$from]
 161                 }
 162         }
 163         close $f
 164 }
 165
 166 # load the lsmod output,  converting the data into segments
 167 proc load_lsmod {filename} {
 168         set f [open $filename]
 169         while {[gets $f line] >= 0} {
 170                 if {[regexp {^([^ ]+)\s+(\d+)\s+.*\s+(0x[0-9a-f]{8})(?:\s+.*)?$} $line dummy name size from]} {
 171                         set to [format 0x%x [expr $from + $size]]
 172                         lappend ::segments(lsmod) [list ${name}.ko $from $to]
 173                 }
 174         }
 175         close $f
 176 }
 177
 178 # load the romfs log,  converting the data into actually executable names
 179 proc load_romfslog {filename} {
 180         if {[regexp -nocase {vmlinux} $filename dummy]} {
 181                 set ::binaries(vmlinux) $filename
 182                 return
 183         }
 184         set f [open $filename]
 185         while {[gets $f line] >= 0} {
 186                 if {[regexp {^([^ ]+)\W*/.*/romfs/(.*)$} $line dummy src bin]} {
 187                         set ::binaries([string tolower /$bin]) $src
 188                         if {[regexp {.*/(.+)} $bin dummy file]} {
 189                                 set ::binaries([string tolower $file]) $src
 190                         }
 191                 }
 192         }
 193         close $f
 194 }
 195
 196 # load the symbols from an executable
 197 proc load_syms {filename} {
 198         if {[info exists ::syms($filename)]} {
 199                 return
 200         }
 201         set f [open "|nm -nv -C $filename"]
 202         set s [list]
 203         while {[gets $f line] >= 0} {
 204                 if {[regexp {^0*([[:xdigit:]]+)\W+\w+\W+([^$].*)$} $line dummy addr sym]} {
 205                         if {[string length $sym] > 1} {
 206                                 lappend s [list 0x$addr $sym]
 207                         }
 208                 }
 209         }
 210         close $f
 211         set ::syms($filename) $s
 212
 213         set f [open "|strings -t x $filename"]
 214         set s [list]
 215         while {[gets $f line] >= 0} {
 216                 if {[regexp {^[0        ]*([[:xdigit:]]+)[      ]+(.*)$} $line dummy addr str]} {
 217                         lappend s [list 0x$addr $str]
 218                 }
 219         }
 220         close $f
 221         set ::strings($filename) $s
 222 }
 223
 224 proc load_segment {seg} {
 225         if {![info exists ::binaries([string tolower $seg])]} {
 226                 return
 227         }
 228         set filename $::binaries([string tolower $seg])
 229         load_syms $filename
 230         if {![info exists ::syms($filename)]} {
 231                 return
 232         }
 233         set from [lindex [lindex $::syms($filename) 0] 0]
 234         set to [lindex [lindex $::syms($filename) end] 0]
 235         set ::segments($seg) [list $seg $from $to]
 236 }
 237
 238 # find a symbol in the currently loaded data if possible
 239 proc find_sym {seg addr} {
 240         if {![info exists ::binaries([string tolower $seg])]} {
 241                 return ""
 242         }
 243         set filename $::binaries([string tolower $seg])
 244         load_syms $filename
 245         if {![info exists ::syms($filename)]} {
 246                 return ""
 247         }
 248         set last ""
 249         foreach sym $::syms($filename) {
 250                 set val [lindex $sym 0]
 251                 if {$addr < $val} {
 252                         break
 253                 }
 254                 set last [lindex $sym 1]
 255         }
 256         return $last
 257 }
 258
 259 # find a symbol in the currently loaded data if possible
 260 proc find_str {seg addr} {
 261         if {![info exists ::binaries([string tolower $seg])]} {
 262                 return ""
 263         }
 264         set filename $::binaries([string tolower $seg])
 265         load_syms $filename
 266         if {![info exists ::syms($filename)]} {
 267                 return ""
 268         }
 269         set last ""
 270         set ret ""
 271         foreach str $::strings($filename) {
 272                 set val [lindex $str 0]
 273                 if {$addr < $val} {
 274                         break
 275                 }
 276                 set last "[lindex $str 1]"
 277                 if {$addr - $val < [string length $last]} {
 278                         set ret "\"[string range $last [expr $addr - $val] [string length $last]]\""
 279                 }
 280         }
 281         return $ret
 282 }
 283
 284 # given an address find the part of the executable (app/lib) it is in
 285 proc find_segment {segments addr} {
 286         foreach segment $segments {
 287                 set seg [lindex $segment 0]
 288                 set from [lindex $segment 1]
 289                 set to [lindex $segment 2]
 290                 if {$addr >= $from && $addr < $to} {
 291                         if {[regexp {\.[ks]o} $seg dummy]} {
 292                                 set saddr [expr $addr - $from]
 293                         } else {
 294                                 set saddr $addr
 295                         }
 296                         set sym "[find_sym $seg $saddr]"
 297                         set str "[find_str $seg $saddr]"
 298                         return "[format %x $saddr]($sym) in $seg ($from - $to) $str"
 299                 }
 300         }
 301         return ""
 302 }
 303
 304 # process a printk core dump output giving as much info as possible
 305 proc examine_coredump {filename} {
 306         load_coredump $filename
 307
 308         for {set i 1} {$i <= $::coredumps} {incr i} {
 309                 puts "---------------------- dump $i -------------------"
 310                 puts "Possible PC:     [find_segment $::segments($i) $::pc($i)]"
 311                 puts "Possible caller: [find_segment $::segments($i) $::ra($i)]"
 312                 puts ""
 313                 puts "Possible Backtrace:"
 314                 foreach addr [split $::stack($i)] {
 315                         set val [find_segment $::segments($i) 0x$addr]
 316                         if {$val != ""} {
 317                                 puts "$addr: $val"
 318                         }
 319                 }
 320                 puts "ASCII stack:"
 321                 foreach addr [split $::stack($i)] {
 322                         if {[regexp {([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})([0-9A-Fa-f]{2})} $addr all one two three four]} {
 323                                 foreach char "$one $two $three $four" {
 324                                         if {"0x$char" > 0x1f && "0x$char" < 0x7f} {
 325                                                 puts -nonewline [format "%c" 0x$char]
 326                                         } else {
 327                                                 puts -nonewline "."
 328                                         }
 329                                 }
 330                         }
 331                 }
 332                 puts ""
 333                 foreach backtrace $::backtrace($i) {
 334                         set at [find_segment $::segments($i) [lindex $backtrace 0]]
 335                         set from [find_segment $::segments($i) [lindex $backtrace 1]]
 336                         if {$at == ""} {
 337                                 set at [lindex $backtrace 0]
 338                         }
 339                         if {$from == ""} {
 340                                 set from [lindex $backtrace 1]
 341                         }
 342                         puts "Function entered at $at from $from"
 343                 }
 344         }
 345 }
 346
 347 # main program
 348
 349 set coredump [lindex $argv 0]
 350 foreach file [lrange $argv 1 end] {
 351         load_romfslog $file
 352 }
 353 if {$params(m) != ""} {
 354         load_lsmod $params(m)
 355 }
 356 puts [examine_coredump $coredump]