mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-28 15:22:18 -05:00
ssh: Use 'guix repl' instead of 'guile'.
This simplifies setup of build machines: no need to install Guile in addition to Guix, no need to set 'GUILE_LOAD_PATH' & co., leading to fewer failure modes. * guix/ssh.scm (remote-run): New procedure. (remote-daemon-channel): Use it instead of 'open-remote-pipe*'. (store-import-channel)[import]: Remove check for module availability. Add call to 'primitive-exit'. Use 'remote-run' instead of 'open-remote-pipe'. (store-export-channel)[export]: Remove check for module availability. Add calls to 'primitive-exit'. Use 'remote-run' instead of 'open-remote-pipe'. (handle-import/export-channel-error): Remove 'module-error' clause. (report-module-error): Remove. * guix/scripts/offload.scm (assert-node-has-guix): Replace call to 'report-module-error' by 'leave'. * doc/guix.texi (Daemon Offload Setup): Remove mention of Guile.
This commit is contained in:
parent
be5a75ebb5
commit
7624ebbae3
3 changed files with 51 additions and 45 deletions
|
@ -1296,7 +1296,7 @@ master node:
|
||||||
@end example
|
@end example
|
||||||
|
|
||||||
This will attempt to connect to each of the build machines specified in
|
This will attempt to connect to each of the build machines specified in
|
||||||
@file{/etc/guix/machines.scm}, make sure Guile and the Guix modules are
|
@file{/etc/guix/machines.scm}, make sure Guix is
|
||||||
available on each machine, attempt to export to the machine and import
|
available on each machine, attempt to export to the machine and import
|
||||||
from it, and report any error in the process.
|
from it, and report any error in the process.
|
||||||
|
|
||||||
|
|
|
@ -634,7 +634,8 @@ (define (assert-node-has-guix node name)
|
||||||
(and add-text-to-store 'alright))
|
(and add-text-to-store 'alright))
|
||||||
node)
|
node)
|
||||||
('alright #t)
|
('alright #t)
|
||||||
(_ (report-module-error name)))
|
(_ (leave (G_ "(guix) module not usable on remote host '~a'")
|
||||||
|
name)))
|
||||||
|
|
||||||
(match (inferior-eval '(begin
|
(match (inferior-eval '(begin
|
||||||
(use-modules (guix))
|
(use-modules (guix))
|
||||||
|
|
91
guix/ssh.scm
91
guix/ssh.scm
|
@ -54,8 +54,7 @@ (define-module (guix ssh)
|
||||||
retrieve-files*
|
retrieve-files*
|
||||||
remote-store-host
|
remote-store-host
|
||||||
|
|
||||||
report-guile-error
|
report-guile-error))
|
||||||
report-module-error))
|
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -206,6 +205,40 @@ (define* (inferior-remote-eval exp session #:optional become-command)
|
||||||
;; <https://bugs.gnu.org/26976>.)
|
;; <https://bugs.gnu.org/26976>.)
|
||||||
(close-inferior inferior)))))
|
(close-inferior inferior)))))
|
||||||
|
|
||||||
|
(define (remote-run exp session)
|
||||||
|
"Run EXP in a new process in SESSION and return a remote pipe.
|
||||||
|
|
||||||
|
Unlike 'inferior-remote-eval', this is used for side effects and may
|
||||||
|
communicate over stdout/stdin as it sees fit. EXP is typically a loop that
|
||||||
|
processes data from stdin and/or sends data to stdout. The assumption is that
|
||||||
|
EXP never returns or calls 'primitive-exit' when it's done."
|
||||||
|
(define pipe
|
||||||
|
(open-remote-pipe* session OPEN_BOTH
|
||||||
|
"guix" "repl" "-t" "machine"))
|
||||||
|
|
||||||
|
(match (read pipe)
|
||||||
|
(('repl-version _ ...)
|
||||||
|
#t)
|
||||||
|
((? eof-object?)
|
||||||
|
(close-port pipe)
|
||||||
|
(raise (formatted-message
|
||||||
|
(G_ "failed to start 'guix repl' on '~a'")
|
||||||
|
(session-get session 'host)))))
|
||||||
|
|
||||||
|
;; Disable buffering so 'guix repl' does not read more than what's really
|
||||||
|
;; sent to itself.
|
||||||
|
(write '(setvbuf (current-input-port) 'none) pipe)
|
||||||
|
(force-output pipe)
|
||||||
|
|
||||||
|
;; Read the reply and subsequent newline.
|
||||||
|
(read pipe) (get-u8 pipe)
|
||||||
|
|
||||||
|
(write exp pipe)
|
||||||
|
(force-output pipe)
|
||||||
|
|
||||||
|
;; From now on, we stop following the inferior protocol.
|
||||||
|
pipe)
|
||||||
|
|
||||||
(define* (remote-daemon-channel session
|
(define* (remote-daemon-channel session
|
||||||
#:optional
|
#:optional
|
||||||
(socket-name
|
(socket-name
|
||||||
|
@ -261,11 +294,7 @@ (define redirect
|
||||||
(_
|
(_
|
||||||
(primitive-exit 1)))))))
|
(primitive-exit 1)))))))
|
||||||
|
|
||||||
(open-remote-pipe* session OPEN_BOTH
|
(remote-run redirect session))
|
||||||
;; Sort-of shell-quote REDIRECT.
|
|
||||||
"guile" "-c"
|
|
||||||
(object->string
|
|
||||||
(object->string redirect))))
|
|
||||||
|
|
||||||
(define* (connect-to-remote-daemon session
|
(define* (connect-to-remote-daemon session
|
||||||
#:optional
|
#:optional
|
||||||
|
@ -288,11 +317,6 @@ (define (store-import-channel session)
|
||||||
;; consumed.
|
;; consumed.
|
||||||
(define import
|
(define import
|
||||||
`(begin
|
`(begin
|
||||||
(eval-when (load expand eval)
|
|
||||||
(unless (resolve-module '(guix) #:ensure #f)
|
|
||||||
(write `(module-error))
|
|
||||||
(exit 7)))
|
|
||||||
|
|
||||||
(use-modules (guix) (srfi srfi-34)
|
(use-modules (guix) (srfi srfi-34)
|
||||||
(rnrs io ports) (rnrs bytevectors))
|
(rnrs io ports) (rnrs bytevectors))
|
||||||
|
|
||||||
|
@ -322,13 +346,10 @@ (define (consume-input port)
|
||||||
(import-paths store (current-input-port))
|
(import-paths store (current-input-port))
|
||||||
'(success))))
|
'(success))))
|
||||||
(lambda args
|
(lambda args
|
||||||
(cons 'error args))))))
|
(cons 'error args))))
|
||||||
|
(primitive-exit 0)))
|
||||||
|
|
||||||
(open-remote-pipe session
|
(remote-run import session))
|
||||||
(string-join
|
|
||||||
`("guile" "-c"
|
|
||||||
,(object->string (object->string import))))
|
|
||||||
OPEN_BOTH))
|
|
||||||
|
|
||||||
(define* (store-export-channel session files
|
(define* (store-export-channel session files
|
||||||
#:key recursive?)
|
#:key recursive?)
|
||||||
|
@ -338,22 +359,20 @@ (define* (store-export-channel session files
|
||||||
;; remote store.
|
;; remote store.
|
||||||
(define export
|
(define export
|
||||||
`(begin
|
`(begin
|
||||||
(eval-when (load expand eval)
|
|
||||||
(unless (resolve-module '(guix) #:ensure #f)
|
|
||||||
(write `(module-error))
|
|
||||||
(exit 7)))
|
|
||||||
|
|
||||||
(use-modules (guix) (srfi srfi-1)
|
(use-modules (guix) (srfi srfi-1)
|
||||||
(srfi srfi-26) (srfi srfi-34))
|
(srfi srfi-26) (srfi srfi-34))
|
||||||
|
|
||||||
(guard (c ((nix-connection-error? c)
|
(guard (c ((nix-connection-error? c)
|
||||||
(write `(connection-error ,(nix-connection-error-file c)
|
(write `(connection-error ,(nix-connection-error-file c)
|
||||||
,(nix-connection-error-code c))))
|
,(nix-connection-error-code c)))
|
||||||
|
(primitive-exit 1))
|
||||||
((nix-protocol-error? c)
|
((nix-protocol-error? c)
|
||||||
(write `(protocol-error ,(nix-protocol-error-status c)
|
(write `(protocol-error ,(nix-protocol-error-status c)
|
||||||
,(nix-protocol-error-message c))))
|
,(nix-protocol-error-message c)))
|
||||||
|
(primitive-exit 2))
|
||||||
(else
|
(else
|
||||||
(write `(exception))))
|
(write `(exception))
|
||||||
|
(primitive-exit 3)))
|
||||||
(with-store store
|
(with-store store
|
||||||
(let* ((files ',files)
|
(let* ((files ',files)
|
||||||
(invalid (remove (cut valid-path? store <>)
|
(invalid (remove (cut valid-path? store <>)
|
||||||
|
@ -371,13 +390,10 @@ (define export
|
||||||
|
|
||||||
(setvbuf (current-output-port) 'none)
|
(setvbuf (current-output-port) 'none)
|
||||||
(export-paths store files (current-output-port)
|
(export-paths store files (current-output-port)
|
||||||
#:recursive? ,recursive?))))))
|
#:recursive? ,recursive?)
|
||||||
|
(primitive-exit 0))))))
|
||||||
|
|
||||||
(open-remote-input-pipe session
|
(remote-run export session))
|
||||||
(string-join
|
|
||||||
`("guile" "-c"
|
|
||||||
,(object->string
|
|
||||||
(object->string export))))))
|
|
||||||
|
|
||||||
(define (remote-system session)
|
(define (remote-system session)
|
||||||
"Return the system type as expected by Nix, usually ARCHITECTURE-KERNEL, of
|
"Return the system type as expected by Nix, usually ARCHITECTURE-KERNEL, of
|
||||||
|
@ -563,8 +579,6 @@ (define (handle-import/export-channel-error sexp remote)
|
||||||
(match sexp
|
(match sexp
|
||||||
((? eof-object?)
|
((? eof-object?)
|
||||||
(report-guile-error (remote-store-host remote)))
|
(report-guile-error (remote-store-host remote)))
|
||||||
(('module-error . _)
|
|
||||||
(report-module-error (remote-store-host remote)))
|
|
||||||
(('connection-error file code . _)
|
(('connection-error file code . _)
|
||||||
(raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
|
(raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a")
|
||||||
file (remote-store-host remote) (strerror code)))
|
file (remote-store-host remote) (strerror code)))
|
||||||
|
@ -626,15 +640,6 @@ (define (report-guile-error host)
|
||||||
check.")
|
check.")
|
||||||
host)))
|
host)))
|
||||||
|
|
||||||
(define (report-module-error host)
|
|
||||||
"Report an error about missing Guix modules on HOST."
|
|
||||||
;; TRANSLATORS: Leave "Guile" untranslated.
|
|
||||||
(raise-error (G_ "Guile modules not found on remote host '~A'") host
|
|
||||||
(=> (G_ "Make sure @code{GUILE_LOAD_PATH} includes Guix'
|
|
||||||
own module directory. Run @command{ssh ~A env | grep GUILE_LOAD_PATH} to
|
|
||||||
check.")
|
|
||||||
host)))
|
|
||||||
|
|
||||||
(define (report-inferior-exception exception host)
|
(define (report-inferior-exception exception host)
|
||||||
"Report EXCEPTION, an &inferior-exception that occurred on HOST."
|
"Report EXCEPTION, an &inferior-exception that occurred on HOST."
|
||||||
(raise-error (G_ "exception occurred on remote host '~A': ~s")
|
(raise-error (G_ "exception occurred on remote host '~A': ~s")
|
||||||
|
|
Loading…
Reference in a new issue