[PATCH consfigurator v2] APT properties: cache packages installed or removed this deployment

[Sean Whitton]

Signed-off-by: Sean Whitton <spwhitton at spwhitton.name>
---
 doc/news.rst          |  7 +++++
 src/property/apt.lisp | 61 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 55 insertions(+), 13 deletions(-)

This patch improves on the previous posting in taking account of how one might
install a package in one property and want to upgrade it to a backport in
another.

diff --git a/doc/news.rst b/doc/news.rst
index ff76424..bf4d435 100644
--- a/doc/news.rst
+++ b/doc/news.rst
@@ -23,6 +23,13 @@ In summary, you should always be able to upgrade to a release which only
 increments ``patch``, but if either of the other two components have changed,
 you should review this document and see if your consfig needs updating.
 
+1.1.2 (unreleased)
+------------------
+
+- APT properties now cache what packages have been installed or removed for
+  the duration of the deployment.  This should significantly speed up some
+  deployments.  It could break some obscure consfigs.
+
 1.1.1 (2022-09-18)
 ------------------
 
diff --git a/src/property/apt.lisp b/src/property/apt.lisp
index a300793..2d45b47 100644
--- a/src/property/apt.lisp
+++ b/src/property/apt.lisp
@@ -39,15 +39,48 @@
 
 ;;;; Properties
 
+;; Cache what we've installed and removed this deployment, rather than
+;; checking over and over again.  We assume, then, that no other properties
+;; add or remove packages in a way that is significant to the deployment.
+(defun install-remove
+    (args packages check-against add-to remove-from &aux all)
+  "Unless each of PACKAGES appears in the union of the connattrs named by the
+elements of CHECK-AGAINST, execute apt-get(8) on ARGS.
+Then add each of PACKAGES to each of the connattrs named by the elements of
+ADD-TO and remove each of PACKAGES from each of the connattrs named by the
+elements of REMOVE-FROM."
+  (if (subsetp packages (reduce (lambda (x y)
+                                  (union x (get-connattr y) :test #'string=))
+                                (ensure-list check-against)
+                                :initial-value nil)
+               :test #'string=)
+      :no-change
+      (prog1 (with-maybe-update
+                 (with-changes-dpkg-status (apt-get :inform args)))
+        ;; We just cache what we explicitly installed or removed: other
+        ;; packages may have been installed or removed too.
+        (dolist (connattr (ensure-list add-to))
+          (unionf (get-connattr connattr) packages :test #'string=)
+          (push connattr all))
+        (dolist (connattr (ensure-list remove-from))
+          (setf (get-connattr connattr)
+                (nset-difference (get-connattr connattr) packages
+                                 :test #'string=))
+          (push connattr all))
+        (apply #'informat 1
+               "~&~@{~@[Known ~(~A~) packages now: ~{~A~^, ~}~%~]~}"
+               (loop for connattr in all
+                     collect connattr
+                     collect (get-connattr connattr))))))
+
 (defprop installed :posix (&rest packages)
   "Ensure all of the apt packages PACKAGES are installed."
   (:desc #?"apt installed @{packages}")
   (:preprocess (flatten packages))
   (:hostattrs (os:required 'os:debianlike))
   (:apply
-   (with-maybe-update
-       (with-changes-dpkg-status
-         (apt-get :inform "-y" "install" packages)))))
+   (install-remove (list* "-y" "install" packages) packages
+                   '(installed installed-backports) 'installed 'removed)))
 
 (defprop installed-minimally :posix (&rest packages)
   "Ensure all of the apt packages PACKAGES are installed, without recommends."
@@ -55,17 +88,18 @@
   (:preprocess (flatten packages))
   (:hostattrs (os:required 'os:debianlike))
   (:apply
-   (with-maybe-update
-       (with-changes-dpkg-status
-        (apt-get :inform "-y" "--no-install-recommends" "install" packages)))))
+   (install-remove (list* "-y" "--no-install-recommends" "install" packages)
+                   packages
+                   '(installed installed-backports) 'installed 'removed)))
 
 (defun install-backports (args packages)
-  (with-maybe-update
-      (with-changes-dpkg-status
-        (apt-get :inform args "install"
-                 (loop with suite = (os:debian-suite (get-hostattrs-car :os))
-                       for pkg in packages
-                       collect (format nil "~A/~A-backports" pkg suite))))))
+  (install-remove
+   (append args '("install")
+           (loop with suite = (os:debian-suite (get-hostattrs-car :os))
+                 for pkg in packages
+                 collect (format nil "~A/~A-backports" pkg suite)))
+   packages
+   'installed-backports 'installed-backports '(installed removed)))
 
 (defprop backports-installed :posix (&rest packages)
   "Ensure all of the apt packages PACKAGES are installed from stable-backports.
@@ -95,7 +129,8 @@ each of those dependencies in PACKAGES."
    (declare (ignore packages))
    (os:required 'os:debianlike))
   (:apply
-   (with-changes-dpkg-status (apt-get :inform "-y" "remove" packages))))
+   (install-remove (list* "-y" "remove" packages) packages
+                   'removed 'removed '(installed installed-backports))))
 
 (defprop reconfigured :posix (package &rest triples)
   "Where each of TRIPLES is a list of three strings, a debconf template, type
-- 
2.30.2