mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-23 11:09:41 -05:00
syscalls: Add 'getxattr'.
* guix/build/syscalls.scm (getxattr): New procedure. * tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr.
This commit is contained in:
parent
1a044e3936
commit
df05842332
2 changed files with 35 additions and 0 deletions
|
@ -79,6 +79,7 @@ (define-module (guix build syscalls)
|
||||||
fdatasync
|
fdatasync
|
||||||
pivot-root
|
pivot-root
|
||||||
scandir*
|
scandir*
|
||||||
|
getxattr
|
||||||
setxattr
|
setxattr
|
||||||
|
|
||||||
fcntl-flock
|
fcntl-flock
|
||||||
|
@ -724,6 +725,32 @@ (define* (device-in-use? device)
|
||||||
(list (strerror err))
|
(list (strerror err))
|
||||||
(list err))))))
|
(list err))))))
|
||||||
|
|
||||||
|
(define getxattr
|
||||||
|
(let ((proc (syscall->procedure ssize_t "getxattr"
|
||||||
|
`(* * * ,size_t))))
|
||||||
|
(lambda (file key)
|
||||||
|
"Get the extended attribute value for KEY on FILE."
|
||||||
|
(let-values (((size err)
|
||||||
|
;; Get size of VALUE for buffer.
|
||||||
|
(proc (string->pointer/utf-8 file)
|
||||||
|
(string->pointer key)
|
||||||
|
(string->pointer "")
|
||||||
|
0)))
|
||||||
|
(cond ((< size 0) #f)
|
||||||
|
((zero? size) "")
|
||||||
|
;; Get VALUE in buffer of SIZE. XXX actual size can race.
|
||||||
|
(else (let*-values (((buf) (make-bytevector size))
|
||||||
|
((size err)
|
||||||
|
(proc (string->pointer/utf-8 file)
|
||||||
|
(string->pointer key)
|
||||||
|
(bytevector->pointer buf)
|
||||||
|
size)))
|
||||||
|
(if (>= size 0)
|
||||||
|
(utf8->string buf)
|
||||||
|
(throw 'system-error "getxattr" "~S: ~A"
|
||||||
|
(list file key (strerror err))
|
||||||
|
(list err))))))))))
|
||||||
|
|
||||||
(define setxattr
|
(define setxattr
|
||||||
(let ((proc (syscall->procedure int "setxattr"
|
(let ((proc (syscall->procedure int "setxattr"
|
||||||
`(* * * ,size_t ,int))))
|
`(* * * ,size_t ,int))))
|
||||||
|
|
|
@ -270,6 +270,14 @@ (define perform-container-tests?
|
||||||
(scandir* directory)
|
(scandir* directory)
|
||||||
(scandir directory (const #t) string<?))))
|
(scandir directory (const #t) string<?))))
|
||||||
|
|
||||||
|
(false-if-exception (delete-file temp-file))
|
||||||
|
(test-assert "getxattr, setxattr"
|
||||||
|
(let ((key "user.translator")
|
||||||
|
(value "/hurd/pfinet\0")
|
||||||
|
(file (open-file temp-file "w0")))
|
||||||
|
(setxattr temp-file key value)
|
||||||
|
(string=? (getxattr temp-file key) value)))
|
||||||
|
|
||||||
(false-if-exception (delete-file temp-file))
|
(false-if-exception (delete-file temp-file))
|
||||||
(test-equal "fcntl-flock wait"
|
(test-equal "fcntl-flock wait"
|
||||||
42 ; the child's exit status
|
42 ; the child's exit status
|
||||||
|
|
Loading…
Reference in a new issue