From 954e4cf6a4cc67701dff8d089e8e02861e3b36c2 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Thu, 3 Dec 2020 20:22:50 +0100 Subject: offload: Print warning in context. * guix/scripts/offload.scm (build-machine): Add `location` field. (build-machine-system): Print location with warning. --- guix/scripts/offload.scm | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'guix/scripts/offload.scm') diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 6366556647..58ee53e85c 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2017 Ricardo Wurmus ;;; Copyright © 2020 Maxim Cournoyer +;;; Copyright © 2020 Julien Lepiller ;;; ;;; This file is part of GNU Guix. ;;; @@ -65,6 +66,7 @@ build-machine-overload-threshold build-machine-systems build-machine-features + build-machine-location build-requirements build-requirements? @@ -112,11 +114,17 @@ (speed build-machine-speed ; inexact real (default 1.0)) (features build-machine-features ; list of strings - (default '()))) + (default '())) + (location build-machine-location + (default (and=> (current-source-location) + source-properties->location)) + (innate))) ;;; Deprecated. (define (build-machine-system machine) - (warning (G_ "The 'system' field is deprecated, \ + (warning + (build-machine-location machine) + (G_ "The 'system' field is deprecated, \ please use 'systems' instead.~%")) (%build-machine-system machine)) -- cgit v1.2.3 From 7624ebbae33cf49dded5e9032ed426781c9554f6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 18 Dec 2020 11:42:57 +0100 Subject: 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. --- doc/guix.texi | 2 +- guix/scripts/offload.scm | 3 +- guix/ssh.scm | 91 +++++++++++++++++++++++++----------------------- 3 files changed, 51 insertions(+), 45 deletions(-) (limited to 'guix/scripts/offload.scm') diff --git a/doc/guix.texi b/doc/guix.texi index 74cd86be37..b12cb11bdf 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1296,7 +1296,7 @@ master node: @end example 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 from it, and report any error in the process. diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 58ee53e85c..835078cb97 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -634,7 +634,8 @@ daemon is not running." (and add-text-to-store 'alright)) node) ('alright #t) - (_ (report-module-error name))) + (_ (leave (G_ "(guix) module not usable on remote host '~a'") + name))) (match (inferior-eval '(begin (use-modules (guix)) diff --git a/guix/ssh.scm b/guix/ssh.scm index e41bffca65..457d1890f9 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -54,8 +54,7 @@ retrieve-files* remote-store-host - report-guile-error - report-module-error)) + report-guile-error)) ;;; Commentary: ;;; @@ -206,6 +205,40 @@ REPL." ;; .) (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 #:optional (socket-name @@ -261,11 +294,7 @@ REPL." (_ (primitive-exit 1))))))) - (open-remote-pipe* session OPEN_BOTH - ;; Sort-of shell-quote REDIRECT. - "guile" "-c" - (object->string - (object->string redirect)))) + (remote-run redirect session)) (define* (connect-to-remote-daemon session #:optional @@ -288,11 +317,6 @@ can be written." ;; consumed. (define import `(begin - (eval-when (load expand eval) - (unless (resolve-module '(guix) #:ensure #f) - (write `(module-error)) - (exit 7))) - (use-modules (guix) (srfi srfi-34) (rnrs io ports) (rnrs bytevectors)) @@ -322,13 +346,10 @@ can be written." (import-paths store (current-input-port)) '(success)))) (lambda args - (cons 'error args)))))) + (cons 'error args)))) + (primitive-exit 0))) - (open-remote-pipe session - (string-join - `("guile" "-c" - ,(object->string (object->string import)))) - OPEN_BOTH)) + (remote-run import session)) (define* (store-export-channel session files #:key recursive?) @@ -338,22 +359,20 @@ be read. When RECURSIVE? is true, the closure of FILES is exported." ;; remote store. (define export `(begin - (eval-when (load expand eval) - (unless (resolve-module '(guix) #:ensure #f) - (write `(module-error)) - (exit 7))) - (use-modules (guix) (srfi srfi-1) (srfi srfi-26) (srfi srfi-34)) (guard (c ((nix-connection-error? 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) (write `(protocol-error ,(nix-protocol-error-status c) - ,(nix-protocol-error-message c)))) + ,(nix-protocol-error-message c))) + (primitive-exit 2)) (else - (write `(exception)))) + (write `(exception)) + (primitive-exit 3))) (with-store store (let* ((files ',files) (invalid (remove (cut valid-path? store <>) @@ -371,13 +390,10 @@ be read. When RECURSIVE? is true, the closure of FILES is exported." (setvbuf (current-output-port) 'none) (export-paths store files (current-output-port) - #:recursive? ,recursive?)))))) + #:recursive? ,recursive?) + (primitive-exit 0)))))) - (open-remote-input-pipe session - (string-join - `("guile" "-c" - ,(object->string - (object->string export)))))) + (remote-run export session)) (define (remote-system session) "Return the system type as expected by Nix, usually ARCHITECTURE-KERNEL, of @@ -563,8 +579,6 @@ REMOTE." (match sexp ((? eof-object?) (report-guile-error (remote-store-host remote))) - (('module-error . _) - (report-module-error (remote-store-host remote))) (('connection-error file code . _) (raise-error (G_ "failed to connect to '~A' on remote host '~A': ~a") file (remote-store-host remote) (strerror code))) @@ -626,15 +640,6 @@ LOCAL. When RECURSIVE? is true, retrieve the closure of FILES." check.") 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) "Report EXCEPTION, an &inferior-exception that occurred on HOST." (raise-error (G_ "exception occurred on remote host '~A': ~s") -- cgit v1.2.3