me/guix
Archived
1
0
Fork 0
Code Activity

syscalls: Use 'define-c-struct' for 'fcntl-flock'.

Browse source 
* guix/build/syscalls.scm (%struct-flock): Use 'define-c-struct'.
(fcntl-flock): Use 'write-flock!' and 'make-bytevector' instead of
'make-c-struct'.
This commit is contained in:
Ludovic Courtès 2016-05-06 13:23:54 +02:00
parent 4e0ea3eb28
commit d33c8b4649
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
guix/build/syscalls.scm
View file

@ -643,13 +643,16 @@ system to PUT-OLD."
;;; Advisory file locking.
;;;
(define %struct-flock
;; 'struct flock' from <fcntl.h>.
(list short ; l_type
short ; l_whence
size_t ; l_start
size_t ; l_len
int)) ; l_pid
(define-c-struct %struct-flock ;<fcntl.h>
sizeof-flock
list
read-flock
write-flock!
(type short)
(whence short)
(start size_t)
(length size_t)
(pid int))
(define F_SETLKW
;; On Linux-based systems, this is usually 7, but not always
@ -690,21 +693,25 @@ exception if it's already taken."
(fileno fd-or-port)
fd-or-port))
(define bv
(make-bytevector sizeof-flock))
(write-flock! bv 0
(operation->int operation) SEEK_SET
0 0 ;whole file
0)
;; XXX: 'fcntl' is a vararg function, but here we happily use the
;; standard ABI; crossing fingers.
(let ((err (proc fd
(let ((ret (proc fd
(if wait?
F_SETLKW ; lock & wait
F_SETLK) ; non-blocking attempt
(make-c-struct %struct-flock
(list (operation->int operation)
SEEK_SET
0 0 ; whole file
0)))))
(or (zero? err)
(bytevector->pointer bv)))
(err (errno)))
(unless (zero? ret)
;; Presumably we got EAGAIN or so.
(throw 'flock-error (errno)))))))
(throw 'flock-error err))))))
;;;