313 lines
7.9 KiB
Perl
313 lines
7.9 KiB
Perl
# PERL implementation of Erik E. Fair's 'shlock' (from the NNTP distribution)
|
|
# Ported by Brent Chapman <Brent@GreatCircle.COM>
|
|
|
|
# Taken from shlock.pl and majordomo.pl in Majordomo distribution
|
|
# Merged into package by Bill Houle <Bill.Houle@SanDiegoCA.NCR.COM>
|
|
|
|
package shlock;
|
|
require 'majordomo.pl'; # For bitch() and abort()
|
|
|
|
# These can be predefined elsewhere, e.g. majordomo.cf
|
|
$waittime = 600 unless $waittime;
|
|
$shlock_debug = 0 unless $shlock_debug;
|
|
$warncount = 20 unless $warncount;
|
|
|
|
sub alert {
|
|
&main'bitch(@_);
|
|
&main'abort("shlock: too many warnings") unless --$warncount;
|
|
}
|
|
|
|
$EPERM = 1;
|
|
$ESRCH = 3;
|
|
$EEXIST = 17;
|
|
|
|
# Lock a process via lockfile.
|
|
#
|
|
sub main'shlock {
|
|
local($file) = shift;
|
|
local($tmp);
|
|
local($retcode) = 0;
|
|
|
|
print STDERR "trying lock '$file' for pid $$\n" if $shlock_debug;
|
|
return(undef) unless ($tmp = &extant_file($file));
|
|
|
|
{ # redo-controlled loop
|
|
unless (link($tmp, $file)) {
|
|
if ($! == $EEXIST) {
|
|
print STDERR "lock '$file' already exists\n" if $shlock_debug;
|
|
if (&check_lock($file)) {
|
|
print STDERR "extant lock is valid\n" if $shlock_debug;
|
|
} else {
|
|
print STDERR "lock is invalid; removing\n" if $shlock_debug;
|
|
unlink($file); # no message because it might be gone by now
|
|
redo;
|
|
}
|
|
} else {
|
|
&alert("shlock: link('$tmp', '$file'): $!");
|
|
}
|
|
} else {
|
|
print STDERR "got lock '$file'\n" if $shlock_debug;
|
|
$retcode = 1;
|
|
}
|
|
}
|
|
|
|
unlink($tmp) || &alert("shlock: unlink('$file'): $!");
|
|
return($retcode);
|
|
}
|
|
|
|
# Create a lock file (with retry).
|
|
#
|
|
sub main'set_lock {
|
|
local($lockfile) = @_;
|
|
local($slept) = 0;
|
|
|
|
while ($slept < $waittime) {
|
|
return 1 if &main'shlock("$lockfile");
|
|
|
|
# didn't get the lock; wait 1-10 seconds and try again.
|
|
$slept += sleep(int(rand(9) + 1));
|
|
}
|
|
# if we got this far, we ran out of tries on the lock.
|
|
return undef;
|
|
}
|
|
|
|
sub main'free_lock {
|
|
unlink $_[0];
|
|
}
|
|
|
|
# open a file locked for exclusive access; we remember the name of the lock
|
|
# file, so that we can delete it when we close the file
|
|
#
|
|
sub main'lopen {
|
|
local($FH) = shift;
|
|
local($mode) = shift;
|
|
local($file) = shift;
|
|
# $fm is what will actually get passed to open()
|
|
local($fm) = "$mode$file";
|
|
local($status);
|
|
|
|
# create name for lock file
|
|
local($lockfile) = $file;
|
|
$lockfile =~ s,([^/]*)$,L.$1,;
|
|
|
|
# force unqualified filehandles into callers' package
|
|
local($package) = caller;
|
|
$FH =~ s/^[^':]+$/$package'$&/;
|
|
|
|
return undef unless &main'set_lock("$lockfile");
|
|
|
|
# Got the lock; now try to open the file
|
|
if ($status = open($FH, $fm)) {
|
|
# File successfully opened; remember the lock file for deletion
|
|
$lock_files[fileno($FH)] = "$lockfile";
|
|
} else {
|
|
# File wasn't successfully opened; delete the lock
|
|
&main'free_lock($lockfile);
|
|
}
|
|
# return the success or failure of the open
|
|
return $status;
|
|
}
|
|
|
|
# reopen a file already opened and locked (probably to change read/write mode).
|
|
# We remember the name of the lock file, so that we can delete it when
|
|
# we close the file
|
|
#
|
|
sub main'lreopen {
|
|
local($FH) = shift;
|
|
local($mode) = shift;
|
|
local($file) = shift;
|
|
# $fm is what will actually get passed to open()
|
|
local($fm) = "$mode$file";
|
|
|
|
# create name for lock file
|
|
local($lockfile) = $file;
|
|
$lockfile =~ s,([^/]*)$,L.$1,;
|
|
|
|
# force unqualified filehandles into callers' package
|
|
local($package) = caller;
|
|
$FH =~ s/^[^':]+$/$package'$&/;
|
|
|
|
# close the old file handle, and delete the lock reference
|
|
if ($lock_files[fileno($FH)]) {
|
|
undef($lock_files[fileno($FH)]);
|
|
close($FH);
|
|
} else {
|
|
# the file wasn't already locked
|
|
# unlink("$lockfile"); ### Do we really want to do this?
|
|
return(undef);
|
|
}
|
|
|
|
# We've already got the lock; now try to open the file
|
|
$status = open($FH, $fm);
|
|
if (defined($status)) {
|
|
# File successfully opened; remember the lock file for deletion
|
|
$lock_files[fileno($FH)] = "$lockfile";
|
|
} else {
|
|
# File wasn't successfully opened; delete the lock
|
|
unlink("$lockfile");
|
|
}
|
|
# return the success or failure of the open
|
|
return($status);
|
|
}
|
|
|
|
|
|
# Close a locked file, deleting the corresponding .lock file.
|
|
#
|
|
sub main'lclose {
|
|
local($FH) = shift;
|
|
|
|
# force unqualified filehandles into callers' package
|
|
local($package) = caller;
|
|
$FH =~ s/^[^':]+$/$package'$&/;
|
|
|
|
local($lock) = $lock_files[fileno($FH)];
|
|
close($FH);
|
|
unlink($lock);
|
|
}
|
|
|
|
# Open a temp file. Ensure it is temporary by checking for other links, etc.
|
|
#
|
|
sub main'open_temp {
|
|
local($FH_name, $filename) = @_;
|
|
local($inode1, $inode2, $dev1, $dev2) = ();
|
|
|
|
# force unqualified filehandles into callers' package
|
|
local($package) = caller;
|
|
$FH_name =~ s/^[^':]+$/$package'$&/;
|
|
|
|
if ( -e $filename ) {
|
|
&alert("Failed to open temp file '$filename', it exists");
|
|
return(undef);
|
|
}
|
|
|
|
unless (open($FH_name, ">> $filename")) {
|
|
local($tempdir) = ($filename =~ m|(.*)/|) ? $1 : ".";
|
|
if (! -e $tempdir) {
|
|
&main'abort("shlock: '$tempdir' does not exist");
|
|
}
|
|
elsif (! -d _) {
|
|
&main'abort("shlock: '$tempdir' is not a directory\n");
|
|
}
|
|
elsif (! -w _) {
|
|
&main'abort("shlock: '$tempdir' is not writable by UID $> GID",
|
|
(split(" ", $) ))[0], "\n");
|
|
}
|
|
else {
|
|
&alert("open of temp file '$filename' failed: $!");
|
|
}
|
|
return(undef);
|
|
}
|
|
|
|
if ( -l $filename ) {
|
|
&alert("Temp file '$filename' is a symbolic link after opening");
|
|
return(undef);
|
|
}
|
|
|
|
if ( (stat(_))[3] != 1 ) {
|
|
&alert("'$filename' has more than one link after opening");
|
|
return(undef);
|
|
}
|
|
|
|
($dev1, $inode1) = (lstat(_))[0..1];
|
|
local(*FH) = $FH_name;
|
|
($dev2, $inode2) = (stat(FH))[0..1];
|
|
|
|
if ($inode1 != $inode2) {
|
|
&alert("Inode for filename does not match filehandle! Inode1=$inode1 Inode2=$inode2");
|
|
return(undef);
|
|
}
|
|
|
|
if ($dev1 != $dev2) {
|
|
&alert("Device for filename does not match filehandle! Dev1=$dev1 Dev2=$dev2");
|
|
return(undef);
|
|
}
|
|
|
|
if ( (stat(_))[3] != 1 ) {
|
|
&alert("filehandle has more than one link after opening");
|
|
return(undef);
|
|
}
|
|
return(1);
|
|
}
|
|
|
|
sub is_process {
|
|
local($pid) = shift;
|
|
|
|
print STDERR "process $pid is " if $shlock_debug;
|
|
if ($pid <= 0) {
|
|
print STDERR "invalid\n" if $shlock_debug;
|
|
return(0);
|
|
}
|
|
if (kill(0, $pid) <= 0) {
|
|
if ($! == $ESRCH)
|
|
{ print STDERR "dead\n" if $shlock_debug; return 0; }
|
|
elsif ($! == $EPERM)
|
|
{ print STDERR "alive\n" if $shlock_debug; return 1; }
|
|
else
|
|
{ print STDERR "state unknown: $!\n" if $shlock_debug; return 1; }
|
|
}
|
|
print "alive\n" if $shlock_debug;
|
|
return 1;
|
|
}
|
|
|
|
sub check_lock {
|
|
local($file) = shift;
|
|
local(*FILE, $pid, $buf);
|
|
|
|
print STDERR "checking extant lock '$file'\n" if $shlock_debug;
|
|
unless (open(FILE, "$file")) {
|
|
&alert("shlock: open('$file'): $!") if $shlock_debug;
|
|
return 1;
|
|
}
|
|
|
|
$pid = int($buf = <FILE>);
|
|
|
|
if ($pid <= 0) {
|
|
close(FILE);
|
|
print STDERR "lock file format error\n" if $shlock_debug;
|
|
return 0;
|
|
}
|
|
close(FILE);
|
|
return(&is_process($pid));
|
|
}
|
|
|
|
sub extant_file {
|
|
local($file) = shift;
|
|
local(*FILE);
|
|
local($tempname);
|
|
|
|
$tempname = $file;
|
|
if ($tempname =~ /\//) {
|
|
$tempname =~ s,/[^\/]*$,/,;
|
|
$tempname .= "shlock.$$";
|
|
} else {
|
|
$tempname = "shlock.$$";
|
|
}
|
|
print STDERR "temporary filename '$tempname'\n" if $shlock_debug;
|
|
|
|
{ # redo-controlled loop
|
|
if ( -e $tempname ) {
|
|
print STDERR "file '$tempname' exists\n" if $shlock_debug;
|
|
unlink($tempname); # no message because it might be gone by now.
|
|
redo;
|
|
}
|
|
elsif (! &main'open_temp(FILE, $tempname)) {
|
|
print STDERR "can't create temporary file '$tempname': $!"
|
|
if $shlock_debug;
|
|
return(undef);
|
|
}
|
|
}
|
|
|
|
unless (print FILE "$$\n") {
|
|
&alert("shlock failed: write('$tempname', '$$'): $!");
|
|
close(FILE);
|
|
unlink($tempname) || &alert("shlock: unlink('$tempname'): $!");
|
|
return(undef);
|
|
}
|
|
close(FILE);
|
|
|
|
sleep(15) if $shlock_debug; # give me a chance to look at the lock file
|
|
return($tempname);
|
|
}
|
|
|
|
1;
|