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.
This commit is contained in:
parent
f326fef8a8
commit
9ea3ef2655
|
@ -252,6 +252,22 @@ buffered data is lost."
|
||||||
((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu
|
((string-contains %host-type "linux") #(0 1 2)) ; *-linux-gnu
|
||||||
(else #(1 2 3))))) ; *-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
|
(define fcntl-flock
|
||||||
(let* ((ptr (dynamic-func "fcntl" (dynamic-link)))
|
(let* ((ptr (dynamic-func "fcntl" (dynamic-link)))
|
||||||
(proc (pointer->procedure int ptr `(,int ,int *))))
|
(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)
|
(or (zero? err)
|
||||||
|
|
||||||
;; Presumably we got EAGAIN or so.
|
;; Presumably we got EAGAIN or so.
|
||||||
(throw 'flock-error fd))))))
|
(throw 'flock-error (errno)))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
Loading…
Reference in New Issue