From 324a2630f26c236c2ce438961d5dec727a4432ac Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Mon, 13 Sep 2021 16:29:43 -0700 Subject: add wrappers of some system functions to manipulate POSIX.1e ACLs Signed-off-by: Sean Whitton --- src/util/posix1e.lisp | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 src/util/posix1e.lisp (limited to 'src/util') diff --git a/src/util/posix1e.lisp b/src/util/posix1e.lisp new file mode 100644 index 0000000..05525ab --- /dev/null +++ b/src/util/posix1e.lisp @@ -0,0 +1,59 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2021 Sean Whitton + +;;; This file is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3, or (at your option) +;;; any later version. + +;;; This file 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 General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see . + +(in-package :consfigurator.util.posix1e) +(named-readtables:in-readtable :consfigurator) + +(define-foreign-library libacl (t (:default "libacl"))) + +(use-foreign-library libacl) + +(define-error-retval-cfun () "acl_free" :int (obj_p :pointer)) + +(define-error-retval-cfun (:failure-val (null-pointer)) + "acl_get_file" :pointer (path-p :string) (type acl_type_t)) + +(define-error-retval-cfun () + "acl_set_file" :int (path-p :string) (type acl_type_t) (acl :pointer)) + +(define-error-retval-cfun () + "acl_get_entry" :int (acl :pointer) (entry-id :int) (entry-p :pointer)) + +(define-error-retval-cfun () + ("acl_get_tag_type" %acl-get-tag-type) + :int (entry-d acl_entry_t) (tag-type-p :pointer)) + +(defun acl-get-tag-type (entry-d) + (with-foreign-object (tag-type-p 'acl_tag_t) + (%acl-get-tag-type entry-d tag-type-p) + (mem-ref tag-type-p 'acl_tag_t))) + +(defmacro with-acl-free ((aclvar aclcall) &body forms) + (with-gensyms (aclvar*) + `(let* ((,aclvar ,aclcall) + (,aclvar* (make-pointer (pointer-address ,aclvar)))) + (unwind-protect (progn ,@forms) (acl-free ,aclvar*))))) + +(define-error-retval-cfun (:failure-val (null-pointer)) + ("acl_get_qualifier" %acl-get-qualifier) :pointer (entry-d acl_entry_t)) + +(define-error-retval-cfun () + "acl_set_qualifier" :int (entry-d acl_entry_t) (qualifier-p :pointer)) + +(defun acl-get-qualifier (entry-d type) + (with-acl-free (qualifier-p (%acl-get-qualifier entry-d)) + (mem-ref qualifier-p type))) -- cgit v1.2.3