diff options
Diffstat (limited to 'mysql-test/lib/My')
| -rw-r--r-- | mysql-test/lib/My/Config.pm | 544 | ||||
| -rw-r--r-- | mysql-test/lib/My/ConfigFactory.pm | 483 | ||||
| -rw-r--r-- | mysql-test/lib/My/CoreDump.pm | 516 | ||||
| -rw-r--r-- | mysql-test/lib/My/Debugger.pm | 287 | ||||
| -rw-r--r-- | mysql-test/lib/My/File/Path.pm | 225 | ||||
| -rw-r--r-- | mysql-test/lib/My/Find.pm | 246 | ||||
| -rw-r--r-- | mysql-test/lib/My/Handles.pm | 71 | ||||
| -rw-r--r-- | mysql-test/lib/My/Options.pm | 179 | ||||
| -rw-r--r-- | mysql-test/lib/My/Platform.pm | 299 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess.pm | 640 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/Base.pm | 227 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/CMakeLists.txt | 50 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/safe_kill_win.cc | 146 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/safe_process.cc | 364 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/safe_process_win.cc | 389 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/wsrep_check_version.c | 51 | ||||
| -rw-r--r-- | mysql-test/lib/My/Suite.pm | 27 | ||||
| -rw-r--r-- | mysql-test/lib/My/SysInfo.pm | 206 | ||||
| -rw-r--r-- | mysql-test/lib/My/Tee.pm | 25 | ||||
| -rw-r--r-- | mysql-test/lib/My/Test.pm | 120 |
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; |