01/02: file-systems: Do not use (gnu packages …).

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 278d486b0c0e3ec0378f6a2ccf6946fb176d088b
Author: Ludovic Courtès <address@hidden>
Date:   Tue Mar 21 21:55:20 2017 +0100

    file-systems: Do not use (gnu packages …).
    
    Fixes a regression introduced in
    7208995426714c9fc3ad59cadc3cc0f52df0f018 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.
---
 gnu/services/base.scm       |  2 ++
 gnu/system/file-systems.scm | 27 +++++----------------------
 gnu/system/linux-initrd.scm | 23 ++++++++++++++++++++++-
 tests/file-systems.scm      | 12 +++++++++++-
 4 files changed, 40 insertions(+), 24 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index dad1911..77efef1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -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))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 8107722..3bd072a 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -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
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 1f1c306..dfe198e 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2016 Mark H Weaver <address@hidden>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
@@ -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)
diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index 467ee8c..12f4f09 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -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)