install system deps by searching for package managers on PATH

With this change we handle the situation in which we don't know the OS of a
host on which we need to install system packages more cleanly than before.

Also rely on the new PACKAGE:INSTALLED to install the OS bootstrapper in
INSTALLER:CLEANLY-INSTALLED-ONCE.  This allows us to simplify usage of the
property by replacing the ORIGINAL-OS argument with ORIGINAL-OS-ARCHITECTURE.

Making this change does mean that we now have two ways to specify the
different names a package has on different OSs: (i) something like
OS:ETYPECASE where each branch applies a property which invokes an OS-specific
package manager; and (ii) the plists supplied to PACKAGE:INSTALLED.

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

5 files changed, 148 insertions, 50 deletions

diff --git a/src/connection/sbcl.lisp b/src/connection/sbcl.lisp
index 206b5ab..db5ac7e 100644
--- a/src/connection/sbcl.lisp
+++ b/src/connection/sbcl.lisp
@@ -18,33 +18,35 @@
 (in-package :consfigurator.connection.sbcl)
 (named-readtables:in-readtable :consfigurator)
 
-(defproplist sbcl-available :posix ()
-  (os:etypecase
-    (debianlike (apt:installed "sbcl" "build-essential"))))
-
 (defparameter *sbcl* '("sbcl" "--noinform" "--noprint"
                        "--disable-debugger" "--no-sysinit" "--no-userinit"))
 
