diff options
Diffstat (limited to 'guix')
30 files changed, 623 insertions, 440 deletions
diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm index 57e294d74d..af04084c86 100644 --- a/guix/build-system/asdf.scm +++ b/guix/build-system/asdf.scm @@ -172,7 +172,7 @@ set up using CL source package conventions." ;; Special considerations for source packages: CL inputs become ;; propagated, and un-handled arguments are removed. - (define new-propagated-inputs + (define (new-propagated-inputs) (if target-is-source? (map rewrite (append @@ -218,7 +218,7 @@ set up using CL source package conventions." (substitute-keyword-arguments base-arguments ((#:phases phases) (list phases-transformer phases)))) (inputs (new-inputs package-inputs)) - (propagated-inputs new-propagated-inputs) + (propagated-inputs (new-propagated-inputs)) (native-inputs (new-inputs package-native-inputs)) (outputs (if target-is-source? '("out") diff --git a/guix/build-system/texlive.scm b/guix/build-system/texlive.scm index 80882b144b..b6a86a1c62 100644 --- a/guix/build-system/texlive.scm +++ b/guix/build-system/texlive.scm @@ -39,9 +39,10 @@ ;; ;; Code: -;; These variables specify the SVN tag and the matching SVN revision. -(define %texlive-tag "texlive-2017.1") -(define %texlive-revision 44591) +;; These variables specify the SVN tag and the matching SVN revision. They +;; are taken from https://www.tug.org/svn/texlive/tags/ +(define %texlive-tag "texlive-2018.2") +(define %texlive-revision 49435) (define (texlive-ref component id) "Return a <svn-reference> object for the package ID, which is part of the diff --git a/guix/build/compile.scm b/guix/build/compile.scm index 5a1363556a..215489f136 100644 --- a/guix/build/compile.scm +++ b/guix/build/compile.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -26,28 +26,22 @@ #:use-module (system base message) #:use-module (guix modules) #:use-module (guix build utils) + #:use-module (language tree-il optimize) + #:use-module (language cps optimize) #:export (%default-optimizations %lightweight-optimizations compile-files)) ;;; Commentary: ;;; -;;; Support code to compile Guile code as efficiently as possible (both with -;;; Guile 2.0 and 2.2). +;;; Support code to compile Guile code as efficiently as possible (with 2.2). ;;; ;;; Code: -(cond-expand - (guile-2.2 (use-modules (language tree-il optimize) - (language cps optimize))) - (else #f)) - (define %default-optimizations ;; Default optimization options (equivalent to -O2 on Guile 2.2). - (cond-expand - (guile-2.2 (append (tree-il-default-optimization-options) - (cps-default-optimization-options))) - (else '()))) + (append (tree-il-default-optimization-options) + (cps-default-optimization-options))) (define %lightweight-optimizations ;; Lightweight optimizations (like -O0, but with partial evaluation). diff --git a/guix/build/download-nar.scm b/guix/build/download-nar.scm index 13f01fb1e8..681f22238d 100644 --- a/guix/build/download-nar.scm +++ b/guix/build/download-nar.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -93,8 +93,8 @@ ITEM." "Download and extract the normalized archive for ITEM. Return #t on success, #f otherwise." ;; Let progress reports go through. - (setvbuf (current-error-port) _IONBF) - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-error-port) 'none) + (setvbuf (current-output-port) 'none) (let loop ((urls (urls-for-item item))) (match urls diff --git a/guix/build/download.scm b/guix/build/download.scm index 54163849a2..c08221b3b2 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; @@ -314,9 +314,7 @@ host name without trailing dot." ;; Write HTTP requests line by line rather than byte by byte: ;; <https://bugs.gnu.org/22966>. This is possible with Guile >= 2.2. - (cond-expand - (guile-2.2 (setvbuf record 'line)) - (else #f)) + (setvbuf record 'line) record))) @@ -359,7 +357,7 @@ ETIMEDOUT error is raised." (connect* s (addrinfo:addr ai) timeout) ;; Buffer input and output on this port. - (setvbuf s _IOFBF) + (setvbuf s 'block) ;; If we're using a proxy, make a note of that. (when http-proxy (set-http-proxy-port?! s #t)) s) @@ -403,7 +401,7 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (with-https-proxy (let ((s (open-socket-for-uri uri #:timeout timeout))) ;; Buffer input and output on this port. - (setvbuf s _IOFBF %http-receive-buffer-size) + (setvbuf s 'block %http-receive-buffer-size) (if https? (tls-wrap s (uri-host uri) @@ -506,18 +504,6 @@ port if PORT is a TLS session record port." (module-set! (resolve-module '(web http)) 'parse-rfc-822-date parse-rfc-822-date)) -;; XXX: Work around <http://bugs.gnu.org/19840>, present in Guile -;; up to 2.0.11. -(unless (or (> (string->number (major-version)) 2) - (> (string->number (minor-version)) 0) - (> (string->number (micro-version)) 11)) - (let ((var (module-variable (resolve-module '(web http)) - 'declare-relative-uri-header!))) - ;; If 'declare-relative-uri-header!' doesn't exist, forget it. - (when (and var (variable-bound? var)) - (let ((declare-relative-uri-header! (variable-ref var))) - (declare-relative-uri-header! "Location"))))) - ;; XXX: Work around broken proxy handling on Guile 2.2 <= 2.2.2, fixed in ;; Guile commits 7d0d9e2c25c1e872cfc7d14ab5139915f1813d56 and ;; 6ad28ae3bc6a6d9e95ab7d70510d12c97673a143. See bug report at @@ -791,11 +777,11 @@ otherwise simply ignore them." hashes)) content-addressed-mirrors)) - ;; Make this unbuffered so 'progress-report/file' works as expected. _IOLBF + ;; Make this unbuffered so 'progress-report/file' works as expected. 'line ;; means '\n', not '\r', so it's not appropriate here. - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-output-port) 'none) - (setvbuf (current-error-port) _IOLBF) + (setvbuf (current-error-port) 'line) (let try ((uri (append uri content-addressed-uris))) (match uri diff --git a/guix/build/make-bootstrap.scm b/guix/build/make-bootstrap.scm index 43b136248f..48799f7e90 100644 --- a/guix/build/make-bootstrap.scm +++ b/guix/build/make-bootstrap.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2017 Manolis Fragkiskos Ragkousis <manolis837@gmail.com> -;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -67,7 +67,7 @@ when producing a bootstrap libc." util).*\\.so(\\..*)?|lib(machuser|hurduser).so.*|(libc(rt|)|libpthread)\ _nonshared\\.a)$") - (setvbuf (current-output-port) _IOLBF) + (setvbuf (current-output-port) 'line) (let* ((libdir (string-append output "/lib"))) (mkdir-p libdir) (for-each (lambda (file) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 56a689f667..d75c11ada7 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 David Thompson <davet@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> @@ -699,39 +699,31 @@ mounted at FILE." (define CLONE_NEWPID #x20000000) (define CLONE_NEWNET #x40000000) -(cond-expand - (guile-2.2 - (define %set-automatic-finalization-enabled?! - ;; When using a statically-linked Guile, for instance in the initrd, we - ;; cannot resolve this symbol, but most of the time we don't need it - ;; anyway. Thus, delay it. - (let ((proc (delay - (pointer->procedure int - (dynamic-func - "scm_set_automatic_finalization_enabled" - (dynamic-link)) - (list int))))) - (lambda (enabled?) - "Switch on or off automatic finalization in a separate thread. +(define %set-automatic-finalization-enabled?! + ;; When using a statically-linked Guile, for instance in the initrd, we + ;; cannot resolve this symbol, but most of the time we don't need it + ;; anyway. Thus, delay it. + (let ((proc (delay + (pointer->procedure int + (dynamic-func + "scm_set_automatic_finalization_enabled" + (dynamic-link)) + (list int))))) + (lambda (enabled?) + "Switch on or off automatic finalization in a separate thread. Turning finalization off shuts down the finalization thread as a side effect." - (->bool ((force proc) (if enabled? 1 0)))))) - - (define-syntax-rule (without-automatic-finalization exp) - "Turn off automatic finalization within the dynamic extent of EXP." - (let ((enabled? #t)) - (dynamic-wind - (lambda () - (set! enabled? (%set-automatic-finalization-enabled?! #f))) - (lambda () - exp) - (lambda () - (%set-automatic-finalization-enabled?! enabled?)))))) - - (else - (define-syntax-rule (without-automatic-finalization exp) - ;; Nothing to do here: Guile 2.0 does not have a separate finalization - ;; thread. - exp))) + (->bool ((force proc) (if enabled? 1 0)))))) + +(define-syntax-rule (without-automatic-finalization exp) + "Turn off automatic finalization within the dynamic extent of EXP." + (let ((enabled? #t)) + (dynamic-wind + (lambda () + (set! enabled? (%set-automatic-finalization-enabled?! #f))) + (lambda () + exp) + (lambda () + (%set-automatic-finalization-enabled?! enabled?))))) ;; The libc interface to sys_clone is not useful for Scheme programs, so the ;; low-level system call is wrapped instead. The 'syscall' function is diff --git a/guix/build/texlive-build-system.scm b/guix/build/texlive-build-system.scm index 1c393ecd9d..841c631dae 100644 --- a/guix/build/texlive-build-system.scm +++ b/guix/build/texlive-build-system.scm @@ -35,7 +35,7 @@ (define (compile-with-latex format file) (invoke format - "-interaction=batchmode" + "-interaction=nonstopmode" "-output-directory=build" (string-append "&" format) file)) @@ -60,7 +60,12 @@ (("^TEXMF = .*") "TEXMF = $TEXMFROOT/share/texmf-dist\n")) (setenv "TEXMFCNF" (dirname texmf.cnf)) - (setenv "TEXMF" (string-append out "/share/texmf-dist"))) + (setenv "TEXMF" (string-append out "/share/texmf-dist")) + + ;; Don't truncate lines. + (setenv "error_line" "254") ; must be less than 255 + (setenv "half_error_line" "238") ; must be less than error_line - 15 + (setenv "max_print_line" "1000")) (mkdir "build") #t) diff --git a/guix/build/union.scm b/guix/build/union.scm index fff795c4d3..961ac3298b 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com> ;;; @@ -39,6 +39,19 @@ ;;; ;;; Code: +;; This code can be used with the bootstrap Guile, which is Guile 2.0, so +;; provide a compatibility layer. +(cond-expand + ((and guile-2 (not guile-2.2)) + (define (setvbuf port mode . rest) + (apply (@ (guile) setvbuf) port + (match mode + ('line _IOLBF) + ('block _IOFBF) + ('none _IONBF)) + rest))) + (else #f)) + (define (files-in-directory dirname) (let ((dir (opendir dirname))) (let loop ((files '())) @@ -179,10 +192,10 @@ returns #f, skip the faulty file altogether." (reverse dirs-with-file)))) table))) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF) + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) (when (file-port? log-port) - (setvbuf log-port _IOLBF)) + (setvbuf log-port 'line)) (union-of-directories output (delete-duplicates inputs))) diff --git a/guix/deprecation.scm b/guix/deprecation.scm new file mode 100644 index 0000000000..453aad7106 --- /dev/null +++ b/guix/deprecation.scm @@ -0,0 +1,89 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix deprecation) + #:use-module (guix i18n) + #:use-module (ice-9 format) + #:export (define-deprecated + without-deprecation-warnings + deprecation-warning-port)) + +;;; Commentary: +;;; +;;; Provide a mechanism to mark bindings as deprecated. +;;; +;;; We don't reuse (guix ui) mostly to avoid pulling in too many things. +;;; +;;; Code: + +(define deprecation-warning-port + ;; Port where deprecation warnings go. + (make-parameter (current-warning-port))) + +(define (source-properties->location-string properties) + "Return a human-friendly, GNU-standard representation of PROPERTIES, a +source property alist." + (let ((file (assq-ref properties 'filename)) + (line (assq-ref properties 'line)) + (column (assq-ref properties 'column))) + (if (and file line column) + (format #f "~a:~a:~a" file (+ 1 line) column) + (G_ "<unknown location>")))) + +(define* (warn-about-deprecation variable properties + #:key replacement) + (format (deprecation-warning-port) + (G_ "~a: warning: '~a' is deprecated~@[, use '~a' instead~]~%") + (source-properties->location-string properties) + variable replacement)) + +(define-syntax define-deprecated + (lambda (s) + "Define a deprecated variable or procedure, along these lines: + + (define-deprecated foo bar 42) + (define-deprecated (baz x y) qux (qux y x)) + +This will write a deprecation warning to DEPRECATION-WARNING-PORT." + (syntax-case s () + ((_ (proc formals ...) replacement body ...) + #'(define-deprecated proc replacement + (lambda* (formals ...) body ...))) + ((_ variable replacement exp) + (identifier? #'variable) + (with-syntax ((real (datum->syntax + #'variable + (symbol-append '% + (syntax->datum #'variable) + '/deprecated)))) + #`(begin + (define real + (begin + (lambda () replacement) ;just to ensure it's bound + exp)) + + (define-syntax variable + (lambda (s) + (warn-about-deprecation 'variable (syntax-source s) + #:replacement 'replacement) + (syntax-case s () + ((_ args (... ...)) + #'(real args (... ...))) + (id + (identifier? #'id) + #'real)))))))))) diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index 0b8f61c276..8d5adcb8ed 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -154,7 +154,7 @@ TIMEOUT, an ETIMEDOUT error is raised." (catch 'system-error (lambda () (connect* s (addrinfo:addr ai) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (let-values (((code message) (%ftp-listen s))) (if (eqv? code 220) (begin @@ -237,7 +237,7 @@ TIMEOUT, an ETIMEDOUT error is raised." (s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (addrinfo:protocol ai)))) (connect* s (address-with-port (addrinfo:addr ai) port) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (dynamic-wind (lambda () #t) @@ -293,7 +293,7 @@ must be closed before CONN can be used for other purposes." (throw 'ftp-error conn "LIST" code message)))) (connect* s (address-with-port (addrinfo:addr ai) port) timeout) - (setvbuf s _IOLBF) + (setvbuf s 'line) (%ftp-command (string-append "RETR " file) 150 (ftp-connection-socket conn)) diff --git a/guix/http-client.scm b/guix/http-client.scm index 07360e6108..067002a79a 100644 --- a/guix/http-client.scm +++ b/guix/http-client.scm @@ -97,7 +97,7 @@ Raise an '&http-get-error' condition if downloading fails." headers)) (_ headers)))) (unless (or buffered? (not (file-port? port))) - (setvbuf port _IONBF)) + (setvbuf port 'none)) (let*-values (((resp data) (http-get uri #:streaming? #t #:port port #:keep-alive? #t diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 15163bd165..b287be6941 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2018 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; @@ -390,11 +390,11 @@ s-expression corresponding to that package, or #f on failure." (_ #f))) (_ #f))))) -(define (latest-cran-release package) - "Return an <upstream-source> for the latest release of PACKAGE." +(define (latest-cran-release pkg) + "Return an <upstream-source> for the latest release of the package PKG." (define upstream-name - (package->upstream-name package)) + (package->upstream-name pkg)) (define meta (fetch-description 'cran upstream-name)) @@ -403,15 +403,18 @@ s-expression corresponding to that package, or #f on failure." (let ((version (assoc-ref meta "Version"))) ;; CRAN does not provide signatures. (upstream-source - (package (package-name package)) + (package (package-name pkg)) (version version) - (urls (cran-uri upstream-name version)))))) + (urls (cran-uri upstream-name version)) + (input-changes + (changed-inputs pkg + (description->package 'cran meta))))))) -(define (latest-bioconductor-release package) - "Return an <upstream-source> for the latest release of PACKAGE." +(define (latest-bioconductor-release pkg) + "Return an <upstream-source> for the latest release of the package PKG." (define upstream-name - (package->upstream-name package)) + (package->upstream-name pkg)) (define version (latest-bioconductor-package-version upstream-name)) @@ -419,9 +422,13 @@ s-expression corresponding to that package, or #f on failure." (and version ;; Bioconductor does not provide signatures. (upstream-source - (package (package-name package)) + (package (package-name pkg)) (version version) - (urls (bioconductor-uri upstream-name version))))) + (urls (bioconductor-uri upstream-name version)) + (input-changes + (changed-inputs + pkg + (cran->guix-package upstream-name 'bioconductor)))))) (define (cran-package? package) "Return true if PACKAGE is an R package from CRAN." diff --git a/guix/inferior.scm b/guix/inferior.scm index 973bd5264e..ba8d00866b 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -137,9 +137,7 @@ it's an old Guix." "Given PIPE, an input/output port, return an inferior that talks over PIPE. PIPE is closed with CLOSE when 'close-inferior' is called on the returned inferior." - (cond-expand - ((and guile-2 (not guile-2.2)) #t) - (else (setvbuf pipe 'line))) + (setvbuf pipe 'line) (match (read pipe) (('repl-version 0 rest ...) @@ -391,8 +389,8 @@ input/output ports.)" ;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. - (setvbuf client _IOFBF 65536) - (setvbuf backend _IOFBF 65536) + (setvbuf client 'block 65536) + (setvbuf backend 'block 65536) (let loop () (match (select* (list client backend) '() '()) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index fb2f61ce30..950f0f41d8 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +23,7 @@ #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix serialization) #:select (restore-file)) #:use-module (guix store) + #:use-module (guix status) #:use-module (guix grafts) #:use-module (guix packages) #:use-module (guix derivations) @@ -55,7 +56,11 @@ (substitutes? . #t) (build-hook? . #t) (graft? . #t) - (verbosity . 0))) + (print-build-trace? . #t) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) + (verbosity . 2) + (debug . 0))) (define (show-help) (display (G_ "Usage: guix archive [OPTION]... PACKAGE... @@ -85,6 +90,8 @@ Export/import one or more packages from/to the store.\n")) -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (G_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (show-build-options-help) @@ -161,6 +168,11 @@ Export/import one or more packages from/to the store.\n")) (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) @@ -239,7 +251,6 @@ build and a list of store files to transfer." resulting archive to the standard output port." (let-values (((drv files) (options->derivations+files store opts))) - (set-build-options-from-command-line store opts) (show-what-to-build store drv #:use-substitutes? (assoc-ref opts 'substitutes?) #:dry-run? (assoc-ref opts 'dry-run?)) @@ -329,21 +340,23 @@ the input port." ((assoc-ref opts 'authorize) (authorize-key)) (else - (with-store store - (cond ((assoc-ref opts 'export) - (export-from-store store opts)) - ((assoc-ref opts 'import) - (import-paths store (current-input-port))) - ((assoc-ref opts 'missing) - (let* ((files (lines (current-input-port))) - (missing (remove (cut valid-path? store <>) - files))) - (format #t "~{~a~%~}" missing))) - ((assoc-ref opts 'extract) - => - (lambda (target) - (restore-file (current-input-port) target))) - (else - (leave - (G_ "either '--export' or '--import' \ -must be specified~%")))))))))))) + (with-status-verbosity (assoc-ref opts 'verbosity) + (with-store store + (set-build-options-from-command-line store opts) + (cond ((assoc-ref opts 'export) + (export-from-store store opts)) + ((assoc-ref opts 'import) + (import-paths store (current-input-port))) + ((assoc-ref opts 'missing) + (let* ((files (lines (current-input-port))) + (missing (remove (cut valid-path? store <>) + files))) + (format #t "~{~a~%~}" missing))) + ((assoc-ref opts 'extract) + => + (lambda (target) + (restore-file (current-input-port) target))) + (else + (leave + (G_ "either '--export' or '--import' \ +must be specified~%"))))))))))))) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 564bdf0ced..5a158799ae 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -450,13 +450,13 @@ options handled by 'set-build-options-from-command-line', and listed in (display (G_ " --timeout=SECONDS mark the build as failed after SECONDS of activity")) (display (G_ " - --verbosity=LEVEL use the given verbosity LEVEL")) - (display (G_ " --rounds=N build N times in a row to detect non-determinism")) (display (G_ " -c, --cores=N allow the use of up to N CPU cores for the build")) (display (G_ " - -M, --max-jobs=N allow at most N build jobs"))) + -M, --max-jobs=N allow at most N build jobs")) + (display (G_ " + --debug=LEVEL produce debugging output at LEVEL"))) (define (set-build-options-from-command-line store opts) "Given OPTS, an alist as returned by 'args-fold' given @@ -479,7 +479,7 @@ options handled by 'set-build-options-from-command-line', and listed in (assoc-ref opts 'print-extended-build-trace?) #:multiplexed-build-output? (assoc-ref opts 'multiplexed-build-output?) - #:verbosity (assoc-ref opts 'verbosity))) + #:verbosity (assoc-ref opts 'debug))) (define set-build-options-from-command-line* (store-lift set-build-options-from-command-line)) @@ -553,12 +553,12 @@ options handled by 'set-build-options-from-command-line', and listed in (apply values (alist-cons 'timeout (string->number* arg) result) rest))) - (option '("verbosity") #t #f + (option '("debug") #t #f (lambda (opt name arg result . rest) - (let ((level (string->number arg))) + (let ((level (string->number* arg))) (apply values - (alist-cons 'verbosity level - (alist-delete 'verbosity result)) + (alist-cons 'debug level + (alist-delete 'debug result)) rest)))) (option '(#\c "cores") #t #f (lambda (opt name arg result . rest) @@ -590,7 +590,8 @@ options handled by 'set-build-options-from-command-line', and listed in (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0))) + (verbosity . 2) + (debug . 0))) (define (show-help) (display (G_ "Usage: guix build [OPTION]... PACKAGE-OR-DERIVATION... @@ -619,6 +620,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) -r, --root=FILE make FILE a symlink to the result, and register it as a garbage collector root")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " -q, --quiet do not show the build log")) (display (G_ " --log-file return the log file names for the given derivations")) @@ -694,9 +697,15 @@ must be one of 'package', 'all', or 'transitive'~%") (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\q "quiet") #f #f (lambda (opt name arg result) - (alist-cons 'quiet? #t result))) + (alist-cons 'verbosity 0 + (alist-delete 'verbosity result)))) (option '("log-file") #f #f (lambda (opt name arg result) (alist-cons 'log-file? #t result))) @@ -819,66 +828,59 @@ needed." (parse-command-line args %options (list %default-options))) - (define quiet? - (assoc-ref opts 'quiet?)) - (with-error-handling ;; Ask for absolute file names so that .drv file names passed from the ;; user to 'read-derivation' are absolute when it returns. (with-fluids ((%file-port-name-canonicalization 'absolute)) - (with-store store - ;; Set the build options before we do anything else. - (set-build-options-from-command-line store opts) - - (parameterize ((current-terminal-columns (terminal-columns)) - (current-build-output-port - (if quiet? - (%make-void-port "w") - (build-event-output-port - (build-status-updater print-build-event))))) - (let* ((mode (assoc-ref opts 'build-mode)) - (drv (options->derivations store opts)) - (urls (map (cut string-append <> "/log") - (if (assoc-ref opts 'substitutes?) - (or (assoc-ref opts 'substitute-urls) - ;; XXX: This does not necessarily match the - ;; daemon's substitute URLs. - %default-substitute-urls) - '()))) - (items (filter-map (match-lambda - (('argument . (? store-path? file)) - file) - (_ #f)) - opts)) - (roots (filter-map (match-lambda - (('gc-root . root) root) - (_ #f)) - opts))) - - (unless (or (assoc-ref opts 'log-file?) - (assoc-ref opts 'derivations-only?)) - (show-what-to-build store drv - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? (assoc-ref opts 'dry-run?) - #:mode mode)) - - (cond ((assoc-ref opts 'log-file?) - (for-each (cut show-build-log store <> urls) - (delete-duplicates - (append (map derivation-file-name drv) - items)))) - ((assoc-ref opts 'derivations-only?) - (format #t "~{~a~%~}" (map derivation-file-name drv)) - (for-each (cut register-root store <> <>) - (map (compose list derivation-file-name) drv) - roots)) - ((not (assoc-ref opts 'dry-run?)) - (and (build-derivations store drv mode) - (for-each show-derivation-outputs drv) - (for-each (cut register-root store <> <>) - (map (lambda (drv) - (map cdr - (derivation->output-paths drv))) - drv) - roots)))))))))) + (with-status-verbosity (assoc-ref opts 'verbosity) + (with-store store + ;; Set the build options before we do anything else. + (set-build-options-from-command-line store opts) + + (parameterize ((current-terminal-columns (terminal-columns))) + (let* ((mode (assoc-ref opts 'build-mode)) + (drv (options->derivations store opts)) + (urls (map (cut string-append <> "/log") + (if (assoc-ref opts 'substitutes?) + (or (assoc-ref opts 'substitute-urls) + ;; XXX: This does not necessarily match the + ;; daemon's substitute URLs. + %default-substitute-urls) + '()))) + (items (filter-map (match-lambda + (('argument . (? store-path? file)) + file) + (_ #f)) + opts)) + (roots (filter-map (match-lambda + (('gc-root . root) root) + (_ #f)) + opts))) + + (unless (or (assoc-ref opts 'log-file?) + (assoc-ref opts 'derivations-only?)) + (show-what-to-build store drv + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? (assoc-ref opts 'dry-run?) + #:mode mode)) + + (cond ((assoc-ref opts 'log-file?) + (for-each (cut show-build-log store <> urls) + (delete-duplicates + (append (map derivation-file-name drv) + items)))) + ((assoc-ref opts 'derivations-only?) + (format #t "~{~a~%~}" (map derivation-file-name drv)) + (for-each (cut register-root store <> <>) + (map (compose list derivation-file-name) drv) + roots)) + ((not (assoc-ref opts 'dry-run?)) + (and (build-derivations store drv mode) + (for-each show-derivation-outputs drv) + (for-each (cut register-root store <> <>) + (map (lambda (drv) + (map cdr + (derivation->output-paths drv))) + drv) + roots))))))))))) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 86e1eb115f..116b8dcbce 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015, 2018 David Thompson <davet@gnu.org> -;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -158,6 +158,8 @@ COMMAND or an interactive shell in that environment.\n")) --expose=SPEC for containers, expose read-only host file system according to SPEC")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " --bootstrap use bootstrap binaries to build the environment")) (newline) (show-build-options-help) @@ -179,7 +181,8 @@ COMMAND or an interactive shell in that environment.\n")) (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0))) + (debug . 0) + (verbosity . 2))) (define (tag-package-arg opts arg) "Return a two-element list with the form (TAG ARG) that tags ARG with either @@ -260,6 +263,11 @@ COMMAND or an interactive shell in that environment.\n")) (option '(#\r "root") #t #f (lambda (opt name arg result) (alist-cons 'gc-root arg result))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -674,7 +682,7 @@ message if any test fails." (leave (G_ "'--user' cannot be used without '--container'~%"))) (with-store store - (with-status-report print-build-event + (with-status-verbosity (assoc-ref opts 'verbosity) (define manifest (options/resolve-packages store opts)) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 9acec48577..0f315a9352 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -8,7 +8,7 @@ ;;; Copyright © 2017 Alex Kost <alezost@gmail.com> ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2017, 2018 Efraim Flashner <efraim@flashner.co.il> -;;; Copyright © 2018 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2018, 2019 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -820,10 +820,11 @@ descriptions maintained upstream." (lambda (uri) (and=> (follow-redirects-to-github uri) (lambda (github-uri) - (emit-warning - package - (format #f (G_ "URL should be '~a'") github-uri) - 'source)))) + (unless (string=? github-uri uri) + (emit-warning + package + (format #f (G_ "URL should be '~a'") github-uri) + 'source))))) (origin-uris origin))))) (define (check-derivation package) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 98b06971bd..b19a4ae1b1 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2015, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017, 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2018 Konrad Hinsen <konrad.hinsen@fastmail.net> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> @@ -553,9 +553,7 @@ please email '~a'~%") "run.c" "-o" result) (delete-file "run.c"))) - (setvbuf (current-output-port) - (cond-expand (guile-2.2 'line) - (else _IOLBF))) + (setvbuf (current-output-port) 'line) ;; Link the top-level files of PACKAGE so that search paths are ;; properly defined in PROFILE/etc/profile. @@ -600,7 +598,8 @@ please email '~a'~%") (print-build-trace? . #t) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) - (verbosity . 0) + (debug . 0) + (verbosity . 2) (symlinks . ()) (compressor . ,(first %compressors)))) @@ -687,6 +686,11 @@ please email '~a'~%") (alist-cons 'profile-name arg result)) (_ (leave (G_ "~a: unsupported profile name~%") arg))))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -725,6 +729,8 @@ Create a bundle of PACKAGE.\n")) --profile-name=NAME populate /var/guix/profiles/.../NAME")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " --bootstrap use the bootstrap binaries to build the pack")) (newline) (display (G_ " @@ -774,7 +780,7 @@ Create a bundle of PACKAGE.\n")) (with-error-handling (with-store store - (with-status-report print-build-event + (with-status-verbosity (assoc-ref opts 'verbosity) ;; Set the build options before we do anything else. (set-build-options-from-command-line store opts) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5743816324..7ff6bfd6d8 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013, 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> @@ -293,7 +293,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (define %default-options ;; Alist of default option values. - `((verbosity . 0) + `((verbosity . 1) + (debug . 0) (graft? . #t) (substitutes? . #t) (build-hook? . #t) @@ -346,7 +347,7 @@ Install, remove, or upgrade packages in a single transaction.\n")) (display (G_ " --bootstrap use the bootstrap Guile to build the profile")) (display (G_ " - --verbose produce verbose output")) + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " -s, --search=REGEXP search in synopsis and description using REGEXP")) @@ -472,13 +473,21 @@ kind of search path~%") (values (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)) #f))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result arg-handler) + (let ((level (string->number* arg))) + (values (alist-cons 'verbosity level + (alist-delete 'verbosity result)) + #f)))) (option '("bootstrap") #f #f (lambda (opt name arg result arg-handler) (values (alist-cons 'bootstrap? #t result) #f))) - (option '("verbose") #f #f + (option '("verbose") #f #f ;deprecated (lambda (opt name arg result arg-handler) - (values (alist-cons 'verbose? #t result) + (values (alist-cons 'verbosity 2 + (alist-delete 'verbosity + result)) #f))) (option '("allow-collisions") #f #f (lambda (opt name arg result arg-handler) @@ -907,14 +916,12 @@ processed, #f otherwise." (define opts (parse-command-line args %options (list %default-options #f) #:argument-handler handle-argument)) - (define verbose? - (assoc-ref opts 'verbose?)) (with-error-handling (or (process-query opts) (parameterize ((%store (open-connection)) (%graft? (assoc-ref opts 'graft?))) - (with-status-report print-build-event/quiet + (with-status-verbosity (assoc-ref opts 'verbosity) (set-build-options-from-command-line (%store) opts) (parameterize ((%guile-for-build (package-derivation diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e7ff44c0d5..6d1914f7c2 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -66,7 +66,8 @@ (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) (graft? . #t) - (verbosity . 0))) + (debug . 0) + (verbosity . 2))) (define (show-help) (display (G_ "Usage: guix pull [OPTION]... @@ -89,6 +90,8 @@ Download and deploy the latest version of Guix.\n")) (display (G_ " -n, --dry-run show what would be pulled and built")) (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) + (display (G_ " -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (G_ " --bootstrap use the bootstrap Guile to build the new Guix")) @@ -135,6 +138,11 @@ Download and deploy the latest version of Guix.\n")) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '("bootstrap") #f #f (lambda (opt name arg result) (alist-cons 'bootstrap? #t result))) @@ -510,7 +518,7 @@ Use '~/.config/guix/channels.scm' instead.")) (process-query opts profile)) (else (with-store store - (with-status-report print-build-event + (with-status-verbosity (assoc-ref opts 'verbosity) (parameterize ((%current-system (assoc-ref opts 'system)) (%graft? (assoc-ref opts 'graft?)) (%repository-cache-directory cache)) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index 003c915da3..a0de9f6c10 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -1,11 +1,12 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org> ;;; Copyright © 2015 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Ben Woodcroft <donttrustben@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,7 +42,6 @@ #:use-module (ice-9 regex) #:use-module (ice-9 vlist) #:use-module (ice-9 format) - #:use-module (ice-9 threads) ; par-for-each #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -172,6 +172,79 @@ specified with `--select'.\n")) (newline) (show-bug-report-information)) +(define (options->packages opts) + "Return the list of packages requested by OPTS, honoring options like +'--recursive'." + (define core-package? + (let* ((input->package (match-lambda + ((name (? package? package) _ ...) package) + (_ #f))) + (final-inputs (map input->package %final-inputs)) + (core (append final-inputs + (append-map (compose (cut filter-map input->package <>) + package-transitive-inputs) + final-inputs))) + (names (delete-duplicates (map package-name core)))) + (lambda (package) + "Return true if PACKAGE is likely a \"core package\"---i.e., one whose +update would trigger a complete rebuild." + ;; Compare by name because packages in base.scm basically inherit + ;; other packages. So, even if those packages are not core packages + ;; themselves, updating them would also update those who inherit from + ;; them. + ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input. + (member (package-name package) names)))) + + (define (keep-newest package lst) + ;; If a newer version of PACKAGE is already in LST, return LST; otherwise + ;; return LST minus the other version of PACKAGE in it, plus PACKAGE. + (let ((name (package-name package))) + (match (find (lambda (p) + (string=? (package-name p) name)) + lst) + ((? package? other) + (if (version>? (package-version other) (package-version package)) + lst + (cons package (delq other lst)))) + (_ + (cons package lst))))) + + (define args-packages + ;; Packages explicitly passed as command-line arguments. + (match (filter-map (match-lambda + (('argument . spec) + ;; Take either the specified version or the + ;; latest one. + (specification->package spec)) + (('expression . exp) + (read/eval-package-expression exp)) + (_ #f)) + opts) + (() ;default to all packages + (let ((select? (match (assoc-ref opts 'select) + ('core core-package?) + ('non-core (negate core-package?)) + (_ (const #t))))) + (fold-packages (lambda (package result) + (if (select? package) + (keep-newest package result) + result)) + '()))) + (some ;user-specified packages + some))) + + (define packages + (match (assoc-ref opts 'manifest) + (#f args-packages) + ((? string? file) (packages-from-manifest file)))) + + (if (assoc-ref opts 'recursive?) + (mlet %store-monad ((edges (node-edges %bag-node-type + (all-packages)))) + (return (node-transitive-edges packages edges))) + (with-monad %store-monad + (return packages)))) + ;;; ;;; Updates. @@ -224,7 +297,7 @@ KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed values: 'interactive' (default), 'always', and 'never'. When WARN? is true, warn about packages that have no matching updater." (if (lookup-updater package updaters) - (let-values (((version tarball) + (let-values (((version tarball changes) (package-update store package updaters #:key-download key-download)) ((loc) @@ -238,6 +311,26 @@ warn about packages that have no matching updater." (location->string loc) (package-name package) (package-version package) version) + (for-each + (lambda (change) + (format (current-error-port) + (match (list (upstream-input-change-action change) + (upstream-input-change-type change)) + (('add 'regular) + (G_ "~a: consider adding this input: ~a~%")) + (('add 'native) + (G_ "~a: consider adding this native input: ~a~%")) + (('add 'propagated) + (G_ "~a: consider adding this propagated input: ~a~%")) + (('remove 'regular) + (G_ "~a: consider removing this input: ~a~%")) + (('remove 'native) + (G_ "~a: consider removing this native input: ~a~%")) + (('remove 'propagated) + (G_ "~a: consider removing this propagated input: ~a~%"))) + (package-name package) + (upstream-input-change-name change))) + (changes)) (let ((hash (call-with-input-file tarball port-sha256))) (update-package-source package version hash))) @@ -335,19 +428,6 @@ dependent packages are rebuilt: ~{~a~^ ~}~%" (map full-name covering)))) (return #t)))) -(define (refresh-recursive packages) - "Check all of the package inputs of PACKAGES for newer upstream versions." - (mlet %store-monad ((edges (node-edges %bag-node-type - ;; Here we don't want the -boot0 packages. - (fold-packages cons '())))) - (let ((dependent (node-transitive-edges packages edges))) - ;; par-for-each has an undefined return value, so packages which cause - ;; errors can be ignored. - (par-for-each (lambda (package) - (guix-refresh package)) - (map package-name dependent))) - (return #t))) - (define (list-transitive packages) "List all the packages that would cause PACKAGES to be rebuilt if they are changed." ;; Using %BAG-NODE-TYPE is more accurate than using %PACKAGE-NODE-TYPE @@ -414,40 +494,6 @@ all are dependent packages: ~{~a~^ ~}~%") (lists (concatenate lists)))) - (define (keep-newest package lst) - ;; If a newer version of PACKAGE is already in LST, return LST; otherwise - ;; return LST minus the other version of PACKAGE in it, plus PACKAGE. - (let ((name (package-name package))) - (match (find (lambda (p) - (string=? (package-name p) name)) - lst) - ((? package? other) - (if (version>? (package-version other) (package-version package)) - lst - (cons package (delq other lst)))) - (_ - (cons package lst))))) - - (define core-package? - (let* ((input->package (match-lambda - ((name (? package? package) _ ...) package) - (_ #f))) - (final-inputs (map input->package %final-inputs)) - (core (append final-inputs - (append-map (compose (cut filter-map input->package <>) - package-transitive-inputs) - final-inputs))) - (names (delete-duplicates (map package-name core)))) - (lambda (package) - "Return true if PACKAGE is likely a \"core package\"---i.e., one whose -update would trigger a complete rebuild." - ;; Compare by name because packages in base.scm basically inherit - ;; other packages. So, even if those packages are not core packages - ;; themselves, updating them would also update those who inherit from - ;; them. - ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input. - (member (package-name package) names)))) - (let* ((opts (parse-options)) (update? (assoc-ref opts 'update?)) (updaters (options->updaters opts)) @@ -458,65 +504,38 @@ update would trigger a complete rebuild." ;; Warn about missing updaters when a package is explicitly given on ;; the command line. - (warn? (or (assoc-ref opts 'argument) - (assoc-ref opts 'expression))) - (args-packages - (match (filter-map (match-lambda - (('argument . spec) - ;; Take either the specified version or the - ;; latest one. - (specification->package spec)) - (('expression . exp) - (read/eval-package-expression exp)) - (_ #f)) - opts) - (() ; default to all packages - (let ((select? (match (assoc-ref opts 'select) - ('core core-package?) - ('non-core (negate core-package?)) - (_ (const #t))))) - (fold-packages (lambda (package result) - (if (select? package) - (keep-newest package result) - result)) - '()))) - (some ; user-specified packages - some))) - (packages - (match (assoc-ref opts 'manifest) - (#f args-packages) - ((? string? file) (packages-from-manifest file))))) + (warn? (and (or (assoc-ref opts 'argument) + (assoc-ref opts 'expression) + (assoc-ref opts 'manifest)) + (not recursive?)))) (with-error-handling (with-store store (run-with-store store - (cond - (list-dependent? - (list-dependents packages)) - (list-transitive? - (list-transitive packages)) - (recursive? - (refresh-recursive packages)) - (update? - (parameterize ((%openpgp-key-server - (or (assoc-ref opts 'key-server) - (%openpgp-key-server))) - (%gpg-command - (or (assoc-ref opts 'gpg-command) - (%gpg-command))) - (current-keyring - (or (assoc-ref opts 'keyring) - (string-append (config-directory) - "/upstream/trustedkeys.kbx")))) - (for-each - (cut update-package store <> updaters - #:key-download key-download - #:warn? warn?) - packages) - (with-monad %store-monad - (return #t)))) - (else - (for-each (cut check-for-package-update <> updaters - #:warn? warn?) - packages) - (with-monad %store-monad + (mlet %store-monad ((packages (options->packages opts))) + (cond + (list-dependent? + (list-dependents packages)) + (list-transitive? + (list-transitive packages)) + (update? + (parameterize ((%openpgp-key-server + (or (assoc-ref opts 'key-server) + (%openpgp-key-server))) + (%gpg-command + (or (assoc-ref opts 'gpg-command) + (%gpg-command))) + (current-keyring + (or (assoc-ref opts 'keyring) + (string-append (config-directory) + "/upstream/trustedkeys.kbx")))) + (for-each + (cut update-package store <> updaters + #:key-download key-download + #:warn? warn?) + packages) + (return #t))) + (else + (for-each (cut check-for-package-update <> updaters + #:warn? warn?) + packages) (return #t))))))))) diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 53b1777241..797a76db3f 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2014 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com> ;;; @@ -219,7 +219,7 @@ provide." (set! port (guix:open-connection-for-uri uri #:verify-certificate? #f)) (unless (or buffered? (not (file-port? port))) - (setvbuf port _IONBF))) + (setvbuf port 'none))) (http-fetch uri #:text? #f #:port port #:verify-certificate? #f)))))) (else @@ -567,7 +567,7 @@ initial connection on which HTTP requests are sent." verify-certificate?)))) ;; For HTTPS, P is not a file port and does not support 'setvbuf'. (when (file-port? p) - (setvbuf p _IOFBF (expt 2 16))) + (setvbuf p 'block (expt 2 16))) ;; Send REQUESTS, up to a certain number, in a row. ;; XXX: Do our own caching to work around inefficiencies when diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 6cda3ccbd6..569b826acd 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016, 2017, 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> @@ -1015,6 +1015,8 @@ Some ACTIONS support additional ARGS.\n")) --full-boot for 'vm', make a full boot sequence")) (display (G_ " --skip-checks skip file system and initrd module safety checks")) + (display (G_ " + -v, --verbosity=LEVEL use the given verbosity LEVEL")) (newline) (display (G_ " -h, --help display this help and exit")) @@ -1074,6 +1076,11 @@ Some ACTIONS support additional ARGS.\n")) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t (alist-cons 'graft? #f result)))) + (option '(#\v "verbosity") #t #f + (lambda (opt name arg result) + (let ((level (string->number* arg))) + (alist-cons 'verbosity level + (alist-delete 'verbosity result))))) (option '(#\s "system") #t #f (lambda (opt name arg result) (alist-cons 'system arg @@ -1092,7 +1099,8 @@ Some ACTIONS support additional ARGS.\n")) (print-extended-build-trace? . #t) (multiplexed-build-output? . #t) (graft? . #t) - (verbosity . 0) + (debug . 0) + (verbosity . #f) ;default (file-system-type . "ext4") (image-size . guess) (install-bootloader? . #t))) @@ -1267,9 +1275,9 @@ argument list and OPTS is the option alist." (args (option-arguments opts)) (command (assoc-ref opts 'action))) (parameterize ((%graft? (assoc-ref opts 'graft?))) - (with-status-report (if (memq command '(init reconfigure)) - print-build-event/quiet - print-build-event) + (with-status-verbosity (or (assoc-ref opts 'verbosity) + (if (memq command '(init reconfigure)) + 1 2)) (process-command command args opts)))))) ;;; Local Variables: diff --git a/guix/self.scm b/guix/self.scm index e9a768bc90..cf6110613c 100644 --- a/guix/self.scm +++ b/guix/self.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,6 +31,7 @@ #:use-module ((guix build compile) #:select (%lightweight-optimizations)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:export (make-config.scm whole-package ;for internal use in 'guix pull' @@ -43,35 +44,6 @@ ;;; Dependency handling. ;;; -(define* (false-if-wrong-guile package - #:optional (guile-version (effective-version))) - "Return #f if PACKAGE depends on the \"wrong\" major version of Guile (e.g., -2.0 instead of 2.2), otherwise return PACKAGE." - (let ((guile (any (match-lambda - ((label (? package? dep) _ ...) - (and (string=? (package-name dep) "guile") - dep))) - (package-direct-inputs package)))) - (and (or (not guile) - (string-prefix? guile-version - (package-version guile))) - package))) - -(define (package-for-guile guile-version . names) - "Return the package with one of the given NAMES that depends on -GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." - (let loop ((names names)) - (match names - (() - #f) - ((name rest ...) - (match (specification->package name) - (#f - (loop rest)) - ((? package? package) - (or (false-if-wrong-guile package guile-version) - (loop rest)))))))) - (define specification->package ;; Use our own variant of that procedure because that of (gnu packages) ;; would traverse all the .scm files, which is wasteful. @@ -89,12 +61,7 @@ GUILE-VERSION (\"2.0\" or \"2.2\"), or #f if none of the packages matches." ("gzip" (ref '(gnu packages compression) 'gzip)) ("bzip2" (ref '(gnu packages compression) 'bzip2)) ("xz" (ref '(gnu packages compression) 'xz)) - ("guile2.0-json" (ref '(gnu packages guile) 'guile2.0-json)) - ("guile2.0-ssh" (ref '(gnu packages ssh) 'guile2.0-ssh)) - ("guile2.0-git" (ref '(gnu packages guile) 'guile2.0-git)) - ;; XXX: No "guile2.0-sqlite3". - ("guile2.0-gnutls" (ref '(gnu packages tls) 'gnutls/guile-2.0)) - (_ #f)))) ;no such package + (_ #f)))) ;no such package ;;; @@ -528,7 +495,7 @@ Info manual." (pull-version 1) (name (string-append "guix-" version)) (guile-version (effective-version)) - (guile-for-build (guile-for-build guile-version)) + (guile-for-build (default-guile)) (zlib (specification->package "zlib")) (gzip (specification->package "gzip")) (bzip2 (specification->package "bzip2")) @@ -536,32 +503,22 @@ Info manual." (guix (specification->package "guix"))) "Return a file-like object that contains a compiled Guix." (define guile-json - (package-for-guile guile-version - "guile-json" - "guile2.0-json")) + (specification->package "guile-json")) (define guile-ssh - (package-for-guile guile-version - "guile-ssh" - "guile2.0-ssh")) + (specification->package "guile-ssh")) (define guile-git - (package-for-guile guile-version - "guile-git" - "guile2.0-git")) + (specification->package "guile-git")) (define guile-sqlite3 - (package-for-guile guile-version - "guile-sqlite3" - "guile2.0-sqlite3")) + (specification->package "guile-sqlite3")) (define guile-gcrypt - (package-for-guile guile-version - "guile-gcrypt")) + (specification->package "guile-gcrypt")) (define gnutls - (package-for-guile guile-version - "gnutls" "guile2.0-gnutls")) + (specification->package "gnutls")) (define dependencies (match (append-map (lambda (package) @@ -904,8 +861,8 @@ containing MODULE-FILES and possibly other files as well." #:report-load report-load #:report-compilation report-compilation))) - (setvbuf (current-output-port) _IONBF) - (setvbuf (current-error-port) _IONBF) + (setvbuf (current-output-port) 'none) + (setvbuf (current-error-port) 'none) (set! %load-path (cons #+module-tree %load-path)) (set! %load-path @@ -950,21 +907,6 @@ containing MODULE-FILES and possibly other files as well." ;;; Building. ;;; -(define (guile-for-build version) - "Return a derivation for Guile 2.0 or 2.2, whichever matches the currently -running Guile." - (define canonical-package ;soft reference - (module-ref (resolve-interface '(gnu packages base)) - 'canonical-package)) - - (match version - ("2.2" - (canonical-package (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2))) - ("2.0" - (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.0)))) - (define* (guix-derivation source version #:optional (guile-version (effective-version)) #:key (pull-version 0)) @@ -981,9 +923,16 @@ is not supported." (define guile ;; When PULL-VERSION >= 1, produce a self-contained Guix and use Guile 2.2 ;; unconditionally. - (guile-for-build (if (>= pull-version 1) - "2.2" - guile-version))) + (default-guile)) + + (when (and (< pull-version 1) + (not (string=? (package-version guile) guile-version))) + ;; Guix < 0.15.0 has PULL-VERSION = 0, where the host Guile is reused and + ;; can be any version. When that happens and Guile is not current (e.g., + ;; it's Guile 2.0), just bail out. + (raise (condition + (&message + (message "Guix is too old and cannot be upgraded"))))) (mbegin %store-monad (set-guile-for-build guile) diff --git a/guix/ssh.scm b/guix/ssh.scm index 1ed8406633..d90cb77be0 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -140,12 +140,12 @@ right away." (match (select read write except) ((read write except) (select read write except 0)))))) - (setvbuf stdout _IONBF) + (setvbuf stdout 'none) ;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>. - (setvbuf stdin _IOFBF 65536) - (setvbuf sock _IOFBF 65536) + (setvbuf stdin 'block 65536) + (setvbuf sock 'block 65536) (connect sock AF_UNIX ,socket-name) @@ -218,7 +218,7 @@ can be written." (consume-input (current-input-port)) (list 'protocol-error (nix-protocol-error-message c)))) (with-store store - (setvbuf (current-input-port) _IONBF) + (setvbuf (current-input-port) 'none) (import-paths store (current-input-port)) '(success)))) (lambda args @@ -269,7 +269,7 @@ be read. When RECURSIVE? is true, the closure of FILES is exported." (write '(exporting)) ;we're ready (force-output) - (setvbuf (current-output-port) _IONBF) + (setvbuf (current-output-port) 'none) (export-paths store files (current-output-port) #:recursive? ,recursive?)))))) diff --git a/guix/status.scm b/guix/status.scm index d4fc4ca16e..2928733257 100644 --- a/guix/status.scm +++ b/guix/status.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -63,7 +63,8 @@ print-build-event/quiet print-build-status - with-status-report)) + with-status-report + with-status-verbosity)) ;;; Commentary: ;;; @@ -636,9 +637,7 @@ The second return value is a thunk to retrieve the current state." ;; The build port actually receives Unicode strings. (set-port-encoding! port "UTF-8") - (cond-expand - ((and guile-2 (not guile-2.2)) #t) - (else (setvbuf port 'line))) + (setvbuf port 'line) (values port (lambda () %state))) (define (call-with-status-report on-event thunk) @@ -651,3 +650,17 @@ The second return value is a thunk to retrieve the current state." "Set up build status reporting to the user using the ON-EVENT procedure; evaluate EXP... in that context." (call-with-status-report on-event (lambda () exp ...))) + +(define (logger-for-level level) + "Return the logging procedure that corresponds to LEVEL." + (cond ((<= level 0) (const #t)) + ((= level 1) print-build-event/quiet) + (else print-build-event))) + +(define (call-with-status-verbosity level thunk) + (call-with-status-report (logger-for-level level) thunk)) + +(define-syntax-rule (with-status-verbosity level exp ...) + "Set up build status reporting to the user at the given LEVEL: 0 means +silent, 1 means quiet, 2 means verbose. Evaluate EXP... in that context." + (call-with-status-verbosity level (lambda () exp ...))) diff --git a/guix/store.scm b/guix/store.scm index 042dfab67f..1f88eb2b33 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. @@ -404,11 +404,6 @@ (define (open-inet-socket host port) "Connect to the Unix-domain socket at HOST:PORT and return it. Raise a '&nix-connection-error' upon error." - ;; Define 'TCP_NODELAY' on Guile 2.0. The value is the same on all GNU - ;; systems. - (cond-expand (guile-2.2 #t) - (else (define TCP_NODELAY 1))) - (let ((sock (with-fluids ((%default-port-encoding #f)) ;; This trick allows use of the `scm_c_read' optimization. (socket PF_UNIX SOCK_STREAM 0)))) @@ -613,7 +608,7 @@ to OUT, using chunks of BUFFER-SIZE bytes." (define %newlines ;; Newline characters triggering a flush of 'current-build-output-port'. - ;; Unlike Guile's _IOLBF, we flush upon #\return so that progress reports + ;; Unlike Guile's 'line, we flush upon #\return so that progress reports ;; that use that trick are correctly displayed. (char-set #\newline #\return)) diff --git a/guix/ui.scm b/guix/ui.scm index 4c31246920..1e089753e1 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -427,11 +427,6 @@ report them in a user-friendly way." (lambda _ (setlocale LC_ALL "")) (lambda args - (cond-expand - ;; Guile 2.2 already emits a warning, so let's not add a second one. - (guile-2.2 #t) - (else (warning (G_ "failed to install locale: ~a~%") - (strerror (system-error-errno args))))) (display-hint (G_ "Consider installing the @code{glibc-utf8-locales} or @code{glibc-locales} package and defining @code{GUIX_LOCPATH}, along these lines: @@ -459,8 +454,8 @@ See the \"Application Setup\" section in the manual, for more info.\n"))))) ;; notified via an EPIPE later. (sigaction SIGPIPE SIG_IGN) - (setvbuf (current-output-port) _IOLBF) - (setvbuf (current-error-port) _IOLBF)) + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line)) (define* (show-version-and-exit #:optional (command (car (command-line)))) "Display version information for COMMAND and `(exit 0)'." diff --git a/guix/upstream.scm b/guix/upstream.scm index 9e1056f7a7..9163478099 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Alex Kost <alezost@gmail.com> +;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +46,7 @@ upstream-source-urls upstream-source-signature-urls upstream-source-archive-types + upstream-source-input-changes url-prefix-predicate coalesce-sources @@ -56,6 +58,12 @@ upstream-updater-predicate upstream-updater-latest + upstream-input-change? + upstream-input-change-name + upstream-input-change-type + upstream-input-change-action + changed-inputs + %updaters lookup-updater @@ -82,7 +90,73 @@ (version upstream-source-version) ;string (urls upstream-source-urls) ;list of strings (signature-urls upstream-source-signature-urls ;#f | list of strings - (default #f))) + (default #f)) + (input-changes upstream-source-input-changes + (default '()) (thunked))) + +;; Representation of an upstream input change. +(define-record-type* <upstream-input-change> + upstream-input-change make-upstream-input-change + upstream-input-change? + (name upstream-input-change-name) ;string + (type upstream-input-change-type) ;symbol: regular | native | propagated + (action upstream-input-change-action)) ;symbol: add | remove + +(define (changed-inputs package package-sexp) + "Return a list of input changes for PACKAGE based on the newly imported +S-expression PACKAGE-SEXP." + (match package-sexp + ((and expr ('package fields ...)) + (let* ((input->name (match-lambda ((name pkg . out) name))) + (new-regular + (match expr + ((path *** ('inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '()))) + (new-native + (match expr + ((path *** ('native-inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '()))) + (new-propagated + (match expr + ((path *** ('propagated-inputs + ('quasiquote ((label ('unquote sym)) ...)))) label) + (_ '()))) + (current-regular + (map input->name (package-inputs package))) + (current-native + (map input->name (package-native-inputs package))) + (current-propagated + (map input->name (package-propagated-inputs package)))) + (append-map + (match-lambda + ((action type names) + (map (lambda (name) + (upstream-input-change + (name name) + (type type) + (action action))) + names))) + `((add regular + ,(lset-difference equal? + new-regular current-regular)) + (remove regular + ,(lset-difference equal? + current-regular new-regular)) + (add native + ,(lset-difference equal? + new-native current-native)) + (remove native + ,(lset-difference equal? + current-native new-native)) + (add propagated + ,(lset-difference equal? + new-propagated current-propagated)) + (remove propagated + ,(lset-difference equal? + current-propagated new-propagated)))))) + (_ '()))) (define (url-prefix-predicate prefix) "Return a predicate that returns true when passed a package where one of its @@ -268,12 +342,12 @@ values: the item from LST1 and the item from LST2 that match PRED." (define* (package-update store package updaters #:key (key-download 'interactive)) - "Return the new version and the file name of the new version tarball for -PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a -download policy for missing OpenPGP keys; allowed values: 'always', 'never', -and 'interactive' (default)." + "Return the new version, the file name of the new version tarball, and input +changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date. +KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed +values: 'always', 'never', and 'interactive' (default)." (match (package-latest-release* package updaters) - (($ <upstream-source> _ version urls signature-urls) + (($ <upstream-source> _ version urls signature-urls changes) (let*-values (((name) (package-name package)) ((archive-type) @@ -299,9 +373,9 @@ and 'interactive' (default)." (or signature-urls (circular-list #f))))) (let ((tarball (download-tarball store url signature-url #:key-download key-download))) - (values version tarball)))) + (values version tarball changes)))) (#f - (values #f #f)))) + (values #f #f #f)))) (define (update-package-source package version hash) "Modify the source file that defines PACKAGE to refer to VERSION, |