add AT-END, REBOOT:REBOOTED-AT-END

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

4 files changed, 64 insertions, 4 deletions

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 <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.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)))