From 384344198dcaa97847e66d3dd82f279ede08d690 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 16 Jan 2017 22:33:46 +0100
Subject: file-systems: 'file-system-needed-for-boot?' is #t for parents of the
 store.

Suggested by John Darrington <john@darrington.wattle.id.au>.

* gnu/system/file-systems.scm (%not-slash): New variable.
(file-prefix?): New procedure.
(file-system-needed-for-boot?): Use it to check whether FS holds the
store.
* tests/file-systems.scm ("file-system-needed-for-boot?"): New test.
* gnu/tests/install.scm (%separate-store-os)[file-systems]: Remove
'needed-for-boot?' field for "/gnu".
---
 tests/file-systems.scm | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

(limited to 'tests/file-systems.scm')

diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index aed27e89c2..fd1599e132 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-file-systems)
+  #:use-module (guix store)
   #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors))
@@ -50,4 +51,25 @@
            (string-contains message "invalid UUID")
            (equal? form '(uuid "foobar"))))))
 
+(test-assert "file-system-needed-for-boot?"
+  (let-syntax ((dummy-fs (syntax-rules ()
+                           ((_ directory)
+                            (file-system
+                              (device "foo")
+                              (mount-point directory)
+                              (type "ext4"))))))
+    (parameterize ((%store-prefix "/gnu/guix/store"))
+      (and (file-system-needed-for-boot? (dummy-fs "/"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu/guix"))
+           (file-system-needed-for-boot? (dummy-fs "/gnu/guix/store"))
+           (not (file-system-needed-for-boot?
+                 (dummy-fs "/gnu/guix/store/foo")))
+           (not (file-system-needed-for-boot? (dummy-fs "/gn")))
+           (not (file-system-needed-for-boot?
+                 (file-system
+                   (inherit (dummy-fs (%store-prefix)))
+                   (device "/foo")
+                   (flags '(bind-mount read-only)))))))))
+
 (test-end)
-- 
cgit v1.2.3


From ad167d028e97dca1937ad6ae3d89d2c4de997754 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 3 Feb 2017 11:26:25 +0100
Subject: file-systems: Remove dependency on (guix store).

(gnu system file-systems) is used on the "build" side since commit
5970e8e248f6327c41c83b86bb2c89be7c3b1b4e.

* gnu/system/file-systems.scm: Remove dependency on (guix store).
(%store-prefix): New procedure.
* tests/file-systems.scm ("does not pull (guix config)"): New test.
---
 gnu/system/file-systems.scm | 15 ++++++++++++++-
 tests/file-systems.scm      |  8 ++++++++
 2 files changed, 22 insertions(+), 1 deletion(-)

(limited to 'tests/file-systems.scm')

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index b2721f2389..708d53d0a1 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -19,7 +19,6 @@
 (define-module (gnu system file-systems)
   #:use-module (ice-9 match)
   #:use-module (guix records)
-  #:use-module (guix store)
   #:use-module ((gnu build file-systems)
                 #:select (string->uuid uuid->string))
   #:re-export (string->uuid
@@ -97,6 +96,20 @@
   (dependencies     file-system-dependencies      ; list of <file-system>
                     (default '())))               ; or <mapped-device>
 
+;; Note: This module is used both on the build side and on the host side.
+;; Arrange not to pull (guix store) and (guix config) because the latter
+;; differs from user to user.
+(define (%store-prefix)
+  "Return the store prefix."
+  (cond ((resolve-module '(guix store) #:ensure #f)
+         =>
+         (lambda (store)
+           ((module-ref store '%store-prefix))))
+        ((getenv "NIX_STORE")
+         => identity)
+        (else
+         "/gnu/store")))
+
 (define %not-slash
   (char-set-complement (char-set #\/)))
 
diff --git a/tests/file-systems.scm b/tests/file-systems.scm
index fd1599e132..467ee8ca5d 100644
--- a/tests/file-systems.scm
+++ b/tests/file-systems.scm
@@ -18,6 +18,7 @@
 
 (define-module (test-file-systems)
   #:use-module (guix store)
+  #:use-module (guix modules)
   #:use-module (gnu system file-systems)
   #:use-module (srfi srfi-64)
   #:use-module (rnrs bytevectors))
@@ -72,4 +73,11 @@
                    (device "/foo")
                    (flags '(bind-mount read-only)))))))))
 
+(test-assert "does not pull (guix config)"
+  ;; This module is meant both for the host side and "build side", so make
+  ;; sure it doesn't pull in (guix config), which depends on the user's
+  ;; config.
+  (not (member '(guix config)
+               (source-module-closure '((gnu system file-systems))))))
+
 (test-end)
-- 
cgit v1.2.3