[PATCH 22/25] ice-9/xattr: implement `xattr-get' function

[KAction]

From: Dmitry Bogatov <address@hidden>

---
 module/ice-9/xattr.scm | 40 +++++++++++++++++++++++++++++++++++++++-
 1 file changed, 39 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/xattr.scm b/module/ice-9/xattr.scm
index 2c81e91..090b233 100644
--- a/module/ice-9/xattr.scm
+++ b/module/ice-9/xattr.scm
@@ -20,7 +20,8 @@
   #:use-module (system foreign)
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 receive)
-  #:export (xattr-set))
+  #:export (xattr-set)
+  #:export (xattr-get))
 
 (define *libattr* (dynamic-link "libattr"))
 
@@ -74,3 +75,40 @@
           (c-attr-set file attrname pointer length flags))))
   (unless (zero? ret)
     (c-scm-syserror "xattr-set")))
+
+(define-foreign-function c-attr-get
+  ((string:      path)
+   (string:      attrname)
+   (*:           attrvalue)
+   (*:           valuelength)
+   (xattr-flags: flags))
+  :: int:
+  #:dynamic-library *libattr*)
+
+(define-foreign-function c-attr-getf
+  ((int:         fd)
+   (string:      attrname)
+   (*:           attrvalue)
+   (*:           valuelength)
+   (xattr-flags: flags))
+  :: int:
+  #:dynamic-library *libattr*)
+
+(define* (xattr-get file attrname #:optional (flags '()) #:key (decode? #t))
+  (define max-valuelen (* 64 1024))
+  (with-pointer ((int: valuelength = max-valuelen)
+                 (attrvalue *--> max-valuelen))
+      (%ret = (if (port? file)
+                  (c-attr-getf (port->fdes file) attrname attrvalue 
valuelength flags)
+                  (c-attr-get file attrname attrvalue valuelength flags)))
+    (unless (zero? %ret)
+      (c-scm-syserror "xattr-get"))
+    ;; No matter how long actual value is, attrvalue is bytevector
+    ;; with length of `max-valuelen'. We need only first `valuelength'
+    ;; from it. It is unexpectedly complicated to splice bytevectory.
+    (let ()
+      (define value
+        (pointer->bytevector (bytevector->pointer attrvalue) valuelength))
+      (if decode?
+          (bytevector->string value "utf-8")
+          (bytevector-copy value)))))
-- 
I may be not subscribed. Please, keep me in carbon copy.