summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-05-06 13:23:54 +0200
committerLudovic Courtès <ludo@gnu.org>2016-05-06 13:25:30 +0200
commitd33c8b464915fb9bbe07434116fd6f3428e8cef0 (patch)
treea1a7b26f1902a2eb4416a156b960122c8f15fdef /guix
parent4e0ea3eb288c2143b44bf324c64047762c72d3b3 (diff)
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'.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/syscalls.scm41
1 files changed, 24 insertions, 17 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 86723c23c7..48ff227e10 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -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)
-
- ;; Presumably we got EAGAIN or so.
- (throw 'flock-error (errno)))))))
+ (bytevector->pointer bv)))
+ (err (errno)))
+ (unless (zero? ret)
+ ;; Presumably we got EAGAIN or so.
+ (throw 'flock-error err))))))
;;;