mirror of
https://github.com/MariaDB/server.git
synced 2025-07-29 05:21:33 +03:00
Merge branch '10.3' into 10.4
This commit is contained in:
@ -19,9 +19,143 @@ package My::CoreDump;
|
||||
use strict;
|
||||
use Carp;
|
||||
use My::Platform;
|
||||
use Text::Wrap;
|
||||
use Data::Dumper;
|
||||
|
||||
use File::Temp qw/ tempfile tempdir /;
|
||||
use File::Find;
|
||||
use File::Basename;
|
||||
use mtr_results;
|
||||
use mtr_report;
|
||||
|
||||
my %opts;
|
||||
my %config;
|
||||
my $help = "\n\nOptions for printing core dumps\n\n";
|
||||
|
||||
sub register_opt($$$) {
|
||||
my ($name, $format, $msg)= @_;
|
||||
my @names= split(/\|/, $name);
|
||||
my $option_name= $names[0];
|
||||
$option_name=~ s/-/_/;
|
||||
$opts{$name. $format}= \$config{$option_name};
|
||||
$help.= wrap(sprintf(" %-23s", join(', ', @names)), ' 'x25, "$msg\n");
|
||||
}
|
||||
|
||||
# To preserve order we use array instead of hash
|
||||
my @print_formats= (
|
||||
short => {
|
||||
description => "Failing stack trace",
|
||||
codes => {}
|
||||
},
|
||||
medium => {
|
||||
description => "All stack traces",
|
||||
codes => {}
|
||||
},
|
||||
detailed => {
|
||||
description => "All stack traces with debug context",
|
||||
codes => {}
|
||||
},
|
||||
custom => {
|
||||
description => "Custom debugger script for printing stack"
|
||||
},
|
||||
# 'no' must be last (check generated help)
|
||||
no => {
|
||||
description => "Skip stack trace printing"
|
||||
}
|
||||
);
|
||||
|
||||
# TODO: make class for each {method, get_code}
|
||||
my @print_methods= (IS_WINDOWS) ? (cdb => { method => \&_cdb }) : (
|
||||
gdb => {
|
||||
method => \&_gdb,
|
||||
get_code => \&_gdb_format,
|
||||
},
|
||||
dbx => {
|
||||
method => \&_dbx
|
||||
},
|
||||
lldb => {
|
||||
method => \&_lldb
|
||||
},
|
||||
# 'auto' must be last (check generated help)
|
||||
auto => {
|
||||
method => \&_auto
|
||||
}
|
||||
);
|
||||
|
||||
# But we also use hash
|
||||
my %print_formats= @print_formats;
|
||||
my %print_methods= @print_methods;
|
||||
|
||||
# and scalar
|
||||
my $x= 0;
|
||||
my $print_formats= join(', ', grep { ++$x % 2 } @print_formats);
|
||||
$x= 0;
|
||||
my $print_methods= join(', ', grep { ++$x % 2 } @print_methods);
|
||||
|
||||
# Fill 'short' and 'detailed' formats per each print_method
|
||||
# that has interface for that
|
||||
for my $f (keys %print_formats)
|
||||
{
|
||||
next unless exists $print_formats{$f}->{codes};
|
||||
for my $m (keys %print_methods)
|
||||
{
|
||||
next unless exists $print_methods{$m}->{get_code};
|
||||
# That calls f.ex. _gdb_format('short')
|
||||
# and assigns { gdb => value-of-_gdb_format } into $print_formats{short}->{format}:
|
||||
$print_formats{$f}->{codes}->{$m}= $print_methods{$m}->{get_code}->($f);
|
||||
}
|
||||
}
|
||||
|
||||
register_opt('print-core|C', ':s',
|
||||
"Print core dump format: ". $print_formats. " (for not printing cores). ".
|
||||
"Defaults to value of MTR_PRINT_CORE or 'short'");
|
||||
if (!IS_WINDOWS)
|
||||
{
|
||||
register_opt('print-method', '=s',
|
||||
"Print core method: ". join(', ', $print_methods). " (try each method until success). ".
|
||||
"Defaults to 'auto'");
|
||||
}
|
||||
|
||||
sub options() { %opts }
|
||||
sub help() { $help }
|
||||
|
||||
|
||||
sub env_or_default($$) {
|
||||
my ($default, $env)= @_;
|
||||
if (exists $ENV{$env}) {
|
||||
my $f= $ENV{$env};
|
||||
$f= 'custom'
|
||||
if $f =~ m/^custom:/;
|
||||
return $ENV{$env}
|
||||
if exists $print_formats{$f};
|
||||
mtr_verbose("$env value ignored: $ENV{$env}");
|
||||
}
|
||||
return $default;
|
||||
}
|
||||
|
||||
sub pre_setup() {
|
||||
$config{print_core}= env_or_default('short', 'MTR_PRINT_CORE')
|
||||
if not defined $config{print_core};
|
||||
$config{print_method}= (IS_WINDOWS) ? 'cdb' : 'auto'
|
||||
if not defined $config{print_method};
|
||||
# If the user has specified 'custom' we fill appropriate print_format
|
||||
# and that will be used automatically
|
||||
# Note: this can assign 'custom' to method 'auto'.
|
||||
if ($config{print_core} =~ m/^custom:(.+)$/) {
|
||||
$config{print_core}= 'custom';
|
||||
$print_formats{'custom'}= {
|
||||
$config{print_method} => $1
|
||||
}
|
||||
}
|
||||
mtr_error "Wrong value for --print-core: $config{print_core}"
|
||||
if not exists $print_formats{$config{print_core}};
|
||||
mtr_error "Wrong value for --print-method: $config{print_method}"
|
||||
if not exists $print_methods{$config{print_method}};
|
||||
|
||||
mtr_debug(Data::Dumper->Dump(
|
||||
[\%config, \%print_formats, \%print_methods],
|
||||
[qw(config print_formats print_methods)]));
|
||||
}
|
||||
|
||||
my $hint_mysqld; # Last resort guess for executable path
|
||||
|
||||
@ -50,8 +184,38 @@ sub _verify_binpath {
|
||||
return $binpath;
|
||||
}
|
||||
|
||||
|
||||
# Returns GDB code according to specified format
|
||||
|
||||
# Note: this is like simple hash, separate interface was made
|
||||
# in advance for implementing below TODO
|
||||
|
||||
# TODO: _gdb_format() and _gdb() should be separate class
|
||||
# (like the other printing methods)
|
||||
|
||||
sub _gdb_format($) {
|
||||
my ($format)= @_;
|
||||
my %formats= (
|
||||
short => "bt\n",
|
||||
medium => "thread apply all bt\n",
|
||||
detailed =>
|
||||
"bt\n".
|
||||
"set print sevenbit on\n".
|
||||
"set print static-members off\n".
|
||||
"set print frame-arguments all\n".
|
||||
"thread apply all bt full\n".
|
||||
"quit\n"
|
||||
);
|
||||
confess "Unknown format: ". $format
|
||||
unless exists $formats{$format};
|
||||
return $formats{$format};
|
||||
}
|
||||
|
||||
|
||||
sub _gdb {
|
||||
my ($core_name)= @_;
|
||||
my ($core_name, $code)= @_;
|
||||
confess "Undefined format"
|
||||
unless defined $code;
|
||||
|
||||
# Check that gdb exists
|
||||
`gdb --version`;
|
||||
@ -61,7 +225,7 @@ sub _gdb {
|
||||
}
|
||||
|
||||
if (-f $core_name) {
|
||||
print "\nTrying 'gdb' to get a backtrace from coredump $core_name\n";
|
||||
mtr_verbose("Trying 'gdb' to get a backtrace from coredump $core_name");
|
||||
} else {
|
||||
print "\nCoredump $core_name does not exist, cannot run 'gdb'\n";
|
||||
return;
|
||||
@ -76,13 +240,7 @@ sub _gdb {
|
||||
|
||||
# Create tempfile containing gdb commands
|
||||
my ($tmp, $tmp_name) = tempfile();
|
||||
print $tmp
|
||||
"bt\n",
|
||||
"set print sevenbit on\n",
|
||||
"set print static-members off\n",
|
||||
"set print frame-arguments all\n",
|
||||
"thread apply all bt full\n",
|
||||
"quit\n";
|
||||
print $tmp $code;
|
||||
close $tmp or die "Error closing $tmp_name: $!";
|
||||
|
||||
# Run gdb
|
||||
@ -105,7 +263,7 @@ EOF
|
||||
|
||||
|
||||
sub _dbx {
|
||||
my ($core_name)= @_;
|
||||
my ($core_name, $format)= @_;
|
||||
|
||||
print "\nTrying 'dbx' to get a backtrace\n";
|
||||
|
||||
@ -167,7 +325,7 @@ sub cdb_check {
|
||||
|
||||
|
||||
sub _cdb {
|
||||
my ($core_name)= @_;
|
||||
my ($core_name, $format)= @_;
|
||||
print "\nTrying 'cdb' to get a backtrace\n";
|
||||
return unless -f $core_name;
|
||||
|
||||
@ -304,38 +462,82 @@ EOF
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub show {
|
||||
my ($class, $core_name, $exe_mysqld, $parallel)= @_;
|
||||
$hint_mysqld= $exe_mysqld;
|
||||
|
||||
# On Windows, rely on cdb to be there...
|
||||
if (IS_WINDOWS)
|
||||
sub _auto
|
||||
{
|
||||
my ($core_name, $code, $rest)= @_;
|
||||
# We use ordered array @print_methods and omit auto itself
|
||||
my @valid_methods= @print_methods[0 .. $#print_methods - 2];
|
||||
my $x= 0;
|
||||
my @methods= grep { ++$x % 2} @valid_methods;
|
||||
my $f= $config{print_core};
|
||||
foreach my $m (@methods)
|
||||
{
|
||||
_cdb($core_name);
|
||||
return;
|
||||
}
|
||||
|
||||
# We try dbx first; gdb itself may coredump if run on a Sun Studio
|
||||
# compiled binary on Solaris.
|
||||
|
||||
my @debuggers =
|
||||
(
|
||||
\&_dbx,
|
||||
\&_gdb,
|
||||
\&_lldb,
|
||||
# TODO...
|
||||
);
|
||||
|
||||
# Try debuggers until one succeeds
|
||||
|
||||
foreach my $debugger (@debuggers){
|
||||
if ($debugger->($core_name)){
|
||||
my $debugger= $print_methods{$m};
|
||||
confess "Broken @print_methods"
|
||||
if $debugger->{method} == \&_auto;
|
||||
# If we didn't find format for 'auto' (that is only possible for 'custom')
|
||||
# we get format for specific debugger
|
||||
if (not defined $code && defined $print_formats{$f} and
|
||||
exists $print_formats{$f}->{codes}->{$m})
|
||||
{
|
||||
$code= $print_formats{$f}->{codes}->{$m};
|
||||
}
|
||||
mtr_verbose2("Trying to print with method ${m}:${f}");
|
||||
if ($debugger->{method}->($core_name, $code)) {
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub show {
|
||||
my ($core_name, $exe_mysqld, $parallel)= @_;
|
||||
if ($config{print_core} ne 'no') {
|
||||
my $f= $config{print_core};
|
||||
my $m= $config{print_method};
|
||||
my $code= undef;
|
||||
if (exists $print_formats{$f}->{codes} and
|
||||
exists $print_formats{$f}->{codes}->{$m}) {
|
||||
$code= $print_formats{$f}->{codes}->{$m};
|
||||
}
|
||||
mtr_verbose2("Printing core with method ${m}:${f}");
|
||||
mtr_debug("code: ${code}");
|
||||
$print_methods{$m}->{method}->($core_name, $code);
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
|
||||
sub core_wanted($$$$$) {
|
||||
my ($num_saved_cores, $opt_max_save_core, $compress,
|
||||
$exe_mysqld, $opt_parallel)= @_;
|
||||
my $core_file= $File::Find::name;
|
||||
my $core_name= basename($core_file);
|
||||
|
||||
# Name beginning with core, not ending in .gz
|
||||
if (($core_name =~ /^core/ and $core_name !~ /\.gz$/)
|
||||
or (IS_WINDOWS and $core_name =~ /\.dmp$/))
|
||||
{
|
||||
# Ending with .dmp
|
||||
mtr_report(" - found '$core_name'",
|
||||
"($$num_saved_cores/$opt_max_save_core)");
|
||||
|
||||
show($core_file, $exe_mysqld, $opt_parallel);
|
||||
|
||||
# Limit number of core files saved
|
||||
if ($$num_saved_cores >= $opt_max_save_core)
|
||||
{
|
||||
mtr_report(" - deleting it, already saved",
|
||||
"$opt_max_save_core");
|
||||
unlink("$core_file");
|
||||
}
|
||||
else
|
||||
{
|
||||
main::mtr_compress_file($core_file) if $compress;
|
||||
++$$num_saved_cores;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
@ -5,6 +5,7 @@ use warnings;
|
||||
use Text::Wrap;
|
||||
use Cwd;
|
||||
use My::Platform;
|
||||
use mtr_report;
|
||||
|
||||
# 1. options to support:
|
||||
# --xxx[=ARGS]
|
||||
@ -105,6 +106,10 @@ EEE
|
||||
|
||||
my %opts;
|
||||
my %opt_vals;
|
||||
my $debugger;
|
||||
my $boot_debugger;
|
||||
my $client_debugger;
|
||||
|
||||
my $help = "\n\nOptions for running debuggers\n\n";
|
||||
|
||||
for my $k (sort keys %debuggers) {
|
||||
@ -161,7 +166,7 @@ sub do_args($$$$$) {
|
||||
if ($v->{script}) {
|
||||
::mtr_tonewfile($vars{script}, subst($v->{script}, %vars)."\n".$script);
|
||||
} elsif ($script) {
|
||||
die "$k is not using a script file, nowhere to write the script \n---\n$script\n---\n";
|
||||
mtr_error "$k is not using a script file, nowhere to write the script \n---\n$script\n---";
|
||||
}
|
||||
|
||||
my $options = subst($v->{options}, %vars);
|
||||
@ -186,24 +191,61 @@ sub help() { $help }
|
||||
sub fix_options(@) {
|
||||
my $re=join '|', keys %opts;
|
||||
$re =~ s/=s//g;
|
||||
# FIXME: what is '=;'? What about ':s' to denote optional argument in register_opt()
|
||||
map { $_ . (/^--($re)$/ and '=;') } @_;
|
||||
}
|
||||
|
||||
sub pre_setup() {
|
||||
my $used;
|
||||
my %options;
|
||||
my %client_options;
|
||||
my %boot_options;
|
||||
|
||||
my $embedded= $::opt_embedded_server ? ' with --embedded' : '';
|
||||
|
||||
for my $k (keys %debuggers) {
|
||||
for my $opt ($k, "manual-$k", "boot-$k", "client-$k") {
|
||||
if ($opt_vals{$opt})
|
||||
{
|
||||
my $val= $opt_vals{$opt};
|
||||
if ($val) {
|
||||
$used = 1;
|
||||
if ($debuggers{$k}->{pre}) {
|
||||
$debuggers{$k}->{pre}->();
|
||||
delete $debuggers{$k}->{pre};
|
||||
}
|
||||
if ($opt eq $k) {
|
||||
$options{$opt}= $val;
|
||||
$client_options{$opt}= $val
|
||||
if $embedded;
|
||||
} elsif ($opt eq "manual-$k") {
|
||||
$options{$opt}= $val;
|
||||
} elsif ($opt eq "boot-$k") {
|
||||
$boot_options{$opt}= $val;
|
||||
} elsif ($opt eq "client-$k") {
|
||||
$client_options{$opt}= $val;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if ((keys %options) > 1) {
|
||||
mtr_error "Multiple debuggers specified: ",
|
||||
join (" ", map { "--$_" } keys %options);
|
||||
}
|
||||
|
||||
if ((keys %boot_options) > 1) {
|
||||
mtr_error "Multiple boot debuggers specified: ",
|
||||
join (" ", map { "--$_" } keys %boot_options);
|
||||
}
|
||||
|
||||
if ((keys %client_options) > 1) {
|
||||
mtr_error "Multiple client debuggers specified: ",
|
||||
join (" ", map { "--$_" } keys %client_options);
|
||||
}
|
||||
|
||||
$debugger= (keys %options)[0];
|
||||
$boot_debugger= (keys %boot_options)[0];
|
||||
$client_debugger= (keys %client_options)[0];
|
||||
|
||||
if ($used) {
|
||||
$ENV{ASAN_OPTIONS}= 'abort_on_error=1:'.($ENV{ASAN_OPTIONS} || '');
|
||||
::mtr_error("Can't use --extern when using debugger") if $ENV{USE_RUNNING_SERVER};
|
||||
@ -219,49 +261,20 @@ sub pre_setup() {
|
||||
|
||||
sub setup_boot_args($$$) {
|
||||
my ($args, $exe, $input) = @_;
|
||||
my $found;
|
||||
|
||||
for my $k (keys %debuggers) {
|
||||
if ($opt_vals{"boot-$k"}) {
|
||||
die "--boot-$k and --$found cannot be used at the same time\n" if $found;
|
||||
|
||||
$found="boot-$k";
|
||||
do_args($args, $exe, $input, 'bootstrap', $found);
|
||||
}
|
||||
}
|
||||
do_args($args, $exe, $input, 'bootstrap', $boot_debugger)
|
||||
if defined $boot_debugger;
|
||||
}
|
||||
|
||||
sub setup_client_args($$) {
|
||||
my ($args, $exe) = @_;
|
||||
my $found;
|
||||
my $embedded = $::opt_embedded_server ? ' with --embedded' : '';
|
||||
|
||||
for my $k (keys %debuggers) {
|
||||
my @opt_names=("client-$k");
|
||||
push @opt_names, $k if $embedded;
|
||||
for my $opt (@opt_names) {
|
||||
if ($opt_vals{$opt}) {
|
||||
die "--$opt and --$found cannot be used at the same time$embedded\n" if $found;
|
||||
$found=$opt;
|
||||
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $found);
|
||||
}
|
||||
}
|
||||
}
|
||||
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $client_debugger)
|
||||
if defined $client_debugger;
|
||||
}
|
||||
|
||||
sub setup_args($$$) {
|
||||
my ($args, $exe, $type) = @_;
|
||||
my $found;
|
||||
|
||||
for my $k (keys %debuggers) {
|
||||
for my $opt ($k, "manual-$k") {
|
||||
if ($opt_vals{$opt}) {
|
||||
die "--$opt and --$found cannot be used at the same time\n" if $found;
|
||||
$found=$opt;
|
||||
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $found);
|
||||
}
|
||||
}
|
||||
}
|
||||
do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $debugger)
|
||||
if defined $debugger;
|
||||
}
|
||||
|
||||
1;
|
||||
|
Reference in New Issue
Block a user