diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/r.scm | 2 | ||||
| -rw-r--r-- | guix/import/cran.scm | 4 | ||||
| -rw-r--r-- | guix/inferior.scm | 12 | ||||
| -rw-r--r-- | guix/licenses.scm | 6 | ||||
| -rw-r--r-- | guix/packages.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 40 | ||||
| -rw-r--r-- | guix/scripts/system/reconfigure.scm | 20 |
7 files changed, 58 insertions, 30 deletions
diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm index 620822b870..9b360ae581 100644 --- a/guix/build-system/r.scm +++ b/guix/build-system/r.scm @@ -61,7 +61,7 @@ release corresponding to NAME and VERSION." "/src/contrib/" name "_" version ".tar.gz") ;; TODO: use %bioconductor-version from (guix import cran) - (string-append "https://bioconductor.org/packages/3.15" + (string-append "https://bioconductor.org/packages/3.16" type-url-part "/src/contrib/" name "_" version ".tar.gz")))) diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 278743d496..286a4c21b9 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -188,9 +188,9 @@ package definition." (define %cran-canonical-url "https://cran.r-project.org/package=") (define %bioconductor-url "https://bioconductor.org/packages/") -;; The latest Bioconductor release is 3.15. Bioconductor packages should be +;; The latest Bioconductor release is 3.16. Bioconductor packages should be ;; updated together. -(define %bioconductor-version "3.15") +(define %bioconductor-version "3.16") (define* (bioconductor-packages-list-url #:optional type) (string-append "https://bioconductor.org/packages/" diff --git a/guix/inferior.scm b/guix/inferior.scm index 2fe34ca0dc..defdcc4e48 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -69,6 +69,8 @@ inferior-exception-arguments inferior-exception-inferior inferior-exception-stack + inferior-protocol-error? + inferior-protocol-error-inferior read-repl-response inferior-packages @@ -314,6 +316,10 @@ equivalent. Return #f if the inferior could not be launched." (inferior inferior-exception-inferior) ;<inferior> | #f (stack inferior-exception-stack)) ;list of (FILE COLUMN LINE) +(define-condition-type &inferior-protocol-error &error + inferior-protocol-error? + (inferior inferior-protocol-error-inferior)) ;<inferior> + (define* (read-repl-response port #:optional inferior) "Read a (guix repl) response from PORT and return it as a Scheme object. Raise '&inferior-exception' when an exception is read from PORT." @@ -339,7 +345,11 @@ Raise '&inferior-exception' when an exception is read from PORT." (raise (condition (&inferior-exception (arguments (cons key (map sexp->object objects))) (inferior inferior) - (stack '()))))))) + (stack '()))))) + (_ + ;; Protocol error. + (raise (condition (&inferior-protocol-error + (inferior inferior))))))) (define (read-inferior-response inferior) (read-repl-response (inferior-socket inferior) diff --git a/guix/licenses.scm b/guix/licenses.scm index 80cf0f1114..632c9174df 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -57,6 +57,7 @@ edl1.0 epl1.0 epl2.0 + eupl1.1 eupl1.2 expat expat-0 freetype @@ -344,6 +345,11 @@ at URI, which may be a file:// URI pointing the package's tree." "https://www.eclipse.org/legal/epl-2.0/" "https://www.gnu.org/licenses/license-list#EPL2")) +(define eupl1.1 + (license "EUPL 1.1" + "https://directory.fsf.org/wiki/License:EUPL-1.1" + "https://www.gnu.org/licenses/license-list#EUPL-1.1")) + (define eupl1.2 (license "EUPL 1.2" "https://directory.fsf.org/wiki/License:EUPL-1.2" diff --git a/guix/packages.scm b/guix/packages.scm index 704b4ee710..502df7fdd1 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1176,9 +1176,9 @@ inputs of Coreutils and adds libcap: (modify-inputs (package-inputs coreutils) (delete \"gmp\" \"acl\") - (append libcap)) + (prepend libcap)) -Other types of clauses include 'prepend' and 'replace'. +Other types of clauses include 'append' and 'replace'. The first argument must be a labeled input list; the result is also a labeled input list." diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 925325ef5f..578b3b9888 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -25,7 +25,7 @@ #:autoload (ssh auth) (userauth-public-key!) #:autoload (ssh session) (make-session connect! get-error - disconnect! session-set!) + disconnect! session-set! session-get) #:autoload (ssh version) (zlib-support?) #:use-module (guix config) #:use-module (guix records) @@ -34,7 +34,8 @@ send-files retrieve-files retrieve-files* remote-inferior report-guile-error) #:use-module (guix store) - #:autoload (guix inferior) (inferior-eval close-inferior inferior?) + #:autoload (guix inferior) (inferior-eval close-inferior + inferior? inferior-protocol-error?) #:autoload (guix derivations) (read-derivation-from-file derivation-file-name build-derivations) @@ -111,7 +112,7 @@ ;; A #f value tells the offload scheduler to disregard the load of the build ;; machine when selecting the best offload machine. (overload-threshold build-machine-overload-threshold ; inexact real between - (default 0.6)) ; 0.0 and 1.0 | #f + (default 0.8)) ; 0.0 and 1.0 | #f (parallel-builds build-machine-parallel-builds ; number (default 1)) (speed build-machine-speed ; inexact real @@ -473,6 +474,15 @@ logical cores available, to give a rough estimation of CPU usage. Return (vector-set! vec j (vector-ref vec (- i 1))) (loop (cons val result) (- i 1)))))))) +(define (remote-inferior* session) + "Like 'remote-inferior', but upon error return #f." + (or (guard (c ((inferior-protocol-error? c) #f)) + (remote-inferior session)) + (begin + (warning (G_ "failed to run 'guix repl' on machine '~a'~%") + (session-get session 'host)) + #f))) + (define (choose-build-machine machines) "Return two values: the best machine among MACHINES and its build slot (which must later be released with 'release-build-slot'), or #f and #f." @@ -511,7 +521,7 @@ slot (which must later be released with 'release-build-slot'), or #f and #f." ;; too costly to call it once for every machine. (let* ((session (false-if-exception (open-ssh-session best %short-timeout))) - (node (and session (remote-inferior session))) + (node (and session (remote-inferior* session))) (load (and node (node-load node))) (threshold (build-machine-overload-threshold best)) (space (and node (node-free-disk-space node)))) @@ -708,6 +718,11 @@ machine." (and (string=? (build-machine-name m1) (build-machine-name m2)) (= (build-machine-port m1) (build-machine-port m2)))) + (define (if-true proc) + (lambda args + (when (every ->bool args) + (apply proc args)))) + ;; A given build machine may appear several times (e.g., once for ;; "x86_64-linux" and a second time for "i686-linux"); test them only once. (let ((machines (filter pred @@ -718,12 +733,12 @@ machine." (let* ((names (map build-machine-name machines)) (sockets (map build-machine-daemon-socket machines)) (sessions (map (cut open-ssh-session <> %short-timeout) machines)) - (nodes (map remote-inferior sessions))) - (for-each assert-node-has-guix nodes names) - (for-each assert-node-repl nodes names) - (for-each assert-node-can-import sessions nodes names sockets) - (for-each assert-node-can-export sessions nodes names sockets) - (for-each close-inferior nodes) + (nodes (map remote-inferior* sessions))) + (for-each (if-true assert-node-has-guix) nodes names) + (for-each (if-true assert-node-repl) nodes names) + (for-each (if-true assert-node-can-import) sessions nodes names sockets) + (for-each (if-true assert-node-can-export) sessions nodes names sockets) + (for-each (if-true close-inferior) nodes) (for-each disconnect! sessions)))) (define (check-machine-status machine-file pred) @@ -743,10 +758,9 @@ machine." (define session (open-ssh-session machine %short-timeout)) - (match (remote-inferior session) + (match (remote-inferior* session) (#f - (warning (G_ "failed to run 'guix repl' on machine '~a'~%") - (build-machine-name machine))) + #f) ((? inferior? inferior) (let ((now (car (gettimeofday)))) (match (inferior-eval '(list (uname) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index afd410d4bc..544aacfef4 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -40,9 +40,9 @@ #:use-module (guix diagnostics) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module ((guix config) #:select (%guix-package-name)) #:export (switch-system-program switch-to-system @@ -184,8 +184,8 @@ services as defined by OS." #:target-type shepherd-root-service-type)))) (mlet* %store-monad ((live-services (running-services eval))) - (let*-values (((to-unload to-restart) - (shepherd-service-upgrade live-services target-services))) + (let ((to-unload to-restart + (shepherd-service-upgrade live-services target-services))) (let* ((to-unload (map live-service-canonical-name to-unload)) (to-restart (map shepherd-service-canonical-name to-restart)) (running (map live-service-canonical-name @@ -347,14 +347,12 @@ to commits of channels in NEW." (channel-name old))) new))) (and new - (let-values (((checkout commit relation) - (update-cached-checkout - (channel-url new) - #:ref - `(commit . ,(channel-commit new)) - #:starting-commit - (channel-commit old) - #:check-out? #f))) + (let ((checkout commit relation + (update-cached-checkout + (channel-url new) + #:ref `(commit . ,(channel-commit new)) + #:starting-commit (channel-commit old) + #:check-out? #f))) (list new (channel-commit old) (channel-commit new) relation))))) |