[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 22/25] ice-9/xattr: implement `xattr-get' function
From: |
KAction |
Subject: |
[PATCH 22/25] ice-9/xattr: implement `xattr-get' function |
Date: |
Mon, 18 Jul 2016 18:17:45 +0300 |
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.
- [PATCH 16/25] Configure emacs file-local indention, (continued)
[PATCH 20/25] Document with-pointer macro, KAction, 2016/07/18
[PATCH 19/25] Document define-foreign-bitmask macro, KAction, 2016/07/18
[PATCH 21/25] new module: (ice-9 xattr), KAction, 2016/07/18
[PATCH 22/25] ice-9/xattr: implement `xattr-get' function,
KAction <=
[PATCH 24/25] Refactor defining foreign libattr function, KAction, 2016/07/18
[PATCH 25/25] ice9/attr: implement xattr-list procedure, KAction, 2016/07/18
[PATCH 23/25] Do not throw exception on missing xattr, KAction, 2016/07/18