diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-03-06 21:41:51 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-06 21:42:24 +0100 |
commit | 9ea3ef26551a754df502e03002a73052f3c2fbc6 (patch) | |
tree | 2a04e53e14cedd66a606922445ba226995982f42 | |
parent | f326fef8a89d02b481d7e900ef791d0108381f3f (diff) | |
download | patches-9ea3ef26551a754df502e03002a73052f3c2fbc6.tar patches-9ea3ef26551a754df502e03002a73052f3c2fbc6.tar.gz |
utils: 'fcntl-flock' passes an errno when throwing an exception.
* guix/utils.scm (%libc-errno-pointer, errno): New procedures.
(fcntl-flock): Use it as the exception's argument.
-rw-r--r-- | guix/utils.scm | 18 |
1 files changed, 17 insertions, 1 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 5fda2116de..38f9ad0f61 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -252,6 +252,22 @@ buffered data is lost." ((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu (else #(1 2 3))))) ; *-gnu* +(define %libc-errno-pointer + ;; Glibc's 'errno' pointer. + (let ((errno-loc (dynamic-func "__errno_location" (dynamic-link)))) + (and errno-loc + (let ((proc (pointer->procedure '* errno-loc '()))) + (proc))))) + +(define (errno) + "Return the current errno." + ;; XXX: We assume that nothing changes 'errno' while we're doing all this. + ;; In particular, that means that no async must be running here. + (if %libc-errno-pointer + (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int)))) + (bytevector-sint-ref bv 0 (native-endianness) (sizeof int))) + 0)) + (define fcntl-flock (let* ((ptr (dynamic-func "fcntl" (dynamic-link))) (proc (pointer->procedure int ptr `(,int ,int *)))) @@ -282,7 +298,7 @@ must be a symbol, one of 'read-lock, 'write-lock, or 'unlock." (or (zero? err) ;; Presumably we got EAGAIN or so. - (throw 'flock-error fd)))))) + (throw 'flock-error (errno))))))) ;;; |