summary refs log tree commit diff
diff options
context:
space:
mode:
authorJan (janneke) Nieuwenhuizen <janneke@gnu.org>2020-05-14 00:30:57 +0200
committerJan Nieuwenhuizen <janneke@gnu.org>2020-05-14 00:48:12 +0200
commitdf05842332be80ed7f53022402b95cf711163b41 (patch)
tree8626f5f1eb82a74369cd1269f75dc13603d84c39
parent1a044e3936ac4c1ba1575fe791bf59577b039cf9 (diff)
downloadguix-df05842332be80ed7f53022402b95cf711163b41.tar.gz
syscalls: Add 'getxattr'.
* guix/build/syscalls.scm (getxattr): New procedure.
* tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr.
-rw-r--r--guix/build/syscalls.scm27
-rw-r--r--tests/syscalls.scm8
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")))