add wrappers of some system functions to manipulate POSIX.1e ACLs

Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>

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)))