syscalls: Use 'define-c-struct' for 'fcntl-flock'.
* 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:
parent
4e0ea3eb28
commit
d33c8b4649
|
@ -643,13 +643,16 @@ system to PUT-OLD."
|
||||||
;;; Advisory file locking.
|
;;; Advisory file locking.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define %struct-flock
|
(define-c-struct %struct-flock ;<fcntl.h>
|
||||||
;; 'struct flock' from <fcntl.h>.
|
sizeof-flock
|
||||||
(list short ; l_type
|
list
|
||||||
short ; l_whence
|
read-flock
|
||||||
size_t ; l_start
|
write-flock!
|
||||||
size_t ; l_len
|
(type short)
|
||||||
int)) ; l_pid
|
(whence short)
|
||||||
|
(start size_t)
|
||||||
|
(length size_t)
|
||||||
|
(pid int))
|
||||||
|
|
||||||
(define F_SETLKW
|
(define F_SETLKW
|
||||||
;; On Linux-based systems, this is usually 7, but not always
|
;; 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)
|
(fileno fd-or-port)
|
||||||
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
|
;; XXX: 'fcntl' is a vararg function, but here we happily use the
|
||||||
;; standard ABI; crossing fingers.
|
;; standard ABI; crossing fingers.
|
||||||
(let ((err (proc fd
|
(let ((ret (proc fd
|
||||||
(if wait?
|
(if wait?
|
||||||
F_SETLKW ; lock & wait
|
F_SETLKW ; lock & wait
|
||||||
F_SETLK) ; non-blocking attempt
|
F_SETLK) ; non-blocking attempt
|
||||||
(make-c-struct %struct-flock
|
(bytevector->pointer bv)))
|
||||||
(list (operation->int operation)
|
(err (errno)))
|
||||||
SEEK_SET
|
(unless (zero? ret)
|
||||||
0 0 ; whole file
|
;; Presumably we got EAGAIN or so.
|
||||||
0)))))
|
(throw 'flock-error err))))))
|
||||||
(or (zero? err)
|
|
||||||
|
|
||||||
;; Presumably we got EAGAIN or so.
|
|
||||||
(throw 'flock-error (errno)))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Reference in New Issue