summaryrefslogtreecommitdiffstats
path: root/mysql-test/lib/My
diff options
context:
space:
mode:
authorDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-13 12:24:36 +0000
committerDaniel Baumann <daniel.baumann@progress-linux.org>2024-04-13 12:24:36 +0000
commit06eaf7232e9a920468c0f8d74dcf2fe8b555501c (patch)
treee2c7b5777f728320e5b5542b6213fd3591ba51e2 /mysql-test/lib/My
parentInitial commit. (diff)
downloadmariadb-06eaf7232e9a920468c0f8d74dcf2fe8b555501c.tar.xz
mariadb-06eaf7232e9a920468c0f8d74dcf2fe8b555501c.zip
Adding upstream version 1:10.11.6.upstream/1%10.11.6
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'mysql-test/lib/My')
-rw-r--r--mysql-test/lib/My/Config.pm544
-rw-r--r--mysql-test/lib/My/ConfigFactory.pm483
-rw-r--r--mysql-test/lib/My/CoreDump.pm516
-rw-r--r--mysql-test/lib/My/Debugger.pm287
-rw-r--r--mysql-test/lib/My/File/Path.pm225
-rw-r--r--mysql-test/lib/My/Find.pm246
-rw-r--r--mysql-test/lib/My/Handles.pm71
-rw-r--r--mysql-test/lib/My/Options.pm179
-rw-r--r--mysql-test/lib/My/Platform.pm299
-rw-r--r--mysql-test/lib/My/SafeProcess.pm640
-rw-r--r--mysql-test/lib/My/SafeProcess/Base.pm227
-rw-r--r--mysql-test/lib/My/SafeProcess/CMakeLists.txt50
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_kill_win.cc146
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_process.cc364
-rw-r--r--mysql-test/lib/My/SafeProcess/safe_process_win.cc389
-rw-r--r--mysql-test/lib/My/SafeProcess/wsrep_check_version.c51
-rw-r--r--mysql-test/lib/My/Suite.pm27
-rw-r--r--mysql-test/lib/My/SysInfo.pm206
-rw-r--r--mysql-test/lib/My/Tee.pm25
-rw-r--r--mysql-test/lib/My/Test.pm120
20 files changed, 5095 insertions, 0 deletions
diff --git a/mysql-test/lib/My/Config.pm b/mysql-test/lib/My/Config.pm
new file mode 100644
index 00000000..c88b1170
--- /dev/null
+++ b/mysql-test/lib/My/Config.pm
@@ -0,0 +1,544 @@
+# -*- cperl -*-
+
+# Copyright (c) 2007, 2010, Oracle and/or its affiliates
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::Config::Option;
+
+use strict;
+use warnings;
+use Carp;
+
+# Define all MariaDB options that the user should be able to specify
+# many times in the config file. Note that options must be written
+# using '-' instead of '_' here!
+
+my %multipart_options=
+ (
+ "plugin-load-add" => 1,
+ "optimizer-switch" => 1,
+);
+
+
+sub new {
+ my ($class, $option_name, $option_value)= @_;
+ my $self= bless { name => $option_name,
+ value => $option_value
+ }, $class;
+ return $self;
+}
+
+
+sub name {
+ my ($self)= @_;
+ return $self->{name};
+}
+
+
+sub value {
+ my ($self)= @_;
+ return $self->{value};
+}
+
+sub option {
+ my ($self)= @_;
+ my $name= $self->{name};
+ my $value= $self->{value};
+
+ my $opt= $name;
+ $opt= "$name=$value" if (defined $value);
+ $opt= "--$opt" unless ($opt =~ /^--/);
+ return $opt;
+}
+
+package My::Config::Group;
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my ($class, $group_name)= @_;
+ my $self= bless { name => $group_name,
+ options => [],
+ options_by_name => {},
+ }, $class;
+ return $self;
+}
+
+
+sub insert {
+ my ($self, $option_name, $value, $if_not_exist)= @_;
+ my $option= $self->option($option_name);
+ if (defined($option) and !$if_not_exist) {
+ $option->{value}= $value;
+ }
+ else {
+ $option= My::Config::Option->new($option_name, $value);
+ # Insert option in list
+ push(@{$self->{options}}, $option);
+ # Insert option in hash
+ $self->{options_by_name}->{$option_name}= $option;
+ }
+ return $option;
+}
+
+sub remove {
+ my ($self, $option_name)= @_;
+
+ # Check that option exists
+ my $option= $self->option($option_name);
+
+ return undef unless defined $option;
+
+ # Remove from the hash
+ delete($self->{options_by_name}->{$option_name}) or croak;
+
+ # Remove from the array
+ @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}};
+
+ return $option;
+}
+
+
+sub options {
+ my ($self)= @_;
+ return @{$self->{options}};
+}
+
+
+sub name {
+ my ($self)= @_;
+ return $self->{name};
+}
+
+sub suffix {
+ my ($self)= @_;
+ # Everything in name from the last .
+ my @parts= split(/\./, $self->{name});
+ my $suffix= pop(@parts);
+ return ".$suffix";
+}
+
+sub after {
+ my ($self, $prefix)= @_;
+ die unless defined $prefix;
+
+ # everything after $prefix
+ my $name= $self->{name};
+ if ($name =~ /^\Q$prefix\E(.*)$/)
+ {
+ return $1;
+ }
+ die "Failed to extract the value after '$prefix' in $name";
+}
+
+
+sub split {
+ my ($self)= @_;
+ # Return an array with name parts
+ return split(/\./, $self->{name});
+}
+
+#
+# Return a specific option in the group
+#
+sub option {
+ my ($self, $option_name)= @_;
+
+ return $self->{options_by_name}->{$option_name};
+}
+
+
+#
+# Return value for an option in the group, fail if it does not exist
+#
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ croak "No option named '$option_name' in group '$self->{name}'"
+ if ! defined($option);
+
+ return $option->value();
+}
+
+#
+# Return value for an option if it exist
+#
+sub if_exist {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ return undef if ! defined($option);
+
+ return $option->value();
+}
+
+package My::Config::Group::ENV;
+our @ISA=qw(My::Config::Group);
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my ($class, $group_name)= @_;
+ bless My::Config::Group->new($group_name), $class;
+}
+
+#
+# Return value for an option in the group, fail if it does not exist
+#
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ if (! defined($option)) {
+ my $value= $ENV{$option_name};
+ $option= My::Config::Option->new($option_name, $value);
+ }
+ return $option->value();
+}
+
+package My::Config::Group::OPT;
+our @ISA=qw(My::Config::Group);
+
+use strict;
+use warnings;
+use Carp;
+
+sub new {
+ my ($class, $group_name)= @_;
+ bless My::Config::Group->new($group_name), $class;
+}
+
+sub options {
+ my ($self)= @_;
+ ()
+}
+
+sub value {
+ my ($self, $option_name)= @_;
+ my $option= $self->option($option_name);
+
+ croak "No option named '$option_name' in group '$self->{name}'"
+ if ! defined($option);
+
+ return $option->value()->();
+}
+
+package My::Config;
+
+use strict;
+use warnings;
+use Carp;
+use IO::File;
+use File::Basename;
+
+#
+# Constructor for My::Config
+# - represents a my.cnf config file
+#
+# Array of arrays
+#
+sub new {
+ my ($class, $path)= @_;
+ my $group_name= undef;
+
+ my $self= bless { groups => [
+ My::Config::Group::ENV->new('ENV'),
+ My::Config::Group::OPT->new('OPT'),
+ ] }, $class;
+ my $F= IO::File->new($path, "<")
+ or croak "Could not open '$path': $!";
+
+ while ( my $line= <$F> ) {
+ chomp($line);
+ # Remove any trailing CR from Windows edited files
+ $line=~ s/\cM$//;
+
+ # [group]
+ if ( $line =~ /^\[(.*)\]/ ) {
+ # New group found
+ $group_name= $1;
+ #print "group: $group_name\n";
+
+ $self->insert($group_name, undef, undef);
+ }
+
+ # Magic #! comments
+ elsif ( $line =~ /^(#\!\S+)(?:\s*(.*?)\s*)?$/) {
+ my ($magic, $arg)= ($1, $2);
+ croak "Found magic comment '$magic' outside of group"
+ unless $group_name;
+
+ #print "$magic\n";
+ $self->insert($group_name, $magic, $arg);
+ }
+
+ # Empty lines
+ elsif ( $line =~ /^$/ ) {
+ # Skip empty lines
+ next;
+ }
+
+ # !include <filename>
+ elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) {
+ my $include_file_name= dirname($path)."/".$1;
+
+ # Check that the file exists relative to path of first config file
+ if (! -f $include_file_name){
+ # Try to include file relativ to current dir
+ $include_file_name= $1;
+ }
+ croak "The include file '$include_file_name' does not exist"
+ unless -f $include_file_name;
+
+ $self->append(My::Config->new($include_file_name));
+ }
+
+ # <option>
+ elsif ( $line =~ /^(#?[\w-]+)\s*$/ ) {
+ my $option= $1;
+
+ croak "Found option '$option' outside of group"
+ unless $group_name;
+
+ #print "$option\n";
+ $self->insert($group_name, $option, undef);
+ }
+
+ # <option>=<value>
+ elsif ( $line =~ /^(#?[\w-]+)\s*=\s*(.*?)\s*$/ ) {
+ my $option= $1;
+ my $value= $2;
+
+ croak "Found option '$option=$value' outside of group"
+ unless $group_name;
+
+ #print "$option=$value\n";
+ $self->insert($group_name, $option, $value);
+ }
+
+ # Comments
+ elsif ( $line =~ /^#/ || $line =~ /^;/) {
+ # Skip comment
+ next;
+ }
+ # Correctly process Replication Filter when they are defined
+ # with connection name.
+ elsif ( $line =~ /^([\w]+.[\w]+)\s*=\s*(.*)\s*/){
+ my $option= $1;
+ my $value= $2;
+ $self->insert($group_name, $option, $value);
+ }
+ else {
+ croak "Unexpected line '$line' found in '$path'";
+ }
+ }
+ undef $F; # Close the file
+
+ return $self;
+}
+
+#
+# Insert a new group if it does not already exist
+# and add option if defined
+#
+sub insert {
+ my ($self, $group_name, $option, $value, $if_not_exist)= @_;
+ my $group;
+
+ # Create empty array for the group if it doesn't exist
+ if ( !$self->group_exists($group_name) ) {
+ $group= $self->_group_insert($group_name);
+ }
+ else {
+ $group= $self->group($group_name);
+ }
+
+ if ( defined $option ) {
+ #print "option: $option, value: $value\n";
+ my $tmp_option= $option;
+ $tmp_option =~ s/_/-/g;
+
+ # If the option is an option that one can specify many times, always add
+ $if_not_exist= 1 if ($multipart_options{$tmp_option});
+
+ # Add the option to the group
+ $group->insert($option, $value, $if_not_exist);
+ }
+ return $group;
+}
+
+#
+# Remove a option, given group and option name
+#
+sub remove {
+ my ($self, $group_name, $option_name)= @_;
+ my $group= $self->group($group_name);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ $group->remove($option_name) or
+ croak "option '$option_name' does not exist";
+}
+
+
+
+#
+# Check if group with given name exists in config
+#
+sub group_exists {
+ my ($self, $group_name)= @_;
+
+ foreach my $group ($self->groups()) {
+ return 1 if $group->{name} eq $group_name;
+ }
+ return 0;
+}
+
+
+#
+# Insert a new group into config
+#
+sub _group_insert {
+ my ($self, $group_name)= @_;
+ caller eq __PACKAGE__ or croak;
+
+ # Check that group does not already exist
+ croak "Group already exists" if $self->group_exists($group_name);
+
+ my $group= My::Config::Group->new($group_name);
+ push(@{$self->{groups}}, $group);
+ return $group;
+}
+
+
+#
+# Append a configuration to current config
+#
+sub append {
+ my ($self, $from)= @_;
+
+ foreach my $group ($from->groups()) {
+ foreach my $option ($group->options()) {
+ $self->insert($group->name(), $option->name(), $option->value());
+ }
+
+ }
+}
+
+
+#
+# Return a list with all the groups in config
+#
+sub groups {
+ my ($self)= @_;
+ return ( @{$self->{groups}} );
+}
+
+
+#
+# Return a list with "real" groups in config, those
+# that should be written to a my.cnf file, those that contain options.
+# Same as groups() but without auto-generated groups like ENV or OPT.
+#
+sub option_groups {
+ my ($self)= @_;
+ return ( grep { ref $_ eq 'My::Config::Group' } @{$self->{groups}} );
+}
+
+
+#
+# Return a list of all the groups in config
+# starting with the given string
+#
+sub like {
+ my ($self, $prefix)= @_;
+ return ( grep ( $_->{name} =~ /^$prefix/, $self->groups()) );
+}
+
+
+#
+# Return the first group in config
+# starting with the given string
+#
+sub first_like {
+ my ($self, $prefix)= @_;
+ return ($self->like($prefix))[0];
+}
+
+
+#
+# Return a specific group in the config
+#
+sub group {
+ my ($self, $group_name)= @_;
+
+ foreach my $group ( $self->groups() ) {
+ return $group if $group->{name} eq $group_name;
+ }
+ return undef;
+}
+
+
+#
+# Return a list of all options in a specific group in the config
+#
+sub options_in_group {
+ my ($self, $group_name)= @_;
+
+ my $group= $self->group($group_name);
+ return () unless defined $group;
+ return $group->options();
+}
+
+
+#
+# Return a value given group and option name
+#
+sub value {
+ my ($self, $group_name, $option_name)= @_;
+ my $group= $self->group($group_name);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ my $option= $group->option($option_name);
+ croak "option '$option_name' does not exist"
+ unless defined($option);
+
+ return $option->value();
+}
+
+
+#
+# Check if an option exists
+#
+sub exists {
+ my ($self, $group_name, $option_name)= @_;
+ my $group= $self->group($group_name);
+
+ croak "group '$group_name' does not exist"
+ unless defined($group);
+
+ my $option= $group->option($option_name);
+ return defined($option);
+}
+
+1;
diff --git a/mysql-test/lib/My/ConfigFactory.pm b/mysql-test/lib/My/ConfigFactory.pm
new file mode 100644
index 00000000..5a5b6919
--- /dev/null
+++ b/mysql-test/lib/My/ConfigFactory.pm
@@ -0,0 +1,483 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library General Public
+# License as published by the Free Software Foundation; version 2
+# of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Library General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::ConfigFactory;
+
+use strict;
+use warnings;
+use Carp;
+
+use My::Config;
+use My::Find;
+use My::Platform;
+
+use File::Basename;
+
+
+#
+# Rules to run first of all
+#
+
+sub add_opt_values {
+ my ($self, $config)= @_;
+
+ # add auto-options
+ $config->insert('OPT', 'port' => sub { fix_port($self, $config) });
+ $config->insert('mysqld', "loose-skip-plugin-$_" => undef) for (@::optional_plugins);
+}
+
+my @pre_rules=
+(
+ \&add_opt_values,
+);
+
+
+my @share_locations= ("share/mariadb", "share/mysql", "sql/share", "share");
+
+
+sub get_basedir {
+ my ($self, $group)= @_;
+ my $basedir= $group->if_exist('basedir') ||
+ $self->{ARGS}->{basedir};
+ return $basedir;
+}
+
+sub get_testdir {
+ my ($self, $group)= @_;
+ my $testdir= $group->if_exist('testdir') ||
+ $self->{ARGS}->{testdir};
+ return $testdir;
+}
+
+# Retrive build directory (which is different from basedir in out-of-source build)
+sub get_bindir {
+ if (defined $ENV{MTR_BINDIR})
+ {
+ return $ENV{MTR_BINDIR};
+ }
+ my ($self, $group)= @_;
+ return $self->get_basedir($group);
+}
+
+sub fix_charset_dir {
+ my ($self, $config, $group_name, $group)= @_;
+ return my_find_dir($self->get_basedir($group),
+ \@share_locations, "charsets");
+}
+
+sub fix_language {
+ my ($self, $config, $group_name, $group)= @_;
+ return my_find_dir($self->get_bindir($group),
+ \@share_locations);
+}
+
+sub fix_datadir {
+ my ($self, $config, $group_name)= @_;
+ my $vardir= $self->{ARGS}->{vardir};
+ return "$vardir/$group_name/data";
+}
+
+sub fix_pidfile {
+ my ($self, $config, $group_name, $group)= @_;
+ my $vardir= $self->{ARGS}->{vardir};
+ return "$vardir/run/$group_name.pid";
+}
+
+sub fix_port {
+ my ($self, $config, $group_name, $group)= @_;
+ return $self->{PORT}++;
+}
+
+sub fix_host {
+ my ($self)= @_;
+ 'localhost'
+}
+
+sub is_unique {
+ my ($config, $name, $value)= @_;
+
+ foreach my $group ( $config->groups() ) {
+ if ($group->option($name)) {
+ if ($group->value($name) eq $value){
+ return 0;
+ }
+ }
+ }
+ return 1;
+}
+
+sub fix_server_id {
+ my ($self, $config, $group_name, $group)= @_;
+#define in the order that mysqlds are listed in my.cnf
+
+ my $server_id= $group->if_exist('server-id');
+ if (defined $server_id){
+ if (!is_unique($config, 'server-id', $server_id)) {
+ croak "The server-id($server_id) for '$group_name' is not unique";
+ }
+ return $server_id;
+ }
+
+ do {
+ $server_id= $self->{SERVER_ID}++;
+ } while(!is_unique($config, 'server-id', $server_id));
+
+ #print "$group_name: server_id: $server_id\n";
+ return $server_id;
+}
+
+sub fix_socket {
+ my ($self, $config, $group_name, $group)= @_;
+ # Put socket file in tmpdir
+ my $dir= $self->{ARGS}->{tmpdir};
+ return "$dir/$group_name.sock";
+}
+
+sub fix_tmpdir {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= $self->{ARGS}->{tmpdir};
+ return "$dir/$group_name";
+}
+
+sub fix_log_error {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= $self->{ARGS}->{vardir};
+ if ( $::opt_valgrind and $::opt_debug ) {
+ return "$dir/log/$group_name.trace";
+ } else {
+ return "$dir/log/$group_name.err";
+ }
+}
+
+sub fix_log {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= dirname($group->value('datadir'));
+ return "$dir/mysqld.log";
+}
+
+sub fix_bind_address {
+ if (IS_WINDOWS) {
+ return "*";
+ } else {
+ return "127.0.0.1";
+ }
+}
+sub fix_log_slow_queries {
+ my ($self, $config, $group_name, $group)= @_;
+ my $dir= dirname($group->value('datadir'));
+ return "$dir/mysqld-slow.log";
+}
+
+#
+# Rules to run for each mysqld in the config
+# - will be run in order listed here
+#
+my @mysqld_rules=
+ (
+ { 'basedir' => sub { return shift->{ARGS}->{basedir}; } },
+ { 'tmpdir' => \&fix_tmpdir },
+ { 'character-sets-dir' => \&fix_charset_dir },
+ { 'lc-messages-dir' => \&fix_language },
+ { 'datadir' => \&fix_datadir },
+ { 'pid-file' => \&fix_pidfile },
+ { '#host' => \&fix_host },
+ { 'port' => \&fix_port },
+ { 'socket' => \&fix_socket },
+ { 'log-error' => \&fix_log_error },
+ { 'general-log' => 1 },
+ { 'plugin-dir' => sub { $::plugindir } },
+ { 'general-log-file' => \&fix_log },
+ { 'slow-query-log' => 1 },
+ { 'slow-query-log-file' => \&fix_log_slow_queries },
+ { '#user' => sub { return shift->{ARGS}->{user} || ""; } },
+ { '#password' => sub { return shift->{ARGS}->{password} || ""; } },
+ { 'server-id' => \&fix_server_id, },
+ { 'bind-address' => \&fix_bind_address },
+ );
+
+#
+# Rules to run for [client] section
+# - will be run in order listed here
+#
+my @client_rules=
+(
+ { 'character-sets-dir' => \&fix_charset_dir },
+ { 'plugin-dir' => sub { $::client_plugindir } },
+);
+
+
+#
+# Rules to run for [mysqltest] section
+# - will be run in order listed here
+#
+my @mysqltest_rules=
+(
+);
+
+
+#
+# Rules to run for [mysqlbinlog] section
+# - will be run in order listed here
+#
+my @mysqlbinlog_rules=
+(
+);
+
+
+#
+# Rules to run for [mysql_upgrade] section
+# - will be run in order listed here
+#
+my @mysql_upgrade_rules=
+(
+ { 'tmpdir' => sub { return shift->{ARGS}->{tmpdir}; } },
+);
+
+
+#
+# Generate a [client.<suffix>] group to be
+# used for connecting to [mysqld.<suffix>]
+#
+sub post_check_client_group {
+ my ($self, $config, $client_group_name, $mysqld_group_name)= @_;
+
+
+ # Settings needed for client, copied from its "mysqld"
+ my %client_needs=
+ (
+ port => 'port',
+ socket => 'socket',
+ host => '#host',
+ user => '#user',
+ password => '#password',
+ );
+ my $group_to_copy_from= $config->group($mysqld_group_name);
+ while (my ($name_to, $name_from)= each( %client_needs )) {
+ my $option= $group_to_copy_from->option($name_from);
+
+ if (! defined $option){
+ #print $config;
+ croak "Could not get value for '$name_from' for test $self->{testname}";
+ }
+ $config->insert($client_group_name, $name_to, $option->value())
+ }
+}
+
+
+sub post_check_client_groups {
+ my ($self, $config)= @_;
+
+ my $first_mysqld= $config->first_like('mysqld\.');
+
+ return unless $first_mysqld;
+
+ # Always generate [client] pointing to the first
+ # [mysqld.<suffix>]
+ $self->post_check_client_group($config,
+ 'client',
+ $first_mysqld->name());
+
+ # Then generate [client.<suffix>] for each [mysqld.<suffix>]
+ foreach my $mysqld ( $config->like('mysqld\.') ) {
+ $self->post_check_client_group($config,
+ 'client'.$mysqld->after('mysqld'),
+ $mysqld->name())
+ }
+
+}
+
+
+#
+# Generate [embedded] by copying the values
+# needed from the default [mysqld] section
+# and from first [mysqld.<suffix>]
+#
+sub post_check_embedded_group {
+ my ($self, $config)= @_;
+
+ return unless $self->{ARGS}->{embedded};
+
+ my $mysqld= $config->group('mysqld') or
+ croak "Can't run with embedded, config has no default mysqld section";
+
+ my $first_mysqld= $config->first_like('mysqld\.') or
+ croak "Can't run with embedded, config has no mysqld";
+
+ my %no_copy = map { $_ => 1 }
+ (
+ 'log-error', # Embedded server writes stderr to mysqltest's log file
+ 'slave-net-timeout', # Embedded server are not build with replication
+ );
+
+ foreach my $option ( $mysqld->options(), $first_mysqld->options() ) {
+ # Don't copy options whose name is in "no_copy" list
+ next if $no_copy{$option->name()};
+
+ $config->insert('embedded', $option->name(), $option->value())
+ }
+
+}
+
+
+sub resolve_at_variable {
+ my ($self, $config, $group, $option)= @_;
+ local $_ = $option->value();
+ my ($res, $after);
+
+ while (m/(.*?)\@((?:\w+\.)+)(#?[-\w]+)/g) {
+ my ($before, $group_name, $option_name)= ($1, $2, $3);
+ $after = $';
+ chop($group_name);
+
+ my $from_group= $config->group($group_name)
+ or croak "There is no group named '$group_name' that ",
+ "can be used to resolve '$option_name' for test '$self->{testname}'";
+
+ my $value= $from_group->value($option_name);
+ if (!defined($value))
+ {
+ ::mtr_verbose("group: $group_name option_name: $option_name is undefined");
+ }
+ else
+ {
+ $res .= $before.$value;
+ }
+ }
+ $res .= $after;
+
+ $option->{value}= $res;
+}
+
+
+sub post_fix_resolve_at_variables {
+ my ($self, $config)= @_;
+
+ foreach my $group ( $config->groups() ) {
+ foreach my $option ( $group->options()) {
+ next unless defined $option->value();
+
+ $self->resolve_at_variable($config, $group, $option)
+ if ($option->value() =~ /\@/);
+ }
+ }
+}
+
+#
+# Rules to run last of all
+#
+my @post_rules=
+(
+ \&post_check_client_groups,
+ \&post_fix_resolve_at_variables,
+ \&post_check_embedded_group,
+);
+
+
+sub run_rules_for_group {
+ my ($self, $config, $group, @rules)= @_;
+ foreach my $hash ( @rules ) {
+ while (my ($option, $rule)= each( %{$hash} )) {
+ # Only run this rule if the value is not already defined
+ if (!$config->exists($group->name(), $option)) {
+ my $value;
+ if (ref $rule eq "CODE") {
+ # Call the rule function
+ $value= &$rule($self, $config, $group->name(),
+ $config->group($group->name()));
+ } else {
+ $value= $rule;
+ }
+ if (defined $value) {
+ $config->insert($group->name(), $option, $value, 1);
+ }
+ }
+ }
+ }
+}
+
+
+sub run_section_rules {
+ my ($self, $config, $name, @rules)= @_;
+
+ foreach my $group ( $config->like($name) ) {
+ $self->run_rules_for_group($config, $group, @rules);
+ }
+}
+
+
+sub new_config {
+ my ($class, $args)= @_;
+
+ my @required_args= ('basedir', 'baseport', 'vardir', 'template_path');
+
+ foreach my $required ( @required_args ) {
+ croak "you must pass '$required'" unless defined $args->{$required};
+ }
+
+ # Open the config template
+ my $config= My::Config->new($args->{'template_path'});
+ my $self= bless {
+ CONFIG => $config,
+ ARGS => $args,
+ PORT => $args->{baseport},
+ SERVER_ID => 1,
+ testname => $args->{testname},
+ }, $class;
+
+ # Run pre rules
+ foreach my $rule ( @pre_rules ) {
+ &$rule($self, $config);
+ }
+
+ $self->run_section_rules($config,
+ 'mysqld\.',
+ @mysqld_rules);
+
+ # [mysqlbinlog] need additional settings
+ $self->run_rules_for_group($config,
+ $config->insert('mysqlbinlog'),
+ @mysqlbinlog_rules);
+
+ # [mysql_upgrade] need additional settings
+ $self->run_rules_for_group($config,
+ $config->insert('mysql_upgrade'),
+ @mysql_upgrade_rules);
+
+ # Additional rules required for [client]
+ $self->run_rules_for_group($config,
+ $config->insert('client'),
+ @client_rules);
+
+
+ # Additional rules required for [mysqltest]
+ $self->run_rules_for_group($config,
+ $config->insert('mysqltest'),
+ @mysqltest_rules);
+
+ {
+ # Run post rules
+ foreach my $rule ( @post_rules ) {
+ &$rule($self, $config);
+ }
+ }
+
+ return $config;
+}
+
+
+1;
+
diff --git a/mysql-test/lib/My/CoreDump.pm b/mysql-test/lib/My/CoreDump.pm
new file mode 100644
index 00000000..be6d2114
--- /dev/null
+++ b/mysql-test/lib/My/CoreDump.pm
@@ -0,0 +1,516 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2013, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+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 'medium'");
+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('medium', '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
+
+# If path in core file is 79 chars we assume it's been truncated
+# Looks like we can still find the full path using 'strings'
+# If that doesn't work, use the hint (mysqld path) as last resort.
+
+sub _verify_binpath {
+ my ($binary, $core_name)= @_;
+ my $binpath;
+
+ if (length $binary != 79) {
+ $binpath= $binary;
+ print "Core generated by '$binpath'\n";
+ } else {
+ # Last occurrence of path ending in /mysql*, cut from first /
+ if (`strings '$core_name' | grep "/mysql[^/. ]*\$" | tail -1` =~ /(\/.*)/) {
+ $binpath= $1;
+ print "Guessing that core was generated by '$binpath'\n";
+ } else {
+ return unless $hint_mysqld;
+ $binpath= $hint_mysqld;
+ print "Wild guess that core was generated by '$binpath'\n";
+ }
+ }
+ 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, $code)= @_;
+ confess "Undefined format"
+ unless defined $code;
+
+ # Check that gdb exists
+ `gdb --version`;
+ if ($?) {
+ print "gdb not found, cannot get the stack trace\n";
+ return;
+ }
+
+ if (-f $core_name) {
+ 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;
+ }
+
+ # Find out name of binary that generated core
+ `gdb -c '$core_name' --batch 2>&1` =~
+ /Core was generated by `([^\s\'\`]+)/;
+ my $binary= $1 or return;
+
+ $binary= _verify_binpath ($binary, $core_name) or return;
+
+ # Create tempfile containing gdb commands
+ my ($tmp, $tmp_name) = tempfile();
+ print $tmp $code;
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ # Run gdb
+ my $gdb_output=
+ `gdb '$binary' -c '$core_name' -x '$tmp_name' --batch 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ return if $? >> 8;
+ return unless $gdb_output;
+
+ resfile_print <<EOF . $gdb_output . "\n";
+Output from gdb follows. The first stack trace is from the failing thread.
+The following stack traces are from all threads (so the failing one is
+duplicated).
+--------------------------
+EOF
+ return 1;
+}
+
+
+sub _dbx {
+ my ($core_name, $format)= @_;
+
+ print "\nTrying 'dbx' to get a backtrace\n";
+
+ return unless -f $core_name;
+
+ # Find out name of binary that generated core
+ `echo | dbx - '$core_name' 2>&1` =~
+ /Corefile specified executable: "([^"]+)"/;
+ my $binary= $1 or return;
+
+ $binary= _verify_binpath ($binary, $core_name) or return;
+
+ # Find all threads
+ my @thr_ids = `echo threads | dbx '$binary' '$core_name' 2>&1` =~ /t@\d+/g;
+
+ # Create tempfile containing dbx commands
+ my ($tmp, $tmp_name) = tempfile();
+ foreach my $thread (@thr_ids) {
+ print $tmp "where $thread\n";
+ }
+ print $tmp "exit\n";
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ # Run dbx
+ my $dbx_output=
+ `cat '$tmp_name' | dbx '$binary' '$core_name' 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ return if $? >> 8;
+ return unless $dbx_output;
+
+ resfile_print <<EOF . $dbx_output . "\n";
+Output from dbx follows. Stack trace is printed for all threads in order,
+above this you should see info about which thread was the failing one.
+----------------------------
+EOF
+ return 1;
+}
+
+
+# Check that Debugging tools for Windows are installed
+sub cdb_check {
+ `cdb -? 2>&1`;
+ if ($? >> 8)
+ {
+ print "Cannot find the cdb debugger. Please install Debugging tools for Windows\n";
+ print "and set PATH environment variable to include location of cdb.exe";
+ }
+}
+
+
+sub _cdb {
+ my ($core_name, $format)= @_;
+ print "\nTrying 'cdb' to get a backtrace\n";
+ return unless -f $core_name;
+ # Read module list, find out the name of executable and
+ # build symbol path (required by cdb if executable was built on
+ # different machine)
+ my $tmp_name= $core_name.".cdb_lmv";
+ `cdb -z $core_name -c \"lmv;q\" > $tmp_name 2>&1`;
+ if ($? >> 8)
+ {
+ unlink($tmp_name);
+ # check if cdb is installed and complain if not
+ cdb_check();
+ return;
+ }
+
+ open(temp,"< $tmp_name");
+ my %dirhash=();
+ while(<temp>)
+ {
+ if($_ =~ /Image path\: (.*)/)
+ {
+ if (rindex($1,'\\') != -1)
+ {
+ my $dir= substr($1, 0, rindex($1,'\\'));
+ $dirhash{$dir}++;
+ }
+ }
+ }
+ close(temp);
+ unlink($tmp_name);
+
+ my $image_path= join(";", (keys %dirhash),".");
+
+ # For better callstacks, setup _NT_SYMBOL_PATH to include
+ # OS symbols. Note : Dowloading symbols for the first time
+ # can take some minutes
+ if (!$ENV{'_NT_SYMBOL_PATH'})
+ {
+ my $windir= $ENV{'windir'};
+ my $symbol_cache= substr($windir ,0, index($windir,'\\'))."\\symbols";
+
+ print "OS debug symbols will be downloaded and stored in $symbol_cache.\n";
+ print "You can control the location of symbol cache with _NT_SYMBOL_PATH\n";
+ print "environment variable. Please refer to Microsoft KB article\n";
+ print "http://support.microsoft.com/kb/311503 for details about _NT_SYMBOL_PATH\n";
+ print "-------------------------------------------------------------------------\n";
+
+ $ENV{'_NT_SYMBOL_PATH'}.=
+ "srv*".$symbol_cache."*http://msdl.microsoft.com/download/symbols";
+ }
+
+ my $symbol_path= $image_path.";".$ENV{'_NT_SYMBOL_PATH'};
+
+
+ # Run cdb. Use "analyze" extension to print crashing thread stacktrace
+ # and "uniqstack" to print other threads
+
+ my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;!uniqstack -p;q";
+ my $cdb_output=
+ `cdb -c "$cdb_cmd" -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines 2>&1`;
+ return if $? >> 8;
+ return unless $cdb_output;
+
+ # Remove comments (lines starting with *), stack pointer and frame
+ # pointer adresses and offsets to function to make output better readable
+ $cdb_output=~ s/^\*.*\n//gm;
+ $cdb_output=~ s/^([\:0-9a-fA-F\`]+ )+//gm;
+ $cdb_output=~ s/^ChildEBP RetAddr//gm;
+ $cdb_output=~ s/^Child\-SP RetAddr Call Site//gm;
+ $cdb_output=~ s/\+0x([0-9a-fA-F]+)//gm;
+
+ resfile_print <<EOF . $cdb_output . "\n";
+Output from cdb follows. Faulting thread is printed twice,with and without function parameters
+Search for STACK_TEXT to see the stack trace of
+the faulting thread. Callstacks of other threads are printed after it.
+EOF
+ return 1;
+}
+
+
+sub _lldb
+{
+ my ($core_name)= @_;
+
+ print "\nTrying 'lldb' to get a backtrace from coredump $core_name\n";
+
+ # Create tempfile containing lldb commands
+ my ($tmp, $tmp_name)= tempfile();
+ print $tmp
+ "bt\n",
+ "thread backtrace all\n",
+ "quit\n";
+ close $tmp or die "Error closing $tmp_name: $!";
+
+ my $lldb_output= `lldb -c '$core_name' -s '$tmp_name' 2>&1`;
+
+ unlink $tmp_name or die "Error removing $tmp_name: $!";
+
+ if ($? == 127)
+ {
+ print "lldb not found, cannot get the stack trace\n";
+ return;
+ }
+
+ return if $?;
+ return unless $lldb_output;
+
+ resfile_print <<EOF . $lldb_output . "\n";
+Output from lldb follows. The first stack trace is from the failing thread.
+The following stack traces are from all threads (so the failing one is
+duplicated).
+--------------------------
+EOF
+ return 1;
+}
+
+
+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)
+ {
+ 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;
diff --git a/mysql-test/lib/My/Debugger.pm b/mysql-test/lib/My/Debugger.pm
new file mode 100644
index 00000000..d129aa09
--- /dev/null
+++ b/mysql-test/lib/My/Debugger.pm
@@ -0,0 +1,287 @@
+package My::Debugger;
+
+use strict;
+use warnings;
+use Text::Wrap;
+use Cwd;
+use My::Platform;
+use mtr_report;
+
+# 1. options to support:
+# --xxx[=ARGS]
+# --manual-xxx[=ARGS]
+# --client-xxx[=ARGS]
+# --boot-xxx[=ARGS]
+# TODO --manual-client-xxx[=ARGS]
+# TODO --manual-boot-xxx[=ARGS]
+# TODO --exec-xxx[=ARGS] (for $ENV{MYSQL}, etc)
+#
+# ARGS is a semicolon-separated list of commands for the
+# command file. If the first command starts from '-' it'll
+# be for a command line, not for a command file.
+#
+# 2. terminal to use: xterm
+# TODO MTR_TERM="xterm -title {title} -e {command}"
+#
+# 3. debugger combinations are *not allowed*
+# (thus no --valgrind --gdb)
+#
+# 4. variables for the command line / file templates:
+# {vardir} -> vardir
+# {exe} -> /path/to/binary/to/execute
+# {args} -> command-line arguments, "-quoted
+# {input}
+# {type} -> client, mysqld.1, etc
+# {script} -> vardir/tmp/{debugger}init.$type
+# {log} -> vardir/log/$type.{debugger}
+# {options} -> user options for the debugger.
+#
+# if {options} isn't used, they're auto-placed before {exe}
+# or at the end if no {exe}
+
+my %debuggers = (
+ gdb => {
+ term => 1,
+ options => '-x {script} {exe}',
+ script => 'set args {args} < {input}',
+ },
+ ddd => {
+ interactive => 1,
+ options => '--command {script} {exe}',
+ script => 'set args {args} < {input}',
+ },
+ dbx => {
+ term => 1,
+ options => '-c "stop in main; run {exe} {args} < {input}"',
+ },
+ devenv => {
+ interactive => 1,
+ options => '/debugexe {exe} {args}',
+ },
+ windbg => {
+ interactive => 1,
+ options => '{exe} {args}',
+ },
+ lldb => {
+ term => 1,
+ options => '-s {script} {exe}',
+ script => 'process launch --stop-at-entry -- {args}',
+ },
+ valgrind => {
+ options => '--tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions='.cwd().'/valgrind.supp {exe} {args} --loose-wait-for-pos-timeout=1500',
+ pre => sub {
+ my $debug_libraries_path= "/usr/lib/debug";
+ $ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
+ }
+ },
+ strace => {
+ options => '-f -o {log} {exe} {args}',
+ },
+ rr => {
+ options => '_RR_TRACE_DIR={log} rr record {exe} {args} --loose-skip-innodb-use-native-aio --loose-innodb-flush-method=fsync',
+ run => 'env',
+ pre => sub {
+ ::mtr_error('rr requires kernel.perf_event_paranoid <= 1')
+ if ::mtr_grab_file('/proc/sys/kernel/perf_event_paranoid') > 1;
+ }
+ },
+ valgdb => {
+ term => 1,
+ run => 'gdb',
+ options => '-x {script} {exe}',
+ script => <<EEE,
+py
+import subprocess,shlex,time
+valg=subprocess.Popen(shlex.split("""valgrind --tool=memcheck --show-reachable=yes --leak-check=yes --num-callers=16 --quiet --suppressions=valgrind.supp --vgdb-error=0 {exe} {args} --loose-wait-for-pos-timeout=1500"""))
+time.sleep(2)
+gdb.execute("target remote | vgdb --pid=" + str(valg.pid))
+EEE
+ pre => sub {
+ my $debug_libraries_path= "/usr/lib/debug";
+ $ENV{LD_LIBRARY_PATH} .= ":$debug_libraries_path" if -d $debug_libraries_path;
+ }
+ },
+
+ # aliases
+ vsjitdebugger => 'windbg',
+ ktrace => 'strace',
+);
+
+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) {
+ my $v = $debuggers{$k};
+ $v = $debuggers{$k} = $debuggers{$v} if not ref $v; # resolve aliases
+
+ sub register_opt($$$) {
+ my ($prefix, $name, $msg) = @_;
+ $opts{"$prefix$name=s"} = \$opt_vals{$prefix.$name};
+ $help .= wrap(sprintf(" %-23s", $prefix.$name), ' 'x25, "$msg under $name\n");
+ }
+
+ $v->{script} = '' unless $v->{script};
+ $v->{options} =~ s/(\{exe\}|$)/ {options} $&/ unless $v->{options} =~ /\{options\}/;
+
+ register_opt "", $k, "Start mysqld";
+ register_opt "client-", $k, "Start mysqltest client";
+ register_opt "boot-", $k, "Start bootstrap server";
+ register_opt "manual-", "$k", "Before running test(s) let user manually start mariadbd";
+}
+
+sub subst($%) {
+ use warnings FATAL => 'uninitialized';
+ my ($templ, %vars) = @_;
+ $templ =~ s/\{(\w+)\}/$vars{$1}/g;
+ $templ;
+}
+
+sub do_args($$$$$) {
+ my ($args, $exe, $input, $type, $opt) = @_;
+ my $k = $opt =~ /^(?:client|boot|manual)-(.*)$/ ? $1 : $opt;
+ my $v = $debuggers{$k};
+
+ # on windows mtr args are quoted (for system), otherwise not (for exec)
+ sub quote($) { $_[0] =~ /[; >]/ ? "\"$_[0]\"" : $_[0] }
+ sub unquote($) { $_[0] =~ s/^"(.*)"$/$1/; $_[0] }
+ sub quote_from_mtr($) { IS_WINDOWS() ? $_[0] : quote($_[0]) }
+ sub unquote_for_mtr($) { IS_WINDOWS() ? $_[0] : unquote($_[0]) }
+
+ my %vars = (
+ vardir => $::opt_vardir,
+ exe => $$exe,
+ args => join(' ', map { quote_from_mtr $_ } @$$args,
+ '--loose-debug-gdb', '--loose-skip-stack-trace'),
+ input => $input,
+ script => "$::opt_vardir/tmp/${k}init.$type",
+ log => "$::opt_vardir/log/$type.$k",
+ options => '',
+ );
+ my @params = split /;/, $opt_vals{$opt};
+ $vars{options} = shift @params if @params and $params[0] =~ /^-/;
+
+ my $script = join "\n", @params;
+ if ($v->{script}) {
+ ::mtr_tonewfile($vars{script}, subst($v->{script}, %vars)."\n".$script);
+ } elsif ($script) {
+ mtr_error "$k is not using a script file, nowhere to write the script \n---\n$script\n---";
+ }
+
+ my $options = subst($v->{options}, %vars);
+ @$$args = map { unquote_for_mtr $_ } $options =~ /("[^"]+"|\S+)/g;
+ my $run = $v->{run} || $k;
+
+ if ($opt =~ /^manual-/) {
+ print "\nTo start $k for $type, type in another window:\n";
+ print "$run $options\n";
+ $$exe= undef; # Indicate the exe should not be started
+ } elsif ($v->{term}) {
+ unshift @$$args, '-title', $type, '-e', $run;
+ $$exe = 'xterm';
+ } else {
+ $$exe = $run;
+ }
+}
+
+sub options() { %opts }
+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 $interactive;
+ 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") {
+ my $val= $opt_vals{$opt};
+ if ($val) {
+ $used = 1;
+ $interactive ||= ($debuggers{$k}->{interactive} ||
+ $debuggers{$k}->{term} ||
+ ($opt =~ /^manual-/));
+ 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};
+
+ $::opt_retry= 1;
+ $::opt_retry_failure= 1;
+ $::opt_testcase_timeout= ($interactive ? 24 : 4) * 60; # in minutes
+ $::opt_suite_timeout= 24 * 60; # in minutes
+ $::opt_shutdown_timeout= ($interactive ? 24 * 60 : 3) * 60; # in seconds
+ $::opt_start_timeout= $::opt_shutdown_timeout; # in seconds
+ }
+}
+
+sub setup_boot_args($$$) {
+ my ($args, $exe, $input) = @_;
+ do_args($args, $exe, $input, 'bootstrap', $boot_debugger)
+ if defined $boot_debugger;
+}
+
+sub setup_client_args($$) {
+ my ($args, $exe) = @_;
+ do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', 'client', $client_debugger)
+ if defined $client_debugger;
+}
+
+sub setup_args($$$) {
+ my ($args, $exe, $type) = @_;
+ do_args($args, $exe, IS_WINDOWS() ? 'NUL' : '/dev/null', $type, $debugger)
+ if defined $debugger;
+}
+
+1;
diff --git a/mysql-test/lib/My/File/Path.pm b/mysql-test/lib/My/File/Path.pm
new file mode 100644
index 00000000..fd3cf6dd
--- /dev/null
+++ b/mysql-test/lib/My/File/Path.pm
@@ -0,0 +1,225 @@
+# -*- cperl -*-
+# Copyright (c) 2007 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::File::Path;
+use strict;
+
+
+#
+# File::Path::rmtree has a problem with deleting files
+# and directories where it hasn't got read permission
+#
+# Patch this by installing a 'rmtree' function in local
+# scope that first chmod all files to 0777 before calling
+# the original rmtree function.
+#
+# This is almost gone in version 1.08 of File::Path -
+# but unfortunately some hosts still suffers
+# from this also in 1.08
+#
+
+use Exporter;
+use base "Exporter";
+our @EXPORT= qw /rmtree mkpath copytree make_readonly/;
+
+use File::Find;
+use File::Copy;
+use File::Spec;
+use Carp;
+use My::Handles;
+use My::Platform;
+
+sub rmtree {
+ my ($dir)= @_;
+ find( {
+ bydepth => 1,
+ no_chdir => 1,
+ wanted => sub {
+ my $name= $_;
+ if (!-l $name && -d _){
+ return if (rmdir($name) == 1);
+
+ chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
+
+ return if (rmdir($name) == 1);
+
+ # Failed to remove the directory, analyze
+ carp("Couldn't remove directory '$name': $!");
+ My::Handles::show_handles($name);
+ } else {
+ return if (unlink($name) == 1);
+
+ chmod(0777, $name) or carp("couldn't chmod(0777, $name): $!");
+
+ return if (unlink($name) == 1);
+
+ carp("Couldn't delete file '$name': $!");
+ My::Handles::show_handles($name);
+ }
+ }
+ }, $dir );
+};
+
+
+use File::Basename;
+sub _mkpath_debug {
+ my ($message, $path, $dir, $err)= @_;
+
+ print "=" x 40, "\n";
+ print $message, "\n";
+ print "err: '$err'\n";
+ print "path: '$path'\n";
+ print "dir: '$dir'\n";
+
+ print "-" x 40, "\n";
+ my $dirname= dirname($path);
+ print "ls -l $dirname\n";
+ print `ls -l $dirname`, "\n";
+ print "-" x 40, "\n";
+ print "dir $dirname\n";
+ print `dir $dirname`, "\n";
+ print "-" x 40, "\n";
+ my $dirname2= dirname($dirname);
+ print "ls -l $dirname2\n";
+ print `ls -l $dirname2`, "\n";
+ print "-" x 40, "\n";
+ print "dir $dirname2\n";
+ print `dir $dirname2`, "\n";
+ print "-" x 40, "\n";
+ print "file exists\n" if (-e $path);
+ print "file is a plain file\n" if (-f $path);
+ print "file is a directory\n" if (-d $path);
+ print "-" x 40, "\n";
+ print "showing handles for $path\n";
+ My::Handles::show_handles($path);
+
+ print "=" x 40, "\n";
+
+}
+
+
+sub mkpath {
+ my $path;
+
+ die "Usage: mkpath(<path>)" unless @_ == 1;
+
+ foreach my $dir ( File::Spec->splitdir( @_ ) ) {
+ #print "dir: $dir\n";
+ if ($dir =~ /^[a-z]:/i){
+ # Found volume ie. C:
+ $path= $dir;
+ next;
+ }
+
+ $path= File::Spec->catdir($path, $dir);
+ #print "path: $path\n";
+
+ next if -d $path; # Path already exists and is a directory
+ croak("File already exists but is not a directory: '$path'") if -e $path;
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed", $path, $dir, $!);
+
+ # mkdir failed, try one more time
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, second time", $path, $dir, $!);
+
+ # mkdir failed again, try two more time after sleep(s)
+ sleep(1);
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, third time", $path, $dir, $!);
+
+ sleep(1);
+ next if mkdir($path);
+ _mkpath_debug("mkdir failed, fourth time", $path, $dir, $!);
+
+ # Report failure and die
+ croak("Couldn't create directory '$path' ",
+ " after 4 attempts and 2 sleep(1): $!");
+ }
+};
+
+
+sub copytree {
+ my ($from_dir, $to_dir, $use_umask) = @_;
+
+ die "Usage: copytree(<fromdir>, <todir>, [<umask>])"
+ unless @_ == 2 or @_ == 3;
+
+ my $orig_umask;
+ if ($use_umask){
+ # Set new umask and remember the original
+ $orig_umask= umask(oct($use_umask));
+ }
+
+ mkpath("$to_dir");
+ opendir(DIR, "$from_dir")
+ or croak("Can't find $from_dir$!");
+ for(readdir(DIR)) {
+
+ next if "$_" eq "." or "$_" eq "..";
+
+ # Skip SCCS/ directories
+ next if "$_" eq "SCCS";
+
+ if ( -d "$from_dir/$_" )
+ {
+ copytree("$from_dir/$_", "$to_dir/$_");
+ next;
+ }
+
+ # Only copy plain files
+ next unless -f "$from_dir/$_";
+ copy("$from_dir/$_", "$to_dir/$_");
+ if (!$use_umask)
+ {
+ chmod(0666, "$to_dir/$_");
+ }
+ }
+ closedir(DIR);
+
+ if ($orig_umask){
+ # Set the original umask
+ umask($orig_umask);
+ }
+}
+
+
+sub make_readonly {
+ my ($dir) = @_;
+
+ die "Usage: make_readonly(<dir>])"
+ unless @_ == 1;
+
+ opendir(DIR, "$dir")
+ or croak("Can't find $dir$!");
+ for(readdir(DIR)) {
+
+ next if "$_" eq "." or "$_" eq "..";
+
+ if ( -d "$dir/$_" )
+ {
+ make_readonly("$dir/$_");
+ next;
+ }
+
+ # Only copy plain files
+ next unless -f "$dir/$_";
+ chmod 0444, "$dir/$_";
+ }
+ closedir(DIR);
+}
+1;
diff --git a/mysql-test/lib/My/Find.pm b/mysql-test/lib/My/Find.pm
new file mode 100644
index 00000000..b8c13752
--- /dev/null
+++ b/mysql-test/lib/My/Find.pm
@@ -0,0 +1,246 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+
+package My::Find;
+
+#
+# Utility functions to find files in a MySQL source or bindist
+#
+
+use strict;
+use Carp;
+use My::Platform;
+
+use base qw(Exporter);
+our @EXPORT= qw(my_find_bin my_find_dir my_find_file NOT_REQUIRED);
+
+my $bin_extension= ".exe" if IS_WINDOWS;
+
+# Helper function to be used for fourth parameter to find functions
+sub NOT_REQUIRED { return 0; }
+
+#
+# my_find_bin - find an executable with "name_1...name_n" in
+# paths "path_1...path_n" and return the full path
+#
+# Example:
+# my $mysqld_exe= my_find_bin($basedir.
+# ["sql", "bin"],
+# ["mysqld", "mysqld-debug"]);
+# my $mysql_exe= my_find_bin($basedir,
+# ["client", "bin"],
+# "mysql");
+#
+#
+# To check if something exists, use the required parameter
+# set to 0, the function will return an empty string if the
+# binary is not found
+# my $mysql_exe= my_find_bin($basedir,
+# ["client", "bin"],
+# "mysql", NOT_REQUIRED);
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_bin {
+ my ($base, $paths, $names, $required)= @_;
+ croak "usage: my_find_bin(<base>, <paths>, <names>, [<required>])"
+ unless @_ == 4 or @_ == 3;
+
+ # -------------------------------------------------------
+ # Find and return the first executable
+ # -------------------------------------------------------
+ foreach my $path (my_build_path_list($base, $paths, $names, $bin_extension)) {
+ return $path if ( -x $path or (IS_WINDOWS and -f $path) );
+ }
+ if (defined $required and $required == NOT_REQUIRED){
+ # Return empty string to indicate not found
+ return "";
+ }
+ find_error($base, $paths, $names);
+}
+
+
+#
+# my_find_file - find a file with "name_1...name_n" in
+# paths "path_1...path_n" and return the full path
+#
+# Example:
+# my $mysqld_exe= my_find_file($basedir.
+# ["sql", "bin"],
+# "filename");
+#
+#
+# Also supports NOT_REQUIRED flag
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_file {
+ my ($base, $paths, $names, $required)= @_;
+ croak "usage: my_find_file(<base>, <paths>, <names>, [<required>])"
+ unless @_ == 4 or @_ == 3;
+
+ # -------------------------------------------------------
+ # Find and return the first executable
+ # -------------------------------------------------------
+ foreach my $path (my_build_path_list($base, $paths, $names, $bin_extension)) {
+ return $path if ( -f $path );
+ }
+ if (defined $required and $required == NOT_REQUIRED){
+ # Return empty string to indicate not found
+ return "";
+ }
+ find_error($base, $paths, $names);
+}
+
+
+#
+# my_find_dir - find the existing directories in one of
+# the given paths. Returns the first found in the scalar context
+# and all of them in the list context.
+#
+# Example:
+# my $charset_set= my_find_dir($basedir,
+# ["mysql/share","sql/share", "share"],
+# ["charset"]);
+# or
+# my $charset_set= my_find_dir($basedir,
+# ['client_release', 'client_debug',
+# 'client', 'bin']);
+#
+# NOTE: The function honours MTR_VS_CONFIG environment variable
+#
+#
+sub my_find_dir {
+ my ($base, $paths, $dirs, $required)= @_;
+ croak "usage: my_find_dir(<base>, <paths>[, <dirs>[, <required>]])"
+ unless (@_ >= 2 and @_ <= 4);
+
+ my @all;
+ foreach my $path (my_build_path_list($base, $paths, $dirs)) {
+ next unless -d $path;
+ return $path unless wantarray;
+ push @all, $path;
+ }
+ return @all if @all;
+ return wantarray ? () : "" if defined $required and $required == NOT_REQUIRED;
+ find_error($base, $paths, $dirs);
+}
+
+
+sub my_build_path_list {
+ my ($base, $paths, $names, $extension)= @_;
+
+ # Convert the arguments into two normal arrays to ease
+ # further mappings
+ my (@names, @paths);
+ push(@names, ref $names eq "ARRAY" ? @$names : $names);
+ push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
+
+ #print "base: $base\n";
+ #print "names: @names\n";
+ #print "paths: @paths\n";
+
+ # User can select to look in a special build dir
+ # which is a subdirectory of any of the paths
+ my @extra_dirs;
+ my $build_dir= $::multiconfig || $ENV{MTR_VS_CONFIG} || $ENV{MTR_BUILD_DIR};
+ push(@extra_dirs, $build_dir) if defined $build_dir;
+
+ if (defined $extension){
+ # Append extension to names, if name does not already have extension
+ map { $_.=$extension unless /\.(.*)+$/ } @names;
+ }
+
+ # -------------------------------------------------------
+ # CMake generator specific (Visual Studio and Xcode have multimode builds)
+ # -------------------------------------------------------
+
+ # Add the default extra build dirs unless a specific one has
+ # already been selected
+ push(@extra_dirs,
+ ("Release",
+ "Relwithdebinfo",
+ "Debug")) if @extra_dirs == 0;
+
+
+ #print "extra_build_dir: @extra_dirs\n";
+
+ # -------------------------------------------------------
+ # Build cross product of "paths * extra_build_dirs"
+ # -------------------------------------------------------
+ push(@paths, map { my $path= $_;
+ map { "$path/$_" } @extra_dirs
+ } @paths);
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Build cross product of "paths * names"
+ # -------------------------------------------------------
+ @paths= map { my $path= $_;
+ map { "$path/$_" } @names
+ } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Prepend base to all paths
+ # -------------------------------------------------------
+ @paths= map { "$base/$_" } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Glob all paths to expand wildcards
+ # -------------------------------------------------------
+ @paths= map { glob("$_") } @paths;
+ #print "paths: @paths\n";
+
+ # -------------------------------------------------------
+ # Return the list of paths
+ # -------------------------------------------------------
+ return @paths;
+}
+
+
+sub commify {
+ return
+ (@_ == 0) ? '' :
+ (@_ == 1) ? $_[0] :
+ (@_ == 2) ? join(" or ", @_) :
+ join(", ", @_[0..($#_-1)], "or $_[-1]");
+
+}
+
+
+sub fnuttify {
+ return map('\''.$_.'\'', @_);
+}
+
+
+sub find_error {
+ my ($base, $paths, $names)= @_;
+
+ my (@names, @paths);
+ push(@names, ref $names eq "ARRAY" ? @$names : $names);
+ push(@paths, ref $paths eq "ARRAY" ? @$paths : $paths);
+
+ croak "** ERROR: Could not find ",
+ commify(fnuttify(@names)), " in ",
+ commify(fnuttify(my_build_path_list($base, $paths, $names))), "\n";
+}
+
+1;
diff --git a/mysql-test/lib/My/Handles.pm b/mysql-test/lib/My/Handles.pm
new file mode 100644
index 00000000..e23d3b75
--- /dev/null
+++ b/mysql-test/lib/My/Handles.pm
@@ -0,0 +1,71 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2010, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::Handles;
+
+
+use strict;
+use Carp;
+
+use My::Platform;
+
+my $handle_exe;
+
+sub import {
+ my $self = shift;
+ my $params = shift;
+ return if (!IS_WINDOWS || $handle_exe);
+ # Check if handle.exe is available
+ # Pass switch to accept the EULA to avoid hanging
+ # if the program hasn't been run before.
+ my $list= `handle.exe -? -accepteula 2>&1`;
+ foreach my $line (split('\n', $list))
+ {
+ $handle_exe= "$2.$3"
+ if ($line =~ /(Nth|H)andle v([0-9]*)\.([0-9]*)/);
+ }
+ if ($handle_exe && (!$params || !$params->{suppress_init_messages})){
+ print "Found handle.exe version $handle_exe\n";
+ }
+}
+
+
+sub show_handles
+{
+ my ($dir)= @_;
+ return unless $handle_exe;
+ return unless $dir;
+
+ $dir= native_path($dir);
+
+ # Get a list of open handles in a particular directory
+ my $list= `handle.exe "$dir" 2>&1` or return;
+
+ foreach my $line (split('\n', $list))
+ {
+ return if ($line =~ /No matching handles found/);
+ }
+
+ print "\n";
+ print "=" x 50, "\n";
+ print "Open handles in '$dir':\n";
+ print "$list\n";
+ print "=" x 50, "\n\n";
+
+ return;
+}
+
+1;
diff --git a/mysql-test/lib/My/Options.pm b/mysql-test/lib/My/Options.pm
new file mode 100644
index 00000000..b3ae64cb
--- /dev/null
+++ b/mysql-test/lib/My/Options.pm
@@ -0,0 +1,179 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2010, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+
+package My::Options;
+
+#
+# Utility functions to work with list of options
+#
+
+use strict;
+
+
+sub same($$) {
+ my $l1= shift;
+ my $l2= shift;
+ return compare($l1,$l2) == 0;
+}
+
+
+sub compare ($$) {
+ my $l1= shift;
+ my $l2= shift;
+
+ my @l1= @$l1;
+ my @l2= @$l2;
+
+ return -1 if @l1 < @l2;
+ return 1 if @l1 > @l2;
+
+ while ( @l1 ) # Same length
+ {
+ my $e1= shift @l1;
+ my $e2= shift @l2;
+ my $cmp= ($e1 cmp $e2);
+ return $cmp if $cmp != 0;
+ }
+
+ return 0; # They are the same
+}
+
+
+sub _split_option {
+ my ($option)= @_;
+ if ($option=~ /^--(.*)=(.*)$/){
+ return ($1, $2);
+ }
+ elsif ($option=~ /^--(.*)$/){
+ return ($1, undef)
+ }
+ elsif ($option=~ /^\$(.*)$/){ # $VAR
+ return ($1, undef)
+ }
+ elsif ($option=~ /^(.*)=(.*)$/){
+ return ($1, $2)
+ }
+ die "Unknown option format '$option'";
+}
+
+
+sub _build_option {
+ my ($name, $value)= @_;
+ if ($name =~ /^O, /){
+ return "-".$name."=".$value;
+ }
+ elsif ($value){
+ return "--".$name."=".$value;
+ }
+ return "--".$name;
+}
+
+
+#
+# Compare two list of options and return what would need
+# to be done to get the server running with the new settings
+#
+sub diff {
+ my ($from_opts, $to_opts)= @_;
+
+ my %from;
+ foreach my $from (@$from_opts)
+ {
+ my ($opt, $value)= _split_option($from);
+ next unless defined($opt);
+ $from{$opt}= $value;
+ }
+
+ #print "from: ", %from, "\n";
+
+ my %to;
+ foreach my $to (@$to_opts)
+ {
+ my ($opt, $value)= _split_option($to);
+ next unless defined($opt);
+ $to{$opt}= $value;
+ }
+
+ #print "to: ", %to, "\n";
+
+ # Remove the ones that are in both lists
+ foreach my $name (keys %from){
+ if (exists $to{$name} and $to{$name} eq $from{$name}){
+ #print "removing '$name' from both lists\n";
+ delete $to{$name};
+ delete $from{$name};
+ }
+ }
+
+ #print "from: ", %from, "\n";
+ #print "to: ", %to, "\n";
+
+ # Add all keys in "to" to result
+ my @result;
+ foreach my $name (keys %to){
+ push(@result, _build_option($name, $to{$name}));
+ }
+
+ # Add all keys in "from" that are not in "to"
+ # to result as "set to default"
+ foreach my $name (keys %from){
+ if (not exists $to{$name}) {
+ push(@result, _build_option($name, "default"));
+ }
+ }
+
+ return @result;
+}
+
+
+sub is_subset {
+ my ($set, $subset)= @_;
+ my %cache = map { join('=', _split_option($_)), 1 } @$set;
+
+ for (@$subset){
+ my ($name, $value)= _split_option($_);
+ return 0 unless $cache{"$name=$value"};
+ }
+
+ return 1;
+}
+
+
+sub toSQL {
+ my (@options)= @_;
+ my @sql;
+
+ foreach my $option (@options) {
+ my ($sql_name, $value)= _split_option($option);
+ #print "name: $sql_name\n";
+ #print "value: $value\n";
+ $sql_name=~ s/-/_/g;
+ push(@sql, "SET GLOBAL $sql_name=$value");
+ }
+ return join("; ", @sql);
+}
+
+
+sub toStr {
+ my $name= shift;
+ return "$name: ",
+ "['", join("', '", @_), "']\n";
+}
+
+
+1;
+
diff --git a/mysql-test/lib/My/Platform.pm b/mysql-test/lib/My/Platform.pm
new file mode 100644
index 00000000..2b32ef87
--- /dev/null
+++ b/mysql-test/lib/My/Platform.pm
@@ -0,0 +1,299 @@
+# -*- cperl -*-
+# Copyright (c) 2008 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::Platform;
+
+use strict;
+use File::Basename;
+use File::Path;
+use Carp;
+
+use base qw(Exporter);
+our @EXPORT= qw(IS_CYGWIN IS_MSYS IS_WINDOWS IS_WIN32PERL IS_AIX
+ native_path posix_path mixed_path
+ check_socket_path_length process_alive open_for_append);
+
+BEGIN {
+ if ($^O eq "cygwin") {
+ # Make sure cygpath works
+ if ((system("cygpath > /dev/null 2>&1") >> 8) != 1){
+ die "Could not execute 'cygpath': $!";
+ }
+ eval 'sub IS_CYGWIN { 1 }';
+ eval 'sub IS_MSYS { 0 }';
+ }
+ elsif ($^O eq "msys") {
+ eval 'sub IS_CYGWIN { 1 }';
+ eval 'sub IS_MSYS { 1 }';
+ }
+ else {
+ eval 'sub IS_CYGWIN { 0 }';
+ eval 'sub IS_MSYS { 0 }';
+ }
+ if ($^O eq "MSWin32") {
+ eval 'sub IS_WIN32PERL { 1 }';
+ }
+ else {
+ eval 'sub IS_WIN32PERL { 0 }';
+ }
+}
+
+BEGIN {
+ if (IS_CYGWIN or IS_WIN32PERL) {
+ eval 'sub IS_WINDOWS { 1 }';
+ }
+ else {
+ eval 'sub IS_WINDOWS { 0 }';
+ }
+}
+
+BEGIN {
+ if ($^O eq "aix") {
+ eval 'sub IS_AIX { 1 }';
+ }
+ else {
+ eval 'sub IS_AIX { 0 }';
+ }
+}
+
+
+#
+# native_path
+# Convert from path format used by perl to the underlying
+# operating systems format
+#
+# NOTE
+# Used when running windows binaries (that expect windows paths)
+# in cygwin perl (that uses unix paths)
+#
+
+use Memoize;
+if (!IS_WIN32PERL){
+ memoize('mixed_path');
+ memoize('native_path');
+ memoize('posix_path');
+}
+
+sub mixed_path {
+ my ($path)= @_;
+ if (IS_CYGWIN){
+ return unless defined $path;
+ my $cmd= "cygpath -m $path";
+ $path= `$cmd` or
+ print "Failed to run: '$cmd', $!\n";
+ chomp $path;
+ }
+ return $path;
+}
+
+sub native_path {
+ my ($path)= @_;
+ if (IS_CYGWIN) {
+ # \\\\ protects against 2 expansions (just for the case)
+ $path=~ s/\/+|\\+/\\\\\\\\/g;
+ }
+ elsif (IS_WINDOWS) {
+ $path=~ s/\/+/\\/g;
+ }
+ return $path;
+}
+
+sub posix_path {
+ my ($path)= @_;
+ if (IS_CYGWIN){
+ return unless defined $path;
+ $path= `cygpath $path`;
+ chomp $path;
+ }
+ return $path;
+}
+
+use File::Temp qw /tempdir/;
+
+sub check_socket_path_length {
+ my ($path)= @_;
+
+ return 0 if IS_WINDOWS;
+ # This may not be true, but we can't test for it on AIX due to Perl bug
+ # See Bug #45771
+ return 0 if ($^O eq 'aix');
+ # See Debian bug #670722 - failing on kFreeBSD even after setting short path
+ return 0 if $^O eq 'gnukfreebsd' and length $path < 40;
+ # GNU/Hurd doesn't have hostpath(), but no limitation either
+ return 0 if $^O eq 'gnu';
+
+ require IO::Socket::UNIX;
+
+ my $truncated= undef;
+
+ # Create a tempfile name with same length as "path"
+ my $tmpdir = tempdir( CLEANUP => 0);
+ my $len = length($path) - length($tmpdir) - 1;
+ my $testfile = $tmpdir . "/" . "x" x ($len > 0 ? $len : 1);
+ my $sock;
+ eval {
+ $sock= new IO::Socket::UNIX
+ (
+ Local => $testfile,
+ Listen => 1,
+ );
+ $truncated= 1; # Be negatvie
+
+ die "Could not create UNIX domain socket: $!"
+ unless defined $sock;
+
+ die "UNIX domain socket path was truncated"
+ unless ($testfile eq $sock->hostpath());
+
+ $truncated= 0; # Yes, it worked!
+
+ };
+
+ die "Unexpected failure when checking socket path length: $@"
+ if $@ and not defined $truncated;
+
+ $sock= undef; # Close socket
+ rmtree($tmpdir); # Remove the tempdir and any socket file created
+ return $truncated;
+}
+
+
+sub process_alive {
+ my ($pid)= @_;
+ die "usage: process_alive(pid)" unless $pid;
+
+ return kill(0, $pid) unless IS_WINDOWS;
+
+ my @list= split(/,/, `tasklist /FI "PID eq $pid" /NH /FO CSV`);
+ my $ret_pid= eval($list[1]);
+ return ($ret_pid == $pid);
+}
+
+
+
+use Symbol qw( gensym );
+
+use if $^O eq 'MSWin32', 'Win32API::File', qw( CloseHandle CreateFile GetOsFHandle OsFHandleOpen OPEN_ALWAYS FILE_APPEND_DATA
+ FILE_SHARE_READ FILE_SHARE_WRITE FILE_SHARE_DELETE );
+use if $^O eq 'MSWin32', 'Win32::API';
+
+use constant WIN32API_FILE_NULL => [];
+
+# Open a file for append
+# On Windows we use CreateFile with FILE_APPEND_DATA
+# to insure that writes are atomic, not interleaved
+# with writes by another processes.
+sub open_for_append
+{
+ my ($file) = @_;
+ my $fh = gensym();
+
+ if (IS_WIN32PERL)
+ {
+ my $handle;
+ if (!($handle = CreateFile(
+ $file,
+ FILE_APPEND_DATA(),
+ FILE_SHARE_READ()|FILE_SHARE_WRITE()|FILE_SHARE_DELETE(),
+ WIN32API_FILE_NULL,
+ OPEN_ALWAYS(),# Create if doesn't exist.
+ 0,
+ WIN32API_FILE_NULL,
+ )))
+ {
+ return undef;
+ }
+
+ if (!OsFHandleOpen($fh, $handle, 'wat'))
+ {
+ CloseHandle($handle);
+ return undef;
+ }
+ return $fh;
+ }
+
+ open($fh,">>",$file) or return undef;
+ return $fh;
+}
+
+
+sub check_cygwin_subshell
+{
+ # Only pipe (or sh-expansion) is fed to /bin/sh
+ my $out= `echo %comspec%|cat`;
+ return ($out =~ /\bcmd.exe\b/) ? 0 : 1;
+}
+
+sub install_shell_wrapper()
+{
+ system("rm -f /bin/sh.exe") and die $!;
+ my $wrapper= <<'EOF';
+#!/bin/bash
+if [[ -n "$MTR_PERL" && "$1" = "-c" ]]; then
+ shift
+ exec $(cygpath -m "$COMSPEC") /C "$@"
+fi
+exec /bin/bash "$@"
+EOF
+ open(OUT, '>', "/bin/sh") or die "/bin/sh: $!\n";
+ print OUT $wrapper;
+ close(OUT);
+ system("chmod +x /bin/sh") and die $!;
+ print "Cygwin subshell wrapper /bin/sh was installed, please restart MTR!\n";
+ exit(0);
+}
+
+sub uninstall_shell_wrapper()
+{
+ system("rm -f /bin/sh") and die $!;
+ system("cp /bin/bash.exe /bin/sh.exe") and die $!;
+}
+
+sub cygwin_subshell_fix
+{
+ my ($opt_name, $opt_value)= @_;
+ if ($opt_name ne "cygwin-subshell-fix") {
+ confess "Wrong option name: ${opt_name}";
+ }
+ if ($opt_value eq "do") {
+ if (check_cygwin_subshell()) {
+ install_shell_wrapper();
+ } else {
+ print "Cygwin subshell fix was already installed, skipping...\n";
+ }
+ } elsif ($opt_value eq "remove") {
+ if (check_cygwin_subshell()) {
+ print "Cygwin subshell fix was already uninstalled, skipping...\n";
+ } else {
+ uninstall_shell_wrapper();
+ }
+ } else {
+ die "Wrong --cygwin-subshell-fix value: ${opt_value} (expected do/remove)";
+ }
+}
+
+sub options
+{
+ if (IS_CYGWIN) {
+ return ('cygwin-subshell-fix=s' => \&cygwin_subshell_fix);
+ } else {
+ return ();
+ }
+}
+
+
+1;
diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm
new file mode 100644
index 00000000..e3b46b37
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess.pm
@@ -0,0 +1,640 @@
+# -*- cperl -*-
+# Copyright (c) 2007, 2011, Oracle and/or its affiliates.
+# Copyright (c) 2009, 2011 Monty Program Ab
+#
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU Library General Public
+# License as published by the Free Software Foundation; version 2
+# of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# Library General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+package My::SafeProcess;
+
+#
+# Class that encapsulates process creation, monitoring and cleanup
+#
+# Spawns a monitor process which spawns a new process locally or
+# remote using subclasses My::Process::Local or My::Process::Remote etc.
+#
+# The monitor process runs a simple event loop more or less just
+# waiting for a reason to zap the process it monitors. Thus the user
+# of this class does not need to care about process cleanup, it's
+# handled automatically.
+#
+# The monitor process wait for:
+# - the parent process to close the pipe, in that case it
+# will zap the "monitored process" and exit
+# - the "monitored process" to exit, in which case it will exit
+# itself with same exit code as the "monitored process"
+# - the parent process to send the "shutdown" signal in which case
+# monitor will kill the "monitored process" hard and exit
+#
+#
+# When used it will look something like this:
+# $> ps
+# [script.pl]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+# - [monitor for `mysqld`]
+# - [mysqld]
+#
+#
+
+use strict;
+use Carp;
+use POSIX qw(WNOHANG);
+
+use My::SafeProcess::Base;
+use base 'My::SafeProcess::Base';
+
+use My::Find;
+use My::Platform;
+
+my %running;
+my $_verbose= 0;
+my $start_exit= 0;
+
+END {
+ # Kill any children still running
+ for my $proc (values %running){
+ if ( $proc->is_child($$) and ! $start_exit){
+ #print "Killing: $proc\n";
+ if ($proc->wait_one(0)){
+ $proc->kill();
+ }
+ }
+ }
+}
+
+
+sub is_child {
+ my ($self, $parent_pid)= @_;
+ croak "usage: \$safe_proc->is_child()" unless (@_ == 2 and ref $self);
+ return ($self->{PARENT} == $parent_pid);
+}
+
+
+our @safe_process_cmd;
+my $safe_kill;
+my $bindir;
+
+if(defined $ENV{MTR_BINDIR})
+{
+ # This is an out-of-source build. Build directory
+ # is given in MTR_BINDIR env.variable
+ $bindir = $ENV{MTR_BINDIR}."/mysql-test";
+}
+else
+{
+ use Cwd;
+ $bindir = getcwd();
+}
+
+# Find the safe process binary or script
+sub find_bin {
+ if (IS_WINDOWS)
+ {
+ # Use my_safe_process.exe
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+
+ # Use my_safe_kill.exe
+ $safe_kill= my_find_bin($bindir, "lib/My/SafeProcess", "my_safe_kill");
+ }
+ else
+ {
+ # Use my_safe_process
+ my $exe= my_find_bin($bindir, ["lib/My/SafeProcess", "My/SafeProcess"],
+ "my_safe_process");
+ push(@safe_process_cmd, $exe);
+ }
+}
+
+
+sub new {
+ my $class= shift;
+
+ my %opts=
+ (
+ verbose => 0,
+ @_
+ );
+
+ my $path = delete($opts{'path'}) or croak "path required @_";
+ my $args = delete($opts{'args'}) or croak "args required @_";
+ my $input = delete($opts{'input'});
+ my $output = delete($opts{'output'});
+ my $error = delete($opts{'error'});
+ my $verbose = delete($opts{'verbose'}) || $::opt_verbose;
+ my $nocore = delete($opts{'nocore'});
+ my $host = delete($opts{'host'});
+ my $shutdown = delete($opts{'shutdown'});
+ my $user_data= delete($opts{'user_data'});
+ my $envs = delete($opts{'envs'});
+
+# if (defined $host) {
+# $safe_script= "lib/My/SafeProcess/safe_process_cpcd.pl";
+# }
+
+ if (IS_CYGWIN){
+ $path= mixed_path($path);
+ $input= mixed_path($input);
+ $output= mixed_path($output);
+ $error= mixed_path($error);
+ }
+
+ my @safe_args;
+ my ($safe_path, $safe_script)= @safe_process_cmd;
+ push(@safe_args, $safe_script) if defined $safe_script;
+
+ push(@safe_args, "--verbose") if $verbose > 0;
+ push(@safe_args, "--nocore") if $nocore;
+
+ # Point the safe_process at the right parent if running on cygwin
+ push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN;
+
+ foreach my $env_var (@$envs) {
+ croak("Missing = in env string") unless $env_var =~ /=/;
+ croak("Env string $env_var seen, probably missing value for --mysqld-env")
+ if $env_var =~ /^--/;
+ push @safe_args, "--env $env_var";
+ }
+
+ push(@safe_args, "--");
+ push(@safe_args, $path); # The program safe_process should execute
+
+ if ($start_exit) { # Bypass safe_process instead, start program directly
+ @safe_args= ();
+ $safe_path= $path;
+ }
+ push(@safe_args, @$$args);
+
+ print "### safe_path: ", $safe_path, " ", join(" ", @safe_args), "\n"
+ if $verbose > 1;
+
+ my $pid= create_process(
+ path => $safe_path,
+ input => $input,
+ output => $output,
+ error => $error,
+ append => $opts{append},
+ args => \@safe_args,
+ );
+
+ my $name = delete($opts{'name'}) || "SafeProcess$pid";
+ my $proc= bless
+ ({
+ SAFE_PID => $pid,
+ SAFE_WINPID => $pid, # Inidicates this is always a real process
+ SAFE_NAME => $name,
+ SAFE_SHUTDOWN => $shutdown,
+ PARENT => $$,
+ SAFE_USER_DATA => $user_data,
+ }, $class);
+
+ # Put the new process in list of running
+ $running{$pid}= $proc;
+ return $proc;
+
+}
+
+
+sub run {
+ my $proc= new(@_);
+ $proc->wait_one();
+ return $proc->exit_status();
+}
+
+#
+# Shutdown process nicely, and wait for shutdown_timeout seconds
+# If processes hasn't shutdown, kill them hard and wait for return
+#
+sub shutdown {
+ my $shutdown_timeout= shift;
+ my @processes= @_;
+ _verbose("shutdown, timeout: $shutdown_timeout, @processes");
+
+ return if (@processes == 0);
+
+ # Call shutdown function if process has one, else
+ # use kill
+ foreach my $proc (@processes){
+ _verbose(" proc: $proc");
+ my $shutdown= $proc->{SAFE_SHUTDOWN};
+ if ($shutdown_timeout > 0 and defined $shutdown){
+ $shutdown->();
+ $proc->{WAS_SHUTDOWN}= 1;
+ }
+ else {
+ $proc->start_kill();
+ }
+ }
+
+ my @kill_processes= ();
+
+ # Wait max shutdown_timeout seconds for those process
+ # that has been shutdown
+ foreach my $proc (@processes){
+ next unless $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one($shutdown_timeout);
+ if ($ret != 0) {
+ push(@kill_processes, $proc);
+ }
+ # Only wait for the first process with shutdown timeout
+ $shutdown_timeout= 0;
+ }
+
+ # Wait infinitely for those process
+ # that has been killed
+ foreach my $proc (@processes){
+ next if $proc->{WAS_SHUTDOWN};
+ my $ret= $proc->wait_one(undef);
+ if ($ret != 0) {
+ warn "Wait for killed process failed!";
+ push(@kill_processes, $proc);
+ # Try one more time, best option...
+ }
+ }
+
+ # Return if all servers has exited
+ return if (@kill_processes == 0);
+
+ foreach my $proc (@kill_processes){
+ $proc->start_kill();
+ }
+
+ foreach my $proc (@kill_processes){
+ $proc->wait_one(undef);
+ }
+
+ return;
+}
+
+
+sub _winpid ($) {
+ my ($pid)= @_;
+
+ # In win32 perl, the pid is already the winpid
+ return $pid unless IS_CYGWIN;
+
+ # In cygwin, the pid is the pseudo process ->
+ # get the real winpid of my_safe_process
+ return Cygwin::pid_to_winpid($pid);
+}
+
+
+#
+# Tell the process to die as fast as possible
+#
+sub start_kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->start_kill()" unless (@_ == 1 and ref $self);
+ _verbose("start_kill: $self");
+ my $ret= 1;
+
+ my $pid= $self->{SAFE_PID};
+ die "INTERNAL ERROR: no pid" unless defined $pid;
+
+ if (IS_WINDOWS and defined $self->{SAFE_WINPID})
+ {
+ die "INTERNAL ERROR: no safe_kill" unless defined $safe_kill;
+
+ my $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+
+ if ($ret == 3){
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, try one more time\n";
+ sleep(1);
+ $winpid= _winpid($pid);
+ $ret= system($safe_kill, $winpid) >> 8;
+ print "Couldn't open the winpid: $winpid ".
+ "for pid: $pid, continue and see what happens...\n";
+ }
+ }
+ else
+ {
+ $pid= $self->{SAFE_PID};
+ die "Can't kill not started process" unless defined $pid;
+ $ret= kill("TERM", $pid);
+ }
+
+ return $ret;
+}
+
+
+sub dump_core {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ die "Can't get core from not started process" unless defined $pid;
+
+ if (IS_WINDOWS) {
+ system("$safe_kill $pid dump");
+ return 1;
+ }
+
+ _verbose("Sending ABRT to $self");
+ kill ("ABRT", $pid);
+ return 1;
+}
+
+
+#
+# Kill the process as fast as possible
+# and wait for it to return
+#
+sub kill {
+ my ($self)= @_;
+ croak "usage: \$safe_proc->kill()" unless (@_ == 1 and ref $self);
+
+ $self->start_kill();
+ $self->wait_one();
+ return 1;
+}
+
+
+sub _collect {
+ my ($self, $exit_code)= @_;
+
+ $self->{EXIT_STATUS}= $exit_code;
+ _verbose("_collect: $self");
+
+ # Take the process out of running list
+ my $pid= $self->{SAFE_PID};
+ die unless delete($running{$pid});
+}
+
+
+# Wait for process to exit
+# optionally with a timeout
+#
+# timeout
+# undef -> wait blocking infinitely
+# 0 -> just poll with WNOHANG
+# >0 -> wait blocking for max timeout seconds
+#
+# RETURN VALUES
+# 0 Not running
+# 1 Still running
+#
+sub wait_one {
+ my ($self, $timeout, $keep)= @_;
+ croak "usage: \$safe_proc->wait_one([timeout] [, keep])" unless ref $self;
+
+ _verbose("wait_one $self, $timeout, $keep");
+
+ if ( ! defined($self->{SAFE_PID}) ) {
+ # No pid => not running
+ _verbose("No pid => not running");
+ return 0;
+ }
+
+ if ( defined $self->{EXIT_STATUS} ) {
+ # Exit status already set => not running
+ _verbose("Exit status already set => not running");
+ return 0;
+ }
+
+ my $pid= $self->{SAFE_PID};
+
+ my $use_alarm;
+ my $blocking;
+ if (defined $timeout)
+ {
+ if ($timeout == 0)
+ {
+ # 0 -> just poll with WNOHANG
+ $blocking= 0;
+ $use_alarm= 0;
+ }
+ else
+ {
+ # >0 -> wait blocking for max timeout seconds
+ $blocking= 1;
+ $use_alarm= 1;
+ }
+ }
+ else
+ {
+ # undef -> wait blocking infinitely
+ $blocking= 1;
+ $use_alarm= 0;
+ }
+ #_verbose("blocking: $blocking, use_alarm: $use_alarm");
+
+ my $retpid;
+ my $exit_code;
+ eval
+ {
+ # alarm should break the wait
+ local $SIG{ALRM}= sub { die "waitpid timeout"; };
+
+ alarm($timeout) if $use_alarm;
+
+ $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG);
+ $exit_code= $?;
+
+ alarm(0) if $use_alarm;
+ };
+
+ if ($@)
+ {
+ die "Got unexpected: $@" if ($@ !~ /waitpid timeout/);
+ if (!defined $retpid) {
+ # Got timeout
+ _verbose("Got timeout");
+ return 1;
+ }
+ # Got pid _and_ alarm, continue
+ _verbose("Got pid and alarm, continue");
+ }
+
+ if ( $retpid == 0 ) {
+ # 0 => still running
+ _verbose("0 => still running");
+ return 1;
+ }
+
+ #if ( not $blocking and $retpid == -1 ) {
+ # # still running
+ # _verbose("still running");
+ # return 1;
+ #}
+
+ #warn "wait_one: expected pid $pid but got $retpid"
+ # unless( $retpid == $pid );
+
+ $self->_collect($exit_code) unless $keep;
+ return 0;
+}
+
+
+#
+# Wait for any process to exit
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub wait_any {
+ my $ret_pid;
+ my $exit_code;
+
+ if (IS_WIN32PERL) {
+ # Can't wait for -1 => use a polling loop
+ do {
+ Win32::Sleep(10); # 10 milli seconds
+ foreach my $pid (keys %running){
+ $ret_pid= waitpid($pid, &WNOHANG);
+ last if $pid == $ret_pid;
+ }
+ } while ($ret_pid == 0);
+ $exit_code= $?;
+ }
+ else
+ {
+ $ret_pid= waitpid(-1, 0);
+ if ($ret_pid <= 0){
+ # No more processes to wait for
+ print STDERR "wait_any, got invalid pid: $ret_pid\n";
+ return undef;
+ }
+ $exit_code= $?;
+ }
+
+ # Look it up in "running" table
+ my $proc= $running{$ret_pid};
+ unless (defined $proc){
+ print STDERR "Could not find pid: $ret_pid in running list\n";
+ print STDERR "running: ". join(", ", keys(%running)). "\n";
+ return undef;
+ }
+ $proc->_collect($exit_code);
+ return $proc;
+}
+
+
+#
+# Wait for any process to exit, or a timeout
+#
+# Returns a reference to the SafeProcess that
+# exited or a pseudo-process with $proc->{timeout} == 1
+#
+
+sub wait_any_timeout {
+ my $class= shift;
+ my $timeout= shift;
+ my $proc;
+ my $millis=10;
+
+ do {
+ ::mtr_milli_sleep($millis);
+ # Slowly increse interval up to max. 1 second
+ $millis++ if $millis < 1000;
+ # Return a "fake" process for timeout
+ if (::has_expired($timeout)) {
+ $proc= bless
+ ({
+ SAFE_PID => 0,
+ SAFE_NAME => "timer",
+ timeout => 1,
+ }, $class);
+ } else {
+ $proc= check_any();
+ }
+ } while (! $proc);
+
+ return $proc;
+}
+
+
+#
+# Wait for all processes to exit
+#
+sub wait_all {
+ while(keys %running)
+ {
+ wait_any();
+ }
+}
+
+#
+# Set global flag to tell all safe_process to exit after starting child
+#
+
+sub start_exit {
+ $start_exit= 1;
+}
+
+#
+# Check if any process has exited, but don't wait.
+#
+# Returns a reference to the SafeProcess that
+# exited or undefined
+#
+sub check_any {
+ for my $proc (values %running){
+ if ( $proc->is_child($$) ) {
+ if (not $proc->wait_one(0)) {
+ _verbose ("Found exited $proc");
+ return $proc;
+ }
+ }
+ }
+ return undef;
+}
+
+
+# Overload string operator
+# and fallback to default functions if no
+# overloaded function is found
+#
+use overload
+ '""' => \&self2str,
+ fallback => 1;
+
+
+#
+# Return the process as a nicely formatted string
+#
+sub self2str {
+ my ($self)= @_;
+ my $pid= $self->{SAFE_PID};
+ my $winpid= $self->{SAFE_WINPID};
+ my $name= $self->{SAFE_NAME};
+ my $exit_status= $self->{EXIT_STATUS};
+
+ my $str= "[$name - pid: $pid";
+ $str.= ", winpid: $winpid" if defined $winpid;
+ $str.= ", exit: $exit_status" if defined $exit_status;
+ $str.= "]";
+}
+
+sub _verbose {
+ return unless $_verbose;
+ print STDERR " ## @_\n";
+}
+
+
+sub pid {
+ my ($self)= @_;
+ return $self->{SAFE_PID};
+}
+
+sub user_data {
+ my ($self)= @_;
+ return $self->{SAFE_USER_DATA};
+}
+
+
+1;
diff --git a/mysql-test/lib/My/SafeProcess/Base.pm b/mysql-test/lib/My/SafeProcess/Base.pm
new file mode 100644
index 00000000..1cd01cb0
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/Base.pm
@@ -0,0 +1,227 @@
+# -*- cperl -*-
+# Copyright (c) 2007 MySQL AB, 2008, 2009 Sun Microsystems, Inc.
+# Use is subject to license terms.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+# This is a library file used by the Perl version of mysql-test-run,
+# and is part of the translation of the Bourne shell script with the
+# same name.
+
+use strict;
+
+package My::SafeProcess::Base;
+
+#
+# Utility functions for Process management
+#
+
+use Carp;
+use IO::Pipe;
+
+use base qw(Exporter);
+our @EXPORT= qw(create_process);
+
+
+
+#
+# safe_fork
+# Retry a couple of times if fork returns EAGAIN
+#
+sub _safe_fork {
+ my $retries= 100;
+ my $pid;
+
+ FORK:
+ {
+ $pid= fork;
+ if ( not defined($pid)) {
+
+ croak("fork failed after: $!") if (!$retries--);
+
+ warn("fork failed sleep 1 second and redo: $!");
+ sleep(1);
+ redo FORK;
+ }
+ }
+
+ return $pid;
+};
+
+
+#
+# Decode exit status
+#
+sub exit_status {
+ my $self= shift;
+ my $raw= $self->{EXIT_STATUS};
+
+ croak("Can't call exit_status before process has died")
+ unless defined $raw;
+
+ if ($raw & 127)
+ {
+ # Killed by signal
+ my $signal_num= $raw & 127;
+ my $dumped_core= $raw & 128;
+ return 1; # Return error code
+ }
+ else
+ {
+ # Normal process exit
+ return $raw >> 8;
+ };
+}
+
+# threads.pm may not exist everywhere, so use only on Windows.
+
+use if $^O eq "MSWin32", "threads";
+use if $^O eq "MSWin32", "threads::shared";
+
+my $win32_spawn_lock :shared;
+
+
+#
+# Create a new process
+# Return pid of the new process
+#
+sub create_process {
+ my %opts=
+ (
+ @_
+ );
+
+ my $path = delete($opts{'path'}) or die "path required";
+ my $args = delete($opts{'args'}) or die "args required";
+ my $input = delete($opts{'input'});
+ my $output = delete($opts{'output'});
+ my $error = delete($opts{'error'});
+
+ my $open_mode= $opts{append} ? ">>" : ">";
+
+ if ($^O eq "MSWin32"){
+
+ lock($win32_spawn_lock);
+
+ #printf STDERR "stdin %d, stdout %d, stderr %d\n",
+ # fileno STDIN, fileno STDOUT, fileno STDERR;
+
+ # input output redirect
+ my ($oldin, $oldout, $olderr);
+ open $oldin, '<&', \*STDIN or die "Failed to save old stdin: $!";
+ open $oldout, '>&', \*STDOUT or die "Failed to save old stdout: $!";
+ open $olderr, '>&', \*STDERR or die "Failed to save old stderr: $!";
+
+ if ( $input ) {
+ if ( ! open(STDIN, "<", $input) ) {
+ croak("can't redirect STDIN to '$input': $!");
+ }
+ }
+
+ if ( $output ) {
+ if ( ! open(STDOUT, $open_mode, $output) ) {
+ croak("can't redirect STDOUT to '$output': $!");
+ }
+ }
+
+ if ( $error ) {
+ if ( $output eq $error ) {
+ if ( ! open(STDERR, ">&STDOUT") ) {
+ croak("can't dup STDOUT: $!");
+ }
+ }
+ elsif ( ! open(STDERR, $open_mode, $error) ) {
+ croak("can't redirect STDERR to '$error': $!");
+ }
+ }
+
+
+ # Magic use of 'system(1, @args)' to spawn a process
+ # and get a proper Win32 pid
+ unshift (@$args, $path);
+ my $pid= system(1, @$args);
+ if ( $pid == 0 ){
+ print $olderr "create_process failed: $^E\n";
+ die "create_process failed: $^E";
+ }
+
+ # Retore IO redirects
+ open STDERR, '>&', $olderr
+ or croak("unable to reestablish STDERR");
+ open STDOUT, '>&', $oldout
+ or croak("unable to reestablish STDOUT");
+ open STDIN, '<&', $oldin
+ or croak("unable to reestablish STDIN");
+ #printf STDERR "stdin %d, stdout %d, stderr %d\n",
+ # fileno STDIN, fileno STDOUT, fileno STDERR;
+ return $pid;
+
+ }
+
+ local $SIG{PIPE}= sub { print STDERR "Got signal $@\n"; };
+ my $pipe= IO::Pipe->new();
+ my $pid= _safe_fork();
+ if ($pid){
+ # Parent
+ $pipe->reader();
+ my $line= <$pipe>; # Wait for child to say it's ready
+ return $pid;
+ }
+
+ $SIG{INT}= 'DEFAULT';
+ $SIG{HUP}= 'DEFAULT';
+
+ # Make this process it's own process group to be able to kill
+ # it and any childs(that hasn't changed group themself)
+ setpgrp(0,0) if $opts{setpgrp};
+
+ if ( $output ) {
+ close STDOUT;
+ open(STDOUT, $open_mode, $output)
+ or croak "can't redirect STDOUT to '$output': $!";
+ }
+
+ if ( $error ) {
+ if ( defined $output and $output eq $error ) {
+ if ( ! open(STDERR, ">&STDOUT") ) {
+ croak("can't dup STDOUT: $!");
+ }
+ }
+ else {
+ close STDERR;
+ open(STDERR, $open_mode, $error)
+ or croak "can't redirect STDERR to '$error': $!";
+ }
+ }
+
+ if ( $input ) {
+ if ( ! open(STDIN, "<", $input) ) {
+ croak("can't redirect STDIN to '$input': $!");
+ }
+ }
+
+ # Tell parent to continue
+ $pipe->writer();
+ print $pipe "ready\n";
+
+ if ( !exec($path, @$args) ){
+ croak("Failed to exec '$path': $!");
+ }
+
+ croak("Should never come here");
+
+}
+
+1;
+
diff --git a/mysql-test/lib/My/SafeProcess/CMakeLists.txt b/mysql-test/lib/My/SafeProcess/CMakeLists.txt
new file mode 100644
index 00000000..0004a449
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/CMakeLists.txt
@@ -0,0 +1,50 @@
+# Copyright (c) 2006, 2013, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+
+INCLUDE_DIRECTORIES(${CMAKE_SOURCE_DIR}/include)
+
+IF (WIN32)
+ ADD_EXECUTABLE(my_safe_process safe_process_win.cc)
+ ADD_EXECUTABLE(my_safe_kill safe_kill_win.cc)
+ TARGET_INCLUDE_DIRECTORIES(my_safe_kill PRIVATE ${CMAKE_SOURCE_DIR}/include)
+ TARGET_LINK_LIBRARIES(my_safe_kill mysys psapi)
+ELSE()
+ ADD_EXECUTABLE(my_safe_process safe_process.cc)
+ENDIF()
+
+IF(WITH_WSREP)
+ ADD_EXECUTABLE(wsrep_check_version wsrep_check_version.c)
+ TARGET_LINK_LIBRARIES(wsrep_check_version ${CMAKE_DL_LIBS})
+ENDIF()
+
+IF(NOT INSTALL_MYSQLTESTDIR)
+ RETURN()
+ENDIF()
+
+SET(INSTALL_ARGS
+ DESTINATION "${INSTALL_MYSQLTESTDIR}/lib/My/SafeProcess"
+ COMPONENT Test
+)
+
+INSTALL(TARGETS my_safe_process ${INSTALL_ARGS})
+IF(WITH_WSREP)
+ INSTALL(TARGETS wsrep_check_version ${INSTALL_ARGS})
+ENDIF()
+IF (WIN32)
+ INSTALL(TARGETS my_safe_kill ${INSTALL_ARGS})
+ENDIF()
+
+INSTALL(FILES Base.pm ${INSTALL_ARGS})
diff --git a/mysql-test/lib/My/SafeProcess/safe_kill_win.cc b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc
new file mode 100644
index 00000000..375ed80b
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc
@@ -0,0 +1,146 @@
+/* Copyright (c) 2007, 2010, Oracle and/or its affiliates. All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA */
+
+
+/*
+ Utility program used to signal a safe_process it's time to shutdown
+
+ Usage:
+ safe_kill <pid>
+*/
+
+#include <windows.h>
+#include <stdio.h>
+#include <signal.h>
+#include <stdlib.h>
+#include <psapi.h>
+#include <my_minidump.h>
+
+#include <tlhelp32.h>
+#include <vector>
+
+
+static std::vector<DWORD> find_children(DWORD pid)
+{
+ HANDLE h= NULL;
+ PROCESSENTRY32 pe={ 0 };
+ std::vector<DWORD> children;
+
+ pe.dwSize = sizeof(PROCESSENTRY32);
+ h = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+ if(h == INVALID_HANDLE_VALUE)
+ return children;
+
+ for (BOOL ret = Process32First(h, &pe); ret; ret = Process32Next(h, &pe))
+ {
+ if (pe.th32ParentProcessID == pid)
+ children.push_back(pe.th32ProcessID);
+ }
+ CloseHandle(h);
+ return children;
+}
+
+
+static int create_dump(DWORD pid, int recursion_depth= 5)
+{
+ if (recursion_depth < 0)
+ return 0;
+
+ my_create_minidump(pid, TRUE);
+ std::vector<DWORD> children= find_children(pid);
+ for(size_t i=0; i < children.size(); i++)
+ create_dump(children[i], recursion_depth -1);
+ return 0;
+}
+
+
+int main(int argc, const char** argv )
+{
+ DWORD pid= -1;
+ HANDLE shutdown_event;
+ char safe_process_name[32]= {0};
+ int retry_open_event= 2;
+ /* Ignore any signals */
+ signal(SIGINT, SIG_IGN);
+ signal(SIGBREAK, SIG_IGN);
+ signal(SIGTERM, SIG_IGN);
+
+ if ((argc != 2 && argc != 3) || (argc == 3 && strcmp(argv[2],"dump"))) {
+ fprintf(stderr, "safe_kill <pid> [dump]\n");
+ exit(2);
+ }
+ pid= atoi(argv[1]);
+
+ if (argc == 3)
+ {
+ return create_dump(pid);
+ }
+ _snprintf(safe_process_name, sizeof(safe_process_name),
+ "safe_process[%d]", pid);
+
+ /* Open the event to signal */
+ while ((shutdown_event=
+ OpenEvent(EVENT_MODIFY_STATE, FALSE, safe_process_name)) == NULL)
+ {
+ /*
+ Check if the process is alive, otherwise there is really
+ no sense to retry the open of the event
+ */
+ HANDLE process;
+ DWORD exit_code;
+ process= OpenProcess(SYNCHRONIZE| PROCESS_QUERY_INFORMATION, FALSE, pid);
+ if (!process)
+ {
+ /* Already died */
+ exit(1);
+ }
+
+ if (!GetExitCodeProcess(process,&exit_code))
+ {
+ fprintf(stderr, "GetExitCodeProcess failed, pid= %lu, err= %lu\n",
+ pid, GetLastError());
+ exit(1);
+ }
+
+ if (exit_code != STILL_ACTIVE)
+ {
+ /* Already died */
+ CloseHandle(process);
+ exit(2);
+ }
+
+ CloseHandle(process);
+
+ if (retry_open_event--)
+ Sleep(100);
+ else
+ {
+ fprintf(stderr, "Failed to open shutdown_event '%s', error: %lu\n",
+ safe_process_name, GetLastError());
+ exit(3);
+ }
+ }
+
+ if(SetEvent(shutdown_event) == 0)
+ {
+ fprintf(stderr, "Failed to signal shutdown_event '%s', error: %lu\n",
+ safe_process_name, GetLastError());
+ CloseHandle(shutdown_event);
+ exit(4);
+ }
+ CloseHandle(shutdown_event);
+ exit(0);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/safe_process.cc b/mysql-test/lib/My/SafeProcess/safe_process.cc
new file mode 100644
index 00000000..dcf9491d
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_process.cc
@@ -0,0 +1,364 @@
+/* Copyright (c) 2008, 2012, Oracle and/or its affiliates
+ Copyright (c) 2019, MariaDB Corporation.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1335 USA */
+
+
+/*
+ Utility program that encapsulates process creation, monitoring
+ and bulletproof process cleanup
+
+ Usage:
+ safe_process [options to safe_process] -- progname arg1 ... argn
+
+ To safeguard mysqld you would invoke safe_process with a few options
+ for safe_process itself followed by a double dash to indicate start
+ of the command line for the program you really want to start
+
+ $> safe_process --output=output.log -- mysqld --datadir=var/data1 ...
+
+ This would redirect output to output.log and then start mysqld,
+ once it has done that it will continue to monitor the child as well
+ as the parent.
+
+ The safe_process then checks the follwing things:
+ 1. Child exits, propagate the childs return code to the parent
+ by exiting with the same return code as the child.
+
+ 2. Parent dies, immediately kill the child and exit, thus the
+ parent does not need to properly cleanup any child, it is handled
+ automatically.
+
+ 3. Signal's recieced by the process will trigger same action as 2)
+
+*/
+
+#include <sys/types.h>
+#include <sys/wait.h>
+#include <sys/time.h>
+#include <sys/resource.h>
+#include <unistd.h>
+#include <stdarg.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <signal.h>
+#include <string.h>
+#include <errno.h>
+
+int verbose= 0;
+int terminated= 0;
+pid_t child_pid= -1;
+char safe_process_name[32]= {0};
+
+
+static void message(const char* fmt, ...)
+{
+ if (!verbose)
+ return;
+ va_list args;
+ fprintf(stderr, "%s: ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ fflush(stderr);
+}
+
+
+static void die(const char* fmt, ...)
+{
+ va_list args;
+ fprintf(stderr, "%s: FATAL ERROR, ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ if (int last_err= errno)
+ fprintf(stderr, "error: %d, %s\n", last_err, strerror(last_err));
+ exit(6);
+}
+
+
+#ifdef __APPLE__
+#include <sys/sysctl.h>
+
+
+/*
+ Eventually we may want to adopt kern.corefile parsing code from
+ https://opensource.apple.com/source/xnu/xnu-3247.1.106/bsd/kern/kern_proc.c
+*/
+
+void handle_core(pid_t pid)
+{
+ char corefile[256];
+ int coredump;
+ size_t corefile_size= sizeof(corefile);
+ size_t coredump_size= sizeof(coredump);
+
+ if (sysctlbyname("kern.coredump", &coredump, &coredump_size, 0, 0) ||
+ sysctlbyname("kern.corefile", corefile, &corefile_size, 0, 0))
+ {
+ message("sysctlbyname failed: %d (%s)", errno, strerror(errno));
+ return;
+ }
+
+ if (!coredump)
+ {
+ message("core dumps disabled, to enable run sudo sysctl kern.coredump=1");
+ return;
+ }
+
+ if (!strncmp(corefile, "/cores/core.%P", corefile_size))
+ {
+ char from[256];
+ char *to= from + 7;
+
+ snprintf(from, sizeof(from), "/cores/core.%u", pid);
+ if (!access(from, R_OK))
+ {
+ if (symlink(from, to))
+ message("symlink failed: %d (%s)", errno, strerror(errno));
+ }
+ }
+}
+#else
+void handle_core(pid_t pid __attribute__((unused))) {}
+#endif
+
+
+static int kill_child(bool was_killed)
+{
+ int status= 0;
+ pid_t ret_pid= 0;
+
+ message("Killing child: %d", child_pid);
+ // Terminate whole process group
+ if (! was_killed)
+ {
+ kill(-child_pid, SIGTERM);
+ sleep(10); // will be interrupted by SIGCHLD
+ if (!(ret_pid= waitpid(child_pid, &status, WNOHANG)))
+ kill(-child_pid, SIGKILL);
+ }
+
+ if (!ret_pid)
+ ret_pid= waitpid(child_pid, &status, 0);
+ if (ret_pid == child_pid)
+ {
+ int exit_code= 1;
+ if (WIFEXITED(status))
+ {
+ // Process has exited, collect return status
+ exit_code= WEXITSTATUS(status);
+ message("Child exit: %d", exit_code);
+ // Exit with exit status of the child
+ return exit_code;
+ }
+
+ if (WIFSIGNALED(status))
+ {
+ message("Child killed by signal: %d", WTERMSIG(status));
+ handle_core(child_pid);
+ }
+
+ return exit_code;
+ }
+ return 5;
+}
+
+
+extern "C" void handle_abort(int sig)
+{
+ message("Got signal %d, child_pid: %d, sending ABRT", sig, child_pid);
+
+ if (child_pid > 0) {
+ kill(-child_pid, SIGABRT); // Don't wait for it to terminate
+ }
+}
+
+
+extern "C" void handle_signal(int sig)
+{
+ message("Got signal %d, child_pid: %d", sig, child_pid);
+ terminated= 1;
+
+ if (child_pid > 0)
+ _exit(kill_child(sig == SIGCHLD));
+
+ // Ignore further signals
+ signal(SIGTERM, SIG_IGN);
+ signal(SIGINT, SIG_IGN);
+ signal(SIGHUP, SIG_IGN);
+
+ // Continune execution, allow the child to be started and
+ // finally terminated by monitor loop
+}
+
+
+void setlimit(int what, uint soft, uint hard)
+{
+ struct rlimit lim = { soft, hard };
+ if (setrlimit (what, &lim) < 0)
+ message("setrlimit failed, errno=%d", errno);
+}
+
+
+int main(int argc, char* const argv[] )
+{
+ char* const* child_argv= 0;
+ pid_t own_pid= getpid();
+ pid_t parent_pid= getppid();
+ bool nocore = false;
+ struct sigaction sa,sa_abort;
+
+ sa.sa_handler= handle_signal;
+ sa.sa_flags= SA_NOCLDSTOP;
+ sigemptyset(&sa.sa_mask);
+
+ sa_abort.sa_handler= handle_abort;
+ sa_abort.sa_flags= 0;
+ sigemptyset(&sa_abort.sa_mask);
+ /* Install signal handlers */
+ sigaction(SIGTERM, &sa,NULL);
+ sigaction(SIGINT, &sa,NULL);
+ sigaction(SIGHUP, &sa, NULL);
+ sigaction(SIGCHLD, &sa,NULL);
+ sigaction(SIGABRT, &sa_abort,NULL);
+
+ sprintf(safe_process_name, "safe_process[%ld]", (long) own_pid);
+
+ message("Started");
+
+ /* Parse arguments */
+ for (int i= 1; i < argc; i++) {
+ const char* arg= argv[i];
+ if (strcmp(arg, "--") == 0 && strlen(arg) == 2) {
+ /* Got the "--" delimiter */
+ if (i >= argc)
+ die("No real args -> nothing to do");
+ child_argv= &argv[i+1];
+ break;
+ } else {
+ if ( strcmp(arg, "--verbose") == 0 )
+ verbose++;
+ else if ( strncmp(arg, "--parent-pid", 12) == 0 )
+ {
+ /* Override parent_pid with a value provided by user */
+ const char* start;
+ if ((start= strstr(arg, "=")) == NULL)
+ die("Could not find start of option value in '%s'", arg);
+ start++; /* Step past = */
+ if ((parent_pid= atoi(start)) == 0)
+ die("Invalid value '%s' passed to --parent-id", start);
+ }
+ else if ( strcmp(arg, "--nocore") == 0 )
+ {
+ nocore = true; // Don't allow the process to dump core
+ }
+ else if ( strncmp (arg, "--env ", 6) == 0 )
+ {
+ putenv(strdup(arg+6));
+ }
+ else
+ die("Unknown option: %s", arg);
+ }
+ }
+ if (!child_argv || *child_argv == 0)
+ die("nothing to do");
+
+ message("parent_pid: %d", parent_pid);
+ if (parent_pid == own_pid)
+ die("parent_pid is equal to own pid!");
+
+ char buf;
+ int pfd[2];
+ if (pipe(pfd) == -1)
+ die("Failed to create pipe");
+
+ /* Create the child process */
+ while((child_pid= fork()) == -1)
+ {
+ message("fork failed");
+ sleep(1);
+ }
+
+ /*
+ Child: Make this process it's own process group to be able to kill
+ it and any its children that hasn't changed a group themselves)
+
+ Parent: Detach from the parent's process group, so that killing a parent
+ group wouldn't kill us (if we're killed, there's no one to kill our child
+ processes that run in their own process group). There's a loop below
+ that monitors the parent, it's enough.
+ */
+ setpgid(0, 0);
+
+
+ if (child_pid == 0)
+ {
+ close(pfd[0]); // Close unused read end
+
+ // Use default signal handlers in child
+ signal(SIGTERM, SIG_DFL);
+ signal(SIGINT, SIG_DFL);
+ signal(SIGHUP, SIG_DFL);
+ signal(SIGCHLD, SIG_DFL);
+
+ if (nocore)
+ setlimit(RLIMIT_CORE, 0, 0);
+
+ /*
+ mysqld defaults depend on that. make test results stable and independent
+ from the environment
+ */
+ setlimit(RLIMIT_NOFILE, 1024, 1024);
+
+ // Signal that child is ready
+ buf= 37;
+ if ((write(pfd[1], &buf, 1)) < 1)
+ die("Failed to signal that child is ready");
+ // Close write end
+ close(pfd[1]);
+
+ execvp(child_argv[0], child_argv);
+ die("Failed to exec child");
+ }
+
+ close(pfd[1]); // Close unused write end
+
+ // Wait for child to signal it's ready
+ if ((read(pfd[0], &buf, 1)) < 1)
+ die("Failed to read signal from child");
+
+ if (buf != 37)
+ die("Didn't get 37 from pipe");
+ close(pfd[0]); // Close read end
+
+ /* Monitor loop */
+ message("Started child %d, terminated: %d", child_pid, terminated);
+
+ while (!terminated)
+ {
+ // Check if parent is still alive
+ if (kill(parent_pid, 0) != 0)
+ {
+ message("Parent is not alive anymore");
+ break;
+ }
+ /* Wait for parent or child to die */
+ sleep(1);
+ }
+ return kill_child(0);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/safe_process_win.cc b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
new file mode 100644
index 00000000..8a5bb60a
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/safe_process_win.cc
@@ -0,0 +1,389 @@
+/* Copyright (c) 2007, 2011, Oracle and/or its affiliates. All rights reserved.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA */
+
+
+/*
+ Utility program that encapsulates process creation, monitoring
+ and bulletproof process cleanup
+
+ Usage:
+ safe_process [options to safe_process] -- progname arg1 ... argn
+
+ To safeguard mysqld you would invoke safe_process with a few options
+ for safe_process itself followed by a double dash to indicate start
+ of the command line for the program you really want to start
+
+ $> safe_process --output=output.log -- mysqld --datadir=var/data1 ...
+
+ This would redirect output to output.log and then start mysqld,
+ once it has done that it will continue to monitor the child as well
+ as the parent.
+
+ The safe_process then checks the follwing things:
+ 1. Child exits, propagate the childs return code to the parent
+ by exiting with the same return code as the child.
+
+ 2. Parent dies, immediately kill the child and exit, thus the
+ parent does not need to properly cleanup any child, it is handled
+ automatically.
+
+ 3. Signal's recieced by the process will trigger same action as 2)
+
+ 4. The named event "safe_process[pid]" can be signaled and will
+ trigger same action as 2)
+
+ WARNING! Be careful when using ProcessExplorer, since it will open
+ a handle to each process(and maybe also the Job), the process
+ spawned by safe_process will not be closed off when safe_process
+ is killed.
+*/
+
+#include <windows.h>
+#include <stdio.h>
+#include <tlhelp32.h>
+#include <signal.h>
+#include <stdlib.h>
+
+static int verbose= 0;
+static char safe_process_name[32]= {0};
+
+static void message(const char* fmt, ...)
+{
+ if (!verbose)
+ return;
+ va_list args;
+ fprintf(stderr, "%s: ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ fflush(stderr);
+}
+
+
+static void die(const char* fmt, ...)
+{
+ int last_err= GetLastError();
+ va_list args;
+ fprintf(stderr, "%s: FATAL ERROR, ", safe_process_name);
+ va_start(args, fmt);
+ vfprintf(stderr, fmt, args);
+ fprintf(stderr, "\n");
+ va_end(args);
+ if (last_err)
+ {
+ char *message_text;
+ if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER
+ |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, last_err , 0, (LPSTR)&message_text,
+ 0, NULL))
+ {
+ fprintf(stderr,"error: %d, %s\n",last_err, message_text);
+ LocalFree(message_text);
+ }
+ else
+ {
+ /* FormatMessage failed, print error code only */
+ fprintf(stderr,"error:%d\n", last_err);
+ }
+ }
+ fflush(stderr);
+ exit(1);
+}
+
+
+DWORD get_parent_pid(DWORD pid)
+{
+ HANDLE snapshot;
+ DWORD parent_pid= 0;
+ PROCESSENTRY32 pe32;
+ pe32.dwSize= sizeof(PROCESSENTRY32);
+
+ snapshot= CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
+ if (snapshot == INVALID_HANDLE_VALUE)
+ die("CreateToolhelp32Snapshot failed");
+
+ if (!Process32First(snapshot, &pe32))
+ {
+ CloseHandle(snapshot);
+ die("Process32First failed");
+ }
+
+ do
+ {
+ if (pe32.th32ProcessID == pid)
+ parent_pid= pe32.th32ParentProcessID;
+ } while(Process32Next( snapshot, &pe32));
+ CloseHandle(snapshot);
+
+ if (parent_pid == 0)
+ die("Could not find parent pid");
+
+ return parent_pid;
+}
+
+
+enum {
+ PARENT,
+ CHILD,
+ EVENT,
+ NUM_HANDLES
+};
+
+
+HANDLE shutdown_event;
+void handle_signal (int signal)
+{
+ message("Got signal: %d", signal);
+ if(SetEvent(shutdown_event) == 0) {
+ /* exit safe_process and (hopefully) kill off the child */
+ die("Failed to SetEvent");
+ }
+}
+
+
+int main(int argc, const char** argv )
+{
+ char child_args[4096]= {0};
+ DWORD pid= GetCurrentProcessId();
+ DWORD parent_pid= get_parent_pid(pid);
+ HANDLE job_handle;
+ HANDLE wait_handles[NUM_HANDLES]= {0};
+ PROCESS_INFORMATION process_info= {0};
+ BOOL nocore= FALSE;
+
+ sprintf(safe_process_name, "safe_process[%lu]", pid);
+
+ /* Create an event for the signal handler */
+ if ((shutdown_event=
+ CreateEvent(NULL, TRUE, FALSE, safe_process_name)) == NULL)
+ die("Failed to create shutdown_event");
+ wait_handles[EVENT]= shutdown_event;
+
+ signal(SIGINT, handle_signal);
+ signal(SIGBREAK, handle_signal);
+ signal(SIGTERM, handle_signal);
+
+ message("Started");
+
+ /* Parse arguments */
+ for (int i= 1; i < argc; i++) {
+ const char* arg= argv[i];
+ char* to= child_args;
+ if (strcmp(arg, "--") == 0 && strlen(arg) == 2) {
+ /* Got the "--" delimiter */
+ if (i >= argc)
+ die("No real args -> nothing to do");
+ /* Copy the remaining args to child_arg */
+ for (int j= i+1; j < argc; j++) {
+ arg= argv[j];
+ if (strchr (arg, ' ') &&
+ arg[0] != '\"' &&
+ arg[strlen(arg)] != '\"')
+ {
+ /* Quote arg that contains spaces and are not quoted already */
+ to+= _snprintf(to, child_args + sizeof(child_args) - to,
+ "\"%s\" ", arg);
+ }
+ else
+ {
+ to+= _snprintf(to, child_args + sizeof(child_args) - to,
+ "%s ", arg);
+ }
+ }
+ break;
+ } else {
+ if (strcmp(arg, "--verbose") == 0)
+ verbose++;
+ else if (strncmp(arg, "--parent-pid", 12) == 0)
+ {
+ /* Override parent_pid with a value provided by user */
+ const char* start;
+ if ((start= strstr(arg, "=")) == NULL)
+ die("Could not find start of option value in '%s'", arg);
+ start++; /* Step past = */
+ if ((parent_pid= atoi(start)) == 0)
+ die("Invalid value '%s' passed to --parent-id", start);
+ }
+ else if (strcmp(arg, "--nocore") == 0)
+ {
+ nocore= TRUE;
+ }
+ else if ( strncmp (arg, "--env ", 6) == 0 )
+ {
+ putenv(strdup(arg+6));
+ }
+ else
+ die("Unknown option: %s", arg);
+ }
+ }
+ if (*child_args == '\0')
+ die("nothing to do");
+
+ /* Open a handle to the parent process */
+ message("parent_pid: %d", parent_pid);
+ if (parent_pid == pid)
+ die("parent_pid is equal to own pid!");
+
+ if ((wait_handles[PARENT]=
+ OpenProcess(SYNCHRONIZE, FALSE, parent_pid)) == NULL)
+ die("Failed to open parent process with pid: %d", parent_pid);
+
+ /* Create the child process in a job */
+ JOBOBJECT_EXTENDED_LIMIT_INFORMATION jeli = { 0 };
+ STARTUPINFO si = { 0 };
+ si.cb = sizeof(si);
+
+ /*
+ Create the job object to make it possible to kill the process
+ and all of it's children in one go
+ */
+ if ((job_handle= CreateJobObject(NULL, NULL)) == NULL)
+ die("CreateJobObject failed");
+
+ /*
+ Make all processes associated with the job terminate when the
+ last handle to the job is closed.
+ */
+#ifndef JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE
+#define JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE 0x00002000
+#endif
+
+ jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;
+ if (SetInformationJobObject(job_handle, JobObjectExtendedLimitInformation,
+ &jeli, sizeof(jeli)) == 0)
+ message("SetInformationJobObject failed, continue anyway...");
+
+ /* Avoid popup box */
+ if (nocore)
+ SetErrorMode(SEM_FAILCRITICALERRORS | SEM_NOGPFAULTERRORBOX
+ | SEM_NOOPENFILEERRORBOX);
+
+#if 0
+ /* Setup stdin, stdout and stderr redirect */
+ si.dwFlags= STARTF_USESTDHANDLES;
+ si.hStdInput= GetStdHandle(STD_INPUT_HANDLE);
+ si.hStdOutput= GetStdHandle(STD_OUTPUT_HANDLE);
+ si.hStdError= GetStdHandle(STD_ERROR_HANDLE);
+#endif
+
+ /*
+ Create the process suspended to make sure it's assigned to the
+ Job before it creates any process of it's own
+
+ Allow the new process to break away from any job that this
+ process is part of so that it can be assigned to the new JobObject
+ we just created. This is safe since the new JobObject is created with
+ the JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE flag, making sure it will be
+ terminated when the last handle to it is closed(which is owned by
+ this process).
+
+ If breakaway from job fails on some reason, fallback is to create a
+ new process group. Process groups also allow to kill process and its
+ descedants, subject to some restrictions (processes have to run within
+ the same console,and must not ignore CTRL_BREAK)
+ */
+ DWORD create_flags[]= {CREATE_BREAKAWAY_FROM_JOB, CREATE_NEW_PROCESS_GROUP, 0};
+ BOOL process_created= FALSE;
+ BOOL jobobject_assigned= FALSE;
+
+ for (size_t i=0; i < sizeof(create_flags)/sizeof(create_flags[0]); i++)
+ {
+ process_created= CreateProcess(NULL, (LPSTR)child_args,
+ NULL,
+ NULL,
+ TRUE, /* inherit handles */
+ CREATE_SUSPENDED | create_flags[i],
+ NULL,
+ NULL,
+ &si,
+ &process_info);
+ if (process_created)
+ {
+ jobobject_assigned= AssignProcessToJobObject(job_handle, process_info.hProcess);
+ break;
+ }
+ }
+
+ if (!process_created)
+ {
+ die("CreateProcess failed");
+ }
+ ResumeThread(process_info.hThread);
+ CloseHandle(process_info.hThread);
+
+ wait_handles[CHILD]= process_info.hProcess;
+
+ message("Started child %d", process_info.dwProcessId);
+
+ /* Monitor loop */
+ DWORD child_exit_code= 1;
+ DWORD wait_res= WaitForMultipleObjects(NUM_HANDLES, wait_handles,
+ FALSE, INFINITE);
+ switch (wait_res)
+ {
+ case WAIT_OBJECT_0 + PARENT:
+ message("Parent exit");
+ break;
+ case WAIT_OBJECT_0 + CHILD:
+ if (GetExitCodeProcess(wait_handles[CHILD], &child_exit_code) == 0)
+ message("Child exit: could not get exit_code");
+ else
+ message("Child exit: exit_code: %d", child_exit_code);
+ break;
+ case WAIT_OBJECT_0 + EVENT:
+ message("Wake up from shutdown_event");
+ break;
+
+ default:
+ message("Unexpected result %d from WaitForMultipleObjects", wait_res);
+ break;
+ }
+ message("Exiting, child: %d", process_info.dwProcessId);
+
+ if (TerminateJobObject(job_handle, 201) == 0)
+ message("TerminateJobObject failed");
+ CloseHandle(job_handle);
+ message("Job terminated and closed");
+
+
+
+ if (wait_res != WAIT_OBJECT_0 + CHILD)
+ {
+ if (!jobobject_assigned)
+ {
+ TerminateProcess(process_info.hProcess, 202);
+ }
+ /* The child has not yet returned, wait for it */
+ message("waiting for child to exit");
+ if ((wait_res= WaitForSingleObject(wait_handles[CHILD], INFINITE))
+ != WAIT_OBJECT_0)
+ {
+ message("child wait failed: %d", wait_res);
+ }
+ else
+ {
+ message("child wait succeeded");
+ }
+ /* Child's exit code should now be 201, no need to get it */
+ }
+
+ message("Closing handles");
+ for (int i= 0; i < NUM_HANDLES; i++)
+ CloseHandle(wait_handles[i]);
+
+ message("Exiting, exit_code: %d", child_exit_code);
+ exit(child_exit_code);
+}
+
diff --git a/mysql-test/lib/My/SafeProcess/wsrep_check_version.c b/mysql-test/lib/My/SafeProcess/wsrep_check_version.c
new file mode 100644
index 00000000..7398bc8a
--- /dev/null
+++ b/mysql-test/lib/My/SafeProcess/wsrep_check_version.c
@@ -0,0 +1,51 @@
+/*
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; version 2 of the License.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA
+ */
+
+#include <my_global.h>
+#include <string.h>
+#include "../../../../wsrep-lib/wsrep-API/v26/wsrep_api.h"
+
+int main(int argc, char **argv)
+{
+ int rc= 1;
+ void *dlh;
+ const char *provider= getenv("WSREP_PROVIDER");
+ char** dlversion= NULL;
+
+ if (!provider || !*provider)
+ {
+ printf("WSREP_PROVIDER is not set\n");
+ return 1;
+ }
+ if (!(dlh= dlopen(provider, RTLD_NOW | RTLD_LOCAL)))
+ {
+ printf("Can't open WSREP_PROVIDER (%s) library, error: %s\n",
+ provider, dlerror());
+ return 1;
+ }
+
+ dlversion= (char**) dlsym(dlh, "wsrep_interface_version");
+ if (dlversion && *dlversion)
+ {
+ rc= strcmp(*dlversion, WSREP_INTERFACE_VERSION) ? 2 : 0;
+ if (rc)
+ printf("Wrong wsrep provider library version, found: %s, need: %s\n", *dlversion, WSREP_INTERFACE_VERSION);
+ }
+ else
+ printf("Galera library does not contain a version symbol");
+
+ dlclose(dlh);
+ return rc;
+}
diff --git a/mysql-test/lib/My/Suite.pm b/mysql-test/lib/My/Suite.pm
new file mode 100644
index 00000000..a603008f
--- /dev/null
+++ b/mysql-test/lib/My/Suite.pm
@@ -0,0 +1,27 @@
+# A default suite class that is used for all suites without their owns suite.pm
+# see README.suites for a description
+
+package My::Suite;
+
+sub is_default { 0 }
+sub config_files { () }
+sub servers { () }
+sub skip_combinations { () }
+
+sub new { bless { } }
+
+sub list_cases {
+ my ($self, $testdir) = @_;
+ opendir(TESTDIR, $testdir) or return ();
+ my (@cases) = grep { s/\.test$// } readdir TESTDIR;
+ closedir TESTDIR;
+ @cases;
+}
+
+sub start_test {
+ my ($self, $tinfo)= @_;
+ &::start_mysqltest($tinfo);
+}
+
+bless { };
+
diff --git a/mysql-test/lib/My/SysInfo.pm b/mysql-test/lib/My/SysInfo.pm
new file mode 100644
index 00000000..211f72c0
--- /dev/null
+++ b/mysql-test/lib/My/SysInfo.pm
@@ -0,0 +1,206 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2013, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+
+package My::SysInfo;
+
+use strict;
+use Carp;
+use My::Platform;
+
+use constant DEFAULT_BOGO_MIPS => 2000;
+
+sub _cpuinfo {
+ my ($self)= @_;
+
+ my $info_file= "/proc/cpuinfo";
+ if ( !( -e $info_file and -f $info_file) ) {
+ return undef;
+ }
+
+ my $F= IO::File->new($info_file) or return undef;
+
+ # Set input separator to blank line
+ local $/ = '';
+
+ while ( my $cpu_chunk= <$F>) {
+ chomp($cpu_chunk);
+
+ my $cpuinfo = {};
+
+ foreach my $cpuline ( split(/\n/, $cpu_chunk) ) {
+ my ( $attribute, $value ) = split(/\s*:\s*/, $cpuline);
+
+ $attribute =~ s/\s+/_/;
+ $attribute = lc($attribute);
+
+ if ( $value =~ /^(no|not available|yes)$/ ) {
+ $value = $value eq 'yes' ? 1 : 0;
+ }
+
+ if ( $attribute eq 'flags' ) {
+ @{ $cpuinfo->{flags} } = split / /, $value;
+ } else {
+ $cpuinfo->{$attribute} = $value;
+ }
+ }
+
+ # Make sure bogomips is set to some value
+ $cpuinfo->{bogomips} ||= DEFAULT_BOGO_MIPS;
+
+ # Cpus reported once, but with 'cpu_count' set to the actual number
+ my $cpu_count= $cpuinfo->{cpu_count} || 1;
+ for(1..$cpu_count){
+ push(@{$self->{cpus}}, $cpuinfo);
+ }
+ }
+ $F= undef; # Close file
+ return $self->{cpus};
+}
+
+
+sub _kstat {
+ my ($self)= @_;
+ while (1){
+ my $instance_num= $self->{cpus} ? @{$self->{cpus}} : 0;
+ my $list= `kstat -p -m cpu_info -i $instance_num 2> /dev/null`;
+ my @lines= split('\n', $list) or last; # Break loop
+
+ my $cpuinfo= {};
+ foreach my $line (@lines)
+ {
+ my ($module, $instance, $name, $statistic, $value)=
+ $line=~ /(\w*):(\w*):(\w*):(\w*)\t(.*)/;
+
+ $cpuinfo->{$statistic}= $value;
+ }
+
+ # Default value, the actual cpu values can be used to decrease this
+ # on slower cpus
+ $cpuinfo->{bogomips}= DEFAULT_BOGO_MIPS;
+
+ push(@{$self->{cpus}}, $cpuinfo);
+ }
+
+ return $self->{cpus};
+}
+
+
+sub _unamex {
+ my ($self)= @_;
+ # TODO
+ return undef;
+}
+
+
+sub new {
+ my ($class)= @_;
+
+
+ my $self= bless {
+ cpus => (),
+ }, $class;
+
+ my @info_methods =
+ (
+ \&_cpuinfo,
+ \&_kstat,
+ \&_unamex,
+ );
+
+ # Detect virtual machines
+ my $isvm= 0;
+
+ if (IS_WINDOWS) {
+ # Detect vmware service
+ $isvm= `tasklist` =~ /vmwareservice/i;
+ }
+ $self->{isvm}= $isvm;
+
+ foreach my $method (@info_methods){
+ if ($method->($self)){
+ return $self;
+ }
+ }
+
+ # Push a dummy cpu
+ push(@{$self->{cpus}},
+ {
+ bogomips => DEFAULT_BOGO_MIPS,
+ model_name => "unknown",
+ });
+
+ return $self;
+}
+
+
+# Return the list of cpus found
+sub cpus {
+ my ($self)= @_;
+ return @{$self->{cpus}} or
+ confess "INTERNAL ERROR: No cpus in list";
+}
+
+
+# Return the number of cpus found
+sub num_cpus {
+ my ($self)= @_;
+ return int(@{$self->{cpus}}) or
+ confess "INTERNAL ERROR: No cpus in list";
+}
+
+
+# Return the smallest bogomips value amongst the processors
+sub min_bogomips {
+ my ($self)= @_;
+
+ my $bogomips;
+
+ foreach my $cpu (@{$self->{cpus}}) {
+ if (!defined $bogomips or $bogomips > $cpu->{bogomips}) {
+ $bogomips= $cpu->{bogomips};
+ }
+ }
+
+ return $bogomips;
+}
+
+sub isvm {
+ my ($self)= @_;
+
+ return $self->{isvm};
+}
+
+
+# Prit the cpuinfo
+sub print_info {
+ my ($self)= @_;
+
+ foreach my $cpu (@{$self->{cpus}}) {
+ while ((my ($key, $value)) = each(%$cpu)) {
+ print " ", $key, "= ";
+ if (ref $value eq "ARRAY") {
+ print "[", join(", ", @$value), "]";
+ } else {
+ print $value;
+ }
+ print "\n";
+ }
+ print "\n";
+ }
+}
+
+1;
diff --git a/mysql-test/lib/My/Tee.pm b/mysql-test/lib/My/Tee.pm
new file mode 100644
index 00000000..8d6b4ddd
--- /dev/null
+++ b/mysql-test/lib/My/Tee.pm
@@ -0,0 +1,25 @@
+package My::Tee;
+use IO::Handle;
+
+# see PerlIO::via
+
+our $copyfh;
+
+sub PUSHED
+{
+ open($copyfh, '>', "$::opt_vardir/log/stdout.log")
+ or die "open(>$::opt_vardir/log/stdout.log): $!"
+ unless $copyfh;
+ bless { }, shift;
+}
+
+sub WRITE
+{
+ my ($obj, $buf, $fh) = @_;
+ print $fh $buf;
+ $fh->flush;
+ print $copyfh $buf;
+ return length($buf);
+}
+
+1;
diff --git a/mysql-test/lib/My/Test.pm b/mysql-test/lib/My/Test.pm
new file mode 100644
index 00000000..56e7cf6d
--- /dev/null
+++ b/mysql-test/lib/My/Test.pm
@@ -0,0 +1,120 @@
+# -*- cperl -*-
+# Copyright (c) 2008, 2011, Oracle and/or its affiliates. All rights reserved.
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; version 2 of the License.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1335 USA
+
+
+#
+# One test
+#
+package My::Test;
+
+use strict;
+use warnings;
+use Carp;
+use Storable();
+use mtr_results;
+
+
+sub new {
+ my $class= shift;
+ my $self= bless {
+ @_,
+ }, $class;
+ return $self;
+}
+
+sub copy {
+ my $self= shift;
+ my $copy= My::Test->new();
+ while (my ($key, $value) = each(%$self)) {
+ if (ref $value eq "ARRAY") {
+ $copy->{$key} = [ @$value ];
+ } else {
+ $copy->{$key}= $value;
+ }
+ }
+ $copy;
+}
+
+sub fullname {
+ my ($self)= @_;
+ $self->{name} . (defined $self->{combinations}
+ ? " '" . join(',', sort @{$self->{combinations}}) . "'"
+ : "")
+}
+
+#
+# Return a unique key that can be used to
+# identify this test in a hash
+#
+sub key {
+ my ($self)= @_;
+ return $self->{key};
+}
+
+
+sub is_failed {
+ my ($self)= @_;
+ my $result= $self->{result};
+ croak "'is_failed' can't be called until test has been run!"
+ unless defined $result;
+
+ return ($result eq 'MTR_RES_FAILED');
+}
+
+
+my %result_names= (
+ 'MTR_RES_PASSED' => 'pass',
+ 'MTR_RES_FAILED' => 'fail',
+ 'MTR_RES_SKIPPED' => 'skipped',
+ );
+
+sub write_test {
+ my ($test, $sock, $header)= @_;
+
+ if ($::opt_resfile && defined $test->{'result'}) {
+ resfile_test_info("result", $result_names{$test->{'result'}});
+ if ($test->{'timeout'}) {
+ resfile_test_info("comment", "Timeout");
+ } elsif (defined $test->{'comment'}) {
+ resfile_test_info("comment", $test->{'comment'});
+ }
+ resfile_test_info("result", "warning") if defined $test->{'check'};
+ resfile_to_test($test);
+ }
+
+ # Give the test a unique key before serializing it
+ $test->{key}= "$test" unless defined $test->{key};
+
+ my $serialized= Storable::freeze($test);
+ $serialized =~ s/([\x0d\x0a\\])/sprintf("\\%02x", ord($1))/eg;
+ send $sock,$header. "\n". $serialized. "\n", 0;
+}
+
+
+sub read_test {
+ my ($sock)= @_;
+ my $serialized= <$sock>;
+ chomp($serialized);
+ $serialized =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/eg;
+ my $test= Storable::thaw($serialized);
+ use Data::Dumper;
+ confess "Not My::Test: ". ref($test). "\n". Dumper(\$test, $serialized)
+ unless ref($test) eq 'My::Test';
+ resfile_from_test($test) if $::opt_resfile;
+ return $test;
+}
+
+1;