syscalls: Add 'getxattr'.

* guix/build/syscalls.scm (getxattr): New procedure.
* tests/syscalls.scm ("getxattr, setxattr"): Test it, together with setxattr.

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3bb4545..ff008c5 100644 (file)
--- 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 7fe0cd1..3823de7 100644 (file)
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -270,6 +270,14 @@
            (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