-(defmethod establish-connection ((type (eql :sbcl)) remaining &key)
+(defmethod establish-connection
+    ((type (eql :sbcl)) remaining
+     &key (package-manager nil package-manager-supplied-p))
+  "Start up a remote Lisp image using SBCL.
+
+Specifying PACKAGE-MANAGER avoids the need to see what package managers are
+available on PATH, which can provide a performance improvement."
   (when (lisp-connection-p)
     (warn
      "Looks like you might be starting a fresh Lisp image directly from the root
 Lisp. This can mean that prerequisite data gets extracted from encrypted
 stores and stored unencrypted under ~~/.cache, and as such is not
 recommended."))
-  (unless (zerop (mrun :for-exit "command" "-v" "sbcl"))
-    ;; If we're not the final hop then we don't know the OS of the host to
-    ;; which we're currently connected, so we can't apply SBCL-AVAILABLE.
-    ;;
-    ;; TODO In the case of INSTALLER:CLEANLY-INSTALLED-ONCE this code will
-    ;; have us trying to use apt to install sbcl on a Fedora host, say, upon
-    ;; the first connection, before Debian has been installed.  Perhaps we
-    ;; should just have some code which tries to install sbcl based on the
-    ;; package manager(s) it can find on PATH.  Could reuse that code for
-    ;; CHROOT::%DEBOOTSTRAP-MANUALLY-INSTALLED.
-    (if remaining
-        (failed-change "sbcl not on PATH and don't know how to install.")
-        (sbcl-available)))
+  ;; Allow the user to request no attempt to install the dependencies at all,
+  ;; perhaps because they know they're already manually installed.
+  (unless (and package-manager-supplied-p (not package-manager))
+    (handler-case (package:installed
+                   package-manager '(:apt "sbcl")
+                   package:*consfigurator-system-dependencies*)
+      ;; If we couldn't find any package manager on PATH, just proceed in the
+      ;; hope that everything we need is already installed; we'll find out
+      ;; whether it's actually a problem pretty quickly, when the remote SBCL
+      ;; tries to compile and load the ASDF systems.
+      (package:package-manager-not-found (c)
+        (apply #'warn (simple-condition-format-control c)
+               (simple-condition-format-arguments c)))))
   (let ((requirements (asdf-requirements-for-host-and-features
                        (safe-read-from-string
                         (run :input "(prin1 *features*)" *sbcl*)
diff --git a/src/package.lisp b/src/package.lisp
index a32c21f..668e0d2 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -91,6 +91,7 @@
            #:noop
            #:symbol-named
            #:memstring=
+           #:define-simple-error
            #:plist-to-cmd-args
 	   #:with-local-temporary-directory
            #:pathname-file
@@ -443,10 +444,17 @@
            #:pinned
            #:no-pdiffs))
 
+(defpackage :consfigurator.property.package
+  (:use #:cl #:alexandria #:consfigurator)
+  (:local-nicknames (#:apt #:consfigurator.property.apt))
+  (:export #:*consfigurator-system-dependencies*
+           #:package-manager-not-found
+           #:installed))
+
 (defpackage :consfigurator.connection.sbcl
   (:use #:cl #:alexandria #:consfigurator)
-  (:local-nicknames (#:os  #:consfigurator.property.os)
-                    (#:apt #:consfigurator.property.apt)))
+  (:local-nicknames (#:os      #:consfigurator.property.os)
+                    (#:package #:consfigurator.property.package)))
 
 (defpackage :consfigurator.property.user
   (:use #:cl #:consfigurator)
@@ -466,6 +474,7 @@
   (:local-nicknames (#:service   #:consfigurator.property.service)
                     (#:apt       #:consfigurator.property.apt)
                     (#:os        #:consfigurator.property.os)
+                    (#:package   #:consfigurator.property.package)
                     (#:container #:consfigurator.property.container)
                     (#:mount     #:consfigurator.property.mount)
                     (#:file      #:consfigurator.property.file))
diff --git a/src/property/chroot.lisp b/src/property/chroot.lisp
index 3cfe527..78ac0a3 100644
--- a/src/property/chroot.lisp
+++ b/src/property/chroot.lisp
@@ -53,26 +53,25 @@
        (nconcf args (list apt.mirror)))
      (apply #'run args))))
 
-(defprop %debootstrap-manually-installed :posix ()
+(defproplist %debootstrap-manually-installed :posix ()
+  ;; Accept any debootstrap we find on path to enable installing Debian on
+  ;; arbitrary unixes, where Consfigurator does not know how to install
+  ;; packages, but the user has manually installed debootstrap(8).
   (:check (remote-executable-find "debootstrap"))
-  (:apply
-   (failed-change "Don't know how to install debootstrap(8) manually.")))
+  (package:installed nil '(:apt ("debootstrap"))))
 
 (defpropspec %os-bootstrapper-installed :posix (host)
   (:desc "OS bootstrapper installed")
   (let ((host (preprocess-host host)))
     `(os:host-etypecase ,host
        (debian
-        ;; Have %DEBOOTSTRAP-MANUALLY-INSTALLED like this to enable installing
-        ;; Debian on arbitrary unixes, where Consfigurator doesn't know how to
-        ;; install packages, but the user has manually ensured that
-        ;; debootstrap(8) is on PATH.  However, we don't have such an escape
-        ;; hatch for the case where the architectures do not match because
-        ;; ensuring that debootstrap(8) will be able to bootstrap a foreign
-        ;; arch is more involved.
         (os:typecase
           (debianlike (apt:installed "debootstrap"))
           (t (%debootstrap-manually-installed)))
+        ;; Don't have an escape hatch like the :CHECK subroutine of
+        ;; %DEBOOTSTRAP-MANUALLY-INSTALLED for the case where the
+        ;; architectures do not match because ensuring that debootstrap(8)
+        ;; will be able to bootstrap a foreign arch is more involved.
         ,@(and (not (call-with-os
                      #'os:supports-arch-p
                      (os:linux-architecture (get-hostattrs-car :os host))))
diff --git a/src/property/installer.lisp b/src/property/installer.lisp
index 38b5ce9..5e68e4f 100644
--- a/src/property/installer.lisp
+++ b/src/property/installer.lisp
@@ -286,17 +286,18 @@ using a combinator like ON-CHANGE, or applied manually with DEPLOY-THESE."
          (apply #'mrun "mount" efi-system-partition-mount-args))))))
 
 (defproplist cleanly-installed-once :lisp
-    (&optional options (original-os '(os:linux :amd64))
-               &aux (minimal-new-host
-                     (make-host :hostattrs (list :os (get-hostattrs :os))))
-               (original-host
-                (make-host
-                 :propspec
-                 (make-propspec
-                  :propspec
-                  `(eseqprops ,original-os
-                              (chroot:os-bootstrapped-for
-                               ,options "/new-os" ,minimal-new-host))))))
+    (original-os-architecture
+     &optional options
+     &aux (minimal-new-host
+	   (make-host :hostattrs (list :os (get-hostattrs :os))))
+     (original-host
+      (make-host
+       :propspec
+       (make-propspec
+        :propspec
+        `(eseqprops
+          (os:linux ,original-os-architecture)
+          (chroot:os-bootstrapped-for ,options "/new-os" ,minimal-new-host))))))
   "Replaces whatever operating system the host has with a clean installation of
 the OS that the host is meant to have, and reboot, once.  This is intended for
 freshly launched machines in faraway datacentres, where your provider has
@@ -308,19 +309,18 @@ but not captured by your consfig.  This property's approach can fail and leave
 the system unbootable, but it's an time-efficient way to ensure that you're
 starting from a truly clean slate for those cases in which it works.
 
-ORIGINAL-OS is a propapp specifying the old OS, as you would apply to a host
-with that OS.  It will be used when trying to install the OS bootstrapper.
-For example, if you're trying to switch a host from a provider's Debian
-\"buster\" image to upstream Debian \"bullseye\", passing '(OS:DEBIAN-STABLE
-\"buster\" :AMD64) would cause Consfigurator to use apt to install
-debootstrap(8).  Alternatively, you can pass '(OS:LINUX :AMD64) and install
-the bootstrapper manually; this is useful for OSs whose package managers
+ORIGINAL-OS-ARCHITECTURE is the architecture of the original OS as would be
+supplied to the OS:LINUX property, e.g. :AMD64.  OPTIONS will be passed on to
+CHROOT:OS-BOOTSTRAPPED-FOR, which see.
+
+The internal property CHROOT::%OS-BOOTSTRAPPER-INSTALLED will attempt to use
+PACKAGE:INSTALLED to install the OS bootstrapper (e.g. debootstrap(8) for
+Debian).  Alternatively, you can install the bootstrapper manually before
+running Consfigurator; this is useful for original OSs whose package managers
 Consfigurator doesn't yet know how to drive.  You might apply an OS-agnostic
 property before this one which manually downloads the bootstrapper and puts it
 on PATH.
 
-OPTIONS will be passed on to CHROOT:OS-BOOTSTRAPPED-FOR, which see.
-
 The files from the old OS will be left in '/old-os'.  Typically you will need
 to perform some additional configuration before rebooting to increase the
 likelihood that the system boots and is network-accessible.  This might
diff --git a/src/property/package.lisp b/src/property/package.lisp
new file mode 100644
index 0000000..9e3d480
--- /dev/null
+++ b/src/property/package.lisp
@@ -0,0 +1,88 @@
+;;; 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.package)
+(named-readtables:in-readtable :consfigurator)
+
+(defparameter *consfigurator-system-dependencies* '(:apt "build-essential"))
+
+(defgeneric %command (package-manager)
+  (:documentation
+   "Returns a command which, if found on PATH, indicates that the system package
+manager identified by PACKAGE-MANAGER is available."))
+
+(defmethod %command ((package-manager (eql :apt)))
+  "apt-get")
+
+(defgeneric %installed (package-manager packages)
+  (:documentation
+   "Install each of PACKAGES using the system package manager identified by
+PACKAGE-MANAGER.
+
+Implementations should not fail just because we are not root, or otherwise
+privileged, if the package is already installed."))
+
+(defmethod %installed ((package-manager (eql :apt)) packages)
+  ;; Call PROPAPPAPPLY directly because we want the :CHECK subroutine run, but
+  ;; it does not make sense to run the :HOSTATTRS subroutine because *HOST*
+  ;; does not necessarily correspond to the host we're attempting to install
+  ;; packages on.
+  (propappapply `(apt:installed ,@packages)))
+
+(define-simple-error package-manager-not-found (aborted-change))
+
+(defprop installed :posix
+    (package-manager &rest package-lists &aux package-list)
+  "Attempt to use a system package manager to install system packages as
+specified by PACKAGE-LISTS.  If PACKAGE-MANAGER, a keyword, use that
+particular package manager; otherwise, see what we can find on PATH.
+
+Each of PACKAGE-LISTS is a plist where the keys identify package managers, and
+where the values are lists of package names to install using that package
+manager.  See PACKAGE:*CONSFIGURATOR-SYSTEM-DEPENDENCIES* for an example.
+
+This property should not typically be applied to hosts.  It is preferable to
+use an operating system-specific property, such as APT:INSTALLED.  This
+property exists because in a few cases it is necessary to install packages
+where there is no known-valid HOST value for the machine upon which we need to
+install packages, and thus we cannot infer what package manager to use from
+the host's OS, and must fall back to seeing what's on PATH.
+
+In particular, when starting up a remote Lisp image when the REMAINING
+argument to ESTABLISH-CONNECTION is non-nil, we might be starting up Lisp on a
+machine other than the one to be deployed and we do not have HOST values for
+intermediate hops.  Another case is INSTALLED:CLEANLY-INSTALLED-ONCE;
+regardless of REMAINING, the initial OS might be the one we will replace, not
+the declared OS for the host."
+  (:apply
+   (dolist (list package-lists)
+     (doplist (k v list)
+       (dolist (p (ensure-cons v))
+         (push p (getf package-list k)))))
+   (loop with reversed
+         for (k v) on package-list by #'cddr
+         do (push v reversed) (push k reversed)
+         finally (setq package-list reversed))
+   (if package-manager
+       (return-from installed
+         (%installed package-manager (getf package-list package-manager)))
+       (doplist (package-manager packages package-list)
+         (when (remote-executable-find (%command package-manager))
+           (return-from installed (%installed package-manager packages)))))
+   (package-manager-not-found
+    "Could not find any package manager on PATH with which to install ~S."
+    package-list)))