branch master updated: syscalls: Add 'getxattr'.

[guix-commits]

This is an automated email from the git hooks/post-receive script.

janneke pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new df05842  syscalls: Add 'getxattr'.
df05842 is described below

commit df05842332be80ed7f53022402b95cf711163b41
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Thu May 14 00:30:57 2020 +0200

    syscalls: Add 'getxattr'.
    
    * guix/build/syscalls.scm (getxattr): New procedure.
    * tests/syscalls.scm ("getxattr, setxattr"): Test it, together with 
setxattr.
---
 guix/build/syscalls.scm | 27 +++++++++++++++++++++++++++
 tests/syscalls.scm      |  8 ++++++++
 2 files changed, 35 insertions(+)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 3bb4545..ff008c5 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 7fe0cd1..3823de7 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")))