diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 3bb4545c04fbc0a9c4fbddf7cf021ef6667a7c61..ff008c5b78d184c76c144d1300a2562cc9798c57 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -79,6 +79,7 @@ (define-module (guix build syscalls) fdatasync pivot-root scandir* + getxattr setxattr fcntl-flock @@ -724,6 +725,32 @@ (define* (device-in-use? 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 7fe0cd15456639b8d37a08e2b519fbb3b4895fdf..3823de7c1e02220992daaa14507720a426f5b851 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -270,6 +270,14 @@ (define perform-container-tests? (scandir* directory) (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