From 10064f1775c65e2c972b9710da846e2934e683ab Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 29 Apr 2021 13:43:45 -0700 Subject: move chroot->volumes operation into a new properties package Signed-off-by: Sean Whitton --- src/package.lisp | 9 ++++++ src/property/disk.lisp | 72 +++++++++++++++++++-------------------------- src/property/installer.lisp | 52 ++++++++++++++++++++++++++++++++ 3 files changed, 92 insertions(+), 41 deletions(-) create mode 100644 src/property/installer.lisp (limited to 'src') diff --git a/src/package.lisp b/src/package.lisp index dc3c5f0..ac860a5 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -399,6 +399,8 @@ #:opened-luks-container #:linux-swap + #:with-these-open-volumes + #:has-volumes #:caches-cleaned #:raw-image-built-for @@ -448,6 +450,13 @@ (:export #:available #:selected-for)) +(defpackage :consfigurator.property.installer + (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk) + (:local-nicknames (#:file #:consfigurator.property.file) + (#:chroot #:consfigurator.property.chroot) + (#:fstab #:consfigurator.property.fstab)) + (:export #:chroot-installed-to-volumes)) + (defpackage :consfigurator.connection.local (:use #:cl #:consfigurator #:alexandria) (:export #:local-connection)) diff --git a/src/property/disk.lisp b/src/property/disk.lisp index 3c9b647..22a98dc 100644 --- a/src/property/disk.lisp +++ b/src/property/disk.lisp @@ -532,7 +532,7 @@ FILESYSTEM volumes. During the application of PROPAPPS, all :OPENED-VOLUMES connattrs are replaced with a list of the volumes that were opened; this list must not be modified." `(with-these-open-volumes* - ,volumes + ',volumes ,(if (cdr propapps) `(eseqprops ,@propapps) (car propapps)) ,@(and mount-below-supplied-p `(:mount-below ,mount-below)))) @@ -661,14 +661,6 @@ the LVM physical volumes corresponding to those volume groups." ;; Finally, create the volumes. (mapc (rcurry #'create-volume-and-contents nil) volumes)))) -(defprop %update-image-from-chroot :posix (chroot opened-image) - (:desc #?"Updated ${opened-image} from ${chroot}") - (:apply - (assert-euid-root) - (mrun "rsync" "-Pav" "--delete" - (strcat (unix-namestring chroot) "/") - (strcat (unix-namestring opened-image) "/")))) - (defpropspec raw-image-built-for :lisp (options host image-pathname &key rebuild) "Build a raw disk image for HOST at IMAGE-PATHNAME. @@ -686,39 +678,37 @@ filesystems will be incrementally updated when other properties change." (:desc (declare (ignore options rebuild)) (let ((hostname (car (getf (hostattrs host) :hostname)))) #?"Built image for ${hostname} @ ${image-pathname}")) - (let* ((chroot (ensure-directory-pathname - (strcat (unix-namestring image-pathname) ".chroot"))) - (opened (ensure-directory-pathname - (strcat (unix-namestring image-pathname) ".opened"))) - (volumes - (loop - with found - for volume in (getf (hostattrs (preprocess-host host)) :volumes) - for physical-disk-p = (subtypep (type-of volume) 'physical-disk) - if (and physical-disk-p (not found) - (slot-boundp volume 'volume-contents)) - do (setq found t) - and collect - (let ((new (make-instance - 'raw-disk-image - :image-file image-pathname - :volume-contents (volume-contents volume)))) - (when (slot-boundp volume 'volume-size) - (setf (volume-size new) (volume-size volume))) - new) - else unless physical-disk-p - collect volume - finally - (unless found - (inapplicable-property - "Volumes list for host has no DISK:PHYSICAL-DISK with contents."))))) - `(on-change (chroot:os-bootstrapped-for ,options ,chroot ,host - ,(make-propspec :systems nil :propspec '(caches-cleaned))) + (let ((chroot (ensure-directory-pathname + (strcat (unix-namestring image-pathname) ".chroot"))) + (volumes + (loop + with found + for volume in (getf (hostattrs (preprocess-host host)) :volumes) + for physical-disk-p = (subtypep (type-of volume) 'physical-disk) + if (and physical-disk-p (not found) + (slot-boundp volume 'volume-contents)) + do (setq found t) + and collect + (let ((new (make-instance + 'raw-disk-image + :image-file image-pathname + :volume-contents (volume-contents volume)))) + (when (slot-boundp volume 'volume-size) + (setf (volume-size new) (volume-size volume))) + new) + else unless physical-disk-p + collect volume + finally + (unless found + (inapplicable-property + "Volumes list for host has no DISK:PHYSICAL-DISK with contents."))))) + `(on-change (chroot:os-bootstrapped-for + ,options ,chroot ,host + ,(make-propspec :systems nil + :propspec '(caches-cleaned))) (%raw-image-created ,volumes :chroot ,chroot :rebuild ,rebuild) - (with-these-open-volumes (',volumes :mount-below ,opened) - ;; TODO update /etc/fstab & /etc/crypttab from the opened volumes - ;; TODO install bootloader - (%update-image-from-chroot ,chroot ,opened))))) + (consfigurator.property.installer:chroot-installed-to-volumes + ,host ,chroot ,volumes)))) (defprop host-volumes-created :lisp () "Recursively create the volumes as specified by DISK:HAS-VOLUMES. diff --git a/src/property/installer.lisp b/src/property/installer.lisp new file mode 100644 index 0000000..c4877d3 --- /dev/null +++ b/src/property/installer.lisp @@ -0,0 +1,52 @@ +;;; 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.installer) +(named-readtables:in-readtable :consfigurator) + +(defprop %update-target-from-chroot :posix (chroot target) + (:desc #?"Updated ${target} from ${chroot}") + (:apply + (assert-euid-root) + (run "rsync" "-PSav" "--delete" + (loop for volume + in (mapcan (curry #'subvolumes-of-type 'mounted-filesystem) + (get-connattr :opened-volumes)) + collect (strcat "--exclude=" + (unix-namestring (mount-point volume)))) + (strcat (unix-namestring chroot) "/") + (strcat (unix-namestring target) "/")))) + +(defpropspec chroot-installed-to-volumes :posix (host chroot volumes) + "Where CHROOT contains the root filesystem of HOST and VOLUMES is a list of +volumes, recursively open the volumes and rsync in the contents of CHROOT. +Also update the fstab and crypttab, and try to install a bootloader." + (:desc #?"${chroot} installed to volumes") + (let ((target (ensure-directory-pathname + (strcat (unix-namestring chroot) ".target")))) + `(with-these-open-volumes (,volumes :mount-below ,target) + (chroot:deploys-these + ,chroot ,host + ,(make-propspec + :systems nil + :propspec + '(eseqprops + ;; TODO (fstab:entries-for-opened-volumes) + (file:lacks-lines "/etc/fstab" "# UNCONFIGURED FSTAB FOR BASE SYSTEM")))) + ;; TODO Update /etc/crypttab + ;; TODO Install bootloader + (%update-target-from-chroot ,chroot ,target)))) -- cgit v1.2.3