From 446b8f4a8ef78cb4605cfb551255bb455be411f0 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 16 Sep 2021 18:23:55 -0700 Subject: 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 --- consfigurator.asd | 1 + src/connection/sbcl.lisp | 38 ++++++++++---------- src/package.lisp | 13 +++++-- src/property/chroot.lisp | 19 +++++----- src/property/installer.lisp | 40 ++++++++++----------- src/property/package.lisp | 88 +++++++++++++++++++++++++++++++++++++++++++++ 6 files changed, 149 insertions(+), 50 deletions(-) create mode 100644 src/property/package.lisp diff --git a/consfigurator.asd b/consfigurator.asd index 6583dfd..5890660 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -39,6 +39,7 @@ (:file "src/property/mount") (:file "src/property/service") (:file "src/property/apt") + (:file "src/property/package") (:file "src/property/chroot") (:file "src/property/disk") (:file "src/property/fstab") 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 + +;;; 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 . + +(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))) -- cgit v1.2.3