3 # IRC - Internet Relay Chat, tools/ringlog.pl
4 # Copyright (C) 2002 by Kevin L. Mitchell <klmitch@mit.edu>
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.
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.
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
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.
38 my ($location, @args) = @_;
40 unshift(@args, '-f'); # always get functions
43 socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)
44 or die "socketpair: $!";
46 CHILD->autoflush(1); # Make sure autoflush is turned on
53 unless (defined($pid = fork));
55 if (!$pid) { # in child
57 open(STDIN, "<&PARENT");
58 open(STDOUT, ">&PARENT");
59 exec($location, @args); # exec!
65 return \*CHILD; # Return a filehandle for it
71 # Feed address into addr2line
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";
79 chomp($function, $fileline);
81 # If addr2line couldn't translate the address, just return it
83 if ($function eq "??");
85 # return function(file:line)[address]
86 return "$function($fileline)[$addr]";
90 my ($location, @args) = @_;
92 # Build a pipe and fork, through the magic of open()
93 my $pid = open(RINGLOG, "-|");
95 # Make sure we forked!
96 die "couldn't fork: $!"
97 unless (defined($pid));
100 exec($location, @args)
107 my ($ringlog, $addr) = @_;
108 my $state = "reading";
113 # Beginning of parsable data
114 if (/^File.*contents:$/) {
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;
121 # Switch out of parsing mode
126 # Print the final result
131 # get an argument for an option that requires one
135 $ARGV[$$iref] =~ /^(-.)(.*)/;
137 die "Argument for $1 missing"
138 unless ((defined($2) && $2 ne "") || @ARGV > $$iref + 1);
140 return defined($2) && $2 ne "" ? $2 : $ARGV[++$$iref];
143 my ($ringlog_exe, $addr2line_exe) = ("ringlog", "addr2line");
144 my (@addr2line_args, @files);
146 # Deal with arguments; note that we have to deal with -b and -e for
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]);
158 push(@files, [ $ARGV[$i], @addr2line_args ]);
159 @addr2line_args = ();
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 "");
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]));
175 parse_ringlog($ringlog, $addr2line);
181 # Now if there are still more unprocessed arguments, expect ringlog
183 if (@addr2line_args) {
184 my $addr2line = start_addr2line($addr2line_exe, @addr2line_args);
186 parse_ringlog(\*STDIN, $addr2line);