diff options
author | Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org> | 2019-08-09 14:24:57 -0400 |
---|---|---|
committer | Christopher Lemmer Webber <cwebber@dustycloud.org> | 2019-08-14 15:38:09 -0400 |
commit | 2c8e04f13670c8c7ad8c7195c305960dd1905363 (patch) | |
tree | 3a019a797bd022b6907019512e44bf55602d7f1f /gnu/machine | |
parent | 67dac6b8920755cb011047157bb7b4fae4760143 (diff) | |
download | guix-2c8e04f13670c8c7ad8c7195c305960dd1905363.tar.gz |
remote: Build derivations appropriate for the remote's
* gnu/machine/ssh.scm (machine-ssh-configuration): Add 'system' field. (managed-host-remote-eval): Pass 'system' field to 'remote-eval'. (machine-check-building-for-appropriate-system): New variable. (check-deployment-sanity): Add call to 'machine-check-building-for-appropriate-system'. * doc/guix.texi (Invoking guix deploy): Describe new 'system' field. * guix/ssh.scm (remote-system): New variable. * guix/remote.scm (remote-eval): Use result of 'remote-system' when lowering the G-Expression. (remote-eval): Add 'system' keyword argument. (trampoline): Return a <program-file> rather than a <scheme-file>.
Diffstat (limited to 'gnu/machine')
-rw-r--r-- | gnu/machine/ssh.scm | 31 |
1 files changed, 27 insertions, 4 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index ba3e33c922..670990a633 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -36,6 +36,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (managed-host-environment-type @@ -68,6 +69,7 @@ machine-ssh-configuration? this-machine-ssh-configuration (host-name machine-ssh-configuration-host-name) ; string + (system machine-ssh-configuration-system) ; string (build-locally? machine-ssh-configuration-build-locally? (default #t)) (port machine-ssh-configuration-port ; integer @@ -103,10 +105,12 @@ one from the configuration's parameters if one was not provided." "Internal implementation of 'machine-remote-eval' for MACHINE instances with an environment type of 'managed-host." (maybe-raise-unsupported-configuration-error machine) - (remote-eval exp (machine-ssh-session machine) - #:build-locally? - (machine-ssh-configuration-build-locally? - (machine-configuration machine)))) + (let ((config (machine-configuration machine))) + (remote-eval exp (machine-ssh-session machine) + #:build-locally? + (machine-ssh-configuration-build-locally? config) + #:system + (machine-ssh-configuration-system config)))) ;;; @@ -240,10 +244,29 @@ MACHINE's 'system' declaration do not exist on the machine." device) (return #t))) +(define (machine-check-building-for-appropriate-system machine) + "Raise a '&message' error condition if MACHINE is configured to be built +locally and the 'system' field does not match the '%current-system' reported +by MACHINE." + (let ((config (machine-configuration machine)) + (system (remote-system (machine-ssh-session machine)))) + (when (and (machine-ssh-configuration-build-locally? config) + (not (string= system (machine-ssh-configuration-system config)))) + (raise (condition + (&message + (message (format #f (G_ "incorrect target system \ +('~a' was given, while the system reports that it is '~a')~%") + (machine-ssh-configuration-system config) + system))))))) + (with-monad %store-monad (return #t))) + (define (check-deployment-sanity machine) "Raise a '&message' error condition if it is clear that deploying MACHINE's 'system' declaration would fail." + ;; Order is important here -- an incorrect value for 'system' will cause + ;; invocations of 'remote-eval' to fail. (mbegin %store-monad + (machine-check-building-for-appropriate-system machine) (machine-check-file-system-availability machine) (machine-check-initrd-modules machine))) |