diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-28 16:41:15 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-02-28 16:42:46 -0700 |
commit | d50a65bd7adf5e4983c1f41b6bbe76b4a9d4e058 (patch) | |
tree | 8b624664ec48d944471345be4d1cc4ddc39173bc | |
parent | fe9117e0bcaf65db50930e6320ff7012cee541e3 (diff) | |
download | consfigurator-d50a65bd7adf5e4983c1f41b6bbe76b4a9d4e058.tar.gz |
eliminate global value for *CONNECTION*
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | src/connection.lisp | 5 | ||||
-rw-r--r-- | src/connection/local.lisp | 8 | ||||
-rw-r--r-- | src/data.lisp | 6 | ||||
-rw-r--r-- | src/deployment.lisp | 45 |
4 files changed, 25 insertions, 39 deletions
diff --git a/src/connection.lisp b/src/connection.lisp index 6efce31..f839a65 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -20,12 +20,9 @@ ;;;; Connections -;; global value gets set in connection/local.lisp, but the symbol is not -;; exported as it should only get bound by DEPLOY* (defvar *connection* nil "Object representing the currently active connection. -Connections dynamically bind this variable and then apply properties. Its -global value should be regarded as a constant.") +Deployments dynamically bind this variable and then apply properties.") ;; generic function operating on keywords which identify connection types (defgeneric establish-connection (type remaining &key) diff --git a/src/connection/local.lisp b/src/connection/local.lisp index 4de70c1..a8a967c 100644 --- a/src/connection/local.lisp +++ b/src/connection/local.lisp @@ -76,11 +76,3 @@ root Lisp is running on, as the root Lisp's uid.")) (defmethod connection-upload ((connection local-connection) from to) (copy-file from to)) - -;; set the root Lisp's connection context now we've defined its value -- other -;; implementations of ESTABLISH-CONNECTION will rely on this when they call -;; RUN, READFILE etc. -(eval-when (:load-toplevel :execute) - (unless consfigurator::*connection* - (setq consfigurator::*connection* - (make-instance 'local-connection)))) diff --git a/src/data.lisp b/src/data.lisp index 63d5e2d..a264030 100644 --- a/src/data.lisp +++ b/src/data.lisp @@ -345,9 +345,6 @@ 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 @@ -412,8 +409,7 @@ achieved by sending the return value of this function into a REPL's stdin." (require "asdf") (let ((*standard-output* *error-output*)) ,(wrap load-forms)) - ,(wrap `((deploy* ',(or remaining-connections :local) - ,*host*))))))))) + ,(wrap `((deploy* ',remaining-connections ,*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 4aef20f..46dc944 100644 --- a/src/deployment.lisp +++ b/src/deployment.lisp @@ -122,35 +122,36 @@ 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 - (let ((*host* (make-instance 'host - :attrs (copy-list (slot-value host 'hostattrs)) - :props (slot-value host 'propspec)))) - (labels - ((connect (connections) - (destructuring-bind ((type . args) . remaining) connections - ;; 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 - (connect remaining) - (eval-propspec (slot-value *host* 'propspec))) - (connection-teardown *connection*))))) - (connect (loop for connection in (ensure-cons connections) + (labels + ((connect (connections) + (destructuring-bind ((type . args) . remaining) connections + ;; 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 + (connect remaining) + (eval-propspec (host-propspec *host*))) + (connection-teardown *connection*))))) + ;; 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 + (let ((*host* (make-instance 'host :props (host-propspec host) + :attrs (copy-list (hostattrs host))))) + (connect (normalise-connections connections))))) + +(defun normalise-connections (connections) + (let ((chain (loop for connection in (ensure-cons connections) collect (apply #'preprocess-connection-args - (ensure-cons connection))))))) + (ensure-cons connection))))) + (if (eq :local (caar chain)) chain (cons '(:local) chain)))) -;; 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*)) + (deploy* remaining-connections *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 |