[Cuis-dev] Do we have an equivalent of Unix 'flock' ?

Thu Sep 23 17:12:39 PDT 2021

Nicola,

Here is a bit more information for background.

File locking is done with posix advisory file locking, as describe in the
man(2) flock man page https://man7.org/linux/man-pages/man2/fcntl.2.html

The necessary primitives are in all of the unix VMs, and are implemented
in the UnixOSProcessPlugin. The plugin source is maintained at
http://www.squeaksource.com/OSProcessPlugin.

I am attaching a copy of the three primitive methods so you can
see what they are doing. These are Smalltalk methods in the plugin
that are translated to C code. You can find the generated C code
for these methods somewhere in the plugin code at
http://squeakvm.org/cgi-bin/viewvc.cgi/squeak/trunk/src/plugins/UnixOSProcessPlugin/UnixOSProcessPlugin.c?revision=3807&view=markup

The methods in package OSProcess make use of these primitives to implement
file locking in Squeak/Cuis, and the unit tests that I referenced show how
it works in the image. UnixOSProcessAccessor provides the direct interface
to the primitives (see category 'file locking'), and OSFileLock and
OSFileRegionLock represent locks on files or regions within a file.

HTH,
Dave

On Wed, Sep 22, 2021 at 10:19:57AM +0200, Nicola Mingotti via Cuis-dev wrote:
> 
> thank you Dave, I will study it.
> 
> bye
> Nicola
> 
> 
> 
> 
> On 9/21/21 10:08 PM, David T. Lewis wrote:
> >On Tue, Sep 21, 2021 at 10:57:16AM +0200, Nicola Mingotti via Cuis-dev 
> >wrote:
> >>Hi again,
> >>
> >>I have another question, as far as you know is it already implemented
> >>somewhere and equivalent of Unix 'flock' ?
> >>
> >>bye
> >>Nicola
> >>
> >>
> >Hi Nicola,
> >
> >Try loading OSProcess (Feature require: 'OSProcess').
> >
> >Then look at UnixProcessFileLockTestCase for examples of how the file
> >locking works on Unix/Linux and OS X.
> >
> >Dave
> >
> 
> -- 
> Cuis-dev mailing list
> Cuis-dev at lists.cuis.st
> https://lists.cuis.st/mailman/listinfo/cuis-dev
-------------- next part --------------
'From Squeak4.6 of 21 July 2021 [latest update: #15118] on 23 September 2021 at 7:35:52 pm'!

!UnixOSProcessPlugin methodsFor: 'primitives - file locking' stamp: 'dtl (auto pragmas dtl 2010-11-28) 11/19/2006 16:31'!
primitiveLockFileRegion
	"Take a struct SQFile from the stack, and request a lock on the specified region.
	If the exclusive flag is true, then request an exclusive (F_WRLCK) lock on the
     file. Otherwise, request a shared (F_RDLCK) lock. Any number of Unix processes
     may hold  a read lock (shared lock) on a file region, but only one process may
     hold a write lock (exclusive lock). Answer the result of the call to fcntl().

	If length is zero, then the entire file will be locked, including region extents that
	have not yet been allocated for the file."

	| lockStruct exclusive len start sqFileOop fileNo result |
	<export: true>
	<var: 'lockStruct' declareC: 'struct flock lockStruct'>
	<var: 'fileNo' type: 'int'>
	<var: 'result' type: 'int'>

	"Get the parameters from the stack"
	exclusive := (interpreterProxy stackValue: 0) == interpreterProxy trueObject.
	len := interpreterProxy stackIntegerValue: 1.
	start := interpreterProxy stackIntegerValue: 2.
	sqFileOop := interpreterProxy stackValue: 3.
	(self isSQFileObject: sqFileOop) ifFalse: [^ interpreterProxy primitiveFail].
	fileNo := self unixFileNumber: (self fileHandleFrom: sqFileOop).

	"Set up the flock structure parameter for fcntl()"
	exclusive
		ifTrue: [self cCode: 'lockStruct.l_type = F_WRLCK']
		ifFalse: [self cCode: 'lockStruct.l_type = F_RDLCK'].
	self cCode: 'lockStruct.l_whence = SEEK_SET'.
	self cCode: 'lockStruct.l_start = start'.
	self cCode: 'lockStruct.l_len = len'.
	self cCode: 'lockStruct.l_pid = 0'.

	"Request the lock and answer the result of the fcntl call"
	result := self cCode: 'fcntl(fileNo, F_SETLK, &lockStruct)'.
	interpreterProxy pop: 5; pushInteger: result
! !

