unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
From: Danny Milosavljevic <dannym@scratchpost.org>
To: 25917@debbugs.gnu.org, ludo@gnu.org
Subject: bug#25917: [PATCH] file-systems: Factorize file-system-packages.
Date: Thu, 16 Mar 2017 18:40:29 +0100	[thread overview]
Message-ID: <20170316174029.1663-1-dannym@scratchpost.org> (raw)
In-Reply-To: <20170301173838.797d5dbc@scratchpost.org>

* gnu/system/linux-initrd.scm (base-initrd): Move helper-packages body to ...
* gnu/system/file-systems.scm (file-system-packages): ... here.
Also export it.
* gnu/services/base.scm (file-system-shepherd-service): Set PATH by using
file-system-packages.
---
 gnu/services/base.scm       | 12 ++++++------
 gnu/system/file-systems.scm | 26 ++++++++++++++++++++++++++
 gnu/system/linux-initrd.scm | 18 +-----------------
 3 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 5298a11f6..f3224aae1 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -274,7 +274,9 @@ FILE-SYSTEM."
         (options (file-system-options file-system))
         (check?  (file-system-check? file-system))
         (create? (file-system-create-mount-point? file-system))
-        (dependencies (file-system-dependencies file-system)))
+        (needed-for-boot? (file-system-needed-for-boot? file-system))
+        (dependencies (file-system-dependencies file-system))
+        (packages (file-system-packages (list file-system))))
     (and (file-system-mount? file-system)
          (with-imported-modules '((gnu build file-systems)
                                   (guix build bournish))
@@ -292,11 +294,9 @@ FILE-SYSTEM."
                          ;; Make sure fsck.ext2 & co. can be found.
                          (dynamic-wind
                            (lambda ()
-                             (setenv "PATH"
-                                     (string-append
-                                      #$e2fsprogs "/sbin:"
-                                      "/run/current-system/profile/sbin:"
-                                      $PATH)))
+                             (set-path-environment-variable "PATH"
+                                                            '("bin" "sbin")
+                                                            '#$packages))
                            (lambda ()
                              (mount-file-system
                               `(#$device #$title #$target #$type #$flags
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 7011a279d..8107722c7 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -22,6 +22,8 @@
   #: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>
@@ -65,6 +67,8 @@
 
             file-system-mapping->bind-mount
 
+            file-system-packages
+
             %store-mapping
             %network-configuration-files
             %network-file-mappings))
@@ -411,4 +415,26 @@ a bind mount."
                  (writable? (string=? file "/etc/resolv.conf"))))
               %network-configuration-files))
 
+(define (file-system-type-predicate type)
+  (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 81c1278c0..1f1c30682 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -272,23 +272,7 @@ loaded at boot time in the order in which they appear."
       ,@extra-modules))
 
   (define helper-packages
-    ;; Packages to be copied on the initrd.
-    `(,@(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-system-packages file-systems #:volatile-root? volatile-root?))
 
   (raw-initrd file-systems
               #:linux linux

  parent reply	other threads:[~2017-03-16 17:41 UTC|newest]

Thread overview: 18+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-03-01 16:38 bug#25917: operating-system file-system with (check? #t) but (needed-for-boot #f) pauses boot until user interaction Danny Milosavljevic
2017-03-11 11:21 ` Ludovic Courtès
2017-03-12 16:56   ` bug#25917: [PATCH] services: Don't check filesystem even if #:check? if not #:needed-for-boot Danny Milosavljevic
2017-03-13  9:01     ` Ludovic Courtès
2017-03-13 19:55       ` Danny Milosavljevic
2017-03-14  8:41         ` Ludovic Courtès
2017-03-14 19:18           ` Danny Milosavljevic
2017-03-14 20:18             ` Ludovic Courtès
2017-03-12 16:59   ` bug#25917: [PATCH v2] services: If a filesystem is not marked as needed for boot, don't check it even if told to check it Danny Milosavljevic
2017-03-16 17:40 ` Danny Milosavljevic [this message]
2017-03-17  9:03   ` bug#25917: [PATCH] file-systems: Factorize file-system-packages Ludovic Courtès
2017-03-17 12:19     ` Danny Milosavljevic
2017-03-18 11:00       ` Ludovic Courtès
2017-03-18 11:04       ` Ludovic Courtès
2017-03-18  9:42     ` Danny Milosavljevic
2017-03-18 14:06   ` bug#25917: [PATCH v2] services: file-system-shepherd-service: Make it find the fsck programs Danny Milosavljevic
2017-03-19 15:44     ` Ludovic Courtès
2017-04-22 23:34     ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20170316174029.1663-1-dannym@scratchpost.org \
    --to=dannym@scratchpost.org \
    --cc=25917@debbugs.gnu.org \
    --cc=ludo@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).