tidy up entering and reentering Consfigurator's primary loop

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

6 files changed, 53 insertions, 22 deletions

diff --git a/src/connection.lisp b/src/connection.lisp
index 0ba08a6..6efce31 100644
--- a/src/connection.lisp
+++ b/src/connection.lisp
@@ -32,13 +32,11 @@ global value should be regarded as a constant.")
   (:documentation
    "Within the context of the current connection, connect to HOST by
 establishing a new connection of type TYPE.
-Either starts a Lisp image somewhere else, tells it to continue establishing
-REMAINING (by telling it to call DEPLOY* with arguments obtained by (locally)
-evaluating (list (or REMAINING '(:local)) *host*)), and returns nil, or
-returns a object suitable to be the value of *CONNECTION*.
+Either returns an object suitable to be the value of *CONNECTION*, or calls
+either CONTINUE-DEPLOY* or CONTINUE-DEPLOY*-PROGRAM and returns nil.
 
-Any implementation which hands over to a remote Lisp image will need to
-upload any prerequisite data required by the deployment."))
+Any implementation which calls CONTINUE-DEPLOY*-PROGRAM will need to call
+UPLOAD-ALL-PREREQUISITE-DATA."))
 
 (defgeneric preprocess-connection-args (type &key)
   (:documentation
diff --git a/src/connection/chroot/fork.lisp b/src/connection/chroot/fork.lisp
index 5fe3711..bea6b10 100644
--- a/src/connection/chroot/fork.lisp
+++ b/src/connection/chroot/fork.lisp
@@ -52,12 +52,12 @@
 		   (list *standard-input* *debug-io* *terminal-io*))
 	     (unless (zerop (chroot into))
 	       (error "chroot(2) failed; are you root?"))
-	     ;; note that we can't just
-	     ;; (return-from establish-connection (establish-connection :local)
-	     ;; because we need to kill off the child afterwards, rather than
-	     ;; returning to the child's REPL or whatever else
-	     ;; TODO public interface to DEPLOY* or similar needed here
-	     (consfigurator::deploy* (or remaining :local) consfigurator::*host*)
+	     ;; it would be nice to reenter Consfigurator's primary loop by
+	     ;; just calling (return-from establish-connection
+	     ;; (establish-connection :local)) here, but we need to kill off
+	     ;; the child afterwards, rather than returning to the child's
+	     ;; REPL or whatever else
+	     (continue-deploy* remaining)
 	     (uiop:quit 0))
 	 (serious-condition (c)
 	   (format *error-output* ":CHROOT.FORK child failed: ~A~%" c)
diff --git a/src/connection/debian-sbcl.lisp b/src/connection/debian-sbcl.lisp
index 5965853..208655e 100644
--- a/src/connection/debian-sbcl.lisp
+++ b/src/connection/debian-sbcl.lisp
@@ -23,7 +23,7 @@
   (upload-all-prerequisite-data)
   (princ "Waiting for remote Lisp to exit, this may take some time ... ")
   (force-output)
-  (let ((program (deployment-handover-program remaining)))
+  (let ((program (continue-deploy*-program remaining)))
     (multiple-value-bind (out err exit)
 	(run :may-fail :input program
 	     "sbcl" "--noinform" "--noprint"
diff --git a/src/data.lisp b/src/data.lisp
index c6e5246..63d5e2d 100644
--- a/src/data.lisp
+++ b/src/data.lisp
@@ -345,17 +345,27 @@ of the current connection, where each entry is of the form
 		    "-type" "f" "-printf" "%P\\n")
 	    (and (zerop exit) (lines out)))))
 
+;; we can't just default REMAINING to :LOCAL in the lambda list because it is
+;; legitimate for callers to explicitly pass nil.
+;;
 ;; TODO on remote side, catch read errors and signal our own which says
 ;; something more specific -- "This has probably been caused by an attempt to
 ;; use a property application specification or set of static informational
 ;; attributes which cannot be serialised by the Lisp printer"
-(defun deployment-handover-program (remaining)
-  "Return a program which instructs a remote Lisp image to continue DEPLOY*.
+(defun continue-deploy*-program (remaining-connections)
+  "Return a program to complete the work of an enclosing call to DEPLOY*.
+
+Implementations of ESTABLISH-CONNECTION which start up remote Lisp images call
+this function, instead of CONTINUE-DEPLOY*, and use the result to instruct the
+newly started image.
 
 Will query the remote cache for paths to Lisp systems, so a connection to the
 host which will run the Lisp image must already be established.
 
-Called by connections which start up remote Lisp images."
+The program returned is a single string consisting of a number of sexps
+separated by newlines.  Each sexp must be evaluated by the remote Lisp image
+before the following sexp is offered to its reader.  Usually this can be
+achieved by sending the return value of this function into a REPL's stdin."
   (flet ((wrap (forms)
 	   `(handler-bind
 		(;; we can skip missing data sources because these are not
@@ -402,7 +412,8 @@ Called by connections which start up remote Lisp images."
 		 (require "asdf")
 		 (let ((*standard-output* *error-output*))
 		   ,(wrap load-forms))
-		 ,(wrap `((deploy* ',(or remaining :local) ,*host*)))))))))
+		 ,(wrap `((deploy* ',(or remaining-connections :local)
+				   ,*host*)))))))))
 
 (defun request-lisp-systems ()
   "Request that all Lisp systems required by the host currently being deployed
diff --git a/src/deployment.lisp b/src/deployment.lisp
index 395cec8..4aef20f 100644
--- a/src/deployment.lisp
+++ b/src/deployment.lisp
@@ -108,9 +108,20 @@ DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
 	 (eval-propspec-hostattrs ,propspec))
        (deploy* ',connection ,new-host))))
 
-;; this is the main do-work loop for Consfigurator; remote Lisp images are
-;; instructed to pick up the remaining work of this loop
 (defun deploy* (connections host)
+  "Execute the deployment which is defined by the pair (CONNECTIONS . HOST).
+
+This is the entry point to Consfigurator's primary loop.  Typically users use
+DEPLOY, DEPLOY-THESE, and the function definitions established by DEFDEPLOY,
+DEFDEPLOY-THESE, etc., rather than calling this function.  However, code which
+programmatically constructs deployments will need to call this function.
+
+Unlike DEPLOY there is no argument to supply additional properties, and there
+is no function DEPLOY-THESE*.  This is because merging/replacing properties
+into HOST's propspec cannot be done without either the implicit context
+established by a consfig (specifically, by IN-CONSFIG) or with an explicit
+specification of the SYSTEMS slot of the resultant property application
+specification."
   ;; make a partial own-copy of HOST so that connections can add new pieces of
   ;; required prerequisite data; specifically, so that they can request the
   ;; source code of ASDF systems
@@ -120,8 +131,8 @@ DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
     (labels
 	((connect (connections)
 	   (destructuring-bind ((type . args) . remaining) connections
-	     ;; implementations of ESTABLISH-CONNECTION return nil if they
-	     ;; have handed off to a remote Lisp image
+	     ;; implementations of ESTABLISH-CONNECTION which call
+	     ;; CONTINUE-DEPLOY* or CONTINUE-DEPLOY*-PROGRAM return nil to us
 	     (when-let ((*connection*
 			 (apply #'establish-connection type remaining args)))
 	       (if remaining
@@ -132,6 +143,15 @@ DEFHOST forms can override earlier entries (see DEFHOST's docstring)."
 		     collect (apply #'preprocess-connection-args
 				    (ensure-cons connection)))))))
 
+;; we can't just default CONNECTIONS to :LOCAL in the lambda list, because it
+;; is legitimate for callers to explicitly pass nil
+(defun continue-deploy* (remaining-connections)
+  "Complete the work of an enclosing call to DEPLOY*.
+
+Used by implementations of ESTABLISH-CONNECTION which need to do something like
+fork(2) and then return to Consfigurator's primary loop in the child."
+  (deploy* (or remaining-connections :local) *host*))
+
 ;; these might need to be special-cased in parsing propspecs, because we
 ;; probably want it to be easy for the user to pass unevaluated propspecs to
 ;; these, but we want the evaluation to happen in the root Lisp.
diff --git a/src/package.lisp b/src/package.lisp
index 6aab491..5d32573 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -103,6 +103,8 @@
 	   #:deploy-these
 	   #:deploys
 	   #:deploys-these
+	   #:deploy*
+	   #:continue-deploy*
 
 	   ;; data.lisp
 	   #:data
@@ -125,7 +127,7 @@
 	   #:get-data-string
 	   #:upload-all-prerequisite-data
 	   #:request-lisp-systems
-	   #:deployment-handover-program))
+	   #:continue-deploy*-program))
 
 (defpackage :consfigurator.connection.shell-wrap
   (:use #:cl #:consfigurator)