From 2ec9cea43c46854dd36e0cf9ba0b0d42d428a286 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 2 Jul 2021 12:40:54 -0700 Subject: add AT-END, REBOOT:REBOOTED-AT-END Signed-off-by: Sean Whitton --- consfigurator.asd | 1 + src/deployment.lisp | 28 ++++++++++++++++++++++++---- src/package.lisp | 6 ++++++ src/property/reboot.lisp | 33 +++++++++++++++++++++++++++++++++ 4 files changed, 64 insertions(+), 4 deletions(-) create mode 100644 src/property/reboot.lisp diff --git a/consfigurator.asd b/consfigurator.asd index 46b4191..8a63015 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -47,6 +47,7 @@ (:file "src/property/ssh") (:file "src/property/sshd") (:file "src/property/locale") + (:file "src/property/reboot") (:file "src/property/installer") (:file "src/property/grub") (:file "src/property/u-boot") diff --git a/src/deployment.lisp b/src/deployment.lisp index 68acdd0..ce4fb95 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -20,7 +20,21 @@ ;;;; Deployments -(defun %consfigure (connections host) +(defparameter *at-end-functions* nil) + +(defun at-end (function) + "Request that FUNCTION be called at the end of the current (sub)deployment. +Called by property :APPLY and :UNAPPLY subroutines. FUNCTION will be passed a +single argument representing whether or not the deployment made a change. + +Properties which call this are responsible for ensuring that the I/O performed +by FUNCTION is compatible with the connection type. This amounts to the +following requirement: if FUNCTION performs I/O beyond what :POSIX property +:APPLY subroutines are permitted to perform, the property calling AT-END to +register FUNCTION must be declared to be a :LISP property." + (push (ensure-function function) *at-end-functions*)) + +(defun %consfigure (connections host &key (collect-at-end t)) "Consfigurator's primary loop, recursively binding *CONNECTION* and *HOST*. Assumes arguments to connections in CONNECTIONS have been both normalised and @@ -29,7 +43,12 @@ preprocessed." ((apply-*host*-propspec () (let ((propapp (eval-propspec (host-propspec *host*)))) (assert-connection-supports (propapptype propapp)) - (propappapply propapp))) + (if collect-at-end + (let (*at-end-functions*) + (let ((result (propappapply propapp))) + (dolist (function *at-end-functions* result) + (funcall function result)))) + (propappapply propapp)))) (connect (connections) (destructuring-bind ((type . args) . remaining) connections ;; implementations of ESTABLISH-CONNECTION which call @@ -53,7 +72,7 @@ preprocessed." (t (connect '((:local)))))))) -(defun consfigure (propspec-expression) +(defun consfigure (propspec-expression &key collect-at-end) "Immediately preprocess and apply PROPSPEC-EXPRESSION in the context of the current target host and connection. This function is provided for use by specialised property combinators. It should not be used in property @@ -69,7 +88,8 @@ will not be discarded." nil (make-host :hostattrs (hostattrs *host*) :propspec (with-*host*-*consfig* - (make-propspec :propspec propspec-expression))))) + (make-propspec :propspec propspec-expression))) + :collect-at-end collect-at-end)) (defmacro with-deployment-report (&rest forms) (with-gensyms (failures) diff --git a/src/package.lisp b/src/package.lisp index b2381e4..8d54b4d 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -218,6 +218,7 @@ #:with-replace-hostattrs ;; deployment.lisp + #:at-end #:consfigure #:defdeploy #:defdeploy-these @@ -576,6 +577,11 @@ (:export #:available #:selected-for)) +(defpackage :consfigurator.property.reboot + (:use #:cl #:consfigurator) + (:local-nicknames (#:container #:consfigurator.property.container)) + (:export #:rebooted-at-end)) + (defpackage :consfigurator.property.installer (:use #:cl #:alexandria #:consfigurator #:consfigurator.property.disk) (:local-nicknames (#:os #:consfigurator.property.os) diff --git a/src/property/reboot.lisp b/src/property/reboot.lisp new file mode 100644 index 0000000..5728e0a --- /dev/null +++ b/src/property/reboot.lisp @@ -0,0 +1,33 @@ +;;; 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.reboot) +(named-readtables:in-readtable :consfigurator) + +(defprop %rebooted-at-end :posix () + (:apply (at-end + (lambda (result) + (declare (ignore result)) + (mrun "shutdown" "-r" "+1") + (inform t "*** SYSTEM REBOOT SCHEDULED, one minute delay ***"))))) + +(defproplist rebooted-at-end :posix () + "Schedule a reboot for the end of the current (sub)deployment. +The reboot is scheduled with a one minute delay to allow remote Lisp images to +return correct exit statuses to the root Lisp, for the root Lisp to have time +to download their output, etc." + (container:when-contained (:reboot) (%rebooted-at-end))) -- cgit v1.2.3