[PATCH 25/25] ice9/attr: implement xattr-list procedure

[KAction@gnu.org]

From: Dmitry Bogatov <KAction@gnu.org>

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

diff --git a/module/ice-9/xattr.scm b/module/ice-9/xattr.scm
index 5374901..6773126 100644
--- a/module/ice-9/xattr.scm
+++ b/module/ice-9/xattr.scm
@@ -20,8 +20,13 @@
   #:use-module (system foreign)
   #:use-module (ice-9 iconv)
   #:use-module (ice-9 receive)
+  #:use-module (ice-9 q)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:export (xattr-set)
-  #:export (xattr-get))
+  #:export (xattr-get)
+  #:export (xattr-remove)
+  #:export (xattr-list))
 
 (define *libattr* (dynamic-link "libattr"))
 
@@ -120,3 +125,39 @@
             (unless (eqv? ENODATA (system-error-errno _args))
               (xattr-get/syserror))
             #f)))))
+
+(define-libattr-functions remove (string: attrname) (xattr-flags: flags))
+(define* (xattr-remove file attrname #:optional (flags '()))
+  (unless (zero? (libattr-remove file attrname flags))
+    (c-scm-syserror "xattr-remove")))
+
+(define-libattr-functions list
+  (*: buffer) (int: buffersize) (xattr-flags: flags) (*: cursor))
+
+(define (pointer-advance p bytes)
+  (make-pointer (+ (pointer-address p) bytes)))
+
+(define (int32-ref p offset)
+  (let* ((offset-bytes (* 4 offset))
+         (pointer      (pointer-advance p offset-bytes)))
+    (car (parse-c-struct pointer (list int32)))))
+
+(define* (xattr-list file #:optional (flags '()))
+  (define attr-queue (make-q))
+  (define buffer-size (* 64 1024 1024)) ; 64Kb, see list_attr(3)
+  ;; attr/attributes.h: struct attrlist_cursor { u_int32_t opaque[4]; }
+  (with-pointer ((cursor *--> 16)
+                 (buffer *--> buffer-size))
+      (let loop ()
+        (unless (zero? (libattr-list file buffer buffer-size flags cursor))
+          (c-scm-syserror "xattr-list"))
+        (let* ((count      (int32-ref buffer 0))
+               (more?      (not (zero? (int32-ref buffer 1))))
+               (offsets    (map (cut int32-ref buffer <>) (iota count 2)))
+               (offsets*   (map (cut + 4 <>) offsets)) ; skip attribute length
+               (pointers   (map (cut pointer-advance buffer <>) offsets*))
+               (attributes (map pointer->string pointers)))
+          (for-each (cut enq! attr-queue <>) attributes)
+          (when more?
+            (loop))))
+    (car attr-queue)))
-- 
I may be not subscribed. Please, keep me in carbon copy.