diff options
author | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2020-08-26 18:35:14 +0200 |
commit | 17dddeeee560527a8f30d37761949d658056cb09 (patch) | |
tree | 15b0b19c55787f556eb9b42c28d173bddc5435db /guix/scripts/offload.scm | |
parent | 331a09654eb7e9f6212b7e8469077fa7393e8b11 (diff) | |
parent | 6a9581741e4ee81226aeb2f1c997df76670a6aab (diff) | |
download | guix-patches-17dddeeee560527a8f30d37761949d658056cb09.tar guix-patches-17dddeeee560527a8f30d37761949d658056cb09.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'guix/scripts/offload.scm')
-rw-r--r-- | guix/scripts/offload.scm | 37 |
1 files changed, 27 insertions, 10 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index e81b6c25f2..a56701f07a 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,11 +34,12 @@ #:use-module ((guix serialization) #:select (nar-error? nar-error-file)) #:use-module (guix nar) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix build syscalls) #:select (fcntl-flock set-thread-name)) #:use-module ((guix build utils) #:select (which mkdir-p)) #:use-module (guix ui) + #:use-module (guix diagnostics) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -65,14 +67,16 @@ ;;; ;;; Code: - (define-record-type* <build-machine> build-machine make-build-machine build-machine? (name build-machine-name) ; string (port build-machine-port ; number (default 22)) - (system build-machine-system) ; string + (systems %build-machine-systems ; list of strings + (default #f)) ; drop default after system is removed + (system %build-machine-system ; deprecated + (default #f)) (user build-machine-user) ; string (private-key build-machine-private-key ; file name (default (user-openssh-private-key))) @@ -90,6 +94,19 @@ (features build-machine-features ; list of strings (default '()))) +;;; Deprecated. +(define (build-machine-system machine) + (warning (G_ "The 'system' field is deprecated, \ +please use 'systems' instead.~%")) + (%build-machine-system machine)) + +;;; TODO: Remove after the deprecated 'system' field is removed. +(define (build-machine-systems machine) + (or (%build-machine-systems machine) + (list (build-machine-system machine)) + (leave (G_ "The build-machine object lacks a value for its 'systems' +field.")))) + (define-record-type* <build-requirements> build-requirements make-build-requirements build-requirements? @@ -156,10 +173,9 @@ can interpret meaningfully." (lambda () (private-key-from-file file)) (lambda (key proc str . rest) - (raise (condition - (&message (message (format #f (G_ "failed to load SSH \ + (raise (formatted-message (G_ "failed to load SSH \ private key from '~a': ~a") - file str)))))))) + file str))))) (define* (open-ssh-session machine #:optional (max-silent-time -1)) "Open an SSH session for MACHINE and return it. Throw an error on failure." @@ -359,8 +375,8 @@ of free disk space on '~a'~%") (define (machine-matches? machine requirements) "Return #t if MACHINE matches REQUIREMENTS." - (and (string=? (build-requirements-system requirements) - (build-machine-system machine)) + (and (member (build-requirements-system requirements) + (build-machine-systems machine)) (lset<= string=? (build-requirements-features requirements) (build-machine-features machine)))) @@ -779,7 +795,8 @@ machine." (("--version") (show-version-and-exit "guix offload")) (("--help") - (format #t (G_ "Usage: guix offload SYSTEM PRINT-BUILD-TRACE + (format #t (G_ "Usage: guix offload SYSTEM MAX-SILENT-TIME \ +PRINT-BUILD-TRACE? BUILD-TIMEOUT Process build offload requests written on the standard input, possibly offloading builds to the machines listed in '~a'.~%") %machine-file) |