From 7f923c8efe82974aac7cb38180b6cc9d56752222 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 --- 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 5ed72662fc3..e201d1969b0 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 ac0706aa0f1..fb0ba287730 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 c5bbb951a7f..120a97ab052 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 2d2d78ad150..272d733aa65 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 994563ab266..33a303a14c8 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 259c0744126..8daad24d97a 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.