ken@sdd.hp.com (Ken Stone) (02/01/91)
A while back I heard several people asking about lockf for perl. Yea you
certainly >can< do it with fcntl(2) but its kind of a pain if your used
to having lockf at your disposal. So here is a patch that should drop into
3.0@41 or 3.0@44 and along with it is a new member of the test suite to
test it out !!
If anybody else thinks this is great ... maybe Larry would consider it for
4.0 .... please ???
-- Ken
# This is a shell archive. Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by Source Hacker <src@hpsdlz> on Mon Jan 14 14:21:05 1991
#
# This archive contains:
# lockf.patches op.lockf
#
LANG=""; export LANG
PATH=/bin:/usr/bin:$PATH; export PATH
echo x - lockf.patches
cat >lockf.patches <<'@EOF'
*** perl.3.0/arg.h Wed Nov 14 08:36:06 1990
--- perl.3.0.patch41.virgin/arg.h Wed Nov 14 08:28:42 1990
***************
*** 315,322 ****
#define O_FTCTIME 265
#define O_WAITPID 266
#define O_ALARM 267
! #define O_LOCKF 268
! #define MAXO 269
#ifndef DOINIT
extern char *opname[];
--- 315,321 ----
#define O_FTCTIME 265
#define O_WAITPID 266
#define O_ALARM 267
! #define MAXO 268
#ifndef DOINIT
extern char *opname[];
***************
*** 590,597 ****
"FTCTIME",
"WAITPID",
"ALARM",
! "LOCKF",
! "269"
};
#endif
--- 589,595 ----
"FTCTIME",
"WAITPID",
"ALARM",
! "268"
};
#endif
***************
*** 990,996 ****
A(1,0,0), /* FTCTIME */
A(1,1,0), /* WAITPID */
A(1,0,0), /* ALARM */
- A(1,1,1), /* LOCKF */
0
};
#undef A
--- 988,993 ----
*** perl.3.0/config_h.SH Wed Nov 14 10:27:19 1990
--- perl.3.0.patch41.virgin/config_h.SH Wed Nov 14 08:28:43 1990
***************
*** 160,171 ****
*/
#$d_flock FLOCK /**/
- /* LOCKF:
- * This symbol, if defined, indicates that the lockf() routine is
- * available to do file locking.
- */
- #$d_lockf LOCKF /**/
-
/* GETGROUPS:
* This symbol, if defined, indicates that the getgroups() routine is
* available to get the list of process groups. If unavailable, multiple
--- 160,165 ----
*** perl.3.0/eval.c Wed Nov 14 08:52:42 1990
--- perl.3.0.patch41.virgin/eval.c Wed Nov 14 08:28:52 1990
***************
*** 1901,1930 ****
str_set(str,"0 but true");
STABSET(str);
break;
- case O_LOCKF:
- #ifdef LOCKF
- if (maxarg <= 0)
- stab = last_in_stab;
- else if ((arg[1].arg_type & A_MASK) == A_WORD)
- stab = arg[1].arg_ptr.arg_stab;
- else
- stab = stabent(str_get(st[1]),TRUE);
- if (stab && stab_io(stab))
- fp = stab_io(stab)->ifp;
- else
- fp = Nullfp;
- if (fp) {
- argtype = (int)str_gnum(st[2]);
- when = (long)str_gnum(st[3]);
- value = (double)(lockf(fileno(fp),argtype,when) >= 0);
- }
- else
- value = 0;
- goto donumset;
- #else
- fatal("The lockf() function is unimplemented on this machine");
- break;
- #endif
case O_FLOCK:
#ifdef FLOCK
if (maxarg <= 0)
--- 1901,1906 ----
*** perl.3.0/toke.c Wed Nov 14 08:38:11 1990
--- perl.3.0.patch41.virgin/toke.c Wed Nov 14 08:29:35 1990
***************
*** 953,960 ****
FOP2(O_LISTEN);
if (strEQ(d,"lstat"))
FOP(O_LSTAT);
- if (strEQ(d,"lockf"))
- FOP3(O_LOCKF);
break;
case 'm': case 'M':
if (s[1] == '\'') {
--- 953,958 ----
*** perl.3.0/Configure Wed Nov 14 10:25:44 1990
--- perl.3.0.patch41.virgin/Configure Wed Nov 14 08:28:39 1990
***************
*** 114,120 ****
d_fchown=''
d_fcntl=''
d_flock=''
- d_lockf=''
d_getgrps=''
d_gethent=''
d_getpgrp=''
--- 114,119 ----
***************
*** 1708,1717 ****
set flock d_flock
eval $inlibc
- : see if lockf exists
- set lockf d_lockf
- eval $inlibc
-
: see if getgroups exists
set getgroups d_getgrps
eval $inlibc
--- 1707,1712 ----
***************
*** 2712,2718 ****
d_fchown='$d_fchown'
d_fcntl='$d_fcntl'
d_flock='$d_flock'
- d_lockf='$d_lockf'
d_getgrps='$d_getgrps'
d_gethent='$d_gethent'
d_getpgrp='$d_getpgrp'
--- 2707,2712 ----
*** perl.3.0/config_h.SH Wed Nov 14 10:27:19 1990
--- perl.3.0.patch41.virgin/config_h.SH Wed Nov 14 08:28:43 1990
***************
*** 160,171 ****
*/
#$d_flock FLOCK /**/
- /* LOCKF:
- * This symbol, if defined, indicates that the lockf() routine is
- * available to do file locking.
- */
- #$d_lockf LOCKF /**/
-
/* GETGROUPS:
* This symbol, if defined, indicates that the getgroups() routine is
* available to get the list of process groups. If unavailable, multiple
--- 160,165 ----
*** perl.3.0/perl_man.2 Wed Nov 14 10:30:13 1990
--- perl.3.0.patch41.virgin/perl_man.2 Wed Nov 14 08:29:09 1990
***************
*** 650,660 ****
Useful for constructing bitmaps for select().
If FILEHANDLE is an expression, the value is taken as the name of
the filehandle.
- .Ip "lockf(FILEHANDLE,FUNCTION,SIZE)" 8 4
- Calls lockf(2) on FILEHANDLE.
- See manual page for lockf(2) for definition of OPERATION and SIZE.
- Will produce a fatal error if used on a machine that doesn't implement
- lockf(2).
.Ip "flock(FILEHANDLE,OPERATION)" 8 4
Calls flock(2) on FILEHANDLE.
See manual page for flock(2) for definition of OPERATION.
--- 650,655 ----
@EOF
chmod 666 lockf.patches
echo x - op.lockf
cat >op.lockf <<'@EOF'
#!./perl
# $Header$
sub lockftest {
local($op, $size) = @_;
local($got,*FOOBAR);
if (fork() == 0) {
open(FOOBAR,'op.lockf') || open(FOOBAR,'t/op.lockf') || exit -1;
$got = lockf(FOOBAR, $op, $size);
print "# child($$) got $got ($!)\n";
close(FOOBAR);
exit $got;
}
wait;
return($? >> 8);
}
print "1..8\n";
open(FOO,'op.lockf') || open(FOO,'t/op.lockf') || die "Can't open op.lockf";
# Lock it
$got = lockf(FOO, 1, 0);
print "# parent($$) got $got ($!)\n";
print ($got ? "ok 1\n" : "not ok 1\n");
# Test after fork
$got = &lockftest(2, 0);
print ((! $got) ? "ok 2\n" : "not ok 2\n");
# Unlock
$got = lockf(FOO, 0, 0);
print "# parent($$) got $got ($!)\n";
print ($got ? "ok 3\n" : "not ok 3\n");
# Now try test after fork
$got = &lockftest(2, 0);
print ($got ? "ok 4\n" : "not ok 4\n");
# Non overlapping locked regions
$got = seek(FOO, 10, 0);
if ($got) {
$got = lockf(FOO, 1, 10);
print "# parent($$) got $got ($!)\n";
print ($got ? "ok 5\n" : "not ok 5\n");
$got = &lockftest(2, 10);
print ($got ? "ok 6\n" : "not ok 6\n");
lockf(FOO, 0, 10);
} else {
print "seek failed ($!)\n";
print "not ok 5\n";
print "not ok 6\n";
}
# Overlapping locked regions
$got = seek(FOO, 10, 0);
if ($got) {
$got = lockf(FOO, 1, 10);
print "# parent($$) got $got ($!)\n";
print ($got ? "ok 7\n" : "not ok 7\n");
$got = &lockftest(2, 15);
print ((! $got) ? "ok 8\n" : "not ok 8\n");
lockf(FOO, 0, 10);
} else {
print "seek failed ($!)\n";
print "not ok 7\n";
print "not ok 8\n";
}
close(FOOBAR);
@EOF
chmod 755 op.lockf
exit 0tchrist@convex.COM (Tom Christiansen) (02/02/91)
I'm a bit nervous about using lockf() in all possible applicaltions. It requires (on Suns and Convexen at least) rpc.lockd to be running. flock() on the other hand is quick and can be run single user. --tom -- "Hey, did you hear Stallman has replaced /vmunix with /vmunix.el? Now he can finally have the whole O/S built-in to his editor like he always wanted!" --me (Tom Christiansen <tchrist@convex.com>)
thurlow@convex.com (Robert Thurlow) (02/02/91)
In <1991Feb1.074602.25583@robobar.co.uk> ronald@robobar.co.uk (Ronald S H Khoo) writes: >Hmm.. but wouldn't it make perl programs more portable if >you actually implemented the perl flock() function with lockf() ? >(Or don't the idioms match ? I haven't got a flock(2) manual page ....) I know of no BSD/Sun based machines which support any form of mapping between flock() and lockf(). An flock() style file lock does not in any way prevent someone from locking either a file region or an entire file with lockf(), or vice versa. Yes, this is stupid. Yes, the two locks can be mapped. But they've not been as far as I know. Anyone can jump in here to point out counterexamples with my thanks. What's the take on this in the System V universe? The last System V machine I worked on supported only lockf()/fcntl() style locking, with either advisory or enforcement locks as a kernel tunable. flock() is really a pretty limited idiom, so I never saw motivation to port it to SysV. The big reason it's so popular on BSD/Sun machines is that the Sun lock manager has traditionally been fraught with reliability problems. Rob T -- Rob Thurlow, thurlow@convex.com An employee and not a spokesman for Convex Computer Corp., Dallas, TX
ronald@robobar.co.uk (Ronald S H Khoo) (02/05/91)
tchrist@convex.COM (Tom Christiansen) writes: > I'm a bit nervous about using lockf() in all possible applicaltions. It > requires (on Suns and Convexen at least) rpc.lockd to be running. flock() > on the other hand is quick and can be run single user. Hmm.. Did I say use lockf() in all applications ? I musta been asleep :-) I probably meant to say "possibly include a flock() emulator written in terms of lockf() for sites without flock()" so that perl programs written with the *perl* flock() function have some chance of working on stock System V machines ? Is this reasonable? Does flock() map onto lockf() well enough for this approach to work ? -- Ronald Khoo <ronald@robobar.co.uk> +44 81 991 1142 (O) +44 71 229 7741 (H)
allbery@NCoast.ORG (Brandon S. Allbery KB8JRR) (02/09/91)
As quoted from <1991Feb4.214044.2422@robobar.co.uk> by ronald@robobar.co.uk (Ronald S H Khoo): +--------------- | I probably meant to say "possibly include a flock() emulator written in | terms of lockf() for sites without flock()" so that perl programs | written with the *perl* flock() function have some chance of working | on stock System V machines ? Is this reasonable? Does flock() map | onto lockf() well enough for this approach to work ? +--------------- Sure. Just lock from bytes 0 to the maximum system file size (*not* to the end of the file! That would still let any process append to the file). ++Brandon -- Me: Brandon S. Allbery VHF/UHF: KB8JRR on 220, 2m, 440 Internet: allbery@NCoast.ORG Packet: KB8JRR @ WA8BXN America OnLine: KB8JRR AMPR: KB8JRR.AmPR.ORG [44.70.4.88] uunet!usenet.ins.cwru.edu!ncoast!allbery Delphi: ALLBERY