From: Dmitry Bogatov <kact...@gnu.org>
* module/ice-9/xattr.scm: new internal macro
`define-libattr-functions', that generalize following properties
of functions in libattr:
- every function have form attr_ACTION or attr_ACTIONf, which
have same signatures, except first argument, which is either
'const char *filepath' or 'int fd'.
- they all return int.
Macro itself is rather involved, but saves from copy-and-paste
programming.
---
module/ice-9/xattr.scm | 79 ++++++++++++++++++++++++--------------------------
1 file changed, 38 insertions(+), 41 deletions(-)
diff --git a/module/ice-9/xattr.scm b/module/ice-9/xattr.scm
index 804d374..5374901 100644
--- a/module/ice-9/xattr.scm
+++ b/module/ice-9/xattr.scm
@@ -33,24 +33,40 @@
(create #x010)
(replace #x020)))
-(export c-attr-set)
-(define-foreign-function c-attr-set
- ((string: path)
- (string: attrname)
- (*: attrvalue)
- (int: valuelength)
- (xattr-flags: flags))
- :: int:
- #:dynamic-library *libattr*)
-(export c-attr-setf)
-(define-foreign-function c-attr-setf
- ((int: fd)
- (string: attrname)
- (*: attrvalue)
- (int: valuelength)
- (xattr-flags: flags))
- :: int:
- #:dynamic-library *libattr*)
+;; Every function from libattr exist in two version -- version, that accept
file
+;; as 'const char *', like 'attr_get' and one, that accept file as file
+;; descriptor, like 'attr_setf'. In both cases, file argument is always
+;; the first one.
+;;
+;; This macro, given function action ('set, 'get, 'remove, 'list) and
+;; arguments after first specification, defines foreign functions
+;; c-attr-ACTION, c-attr-ACTIONf and generic libattr-ACTION, that
+;; dispatches based on first argument type.
+
+(define-syntax define-libattr-functions
+ (lambda (x)
+ (syntax-case x ()
+ ((_ action (type name) ...)
+ (let ()
+ (define (format-symbol fmt)
+ (datum->syntax x (string->symbol (format #f fmt (syntax->datum
#'action)))))
+ (with-syntax ((c-path-function-name (format-symbol "c-attr-~a"))
+ (c-fd-function-name (format-symbol "c-attr-~af"))
+ (generic-procedure-name (format-symbol "libattr-~a")))
+ #'(begin
+ (define-foreign-function c-path-function-name
+ ((string: path) (type name) ...)
+ :: int: #:dynamic-library *libattr*)
+ (define-foreign-function c-fd-function-name
+ ((int: fd) (type name) ...)
+ :: int: #:dynamic-library *libattr*)
+ (define (generic-procedure-name file name ...)
+ (if (port? file)
+ (c-fd-function-name (port->fdes file) name ...)
+ (c-path-function-name file name ...))))))))))
+
+(define-libattr-functions set
+ (string: attrname) (*: attrvalue) (int: valuelength) (xattr-flags: flags))
;; Converts string or bytevector into pair (pointer . length)
(define (encode-value value)
@@ -70,37 +86,18 @@
(define ret
(receive (pointer length)
(encode-value attrvalue)
- (if (port? file)
- (c-attr-setf (port->fdes file) attrname pointer length flags)
- (c-attr-set file attrname pointer length flags))))
+ (libattr-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-libattr-functions get
+ (string: attrname) (*: attrvalue) (*: valuelength) (xattr-flags: flags))
(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)))
+ (%ret = (libattr-get file attrname attrvalue valuelength flags))
;; 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.
--
I may be not subscribed. Please, keep me in carbon copy.
