From: Dmitry Bogatov <kact...@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.
