diff options
| -rw-r--r-- | guix/build/syscalls.scm | 27 | ||||
| -rw-r--r-- | tests/syscalls.scm | 8 |
2 files changed, 35 insertions, 0 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3bb4545c04..ff008c5b78 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -79,6 +79,7 @@ fdatasync pivot-root scandir* + getxattr setxattr fcntl-flock @@ -724,6 +725,32 @@ backend device." (list (strerror 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 (let ((proc (syscall->procedure int "setxattr" `(* * * ,size_t ,int)))) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7fe0cd1545..3823de7c1e 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -271,6 +271,14 @@ (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)) (test-equal "fcntl-flock wait" 42 ; the child's exit status (let ((file (open-file temp-file "w0b"))) |