guix_mirror_bot pushed a commit to branch next-master
in repository guix.
commit b49e9e992e36ac9972273993da84ceea3424222e
Author: Ludovic Courtès <[email protected]>
AuthorDate: Sun Dec 14 23:37:13 2025 +0100
describe: Define and use ‘modules-from-current-profile’.
Fixes <https://issues.guix.gnu.org/75458>.
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 <[email protected]>
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 5ed72662fc..e201d1969b 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -2,7 +2,7 @@
;;; Copyright © 2017 David Craven <[email protected]>
;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe <[email protected]>
;;; Copyright © 2017 Leo Famulari <[email protected]>
-;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <[email protected]>
+;;; Copyright © 2019, 2021, 2023, 2025 Ludovic Courtès <[email protected]>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email protected]>
;;; Copyright © 2022 Josselin Poiret <[email protected]>
;;; Copyright © 2022 Reza Alizadeh Majd <[email protected]>
@@ -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 73686023a9..d47269a442 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 c5bbb951a7..120a97ab05 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 2d2d78ad15..272d733aa6 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
<[email protected]>
+;;; Copyright © 2012-2013, 2018-2020, 2023, 2025 Ludovic Courtès <[email protected]>
;;; Copyright © 2016 Jelle Licht <[email protected]>
;;; Copyright © 2016 David Craven <[email protected]>
;;; Copyright © 2017, 2019, 2020, 2022, 2023, 2024, 2025 Ricardo Wurmus
<[email protected]>
@@ -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 <build-system> value for the symbol NAME, representing the name of
diff --git a/guix/platform.scm b/guix/platform.scm
index 994563ab26..33a303a14c 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 259c074412..8daad24d97 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.
