Commit 54acc838 authored by Leigh Stoller's avatar Leigh Stoller

Move the script locking code that Rob did a long time ago (the stuff

that is at the start of scripts like exports_setup) into a library
function. I'm tired of duplicating it!
parent 4b845cfd
......@@ -13,13 +13,17 @@ use Exporter;
@EXPORT =
qw ( SENDMAIL OPENMAIL TBTimeStamp TBBackGround TBDateTimeFSSafe
TBMakeLogname TB_BOSSNODE TB_OPSEMAIL TBGenSecretKey TBDebugTimeStamp
TBDebugTimeStampsOn TBForkCmd TB_BOSSEVENTPORT TB_EVENTSERVER);
TBDebugTimeStampsOn TBForkCmd TB_BOSSEVENTPORT TB_EVENTSERVER
TBScriptLock TBScriptUnlock
TBSCRIPTLOCK_OKAY TBSCRIPTLOCK_TIMEDOUT
TBSCRIPTLOCK_IGNORE TBSCRIPTLOCK_FAILED);
# After package decl.
use English;
use POSIX qw(strftime);
use POSIX qw(setsid);
use Fcntl;
use Fcntl ':flock';
use IO::Handle;
use File::Basename;
use Time::HiRes qw(gettimeofday);
......@@ -319,4 +323,140 @@ sub TBForkCmd($;$) {
return(0);
}
#
# Serialize an operation (script).
#
my $lockname;
my $lockhandle;
# Return Values.
sub TBSCRIPTLOCK_OKAY() { 0; }
sub TBSCRIPTLOCK_TIMEDOUT() { 1; }
sub TBSCRIPTLOCK_IGNORE() { 2; }
sub TBSCRIPTLOCK_FAILED() { -1; }
#
# There are two kinds of serialization.
#
# * Usual Kind: Each party just waits for a chance to go.
# * Other Kind: Only the first party really needs to run; the others just
# need to wait. For example; exports_setup operates globally,
# so there is no reason to run it more then once. We just
# need to make sure that everyone waits for the one that is
# running to finish. Use the global option for this.
#
sub TBScriptLock($;$$)
{
my ($token, $global, $waittime) = @_;
local *LOCK;
$waittime = 30
if (!defined($waittime));
$global = 0
if (!defined($global));
$lockname = "/var/tmp/testbed_${token}_lockfile";
if (! open(LOCK, ">>$lockname")) {
print STDERR "Could not open $lockname!\n";
return TBSCRIPTLOCK_FAILED();
}
if (! $global) {
#
# A plain old serial lock.
#
while (flock(LOCK, LOCK_EX|LOCK_NB) == 0) {
print "Another $token is in progress. Waiting a moment ...\n";
$waittime--;
if ($waittime == 0) {
print STDERR "Could not get the lock after a long time!\n";
return TBSCRIPTLOCK_TIMEDOUT();
}
sleep(1);
}
# Okay, got the lock. Save the handle. We need it below.
$lockhandle = *LOCK;
return TBSCRIPTLOCK_OKAY();
}
#
# Okay, a global lock.
#
# If we don't get it the first time, we wait for:
# 1) The lock to become free, in which case we do our thing
# 2) The time on the lock to change, in which case we wait for that
# process to finish, and then we are done since there is no
# reason to duplicate what the just finished process did.
#
if (flock(LOCK, LOCK_EX|LOCK_NB) == 0) {
my $oldlocktime = (stat(LOCK))[9];
my $gotlock = 0;
while (1) {
print "Another $token in progress. Waiting a moment ...\n";
if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
# OK, got the lock
$gotlock = 1;
last;
}
my $locktime = (stat(LOCK))[9];
if ($locktime != $oldlocktime) {
$oldlocktime = $locktime;
last;
}
$waittime--;
if ($waittime <= 0) {
print STDERR "Could not get the lock after a long time!\n";
return TBSCRIPTLOCK_TIMEDOUT();
}
sleep(1);
}
$count = 0;
#
# If we did not get the lock, wait for the process that did to finish.
#
if (!$gotlock) {
while (1) {
if ((stat(LOCK))[9] != $oldlocktime) {
return TBSCRIPTLOCK_IGNORE();
}
if (flock(LOCK, LOCK_EX|LOCK_NB) != 0) {
close(LOCK);
return TBSCRIPTLOCK_IGNORE();
}
$waittime--;
if ($waittime <= 0) {
print STDERR
"Process with the lock did not finish after ".
"a long time!\n";
return TBSCRIPTLOCK_TIMEDOUT();
}
sleep(1);
}
}
}
#
# Perl-style touch(1)
#
my $now = time;
utime $now, $now, $lockname;
$lockhandle = *LOCK;
return TBSCRIPTLOCK_OKAY();
}
#
# Unlock; Just need to close the file (releasing the lock).
#
sub TBScriptUnlock()
{
close($lockhandle)
if defined($lockhandle);
}
1;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment