From 15f87a0f037ec9b4f5045965416652670ffd955f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 14 Dec 2025 23:37:13 +0100 Subject: [PATCH] =?UTF-8?q?describe:=20Define=20and=20use=20=E2=80=98modul?= =?UTF-8?q?es-from-current-profile=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes . Fixes a bug whereby bootloader, image, platform, etc. modules would be searched for in locations other than the current profile, possibly leading to incompatible files being loaded. More generally, this bug would break statelessness: depending on what happens to be available in $GUILE_LOAD_PATH, some modules would or would not be loaded. * guix/describe.scm (modules-from-current-profile): New procedure. * gnu/bootloader.scm (bootloader-modules): Use it instead of ‘all-modules’. * gnu/system/image.scm (image-modules): Likewise. (not-config?): Rename to… (neither-config-nor-git?): … this, and add (guix git). Adjust users. * guix/import/utils.scm (build-system-modules): Likewise. * guix/platform.scm (platform-modules): Likewise. * guix/upstream.scm (importer-modules): Likewise. Change-Id: I8ac55a5bcdf54990665c70d0aa558b9b2c2548d4 Signed-off-by: Ludovic Courtès Merges: #4859 Signed-off-by: Rutherther --- gnu/bootloader.scm | 11 +++++------ gnu/system/image.scm | 23 +++++++++++++---------- guix/describe.scm | 22 ++++++++++++++++++++++ guix/import/utils.scm | 9 ++++----- guix/platform.scm | 7 +++---- guix/upstream.scm | 9 ++++----- 6 files changed, 51 insertions(+), 30 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 5ed72662fc30f5b6f31c517b4bdb43d1b19de3e9..e201d1969b0393109020fdac59afc59ea4290c71 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2017 David Craven ;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe ;;; Copyright © 2017 Leo Famulari -;;; Copyright © 2019, 2021, 2023 Ludovic Courtès +;;; Copyright © 2019, 2021, 2023, 2025 Ludovic Courtès ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2022 Josselin Poiret ;;; Copyright © 2022 Reza Alizadeh Majd @@ -26,7 +26,8 @@ (define-module (gnu bootloader) #:use-module (gnu system file-systems) #:use-module (gnu system uuid) - #:use-module (guix discovery) + #:autoload (guix discovery) (fold-module-public-variables) + #:autoload (guix describe) (modules-from-current-profile) #:use-module (guix gexp) #:use-module (guix profiles) #:use-module (guix records) @@ -305,10 +306,8 @@ instead~%"))) (define (bootloader-modules) "Return the list of bootloader modules." - (all-modules (map (lambda (entry) - `(,entry . "gnu/bootloader")) - %load-path) - #:warn warn-about-load-error)) + (modules-from-current-profile "gnu/bootloader" + #:warn warn-about-load-error)) (define %bootloaders ;; The list of publically-known bootloaders. diff --git a/gnu/system/image.scm b/gnu/system/image.scm index ac0706aa0f1e1f3e57fee513af59a079bb9a0395..fb0ba2877301b5b69927de3d9503d0589ebc6a01 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -25,7 +25,8 @@ (define-module (gnu system image) #:use-module (guix deprecation) #:use-module (guix diagnostics) - #:use-module (guix discovery) + #:autoload (guix discovery) (fold-module-public-variables) + #:autoload (guix describe) (modules-from-current-profile) #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix monads) @@ -315,10 +316,14 @@ set to the given OS." ;; Helpers. ;; -(define not-config? - ;; Select (guix …) and (gnu …) modules, except (guix config). +(define neither-config-nor-git? + ;; Select (guix …) and (gnu …) modules, except (guix config) and (guix git). + ;; The latter is autoloaded by some modules but it is not supposed to be + ;; actually used in the context of image creation; adding it to the module + ;; closure would imply adding Guile-Git as well. (match-lambda (('guix 'config) #f) + (('guix 'git) #f) (('guix rest ...) #t) (('gnu rest ...) #t) (rest #f))) @@ -352,7 +357,7 @@ set to the given OS." (gnu build hurd-boot) (gnu build linux-boot) (guix store database)) - #:select? not-config?) + #:select? neither-config-nor-git?) ((guix config) => ,(make-config.scm))) #~(begin (use-modules (gnu build image) @@ -786,7 +791,7 @@ output file." (guix build utils) (guix build store-copy) (gnu build image)) - #:select? not-config?) + #:select? neither-config-nor-git?) ((guix config) => ,(make-config.scm))) #~(begin (use-modules (guix docker) @@ -880,7 +885,7 @@ output file." (guix build utils) (guix store database) (gnu build image)) - #:select? not-config?) + #:select? neither-config-nor-git?) ((guix config) => ,(make-config.scm))) #~(begin (use-modules (guix build pack) @@ -1137,10 +1142,8 @@ image, depending on IMAGE format." (define (image-modules) "Return the list of image modules." (cons (resolve-interface '(gnu system image)) - (all-modules (map (lambda (entry) - `(,entry . "gnu/system/images/")) - %load-path) - #:warn warn-about-load-error))) + (modules-from-current-profile "gnu/system/images" + #:warn warn-about-load-error))) (define %image-types ;; The list of publically-known image types. diff --git a/guix/describe.scm b/guix/describe.scm index c5bbb951a7f1e1627dcbf79243e50162dcaad2fb..120a97ab05251564f1c44cad7982435e0009f207 100644 --- a/guix/describe.scm +++ b/guix/describe.scm @@ -26,6 +26,7 @@ #:autoload (guix channels) (channel-name sexp->channel manifest-entry-channel) + #:autoload (guix discovery) (all-modules) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-71) @@ -33,6 +34,7 @@ #:export (current-profile current-profile-date current-profile-entries + modules-from-current-profile current-channels package-path-entries append-channels-to-load-path! @@ -102,6 +104,26 @@ or #f if this is not applicable." ((program . _) (find-profile program))))) +(define* (modules-from-current-profile sub-directory + #:key (warn (const #f))) + "Return the list of modules from SUB-DIRECTORY found in (current-profile). +If 'current-profile' returns #f, search for those modules in each entry of +'%load-path'." + (all-modules (map (lambda (entry) + `(,entry . ,sub-directory)) + (match (current-profile-entries) + (() + %load-path) + (lst + ;; Browse modules from all the channels, including + ;; 'guix', and nothing else. + (map (lambda (entry) + (string-append (manifest-entry-item entry) + "/share/guile/site/" + (effective-version))) + lst)))) + #:warn warn)) + (define (current-profile-date) "Return the creation date of the current profile (produced by 'guix pull'), as a number of seconds since the Epoch, or #f if it could not be determined." diff --git a/guix/import/utils.scm b/guix/import/utils.scm index 2d2d78ad15054b5b7f5f3fbb044de43ff35f347e..272d733aa6513ec5b5e18b9b004223e2c685c893 100644 --- a/guix/import/utils.scm +++ b/guix/import/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2018, 2019, 2020, 2023 Ludovic Courtès +;;; Copyright © 2012-2013, 2018-2020, 2023, 2025 Ludovic Courtès ;;; Copyright © 2016 Jelle Licht ;;; Copyright © 2016 David Craven ;;; Copyright © 2017, 2019, 2020, 2022, 2023, 2024, 2025 Ricardo Wurmus @@ -42,7 +42,8 @@ #:use-module (guix packages) #:use-module (guix deprecation) #:use-module (guix diagnostics) - #:use-module (guix discovery) + #:autoload (guix discovery) (fold-module-public-variables) + #:autoload (guix describe) (modules-from-current-profile) #:use-module (guix build-system) #:use-module (guix git) #:use-module (guix hash) @@ -600,9 +601,7 @@ APPEND-VERSION?/string is a string, append this string." ,guix-package)))) (define (build-system-modules) - (all-modules (map (lambda (entry) - `(,entry . "guix/build-system")) - %load-path))) + (modules-from-current-profile "guix/build-system")) (define (lookup-build-system-by-name name) "Return a value for the symbol NAME, representing the name of diff --git a/guix/platform.scm b/guix/platform.scm index 994563ab26651ae1772416316e0fbb8935d3e3ad..33a303a14c83fbdfeb9605f9f09b304a08478310 100644 --- a/guix/platform.scm +++ b/guix/platform.scm @@ -21,6 +21,7 @@ #:use-module (guix memoization) #:use-module (guix records) #:use-module (guix ui) + #:autoload (guix describe) (modules-from-current-profile) #:use-module (srfi srfi-1) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -100,10 +101,8 @@ exception." (define (platform-modules) "Return the list of platform modules." - (all-modules (map (lambda (entry) - `(,entry . "guix/platforms")) - %load-path) - #:warn warn-about-load-error)) + (modules-from-current-profile "guix/platforms" + #:warn warn-about-load-error)) (define platforms ;; The list of publically-known platforms. diff --git a/guix/upstream.scm b/guix/upstream.scm index 259c07441266a8daaa1b0a4a0c602cf96d1c550a..8daad24d97a21feec0fbb50d4744dc7cb91b86b3 100644 --- a/guix/upstream.scm +++ b/guix/upstream.scm @@ -24,7 +24,8 @@ (define-module (guix upstream) #:use-module (guix records) #:use-module (guix utils) - #:use-module (guix discovery) + #:autoload (guix discovery) (fold-module-public-variables) + #:autoload (guix describe) (modules-from-current-profile) #:use-module ((guix download) #:select (download-to-store url-fetch)) #:use-module (guix git-download) @@ -219,10 +220,8 @@ correspond to the same version." (define (importer-modules) "Return the list of importer modules." (cons (resolve-interface '(guix gnu-maintenance)) - (all-modules (map (lambda (entry) - `(,entry . "guix/import")) - %load-path) - #:warn warn-about-load-error))) + (modules-from-current-profile "guix/import" + #:warn warn-about-load-error))) (define %updaters ;; The list of publically-known updaters, alphabetically sorted.