Karl Swartz (kls@ditka.chicago.com) just figured out the bug that's
causing Majordomo files to get deleted: it was a bug in "shlock".
shlock would create lock files by appending ".lock" to the file name.
If the file name was already 14 characters or longer, the lock file would
end up having the same name as the original file; thus the original file
would get over-written by the lock file, and then deleted when the lock
was deleted.
A fixed version of "shlock.pl" is appended. It will be part of the next
Majordomo release.
Thanks, Karl!
-Brent
--
Brent Chapman Great Circle Associates
Brent@GreatCircle.COM 1057 West Dana Street
+1 415 962 0841 Mountain View, CA 94041
# PERL implementation of Erik E. Fair's 'shlock' (from the NNTP distribution)
# Ported by Brent Chapman <Brent@GreatCircle.COM>
# $Source: /mycroft/brent/majordomo/RCS/shlock.pl,v $
# $Revision: 1.4 $
# $Date: 1993/02/26 17:24:56 $
# $Author: brent $
# $State: Exp $
#
# $Locker: $
#
# $Log: shlock.pl,v $
# Revision 1.4 1993/02/26 17:24:56 brent
# Fixed bug that was causing files to get deleted on systems with 14-char
# filename limits. $file.lock would end up same as $file if $file was
# already 14 characters or longer. Changed from $file.lock to L.$file.
# Thanks to Karl Swartz <kls@ditka.chicago.com> for chasing this down.
#
# Revision 1.3 1993/01/03 04:18:18 brent
# Added "lreopen" function. -Brent
#
# Revision 1.2 1992/12/25 00:48:53 brent
# Moved "lopen" and "lclose" functions from "majordomo.pl" to "shlock.pl".
#
# Revision 1.1 1992/06/24 01:53:45 brent
# Initial revision
#
#
package shlock;
$shlock_debug = 0;
$EPERM = 1;
$ESRCH = 3;
$EEXIST = 17;
sub main'shlock ## Public
{
local($file) = shift;
local($tmp);
local($retcode) = 0;
local($redo_loop);
print STDERR "trying lock \"$file\" for pid $$\n" if $shlock_debug;
if (!($tmp = &xtmpfile($file))) {
return(undef);
}
do {
$redo_loop = 0;
if (! link($tmp, $file)) {
if ($! == $EEXIST) {
print STDERR "lock \"$file\" already exists\n" if $shlock_debug;
$redo_loop = 1;
if (&cklock($file)) {
print STDERR "extant lock is valid\n" if $shlock_debug;
$redo_loop = 0;
} else {
print STDERR "lock is invalid; removing\n" if $shlock_debug;
if (unlink($file) <= 0) {
warn("shlock: unlink(\"$file\"): $!");
}
}
} else {
warn("shlock: link(\"$tmp\", \"$file\"): $!");
}
} else {
print STDERR "got lock \"$file\"\n" if $shlock_debug;
$retcode = 1;
}
} while ($redo_loop);
if (unlink($tmp) <= 0) {
warn("shlock: unlink(\"$file\"): $!");
}
return($retcode);
}
sub p_exists {
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 cklock {
local($file) = shift;
local(*FILE, $len, $pid, $buf);
print STDERR "checking extant lock \"$file\"\n" if $shlock_debug;
if (!open(FILE, "$file")) {
warn("shlock: open(\"$file\"): $!");
return 1;
}
$buf = <FILE>;
if (int($buf) <= 0) {
close(FILE);
print STDERR "lock file format error\n" if $shlock_debug;
return 0;
}
close(FILE);
return(&p_exists(int($buf)));
}
sub xtmpfile {
local($file) = shift;
local(*FILE);
local($tempname);
local($redo_loop);
$tempname = $file;
if ($tempname =~ /\//) {
$tempname =~ s,/[^\/]*$,/,;
$tempname .= "shlock$$";
} else {
$tempname = "shlock$$";
}
print STDERR "temporary filename \"$tempname\"\n" if $shlock_debug;
do {
$redo_loop = 0;
if (!open(FILE, ">$tempname")) {
if ($! == $EEXIST) {
print STDERR "file \"$tempname\" exists\n" if $shlock_debug;
if (unlink($tempname) <= 0) {
warn("shlock: unlink(\"$tempname\"): $!");
return(undef);
}
$redo_loop = 1;
} else {
warn("shlock: open(\">$tempname\"): $!");
return(undef);
}
}
} while ($redo_loop);
if (! print FILE "$$\n") {
warn("shlock: write(\"$tempfile\", \"$$\"): $!");
close(FILE);
unlink($tempname) || warn("shlock: unlink(\"$tempname\"): $!");
return(undef);
}
close(FILE);
return($tempname);
}
# 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);
local($tries);
# create name for lock file
local($lockfile) = $file;
$lockfile =~ s,([^/]*)$,L.$1,;
# force unqualified filehandles into callers' package
local($package) = caller;
$FH =~ s/^[^']+$/$package'$&/;
for ($tries = 0 ; $tries < 600 ; $tries++) {
# Try to obtain the lock 600 times, waiting 1 second after each try
if (&main'shlock("$lockfile")) {
# 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);
} else {
# didn't get the lock; wait 1 second and try again.
sleep(1);
}
}
# If we get this far, we ran out of tries on the lock.
return undef;
}
# 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");
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'$&/;
unlink($lock_files[fileno($FH)]);
close($FH);
}
1;
Follow-Ups:
|
|
