mirror of
https://github.com/MariaDB/server.git
synced 2025-07-30 16:24:05 +03:00
Merge MySQL->MariaDB
* Finished Monty and Jani's merge * Some InnoDB tests still fail (because it's old xtradb code run against newer testsuite). They are expected to go after mergning with the latest xtradb.
This commit is contained in:
Sergey Petrunya
@ -22,6 +22,33 @@ use My::Platform;
|
||||
|
||||
use File::Temp qw/ tempfile tempdir /;
|
||||
|
||||
my $hint_mysqld; # Last resort guess for executable path
|
||||
|
||||
# If path in core file is 79 chars we assume it's been truncated
|
||||
# Looks like we can still find the full path using 'strings'
|
||||
# If that doesn't work, use the hint (mysqld path) as last resort.
|
||||
|
||||
sub _verify_binpath {
|
||||
my ($binary, $core_name)= @_;
|
||||
my $binpath;
|
||||
|
||||
if (length $binary != 79) {
|
||||
$binpath= $binary;
|
||||
print "Core generated by '$binpath'\n";
|
||||
} else {
|
||||
# Last occurrence of path ending in /mysql*, cut from first /
|
||||
if (`strings '$core_name' | grep "/mysql[^/. ]*\$" | tail -1` =~ /(\/.*)/) {
|
||||
$binpath= $1;
|
||||
print "Guessing that core was generated by '$binpath'\n";
|
||||
} else {
|
||||
return unless $hint_mysqld;
|
||||
$binpath= $hint_mysqld;
|
||||
print "Wild guess that core was generated by '$binpath'\n";
|
||||
}
|
||||
}
|
||||
return $binpath;
|
||||
}
|
||||
|
||||
sub _gdb {
|
||||
my ($core_name)= @_;
|
||||
|
||||
@ -33,7 +60,8 @@ sub _gdb {
|
||||
`gdb -c '$core_name' --batch 2>&1` =~
|
||||
/Core was generated by `([^\s\'\`]+)/;
|
||||
my $binary= $1 or return;
|
||||
print "Core generated by '$binary'\n";
|
||||
|
||||
$binary= _verify_binpath ($binary, $core_name) or return;
|
||||
|
||||
# Create tempfile containing gdb commands
|
||||
my ($tmp, $tmp_name) = tempfile();
|
||||
@ -73,7 +101,8 @@ sub _dbx {
|
||||
`echo | dbx - '$core_name' 2>&1` =~
|
||||
/Corefile specified executable: "([^"]+)"/;
|
||||
my $binary= $1 or return;
|
||||
print "Core generated by '$binary'\n";
|
||||
|
||||
$binary= _verify_binpath ($binary, $core_name) or return;
|
||||
|
||||
# Find all threads
|
||||
my @thr_ids = `echo threads | dbx '$binary' '$core_name' 2>&1` =~ /t@\d+/g;
|
||||
@ -203,7 +232,7 @@ sub _cdb {
|
||||
|
||||
my $cdb_cmd = "!sym prompts off; !analyze -v; .ecxr; !for_each_frame dv /t;!uniqstack -p;q";
|
||||
my $cdb_output=
|
||||
`cdb -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines -c "$cdb_cmd" 2>&1`;
|
||||
`cdb -c "$cdb_cmd" -z $core_name -i "$image_path" -y "$symbol_path" -t 0 -lines 2>&1`;
|
||||
return if $? >> 8;
|
||||
return unless $cdb_output;
|
||||
|
||||
@ -225,7 +254,8 @@ EOF
|
||||
|
||||
|
||||
sub show {
|
||||
my ($class, $core_name)= @_;
|
||||
my ($class, $core_name, $exe_mysqld)= @_;
|
||||
$hint_mysqld= $exe_mysqld;
|
||||
|
||||
# On Windows, rely on cdb to be there...
|
||||
if (IS_WINDOWS)
|
||||
|
||||
@ -164,6 +164,9 @@ sub copytree {
|
||||
copytree("$from_dir/$_", "$to_dir/$_");
|
||||
next;
|
||||
}
|
||||
|
||||
# Only copy plain files
|
||||
next unless -f "$from_dir/$_";
|
||||
copy("$from_dir/$_", "$to_dir/$_");
|
||||
}
|
||||
closedir(DIR);
|
||||
|
||||
@ -536,7 +536,37 @@ sub wait_any {
|
||||
return $proc;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Wait for all processes to exit
|
||||
#
|
||||
sub wait_all {
|
||||
while(keys %running)
|
||||
{
|
||||
wait_any();
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Check if any process has exited, but don't wait.
|
||||
#
|
||||
# Returns a reference to the SafeProcess that
|
||||
# exited or undefined
|
||||
#
|
||||
sub check_any {
|
||||
for my $proc (values %running){
|
||||
if ( $proc->is_child($$) ) {
|
||||
if (not $proc->wait_one(0)) {
|
||||
_verbose ("Found exited $proc");
|
||||
return $proc;
|
||||
}
|
||||
}
|
||||
}
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
# Overload string operator
|
||||
# and fallback to default functions if no
|
||||
# overloaded function is found
|
||||
|
||||
@ -83,6 +83,13 @@ sub exit_status {
|
||||
};
|
||||
}
|
||||
|
||||
# threads.pm may not exist everywhere, so use only on Windows.
|
||||
|
||||
use if $^O eq "MSWin32", "threads";
|
||||
use if $^O eq "MSWin32", "threads::shared";
|
||||
|
||||
my $win32_spawn_lock :shared;
|
||||
|
||||
|
||||
#
|
||||
# Create a new process
|
||||
@ -104,6 +111,8 @@ sub create_process {
|
||||
|
||||
if ($^O eq "MSWin32"){
|
||||
|
||||
lock($win32_spawn_lock);
|
||||
|
||||
#printf STDERR "stdin %d, stdout %d, stderr %d\n",
|
||||
# fileno STDIN, fileno STDOUT, fileno STDERR;
|
||||
|
||||
|
||||
@ -89,7 +89,7 @@ static void die(const char* fmt, ...)
|
||||
}
|
||||
|
||||
|
||||
static void kill_child (void)
|
||||
static void kill_child(void)
|
||||
{
|
||||
int status= 0;
|
||||
|
||||
@ -119,7 +119,7 @@ static void kill_child (void)
|
||||
}
|
||||
|
||||
|
||||
static void handle_abort (int sig)
|
||||
extern "C" void handle_abort(int sig)
|
||||
{
|
||||
message("Got signal %d, child_pid: %d, sending ABRT", sig, child_pid);
|
||||
|
||||
@ -128,8 +128,8 @@ static void handle_abort (int sig)
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
static void handle_signal (int sig)
|
||||
|
||||
extern "C" void handle_signal(int sig)
|
||||
{
|
||||
message("Got signal %d, child_pid: %d", sig, child_pid);
|
||||
terminated= 1;
|
||||
@ -152,7 +152,7 @@ int main(int argc, char* const argv[] )
|
||||
pid_t own_pid= getpid();
|
||||
pid_t parent_pid= getppid();
|
||||
bool nocore = false;
|
||||
|
||||
|
||||
/* Install signal handlers */
|
||||
signal(SIGTERM, handle_signal);
|
||||
signal(SIGINT, handle_signal);
|
||||
@ -232,10 +232,11 @@ int main(int argc, char* const argv[] )
|
||||
message("setrlimit failed, errno=%d", errno);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
// Signal that child is ready
|
||||
buf= 37;
|
||||
write(pfd[1], &buf, 1);
|
||||
if ((write(pfd[1], &buf, 1)) < 1)
|
||||
die("Failed to signal that child is ready");
|
||||
// Close write end
|
||||
close(pfd[1]);
|
||||
|
||||
@ -246,8 +247,10 @@ int main(int argc, char* const argv[] )
|
||||
close(pfd[1]); // Close unused write end
|
||||
|
||||
// Wait for child to signal it's ready
|
||||
read(pfd[0], &buf, 1);
|
||||
if(buf != 37)
|
||||
if ((read(pfd[0], &buf, 1)) < 1)
|
||||
die("Failed to read signal from child");
|
||||
|
||||
if (buf != 37)
|
||||
die("Didn't get 37 from pipe");
|
||||
close(pfd[0]); // Close read end
|
||||
|
||||
@ -272,7 +275,7 @@ int main(int argc, char* const argv[] )
|
||||
if (WIFEXITED(status))
|
||||
{
|
||||
// Process has exited, collect return status
|
||||
int ret_code= WEXITSTATUS(status);
|
||||
ret_code= WEXITSTATUS(status);
|
||||
message("Child exit: %d", ret_code);
|
||||
// Exit with exit status of the child
|
||||
exit(ret_code);
|
||||
@ -287,6 +290,6 @@ int main(int argc, char* const argv[] )
|
||||
}
|
||||
kill_child();
|
||||
|
||||
exit(1);
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
@ -259,22 +259,37 @@ int main(int argc, const char** argv )
|
||||
the JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE flag, making sure it will be
|
||||
terminated when the last handle to it is closed(which is owned by
|
||||
this process).
|
||||
|
||||
If breakaway from job fails on some reason, fallback is to create a
|
||||
new process group. Process groups also allow to kill process and its
|
||||
descedants, subject to some restrictions (processes have to run within
|
||||
the same console,and must not ignore CTRL_BREAK)
|
||||
*/
|
||||
if (CreateProcess(NULL, (LPSTR)child_args,
|
||||
DWORD create_flags[]= {CREATE_BREAKAWAY_FROM_JOB, CREATE_NEW_PROCESS_GROUP, 0};
|
||||
BOOL process_created= FALSE;
|
||||
BOOL jobobject_assigned= FALSE;
|
||||
|
||||
for (int i=0; i < sizeof(create_flags)/sizeof(create_flags[0]); i++)
|
||||
{
|
||||
process_created= CreateProcess(NULL, (LPSTR)child_args,
|
||||
NULL,
|
||||
NULL,
|
||||
TRUE, /* inherit handles */
|
||||
CREATE_SUSPENDED | CREATE_BREAKAWAY_FROM_JOB,
|
||||
CREATE_SUSPENDED | create_flags[i],
|
||||
NULL,
|
||||
NULL,
|
||||
&si,
|
||||
&process_info) == 0)
|
||||
die("CreateProcess failed");
|
||||
&process_info);
|
||||
if (process_created)
|
||||
{
|
||||
jobobject_assigned= AssignProcessToJobObject(job_handle, process_info.hProcess);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if (AssignProcessToJobObject(job_handle, process_info.hProcess) == 0)
|
||||
if (!process_created)
|
||||
{
|
||||
TerminateProcess(process_info.hProcess, 200);
|
||||
die("AssignProcessToJobObject failed");
|
||||
die("CreateProcess failed");
|
||||
}
|
||||
ResumeThread(process_info.hThread);
|
||||
CloseHandle(process_info.hThread);
|
||||
@ -312,6 +327,13 @@ int main(int argc, const char** argv )
|
||||
message("TerminateJobObject failed");
|
||||
CloseHandle(job_handle);
|
||||
message("Job terminated and closed");
|
||||
|
||||
if (!jobobject_assigned)
|
||||
{
|
||||
GenerateConsoleCtrlEvent(CTRL_BREAK_EVENT, process_info.dwProcessId);
|
||||
TerminateProcess(process_info.hProcess, 202);
|
||||
}
|
||||
|
||||
if (wait_res != WAIT_OBJECT_0 + CHILD)
|
||||
{
|
||||
/* The child has not yet returned, wait for it */
|
||||
|
||||
@ -33,7 +33,7 @@ our $print_testcases;
|
||||
our $skip_rpl;
|
||||
our $do_test;
|
||||
our $skip_test;
|
||||
our $opt_skip_combination;
|
||||
our $skip_combinations;
|
||||
our $binlog_format;
|
||||
our $enable_disabled;
|
||||
our $default_storage_engine;
|
||||
@ -127,11 +127,22 @@ sub collect_test_cases ($$) {
|
||||
if ( $test->{name} =~ /.*\.$tname/ )
|
||||
{
|
||||
$found= 1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
if ( not $found )
|
||||
{
|
||||
mtr_error("Could not find '$tname' in '$suites' suite(s)");
|
||||
mtr_error("Could not find '$tname' in '$suites' suite(s)") unless $sname;
|
||||
# If suite was part of name, find it there
|
||||
my ($this_case) = collect_one_suite($sname, [ $tname ]);
|
||||
if ($this_case)
|
||||
{
|
||||
push (@$cases, $this_case);
|
||||
}
|
||||
else
|
||||
{
|
||||
mtr_error("Could not find '$tname' in '$sname' suite");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@ -383,7 +394,7 @@ sub collect_one_suite($)
|
||||
# Read combinations for this suite and build testcases x combinations
|
||||
# if any combinations exists
|
||||
# ----------------------------------------------------------------------
|
||||
if ( ! $opt_skip_combination )
|
||||
if ( ! $skip_combinations )
|
||||
{
|
||||
my @combinations;
|
||||
my $combination_file= "$suitedir/combinations";
|
||||
@ -472,6 +483,67 @@ sub collect_one_suite($)
|
||||
#print_testcases(@cases);
|
||||
}
|
||||
}
|
||||
|
||||
# ----------------------------------------------------------------------
|
||||
# Testing InnoDB plugin.
|
||||
# ----------------------------------------------------------------------
|
||||
my $lib_innodb_plugin=
|
||||
mtr_file_exists(::vs_config_dirs('storage/innodb_plugin', 'ha_innodb_plugin.dll'),
|
||||
"$::basedir/storage/innodb_plugin/.libs/ha_innodb_plugin.so",
|
||||
"$::basedir/lib/mysql/plugin/ha_innodb_plugin.so",
|
||||
"$::basedir/lib/mysql/plugin/ha_innodb_plugin.dll");
|
||||
if ($::mysql_version_id >= 50100 && !(IS_WINDOWS && $::opt_embedded_server) &&
|
||||
$lib_innodb_plugin)
|
||||
{
|
||||
my @new_cases;
|
||||
|
||||
foreach my $test (@cases)
|
||||
{
|
||||
next if ($test->{'skip'} || !$test->{'innodb_test'});
|
||||
# Exceptions
|
||||
next if ($test->{'name'} eq 'main.innodb'); # Failed with wrong errno (fk)
|
||||
next if ($test->{'name'} eq 'main.index_merge_innodb'); # Explain diff
|
||||
# innodb_file_per_table is rw with innodb_plugin
|
||||
next if ($test->{'name'} eq 'sys_vars.innodb_file_per_table_basic');
|
||||
# innodb_lock_wait_timeout is rw with innodb_plugin
|
||||
next if ($test->{'name'} eq 'sys_vars.innodb_lock_wait_timeout_basic');
|
||||
# Diff around innodb_thread_concurrency variable
|
||||
next if ($test->{'name'} eq 'sys_vars.innodb_thread_concurrency_basic');
|
||||
# Copy test options
|
||||
my $new_test= My::Test->new();
|
||||
while (my ($key, $value) = each(%$test))
|
||||
{
|
||||
if (ref $value eq "ARRAY")
|
||||
{
|
||||
push(@{$new_test->{$key}}, @$value);
|
||||
}
|
||||
else
|
||||
{
|
||||
$new_test->{$key}= $value;
|
||||
}
|
||||
}
|
||||
my $plugin_filename= basename($lib_innodb_plugin);
|
||||
push(@{$new_test->{master_opt}}, '--ignore-builtin-innodb');
|
||||
push(@{$new_test->{master_opt}}, '--plugin-dir=' . dirname($lib_innodb_plugin));
|
||||
push(@{$new_test->{master_opt}}, "--plugin_load=innodb=$plugin_filename;innodb_locks=$plugin_filename");
|
||||
push(@{$new_test->{slave_opt}}, '--ignore-builtin-innodb');
|
||||
push(@{$new_test->{slave_opt}}, '--plugin-dir=' . dirname($lib_innodb_plugin));
|
||||
push(@{$new_test->{slave_opt}}, "--plugin_load=innodb=$plugin_filename;innodb_locks=$plugin_filename");
|
||||
if ($new_test->{combination})
|
||||
{
|
||||
$new_test->{combination}.= ' + InnoDB plugin';
|
||||
}
|
||||
else
|
||||
{
|
||||
$new_test->{combination}= 'InnoDB plugin';
|
||||
}
|
||||
push(@new_cases, $new_test);
|
||||
}
|
||||
push(@cases, @new_cases);
|
||||
}
|
||||
# ----------------------------------------------------------------------
|
||||
# End of testing InnoDB plugin.
|
||||
# ----------------------------------------------------------------------
|
||||
optimize_cases(\@cases);
|
||||
#print_testcases(@cases);
|
||||
|
||||
@ -919,7 +991,8 @@ sub collect_one_test_case {
|
||||
if ( $tinfo->{'innodb_test'} )
|
||||
{
|
||||
# This is a test that need innodb
|
||||
if ( $::mysqld_variables{'innodb'} ne "TRUE" )
|
||||
if ( $::mysqld_variables{'innodb'} eq "OFF" ||
|
||||
! exists $::mysqld_variables{'innodb'} )
|
||||
{
|
||||
# innodb is not supported, skip it
|
||||
$tinfo->{'skip'}= 1;
|
||||
|
||||
@ -21,7 +21,25 @@
|
||||
use strict;
|
||||
use Socket;
|
||||
use Errno;
|
||||
use My::Platform;
|
||||
use if IS_WINDOWS, "Net::Ping";
|
||||
|
||||
# Ancient perl might not have port_number method for Net::Ping.
|
||||
# Check it and use fallback to connect() if it is not present.
|
||||
BEGIN
|
||||
{
|
||||
my $use_netping= 0;
|
||||
if (IS_WINDOWS)
|
||||
{
|
||||
my $ping = Net::Ping->new();
|
||||
if ($ping->can("port_number"))
|
||||
{
|
||||
$use_netping= 1;
|
||||
}
|
||||
}
|
||||
eval 'sub USE_NETPING { $use_netping }';
|
||||
}
|
||||
|
||||
sub sleep_until_file_created ($$$);
|
||||
sub mtr_ping_port ($);
|
||||
|
||||
@ -30,6 +48,24 @@ sub mtr_ping_port ($) {
|
||||
|
||||
mtr_verbose("mtr_ping_port: $port");
|
||||
|
||||
if (IS_WINDOWS && USE_NETPING)
|
||||
{
|
||||
# Under Windows, connect to a port that is not open is slow
|
||||
# It takes ~1sec. Net::Ping with small timeout is much faster.
|
||||
my $ping = Net::Ping->new();
|
||||
$ping->port_number($port);
|
||||
if ($ping->ping("localhost",0.1))
|
||||
{
|
||||
mtr_verbose("USED");
|
||||
return 1;
|
||||
}
|
||||
else
|
||||
{
|
||||
mtr_verbose("FREE");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
my $remote= "localhost";
|
||||
my $iaddr= inet_aton($remote);
|
||||
if ( ! $iaddr )
|
||||
|
||||
@ -30,6 +30,8 @@ our @EXPORT= qw(report_option mtr_print_line mtr_print_thick_line
|
||||
mtr_report_test);
|
||||
|
||||
use mtr_match;
|
||||
use My::Platform;
|
||||
use POSIX qw[ _exit ];
|
||||
require "mtr_io.pl";
|
||||
|
||||
my $tot_real_time= 0;
|
||||
@ -69,6 +71,8 @@ sub _mtr_report_test_name ($) {
|
||||
|
||||
print _name(), _timestamp();
|
||||
printf "%-40s ", $tname;
|
||||
my $worker = $tinfo->{worker};
|
||||
printf "w$worker " if $worker;
|
||||
|
||||
return $tname;
|
||||
}
|
||||
@ -259,6 +263,17 @@ sub mtr_report_stats ($$$) {
|
||||
$tot_restarts++;
|
||||
}
|
||||
|
||||
# Add counts for repeated runs, if any.
|
||||
# Note that the last run has already been counted above.
|
||||
my $num_repeat = $tinfo->{'repeat'} - 1;
|
||||
if ( $num_repeat > 0 )
|
||||
{
|
||||
$tot_tests += $num_repeat;
|
||||
my $rep_failed = $tinfo->{'rep_failures'} || 0;
|
||||
$tot_failed += $rep_failed;
|
||||
$tot_passed += $num_repeat - $rep_failed;
|
||||
}
|
||||
|
||||
# Look for warnings produced by mysqltest
|
||||
my $base_file= mtr_match_extension($tinfo->{'result_file'},
|
||||
"result"); # Trim extension
|
||||
@ -336,7 +351,7 @@ sub mtr_report_stats ($$$) {
|
||||
foreach my $tinfo (@$tests)
|
||||
{
|
||||
my $tname= $tinfo->{'name'};
|
||||
if ( $tinfo->{failures} and ! $seen{$tname})
|
||||
if ( ($tinfo->{failures} || $tinfo->{rep_failures}) and ! $seen{$tname})
|
||||
{
|
||||
print " $tname";
|
||||
$seen{$tname}= 1;
|
||||
@ -476,7 +491,14 @@ sub mtr_warning (@) {
|
||||
sub mtr_error (@) {
|
||||
print STDERR _name(), _timestamp(),
|
||||
"mysql-test-run: *** ERROR: ", join(" ", @_), "\n";
|
||||
exit(1);
|
||||
if (IS_WINDOWS)
|
||||
{
|
||||
POSIX::_exit(1);
|
||||
}
|
||||
else
|
||||
{
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -28,32 +28,36 @@ sub msg {
|
||||
# print "### unique($$) - ", join(" ", @_), "\n";
|
||||
}
|
||||
|
||||
my $file;
|
||||
my $dir;
|
||||
|
||||
if(!IS_WINDOWS)
|
||||
{
|
||||
$file= "/tmp/mysql-test-ports";
|
||||
$dir= "/tmp/mysql-unique-ids";
|
||||
}
|
||||
else
|
||||
{
|
||||
$file= $ENV{'TEMP'}."/mysql-test-ports";
|
||||
}
|
||||
|
||||
|
||||
my %mtr_unique_ids;
|
||||
|
||||
END {
|
||||
my $allocated_id= $mtr_unique_ids{$$};
|
||||
if (defined $allocated_id)
|
||||
# Try to use machine-wide directory location for unique IDs,
|
||||
# $ALLUSERSPROFILE . IF it is not available, fallback to $TEMP
|
||||
# which is typically a per-user temporary directory
|
||||
if (exists $ENV{'ALLUSERSPROFILE'} && -w $ENV{'ALLUSERSPROFILE'})
|
||||
{
|
||||
mtr_release_unique_id($allocated_id);
|
||||
$dir= $ENV{'ALLUSERSPROFILE'}."/mysql-unique-ids";
|
||||
}
|
||||
delete $mtr_unique_ids{$$};
|
||||
else
|
||||
{
|
||||
$dir= $ENV{'TEMP'}."/mysql-unique-ids";
|
||||
}
|
||||
}
|
||||
|
||||
my $mtr_unique_fh = undef;
|
||||
|
||||
END
|
||||
{
|
||||
mtr_release_unique_id();
|
||||
}
|
||||
|
||||
#
|
||||
# Get a unique, numerical ID, given a file name (where all
|
||||
# requested IDs are stored), a minimum and a maximum value.
|
||||
# Get a unique, numerical ID in a specified range.
|
||||
#
|
||||
# If no unique ID within the specified parameters can be
|
||||
# obtained, return undef.
|
||||
@ -61,137 +65,63 @@ END {
|
||||
sub mtr_get_unique_id($$) {
|
||||
my ($min, $max)= @_;;
|
||||
|
||||
msg("get, '$file', $min-$max");
|
||||
msg("get $min-$max, $$");
|
||||
|
||||
die "Can only get one unique id per process!" if $mtr_unique_ids{$$};
|
||||
die "Can only get one unique id per process!" if defined $mtr_unique_fh;
|
||||
|
||||
my $ret = undef;
|
||||
my $changed = 0;
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
# Make sure our ID directory exists
|
||||
if (! -d $dir)
|
||||
{
|
||||
# If there is a file with the reserved
|
||||
# directory name, just delete the file.
|
||||
if (-e $dir)
|
||||
{
|
||||
unlink($dir);
|
||||
}
|
||||
|
||||
my $save_umask= umask(0);
|
||||
open SEM, ">", "$file.sem" or die "can't write to $file.sem";
|
||||
flock SEM, LOCK_EX or die "can't lock $file.sem";
|
||||
if(! -e $file) {
|
||||
open FILE, ">", $file or die "can't create $file";
|
||||
close FILE;
|
||||
}
|
||||
umask($save_umask);
|
||||
mkdir $dir;
|
||||
chmod 0777, $dir;
|
||||
|
||||
msg("HAVE THE LOCK");
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
open FILE, "+<", $file or die "can't open $file";
|
||||
#select undef,undef,undef,0.2;
|
||||
seek FILE, 0, 0;
|
||||
my %taken = ();
|
||||
while(<FILE>) {
|
||||
chomp;
|
||||
my ($id, $pid) = split / /;
|
||||
$taken{$id} = $pid;
|
||||
msg("taken: $id, $pid");
|
||||
# Check if process with given pid is alive
|
||||
if(!process_alive($pid)) {
|
||||
print "Removing slot $id used by missing process $pid\n";
|
||||
msg("Removing slot $id used by missing process $pid");
|
||||
delete $taken{$id};
|
||||
$changed++;
|
||||
if(! -d $dir)
|
||||
{
|
||||
die "can't make directory $dir";
|
||||
}
|
||||
}
|
||||
for(my $i=$min; $i<=$max; ++$i) {
|
||||
if(! exists $taken{$i}) {
|
||||
$ret = $i;
|
||||
$taken{$i} = $$;
|
||||
$changed++;
|
||||
# Remember the id this process got
|
||||
$mtr_unique_ids{$$}= $i;
|
||||
msg(" got $i");
|
||||
last;
|
||||
|
||||
|
||||
my $fh;
|
||||
for(my $id = $min; $id <= $max; $id++)
|
||||
{
|
||||
open( $fh, ">$dir/$id");
|
||||
chmod 0666, "$dir/$id";
|
||||
# Try to lock the file exclusively. If lock succeeds, we're done.
|
||||
if (flock($fh, LOCK_EX|LOCK_NB))
|
||||
{
|
||||
# Store file handle - we would need it to release the ID (==unlock the file)
|
||||
$mtr_unique_fh = $fh;
|
||||
return $id;
|
||||
}
|
||||
else
|
||||
{
|
||||
close $fh;
|
||||
}
|
||||
}
|
||||
if($changed) {
|
||||
seek FILE, 0, 0;
|
||||
truncate FILE, 0 or die "can't truncate $file";
|
||||
for my $k (keys %taken) {
|
||||
print FILE $k . ' ' . $taken{$k} . "\n";
|
||||
}
|
||||
}
|
||||
close FILE;
|
||||
|
||||
msg("RELEASING THE LOCK");
|
||||
flock SEM, LOCK_UN or warn "can't unlock $file.sem";
|
||||
close SEM;
|
||||
|
||||
return $ret;
|
||||
return undef;
|
||||
}
|
||||
|
||||
|
||||
#
|
||||
# Release a unique ID.
|
||||
#
|
||||
sub mtr_release_unique_id($) {
|
||||
my ($myid)= @_;
|
||||
|
||||
msg("release, $myid");
|
||||
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
my $save_umask= umask(0);
|
||||
open SEM, ">", "$file.sem" or die "can't write to $file.sem";
|
||||
flock SEM, LOCK_EX or die "can't lock $file.sem";
|
||||
|
||||
msg("HAVE THE LOCK");
|
||||
|
||||
if(eval("readlink '$file'") || eval("readlink '$file.sem'")) {
|
||||
die 'lock file is a symbolic link';
|
||||
}
|
||||
|
||||
if(! -e $file) {
|
||||
open FILE, ">", $file or die "can't create $file";
|
||||
close FILE;
|
||||
}
|
||||
umask($save_umask);
|
||||
open FILE, "+<", $file or die "can't open $file";
|
||||
#select undef,undef,undef,0.2;
|
||||
seek FILE, 0, 0;
|
||||
my %taken = ();
|
||||
while(<FILE>) {
|
||||
chomp;
|
||||
my ($id, $pid) = split / /;
|
||||
msg(" taken, $id $pid");
|
||||
$taken{$id} = $pid;
|
||||
}
|
||||
|
||||
if ($taken{$myid} != $$)
|
||||
sub mtr_release_unique_id()
|
||||
{
|
||||
msg("release $$");
|
||||
if (defined $mtr_unique_fh)
|
||||
{
|
||||
msg(" The unique id for this process does not match pid");
|
||||
close $mtr_unique_fh;
|
||||
$mtr_unique_fh = undef;
|
||||
}
|
||||
|
||||
|
||||
msg(" removing $myid");
|
||||
delete $taken{$myid};
|
||||
seek FILE, 0, 0;
|
||||
truncate FILE, 0 or die "can't truncate $file";
|
||||
for my $k (keys %taken) {
|
||||
print FILE $k . ' ' . $taken{$k} . "\n";
|
||||
}
|
||||
close FILE;
|
||||
|
||||
msg("RELEASE THE LOCK");
|
||||
|
||||
flock SEM, LOCK_UN or warn "can't unlock $file.sem";
|
||||
close SEM;
|
||||
|
||||
delete $mtr_unique_ids{$$};
|
||||
}
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user