From 8c620a60367e26b30dae22988e2ddc972b64234d Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 12 Aug 2022 18:59:11 +0200 Subject: import/cran: download: Accept optional REF argument. * guix/import/cran.scm (download): Accept REF argument for git downloads. --- guix/import/cran.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 4e1ce7c010..69d01b5f7c 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -200,11 +200,11 @@ bioconductor package NAME, or #F if the package is unknown." ;; Little helper to download URLs only once. (define download (memoize - (lambda* (url #:key method) + (lambda* (url #:key method (ref '())) (with-store store (cond ((eq? method 'git) - (latest-repository-commit store url)) + (latest-repository-commit store url #:ref ref)) ((eq? method 'hg) (call-with-temporary-directory (lambda (dir) -- cgit v1.2.3 From ec92bcaaddbe205f439b7ec11825117515e3d07c Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus Date: Fri, 12 Aug 2022 19:59:50 +0200 Subject: import/cran: description->package: Use COND and computed booleans. * guix/import/cran.scm (description->package): Use COND with previously computed booleans instead of using CASE on REPOSITORY. --- guix/import/cran.scm | 62 ++++++++++++++++++++++++++-------------------------- 1 file changed, 31 insertions(+), 31 deletions(-) (limited to 'guix') diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 69d01b5f7c..d7f6945675 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -516,32 +516,32 @@ from the alist META, which was derived from the R package's DESCRIPTION file." (package `(package (name ,(cran-guix-name name)) - (version ,(case repository - ((git) - `(git-version ,version revision commit)) - ((hg) - `(string-append ,version "-" revision "." changeset)) - (else version))) + (version ,(cond + (git? + `(git-version ,version revision commit)) + (hg? + `(string-append ,version "-" revision "." changeset)) + (else version))) (source (origin (method ,(cond (git? 'git-fetch) (hg? 'hg-fetch) (else 'url-fetch))) - (uri ,(case repository - ((git) - `(git-reference - (url ,(assoc-ref meta 'git)) - (commit commit))) - ((hg) - `(hg-reference - (url ,(assoc-ref meta 'hg)) - (changeset changeset))) - (else - `(,(procedure-name uri-helper) ,name version - ,@(or (and=> (assoc-ref meta 'bioconductor-type) - (lambda (type) - (list (list 'quote type)))) - '()))))) + (uri ,(cond + (git? + `(git-reference + (url ,(assoc-ref meta 'git)) + (commit commit))) + (hg? + `(hg-reference + (url ,(assoc-ref meta 'hg)) + (changeset changeset))) + (else + `(,(procedure-name uri-helper) ,name version + ,@(or (and=> (assoc-ref meta 'bioconductor-type) + (lambda (type) + (list (list 'quote type)))) + '()))))) ,@(cond (git? '((file-name (git-file-name name version)))) @@ -576,16 +576,16 @@ from the alist META, which was derived from the R package's DESCRIPTION file." ""))) (license ,license)))) (values - (case repository - ((git) - `(let ((commit ,(assoc-ref meta 'git-commit)) - (revision "1")) - ,package)) - ((hg) - `(let ((changeset ,(assoc-ref meta 'hg-changeset)) - (revision "1")) - ,package)) - (else package)) + (cond + (git? + `(let ((commit ,(assoc-ref meta 'git-commit)) + (revision "1")) + ,package)) + (hg? + `(let ((changeset ,(assoc-ref meta 'hg-changeset)) + (revision "1")) + ,package)) + (else package)) propagate))) (define cran->guix-package -- cgit v1.2.3 From 818220f1ccd57d14a62f07489b0e5e21837bb3dd Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 15 Sep 2022 08:51:39 +0200 Subject: weather: Actually show the weather. * guix/scripts/weather.scm (report-server-coverage): Show a weather icon. --- guix/scripts/weather.scm | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index b7d8165262..f46c11b1a5 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -205,7 +205,6 @@ In case ITEMS is an empty list, return 1 instead." #:make-progress-reporter (lambda* (total #:key url #:allow-other-keys) (progress-reporter/bar total))))) - (format #t (highlight "~a~%") server) (let ((obtained (length narinfos)) (requested (length items)) (missing (lset-difference string=? @@ -224,6 +223,15 @@ In case ITEMS is an empty list, return 1 instead." (coloring-procedure (color BOLD RED))) (else highlight)))) + (format #t (highlight "~a ~a~%") server + ;; This requires a Unicode-capable encoding, which we + ;; restrict to UTF-8 for simplicity. + (if (string=? (port-encoding (current-output-port)) "UTF-8") + (cond ((> ratio 0.80) "☀") + ((< ratio 0.50) "⛈") + (else "⛅")) + "")) + (format #t (colorize (G_ " ~,1f% substitutes available (~h out of ~h)~%")) (* 100. ratio) -- cgit v1.2.3 From 7a698da0d04d75f1c49f9ae9f358070acab0f781 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 17 Sep 2022 16:15:17 +0200 Subject: read-print: Correctly support multiple same-named newline forms. Previously (home-environment (services ...)) would not be considered a "newline form". This fixes it. * guix/read-print.scm (newline-form?): Use 'vhash-foldq*' instead of 'vhash-assq' and iterate over candidates. * tests/read-print.scm: Add test. --- guix/read-print.scm | 7 +++---- tests/read-print.scm | 5 +++++ 2 files changed, 8 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/read-print.scm b/guix/read-print.scm index a5a1b708bf..c8849e767b 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -367,10 +367,9 @@ surrounding SYMBOL." (define (newline-form? symbol context) "Return true if parenthesized expressions starting with SYMBOL must be followed by a newline." - (match (vhash-assq symbol %newline-forms) - (#f #f) - ((_ . prefix) - (prefix? prefix context)))) + (let ((matches (vhash-foldq* cons '() symbol %newline-forms))) + (find (cut prefix? <> context) + matches))) (define (escaped-string str) "Return STR with backslashes and double quotes escaped. Everything else, in diff --git a/tests/read-print.scm b/tests/read-print.scm index ca3f3193f7..ea52a52145 100644 --- a/tests/read-print.scm +++ b/tests/read-print.scm @@ -294,6 +294,11 @@ mnopqrstuvwxyz.\")" ;; page break above end)") +(test-pretty-print "\ +(home-environment + (services + (list (service-type home-bash-service-type))))") + (test-pretty-print/sequence "\ ;;; This is a top-level comment. -- cgit v1.2.3 From d0a1e48944cea22c6aebb22121eb21122a738d78 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 20 Sep 2022 11:52:39 +0200 Subject: read-print: Add rule for 'home-bash-configuration'. * guix/read-print.scm (%newline-forms): Add 'home-bash-configuration'. --- guix/read-print.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/read-print.scm b/guix/read-print.scm index c8849e767b..65b8cce37d 100644 --- a/guix/read-print.scm +++ b/guix/read-print.scm @@ -337,7 +337,8 @@ expressions and blanks that were read." ('services '(operating-system)) ('set-xorg-configuration '()) - ('services '(home-environment)))) + ('services '(home-environment)) + ('home-bash-configuration '(service)))) (define (prefix? candidate lst) "Return true if CANDIDATE is a prefix of LST." -- cgit v1.2.3 From 76c58ed59c05fa2ae14281109c9186e47ba810da Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 20 Sep 2022 11:58:32 +0200 Subject: home: import: Use (guix read-print) to render the config file. * guix/scripts/home/import.scm (manifest+configuration-files->code): Insert calls to 'comment' and 'vertical-space'. (import-manifest): Use 'pretty-print-with-comments/splice' instead of a loop on 'pretty-print'. * tests/home-import.scm (remove-recursively): New procedure. (eval-test-with-home-environment): Use it. --- guix/scripts/home/import.scm | 21 +++++++++++++++------ tests/home-import.scm | 11 ++++++++++- 2 files changed, 25 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm index 825ccb1e73..fd263c0699 100644 --- a/guix/scripts/home/import.scm +++ b/guix/scripts/home/import.scm @@ -26,9 +26,9 @@ #:use-module (guix utils) #:use-module (guix packages) #:autoload (guix scripts package) (manifest-entry-version-prefix) + #:use-module (guix read-print) #:use-module (gnu packages) #:use-module (ice-9 match) - #:use-module (ice-9 pretty-print) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 popen) @@ -170,8 +170,19 @@ user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them." (gnu services) ,@(delete-duplicates (concatenate modules))) + ,(vertical-space 1) + (home-environment - (packages (specifications->packages ,packages)) + ,(comment (G_ "\ +;; Below is the list of packages that will show up in your +;; Home profile, under ~/.guix-home/profile.\n")) + (packages + (specifications->packages ,packages)) + + ,(vertical-space 1) + ,(comment (G_ "\ +;; Below is the list of Home services. To search for available +;; services, run 'guix home search KEYWORD' in a terminal.\n")) (services (list ,@services))))))))) (define* (import-manifest @@ -187,7 +198,5 @@ user's files to CONFIGURATION-DIRECTORY; the generated sexp refers to them." ;; specifies package names. To reproduce the exact same profile, you also ;; need to capture the channels being used, as returned by \"guix describe\". ;; See the \"Replicating Guix\" section in the manual.\n")) - (for-each (lambda (exp) - (newline port) - (pretty-print exp port)) - exp)))) + (newline port) + (pretty-print-with-comments/splice port exp)))) diff --git a/tests/home-import.scm b/tests/home-import.scm index d62a6de648..04b7b76156 100644 --- a/tests/home-import.scm +++ b/tests/home-import.scm @@ -23,6 +23,7 @@ #:use-module (guix build utils) #:use-module (guix packages) #:use-module (ice-9 match) + #:use-module ((guix read-print) #:select (blank?)) #:use-module ((guix profiles) #:hide (manifest->code)) #:use-module ((guix build syscalls) #:select (mkdtemp!)) #:use-module ((guix scripts package) @@ -85,13 +86,21 @@ corresponding file." ((file . content) (create-file file content))) files-alist)) +(define (remove-recursively pred sexp) + "Like SRFI-1 'remove', but recurse within SEXP." + (let loop ((sexp sexp)) + (match sexp + ((lst ...) + (map loop (remove pred lst))) + (x x)))) + (define (eval-test-with-home-environment files-alist manifest matcher) (create-temporary-home files-alist) (setenv "HOME" %temporary-home-directory) (mkdir-p %temporary-home-directory) (let* ((home-environment (manifest+configuration-files->code manifest %destination-directory)) - (result (matcher home-environment))) + (result (matcher (remove-recursively blank? home-environment)))) (delete-file-recursively %temporary-home-directory) result)) -- cgit v1.2.3 From 08a7eb187f09aeefbb03b8b28b0d67aab33d4a06 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Sat, 24 Sep 2022 14:46:47 +0200 Subject: platforms: x86: Rename Hurd hurd to i586-gnu. * guix/platforms/x86.scm (hurd): Rename it to ... (i586-gnu): ... this variable. * gnu/system/images/hurd.scm (hurd-disk-image, hurd-barebones-disk-image, hurd-barebones-qcow2-image): Adapt those. --- gnu/system/images/hurd.scm | 6 +++--- guix/platforms/x86.scm | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) (limited to 'guix') diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm index 2c64117c08..9b618f7dc6 100644 --- a/gnu/system/images/hurd.scm +++ b/gnu/system/images/hurd.scm @@ -76,7 +76,7 @@ (define hurd-disk-image (image-without-os (format 'disk-image) - (platform hurd) + (platform i586-gnu) (partitions (list (partition (size 'guess) @@ -104,14 +104,14 @@ (define hurd-barebones-disk-image (image (inherit - (os+platform->image hurd-barebones-os hurd + (os+platform->image hurd-barebones-os i586-gnu #:type hurd-image-type)) (name 'hurd-barebones-disk-image))) (define hurd-barebones-qcow2-image (image (inherit - (os+platform->image hurd-barebones-os hurd + (os+platform->image hurd-barebones-os i586-gnu #:type hurd-qcow2-image-type)) (name 'hurd-barebones.qcow2))) diff --git a/guix/platforms/x86.scm b/guix/platforms/x86.scm index 5338049d6f..6f547dd770 100644 --- a/guix/platforms/x86.scm +++ b/guix/platforms/x86.scm @@ -23,7 +23,7 @@ x86_64-linux i686-mingw x86_64-mingw - hurd)) + i586-gnu)) (define i686-linux (platform @@ -51,7 +51,7 @@ (system #f) (glibc-dynamic-linker #f))) -(define hurd +(define i586-gnu (platform (target "i586-pc-gnu") (system "i586-gnu") -- cgit v1.2.3 From ebe9d660a55629f2506db124b0e016885fc61e5c Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 12 Sep 2022 08:31:36 +0200 Subject: gnu: Add compression module. Move the compression record to a dedicated module so that it can be used outside (guix scripts pack) module. * guix/scripts/pack.scm (, %compressors, lookup-compressor): Move it to ... * gnu/compression.scm: ... this new file. * gnu/ci.scm: Adapt it. * local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/ci.scm | 3 ++- gnu/compression.scm | 69 +++++++++++++++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + guix/scripts/pack.scm | 46 ++-------------------------------- 4 files changed, 74 insertions(+), 45 deletions(-) create mode 100644 gnu/compression.scm (limited to 'guix') diff --git a/gnu/ci.scm b/gnu/ci.scm index 2c51ea7387..19a48bdbf1 100644 --- a/gnu/ci.scm +++ b/gnu/ci.scm @@ -39,9 +39,10 @@ #:select (gpl3+ license? license-name)) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix scripts pack) - #:select (lookup-compressor self-contained-tarball)) + #:select (self-contained-tarball)) #:use-module (gnu bootloader) #:use-module (gnu bootloader u-boot) + #:use-module (gnu compression) #:use-module (gnu image) #:use-module (gnu packages) #:use-module (gnu packages gcc) diff --git a/gnu/compression.scm b/gnu/compression.scm new file mode 100644 index 0000000000..0418e80a15 --- /dev/null +++ b/gnu/compression.scm @@ -0,0 +1,69 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2022 Mathieu Othacehe +;;; +;;; 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 . + +(define-module (gnu compression) + #:use-module (guix gexp) + #:use-module (guix ui) + #:use-module ((gnu packages compression) #:hide (zip)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (ice-9 match) + #:export (compressor + compressor? + compressor-name + compressor-extension + compressor-command + %compressors + lookup-compressor)) + +;; Type of a compression tool. +(define-record-type + (compressor name extension command) + compressor? + (name compressor-name) ;string (e.g., "gzip") + (extension compressor-extension) ;string (e.g., ".lz") + (command compressor-command)) ;gexp (e.g., #~(list "/gnu/store/…/gzip" + ; "-9n" )) + +(define %compressors + ;; Available compression tools. + (list (compressor "gzip" ".gz" + #~(list #+(file-append gzip "/bin/gzip") "-9n")) + (compressor "lzip" ".lz" + #~(list #+(file-append lzip "/bin/lzip") "-9")) + (compressor "xz" ".xz" + #~(append (list #+(file-append xz "/bin/xz") + "-e") + (%xz-parallel-args))) + (compressor "bzip2" ".bz2" + #~(list #+(file-append bzip2 "/bin/bzip2") "-9")) + (compressor "zstd" ".zst" + ;; The default level 3 compresses better than gzip in a + ;; fraction of the time, while the highest level 19 + ;; (de)compresses more slowly and worse than xz. + #~(list #+(file-append zstd "/bin/zstd") "-3")) + (compressor "none" "" #f))) + +(define (lookup-compressor name) + "Return the compressor object called NAME. Error out if it could not be +found." + (or (find (match-lambda + (($ name*) + (string=? name* name))) + %compressors) + (leave (G_ "~a: compressor not found~%") name))) diff --git a/gnu/local.mk b/gnu/local.mk index 140845a7c6..4774be2688 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -81,6 +81,7 @@ GNU_SYSTEM_MODULES = \ %D%/bootloader/u-boot.scm \ %D%/bootloader/depthcharge.scm \ %D%/ci.scm \ + %D%/compression.scm \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/desktop.scm \ diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index d3ee69840c..78b6978c92 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -48,6 +48,7 @@ #:use-module (guix scripts build) #:use-module (guix transformations) #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (gnu compression) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages compression) #:hide (zip)) @@ -61,13 +62,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 match) - #:export (compressor? - compressor-name - compressor-extension - compressor-command - %compressors - lookup-compressor - self-contained-tarball + #:export (self-contained-tarball debian-archive docker-image squashfs-image @@ -75,34 +70,6 @@ %formats guix-pack)) -;; Type of a compression tool. -(define-record-type - (compressor name extension command) - compressor? - (name compressor-name) ;string (e.g., "gzip") - (extension compressor-extension) ;string (e.g., ".lz") - (command compressor-command)) ;gexp (e.g., #~(list "/gnu/store/…/gzip" - ; "-9n" )) - -(define %compressors - ;; Available compression tools. - (list (compressor "gzip" ".gz" - #~(list #+(file-append gzip "/bin/gzip") "-9n")) - (compressor "lzip" ".lz" - #~(list #+(file-append lzip "/bin/lzip") "-9")) - (compressor "xz" ".xz" - #~(append (list #+(file-append xz "/bin/xz") - "-e") - (%xz-parallel-args))) - (compressor "bzip2" ".bz2" - #~(list #+(file-append bzip2 "/bin/bzip2") "-9")) - (compressor "zstd" ".zst" - ;; The default level 3 compresses better than gzip in a - ;; fraction of the time, while the highest level 19 - ;; (de)compresses more slowly and worse than xz. - #~(list #+(file-append zstd "/bin/zstd") "-3")) - (compressor "none" "" #f))) - ;; This one is only for use in this module, so don't put it in %compressors. (define bootstrap-xz (compressor "bootstrap-xz" ".xz" @@ -110,15 +77,6 @@ "-e") (%xz-parallel-args)))) -(define (lookup-compressor name) - "Return the compressor object called NAME. Error out if it could not be -found." - (or (find (match-lambda - (($ name*) - (string=? name* name))) - %compressors) - (leave (G_ "~a: compressor not found~%") name))) - (define not-config? ;; Select (guix …) and (gnu …) modules, except (guix config). (match-lambda -- cgit v1.2.3 From 95e06bc3e1a4fda2b010d69776187ec2e1b02c1b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 23 Sep 2022 07:56:04 +0200 Subject: narinfo: Fix misleading docstring. The misleading docstring had been here from the start, in commit cdea30e061490a521f1e9c66ff870ca98ae5d7e5. * guix/narinfo.scm (valid-narinfo?): Fix docstring. --- guix/narinfo.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/narinfo.scm b/guix/narinfo.scm index 4fc550aa6c..741c7ad406 100644 --- a/guix/narinfo.scm +++ b/guix/narinfo.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2013-2022 Ludovic Courtès ;;; Copyright © 2014 Nikita Karetnikov ;;; Copyright © 2018 Kyle Meyer ;;; @@ -209,7 +209,8 @@ No authentication and authorization checks are performed here!" (define* (valid-narinfo? narinfo #:optional (acl (current-acl)) #:key verbose?) - "Return #t if NARINFO's signature is not valid." + "Return #t if NARINFO's signature is valid and made by one of the keys in +ACL." (let ((hash (narinfo-sha256 narinfo)) (signature (narinfo-signature narinfo)) (uri (uri->string (first (narinfo-uris narinfo))))) -- cgit v1.2.3 From 9e4d8c75183c226d0cba2de3b40e6a9e603ae43b Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 13 Sep 2022 13:01:05 +0200 Subject: build-system/go: Respect #:imported-modules when cross-compiling. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Previously, #:imported-modules was ignored, causing cross-compilation failures. This bug seems seems to have been introduced in e37dcf63dcea0817ffd74722ee5ff2d103aa2157. After this commit, there remain other cross-compilation problems, e.g. fixes one of them. * guix/build-system/go.scm (go-cross-build)[builder]: Wrap in with-imported-modules. Signed-off-by: Ludovic Courtès --- guix/build-system/go.scm | 67 ++++++++++++++++++++++++------------------------ 1 file changed, 34 insertions(+), 33 deletions(-) (limited to 'guix') diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm index 5e0e5bbad3..4b3b67b08f 100644 --- a/guix/build-system/go.scm +++ b/guix/build-system/go.scm @@ -240,45 +240,46 @@ commit hash and its date rather than a proper release tag." (substitutable? #t)) "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS." (define builder - #~(begin - (use-modules #$@(sexp->gexp modules)) + (with-imported-modules imported-modules + #~(begin + (use-modules #$@(sexp->gexp modules)) - (define %build-host-inputs - #+(input-tuples->gexp build-inputs)) + (define %build-host-inputs + #+(input-tuples->gexp build-inputs)) - (define %build-target-inputs - (append #$(input-tuples->gexp host-inputs) + (define %build-target-inputs + (append #$(input-tuples->gexp host-inputs) #+(input-tuples->gexp target-inputs))) - (define %build-inputs - (append %build-host-inputs %build-target-inputs)) + (define %build-inputs + (append %build-host-inputs %build-target-inputs)) - (define %outputs - #$(outputs->gexp outputs)) + (define %outputs + #$(outputs->gexp outputs)) - (go-build #:name #$name - #:source #+source - #:system #$system - #:phases #$phases - #:outputs %outputs - #:target #$target - #:goarch #$goarch - #:goos #$goos - #:inputs %build-target-inputs - #:native-inputs %build-host-inputs - #:search-paths '#$(map search-path-specification->sexp - search-paths) - #:native-search-paths '#$(map - search-path-specification->sexp - native-search-paths) - #:install-source? #$install-source? - #:import-path #$import-path - #:unpack-path #$unpack-path - #:build-flags #$build-flags - #:tests? #$tests? - #:make-dynamic-linker-cache? #f ;cross-compiling - #:allow-go-reference? #$allow-go-reference? - #:inputs %build-inputs))) + (go-build #:name #$name + #:source #+source + #:system #$system + #:phases #$phases + #:outputs %outputs + #:target #$target + #:goarch #$goarch + #:goos #$goos + #:inputs %build-target-inputs + #:native-inputs %build-host-inputs + #:search-paths '#$(map search-path-specification->sexp + search-paths) + #:native-search-paths '#$(map + search-path-specification->sexp + native-search-paths) + #:install-source? #$install-source? + #:import-path #$import-path + #:unpack-path #$unpack-path + #:build-flags #$build-flags + #:tests? #$tests? + #:make-dynamic-linker-cache? #f ;cross-compiling + #:allow-go-reference? #$allow-go-reference? + #:inputs %build-inputs)))) (mlet %store-monad ((guile (package->derivation (or guile (default-guile)) system #:graft? #f))) -- cgit v1.2.3 From fc5c4ce4ec2ecf6b7d9e227617777d8dd10b903a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:48 +0200 Subject: lint: Extract logic of 'check-mirror-url'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit It will be useful for fixing . * guix/lint.scm (check-mirror-url): Extract mirror://-constructing code to ... * guix/gnu-maintenance.scm (uri-mirror-rewrite): ... here, tweaking the API and implementation in anticipation of future users. Co-authored-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 21 +++++++++++++++++++++ guix/lint.scm | 26 +++++++++----------------- 2 files changed, 30 insertions(+), 17 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 1ffa408666..20e3bc1cba 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -33,6 +33,8 @@ #:use-module (rnrs io ports) #:use-module (system foreign) #:use-module ((guix http-client) #:hide (open-socket-for-uri)) + ;; not required in many cases, so autoloaded to reduce start-up costs. + #:autoload (guix download) (%mirrors) #:use-module (guix ftp-client) #:use-module (guix utils) #:use-module (guix memoization) @@ -58,6 +60,8 @@ find-package gnu-package? + uri-mirror-rewrite + release-file? releases latest-release @@ -658,6 +662,23 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." (string-append new (string-drop url (string-length old))) url))) +(define (uri-mirror-rewrite uri) + "Rewrite URI to a mirror:// URI if possible, or return URI unmodified." + (if (string-prefix? "mirror://" uri) + uri ;nothing to do, it's already a mirror URI + (let loop ((mirrors %mirrors)) + (match mirrors + (() + uri) + (((mirror-id mirror-urls ...) rest ...) + (match (find (cut string-prefix? <> uri) mirror-urls) + (#f + (loop rest)) + (prefix + (format #f "mirror://~a/~a" + mirror-id + (string-drop uri (string-length prefix)))))))))) + (define (adjusted-upstream-source source rewrite-url) "Rewrite URLs in SOURCE by apply REWRITE-URL to each of them." (upstream-source diff --git a/guix/lint.scm b/guix/lint.scm index edba1c2663..7ee3a3122f 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -12,7 +12,7 @@ ;;; Copyright © 2020 Chris Marusich ;;; Copyright © 2020 Timothy Sample ;;; Copyright © 2021 Xinglu Chen -;;; Copyright © 2021 Maxime Devos +;;; Copyright © 2021, 2022 Maxime Devos ;;; Copyright © 2021 Brice Waegeneire ;;; ;;; This file is part of GNU Guix. @@ -1222,22 +1222,14 @@ descriptions maintained upstream." (define (check-mirror-url package) "Check whether PACKAGE uses source URLs that should be 'mirror://'." - (define (check-mirror-uri uri) ;XXX: could be optimized - (let loop ((mirrors %mirrors)) - (match mirrors - (() - #f) - (((mirror-id mirror-urls ...) rest ...) - (match (find (cut string-prefix? <> uri) mirror-urls) - (#f - (loop rest)) - (prefix - (make-warning package - (G_ "URL should be \ -'mirror://~a/~a'") - (list mirror-id - (string-drop uri (string-length prefix))) - #:field 'source))))))) + (define (check-mirror-uri uri) + (define rewritten-uri + (uri-mirror-rewrite uri)) + + (and (not (string=? uri rewritten-uri)) + (make-warning package (G_ "URL should be '~a'") + (list rewritten-uri) + #:field 'source))) (let ((origin (package-source package))) (if (and (origin? origin) -- cgit v1.2.3 From d877dc098bcf1f1b2f39ba5a6e3701eda547d004 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:49 +0200 Subject: gnu-maintenance: Produce mirror:// URIs in latest-ftp-release. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Partially fixes . As a test, try updating gnupg. Before the patch, a ftp:// URL was produced, now the mirror:// is preserved. * guix/gnu-maintenance.scm (latest-ftp-release)[file->source]{urls,signature-urls}: Call uri-mirror-rewrite on the URLs. Signed-off-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 20e3bc1cba..b6450994e6 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -363,10 +363,12 @@ return the corresponding signature URL, or #f it signatures are unavailable." (upstream-source (package project) (version (tarball->version file)) - (urls (list url)) + ;; uri-mirror-rewrite: Don't turn nice mirror:// URIs into ftp:// + ;; URLs during "guix refresh -u". + (urls (list (uri-mirror-rewrite url))) (signature-urls (match (file->signature url) (#f #f) - (sig (list sig))))))) + (sig (list (uri-mirror-rewrite sig)))))))) (let loop ((directory directory) (result #f)) -- cgit v1.2.3 From 11ec14ff0ede22fa5e402baf46938b17513d21e6 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:50 +0200 Subject: gnu-maintenance: Produce mirror:// URIs in latest-html-release. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Partially fixes . I'm not aware of a package using both latest-html-release and mirrors, so it has not been completely tested. However, updating "yt-dlp" appears to work (except for git-fetch not being supported yet). The expression for the signature-urls field had to be tweaked to not call uri-mirror-rewrite on #false. * guix/gnu-maintenance.scm (latest-html-release)[url->research]{urls,signature-urls}: Call uri-mirror-rewrite on the URLs. Co-authored-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index b6450994e6..604522e913 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -538,9 +538,12 @@ are unavailable." (upstream-source (package package) (version version) - (urls (list url)) + ;; uri-mirror-rewrite: Don't turn nice mirror:// URIs into ftp:// + ;; URLs during "guix refresh -u". + (urls (list (uri-mirror-rewrite url))) (signature-urls - (list ((or file->signature file->signature/guess) url)))))))) + (and=> ((or file->signature file->signature/guess) url) + (lambda (url) (list (uri-mirror-rewrite url)))))))))) (define candidates (filter-map url->release links)) -- cgit v1.2.3 From 6c16de72de646137b04b4b5e82b816fdeb02ac65 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:51 +0200 Subject: download: Switch savannah mirrors to HTTPS URLs. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The URI scheme used for nongnu.freemirror.org needs to be consistent between (guix download) and (guix gnu-maintenance) to make the simplified savannah-updater (of a later commit) work. While we're at it, switch the other mirrors to https as well. http://download.savannah.gnu.org/releases-noredirect/ is left unmodified because it 404s * download.scm (%mirrors)[savannah]: Switch from http to https where possible. Signed-off-by: Ludovic Courtès --- guix/download.scm | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index d459ba8cf1..ac88b215de 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -96,15 +96,15 @@ (hackage "http://hackage.haskell.org/") (savannah ; http://download0.savannah.gnu.org/mirmon/savannah/ - "http://download.savannah.gnu.org/releases/" - "http://nongnu.freemirror.org/nongnu/" - "http://ftp.cc.uoc.gr/mirrors/nongnu.org/" - "http://ftp.twaren.net/Unix/NonGNU/" - "http://mirror.csclub.uwaterloo.ca/nongnu/" - "http://nongnu.askapache.com/" - "http://savannah.c3sl.ufpr.br/" + "https://download.savannah.gnu.org/releases/" + "https://nongnu.freemirror.org/nongnu/" + "https://ftp.cc.uoc.gr/mirrors/nongnu.org/" + "http://ftp.twaren.net/Unix/NonGNU/" ; https appears unsupported + "https://mirror.csclub.uwaterloo.ca/nongnu/" + "https://nongnu.askapache.com/" + "https://savannah.c3sl.ufpr.br/" "http://download.savannah.gnu.org/releases-noredirect/" - "http://download-mirror.savannah.gnu.org/releases/" + "https://download-mirror.savannah.gnu.org/releases/" "ftp://ftp.twaren.net/Unix/NonGNU/" "ftp://mirror.csclub.uwaterloo.ca/nongnu/" "ftp://mirror.publicns.net/pub/nongnu/" -- cgit v1.2.3 From e96f380fd42963fb08ccbd67e752470d4f42f223 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:52 +0200 Subject: gnu-maintenance: Simplify latest-savannah-release. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit As latest-html-release now produces mirror:// URIs where possible, the additional post-processing is not necessary anymore. As a test, try updating 'gash', the mirror:// URI remains. * gnu-maintenance.scm (latest-savannah-release): Do not call adjusted-upstream-source on the result. Signed-off-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 604522e913..cb774d2ed6 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -706,15 +706,12 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." ((? string? uri) uri) ((uri mirrors ...) uri)))) (package (package-upstream-name package)) - (directory (dirname (uri-path uri))) - (rewrite (url-prefix-rewrite %savannah-base - "mirror://savannah"))) + (directory (dirname (uri-path uri)))) ;; Note: We use the default 'file->signature', which adds ".sig", ".asc", ;; or whichever detached signature naming scheme PACKAGE uses. - (and=> (latest-html-release package - #:base-url %savannah-base - #:directory directory) - (cut adjusted-upstream-source <> rewrite)))) + (latest-html-release package + #:base-url %savannah-base + #:directory directory))) (define (latest-sourceforge-release package) "Return the latest release of PACKAGE." -- cgit v1.2.3 From 60474b5291360830983aa2c2514cb9da44259d1d Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:53 +0200 Subject: download: Add a kernel.org mirror. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add the mirror from (guix gnu-maintenance) to make the simplified linux.org updater (of a later commit) work. * download.scm (%mirrors)[kernel.org]: Add mirrors.edge.kernel.org mirror. Signed-off-by: Ludovic Courtès --- guix/download.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/download.scm b/guix/download.scm index ac88b215de..29a8f99034 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -138,6 +138,7 @@ "http://kernel.osuosl.org/pub/" "http://ftp.be.debian.org/pub/" "http://mirror.linux.org.au/" + "https://mirrors.edge.kernel.org/pub/" "ftp://ftp.funet.fi/pub/mirrors/ftp.kernel.org/pub/") (apache ; from http://www.apache.org/mirrors/dist.html "http://www.eu.apache.org/dist/" -- cgit v1.2.3 From d9b8169a9f3cd5bcafcd2f85af7c7c876272c540 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:54 +0200 Subject: gnu-maintenance: Simplify latest-kernel.org-release. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit As latest-html-release now produces mirror:// URIs where possible, the additional post-processing is not necessary anymore. As a test, revert the dtc package back to 1.6.0 and try updating 'gash', the mirror:// URI remains. * gnu-maintenance.scm (latest-kernel.org-release): Do not call adjusted-upstream-source on the result. Signed-off-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 13 +++++-------- 1 file changed, 5 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index cb774d2ed6..824762695c 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -791,14 +791,11 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." ((? string? uri) uri) ((uri mirrors ...) uri)))) (package (package-upstream-name package)) - (directory (dirname (uri-path uri))) - (rewrite (url-prefix-rewrite %kernel.org-base - "mirror://kernel.org"))) - (and=> (latest-html-release package - #:base-url %kernel.org-base - #:directory directory - #:file->signature file->signature) - (cut adjusted-upstream-source <> rewrite)))) + (directory (dirname (uri-path uri)))) + (latest-html-release package + #:base-url %kernel.org-base + #:directory directory + #:file->signature file->signature))) (define html-updatable-package? ;; Return true if the given package may be handled by the generic HTML -- cgit v1.2.3 From 55d4200002940506607472d326deb130edecf90e Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Thu, 1 Sep 2022 11:01:55 +0200 Subject: gnu-maintenance: Remove unused procedures. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/gnu-maintenance.scm (url-prefix-rewrite, adjusted-upstream-source): Remove. Signed-off-by: Ludovic Courtès --- guix/gnu-maintenance.scm | 16 ---------------- 1 file changed, 16 deletions(-) (limited to 'guix') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index 824762695c..f983debcd2 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -660,13 +660,6 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." (define gnu-hosted? (url-prefix-predicate "mirror://gnu/")) -(define (url-prefix-rewrite old new) - "Return a one-argument procedure that rewrites URL prefix OLD to NEW." - (lambda (url) - (if (and url (string-prefix? old url)) - (string-append new (string-drop url (string-length old))) - url))) - (define (uri-mirror-rewrite uri) "Rewrite URI to a mirror:// URI if possible, or return URI unmodified." (if (string-prefix? "mirror://" uri) @@ -684,15 +677,6 @@ GNOME packages; EMMS is included though, because its releases are on gnu.org." mirror-id (string-drop uri (string-length prefix)))))))))) -(define (adjusted-upstream-source source rewrite-url) - "Rewrite URLs in SOURCE by apply REWRITE-URL to each of them." - (upstream-source - (inherit source) - (urls (map rewrite-url (upstream-source-urls source))) - (signature-urls (and=> (upstream-source-signature-urls source) - (lambda (urls) - (map rewrite-url urls)))))) - (define %savannah-base ;; One of the Savannah mirrors listed at ;; that serves valid -- cgit v1.2.3 From 172207924e8491e654623d0a7e7503f80fddafc3 Mon Sep 17 00:00:00 2001 From: jgart Date: Thu, 15 Sep 2022 20:33:01 -0500 Subject: debug-link: Clarify what CRC is. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/debug-link.scm: Clarify "CRC"; update bug URL. Signed-off-by: Ludovic Courtès --- guix/build/debug-link.scm | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'guix') diff --git a/guix/build/debug-link.scm b/guix/build/debug-link.scm index 9167737fb3..f3284f74c4 100644 --- a/guix/build/debug-link.scm +++ b/guix/build/debug-link.scm @@ -38,10 +38,10 @@ ;;; create separate debug files (info "(gdb) Separate Debug Files"). ;;; ;;; The main facility of this module is 'graft-debug-links', which allows us -;;; to update the CRC that appears in '.gnu_debuglink' sections when grafting, -;;; such that separate debug files remain usable after grafting. Failing to -;;; do that, GDB would complain about CRC mismatch---see -;;; . +;;; to update the cyclic redundancy check (CRC) that appears in +;;; '.gnu_debuglink' sections when grafting, such that separate debug files +;;; remain usable after grafting. Failing to do that, GDB would complain +;;; about CRC mismatch---see . ;;; ;;; Code: -- cgit v1.2.3