1
0
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:
Oleksandr Byelkin
2022-07-27 11:02:57 +02:00
267 changed files with 17524 additions and 7380 deletions

View File

@ -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;

View File

@ -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;