add PROPAPPARGS and some Postfix properties

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

4 files changed, 82 insertions, 0 deletions

diff --git a/src/combinator.lisp b/src/combinator.lisp
index bcba1c3..636893e 100644
--- a/src/combinator.lisp
+++ b/src/combinator.lisp
@@ -21,6 +21,15 @@
 ;;;; Property combinators
 
 (defmacro define-function-property-combinator (name args &body body)
+  "Define a function property combinator NAME with lambda list ARGS.
+
+Usage notes:
+
+- If you need to read individual arguments to propapps passed as arguments to
+  NAME, call PROPAPPARGS to access them.  For passing a whole list of args on
+  to a property subroutine, just take the cdr of the propapp.
+
+  For an example showing both techniques at work, see POSTFIX:MAPPED-FILE."
   (multiple-value-bind (forms declarations docstring)
       (parse-body body :documentation t)
     `(defun ,name ,args
diff --git a/src/package.lisp b/src/package.lisp
index 25e88ae..41da5f9 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -143,6 +143,7 @@
            #:collapse-types
            #:collapse-propapp-types
            #:propapptype
+           #:propappargs
            #:propappdesc
            #:propappattrs
            #:propappcheck
@@ -655,6 +656,18 @@
            #:built.
            #:standard-debian-schroot))
 
+(defpackage :consfigurator.property.postfix
+  (:use #:cl #:alexandria #:consfigurator)
+  (:local-nicknames (#:cmd       #:consfigurator.property.cmd)
+                    (#:service   #:consfigurator.property.service)
+                    (#:apt       #:consfigurator.property.apt)
+                    (#:os        #:consfigurator.property.os)
+                    (#:file      #:consfigurator.property.file))
+  (:export #:installed
+           #:reloaded
+           #:main-configured
+           #:mapped-file))
+
 (defpackage :consfigurator.connection.local
   (:use #:cl #:consfigurator #:alexandria)
   (:export #:local-connection))
diff --git a/src/property.lisp b/src/property.lisp
index 1bba39e..ebdfadb 100644
--- a/src/property.lisp
+++ b/src/property.lisp
@@ -63,6 +63,11 @@
       (get (car propapp) 'ptype)
       :posix))
 
+(defun propappargs (propapp)
+  (if (member :orig-args (cadr propapp))
+      (getf (cadr propapp) :orig-args)
+      (cdr propapp)))
+
 (defun collapse-types (&rest lists)
   (if (member :posix (flatten lists)) :posix :lisp))
 
diff --git a/src/property/postfix.lisp b/src/property/postfix.lisp
new file mode 100644
index 0000000..0121a2f
--- /dev/null
+++ b/src/property/postfix.lisp
@@ -0,0 +1,55 @@
+;;; 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.property.postfix)
+(named-readtables:in-readtable :consfigurator)
+
+(defproplist installed :posix ()
+  (:desc "Postfix installed")
+  (os:etypecase
+    (debianlike (apt:installed "postfix"))))
+
+(defproplist reloaded :posix ()
+  (:desc "Postfix reloaded")
+  (service:reloaded "postfix"))
+
+(defprop main-configured :posix (&rest pairs)
+  "Set key--value pairs in /etc/postfix/main.cf."
+  (:desc (format nil "Postfix main.cf configured ~{~A=~A~^, ~}" pairs))
+  (:apply
+   (or (eql :no-change
+            (apply #'file:contains-conf-equals "/etc/postfix/main.cf" pairs))
+       (reloaded))))
+
+(define-function-property-combinator mapped-file
+    (propapp &optional (file (car (propappargs propapp))))
+  "Apply PROPAPP, and if it makes a change, run postmap(1) on FILE, which
+defaults to the first argument to propapp."
+  (:retprop :type (propapptype propapp)
+            :desc (get (car propapp) 'desc)
+            :check (get (car propapp) 'check)
+            :hostattrs (get (car propapp) 'hostattrs)
+            :apply (lambda (&rest args)
+                     (when-let ((f (get (car propapp) 'papply)))
+                       (or (eql :no-change (apply f args))
+                           (mrun "postmap" file))))
+            :unapply
+            (lambda (&rest args)
+              (when-let ((f (get (car propapp) 'punapply)))
+                (apply f args))
+              (file:does-not-exist (strcat (unix-namestring file) ".db")))
+            :args (cdr propapp)))