From c173819c8e5235ce02d60b79bd88b10023a7c614 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 30 Jul 2023 10:57:41 +0200 Subject: guix: profiles: Fix auto-generated file deletion. * guix/profiles.scm (texlive-font-maps): Make sure auto-generated file exists before deleting it, which is not guaranteed when creating the initial texmf tree union. This is a followup to e43cbeafd1b632f39b08b3644af5230d5350a656. --- guix/profiles.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index 6c88759cae..c62d7f4d22 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1815,9 +1815,12 @@ MANIFEST." #:create-all-directories? #t #:log-port (%make-void-port "w")) - ;; Clear files that are going to be regenerated. + ;; Clear files that are going to be regenerated, or copied from + ;; a different place, in order to prevent failures during profile + ;; generation. (with-directory-excursion "/tmp/texlive/share/texmf-dist" - (for-each delete-file + (for-each (lambda (file) + (when (file-exists? file) (delete-file file))) (list "fonts/map/dvipdfmx/updmap/kanjix.map" "fonts/map/dvips/updmap/builtin35.map" "fonts/map/dvips/updmap/download35.map" -- cgit v1.2.3 From 5652c2e14728cf746f86c4ec34a84e99eb34f9a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 8 Aug 2023 11:47:08 +0200 Subject: system: Do not check initrd modules for pseudo file systems. Reported by hako on #guix. * gnu/machine/ssh.scm (machine-check-initrd-modules): Filter out pseudo file systems from 'file-systems'. * guix/scripts/system.scm (check-initrd-modules): Likewise. --- guix/scripts/system.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index f1154dad33..acbe3dab2c 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -686,7 +686,10 @@ checking this by themselves in their 'check' procedure." (find-partition-by-label (file-system-label->string device)))))) (define file-systems - (filter file-system-needed-for-boot? + (filter (lambda (file-system) + (and (file-system-needed-for-boot? file-system) + (not (member (file-system-type file-system) + %pseudo-file-system-types)))) (operating-system-file-systems os))) (for-each (lambda (fs) -- cgit v1.2.3 From 3481a5cb37cacbb54f74a2b1fa52ffc5c972b09f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 9 Aug 2023 10:45:42 +0200 Subject: guix: profiles: Do not raise error on incomplete TeX Live setups. * guix/profiles.scm (texlive-font-maps): Check if TEXLIVE-SCRIPTS is present in the manifest before trying to generate font maps. --- guix/profiles.scm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/profiles.scm b/guix/profiles.scm index c62d7f4d22..2bd6477cf8 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1787,6 +1787,11 @@ MANIFEST." (cons (gexp-input thing output) (append-map entry->texlive-input deps)) '())))) + (define texlive-scripts-entry? + (match-lambda + (($ name version output thing deps) + (or (string=? "texlive-scripts" name) + (any texlive-scripts-entry? deps))))) (define texlive-inputs (append-map entry->texlive-input (manifest-entries manifest))) (define texlive-scripts @@ -1887,9 +1892,11 @@ MANIFEST." (copy-recursively a b) (invoke mktexlsr b) (install-file (string-append b "/ls-R") a)))))) - (with-monad %store-monad - (if (pair? texlive-inputs) + ;; `texlive-scripts' brings essential files to generate font maps. + ;; Therefore, it must be present in the profile. This check prevents + ;; incomplete modular TeX Live installations to generate errors. + (if (any texlive-scripts-entry? (manifest-entries manifest)) (gexp->derivation "texlive-font-maps" build #:substitutable? #f #:local-build? #t -- cgit v1.2.3 From 3f092e4d762636ebef394d2a61d4967dcffe806d Mon Sep 17 00:00:00 2001 From: walky_talky Date: Tue, 18 Jul 2023 13:36:11 +0800 Subject: licenses: Add Arphic-1999 (Aprhic Public License). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/licenses.scm (arphic-1999): New variable. * guix/import/utils.scm (%spdx-license-identifiers): Add Arphic-1999. Signed-off-by: 宋文武 --- guix/import/utils.scm | 1 + guix/licenses.scm | 9 +++++++++ 2 files changed, 10 insertions(+) (limited to 'guix') diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 257570e95b..fcd7707482 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -179,6 +179,7 @@ thrown." ("AGPL-3.0" . license:agpl3) ("AGPL-3.0-only" . license:agpl3) ("AGPL-3.0-or-later" . license:agpl3+) + ("Arphic-1999" . license:arphic-1999) ("Apache-1.1" . license:asl1.1) ("Apache-2.0" . license:asl2.0) ("APSL-2.0" . license:apsl2) diff --git a/guix/licenses.scm b/guix/licenses.scm index 10f36b02f9..d200614d91 100644 --- a/guix/licenses.scm +++ b/guix/licenses.scm @@ -42,6 +42,7 @@ afl2.1 agpl1 agpl3 agpl3+ apsl2 + arphic-1999 asl1.1 asl2.0 boost1.0 bsd-0 bsd-1 bsd-2 bsd-3 bsd-4 @@ -197,6 +198,14 @@ cases, reduces to #t at macro-expansion time." "https://directory.fsf.org/wiki/License:APSL-2.0" "https://www.gnu.org/licenses/license-list.html#apsl2")) +;; This is a copyleft free software license, incompatible with the GPL. Its +;; normal use is for fonts, and in that use, the incompatibility does not +;; cause a problem. +(define arphic-1999 + (license "Arphic Public License" + "https://directory.fsf.org/wiki/License:Arphic-PL" + "https://www.gnu.org/licenses/license-list.html#Arphic")) + (define asl1.1 (license "ASL 1.1" "http://directory.fsf.org/wiki/License:Apache1.1" -- cgit v1.2.3 From 3e5192e6bb3f1f0d80a87c1e69d6a9f3da267b28 Mon Sep 17 00:00:00 2001 From: Zheng Junjie <873216071@qq.com> Date: Fri, 21 Jul 2023 15:22:59 +0800 Subject: build: qt-utils: Wrap QML2_IMPORT_PATH with 'prefix' location. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Some qml files have optional or circular dependencies, use 'prefix' instead of '=' to get those dependencies from environment/profile. * guix/build/qt-utils.scm (variables-for-wrapping): Use 'prefix' for QML2_IMPORT_PATH. Signed-off-by: 宋文武 --- guix/build/qt-utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm index f52e3f7af5..7d1b0e0e23 100644 --- a/guix/build/qt-utils.scm +++ b/guix/build/qt-utils.scm @@ -90,7 +90,7 @@ '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg") `("QT_PLUGIN_PATH" prefix directory ,(format #f "/lib/qt~a/plugins" qt-major-version)) - `("QML2_IMPORT_PATH" = directory + `("QML2_IMPORT_PATH" prefix directory ,(format #f "/lib/qt~a/qml" qt-major-version)) ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the ;; most suitable environment variable type for it. -- cgit v1.2.3 From bcdafd00a3acad32db68e300ce4d67f25583b4d4 Mon Sep 17 00:00:00 2001 From: fanquake Date: Tue, 8 Aug 2023 16:39:47 +0200 Subject: platform: Add powerpc64-linux. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/platforms/powerpc.scm (powerpc64-linux): New variable. Co-authored-by: Ludovic Courtès --- guix/platforms/powerpc.scm | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'guix') diff --git a/guix/platforms/powerpc.scm b/guix/platforms/powerpc.scm index 9d0b343bc3..1c7141ab42 100644 --- a/guix/platforms/powerpc.scm +++ b/guix/platforms/powerpc.scm @@ -20,6 +20,7 @@ #:use-module (guix platform) #:use-module (guix records) #:export (powerpc-linux + powerpc64-linux powerpc64le-linux)) (define powerpc-linux @@ -29,6 +30,13 @@ (linux-architecture "powerpc") (glibc-dynamic-linker "/lib/ld.so.1"))) +(define powerpc64-linux + (platform + (target "powerpc64-linux-gnu") + (system #f) ;not supported + (linux-architecture "powerpc") + (glibc-dynamic-linker "/lib/ld64.so.1"))) + (define powerpc64le-linux (platform (target "powerpc64le-linux-gnu") -- cgit v1.2.3 From 9be28375cf6d900e075b470412d629ddbd8710c0 Mon Sep 17 00:00:00 2001 From: Nicolas Graves Date: Wed, 9 Aug 2023 11:28:34 +0200 Subject: reconfigure: Use let* from srfi-71. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/system/reconfigure.scm (upgrade-shepherd-services): Merge 'let' + 'let*' in just 'let*'. Signed-off-by: Ludovic Courtès --- guix/scripts/system/reconfigure.scm | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) (limited to 'guix') diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 9948df0ca6..ff6242ffb4 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -186,22 +186,22 @@ services as defined by OS." #:target-type shepherd-root-service-type)))) (mlet* %store-monad ((live-services (running-services eval))) - (let ((to-unload to-restart - (shepherd-service-upgrade live-services target-services))) - (let* ((to-unload (map live-service-canonical-name to-unload)) - (to-restart (map shepherd-service-canonical-name to-restart)) - (running (map live-service-canonical-name - (filter live-service-running live-services))) - (to-start (lset-difference eqv? - (map shepherd-service-canonical-name - target-services) - running)) - (service-files (map shepherd-service-file target-services))) - (eval #~(parameterize ((current-warning-port (%make-void-port "w"))) - (primitive-load #$(upgrade-services-program service-files - to-start - to-unload - to-restart)))))))) + (let* ((to-unload to-restart + (shepherd-service-upgrade live-services target-services)) + (to-unload (map live-service-canonical-name to-unload)) + (to-restart (map shepherd-service-canonical-name to-restart)) + (running (map live-service-canonical-name + (filter live-service-running live-services))) + (to-start (lset-difference eqv? + (map shepherd-service-canonical-name + target-services) + running)) + (service-files (map shepherd-service-file target-services))) + (eval #~(parameterize ((current-warning-port (%make-void-port "w"))) + (primitive-load #$(upgrade-services-program service-files + to-start + to-unload + to-restart))))))) ;;; -- cgit v1.2.3 From 6f03e4be8588165a8b470a6276d19eca318dc70a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 14 Aug 2023 13:42:52 +0200 Subject: guix: import: Handle X11 license in texlive importer. * guix/import/texlive.scm (string->license): Recognize X11 license. --- guix/import/texlive.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'guix') diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index b5a812b34e..f65347d7f8 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -101,6 +101,7 @@ ("cc-by-sa-3" 'cc-by-sa3.0) ("cc-by-sa-4" 'cc-by-sa4.0) ("mit" 'expat) + ("x11" 'x11) ("fdl" 'fdl1.3+) ;; The GUST Font Nosource License, which is legally equivalent to ;; lppl1.3c+, is no longer in use (per -- cgit v1.2.3 From 1619f2c18c1b3cca41f52fea3d7231b9ad490af8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 14 Aug 2023 13:44:06 +0200 Subject: guix: import: Do not prefix `fsf-free' with "license:" in texlive. * guix/import/texlive.scm (tlpdb->package): For consistency with other imported licenses, `fsf-free' need not be prefixed with "license:". --- guix/import/texlive.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index f65347d7f8..581bd1b85b 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -500,7 +500,7 @@ of those files are returned that are unexpectedly installed." (license ,(cond (meta-package? - '(license:fsf-free "https://www.tug.org/texlive/copying.html")) + '(fsf-free "https://www.tug.org/texlive/copying.html")) ((assoc-ref data 'catalogue-license) => string->license) (else #f)))) (translate-depends depends #t))))) -- cgit v1.2.3 From 2884abb3df4f95cef75219435ce9c1c968068568 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Fri, 11 Aug 2023 17:09:08 -0400 Subject: refresh: Add --target-version option. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/refresh.scm (%options): Register 'target-version' long version. (update-specification->update-spec): Add a fallback-version argument. (options->update-specs): Honor target-version option. * tests/guix-refresh.sh: Test it. * doc/guix.texi (Invoking guix refresh): Document it. Reviewed-by: Ludovic Courtès --- guix/scripts/refresh.scm | 31 +++++++++++++++++++++++-------- 1 file changed, 23 insertions(+), 8 deletions(-) (limited to 'guix') diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index a9241aa20d..f39dc743b1 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2020 Simon Tournier ;;; Copyright © 2021 Sarah Morgensen ;;; Copyright © 2022 Hartmut Goebel +;;; Copyright © 2023 Maxim Cournoyer maxim.cournoyer@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -106,6 +107,9 @@ (option '(#\m "manifest") #t #f (lambda (opt name arg result) (alist-cons 'manifest arg result))) + (option '("target-version") #t #f + (lambda (opt name arg result) + (alist-cons 'target-version arg result))) (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) @@ -164,6 +168,9 @@ specified with `--select'.\n")) 'module:(gnu packages guile)'")) (display (G_ " -m, --manifest=FILE select all the packages from the manifest in FILE")) + (display (G_ " + --target-version=VERSION + update the package or packages to VERSION")) (display (G_ " -t, --type=UPDATER,... restrict to updates from the specified updaters (e.g., 'gnu')")) @@ -213,17 +220,20 @@ specified with `--select'.\n")) (define* (update-spec package #:optional version) (%update-spec package version)) -(define (update-specification->update-spec spec) +(define (update-specification->update-spec spec fallback-version) "Given SPEC, a package name like \"guile@2.0=2.0.8\", return a -record with two fields: the package to upgrade, and the target version." +record with two fields: the package to upgrade, and the target version. When +SPEC lacks a version, use FALLBACK-VERSION." (match (string-rindex spec #\=) - (#f (update-spec (specification->package spec) #f)) + (#f (update-spec (specification->package spec) fallback-version)) (idx (update-spec (specification->package (substring spec 0 idx)) (substring spec (1+ idx)))))) (define (options->update-specs opts) "Return the list of records requested by OPTS, honoring options like '--recursive'." + (define target-version (assoc-ref opts 'target-version)) + (define core-package? (let* ((input->package (match-lambda ((name (? package? package) _ ...) package) @@ -263,13 +273,18 @@ update would trigger a complete rebuild." ;; Update specs explicitly passed as command-line arguments. (match (append-map (match-lambda (('argument . spec) - ;; Take either the specified version or the - ;; latest one. - (list (update-specification->update-spec spec))) + ;; Take either the specified version or the latest + ;; one. The version specified as part of a spec + ;; takes precedence, with the command-line specified + ;; --target-version used as a fallback. + (list (update-specification->update-spec + spec target-version))) (('expression . exp) - (list (update-spec (read/eval-package-expression exp)))) + (list (update-spec (read/eval-package-expression exp) + target-version))) (('manifest . manifest) - (map update-spec (packages-from-manifest manifest))) + (map (cut update-spec <> target-version) + (packages-from-manifest manifest))) (_ '())) opts) -- cgit v1.2.3 From 1804a99d055570e7c6e14415790cb7689ce1aa17 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 16 Aug 2023 11:46:17 +0200 Subject: guix: import: texlive importer handles Ruby linked scripts. * guix/import/texlive.scm (linked-scripts): Also check for scripts with ".rb" extension. (tlpdb->package): Add proper RUBY input for Ruby linked scripts. --- guix/import/texlive.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/import/texlive.scm b/guix/import/texlive.scm index 581bd1b85b..7e79c77884 100644 --- a/guix/import/texlive.scm +++ b/guix/import/texlive.scm @@ -299,7 +299,7 @@ When TEXLIVE-ONLY is true, only TeX Live packages are returned." (define (linked-scripts name package-database) "Return a list of script names to symlink from \"bin/\" directory for package NAME according to PACKAGE-DATABASE. Consider as scripts files with -\".lua\", \".pl\", \".py\", \".sh\", \".tcl\", \".texlua\", \".tlu\" +\".lua\", \".pl\", \".py\", \".rb\", \".sh\", \".tcl\", \".texlua\", \".tlu\" extensions, and files without extension." (and-let* ((data (assoc-ref package-database name)) ;; Check if binaries are associated to the package. @@ -318,7 +318,8 @@ extensions, and files without extension." (filter-map (lambda (script) (and (any (lambda (ext) (member (basename script ext) binaries)) - '(".lua" ".pl" ".py" ".sh" ".tcl" ".texlua" ".tlu")) + '(".lua" ".pl" ".py" ".rb" ".sh" ".tcl" ".texlua" + ".tlu")) (basename script))) ;; Get the right (alphabetic) order. (reverse scripts)))) @@ -477,6 +478,7 @@ of those files are returned that are unexpectedly installed." ,@(match (append-map (lambda (s) (cond ((string-suffix? ".pl" s) '(perl)) ((string-suffix? ".py" s) '(python)) + ((string-suffix? ".rb" s) '(ruby)) ((string-suffix? ".tcl" s) '(tcl tk)) (else '()))) (or scripts '())) -- cgit v1.2.3 From bb7369ba8a4898567804fb7cef2ed97d77264d82 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 16 Aug 2023 19:45:28 +0200 Subject: guix home: Create /tmp in container if needed. Previously 'guix home container' would create a container without /tmp, which would prevent 'least-authority-wrapper' programs from starting, for example. * guix/scripts/home.scm (spawn-home-container): Create /tmp if it doesn't exist yet. --- guix/scripts/home.scm | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'guix') diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm index fbd5689be8..e0800bc062 100644 --- a/guix/scripts/home.scm +++ b/guix/scripts/home.scm @@ -330,6 +330,10 @@ immediately. Return the exit status of the process in the container." (display "127.0.0.1 localhost\n" port) (chmod port #o444)))) + ;; Create /tmp; bits of code expect it, such as + ;; 'least-authority-wrapper'. + (mkdir-p "/tmp") + ;; Set PATH for things that the activation script might expect, such ;; as "env". (load-profile #$system-profile) -- cgit v1.2.3 From addffd09884897d8977cd90da09c3bc1c9d2689a Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 19 Jul 2023 22:27:06 -0400 Subject: git: Clarify commit relation reference in doc. * guix/git.scm (update-cached-checkout): Clarify that it is the relation of STARTING-COMMIT that is returned, relative to the new commit, not the other way around. --- guix/git.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/git.scm b/guix/git.scm index be20cde019..dbc3b7caa7 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -439,7 +439,7 @@ could not be fetched from Software Heritage~%") #:recursive? recursive?))) "Update the cached checkout of URL to REF in CACHE-DIRECTORY. Return three values: the cache directory name, and the SHA1 commit (a string) corresponding -to REF, and the relation of the new commit relative to STARTING-COMMIT (if +to REF, and the relation of STARTING-COMMIT relative to the new commit (if provided) as returned by 'commit-relation'. REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value -- cgit v1.2.3 From ecab937897385fce3e3ce0c5f128afba4304187c Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Tue, 15 Aug 2023 14:43:11 -0400 Subject: pull: Tag commit argument with 'tag-or-commit. For compatibility with (guix git) procedures. * guix/scripts/pull.scm (channel-list): Also accept tag-or-commit tagged refspec. --- guix/scripts/pull.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index ecd264d3fa..9b78d4b5ca 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -166,7 +166,7 @@ Download and deploy the latest version of Guix.\n")) (alist-delete 'repository-url result)))) (option '("commit") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(commit . ,arg) result))) + (alist-cons 'ref `(tag-or-commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) @@ -774,7 +774,8 @@ Use '~/.config/guix/channels.scm' instead.")) (if (guix-channel? c) (let ((url (or url (channel-url c)))) (match ref - (('commit . commit) + ((or ('commit . commit) + ('tag-or-commit . commit)) (channel (inherit c) (url url) (commit commit) (branch #f))) (('branch . branch) -- cgit v1.2.3 From 79ec651a286c71a3d4c72be33a1f80e76a560031 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Wed, 19 Jul 2023 11:31:50 -0400 Subject: scripts: time-machine: Error when attempting to visit too old commits. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Invoking guix time-machine): Document limitation. * guix/inferior.scm (cached-channel-instance): New VALIDATE-CHANNELS argument. Use it to validate channels when there are no cache hit. * guix/scripts/time-machine.scm (%options): Tag the given reference with 'tag-or-commit instead of 'commit. (%oldest-possible-commit): New variable. (guix-time-machine) : New nested procedure. Pass it to the 'cached-channel-instance' call. * tests/guix-time-machine.sh: New test. * Makefile.am (SH_TESTS): Register it. Suggested-by: Simon Tournier Reviewed-by: Ludovic Courtès Reviewed-by: Simon Tournier --- guix/inferior.scm | 57 ++++++++++++++++++++++++------------------- guix/scripts/time-machine.scm | 38 ++++++++++++++++++++++++++--- 2 files changed, 67 insertions(+), 28 deletions(-) (limited to 'guix') diff --git a/guix/inferior.scm b/guix/inferior.scm index 5dfd30a6c8..fca6fb4b22 100644 --- a/guix/inferior.scm +++ b/guix/inferior.scm @@ -871,11 +871,15 @@ prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." #:key (authenticate? #t) (cache-directory (%inferior-cache-directory)) - (ttl (* 3600 24 30))) + (ttl (* 3600 24 30)) + validate-channels) "Return a directory containing a guix filetree defined by CHANNELS, a list of channels. -The directory is a subdirectory of CACHE-DIRECTORY, where entries can be reclaimed after TTL seconds. -This procedure opens a new connection to the build daemon. AUTHENTICATE? -determines whether CHANNELS are authenticated." +The directory is a subdirectory of CACHE-DIRECTORY, where entries can be +reclaimed after TTL seconds. This procedure opens a new connection to the +build daemon. AUTHENTICATE? determines whether CHANNELS are authenticated. +VALIDATE-CHANNELS, if specified, must be a one argument procedure accepting a +list of channels that can be used to validate the channels; it should raise an +exception in case of problems." (define commits ;; Since computing the instances of CHANNELS is I/O-intensive, use a ;; cheaper way to get the commit list of CHANNELS. This limits overhead @@ -923,27 +927,30 @@ determines whether CHANNELS are authenticated." (if (file-exists? cached) cached - (run-with-store store - (mlet* %store-monad ((instances - -> (latest-channel-instances store channels - #:authenticate? - authenticate?)) - (profile - (channel-instances->derivation instances))) - (mbegin %store-monad - ;; It's up to the caller to install a build handler to report - ;; what's going to be built. - (built-derivations (list profile)) - - ;; Cache if and only if AUTHENTICATE? is true. - (if authenticate? - (mbegin %store-monad - (symlink* (derivation->output-path profile) cached) - (add-indirect-root* cached) - (return cached)) - (mbegin %store-monad - (add-temp-root* (derivation->output-path profile)) - (return (derivation->output-path profile))))))))) + (begin + (when (procedure? validate-channels) + (validate-channels channels)) + (run-with-store store + (mlet* %store-monad ((instances + -> (latest-channel-instances store channels + #:authenticate? + authenticate?)) + (profile + (channel-instances->derivation instances))) + (mbegin %store-monad + ;; It's up to the caller to install a build handler to report + ;; what's going to be built. + (built-derivations (list profile)) + + ;; Cache if and only if AUTHENTICATE? is true. + (if authenticate? + (mbegin %store-monad + (symlink* (derivation->output-path profile) cached) + (add-indirect-root* cached) + (return cached)) + (mbegin %store-monad + (add-temp-root* (derivation->output-path profile)) + (return (derivation->output-path profile)))))))))) (define* (inferior-for-channels channels #:key diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index d7c71ef705..e4fe511382 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2019 Konrad Hinsen ;;; Copyright © 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2021 Simon Tournier +;;; Copyright © 2023 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,13 +20,15 @@ ;;; along with GNU Guix. If not, see . (define-module (guix scripts time-machine) + #:use-module (guix channels) + #:use-module (guix diagnostics) #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix inferior) #:use-module (guix store) #:use-module (guix status) #:use-module ((guix git) - #:select (with-git-error-handling)) + #:select (update-cached-checkout with-git-error-handling)) #:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix scripts pull) @@ -38,9 +41,17 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-71) #:export (guix-time-machine)) +;;; The required inferiors mechanism relied on by 'guix time-machine' was +;;; firmed up in v1.0.0; it is the oldest, safest commit that can be travelled +;;; to. +(define %oldest-possible-commit + "6298c3ffd9654d3231a6f25390b056483e8f407c") ;v1.0.0 + ;;; ;;; Command-line options. @@ -81,7 +92,7 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (alist-delete 'repository-url result)))) (option '("commit") #t #f (lambda (opt name arg result) - (alist-cons 'ref `(commit . ,arg) result))) + (alist-cons 'ref `(tag-or-commit . ,arg) result))) (option '("branch") #t #f (lambda (opt name arg result) (alist-cons 'ref `(branch . ,arg) result))) @@ -140,8 +151,27 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (let* ((opts (parse-args args)) (channels (channel-list opts)) (command-line (assoc-ref opts 'exec)) + (ref (assoc-ref opts 'ref)) (substitutes? (assoc-ref opts 'substitutes?)) (authenticate? (assoc-ref opts 'authenticate-channels?))) + + (define (validate-guix-channel channels) + "Finds the Guix channel among CHANNELS, and validates that REF as +captured from the closure, a git reference specification such as a commit hash +or tag associated to CHANNEL, is valid and new enough to satisfy the 'guix +time-machine' requirements. A `formatted-message' condition is raised +otherwise." + (let* ((guix-channel (find guix-channel? channels)) + (checkout commit relation (update-cached-checkout + (channel-url guix-channel) + #:ref (or ref '()) + #:starting-commit + %oldest-possible-commit))) + (unless (memq relation '(ancestor self)) + (raise (formatted-message + (G_ "cannot travel past commit `~a' from May 1st, 2019") + (string-take %oldest-possible-commit 12)))))) + (when command-line (let* ((directory (with-store store @@ -153,6 +183,8 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) #:dry-run? #f) (set-build-options-from-command-line store opts) (cached-channel-instance store channels - #:authenticate? authenticate?))))) + #:authenticate? authenticate? + #:validate-channels + validate-guix-channel))))) (executable (string-append directory "/bin/guix"))) (apply execl (cons* executable executable command-line)))))))) -- cgit v1.2.3 From 3363ff1867bb02c4aa4955db917ef1d67f2c47e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 11 Aug 2023 17:20:06 +0200 Subject: ui: 'load*' accepts /dev/fd/N files pointing to a pipe. This allows users to write Bash commands like: guix time-machine -C <(echo %default-channels) -- ... or: guix build -m <(echo '(specifications->manifest (list "guile"))') Previously, on GNU/Linux, they would fail with: error: failed to load '/dev/fd/63': No such file or directory * guix/ui.scm (try-canonicalize-path): New procedure. (load*): Use it. * tests/guix-build.sh: Test 'guix build -m' with a /dev/fd/N file. --- guix/ui.scm | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'guix') diff --git a/guix/ui.scm b/guix/ui.scm index 47a118364a..6f2d4fe245 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -200,6 +200,20 @@ information, or #f if it could not be found." (parameterize (((@ (system base compile) default-optimization-level) 1)) exp)) +(define (try-canonicalize-path file) + "Like 'canonicalize-path', but return FILE as-is if 'canonicalize-path' +throws. + +This is necessary for corner cases where 'canonicalize-path' fails. One +example is on Linux when a /dev/fd/N file denotes a pipe, represented as a +symlink to a non-existent file like 'pipe:[1234]', as in this example: + + sh -c 'stat $(readlink -f /dev/fd/1)' | cat" + (catch 'system-error + (lambda () + (canonicalize-path file)) + (const file))) + (define* (load* file user-module #:key (on-error 'nothing-special)) "Load the user provided Scheme source code FILE." @@ -230,7 +244,7 @@ information, or #f if it could not be found." ;; 'primitive-load', so that FILE is compiled, which then allows ;; us to provide better error reporting with source line numbers. (without-compiler-optimizations - (load (canonicalize-path file)))) + (load (try-canonicalize-path file)))) (const #f)))))) (lambda _ ;; XXX: Errors are reported from the pre-unwind handler below, but -- cgit v1.2.3 From 9c8098424b5be3abf21144c74162ec39c0c2e799 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 11 Aug 2023 16:54:26 +0200 Subject: pull, time-machine: Add '-q' to ignore channel files. This also fixes . * guix/scripts/pull.scm (show-help, %options): Add '-q'. (channel-list): Honor it. * guix/scripts/time-machine.scm (show-help, %options): Add '-q'. * doc/guix.texi (Invoking guix pull, Invoking guix time-machine): Document it. Reported-by: Simon Tournier --- guix/scripts/pull.scm | 15 +++++++++++++-- guix/scripts/time-machine.scm | 8 +++++++- 2 files changed, 20 insertions(+), 3 deletions(-) (limited to 'guix') diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 9b78d4b5ca..759c3a94a3 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -84,6 +84,9 @@ Download and deploy the latest version of Guix.\n")) (display (G_ " -C, --channels=FILE deploy the channels defined in FILE")) + (display (G_ " + -q, --no-channel-files + inhibit loading of user and system 'channels.scm'")) (display (G_ " --url=URL download \"guix\" channel from the Git repository at URL")) (display (G_ " @@ -133,6 +136,9 @@ Download and deploy the latest version of Guix.\n")) (cons* (option '(#\C "channels") #t #f (lambda (opt name arg result) (alist-cons 'channel-file arg result))) + (option '(#\q "no-channel-files") #f #f + (lambda (opt name arg result) + (alist-cons 'ignore-channel-files? #t result))) (option '(#\l "list-generations") #f #t (lambda (opt name arg result) (cons `(query list-generations ,arg) @@ -735,6 +741,9 @@ transformations specified in OPTS (resulting from '--url', '--commit', or (define file (assoc-ref opts 'channel-file)) + (define ignore-channel-files? + (assoc-ref opts 'ignore-channel-files?)) + (define default-file (string-append (config-directory) "/channels.scm")) @@ -750,9 +759,11 @@ transformations specified in OPTS (resulting from '--url', '--commit', or (define channels (cond (file (load-channels file)) - ((file-exists? default-file) + ((and (not ignore-channel-files?) + (file-exists? default-file)) (load-channels default-file)) - ((file-exists? global-file) + ((and (not ignore-channel-files?) + (file-exists? global-file)) (load-channels global-file)) (else %default-channels))) diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm index e4fe511382..87000d82ec 100644 --- a/guix/scripts/time-machine.scm +++ b/guix/scripts/time-machine.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Konrad Hinsen -;;; Copyright © 2019, 2020, 2021 Ludovic Courtès +;;; Copyright © 2019, 2020, 2021, 2023 Ludovic Courtès ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2023 Maxim Cournoyer ;;; @@ -62,6 +62,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (display (G_ " -C, --channels=FILE deploy the channels defined in FILE")) + (display (G_ " + -q, --no-channel-files + inhibit loading of user and system 'channels.scm'")) (display (G_ " --url=URL use the Git repository at URL")) (display (G_ " @@ -86,6 +89,9 @@ Execute COMMAND ARGS... in an older version of Guix.\n")) (cons* (option '(#\C "channels") #t #f (lambda (opt name arg result) (alist-cons 'channel-file arg result))) + (option '(#\q "no-channel-files") #f #f + (lambda (opt name arg result) + (alist-cons 'ignore-channel-files? #t result))) (option '("url") #t #f (lambda (opt name arg result) (alist-cons 'repository-url arg -- cgit v1.2.3