diff options
Diffstat (limited to 'mysql-test/lib/My')
| -rw-r--r-- | mysql-test/lib/My/Config.pm | 106 | ||||
| -rw-r--r-- | mysql-test/lib/My/ConfigFactory.pm | 657 | ||||
| -rw-r--r-- | mysql-test/lib/My/CoreDump.pm | 131 | ||||
| -rw-r--r-- | mysql-test/lib/My/File/Path.pm | 177 | ||||
| -rw-r--r-- | mysql-test/lib/My/Find.pm | 245 | ||||
| -rwxr-xr-x | mysql-test/lib/My/Handles.pm | 69 | ||||
| -rw-r--r-- | mysql-test/lib/My/Options.pm | 199 | ||||
| -rw-r--r-- | mysql-test/lib/My/Platform.pm | 156 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess.pm | 580 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/Base.pm | 212 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/CMakeLists.txt | 17 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/Makefile.am | 28 | ||||
| -rwxr-xr-x | mysql-test/lib/My/SafeProcess/safe_kill_win.cc | 85 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/safe_process.cc | 277 | ||||
| -rw-r--r-- | mysql-test/lib/My/SafeProcess/safe_process.pl | 151 | ||||
| -rwxr-xr-x | mysql-test/lib/My/SafeProcess/safe_process_win.cc | 316 | ||||
| -rw-r--r-- | mysql-test/lib/My/SysInfo.pm | 211 | ||||
| -rw-r--r-- | mysql-test/lib/My/Test.pm | 123 |
18 files changed, 3716 insertions, 24 deletions
diff --git a/mysql-test/lib/My/Config.pm b/mysql-test/lib/My/Config.pm index 5491e341ddc..f8416e3df3a 100644 --- a/mysql-test/lib/My/Config.pm +++ b/mysql-test/lib/My/Config.pm @@ -4,6 +4,7 @@ package My::Config::Option; use strict; use warnings; +use Carp; sub new { @@ -26,12 +27,22 @@ sub value { return $self->{value}; } +sub option { + my ($self)= @_; + my $name= $self->{name}; + my $value= $self->{value}; + + my $opt= $name; + $opt= "$name=$value" if ($value); + $opt= "--$opt" unless ($opt =~ /^--/); + return $opt; +} package My::Config::Group; use strict; use warnings; - +use Carp; sub new { my ($class, $group_name)= @_; @@ -68,7 +79,7 @@ sub remove { return undef unless defined $option; # Remove from the hash - delete($self->{options_by_name}->{$option_name}) or die; + delete($self->{options_by_name}->{$option_name}) or croak; # Remove from the array @{$self->{options}}= grep { $_->name ne $option_name } @{$self->{options}}; @@ -88,6 +99,33 @@ sub name { 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 @@ -100,23 +138,37 @@ sub option { # -# Return a specific value for an option in the group +# 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); - die "No option named '$option_name' in this group" + 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; use strict; use warnings; +use Carp; use IO::File; use File::Basename; @@ -132,13 +184,13 @@ sub new { my $self= bless { groups => [] }, $class; my $F= IO::File->new($path, "<") - or die "Could not open '$path': $!"; + or croak "Could not open '$path': $!"; while ( my $line= <$F> ) { chomp($line); # [group] - if ( $line =~ /\[(.*)\]/ ) { + if ( $line =~ /^\[(.*)\]/ ) { # New group found $group_name= $1; #print "group: $group_name\n"; @@ -149,7 +201,7 @@ sub new { # Magic #! comments elsif ( $line =~ /^#\!/) { my $magic= $line; - die "Found magic comment '$magic' outside of group" + croak "Found magic comment '$magic' outside of group" unless $group_name; #print "$magic\n"; @@ -171,8 +223,13 @@ sub new { # !include <filename> elsif ( $line =~ /^\!include\s*(.*?)\s*$/ ) { my $include_file_name= dirname($path)."/".$1; - # Check that the file exists - die "The include file '$include_file_name' does not exist" + + # 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)); @@ -182,7 +239,7 @@ sub new { elsif ( $line =~ /^([\@\w-]+)\s*$/ ) { my $option= $1; - die "Found option '$option' outside of group" + croak "Found option '$option' outside of group" unless $group_name; #print "$option\n"; @@ -194,13 +251,13 @@ sub new { my $option= $1; my $value= $2; - die "Found option '$option=$value' outside of group" + croak "Found option '$option=$value' outside of group" unless $group_name; #print "$option=$value\n"; $self->insert($group_name, $option, $value); } else { - die "Unexpected line '$line' found in '$path'"; + croak "Unexpected line '$line' found in '$path'"; } } @@ -231,6 +288,7 @@ sub insert { # Add the option to the group $group->insert($option, $value, $if_not_exist); } + return $group; } # @@ -240,11 +298,11 @@ sub remove { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); $group->remove($option_name) or - die "option '$option_name' does not exist"; + croak "option '$option_name' does not exist"; } @@ -267,10 +325,10 @@ sub group_exists { # sub _group_insert { my ($self, $group_name)= @_; - caller eq __PACKAGE__ or die; + caller eq __PACKAGE__ or croak; # Check that group does not already exist - die "Group already exists" if $self->group_exists($group_name); + croak "Group already exists" if $self->group_exists($group_name); my $group= My::Config::Group->new($group_name); push(@{$self->{groups}}, $group); @@ -354,11 +412,11 @@ sub value { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); my $option= $group->option($option_name); - die "option '$option_name' does not exist" + croak "option '$option_name' does not exist" unless defined($option); return $option->value(); @@ -372,7 +430,7 @@ sub exists { my ($self, $group_name, $option_name)= @_; my $group= $self->group($group_name); - die "group '$group_name' does not exist" + croak "group '$group_name' does not exist" unless defined($group); my $option= $group->option($option_name); @@ -412,11 +470,11 @@ sub stringify { # Save the config to named file # sub save { - my ($self, $path)= @_; - my $F= IO::File->new($path, ">") - or die "Could not open '$path': $!"; - print $F $self; - undef $F; # Close the file + my ($self, $path)= @_; + my $F= IO::File->new($path, ">") + or croak "Could not open '$path': $!"; + print $F $self; + undef $F; # Close the file } 1; diff --git a/mysql-test/lib/My/ConfigFactory.pm b/mysql-test/lib/My/ConfigFactory.pm new file mode 100644 index 00000000000..b86243d3705 --- /dev/null +++ b/mysql-test/lib/My/ConfigFactory.pm @@ -0,0 +1,657 @@ +# -*- cperl -*- +package My::ConfigFactory; + +use strict; +use warnings; +use Carp; + +use My::Config; +use My::Find; + +use File::Basename; + + +# +# Rules to run first of all +# +my @pre_rules= +( +); + + +my @share_locations= ("share/mysql", "sql/share", "share"); + + +sub get_basedir { + my ($self, $group)= @_; + my $basedir= $group->if_exist('basedir') || + $self->{ARGS}->{basedir}; + return $basedir; +} + + +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_basedir($group), + \@share_locations, "english"); +} + +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)= @_; + my $hostname= $group->value('#host'); + return $self->{HOSTS}->{$hostname}++; +} + +sub fix_host { + my ($self)= @_; + # Get next host from HOSTS array + my @hosts= keys(%{$self->{HOSTS}});; + my $host_no= $self->{NEXT_HOST}++ % @hosts; + return $hosts[$host_no]; +} + +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= dirname($group->value('datadir')); + return "$dir/mysqld.err"; +} + +sub fix_log { + my ($self, $config, $group_name, $group)= @_; + my $dir= dirname($group->value('datadir')); + return "$dir/mysqld.log"; +} + +sub fix_log_slow_queries { + my ($self, $config, $group_name, $group)= @_; + my $dir= dirname($group->value('datadir')); + return "$dir/mysqld-slow.log"; +} + +sub fix_secure_file_priv { + my ($self)= @_; + my $vardir= $self->{ARGS}->{vardir}; + # By default, prevent the started mysqld to access files outside of vardir + return $vardir; +} + +sub fix_std_data { + my ($self, $config, $group_name, $group)= @_; + my $basedir= $self->get_basedir($group); + return "$basedir/mysql-test/std_data"; +} + +sub ssl_supported { + my ($self)= @_; + return $self->{ARGS}->{ssl}; +} + +sub fix_skip_ssl { + return if !ssl_supported(@_); + # Add skip-ssl if ssl is supported to avoid + # that mysqltest connects with SSL by default + return 1; +} + +sub fix_ssl_ca { + return if !ssl_supported(@_); + my $std_data= fix_std_data(@_); + return "$std_data/cacert.pem" +} + +sub fix_ssl_server_cert { + return if !ssl_supported(@_); + my $std_data= fix_std_data(@_); + return "$std_data/server-cert.pem" +} + +sub fix_ssl_client_cert { + return if !ssl_supported(@_); + my $std_data= fix_std_data(@_); + return "$std_data/client-cert.pem" +} + +sub fix_ssl_server_key { + return if !ssl_supported(@_); + my $std_data= fix_std_data(@_); + return "$std_data/server-key.pem" +} + +sub fix_ssl_client_key { + return if !ssl_supported(@_); + my $std_data= fix_std_data(@_); + return "$std_data/client-key.pem" +} + + +# +# 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 }, + { 'language' => \&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' => sub { return 1; } }, + { 'general-log-file' => \&fix_log }, + { 'slow-query-log-file' => \&fix_log_slow_queries }, + { 'slow-query-log' => sub { return 1; } }, + { '#user' => sub { return shift->{ARGS}->{user} || ""; } }, + { '#password' => sub { return shift->{ARGS}->{password} || ""; } }, + { 'server-id' => \&fix_server_id, }, + # By default, prevent the started mysqld to access files outside of vardir + { 'secure-file-priv' => sub { return shift->{ARGS}->{vardir}; } }, + { 'ssl-ca' => \&fix_ssl_ca }, + { 'ssl-cert' => \&fix_ssl_server_cert }, + { 'ssl-key' => \&fix_ssl_server_key }, + ); + + +sub fix_ndb_mgmd_port { + my ($self, $config, $group_name, $group)= @_; + my $hostname= $group->value('HostName'); + return $self->{HOSTS}->{$hostname}++; +} + + +sub fix_cluster_dir { + my ($self, $config, $group_name, $group)= @_; + my $vardir= $self->{ARGS}->{vardir}; + my (undef, $process_type, $idx, $suffix)= split(/\./, $group_name); + return "$vardir/mysql_cluster.$suffix/$process_type.$idx"; +} + + +sub fix_cluster_backup_dir { + my ($self, $config, $group_name, $group)= @_; + my $vardir= $self->{ARGS}->{vardir}; + my (undef, $process_type, $idx, $suffix)= split(/\./, $group_name); + return "$vardir/mysql_cluster.$suffix/"; +} + + +# +# Rules to run for each ndb_mgmd in the config +# - will be run in order listed here +# +my @ndb_mgmd_rules= +( + { 'PortNumber' => \&fix_ndb_mgmd_port }, + { 'DataDir' => \&fix_cluster_dir }, +); + + +# +# Rules to run for each ndbd in the config +# - will be run in order listed here +# +my @ndbd_rules= +( + { 'HostName' => \&fix_host }, + { 'DataDir' => \&fix_cluster_dir }, + { 'BackupDataDir' => \&fix_cluster_backup_dir }, +); + + +# +# Rules to run for each cluster_config section +# - will be run in order listed here +# +my @cluster_config_rules= +( + { 'ndb_mgmd' => \&fix_host }, + { 'ndbd' => \&fix_host }, + { 'mysqld' => \&fix_host }, + { 'ndbapi' => \&fix_host }, +); + + +# +# Rules to run for [client] section +# - will be run in order listed here +# +my @client_rules= +( +); + + +# +# Rules to run for [mysqltest] section +# - will be run in order listed here +# +my @mysqltest_rules= +( + { 'ssl-ca' => \&fix_ssl_ca }, + { 'ssl-cert' => \&fix_ssl_client_cert }, + { 'ssl-key' => \&fix_ssl_client_key }, + { 'skip-ssl' => \&fix_skip_ssl }, +); + + +# +# Rules to run for [mysqlbinlog] section +# - will be run in order listed here +# +my @mysqlbinlog_rules= +( + { 'character-sets-dir' => \&fix_charset_dir }, +); + + +# +# 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'"; + } + $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 = + ( + '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 grep ( $option->name() eq $_, @no_copy); + + $config->insert('embedded', $option->name(), $option->value()) + } + +} + + +sub resolve_at_variable { + my ($self, $config, $group, $option)= @_; + + # Split the options value on last . + my @parts= split(/\./, $option->value()); + my $option_name= pop(@parts); + my $group_name= join('.', @parts); + + $group_name =~ s/^\@//; # Remove at + + my $from_group= $config->group($group_name) + or croak "There is no group named '$group_name' that ", + "can be used to resolve '$option_name'"; + + my $from= $from_group->value($option_name); + $config->insert($group->name(), $option->name(), $from) +} + + +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() =~ /^\@/); + } + } +} + +sub post_fix_mysql_cluster_section { + my ($self, $config)= @_; + + # Add a [mysl_cluster.<suffix>] section for each + # defined [cluster_config.<suffix>] section + foreach my $group ( $config->like('cluster_config\.\w*$') ) + { + my @urls; + # Generate ndb_connectstring for this cluster + foreach my $ndb_mgmd ( $config->like('cluster_config.ndb_mgmd.')) { + if ($ndb_mgmd->suffix() eq $group->suffix()) { + my $host= $ndb_mgmd->value('HostName'); + my $port= $ndb_mgmd->value('PortNumber'); + push(@urls, "$host:$port"); + } + } + croak "Could not generate valid ndb_connectstring for '$group'" + unless @urls > 0; + my $ndb_connectstring= join(";", @urls); + + # Add ndb_connectstring to [mysql_cluster.<suffix>] + $config->insert('mysql_cluster'.$group->suffix(), + 'ndb_connectstring', $ndb_connectstring); + + # Add ndb_connectstring to each mysqld connected to this + # cluster + foreach my $mysqld ( $config->like('cluster_config.mysqld.')) { + if ($mysqld->suffix() eq $group->suffix()) { + my $after= $mysqld->after('cluster_config.mysqld'); + $config->insert("mysqld$after", + 'ndb_connectstring', $ndb_connectstring); + } + } + } +} + +# +# Rules to run last of all +# +my @post_rules= +( + \&post_check_client_groups, + \&post_fix_mysql_cluster_section, + \&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 run_generate_sections_from_cluster_config { + my ($self, $config)= @_; + + my @options= ('ndb_mgmd', 'ndbd', + 'mysqld', 'ndbapi'); + + foreach my $group ( $config->like('cluster_config\.\w*$') ) { + + # Keep track of current index per process type + my %idxes; + map { $idxes{$_}= 1; } @options; + + foreach my $option_name ( @options ) { + my $value= $group->value($option_name); + my @hosts= split(/,/, $value, -1); # -1 => return also empty strings + + # Add at least one host + push(@hosts, undef) unless scalar(@hosts); + + # Assign hosts unless already fixed + @hosts= map { $self->fix_host() unless $_; } @hosts; + + # Write the hosts value back + $group->insert($option_name, join(",", @hosts)); + + # Generate sections for each host + foreach my $host ( @hosts ){ + my $idx= $idxes{$option_name}++; + + my $suffix= $group->suffix(); + # Generate a section for ndb_mgmd to read + $config->insert("cluster_config.$option_name.$idx$suffix", + "HostName", $host); + + if ($option_name eq 'mysqld'){ + my $datadir= + $self->fix_cluster_dir($config, + "cluster_config.mysqld.$idx$suffix", + $group); + $config->insert("mysqld.$idx$suffix", + 'datadir', "$datadir/data"); + } + } + } + } +} + + +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}; + } + + # Fill in hosts/port hash + my $hosts= {}; + my $baseport= $args->{baseport}; + $args->{hosts}= [ 'localhost' ] unless exists($args->{hosts}); + foreach my $host ( @{$args->{hosts}} ) { + $hosts->{$host}= $baseport; + } + + # Open the config template + my $config= My::Config->new($args->{'template_path'}); + my $extra_template_path= $args->{'extra_template_path'}; + if ($extra_template_path){ + $config->append(My::Config->new($extra_template_path)); + } + my $self= bless { + CONFIG => $config, + ARGS => $args, + HOSTS => $hosts, + NEXT_HOST => 0, + SERVER_ID => 1, + }, $class; + + + { + # Run pre rules + foreach my $rule ( @pre_rules ) { + &$rule($self, $config); + } + } + + + $self->run_section_rules($config, + 'cluster_config\.\w*$', + @cluster_config_rules); + $self->run_generate_sections_from_cluster_config($config); + + $self->run_section_rules($config, + 'cluster_config.ndb_mgmd.', + @ndb_mgmd_rules); + $self->run_section_rules($config, + 'cluster_config.ndbd', + @ndbd_rules); + + $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 00000000000..599f9ccbfca --- /dev/null +++ b/mysql-test/lib/My/CoreDump.pm @@ -0,0 +1,131 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 USA + +package My::CoreDump; + +use strict; +use Carp; +use My::Platform; + +use File::Temp qw/ tempfile tempdir /; + +sub _gdb { + my ($core_name)= @_; + + print "\nTrying 'gdb' to get a backtrace\n"; + + return unless -f $core_name; + + # 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; + print "Core generated by '$binary'\n"; + + # Create tempfile containing gdb commands + my ($tmp, $tmp_name) = tempfile(); + print $tmp + "bt\n", + "thread apply all bt\n", + "quit\n"; + 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; + + 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)= @_; + + 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; + print "Core generated by '$binary'\n"; + + # 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; + + 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; +} + + +sub show { + my ($class, $core_name)= @_; + + # We try dbx first; gdb itself may coredump if run on a Sun Studio + # compiled binary on Solaris. + + my @debuggers = + ( + \&_dbx, + \&_gdb, + # TODO... + ); + + # Try debuggers until one succeeds + + foreach my $debugger (@debuggers){ + if ($debugger->($core_name)){ + return; + } + } + return; +} + + +1; diff --git a/mysql-test/lib/My/File/Path.pm b/mysql-test/lib/My/File/Path.pm new file mode 100644 index 00000000000..99edeecdaf7 --- /dev/null +++ b/mysql-test/lib/My/File/Path.pm @@ -0,0 +1,177 @@ +# -*- cperl -*- +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 /; + +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; + } + copy("$from_dir/$_", "$to_dir/$_"); + } + closedir(DIR); + + if ($orig_umask){ + # Set the original umask + umask($orig_umask); + } +} + +1; diff --git a/mysql-test/lib/My/Find.pm b/mysql-test/lib/My/Find.pm new file mode 100644 index 00000000000..8557584bbc8 --- /dev/null +++ b/mysql-test/lib/My/Find.pm @@ -0,0 +1,245 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 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); + +our $vs_config_dir; + +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_find_paths($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_find_paths($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 first existing directory in one of +# the given paths +# +# 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>])" + unless (@_ == 3 or @_ == 2); + + # ------------------------------------------------------- + # Find and return the first directory + # ------------------------------------------------------- + foreach my $path (my_find_paths($base, $paths, $dirs)) { + return $path if ( -d $path ); + } + find_error($base, $paths, $dirs); +} + + +sub my_find_paths { + 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= $vs_config_dir || $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; + } + + # ------------------------------------------------------- + # Windows specific + # ------------------------------------------------------- + if (IS_WINDOWS) { + # 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_find_paths($base, $paths, $names))), "\n"; +} + +1; diff --git a/mysql-test/lib/My/Handles.pm b/mysql-test/lib/My/Handles.pm new file mode 100755 index 00000000000..66ee22b403f --- /dev/null +++ b/mysql-test/lib/My/Handles.pm @@ -0,0 +1,69 @@ +# -*- cperl -*- +# Copyright (C) 2008 MySQL AB +# +# 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-1301 USA + +package My::Handles; + + +use strict; +use Carp; + +use My::Platform; + +my $handle_exe; + + +if (IS_WINDOWS){ + # 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= "$1.$2" + if ($line =~ /Handle v([0-9]*)\.([0-9]*)/); + } + if ($handle_exe){ + 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 00000000000..40f05c41d1c --- /dev/null +++ b/mysql-test/lib/My/Options.pm @@ -0,0 +1,199 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 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) + } + elsif ($option=~ /^-O$/){ + return (undef, undef); + } + 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_set { + my ($opts, $set_opts)= @_; + + foreach my $opt (@$opts){ + + my ($opt_name1, $value1)= _split_option($opt); + + foreach my $set_opt (@$set_opts){ + my ($opt_name2, $value2)= _split_option($set_opt); + + if ($opt_name1 eq $opt_name2){ + # Option already set + return 1; + } + } + } + + return 0; +} + + +sub toSQL { + my (@options)= @_; + my @sql; + + foreach my $option (@options) { + my ($name, $value)= _split_option($option); + #print "name: $name\n"; + #print "value: $value\n"; + if ($name =~ /^O, (.*)/){ + push(@sql, "SET GLOBAL $1=$value"); + } + elsif ($name =~ /^set-variable=(.*)/){ + push(@sql, "SET GLOBAL $1=$value"); + } + else { + my $sql_name= $name; + $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 00000000000..3dd5c552b10 --- /dev/null +++ b/mysql-test/lib/My/Platform.pm @@ -0,0 +1,156 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 USA + +package My::Platform; + +use strict; +use File::Basename; +use File::Path; + +use base qw(Exporter); +our @EXPORT= qw(IS_CYGWIN IS_WINDOWS IS_WIN32PERL + native_path posix_path mixed_path + check_socket_path_length process_alive); + +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 }'; + } + else { + eval 'sub IS_CYGWIN { 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 }'; + } +} + + +# +# 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)= @_; + $path=~ s/\//\\/g + if (IS_CYGWIN or IS_WIN32PERL); + 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; + + require IO::Socket::UNIX; + + my $truncated= 1; # Be negative + + # Create a tempfile name with same length as "path" + my $tmpdir = tempdir( CLEANUP => 0); + my $len = length($path) - length($tmpdir); + my $testfile = $tmpdir . "x" x ($len > 0 ? $len : 1); + my $sock; + eval { + $sock= new IO::Socket::UNIX + ( + Local => $testfile, + Listen => 1, + ); + + die "Could not create UNIX domain socket: $!" + unless defined $sock; + + die "UNIX domain socket patch was truncated" + unless ($testfile eq $sock->hostpath()); + + $truncated= 0; # Yes, it worked! + + }; + #print "check_socket_path_length, failed: ", $@, '\n' if ($@); + + $sock= undef; # Close socket + unlink($testfile); # Remove the physical file + rmdir($tmpdir); # Remove the tempdir + 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); +} + + +1; diff --git a/mysql-test/lib/My/SafeProcess.pm b/mysql-test/lib/My/SafeProcess.pm new file mode 100644 index 00000000000..0e3aa968052 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess.pm @@ -0,0 +1,580 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 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 wich 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; + +END { + # Kill any children still running + for my $proc (values %running){ + if ( $proc->is_child($$) ){ + #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); +} + + +# Find the safe process binary or script +my @safe_process_cmd; +my $safe_kill; +if (IS_WIN32PERL or IS_CYGWIN){ + # Use my_safe_process.exe + my $exe= my_find_bin(".", ["lib/My/SafeProcess", "My/SafeProcess"], + "my_safe_process"); + push(@safe_process_cmd, $exe); + + # Use my_safe_kill.exe + $safe_kill= my_find_bin(".", "lib/My/SafeProcess", "my_safe_kill"); +} +else +{ + # Use my_safe_process + my $exe= my_find_bin(".", ["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'}); + my $host = delete($opts{'host'}); + my $shutdown = delete($opts{'shutdown'}); + my $user_data= delete($opts{'user_data'}); + +# 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; + + # Point the safe_process at the right parent if running on cygwin + push(@safe_args, "--parent-pid=".Cygwin::pid_to_winpid($$)) if IS_CYGWIN; + + push(@safe_args, "--"); + push(@safe_args, $path); # The program safe_process should execute + 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(); +} + +# +# Start a process that returns after "duration" seconds +# or when it's parent process does not exist anymore +# +sub timer { + my $class= shift; + my $duration= shift or croak "duration required"; + my $parent_pid= $$; + + my $pid= My::SafeProcess::Base::_safe_fork(); + if ($pid){ + # Parent + my $proc= bless + ({ + SAFE_PID => $pid, + SAFE_NAME => "timer", + PARENT => $$, + }, $class); + + # Put the new process in list of running + $running{$pid}= $proc; + return $proc; + } + + # Child, install signal handlers and sleep for "duration" + $SIG{INT}= 'IGNORE'; + + $SIG{TERM}= sub { + #print STDERR "timer $$: woken up, exiting!\n"; + exit(0); + }; + + $0= "safe_timer($duration)"; + + if (IS_WIN32PERL){ + # Just a thread in same process + sleep($duration); + print STDERR "timer $$: expired after $duration seconds\n"; + exit(0); + } + + my $count_down= $duration; + while($count_down--){ + + # Check that parent is still alive + if (kill(0, $parent_pid) == 0){ + #print STDERR "timer $$: parent gone, exiting!\n"; + exit(0); + } + + sleep(1); + } + print STDERR "timer $$: expired after $duration seconds\n"; + exit(0); +} + + +# +# 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)= @_; + return if IS_WINDOWS; + my $pid= $self->{SAFE_PID}; + die "Can't cet core from not started process" unless defined $pid; + _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)= @_; + + $self->{EXIT_STATUS}= $?; + _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)= @_; + croak "usage: \$safe_proc->wait_one([timeout])" unless ref $self; + + _verbose("wait_one $self, $timeout"); + + 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; + eval + { + # alarm should break the wait + local $SIG{ALRM}= sub { die "waitpid timeout"; }; + + alarm($timeout) if $use_alarm; + + $retpid= waitpid($pid, $blocking ? 0 : &WNOHANG); + + 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(); + return 0; +} + + +# +# Wait for any process to exit +# +# Returns a reference to the SafeProcess that +# exited or undefined +# +sub wait_any { + my $ret_pid; + 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); + } + 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; + } + } + + # 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; + return $proc; +} + +# +# 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 00000000000..3fc1b1be017 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/Base.pm @@ -0,0 +1,212 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 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= 5; + 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; + }; +} + + +# +# 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"){ + + #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'; + + # 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 and !open(STDOUT, $open_mode, $output) ) { + 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: $!"); + } + } + elsif ( ! open(STDERR, $open_mode, $error) ) { + 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 00000000000..97fab820f95 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/CMakeLists.txt @@ -0,0 +1,17 @@ +# Copyright (C) 2006 MySQL AB +# +# 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-1301 USA + +ADD_EXECUTABLE(my_safe_process safe_process_win.cc) +ADD_EXECUTABLE(my_safe_kill safe_kill_win.cc) diff --git a/mysql-test/lib/My/SafeProcess/Makefile.am b/mysql-test/lib/My/SafeProcess/Makefile.am new file mode 100644 index 00000000000..623c0e9a87a --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/Makefile.am @@ -0,0 +1,28 @@ +# Copyright (C) 2000-2006 MySQL AB +# +# 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +safedir = $(prefix)/mysql-test/lib/My/SafeProcess +#nobase_bin_PROGRAMS = ... +safe_PROGRAMS = my_safe_process + +my_safe_process_SOURCES = safe_process.cc + +EXTRA_DIST = safe_kill_win.cc \ + safe_process_win.cc \ + CMakeLists.txt + + +# Don't update the files from bitkeeper +%::SCCS/s.% 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 100755 index 00000000000..c6256fd92e1 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_kill_win.cc @@ -0,0 +1,85 @@ +/* Copyright (C) 2004 MySQL AB + + 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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> + +int main(int argc, const char** argv ) +{ + DWORD pid= -1; + HANDLE shutdown_event; + char safe_process_name[32]= {0}; + int retry_open_event= 100; + /* Ignore any signals */ + signal(SIGINT, SIG_IGN); + signal(SIGBREAK, SIG_IGN); + signal(SIGTERM, SIG_IGN); + + if (argc != 2) { + fprintf(stderr, "safe_kill <pid>\n"); + exit(2); + } + pid= atoi(argv[1]); + + _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 idea to retry the open of the event + */ + HANDLE process; + if ((process= OpenProcess(SYNCHRONIZE, FALSE, pid)) == NULL) + { + fprintf(stderr, "Could not open event or process %d, error: %d\n", + pid, GetLastError()); + exit(3); + } + CloseHandle(process); + + if (retry_open_event--) + Sleep(100); + else + { + fprintf(stderr, "Failed to open shutdown_event '%s', error: %d\n", + safe_process_name, GetLastError()); + exit(3); + } + } + + if(SetEvent(shutdown_event) == 0) + { + fprintf(stderr, "Failed to signal shutdown_event '%s', error: %d\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 00000000000..7932f3fd2d6 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_process.cc @@ -0,0 +1,277 @@ +/* Copyright (C) 2008 MySQL AB + + 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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 <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(1); +} + + +static void kill_child (void) +{ + int status= 0; + + message("Killing child: %d", child_pid); + // Terminate whole process group + kill(-child_pid, SIGKILL); + + pid_t 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 + exit(exit_code); + } + + if (WIFSIGNALED(status)) + message("Child killed by signal: %d", WTERMSIG(status)); + + exit(exit_code); + } + exit(1); +} + + +static 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 + } +} + + +static void handle_signal (int sig) +{ + message("Got signal %d, child_pid: %d", sig, child_pid); + terminated= 1; + + if (child_pid > 0) + kill_child(); + + // Ignore further signals + signal(SIGTERM, SIG_IGN); + signal(SIGINT, SIG_IGN); + + // Continune execution, allow the child to be started and + // finally terminated by monitor loop +} + + +int main(int argc, char* const argv[] ) +{ + char* const* child_argv= 0; + pid_t own_pid= getpid(); + pid_t parent_pid= getppid(); + + /* Install signal handlers */ + signal(SIGTERM, handle_signal); + signal(SIGINT, handle_signal); + signal(SIGCHLD, handle_signal); + signal(SIGABRT, handle_abort); + + sprintf(safe_process_name, "safe_process[%d]", 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", 10) == 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 + 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); + } + + 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(SIGCHLD, SIG_DFL); + + // Make this process it's own process group to be able to kill + // it and any childs(that hasn't changed group themself) + setpgid(0, 0); + + // Signal that child is ready + buf= 37; + write(pfd[1], &buf, 1); + // Close write end + close(pfd[1]); + + if (execvp(child_argv[0], child_argv) < 0) + die("Failed to exec child"); + } + + close(pfd[1]); // Close unused write end + + // Wait for child to signal it's ready + read(pfd[0], &buf, 1); + 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; + } + + // Check if child has exited, normally this will be + // detected immediately with SIGCHLD handler + int status= 0; + pid_t ret_pid= waitpid(child_pid, &status, WNOHANG); + if (ret_pid == child_pid) + { + int ret_code= 2; + if (WIFEXITED(status)) + { + // Process has exited, collect return status + int ret_code= WEXITSTATUS(status); + message("Child exit: %d", ret_code); + // Exit with exit status of the child + exit(ret_code); + } + + if (WIFSIGNALED(status)) + message("Child killed by signal: %d", WTERMSIG(status)); + + exit(ret_code); + } + sleep(1); + } + kill_child(); + + exit(1); +} + diff --git a/mysql-test/lib/My/SafeProcess/safe_process.pl b/mysql-test/lib/My/SafeProcess/safe_process.pl new file mode 100644 index 00000000000..e3114a749d3 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_process.pl @@ -0,0 +1,151 @@ +#!/usr/bin/perl +# -*- cperl -*- + +use strict; +use warnings; + +use lib 'lib'; +use My::SafeProcess::Base; +use POSIX qw(WNOHANG); + +########################################################################### +# Util functions +########################################################################### + +# +#Print message to stderr +# +my $verbose= 0; +sub message { + if ($verbose > 0){ + use Time::localtime; + my $tm= localtime(); + my $timestamp= sprintf("%02d%02d%02d %2d:%02d:%02d", + $tm->year % 100, $tm->mon+1, $tm->mday, + $tm->hour, $tm->min, $tm->sec); + print STDERR $timestamp, " monitor[$$]: ", @_, "\n"; + } +} + + +########################################################################### +# Main program +########################################################################### + +my $terminated= 0; + +# Protect against being killed in the middle +# of child creation, just set the terminated flag +# to make sure the child will be killed off +# when program is ready to do that +$SIG{TERM}= sub { message("!Got signal @_"); $terminated= 1; }; +$SIG{INT}= sub { message("!Got signal @_"); $terminated= 1; }; + +my $parent_pid= getppid(); + +my $found_double_dash= 0; +while (my $arg= shift(@ARGV)){ + + if ($arg =~ /^--$/){ + $found_double_dash= 1; + last; + } + elsif ($arg =~ /^--verbose$/){ + $verbose= 1; + } + else { + die "Unknown option: $arg"; + } +} + +my $path= shift(@ARGV); # Executable + +die "usage:\n" . + " safe_process.pl [opts] -- <path> [<args> [...<args_n>]]" + unless defined $path || $found_double_dash; + + +message("started"); +#message("path: '$path'"); +message("parent: $parent_pid"); + +# Start process to monitor +my $child_pid= + create_process( + path => $path, + args => \@ARGV, + setpgrp => 1, + ); +message("Started child $child_pid"); + +eval { + sub handle_signal { + $terminated= 1; + message("Got signal @_"); + + # Ignore all signals + foreach my $name (keys %SIG){ + $SIG{$name}= 'IGNORE'; + } + + die "signaled\n"; + }; + local $SIG{TERM}= \&handle_signal; + local $SIG{INT}= \&handle_signal; + local $SIG{CHLD}= sub { + message("Got signal @_"); + kill(9, -$child_pid); + my $ret= waitpid($child_pid, 0); + if ($? & 127){ + exit(65); # Killed by signal + } + exit($? >> 8); + }; + + # Monitoring loop + while(!$terminated) { + + # Check if parent is still alive + if (kill(0, $parent_pid) < 1){ + message("Parent is not alive anymore"); + last; + } + + # Wait for child to terminate but wakeup every + # second to also check that parent is still alive + my $ret_pid; + $ret_pid= waitpid($child_pid, &WNOHANG); + if ($ret_pid == $child_pid) { + # Process has exited, collect return status + my $ret_code= $? >> 8; + message("Child exit: $ret_code"); + # Exit with exit status of the child + exit ($ret_code); + } + sleep(1); + } +}; +if ( $@ ) { + # The monitoring loop should have been + # broken by handle_signal + warn "Unexpected: $@" unless ( $@ =~ /signaled/ ); +} + +# Use negative pid in order to kill the whole +# process group +# +my $ret= kill(9, -$child_pid); +message("Killed child: $child_pid, ret: $ret"); +if ($ret > 0) { + message("Killed child: $child_pid"); + # Wait blocking for the child to return + my $ret_pid= waitpid($child_pid, 0); + if ($ret_pid != $child_pid){ + message("unexpected pid $ret_pid returned from waitpid($child_pid)"); + } +} + +message("DONE!"); +exit (1); + + 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 100755 index 00000000000..8aa603a8793 --- /dev/null +++ b/mysql-test/lib/My/SafeProcess/safe_process_win.cc @@ -0,0 +1,316 @@ +/* Copyright (C) 2004 MySQL AB + + 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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. +*/ + +/* Requires Windows 2000 or higher */ +#define _WIN32_WINNT 0x0500 + +#include <windows.h> +#include <stdio.h> +#include <tlhelp32.h> +#include <signal.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, ...) +{ + 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= GetLastError()) + fprintf(stderr, "error: %d, %s\n", last_err, strerror(last_err)); + fflush(stderr); + exit(1); +} + + +DWORD get_parent_pid(DWORD pid) +{ + HANDLE snapshot; + DWORD parent_pid= -1; + 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 == -1) + 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}; + + sprintf(safe_process_name, "safe_process[%d]", 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++) { + to+= _snprintf(to, child_args + sizeof(child_args) - to, "%s ", argv[j]); + } + break; + } else { + if ( strcmp(arg, "--verbose") == 0 ) + verbose++; + else if ( strncmp(arg, "--parent-pid", 10) == 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 + 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. + */ + jeli.BasicLimitInformation.LimitFlags = JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE; + if (SetInformationJobObject(job_handle, JobObjectExtendedLimitInformation, + &jeli, sizeof(jeli)) == 0) + message("SetInformationJobObject failed, continue anyway..."); + +#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 + */ + if (CreateProcess(NULL, (LPSTR)child_args, + NULL, + NULL, + TRUE, /* inherit handles */ + CREATE_SUSPENDED, + NULL, + NULL, + &si, + &process_info) == 0) + die("CreateProcess failed"); + + if (AssignProcessToJobObject(job_handle, process_info.hProcess) == 0) + { + TerminateProcess(process_info.hProcess, 200); + die("AssignProcessToJobObject 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) + { + /* 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/SysInfo.pm b/mysql-test/lib/My/SysInfo.pm new file mode 100644 index 00000000000..f1ba5fb610f --- /dev/null +++ b/mysql-test/lib/My/SysInfo.pm @@ -0,0 +1,211 @@ +# -*- cperl -*- +# Copyright (C) 2004-2006 MySQL AB +# +# 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-1301 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; +} + + +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); + } + + # At least one cpu should have been found + # if this method worked + if ( $self->{cpus} ) { + return $self; + } + return undef; +} + + +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/Test.pm b/mysql-test/lib/My/Test.pm new file mode 100644 index 00000000000..68b100f91af --- /dev/null +++ b/mysql-test/lib/My/Test.pm @@ -0,0 +1,123 @@ +# -*- cperl -*- + + +# +# One test +# +package My::Test; + +use strict; +use warnings; +use Carp; + + +sub new { + my $class= shift; + my $self= bless { + @_, + }, $class; + return $self; +} + + +# +# Return a unique key that can be used to +# identify this test in a hash +# +sub key { + my ($self)= @_; + return $self->{key}; +} + + +sub _encode { + my ($value)= @_; + $value =~ s/([|\\\x{0a}\x{0d}])/sprintf('\%02X', ord($1))/eg; + return $value; +} + +sub _decode { + my ($value)= @_; + $value =~ s/\\([0-9a-fA-F]{2})/chr(hex($1))/ge; + return $value; +} + +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'); +} + + +sub write_test { + my ($test, $sock, $header)= @_; + + # Give the test a unique key before serializing it + $test->{key}= "$test" unless defined $test->{key}; + + print $sock $header, "\n"; + while ((my ($key, $value)) = each(%$test)) { + print $sock $key, "= "; + if (ref $value eq "ARRAY") { + print $sock "[", _encode(join(", ", @$value)), "]"; + } else { + print $sock _encode($value); + } + print $sock "\n"; + } + print $sock "\n"; +} + + +sub read_test { + my ($sock)= @_; + my $test= My::Test->new(); + # Read the : separated key value pairs until a + # single newline on it's own line + my $line; + while (defined($line= <$sock>)) { + # List is terminated by newline on it's own + if ($line eq "\n") { + # Correctly terminated reply + # print "Got newline\n"; + last; + } + chomp($line); + + # Split key/value on the first "=" + my ($key, $value)= split("= ", $line, 2); + + if ($value =~ /^\[(.*)\]/){ + my @values= split(", ", _decode($1)); + push(@{$test->{$key}}, @values); + } + else + { + $test->{$key}= _decode($value); + } + } + return $test; +} + + +sub print_test { + my ($self)= @_; + + print "[", $self->{name}, "]", "\n"; + while ((my ($key, $value)) = each(%$self)) { + print " ", $key, "= "; + if (ref $value eq "ARRAY") { + print "[", join(", ", @$value), "]"; + } else { + print $value; + } + print "\n"; + } + print "\n"; +} + + +1; |