file-systems: Do not use (gnu packages …).
Fixes a regression introduced in
7208995426
whereby (gnu system
file-systems) would pull in (gnu packages …) module, which in turn
breaks when importing things like (gnu build shepherd).
* gnu/system/file-systems.scm (file-system-type-predicate): Export.
(file-system-packages): Move to...
* gnu/system/linux-initrd.scm (file-system-packages): ... here. Add
docstring.
* gnu/services/base.scm: Use it.
* tests/file-systems.scm ("does not pull (gnu packages …)"): New test.
This commit is contained in:
parent
4f7a9e0bff
commit
278d486b0c
|
@ -31,6 +31,8 @@
|
|||
#:use-module (gnu system shadow) ; 'user-account', etc.
|
||||
#:use-module (gnu system file-systems) ; 'file-system', etc.
|
||||
#:use-module (gnu system mapped-devices)
|
||||
#:use-module ((gnu system linux-initrd)
|
||||
#:select (file-system-packages))
|
||||
#:use-module (gnu packages admin)
|
||||
#:use-module ((gnu packages linux)
|
||||
#:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools))
|
||||
|
|
|
@ -22,8 +22,6 @@
|
|||
#:use-module (guix records)
|
||||
#:use-module ((gnu build file-systems)
|
||||
#:select (string->uuid uuid->string))
|
||||
#:use-module (gnu packages linux)
|
||||
#:use-module (gnu packages disk)
|
||||
#:re-export (string->uuid
|
||||
uuid->string)
|
||||
#:export (<file-system>
|
||||
|
@ -41,6 +39,8 @@
|
|||
file-system-create-mount-point?
|
||||
file-system-dependencies
|
||||
|
||||
file-system-type-predicate
|
||||
|
||||
file-system->spec
|
||||
spec->file-system
|
||||
specification->file-system-mapping
|
||||
|
@ -67,8 +67,6 @@
|
|||
|
||||
file-system-mapping->bind-mount
|
||||
|
||||
file-system-packages
|
||||
|
||||
%store-mapping
|
||||
%network-configuration-files
|
||||
%network-file-mappings))
|
||||
|
@ -77,6 +75,9 @@
|
|||
;;;
|
||||
;;; Declaring file systems to be mounted.
|
||||
;;;
|
||||
;;; Note: this file system is used both in the Shepherd and on the "host
|
||||
;;; side", so it must not include (gnu packages …) modules.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
;; File system declaration.
|
||||
|
@ -419,22 +420,4 @@ a bind mount."
|
|||
(lambda (fs)
|
||||
(string=? (file-system-type fs) type)))
|
||||
|
||||
(define* (file-system-packages file-systems #:key (volatile-root? #f))
|
||||
`(,@(if (find (lambda (fs)
|
||||
(string-prefix? "ext" (file-system-type fs)))
|
||||
file-systems)
|
||||
(list e2fsck/static)
|
||||
'())
|
||||
,@(if (find (lambda (fs)
|
||||
(string-suffix? "fat" (file-system-type fs)))
|
||||
file-systems)
|
||||
(list fatfsck/static)
|
||||
'())
|
||||
,@(if (find (file-system-type-predicate "btrfs") file-systems)
|
||||
(list btrfs-progs/static)
|
||||
'())
|
||||
,@(if volatile-root?
|
||||
(list unionfs-fuse/static)
|
||||
'())))
|
||||
|
||||
;;; file-systems.scm ends here
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
|
||||
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||||
|
@ -43,6 +43,7 @@
|
|||
#:use-module (srfi srfi-26)
|
||||
#:export (expression->initrd
|
||||
raw-initrd
|
||||
file-system-packages
|
||||
base-initrd))
|
||||
|
||||
|
||||
|
@ -199,6 +200,26 @@ to it are lost."
|
|||
#:volatile-root? '#$volatile-root?)))
|
||||
#:name "raw-initrd")))
|
||||
|
||||
(define* (file-system-packages file-systems #:key (volatile-root? #f))
|
||||
"Return the list of statically-linked, stripped packages to check
|
||||
FILE-SYSTEMS."
|
||||
`(,@(if (find (lambda (fs)
|
||||
(string-prefix? "ext" (file-system-type fs)))
|
||||
file-systems)
|
||||
(list e2fsck/static)
|
||||
'())
|
||||
,@(if (find (lambda (fs)
|
||||
(string-suffix? "fat" (file-system-type fs)))
|
||||
file-systems)
|
||||
(list fatfsck/static)
|
||||
'())
|
||||
,@(if (find (file-system-type-predicate "btrfs") file-systems)
|
||||
(list btrfs-progs/static)
|
||||
'())
|
||||
,@(if volatile-root?
|
||||
(list unionfs-fuse/static)
|
||||
'())))
|
||||
|
||||
(define* (base-initrd file-systems
|
||||
#:key
|
||||
(linux linux-libre)
|
||||
|
|
|
@ -20,8 +20,10 @@
|
|||
#:use-module (guix store)
|
||||
#:use-module (guix modules)
|
||||
#:use-module (gnu system file-systems)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs bytevectors))
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
;; Test the (gnu system file-systems) module.
|
||||
|
||||
|
@ -80,4 +82,12 @@
|
|||
(not (member '(guix config)
|
||||
(source-module-closure '((gnu system file-systems))))))
|
||||
|
||||
(test-equal "does not pull (gnu packages …)"
|
||||
;; Same story: (gnu packages …) should not be pulled.
|
||||
#f
|
||||
(find (match-lambda
|
||||
(('gnu 'packages _ ..1) #t)
|
||||
(_ #f))
|
||||
(source-module-closure '((gnu system file-systems)))))
|
||||
|
||||
(test-end)
|
||||
|
|
Loading…
Reference in New Issue