[PATCH consfigurator] 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 | 46 ++++++++++++++++++++++++++++---------------
 2 files changed, 37 insertions(+), 16 deletions(-)

This massively speeds up my slowest deployment, but I'm not yet sure it's sound.

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..8ca9394 100644
--- a/src/property/apt.lisp
+++ b/src/property/apt.lisp
@@ -39,33 +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 &optional connattr1 connattr2)
+  (if (subsetp packages (get-connattr connattr1) :test #'string=)
+      :no-change
+      (prog1 (with-maybe-update
+                 (with-changes-dpkg-status
+                   (apt-get :inform args packages)))
+        ;; We just cache what we explicitly installed or removed: other
+        ;; packages may have been installed or removed too.
+        (when connattr1
+          (unionf (get-connattr connattr1) packages :test #'string=))
+        (when connattr2
+          (setf (get-connattr connattr2)
+                (nset-difference (get-connattr connattr2) packages
+                                 :test #'string=)))
+        (informat 1 "~&~@{~@[Known ~(~A~) packages now: ~{~A~^, ~}~%~]~}"
+                  connattr1 (get-connattr connattr1)
+                  connattr2 (get-connattr connattr2)))))
+
 (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)))))
+  (:apply (install-remove '("-y" "install") packages 'installed 'removed)))
 
 (defprop installed-minimally :posix (&rest packages)
   "Ensure all of the apt packages PACKAGES are installed, without recommends."
   (:desc #?"apt installed @{packages}")
   (: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)))))
+  (:apply (install-remove '("-y" "--no-install-recommends" "install")
+                          packages '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))
+                  'installed-backports))
 
 (defprop backports-installed :posix (&rest packages)
   "Ensure all of the apt packages PACKAGES are installed from stable-backports.
@@ -94,8 +109,7 @@ each of those dependencies in PACKAGES."
   (:hostattrs
    (declare (ignore packages))
    (os:required 'os:debianlike))
-  (:apply
-   (with-changes-dpkg-status (apt-get :inform "-y" "remove" packages))))
+  (:apply (install-remove '("-y" "remove") packages 'removed 'installed)))
 
 (defprop reconfigured :posix (package &rest triples)
   "Where each of TRIPLES is a list of three strings, a debconf template, type
-- 
2.30.2