[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH 21/25] new module: (ice-9 xattr)
From: |
KAction |
Subject: |
[PATCH 21/25] new module: (ice-9 xattr) |
Date: |
Mon, 18 Jul 2016 18:17:44 +0300 |
From: Dmitry Bogatov <address@hidden>
This module provides interface to extended filesystem attributes and
serves as example of (system foreign declarative) usage.
---
module/Makefile.am | 1 +
module/ice-9/xattr.scm | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 77 insertions(+)
create mode 100644 module/ice-9/xattr.scm
diff --git a/module/Makefile.am b/module/Makefile.am
index 137530d..ab30b1b 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -117,6 +117,7 @@ SOURCES = \
ice-9/top-repl.scm \
ice-9/unicode.scm \
ice-9/vlist.scm \
+ ice-9/xattr.scm \
ice-9/weak-vector.scm \
\
language/brainfuck/parse.scm \
diff --git a/module/ice-9/xattr.scm b/module/ice-9/xattr.scm
new file mode 100644
index 0000000..2c81e91
--- /dev/null
+++ b/module/ice-9/xattr.scm
@@ -0,0 +1,76 @@
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+
+(define-module (ice-9 xattr)
+ #:use-module (system foreign declarative)
+ #:use-module (rnrs bytevectors)
+ #:use-module (system foreign)
+ #:use-module (ice-9 iconv)
+ #:use-module (ice-9 receive)
+ #:export (xattr-set))
+
+(define *libattr* (dynamic-link "libattr"))
+
+(define-foreign-bitmask xattr-flags:
+ ((dontfollow #x001)
+ (root #x002)
+ (trust #x004)
+ (secure #x008)
+ (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*)
+
+;; Converts string or bytevector into pair (pointer . length)
+(define (encode-value value)
+ (cond
+ ((bytevector? value)
+ (values (bytevector->pointer value) (bytevector-length value)))
+ ((string? value)
+ (encode-value (string->bytevector value "utf8")))
+ ((string? value)
+ (throw 'wrong-type-argument))))
+
+(define-foreign-function c-scm-syserror
+ ((string: subr))
+ :: void:)
+
+(define* (xattr-set file attrname attrvalue #:optional (flags '()))
+ (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))))
+ (unless (zero? ret)
+ (c-scm-syserror "xattr-set")))
--
I may be not subscribed. Please, keep me in carbon copy.
- [PATCH 15/25] New macro: with-pointer, (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 <=
[PATCH 22/25] ice-9/xattr: implement `xattr-get' function, KAction, 2016/07/18
[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