tools/ringlog.pl

   1 #! /usr/bin/perl -w
   2 #
   3 # IRC - Internet Relay Chat, tools/ringlog.pl
   4 # Copyright (C) 2002 by Kevin L. Mitchell <klmitch@mit.edu>
   5 #
   6 # This program is free software; you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation; either version 2 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program; if not, write to the Free Software
  18 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 #
  20 # @(#)$Id$
  21 #
  22 # This program is intended to be used in conjunction with ringlog and
  23 # the binutils program addr2line.  The -r option specifies the path to
  24 # the ringlog program; the -a option specifies the path to addr2line.
  25 # (Both of these default to assuming that the programs are in your
  26 # PATH.)  All other options are passed to addr2line, and any other
  27 # arguments are treated as filenames to pass to ringlog.  If no
  28 # filenames are given, the program operates in filter mode, expecting
  29 # to get output from ringlog on its standard input.  In this case,
  30 # ringlog will not be directly executed, but addr2line still will.
  31
  32 use strict;
  33
  34 use Socket;
  35 use IO::Handle;
  36
  37 sub start_addr2line {
  38     my ($location, @args) = @_;
  39
  40     unshift(@args, '-f'); # always get functions
  41
  42     # Get a socket pair
  43     socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
  44         or die "socketpair: $!";
  45
  46     CHILD->autoflush(1); # Make sure autoflush is turned on
  47     PARENT->autoflush(1);
  48
  49     my $pid;
  50
  51     # Fork...
  52     die "cannot fork: $!"
  53         unless (defined($pid = fork));
  54
  55     if (!$pid) { # in child
  56         close(CHILD);
  57         open(STDIN, "<&PARENT");
  58         open(STDOUT, ">&PARENT");
  59         exec($location, @args); # exec!
  60     }
  61
  62     # in parent
  63     close(PARENT);
  64
  65     return \*CHILD; # Return a filehandle for it
  66 }
  67
  68 sub xlate_addr {
  69     my ($fh, $addr) = @_;
  70
  71     # Feed address into addr2line
  72     print $fh "$addr\n";
  73
  74     # Get function name, file name, and line number
  75     my $function = <$fh> || die "Couldn't get function name";
  76     my $fileline = <$fh> || die "Couldn't get file name or line number";
  77
  78     # Remove newlines...
  79     chomp($function, $fileline);
  80
  81     # If addr2line couldn't translate the address, just return it
  82     return "[$addr]"
  83         if ($function eq "??");
  84
  85     # return function(file:line)[address]
  86     return "$function($fileline)[$addr]";
  87 }
  88
  89 sub start_ringlog {
  90     my ($location, @args) = @_;
  91
  92     # Build a pipe and fork, through the magic of open()
  93     my $pid = open(RINGLOG, "-|");
  94
  95     # Make sure we forked!
  96     die "couldn't fork: $!"
  97         unless (defined($pid));
  98
  99     # Execute ringlog...
 100     exec($location, @args)
 101         unless ($pid);
 102
 103     return \*RINGLOG;
 104 }
 105
 106 sub parse_ringlog {
 107     my ($ringlog, $addr) = @_;
 108     my $state = "reading";
 109
 110     while (<$ringlog>) {
 111         chomp;
 112
 113         # Beginning of parsable data
 114         if (/^File.*contents:$/) {
 115             $state = "parsing";
 116
 117             # Here's actual parsable data, so parse it
 118         } elsif ($state eq "parsing" && /^\s*\d+/) {
 119             s/(0x[a-fA-F0-9]+)/&xlate_addr($addr, $1)/eg;
 120
 121             # Switch out of parsing mode
 122         } else {
 123             $state = "reading";
 124         }
 125
 126         # Print the final result
 127         print "$_\n";
 128     }
 129 }
 130
 131 # get an argument for an option that requires one
 132 sub getarg (\$) {
 133     my ($iref) = @_;
 134
 135     $ARGV[$$iref] =~ /^(-.)(.*)/;
 136
 137     die "Argument for $1 missing"
 138         unless ((defined($2) && $2 ne "") || @ARGV > $$iref + 1);
 139
 140     return defined($2) && $2 ne "" ? $2 : $ARGV[++$$iref];
 141 }
 142
 143 my ($ringlog_exe, $addr2line_exe) = ("ringlog", "addr2line");
 144 my (@addr2line_args, @files);
 145
 146 # Deal with arguments; note that we have to deal with -b and -e for
 147 # addr2line.
 148 for (my $i = 0; $i < @ARGV; $i++) {
 149     if ($ARGV[$i] =~ /^-r/) {
 150         $ringlog_exe = getarg($i);
 151     } elsif ($ARGV[$i] =~ /^-a/) {
 152         $addr2line_exe = getarg($i);
 153     } elsif ($ARGV[$i] =~ /^-([be])/) {
 154         push(@addr2line_args, "-$1", getarg($i));
 155     } elsif ($ARGV[$i] =~ /^-/) {
 156         push(@addr2line_args, $ARGV[$i]);
 157     } else {
 158         push(@files, [ $ARGV[$i], @addr2line_args ]);
 159         @addr2line_args = ();
 160     }
 161 }
 162
 163 # Verify that that left us with executable names, at least
 164 die "No ringlog executable"
 165     unless (defined($ringlog_exe) && $ringlog_exe ne "");
 166 die "No addr2line executable"
 167     unless (defined($addr2line_exe) && $addr2line_exe ne "");
 168
 169 # Ok, process each file we've been asked to process
 170 foreach my $file (@files) {
 171     my ($addr2line, $ringlog) =
 172         (start_addr2line($addr2line_exe, @{$file}[1..$#{$file}]),
 173          start_ringlog($ringlog_exe, $file->[0]));
 174
 175     parse_ringlog($ringlog, $addr2line);
 176
 177     close($addr2line);
 178     close($ringlog);
 179 }
 180
 181 # Now if there are still more unprocessed arguments, expect ringlog
 182 # input on stdin...
 183 if (@addr2line_args) {
 184     my $addr2line = start_addr2line($addr2line_exe, @addr2line_args);
 185
 186     parse_ringlog(\*STDIN, $addr2line);
 187     close($addr2line);
 188 }