diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-03-07 16:46:09 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-08 00:18:22 +0100 |
| commit | c7445833eb43ec621fb5a56f6bfbbf0a02a675c2 (patch) | |
| tree | 3107311f5d32a144f6c3373f6b5b0eb70041f6d5 /guix | |
| parent | e7f34eb0dc5a5302726857a77de3cf5f6635c1b7 (diff) | |
utils: Add a non-blocking option for 'fcntl-flock'.
* guix/utils.scm (F_SETLK): New variable.
(fcntl-flock): Add 'wait?' keyword parameter; honor it.
* tests/utils.scm ("fcntl-flock non-blocking"): New test.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/utils.scm | 17 |
1 files changed, 14 insertions, 3 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 38f9ad0f61..68329ec915 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -244,6 +244,13 @@ buffered data is lost." ((string-contains %host-type "linux") 7) ; *-linux-gnu (else 9)))) ; *-gnu* +(define F_SETLK + ;; Likewise: GNU/Hurd and SPARC use 8, while the others typically use 6. + (compile-time-value + (cond ((string-contains %host-type "sparc") 8) ; sparc-*-linux-gnu + ((string-contains %host-type "linux") 6) ; *-linux-gnu + (else 8)))) ; *-gnu* + (define F_xxLCK ;; The F_RDLCK, F_WRLCK, and F_UNLCK constants. (compile-time-value @@ -271,9 +278,11 @@ buffered data is lost." (define fcntl-flock (let* ((ptr (dynamic-func "fcntl" (dynamic-link))) (proc (pointer->procedure int ptr `(,int ,int *)))) - (lambda (fd-or-port operation) + (lambda* (fd-or-port operation #:key (wait? #t)) "Perform locking OPERATION on the file beneath FD-OR-PORT. OPERATION -must be a symbol, one of 'read-lock, 'write-lock, or 'unlock." +must be a symbol, one of 'read-lock, 'write-lock, or 'unlock. When WAIT? is +true, block until the lock is acquired; otherwise, thrown an 'flock-error' +exception if it's already taken." (define (operation->int op) (case op ((read-lock) (vector-ref F_xxLCK 0)) @@ -289,7 +298,9 @@ must be a symbol, one of 'read-lock, 'write-lock, or 'unlock." ;; XXX: 'fcntl' is a vararg function, but here we happily use the ;; standard ABI; crossing fingers. (let ((err (proc fd - F_SETLKW ; lock & wait + (if wait? + F_SETLKW ; lock & wait + F_SETLK) ; non-blocking attempt (make-c-struct %struct-flock (list (operation->int operation) SEEK_SET |