package Debug::FaultAutoBT;
use 5.00503;
use strict;
#use warnings;
use File::Spec::Functions;
use Config;
use Symbol;
require DynaLoader;
@Debug::FaultAutoBT::ISA = qw(DynaLoader);
$Debug::FaultAutoBT::VERSION = '0.02';
bootstrap Debug::FaultAutoBT $Debug::FaultAutoBT::VERSION;
use constant COMMAND_FILE => 'gdb-command';
use constant CORE_FILE_BASE => 'core.backtrace.';
sub new {
my ($class, %attrs) = @_;
my $self = bless \%attrs, ref($class)||$class;
$self->init();
return $self;
}
sub init {
my $self = shift;
# verify that the 'dir' attribute is set and the dir is writable
die "must specify a 'dir' attribute"
unless exists $self->{dir} && length $self->{dir};
die "the dir $self->{dir} must be writable"
unless -w $self->{dir};
# set/verify the 'exec_path' attribute
if (exists $self->{exec_path}) {
die "exec_path: $self->{exec_path} is not found"
unless -e $self->{exec_path};
die "exec_path: $self->{exec_path} is not executable"
unless -x $self->{exec_path};
$self->{exec_path_in} = $self->{exec_path};
}
else {
$self->inteli_guess_exec_path();
die "cannot figure out the executable path, ",
"set the 'exec_path' attribute"
unless exists $self->{exec_path_in};
}
# set/verify the 'command_path_in' attribute
if (exists $self->{command_path}) {
# the file should already exist and include the gdb commands
die "command_path: cannot read $self->{command_path}"
unless -r $self->{command_path};
$self->{command_path_in} = $self->{command_path};
}
else {
# use the default file and write it
$self->{command_path_in} = catfile $self->{dir}, COMMAND_FILE;
$self->write_gdb_command_file();
}
# set/verify the 'command_path_base_in' attribute
if (exists $self->{core_path_base}) {
# try to create a file using this base
my $try_path = $self->{core_path_base} . "00000";
my $fh = Symbol::gensym();
if (open $fh, ">$try_path") {
close $fh;
unlink $try_path;
}
else {
die "core_path_base: $self->{core_path_base} doesn't seem to ",
"be suitable as a base for the path that can be written to";
}
$self->{core_path_base_in} = $self->{core_path_base};
}
else {
# use the default file and write it
$self->{core_path_base_in} = catfile $self->{dir}, CORE_FILE_BASE;
}
# set/verify the 'debugger' attribute
# NOOP now
}
sub write_gdb_command_file {
my $self = shift;
#XXX: should we die here?
#die "$self->{command_path_in} already exists, delete first"
# if -e $self->{command_path_in};
#warn "creating $self->{command_path_in} for user ".(getpwuid($>))[0]."\n";
my $fh = Symbol::gensym();
open $fh, ">$self->{command_path_in}"
or die "can't open $self->{command_path_in} for writing: $!";
print $fh <<EOI;
bt
kill
quit
EOI
close $fh;
}
sub inteli_guess_exec_path {
my $self = shift;
if (-x $^X) {
$self->{exec_path_in} = $^X;
}
elsif (-e '/proc/self/exe') {
# linux?
my $path = readlink("/proc/self/exe");
$self->{exec_path_in} = $path if -e $path;
}
else {
$self->{exec_path_in} = $Config{perlpath} if -x $Config{perlpath};
}
}
sub ready {
my $self = shift;
#warn "calling @$self{qw(exec_path_in command_path_in core_path_base_in)}";
set_segv_action($self->{exec_path_in},
$self->{command_path_in},
$self->{core_path_base_in});
}
DESTROY {
my $self = shift;
# XXX: test that this actually works, since we die here!
# cleanup the autogenerated file if we have created it
#unlink $self->{command_path_in} unless exists $self->{command_path};
}
1;
__END__
=head1 NAME
Debug::FaultAutoBT - Automatic Backtrace Extractor on SIGSEGV, SIGBUS, etc.
=head1 SYNOPSIS
use Debug::FaultAutoBT;
use File::Spec::Functions;
my $tmp_dir = File::Spec::Functions::tmpdir;
my $trace = Debug::FaultAutoBT->new(
dir => "$tmp_dir",
#verbose => 1,
#exec_path => '/home/stas/perl/bin/perl',
#core_path_base => catfile($tmp_dir, "mycore"),
#command_path => catfile($tmp_dir, "my-gdb-command"),
#debugger => "gdb",
);
# enable the sighandler
$trace->ready();
# or simply:
Debug::FaultAutoBT->new(dir => "$tmp_dir")->ready;
=head1 DESCRIPTION
When a signal, that normally causes a coredump, is delivered This
module attempts to automatically extract a backtrace, rather than
letting the core file be dumped. This has the following benefits:
=over
=item *
no need to setup the environment to allow core file dumped. Sometimes
people just don't know how to set it up. Sometimes you aren't allowed
to set it up (e.g., when the webserver environment is not under your
control).
=item *
if many Perl programs are run in a row and more than one program
segfaults it's possible to collect all backtraces, rathen then
aborting the run on the first segfault or staying with only the last
core file, which will overwrite all the previous ones. For example
consider a live webserver or a test suite which may segfault many
times for different reasons.
=item *
for huge core files, this approach saves disk space. And can be a
saver when you don't have disk space left for various reasons (passed
the quota?), but still have a few kilo-bytes left.
=back
Currently the following signals are trapped:
SIGQUIT
SIGILL
SIGTRAP
SIGABRT
SIGEMT
SIGFPE
SIGBUS
SIGSEGV
SIGSYS
(If you know of other signals that should be trapped let me
know. thanks.)
=head1 METHODS
=head2 new()
my $trace = Debug::FaultAutoBT->new(
dir => "$tmp_dir",
verbose => 1,
exec_path => '/home/stas/perl/bin/perl',
core_path_base => catfile($tmp_dir, "mycore"),
command_path => catfile($tmp_dir, "my-gdb-command"),
debugger => "gdb",
);
Attributes:
=over
=item I<dir>
a writable by the process directory.
This is a required attribute.
=item I<verbose>
Whether to be silent (0) or verbose (1).
This is an optional attribute. The default is 0.
Currently it's always a non-verbose, with just a few traces printed
out. Will work in the future.
=item I<exec_path>
C<gdb> needs to know the path to the executable in order to attach to
the process (though gdb 5.2 and higher needs only pid to do
that). This module is trying to automatically figure out the
executable path, using several methods in the following order:
$^X, /proc/self/exe, $Config{perlpath}
If all these methods fail the module will die(), unless you explicitly
set the I<exec_path> attribute. Notice I named it I<exec_path> because
the executable doesn't have to be perl, when Perl is embedded, which
is the case with mod_perl, which sets C<$^X> to the path to the Apache
httpd server.
=item I<core_path_base>
The base path of the core file. e.g. if I<core_path_base> is set to
I</tmp/mycore> and the pid of the process that has segfaulted is
12345, the generated core is written to the file I</tmp/mycore12345>.
This is an optional attribute.
By default I<core_path_base> is a concatenation of the I<dir>
attribute and the string I<core.>.
=item I<command_path>
The path to the file with debugger commands. If this attribute is set
the file should already include the commands. Notice that the commands
should include 'quit' as the last command, so the debugger will quit.
This is an optional attribute.
By default I<command_path> is a concatenation of the I<dir> attribute
and the string I<gdb-command>, which is getting populated with the
following commands:
bt
quit
=item I<debugger>
Curently not used. In the future could be used to specify which
debugger to use (when more than one debugger is supported). For the
future compatibility C<gdb> is going to be the default.
=back
=head2 ready()
$trace->ready();
This method sets the SIGSEGV sighandler. Only after this method is
called the extract of the trace will be attempted on the event of
SegFault.
Notice that it sets the handler to be called only once. If another
segfault happens during the processing of the handler, the SIGSEGV
handler that was previously set will get invoked. If none was
previously set the default SIGSEGV handler will attempt to dump the
core file if the environment is configured to allow one (via shell's
C<limit> command and possibly other system-dependent manipulations).
=head2 RELATED NOTES
When you want to get a useful backtrace the debugger must be able to
resolve symbols. Therefore the object in question must have its
symbols preserved and not stripped. This is usually accomplished by
compiling the C code with C<-g>. Since this code gets called from
Perl, which in turn may be embedded into some other application (e.g.,
mod_perl enabled Apache), you probably want to have I<libperl.so> and
the application it's embedded to, to be compiled with the debug
symbols non-stripped.
For example to build a Perl package which includes XS/C objects, add:
WriteMakefile(
...
DEFINE => '-g',
...
);
To build Perl in debug mode:
./Configure ... -Doptimize='-g' ...
To build Apache 1.3 without stripping the symbols:
./configure ... --without-execstrip
To build Apache 2.0 in the debug mode:
./configure ... --enable-maintainer-mode ...
=head1 BUGS
=over
=item *
For some reason gdb invoked from sighandler doesn't see the last frame
the actual fault happened at, rendering the tool less useful as it
could be. If you know how to cure that, please let me know.
=item *
When you run the handler you might get things like:
/tmp/Debug-FaultAutoBT-0.01/24043: No such file or directory.
This is a bug in older versions of gdb, simply ignore it.
=item *
It probably won't compile on Win32. If you know how please submit
patches.
=back
=head1 EXPORT
None.
=head1 TODO
* the code is not thread-safe (so it's not running under mod_perl 2.0
with worker mpm :(. The question is how to pass data to the SIGSEGV
signal handler, without using static variables.
* clean the backtrace from extra frames added by this module
* how do we pass the test suite if we exit(2)? currently used fork()
to workaround it, but it's not very portable.
* how do we clean-up the autogenerated gdb-command file if we exit(2)?
* support other debuggers than gdb. Need your input/patches.
Currently this module works only on systems with gdb installed.
I'm not sure how portable is my C code, but should probable work on
any POSIX-complient system.
If you know how to make the code more portable, or support other
debuggers on other OSes please send patches.
=head1 ACKNOWLEDGEMENTS
The idea has been borrowed from the GNOME's gnome-crash project, which
is used to automatically extract a backtrace when reporting a bug.
Parts of the C non-blocking-read implementation were borrowed from
Matt Sergeant's PPerl project.
=head1 AUTHOR
Stas Bekman E<lt>stas@stason.orgE<gt>
=head1 SEE ALSO
perl(3), C<Debug::DumpCore(3)>.
=cut