From e2922f527ee8d891a41b5086637fa560a1c2ddd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 10:05:54 +0100 Subject: substitute: 'http-multiple-get' processes each request only once. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Reported by Gábor Boskovits . Fixes a regression introduced in 9e3f9ac3c00906f5bc647ea8398e4ed5a370614e. * guix/scripts/substitute.scm (http-multiple-get): In the "Connection: close" case, pass (drop requests (+ 1 processed)) to 'loop' as the remaining REQUESTS value. Previously, we would pass a list containing duplicates, and thus the final result would also contain duplicates. When sent to the daemon, that list would lead to a daemon error: got unexpected path `/gnu/store/…' from substituter --- guix/scripts/substitute.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 3bf9b8735f..dfb975a24a 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -557,7 +557,7 @@ initial connection on which HTTP requests are sent." (('connection 'close) (close-port p) (connect #f ;try again - (append tail (drop requests processed)) + (drop requests (+ 1 processed)) result)) (_ (loop tail (+ 1 processed) result)))))))))) ;keep going -- cgit v1.2.3 From 5a2639f9cb367bc42a552a6fe9c7081f8b7c4cf0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 15:03:08 +0100 Subject: Avoid warnings for the 'delete' binding of (guix build utils). On Guile 3, importing (guix build utils) leads to warnings such as: WARNING: (gnu packages embedded): imported module (guix build utils) overrides core binding `delete' * gnu/packages/embedded.scm: Select 'alist-replace' from (guix build utils). * guix/ui.scm: Hide 'delete' from (guix build utils). --- guix/ui.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 023e604085..b99a9e59f5 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -55,7 +55,9 @@ ;; in 5d669883ecc104403c5d3ba7d172e9c02234577c, #:hide ;; unwanted bindings instead of #:select'ing the needed ;; bindings. - #:hide (package-name->name+version)) + #:hide (package-name->name+version + ;; Avoid "overrides core binding" warning. + delete)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) -- cgit v1.2.3 From ea6d962b93a38dd11c1d43c647a7ac10c2f75fe8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 15:04:40 +0100 Subject: More module autoload adjustments. This is a followup to 7a0836cffdfe3ab9ee899602f218277646959144. * guix/scripts/package.scm: Adjust binding list of the (guix store roots) autoload. * guix/inferior.scm: Adjust binding list of the (guix cache) autoload. --- guix/inferior.scm | 5 +++-- guix/scripts/package.scm | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/inferior.scm b/guix/inferior.scm index c4969cd56a..0236fb61ad 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -44,7 +44,8 @@ #:use-module (guix derivations) #:use-module (guix base32) #:use-module (gcrypt hash) - #:autoload (guix cache) (maybe-remove-expired-cache-entries) + #:autoload (guix cache) (maybe-remove-expired-cache-entries + file-expiration-time) #:autoload (guix ui) (show-what-to-build*) #:autoload (guix build utils) (mkdir-p) #:use-module (srfi srfi-1) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index ea16435d2d..0fe25aee6f 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, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2013 Nikita Karetnikov ;;; Copyright © 2013, 2015 Mark H Weaver ;;; Copyright © 2014, 2016 Alex Kost @@ -39,7 +39,7 @@ #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (guix describe) - #:autoload (guix store roots) (gc-roots) + #:autoload (guix store roots) (gc-roots user-owned?) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p)) #:use-module ((guix build syscalls) -- cgit v1.2.3 From 69f132554c6bd23df4610a21e636bde5f0578174 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 18:05:26 +0100 Subject: import: cpan: Rewrite to use 'define-json-mapping'. * guix/import/cpan.scm (, ): New JSON-mapped record types. (metacpan-url->mirror-url): New procedure. (cpan-source-url): Rewrite in terms of it. (cpan-version): Remove. (cpan-module->sexp): Rewrite to take a instead of an alist, and rename 'meta' to 'release'. [convert-inputs]: Rewrite to use 'cpan-release-dependencies'. Update calls to 'convert-inputs' to pass a list of symbols. Replace 'assoc-ref' calls with the appropriate field accessors. (cpan->guix-package): Rename 'module-meta' to 'release'. (latest-release): Likewise, and use the appropriate accessors. * tests/cpan.scm (test-json): Remove "prereqs" record; add "dependency" list. ("source-url-http", "source-url-https"): Remove. ("metacpan-url->mirror-url, http") ("metacpan-url->mirror-url, https"): New tests. --- guix/import/cpan.scm | 151 ++++++++++++++++++++++++++++++++++----------------- 1 file changed, 100 insertions(+), 51 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index ec86f11743..4320f94c98 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016 Alex Sassmannshausen ;;; Copyright © 2017, 2018 Tobias Geerinckx-Rice +;;; Copyright © 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,19 +28,39 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (json) + #:use-module (guix json) #:use-module (gcrypt hash) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix base32) #:use-module (guix ui) #:use-module ((guix download) #:select (download-to-store url-fetch)) - #:use-module ((guix import utils) #:select (factorize-uri - flatten assoc-ref*)) + #:use-module ((guix import utils) #:select (factorize-uri)) #:use-module (guix import json) #:use-module (guix packages) #:use-module (guix upstream) #:use-module (guix derivations) - #:export (cpan->guix-package + #:export (cpan-dependency? + cpan-dependency-relationship + cpan-dependency-phase + cpan-dependency-module + cpan-dependency-version + + cpan-release? + cpan-release-license + cpan-release-author + cpan-release-version + cpan-release-modle + cpan-release-distribution + cpan-release-download-url + cpan-release-abstract + cpan-release-home-page + cpan-release-dependencies + json->cpan-release + + cpan-fetch + cpan->guix-package + metacpan-url->mirror-url %cpan-updater)) ;;; Commentary: @@ -49,6 +70,45 @@ ;;; ;;; Code: +;; Dependency of a "release". +(define-json-mapping make-cpan-dependency cpan-dependency? + json->cpan-dependency + (relationship cpan-dependency-relationship "relationship" + string->symbol) ;requires | suggests + (phase cpan-dependency-phase "phase" + string->symbol) ;develop | configure | test | runtime + (module cpan-dependency-module) ;string + (version cpan-dependency-version)) ;string + +;; Release as returned by . +(define-json-mapping make-cpan-release cpan-release? + json->cpan-release + (license cpan-release-license) + (author cpan-release-author) + (version cpan-release-version "version" + (match-lambda + ((? number? version) + ;; Version is sometimes not quoted in the module json, so + ;; it gets imported into Guile as a number, so convert it + ;; to a string (example: "X11-Protocol-Other"). + (number->string version)) + ((? string? version) + ;; Sometimes we get a "v" prefix. Strip it. + (if (string-prefix? "v" version) + (string-drop version 1) + version)))) + (module cpan-release-module "main_module") ;e.g., "Test::Script" + (distribution cpan-release-distribution) ;e.g., "Test-Script" + (download-url cpan-release-download-url "download_url") + (abstract cpan-release-abstract "abstract") + (home-page cpan-release-home-page "resources" + (match-lambda + (#f #f) + ((lst ...) (assoc-ref lst "homepage")))) + (dependencies cpan-release-dependencies "dependency" + (lambda (vector) + (map json->cpan-dependency (vector->list vector))))) + (define string->license (match-lambda ;; List of valid values from https://metacpan.org/pod/CPAN::Meta::Spec. @@ -111,32 +171,25 @@ return \"Test-Simple\"" (_ #f))))) (define (cpan-fetch name) - "Return an alist representation of the CPAN metadata for the perl module MODULE, -or #f on failure. MODULE should be e.g. \"Test::Script\"" + "Return a record for Perl module MODULE, +or #f on failure. MODULE should be the distribution name, such as +\"Test-Script\" for the \"Test::Script\" module." ;; This API always returns the latest release of the module. - (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" name))) + (json->cpan-release + (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" + name)))) (define (cpan-home name) (string-append "https://metacpan.org/release/" name)) -(define (cpan-source-url meta) - "Return the download URL for a module's source tarball." +(define (metacpan-url->mirror-url url) + "Replace 'https://cpan.metacpan.org' in URL with 'mirror://cpan'." (regexp-substitute/global #f "http[s]?://cpan.metacpan.org" - (assoc-ref meta "download_url") + url 'pre "mirror://cpan" 'post)) -(define (cpan-version meta) - "Return the version number from META." - (match (assoc-ref meta "version") - ((? number? version) - ;; version is sometimes not quoted in the module json, so it gets - ;; imported into Guile as a number, so convert it to a string. - (number->string version)) - (version - ;; Sometimes we get a "v" prefix. Strip it. - (if (string-prefix? "v" version) - (string-drop version 1) - version)))) +(define cpan-source-url + (compose metacpan-url->mirror-url cpan-release-download-url)) (define (perl-package) "Return the 'perl' package. This is a lazy reference so that we don't @@ -179,42 +232,38 @@ depend on (gnu packages perl)." first perl-version last)))) (loop))))))))))) -(define (cpan-module->sexp meta) - "Return the `package' s-expression for a CPAN module from the metadata in -META." +(define (cpan-module->sexp release) + "Return the 'package' s-expression for a CPAN module from the release data +in RELEASE, a record." (define name - (assoc-ref meta "distribution")) + (cpan-release-distribution release)) (define (guix-name name) (if (string-prefix? "perl-" name) (string-downcase name) (string-append "perl-" (string-downcase name)))) - (define version (cpan-version meta)) - (define source-url (cpan-source-url meta)) + (define version (cpan-release-version release)) + (define source-url (cpan-source-url release)) (define (convert-inputs phases) ;; Convert phase dependencies into a list of name/variable pairs. - (match (flatten - (map (lambda (ph) - (filter-map (lambda (t) - (assoc-ref* meta "metadata" "prereqs" ph t)) - '("requires" "recommends" "suggests"))) - phases)) - (#f - '()) + (match (filter-map (lambda (dependency) + (and (memq (cpan-dependency-phase dependency) + phases) + (cpan-dependency-module dependency))) + (cpan-release-dependencies release)) ((inputs ...) (sort (delete-duplicates ;; Listed dependencies may include core modules. Filter those out. (filter-map (match-lambda - (("perl" . _) ;implicit dependency - #f) - ((module . _) - (and (not (core-module? module)) - (let ((name (guix-name (module->dist-name module)))) - (list name - (list 'unquote (string->symbol name))))))) + ("perl" #f) ;implicit dependency + ((? core-module?) #f) + (module + (let ((name (guix-name (module->dist-name module)))) + (list name + (list 'unquote (string->symbol name)))))) inputs)) (lambda args (match args @@ -247,19 +296,19 @@ META." ;; which says they are required during building. We ;; have not yet had a need for cross-compiled perl ;; modules, however, so we leave it out. - (convert-inputs '("configure" "build" "test"))) + (convert-inputs '(configure build test))) ,@(maybe-inputs 'propagated-inputs - (convert-inputs '("runtime"))) + (convert-inputs '(runtime))) (home-page ,(cpan-home name)) - (synopsis ,(assoc-ref meta "abstract")) + (synopsis ,(cpan-release-abstract release)) (description fill-in-yourself!) - (license ,(string->license (assoc-ref meta "license")))))) + (license ,(string->license (cpan-release-license release)))))) (define (cpan->guix-package module-name) "Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the `package' s-expression corresponding to that package, or #f on failure." - (let ((module-meta (cpan-fetch (module->name module-name)))) - (and=> module-meta cpan-module->sexp))) + (let ((release (cpan-fetch (module->name module-name)))) + (and=> release cpan-module->sexp))) (define (cpan-package? package) "Return #t if PACKAGE is a package from CPAN." @@ -285,7 +334,7 @@ META." "Return an for the latest release of PACKAGE." (match (cpan-fetch (package->upstream-name package)) (#f #f) - (meta + (release (let ((core-inputs (match (package-direct-inputs package) (((_ inputs _ ...) ...) @@ -303,8 +352,8 @@ META." (warning (G_ "input '~a' of ~a is in Perl core~%") module (package-name package))) core-inputs))) - (let ((version (cpan-version meta)) - (url (cpan-source-url meta))) + (let ((version (cpan-release-version release)) + (url (cpan-source-url release))) (upstream-source (package (package-name package)) (version version) -- cgit v1.2.3 From 4aea90b1876179aab8d603a42533a6bdf97ccd3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 18:35:14 +0100 Subject: import: cpan: Rewrite tests to use an HTTP server instead of mocking. * guix/import/cpan.scm (%metacpan-base-url): New variable. (module->dist-name, cpan-fetch): Refer to it instead of the hard-coded URL. * tests/cpan.scm ("cpan->guix-package"): Use 'with-http-server' instead of 'mock'. --- guix/import/cpan.scm | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/import/cpan.scm b/guix/import/cpan.scm index 4320f94c98..7a97c7f8e8 100644 --- a/guix/import/cpan.scm +++ b/guix/import/cpan.scm @@ -61,7 +61,9 @@ cpan-fetch cpan->guix-package metacpan-url->mirror-url - %cpan-updater)) + %cpan-updater + + %metacpan-base-url)) ;;; Commentary: ;;; @@ -70,6 +72,10 @@ ;;; ;;; Code: +(define %metacpan-base-url + ;; Base URL of the MetaCPAN API. + (make-parameter "https://fastapi.metacpan.org/v1/")) + ;; Dependency of a "release". (define-json-mapping make-cpan-dependency cpan-dependency? json->cpan-dependency @@ -149,7 +155,7 @@ module is distributed with 'Test::Simple', so (module->dist-name \"ok\") would return \"Test-Simple\"" (assoc-ref (json-fetch (string-append - "https://fastapi.metacpan.org/v1/module/" + (%metacpan-base-url) "/module/" module "?fields=distribution")) "distribution")) @@ -176,7 +182,7 @@ or #f on failure. MODULE should be the distribution name, such as \"Test-Script\" for the \"Test::Script\" module." ;; This API always returns the latest release of the module. (json->cpan-release - (json-fetch (string-append "https://fastapi.metacpan.org/v1/release/" + (json-fetch (string-append (%metacpan-base-url) "/release/" name)))) (define (cpan-home name) -- cgit v1.2.3 From 0aa6b3869584dba5916039b8e71b6532463e42ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 23:34:46 +0100 Subject: serialize: Export 'dump-port*'. * guix/serialization.scm (dump): Export as 'dump-port*'. * guix/scripts/challenge.scm (dump-port*): Remove. --- guix/scripts/challenge.scm | 7 ++----- guix/serialization.scm | 3 ++- 2 files changed, 4 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/scripts/challenge.scm b/guix/scripts/challenge.scm index ebeebd5cbe..65e2427033 100644 --- a/guix/scripts/challenge.scm +++ b/guix/scripts/challenge.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2015, 2016, 2017, 2019 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -25,7 +25,7 @@ #:use-module (guix monads) #:use-module (guix base32) #:use-module (guix packages) - #:use-module (guix progress) + #:use-module ((guix progress) #:hide (dump-port*)) #:use-module (guix serialization) #:use-module (guix scripts substitute) #:use-module (rnrs bytevectors) @@ -193,9 +193,6 @@ taken since we do not import the archives." ;;; Reporting. ;;; -(define dump-port* ;FIXME: deduplicate - (@@ (guix serialization) dump)) - (define (port-sha256* port size) ;; Like 'port-sha256', but limited to SIZE bytes. (let-values (((out get) (open-sha256-port))) diff --git a/guix/serialization.scm b/guix/serialization.scm index f793feb53d..9452303730 100644 --- a/guix/serialization.scm +++ b/guix/serialization.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,6 +36,7 @@ write-string-pairs write-store-path read-store-path write-store-path-list read-store-path-list + (dump . dump-port*) &nar-error nar-error? -- cgit v1.2.3 From 65b510bbc4f2a9ce5bfe3355e6006e9d08f14532 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jan 2020 23:38:35 +0100 Subject: clojure-utils: Avoid use of '@@'. * guix/build/clojure-utils.scm (%doc-regex): Avoid @@, which doesn't work on Guile 3. (file-sans-extension): Likewise. --- guix/build/clojure-utils.scm | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/build/clojure-utils.scm b/guix/build/clojure-utils.scm index 9f7334bc8d..a9ffad3c8f 100644 --- a/guix/build/clojure-utils.scm +++ b/guix/build/clojure-utils.scm @@ -69,10 +69,7 @@ (define-with-docs %doc-regex "Default regex for matching the base name of top-level documentation files." - (format #f - "(~a)|(\\.(html|markdown|md|txt)$)" - (@@ (guix build guile-build-system) - %documentation-file-regexp))) + "^(README.*|.*\\.html|.*\\.org|.*\\.md|\\.markdown|\\.txt)$") (define* (install-doc #:key doc-dirs @@ -185,10 +182,12 @@ canonicalized." (apply find-files "./" args)))) ;;; FIXME: should be moved to (guix build utils) -(define-with-docs file-sans-extension - "Strip extension from path, if any." - (@@ (guix build guile-build-system) - file-sans-extension)) +(define (file-sans-extension file) ;TODO: factorize + "Return the substring of FILE without its extension, if any." + (let ((dot (string-rindex file #\.))) + (if dot + (substring file 0 dot) + file))) (define (relative-path->clojure-lib-string path) "Convert PATH to a clojure library string." -- cgit v1.2.3 From ee9a735bc8f544cf8eedc6c6a7e4ed2962663013 Mon Sep 17 00:00:00 2001 From: Pierre Neidhardt Date: Thu, 16 Jan 2020 15:16:02 +0100 Subject: graph: Add '--load-path' option. * guix/scripts/graph.scm (%option): Add '--load-path' option. * doc/guix.texi: Document it. * tests/guix-graph.sh: Test it. --- guix/scripts/graph.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'guix') diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 7558cb1e85..53f407b2fc 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2019 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -35,6 +36,7 @@ #:use-module ((guix scripts build) #:select (show-transformation-options-help options->transformation + %standard-build-options %transformation-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -473,6 +475,9 @@ package modules, while attempting to retain user package modules." (lambda (opt name arg result) (alist-cons 'system arg (alist-delete 'system result eq?)))) + (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options) (option '(#\h "help") #f #f (lambda args (show-help) @@ -501,6 +506,9 @@ Emit a representation of the dependency graph of PACKAGE...\n")) (display (G_ " -s, --system=SYSTEM consider the graph for SYSTEM--e.g., \"i686-linux\"")) (newline) + (display (G_ " + -L, --load-path=DIR prepend DIR to the package module search path")) + (newline) (show-transformation-options-help) (newline) (display (G_ " -- cgit v1.2.3 From 2d4688c1ea64f07866ffe976391d7ec3d371f6b5 Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 15 Jan 2020 18:00:02 +0100 Subject: size: Add '--load-path' option. * guix/scripts/size.scm (%option): Add '--load-path' option. * doc/guix.texi: Document it. --- guix/scripts/size.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'guix') diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index f549ce05b8..2446b84587 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2019 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +20,7 @@ (define-module (guix scripts size) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module (guix scripts build) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix combinators) @@ -242,6 +244,9 @@ Report the size of PACKAGE and its dependencies.\n")) -m, --map-file=FILE write to FILE a graphical map of disk usage")) (newline) (display (G_ " + -L, --load-path=DIR prepend DIR to the package module search path")) + (newline) + (display (G_ " -h, --help display this help and exit")) (display (G_ " -V, --version display version information and exit")) @@ -273,6 +278,9 @@ Report the size of PACKAGE and its dependencies.\n")) (option '(#\m "map-file") #t #f (lambda (opt name arg result) (alist-cons 'map-file arg result))) + (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options) (option '(#\h "help") #f #f (lambda args (show-help) -- cgit v1.2.3 From 21f4fbdd8453e489fb89825c4226a0a0bda2bc17 Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 15 Jan 2020 18:00:03 +0100 Subject: refresh: Add '--load-path' option. * guix/scripts/refresh.scm (%option): Add '--load-path' option. * doc/guix.texi: Document it. --- guix/scripts/refresh.scm | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'guix') diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index daf6fcf947..bc8e906054 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -7,6 +7,7 @@ ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Efraim Flashner ;;; Copyright © 2019 Ricardo Wurmus +;;; Copyright © 2020 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,6 +28,7 @@ #:use-module (guix ui) #:use-module (gcrypt hash) #:use-module (guix scripts) + #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) @@ -116,6 +118,19 @@ (leave (G_ "unsupported policy: ~a~%") arg))))) + ;; The short option -L is already used by --list-updaters, therefore + ;; it needs to be removed from %standard-build-options. + (let ((%load-path-option (find (lambda (option) + (member "load-path" + (option-names option))) + %standard-build-options))) + (option + (filter (lambda (name) (not (equal? #\L name))) + (option-names %load-path-option)) + (option-required-arg? %load-path-option) + (option-optional-arg? %load-path-option) + (option-processor %load-path-option))) + (option '(#\h "help") #f #f (lambda args (show-help) @@ -165,6 +180,9 @@ specified with `--select'.\n")) 'always', 'never', and 'interactive', which is also used when 'key-download' is not specified")) (newline) + (display (G_ " + --load-path=DIR prepend DIR to the package module search path")) + (newline) (display (G_ " -h, --help display this help and exit")) (display (G_ " -- cgit v1.2.3 From 3c8396b578fe1b2efa942785e92a433c5f712b5d Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 15 Jan 2020 18:00:04 +0100 Subject: edit: Add '--load-path' option. * guix/scripts/edit.scm (%option): Add '--load-path' option. * doc/guix.texi: Document it. --- guix/scripts/edit.scm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index da3d2775e8..a6fd1d2751 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015, 2016, 2019 Ludovic Courtès ;;; Copyright © 2015 Mathieu Lirzin +;;; Copyright © 2020 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -20,6 +21,7 @@ (define-module (guix scripts edit) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix utils) #:use-module (gnu packages) #:use-module (srfi srfi-1) @@ -28,7 +30,10 @@ guix-edit)) (define %options - (list (option '(#\h "help") #f #f + (list (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options) + (option '(#\h "help") #f #f (lambda args (show-help) (exit 0))) @@ -39,6 +44,9 @@ (define (show-help) (display (G_ "Usage: guix edit PACKAGE... Start $VISUAL or $EDITOR to edit the definitions of PACKAGE...\n")) + (newline) + (display (G_ " + -L, --load-path=DIR prepend DIR to the package module search path")) (newline) (display (G_ " -h, --help display this help and exit")) -- cgit v1.2.3 From e8728862a15abd58702ff4be05440298c0734e57 Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 15 Jan 2020 18:00:05 +0100 Subject: repl: Add '--load-path' option. * guix/scripts/repl.scm (%option): Add '--load-path' option. * doc/guix.texi: Document it. --- guix/scripts/repl.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index e1cc759fc8..39a9b09656 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2020 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +20,7 @@ (define-module (guix scripts repl) #:use-module (guix ui) #:use-module (guix scripts) + #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix repl) #:use-module (guix utils) #:use-module (guix packages) @@ -52,7 +54,10 @@ (alist-cons 'type (string->symbol arg) result))) (option '("listen") #t #f (lambda (opt name arg result) - (alist-cons 'listen arg result))))) + (alist-cons 'listen arg result))) + (find (lambda (option) + (member "load-path" (option-names option))) + %standard-build-options))) (define (show-help) @@ -60,6 +65,8 @@ Start a Guile REPL in the Guix execution environment.\n")) (display (G_ " -t, --type=TYPE start a REPL of the given TYPE")) + (display (G_ " + -L, --load-path=DIR prepend DIR to the package module search path")) (newline) (display (G_ " -h, --help display this help and exit")) -- cgit v1.2.3 From d14e4745b36a835c6babd5b5f5562e12294cd9cf Mon Sep 17 00:00:00 2001 From: zimoun Date: Wed, 15 Jan 2020 18:00:06 +0100 Subject: repl: Fix '--help' message. * guix/scripts/repl.scm: (show-help): Add '--listen' option message. --- guix/scripts/repl.scm | 3 +++ 1 file changed, 3 insertions(+) (limited to 'guix') diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index 39a9b09656..fc3e4e2131 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -65,6 +65,9 @@ Start a Guile REPL in the Guix execution environment.\n")) (display (G_ " -t, --type=TYPE start a REPL of the given TYPE")) + (display (G_ " + --listen=ENDPOINT listen ENDPOINT instead of standard I/O")) + (newline) (display (G_ " -L, --load-path=DIR prepend DIR to the package module search path")) (newline) -- cgit v1.2.3 From 4fe01b09ea0b304b963b7fd9f168439ddfb515c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 10:43:29 +0100 Subject: publish: Export 'signed-string'. * guix/scripts/publish.scm (signed-string): Export and improve docstring. * tests/publish.scm ("/*.narinfo") ("/*.narinfo with properly encoded '+' sign"): Adjust accordingly. --- guix/scripts/publish.scm | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index 71a349d2fe..f5b2f5fd4e 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -64,6 +64,7 @@ #:use-module ((guix build syscalls) #:select (set-thread-name)) #:export (%public-key %private-key + signed-string guix-publish)) @@ -237,7 +238,8 @@ if ITEM is already compressed." ("Priority" . 100))) (define (signed-string s) - "Sign the hash of the string S with the daemon's key." + "Sign the hash of the string S with the daemon's key. Return a canonical +sexp for the signature." (let* ((public-key (%public-key)) (hash (bytevector->hash-data (sha256 (string->utf8 s)) #:key-type (key-type public-key)))) -- cgit v1.2.3 From 84c5da08dda4fa8fd0e0f1e6a8a115190005f84a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 10:57:19 +0100 Subject: guix package: Export 'transaction-upgrade-entry'. * guix/scripts/package.scm (transaction-upgrade-entry): Add 'store' parameter and use it instead of (%store). Export. * tests/packages.scm ("transaction-upgrade-entry, zero upgrades") ("transaction-upgrade-entry, one upgrade") ("transaction-upgrade-entry, superseded package"): Adjust accordingly. --- guix/scripts/package.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 0fe25aee6f..f4d92a649e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -63,6 +63,8 @@ delete-matching-generations guix-package + transaction-upgrade-entry ;mostly for testing + (%options . %package-options) (%default-options . %package-default-options) guix-package*)) @@ -205,7 +207,7 @@ non-zero relevance score." (package-full-name package2)) (> score1 score2)))))))))) -(define (transaction-upgrade-entry entry transaction) +(define (transaction-upgrade-entry store entry transaction) "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a ." (define (supersede old new) @@ -242,7 +244,7 @@ non-zero relevance score." transaction) ((=) (let ((candidate-path (derivation->output-path - (package-derivation (%store) pkg)))) + (package-derivation store pkg)))) ;; XXX: When there are propagated inputs, assume we need to ;; upgrade the whole entry. (if (and (string=? path candidate-path) @@ -600,7 +602,7 @@ and upgrades." (define upgraded (fold (lambda (entry transaction) (if (upgrade? (manifest-entry-name entry)) - (transaction-upgrade-entry entry transaction) + (transaction-upgrade-entry (%store) entry transaction) transaction)) transaction (manifest-entries manifest))) -- cgit v1.2.3 From 47212fc763788660ff9051ccee1f6fa8a0db7bdd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 15:00:18 +0100 Subject: records: Improve reporting of "invalid field specifier" errors. Previously users would just see: error: invalid field specifier without source location or hints. * guix/records.scm (expand): Add optional 'parent-form' parameter and pass it to 'syntax-violation' when it is true. (make-syntactic-constructor): Pass S as a third argument to 'report-invalid-field-specifier'. * guix/ui.scm (report-load-error): For 'syntax-error', show SUBFORM or FORM in the message. * tests/records.scm ("define-record-type* & wrong field specifier"): Add a 'subform' parameter and adjust test accordingly. ("define-record-type* & wrong field specifier, identifier"): New test. * tests/guix-system.sh: Add test. --- guix/records.scm | 19 ++++++++++++++----- guix/ui.scm | 5 +++-- 2 files changed, 17 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/records.scm b/guix/records.scm index 99507dc384..4bda5426a3 100644 --- a/guix/records.scm +++ b/guix/records.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -70,14 +70,22 @@ interface\" (ABI) for TYPE is equal to COOKIE." "~a: record ABI mismatch; recompilation needed" (list #,type) '())))) - (define (report-invalid-field-specifier name bindings) - "Report the first invalid binding among BINDINGS." + (define* (report-invalid-field-specifier name bindings + #:optional parent-form) + "Report the first invalid binding among BINDINGS. PARENT-FORM is used for +error-reporting purposes." (let loop ((bindings bindings)) (syntax-case bindings () (((field value) rest ...) ;good (loop #'(rest ...))) ((weird _ ...) ;weird! - (syntax-violation name "invalid field specifier" #'weird))))) + ;; WEIRD may be an identifier, thus lacking source location info, and + ;; BINDINGS is a list, also lacking source location info. Hopefully + ;; PARENT-FORM provides source location info. + (apply syntax-violation name "invalid field specifier" + (if parent-form + (list parent-form #'weird) + (list #'weird))))))) (define (report-duplicate-field-specifier name ctor) "Report the first duplicate identifier among the bindings in CTOR." @@ -233,7 +241,8 @@ of TYPE matches the expansion-time ABI." ;; Report precisely which one is faulty, instead of letting the ;; "source expression failed to match any pattern" error. (report-invalid-field-specifier 'name - #'(bindings (... ...)))))))))) + #'(bindings (... ...)) + s)))))))) (define-syntax-rule (define-field-property-predicate predicate property) "Define PREDICATE as a procedure that takes a syntax object and, when passed diff --git a/guix/ui.scm b/guix/ui.scm index b99a9e59f5..01aeee49eb 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -372,9 +372,10 @@ ARGS is the list of arguments received by the 'throw' handler." (format (current-error-port) (G_ "~amissing closing parenthesis~%") location)) (apply throw args))) - (('syntax-error proc message properties form . rest) + (('syntax-error proc message properties form subform . rest) (let ((loc (source-properties->location properties))) - (report-error loc (G_ "~a~%") message))) + (report-error loc (G_ "~s: ~a~%") + (or subform form) message))) (('unbound-variable _ ...) (report-unbound-variable-error args #:frame frame)) (((or 'srfi-34 '%exception) obj) -- cgit v1.2.3 From 3597c0396b9bd6440c02462107c743c6aeb29672 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 21:42:27 +0100 Subject: lzlib: Define 'dictionary-size+match-length-limit'. * guix/lzlib.scm (%compression-levels): Splice the rest of each element. (dictionary-size+match-length-limit): New procedure. (make-lzip-output-port, make-lzip-input-port/compressed): Use it. * tests/lzlib.scm ("Bytevector of size relative to Lzip internal buffers (2 * dictionary)"): Use 'dictionary-size+match-length-limit' instead of 'assoc-ref'. --- guix/lzlib.scm | 42 ++++++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/lzlib.scm b/guix/lzlib.scm index 24c7b4b448..2fc326ba34 100644 --- a/guix/lzlib.scm +++ b/guix/lzlib.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Pierre Neidhardt -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,7 +32,8 @@ call-with-lzip-input-port call-with-lzip-output-port %default-member-length-limit - %default-compression-level)) + %default-compression-level + dictionary-size+match-length-limit)) ;;; Commentary: ;;; @@ -569,20 +570,27 @@ the number of uncompressed bytes written, a non-negative integer." ;; Alist of (levels (dictionary-size match-length-limit)). 0 is the fastest. ;; See bbexample.c in lzlib's source. (define %compression-levels - `((0 (65535 16)) - (1 (,(bitwise-arithmetic-shift-left 1 20) 5)) - (2 (,(bitwise-arithmetic-shift-left 3 19) 6)) - (3 (,(bitwise-arithmetic-shift-left 1 21) 8)) - (4 (,(bitwise-arithmetic-shift-left 3 20) 12)) - (5 (,(bitwise-arithmetic-shift-left 1 22) 20)) - (6 (,(bitwise-arithmetic-shift-left 1 23) 36)) - (7 (,(bitwise-arithmetic-shift-left 1 24) 68)) - (8 (,(bitwise-arithmetic-shift-left 3 23) 132)) - (9 (,(bitwise-arithmetic-shift-left 1 25) 273)))) + `((0 65535 16) + (1 ,(bitwise-arithmetic-shift-left 1 20) 5) + (2 ,(bitwise-arithmetic-shift-left 3 19) 6) + (3 ,(bitwise-arithmetic-shift-left 1 21) 8) + (4 ,(bitwise-arithmetic-shift-left 3 20) 12) + (5 ,(bitwise-arithmetic-shift-left 1 22) 20) + (6 ,(bitwise-arithmetic-shift-left 1 23) 36) + (7 ,(bitwise-arithmetic-shift-left 1 24) 68) + (8 ,(bitwise-arithmetic-shift-left 3 23) 132) + (9 ,(bitwise-arithmetic-shift-left 1 25) 273))) (define %default-compression-level 6) +(define (dictionary-size+match-length-limit level) + "Return two values: the dictionary size for LEVEL, and its match-length +limit. LEVEL must be a compression level, an integer between 0 and 9." + (match (assv-ref %compression-levels level) + ((dictionary-size match-length-limit) + (values dictionary-size match-length-limit)))) + (define* (make-lzip-input-port port) "Return an input port that decompresses data read from PORT, a file port. PORT is automatically closed when the resulting port is closed." @@ -602,8 +610,9 @@ PORT is automatically closed when the resulting port is closed." "Return an output port that compresses data at the given LEVEL, using PORT, a file port, as its sink. PORT is automatically closed when the resulting port is closed." - (define encoder (apply lz-compress-open - (car (assoc-ref %compression-levels level)))) + (define encoder + (call-with-values (lambda () (dictionary-size+match-length-limit level)) + lz-compress-open)) (define (write! bv start count) (lzwrite encoder bv port start count)) @@ -626,8 +635,9 @@ port is closed." (level %default-compression-level)) "Return an input port that compresses data read from PORT, with the given LEVEL. PORT is automatically closed when the resulting port is closed." - (define encoder (apply lz-compress-open - (car (assoc-ref %compression-levels level)))) + (define encoder + (call-with-values (lambda () (dictionary-size+match-length-limit level)) + lz-compress-open)) (define input-buffer (make-bytevector 8192)) (define input-len 0) -- cgit v1.2.3 From 72c678af55390ce01bec590f760ab95af67663b2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 21:45:36 +0100 Subject: import: crate: Export 'string->license'. * guix/import/crate.scm (string->license): Export. * tests/crate.scm (string->license): Remove. --- guix/import/crate.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/crate.scm b/guix/import/crate.scm index 405a26a877..57823c3639 100644 --- a/guix/import/crate.scm +++ b/guix/import/crate.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 David Craven -;;; Copyright © 2019 Ludovic Courtès +;;; Copyright © 2019, 2020 Ludovic Courtès ;;; Copyright © 2019 Martin Becze ;;; ;;; This file is part of GNU Guix. @@ -40,6 +40,7 @@ #:use-module (srfi srfi-26) #:export (crate->guix-package guix-package->crate-name + string->license crate-recursive-import %crate-updater)) -- cgit v1.2.3 From cfd1ed84013df85f0e473884ef4038b4bd7120d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 21:47:36 +0100 Subject: import: cran: Avoid uses of '@@' in the tests. * guix/import/cran.scm (description->alist, description->package): Export. : Set! 'listify'. * tests/cran.scm (description-alist, "description->package"): Remove use of '@@' to access the relevant bindings. --- guix/import/cran.scm | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 13771ec598..bcb37ed250 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -54,7 +54,10 @@ cran-package? bioconductor-package? bioconductor-data-package? - bioconductor-experiment-package?)) + bioconductor-experiment-package? + + description->alist + description->package)) ;;; Commentary: ;;; @@ -270,6 +273,10 @@ empty list when the FIELD cannot be found." (string-any char-set:whitespace item))) (map string-trim-both items)))))) +;; Trick Guile 3 so that it keeps the 'listify' binding accessible *and* +;; private even though this module is declarative. +(set! listify listify) + (define default-r-packages (list "base" "compiler" -- cgit v1.2.3 From 9d6c6cb20ef240221fc9a8e155f4bfa53e71bce4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 16 Jan 2020 22:49:41 +0100 Subject: import: elpa: Rewrite test to use an HTTP server instead of mocking. * guix/import/elpa.scm (elpa-url): Add 'gnu/http'. (elpa->guix-package): Handle it. * tests/elpa.scm (elpa-package-info-mock, auctex-readme-mock) (elpa-version->string, package-source-url, ensure-list) (package-home-page, make-elpa-package): Remove. : Call '%http-server-port'. (eval-test-with-elpa): Remove uses of 'mock'. Use 'with-http-server' and parameterize 'current-http-proxy' instead. --- guix/import/elpa.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 83354d3f04..2d4487dba0 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa -;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2015, 2016, 2017, 2018, 2020 Ludovic Courtès ;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. @@ -72,6 +72,7 @@ NAMES (strings)." "Retrieve the URL of REPO." (let ((elpa-archives '((gnu . "https://elpa.gnu.org/packages") + (gnu/http . "http://elpa.gnu.org/packages") ;for testing (melpa-stable . "https://stable.melpa.org/packages") (melpa . "https://melpa.org/packages")))) (assq-ref elpa-archives repo))) @@ -251,7 +252,7 @@ type ''." (package ;; ELPA is known to contain only GPLv3+ code. Other repos may contain ;; code under other license but there's no license metadata. - (let ((license (and (eq? 'gnu repo) 'license:gpl3+))) + (let ((license (and (memq repo '(gnu gnu/http)) 'license:gpl3+))) (elpa-package->sexp package license))))) -- cgit v1.2.3 From fd4c832bdbc4bc3e9479ad1bab6590d03ae78b60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Jan 2020 11:23:34 +0100 Subject: lint: derivation: Adjust exception handling for Guile 3. This makes sure the "derivation: invalid arguments" test passes on Guile 3.0.0. Without this change, the lint warning would only include the format string instead of the key and arguments. * guix/lint.scm (exception-with-kind-and-args?): New procedure. (check-derivation): Use it. --- guix/lint.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/lint.scm b/guix/lint.scm index d2f24c61f8..697bd24a1e 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -905,16 +905,31 @@ descriptions maintained upstream." (origin-uris origin)) '()))) +(cond-expand + (guile-3 + ;; Guile 3.0.0 does not export this predicate. + (define exception-with-kind-and-args? + (exception-predicate &exception-with-kind-and-args))) + (else ;Guile 2 + (define exception-with-kind-and-args? + (const #f)))) + (define (check-derivation package) "Emit a warning if we fail to compile PACKAGE to a derivation." (define (try system) - (catch #t + (catch #t ;TODO: Remove 'catch' when Guile 2.x is no longer supported. (lambda () (guard (c ((store-protocol-error? c) (make-warning package (G_ "failed to create ~a derivation: ~a") (list system (store-protocol-error-message c)))) + ((exception-with-kind-and-args? c) + (make-warning package + (G_ "failed to create ~a derivation: ~s") + (list system + (cons (exception-kind c) + (exception-args c))))) ((message-condition? c) (make-warning package (G_ "failed to create ~a derivation: ~a") -- cgit v1.2.3 From fcb2318e51d33a9319619f9486a7ac486db2af37 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Jan 2020 11:27:37 +0100 Subject: lint: vulnerabilities: Avoid 'mock' in test. * guix/lint.scm (check-vulnerabilities): Add 'package-vulnerabilities' optional parameter. * tests/lint.scm ("cve: one vulnerability"): Use it instead of 'mock'. --- guix/lint.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/lint.scm b/guix/lint.scm index 697bd24a1e..24fbf05202 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -1029,8 +1029,11 @@ the NIST server non-fatal." (package-version package)))) ((force lookup) name version))))) -(define (check-vulnerabilities package) - "Check for known vulnerabilities for PACKAGE." +(define* (check-vulnerabilities package + #:optional (package-vulnerabilities + package-vulnerabilities)) + "Check for known vulnerabilities for PACKAGE. Obtain the list of +vulnerability records for PACKAGE by calling PACKAGE-VULNERABILITIES." (let ((package (or (package-replacement package) package))) (match (package-vulnerabilities package) (() -- cgit v1.2.3 From 282f91790a5bbd0d9b3223c4bfd45b66e418c200 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Jan 2020 13:48:23 +0100 Subject: import: opam: Avoid uses of '@@' in tests. * guix/import/opam.scm (string-pat, multiline-string, list-pat) (dict, condition): Export. (opam-fetch): Add optional 'repository' parameter. (opam->guix-package): Add #:repository parameter and pass it to 'opam-fetch'. * tests/opam.scm ("opam->guix-package"): Remove use of 'mock' and pass TEST-REPO to 'opam->guix-package' instead. ("parse-strings", "parse-multiline-strings") ("parse-lists", "parse-dicts", "parse-conditions"): Remove uses of '@@', which are no longer needed. --- guix/import/opam.scm | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/import/opam.scm b/guix/import/opam.scm index e258c4197f..394415fdd4 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -1,3 +1,4 @@ +;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller ;;; ;;; This file is part of GNU Guix. @@ -38,7 +39,14 @@ #:use-module ((guix licenses) #:prefix license:) #:export (opam->guix-package opam-recursive-import - %opam-updater)) + %opam-updater + + ;; The following patterns are exported for testing purposes. + string-pat + multiline-string + list-pat + dict + condition)) ;; Define a PEG parser for the opam format (define-peg-pattern comment none (and "#" (* STRCHR) "\n")) @@ -233,8 +241,8 @@ path to the repository." (list dependency (list 'unquote (string->symbol dependency)))) (ocaml-names->guix-names lst))) -(define (opam-fetch name) - (and-let* ((repository (get-opam-repository)) +(define* (opam-fetch name #:optional (repository (get-opam-repository))) + (and-let* ((repository repository) (version (find-latest-version name repository)) (file (string-append repository "/packages/" name "/" name "." version "/opam"))) `(("metadata" ,@(get-metadata file)) @@ -242,8 +250,11 @@ path to the repository." (substring version 1) version))))) -(define (opam->guix-package name) - (and-let* ((opam-file (opam-fetch name)) +(define* (opam->guix-package name #:key repository) + "Import OPAM package NAME from REPOSITORY (a directory name) or, if +REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp +or #f on failure." + (and-let* ((opam-file (opam-fetch name repository)) (version (assoc-ref opam-file "version")) (opam-content (assoc-ref opam-file "metadata")) (url-dict (metadata-ref opam-content "url")) -- cgit v1.2.3 From 6f918d69b4824226c877c0ca6385360a1dd38bbd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Jan 2020 13:50:53 +0100 Subject: import: texlive: Avoid uses of '@@' in tests. * guix/import/texlive.scm (fetch-sxml, sxml->package): Export. * tests/texlive.scm : Call '%http-server-port'. ("fetch-sxml: returns SXML for valid XML"): Use 'with-http-server' and set 'current-http-proxy' instead of using 'mock'. ("sxml->package"): Remove use of '@@'. --- guix/import/texlive.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index d528aace9a..a84683ef6f 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -38,7 +38,10 @@ #:use-module (guix packages) #:use-module (gnu packages) #:use-module (guix build-system texlive) - #:export (texlive->guix-package)) + #:export (texlive->guix-package + + fetch-sxml + sxml->package)) ;;; Commentary: ;;; -- cgit v1.2.3 From abbb98714b455f36373c17f00c82db9d1c41d5db Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 17 Jan 2020 17:11:34 +0100 Subject: ui: Ignore 'raise-exception' frames when reporting exceptions. * guix/ui.scm (last-frame-with-source): Check whether FRAME corresponds to 'raise-exception' and skip it if it does. --- guix/ui.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 01aeee49eb..4857a88827 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -175,7 +175,11 @@ information, or #f if it could not be found." (previous frame)) (if (not frame) previous - (if (frame-source frame) + + ;; On Guile 3, the latest frame with source may be that of + ;; 'raise-exception' in boot-9.scm. Skip it. + (if (and (frame-source frame) + (not (eq? 'raise-exception (frame-procedure-name frame)))) frame (loop (frame-previous frame) frame))))) -- cgit v1.2.3 From e478fd9747c0a97212ec86871c68feb1641961bb Mon Sep 17 00:00:00 2001 From: zimoun Date: Fri, 17 Jan 2020 18:30:00 +0100 Subject: refresh: Fix internal variable name. * guix/scripts/refresh.scm (%option): Fix internal variable name. --- guix/scripts/refresh.scm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index bc8e906054..efada1df5a 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -120,16 +120,16 @@ ;; The short option -L is already used by --list-updaters, therefore ;; it needs to be removed from %standard-build-options. - (let ((%load-path-option (find (lambda (option) + (let ((load-path-option (find (lambda (option) (member "load-path" (option-names option))) %standard-build-options))) (option (filter (lambda (name) (not (equal? #\L name))) - (option-names %load-path-option)) - (option-required-arg? %load-path-option) - (option-optional-arg? %load-path-option) - (option-processor %load-path-option))) + (option-names load-path-option)) + (option-required-arg? load-path-option) + (option-optional-arg? load-path-option) + (option-processor load-path-option))) (option '(#\h "help") #f #f (lambda args -- cgit v1.2.3 From a9f4a7eee379accded2bd1515d8acb0746ea0517 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Jan 2020 21:54:46 +0100 Subject: repl: Add "-q". * guix/scripts/repl.scm (%options, show-help): Add "-q". (guix-repl): Add 'user-config' and use it. Honor 'ignore-dot-guile?'. --- guix/scripts/repl.scm | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) (limited to 'guix') diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index fc3e4e2131..721c0a7450 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018, 2019 Ludovic Courtès +;;; Copyright © 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2020 Simon Tournier ;;; ;;; This file is part of GNU Guix. @@ -55,6 +55,9 @@ (option '("listen") #t #f (lambda (opt name arg result) (alist-cons 'listen arg result))) + (option '(#\q) #f #f + (lambda (opt name arg result) + (alist-cons 'ignore-dot-guile? #t result))) (find (lambda (option) (member "load-path" (option-names option))) %standard-build-options))) @@ -67,6 +70,8 @@ Start a Guile REPL in the Guix execution environment.\n")) -t, --type=TYPE start a REPL of the given TYPE")) (display (G_ " --listen=ENDPOINT listen ENDPOINT instead of standard I/O")) + (display (G_ " + -q inhibit loading of ~/.guile")) (newline) (display (G_ " -L, --load-path=DIR prepend DIR to the package module search path")) @@ -139,6 +144,11 @@ call THUNK." (leave (G_ "~A: extraneous argument~%") arg)) %default-options)) + (define user-config + (and=> (getenv "HOME") + (lambda (home) + (string-append home "/.guile")))) + (with-error-handling (let ((type (assoc-ref opts 'type))) (call-with-connection (assoc-ref opts 'listen) @@ -148,11 +158,11 @@ call THUNK." (save-module-excursion (lambda () (set-current-module user-module) - (and=> (getenv "HOME") - (lambda (home) - (let ((guile (string-append home "/.guile"))) - (when (file-exists? guile) - (load guile))))) + (when (and (not (assoc-ref opts 'ignore-dot-guile?)) + user-config + (file-exists? user-config)) + (load user-config)) + ;; Do not exit repl on SIGINT. ((@@ (ice-9 top-repl) call-with-sigint) (lambda () -- cgit v1.2.3 From eb6025322017e9096470b449a0dfb2be65668402 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Jan 2020 21:56:04 +0100 Subject: repl: Adjust "--listen" help message. * guix/scripts/repl.scm (show-help): Adjust "--listen" string. --- guix/scripts/repl.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index 721c0a7450..a9268da29e 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -69,7 +69,7 @@ Start a Guile REPL in the Guix execution environment.\n")) (display (G_ " -t, --type=TYPE start a REPL of the given TYPE")) (display (G_ " - --listen=ENDPOINT listen ENDPOINT instead of standard I/O")) + --listen=ENDPOINT listen to ENDPOINT instead of standard input")) (display (G_ " -q inhibit loading of ~/.guile")) (newline) -- cgit v1.2.3 From 358f66a004bc232aca1c51d04776a2ae0c1fbc9a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Jan 2020 22:01:33 +0100 Subject: repl: Avoid dependency on high-level package modules. * guix/scripts/repl.scm: Remove imports of (guix scripts build), (gnu packages), (guix utils), and (guix packages). (%options): Define "--load-path" option right here. --- guix/scripts/repl.scm | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm index a9268da29e..ff1f208894 100644 --- a/guix/scripts/repl.scm +++ b/guix/scripts/repl.scm @@ -20,11 +20,7 @@ (define-module (guix scripts repl) #:use-module (guix ui) #:use-module (guix scripts) - #:use-module ((guix scripts build) #:select (%standard-build-options)) #:use-module (guix repl) - #:use-module (guix utils) - #:use-module (guix packages) - #:use-module (gnu packages) #:use-module (srfi srfi-1) #:use-module (srfi srfi-37) #:use-module (ice-9 match) @@ -58,9 +54,12 @@ (option '(#\q) #f #f (lambda (opt name arg result) (alist-cons 'ignore-dot-guile? #t result))) - (find (lambda (option) - (member "load-path" (option-names option))) - %standard-build-options))) + (option '(#\L "load-path") #t #f + (lambda (opt name arg result) + ;; XXX: Imperatively modify the search paths. + (set! %load-path (cons arg %load-path)) + (set! %load-compiled-path (cons arg %load-compiled-path)) + result)))) (define (show-help) -- cgit v1.2.3 From b782688d71f707a8a263abc69c2745d815c45ec7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Jan 2020 22:42:27 +0100 Subject: syscalls: Pass the right 'throw' arguments in 'call-with-file-lock/no-wait'. Reported by Matt Wette in . * guix/build/syscalls.scm (call-with-file-lock/no-wait): When re-throwing, pass KEY in addition to ARGS. --- guix/build/syscalls.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 248d6761fc..ae79a9708f 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, 2019 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Mathieu Othacehe @@ -1140,7 +1140,7 @@ exception if it's already taken." ;; at this point. (if (= ENOSYS (system-error-errno (cons key args))) #f - (apply throw args))) + (apply throw key args))) (_ (apply throw key args))))))) (dynamic-wind (lambda () -- cgit v1.2.3 From 7842ddcbc118cbc2799e22651732b7cdc06b93ee Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 19 Jan 2020 22:52:31 +0100 Subject: guix package: Create profiles/per-user/$USER upfront. Fixes . Reported by Matt Wette . * guix/scripts/package.scm (build-and-use-profile): Move 'ensure-default-profile' call to... (process-actions): ... here. --- guix/scripts/package.scm | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index f4d92a649e..1cb0d382bf 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -137,9 +137,6 @@ denote ranges as interpreted by 'matching-generations'." specified in MANIFEST, a manifest object. When ALLOW-COLLISIONS? is true, do not treat collisions in MANIFEST as an error. HOOKS is a list of \"profile hooks\" run when building the profile." - (when (equal? profile %current-profile) - (ensure-default-profile)) - (let* ((prof-drv (run-with-store store (profile-derivation manifest #:allow-collisions? allow-collisions? @@ -865,6 +862,12 @@ processed, #f otherwise." (package-version item) (manifest-entry-version entry)))))) + (when (equal? profile %current-profile) + ;; Normally the daemon created %CURRENT-PROFILE when we connected, unless + ;; it's a version that lacks the fix for + ;; (aka. CVE-2019-18192). Ensure %CURRENT-PROFILE exists so that + ;; 'with-profile-lock' can create its lock file below. + (ensure-default-profile)) ;; First, acquire a lock on the profile, to ensure only one guix process ;; is modifying it at a time. -- cgit v1.2.3