bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

describe: Define and use ‘modules-from-current-profile’.

Browse source 
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 <ludo@gnu.org>
Merges: #4859
This commit is contained in:
Ludovic Courtès 2025-12-14 23:37:13 +01:00 • committed by Andreas Enge
parent f5fcdbb051
commit 2a8b9e980f
No known key found for this signature in database
GPG key ID: F7D5C9BF765C61E3
6 changed files with 51 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gnu/bootloader.scm
View file

@ -2,7 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017, 2020, 2022 Mathieu Othacehe <othacehe@gnu.org>
;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
;;; Copyright © 2019, 2021, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2021, 2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
@ -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.

23
gnu/system/image.scm
View file

@ -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.

22
guix/describe.scm
View file

@ -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."

9
guix/import/utils.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2018, 2019, 2020, 2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012-2013, 2018-2020, 2023, 2025 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017, 2019, 2020, 2022, 2023, 2024, 2025 Ricardo Wurmus <rekado@elephly.net>
@ -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

7
guix/platform.scm
View file

@ -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.

9
guix/upstream.scm
View file

@ -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.