!UnixOSProcessPlugin methodsFor: 'primitives - file locking' stamp: 'dtl (auto pragmas dtl 2010-11-28) 11/19/2006 16:34'!
primitiveTestLockableFileRegion
	"Take a struct SQFile from the stack, and check for ability to lock the specified region.
	If the exclusive flag is true, then specify an exclusive (F_WRLCK) lock on the
     file. Otherwise, specify a shared (F_RDLCK) lock. Any number of Unix processes
     may hold  a read lock (shared lock) on a file region, but only one process may
     hold a write lock (exclusive lock).

	If length is zero, then the request is for the entire file to be locked, including
	region extents that have not yet been allocated for the file.

	If the fcntl() call fails, answer -1 (the result of the failed call). Otherwise,
	answer an array with the following six fields:
		lockable (true or false)
		l_pid (pid of the process preventing this lock request, or nil)
		l_type (request type F_WRLCK or F_RDLOCK of the process preventing this lock request)
		l_whence (the SEEK_SET, SEEK_CUR, or SEEK_END value of the lock preventing this lock request).
		l_start (offset of the region lock preventing this lock request)
		l_len (length of the region lock preventing this lock request)"

	| lockStruct exclusive len start sqFileOop fileNo result resultArray canObtainLock |
	<export: true>
	<var: 'lockStruct' declareC: 'struct flock lockStruct'>
	<var: 'fileNo' type: 'int'>
	<var: 'result' type: 'int'>

	"Get the parameters from the stack"
	exclusive := (interpreterProxy stackValue: 0) == interpreterProxy trueObject.
	len := interpreterProxy stackIntegerValue: 1.
	start := interpreterProxy stackIntegerValue: 2.
	sqFileOop := interpreterProxy stackValue: 3.
	(self isSQFileObject: sqFileOop) ifFalse: [^ interpreterProxy primitiveFail].
	fileNo := self unixFileNumber: (self fileHandleFrom: sqFileOop).

	"Set up the flock structure parameter for fcntl()"
	exclusive
		ifTrue: [self cCode: 'lockStruct.l_type = F_WRLCK']
		ifFalse: [self cCode: 'lockStruct.l_type = F_RDLCK'].
	self cCode: 'lockStruct.l_whence = SEEK_SET'.
	self cCode: 'lockStruct.l_start = start'.
	self cCode: 'lockStruct.l_len = len'.
	self cCode: 'lockStruct.l_pid = 0'.

	"Check availability of the lock"
	result := self cCode: 'fcntl(fileNo, F_GETLK, &lockStruct)'.
	(result == -1)
		ifTrue:
			[interpreterProxy pop: 5; pushInteger: result]
		ifFalse:
			[(self cCode: 'lockStruct.l_type == F_UNLCK')
				ifTrue: [canObtainLock := interpreterProxy trueObject]
				ifFalse: [canObtainLock := interpreterProxy falseObject].

resultArray := interpreterProxy
							instantiateClass: (interpreterProxy classArray)
							indexableSize: 6.
			interpreterProxy
				stObject: resultArray
				at: 1
				put: canObtainLock.
			interpreterProxy
				stObject: resultArray
				at: 2
				put: (interpreterProxy integerObjectOf: (self cCode: 'lockStruct.l_pid')).
			interpreterProxy
				stObject: resultArray
				at: 3
				put: (interpreterProxy integerObjectOf: (self cCode: 'lockStruct.l_type')).
			interpreterProxy
				stObject: resultArray
				at: 4
				put: (interpreterProxy integerObjectOf: (self cCode: 'lockStruct.l_whence')).
			interpreterProxy
				stObject: resultArray
				at: 5
				put: (interpreterProxy integerObjectOf: (self cCode: 'lockStruct.l_start')).
			interpreterProxy
				stObject: resultArray
				at: 6
				put: (interpreterProxy integerObjectOf: (self cCode: 'lockStruct.l_len')).
			interpreterProxy pop: 5 thenPush: resultArray]
! !

!UnixOSProcessPlugin methodsFor: 'primitives - file locking' stamp: 'dtl (auto pragmas dtl 2010-11-28) 11/19/2006 16:37'!
primitiveUnlockFileRegion
	"Take a struct SQFile from the stack, and unlock the specified region.
	Answer the result of the call to fcntl(). If the region is in the file lock cache,
	remove it, but otherwise ignore the cache. The cache supports Win32 semantics
	within a single Squeak image, but not across separate images, therefore the
	unlock should be attempted regardless of whether this image thinks that the
	region has previously been locked. Answer the result of the call to fcntl()."

	| lockStruct len start sqFileOop fileNo result |
	<export: true>
	<var: 'lockStruct' declareC: 'struct flock lockStruct'>
	<var: 'fileNo' type: 'int'>
	<var: 'result' type: 'int'>

	"Get the parameters from the stack"
	len := interpreterProxy stackIntegerValue: 0.
	start := interpreterProxy stackIntegerValue: 1.
	sqFileOop := interpreterProxy stackValue: 2.
	(self isSQFileObject: sqFileOop) ifFalse: [^ interpreterProxy primitiveFail].
	fileNo := self unixFileNumber: (self fileHandleFrom: sqFileOop).

	"Set up the flock structure parameter for fcntl()"
	self cCode: 'lockStruct.l_type = F_UNLCK'.
	self cCode: 'lockStruct.l_whence = SEEK_SET'.
	self cCode: 'lockStruct.l_start = start'.
	self cCode: 'lockStruct.l_len = len'.
	self cCode: 'lockStruct.l_pid = 0'.

	"Request the lock and answer the result of the fcntl call"
	result := self cCode: 'fcntl(fileNo, F_SETLK, &lockStruct)'.
	interpreterProxy pop: 4; pushInteger: result
! !