diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-09-13 16:29:43 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-10-23 10:51:30 -0700 |
commit | 324a2630f26c236c2ce438961d5dec727a4432ac (patch) | |
tree | 6921a7574c362735a96e47b2733b0f9642765207 | |
parent | 446b8f4a8ef78cb4605cfb551255bb455be411f0 (diff) | |
download | consfigurator-324a2630f26c236c2ce438961d5dec727a4432ac.tar.gz |
add wrappers of some system functions to manipulate POSIX.1e ACLs
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | consfigurator.asd | 3 | ||||
-rw-r--r-- | debian/changelog | 7 | ||||
-rw-r--r-- | debian/control | 2 | ||||
-rw-r--r-- | src/libacl.lisp | 14 | ||||
-rw-r--r-- | src/package.lisp | 19 | ||||
-rw-r--r-- | src/property/package.lisp | 3 | ||||
-rw-r--r-- | src/util.lisp | 16 | ||||
-rw-r--r-- | src/util/posix1e.lisp | 59 |
8 files changed, 118 insertions, 5 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index 5890660..0b54349 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -4,6 +4,7 @@ :author "Sean Whitton <spwhitton@spwhitton.name>" :licence "GPL-3+" :serial t + :defsystem-depends-on (#:cffi-grovel) :depends-on (#:anaphora #:alexandria #:babel @@ -20,7 +21,9 @@ #:trivial-backtrace) :components ((:file "src/package") (:file "src/reader") + (:cffi-grovel-file "src/libacl") (:file "src/util") + (:file "src/util/posix1e") (:file "src/connection") (:file "src/property") (:file "src/propspec") diff --git a/debian/changelog b/debian/changelog index 3f814be..a0d19e1 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +consfigurator (0.11.1-1) UNRELEASED; urgency=medium + + * New upstream release. + * Add dep and build-dep on libacl1-dev. + + -- Sean Whitton <spwhitton@spwhitton.name> Thu, 21 Oct 2021 13:25:09 -0700 + consfigurator (0.11.0-1) unstable; urgency=medium * New upstream release. diff --git a/debian/control b/debian/control index 73072ac..061072a 100644 --- a/debian/control +++ b/debian/control @@ -17,6 +17,7 @@ Build-Depends: cl-agnostic-lizard, debhelper-compat (= 13), dh-elpa, + libacl1-dev, python3-sphinx, sbcl, sphinx-common, @@ -44,6 +45,7 @@ Depends: cl-trivial-backtrace, cl-agnostic-lizard, emacsen-common, + libacl1-dev, ${misc:Depends}, Recommends: emacs, diff --git a/src/libacl.lisp b/src/libacl.lisp new file mode 100644 index 0000000..b162e30 --- /dev/null +++ b/src/libacl.lisp @@ -0,0 +1,14 @@ +(in-package :consfigurator.util.posix1e) + +(include "sys/types.h" "sys/acl.h") + +(ctype acl_tag_t "acl_tag_t") +(ctype acl_type_t "acl_type_t") +(ctype acl_entry_t "acl_entry_t") + +(constant (+ACL-USER+ "ACL_USER")) +(constant (+ACL-GROUP+ "ACL_GROUP")) +(constant (+ACL-TYPE-ACCESS+ "ACL_TYPE_ACCESS")) +(constant (+ACL-TYPE-DEFAULT+ "ACL_TYPE_DEFAULT")) +(constant (+ACL-NEXT-ENTRY+ "ACL_NEXT_ENTRY")) +(constant (+ACL-FIRST-ENTRY+ "ACL_FIRST_ENTRY")) diff --git a/src/package.lisp b/src/package.lisp index 668e0d2..dba79ec 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -316,6 +316,25 @@ #:request-asdf-requirements #:continue-deploy*-program)) +(defpackage :consfigurator.util.posix1e + (:use #:cl #:alexandria #:consfigurator #:cffi) + (:export #:acl_type_t + #:acl_entry_t + #:+ACL-USER+ + #:+ACL-GROUP+ + #:+ACL-TYPE-ACCESS+ + #:+ACL-TYPE-DEFAULT+ + #:+ACL-NEXT-ENTRY+ + #:+ACL-FIRST-ENTRY+ + + #:with-acl-free + #:acl-get-file + #:acl-set-file + #:acl-get-entry + #:acl-get-tag-type + #:acl-get-qualifier + #:acl-set-qualifier)) + (defpackage :consfigurator.property.cmd (:use #:cl #:consfigurator) (:export #:single)) diff --git a/src/property/package.lisp b/src/property/package.lisp index 9e3d480..91b2aef 100644 --- a/src/property/package.lisp +++ b/src/property/package.lisp @@ -18,7 +18,8 @@ (in-package :consfigurator.property.package) (named-readtables:in-readtable :consfigurator) -(defparameter *consfigurator-system-dependencies* '(:apt "build-essential")) +(defparameter *consfigurator-system-dependencies* + '(:apt ("build-essential" "libacl1-dev"))) (defgeneric %command (package-manager) (:documentation diff --git a/src/util.lisp b/src/util.lisp index 487fcd4..0396fde 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -605,11 +605,19 @@ Does not currently establish a PAM session." (defmacro define-error-retval-cfun ((&key (errno t) (failure-val -1)) &body defcfun-args) (let ((defun (etypecase (car defcfun-args) - (string (intern (string-upcase (car defcfun-args)))) + (string + (translate-name-from-foreign (car defcfun-args) '*package*)) (list (cadar defcfun-args)))) (cfun (etypecase (car defcfun-args) (string (car defcfun-args)) - (list (caar defcfun-args))))) + (list (caar defcfun-args)))) + (failure-val-check + (once-only (failure-val) + `(cond ((numberp ,failure-val) (= ,failure-val result)) + ((pointerp ,failure-val) (pointer-eq ,failure-val result)) + (t (simple-program-error + "Don't know how to compare function return value with ~S." + ,failure-val)))))) `(defun ,defun ,(loop for arg in (cddr defcfun-args) collect (car arg)) ,@(and (eql errno :zero) '((nix:set-errno 0))) (let ((result (foreign-funcall @@ -618,8 +626,8 @@ Does not currently establish a PAM session." collect (cadr arg) collect (car arg)) ,(cadr defcfun-args)))) (if ,(if (eql errno :zero) - `(and (= ,failure-val result) (not (zerop (nix:get-errno)))) - `(= ,failure-val result)) + `(and ,failure-val-check (not (zerop (nix:get-errno)))) + failure-val-check) (nix:posix-error ,(and errno '(nix:get-errno)) nil ',defun) result))))) 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 <spwhitton@spwhitton.name> + +;;; 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 <http://www.gnu.org/licenses/>. + +(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))) |