From 83bcd0b895016c058807e71e102c54d2fab44339 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 3 May 2014 00:26:07 +0200
Subject: system: Add first-class file system declarations.

* gnu/system.scm (<operating-system>)[initrd]: Default to
  'qemu-initrd'.
  (<file-system>): New record type.
  (operating-system-root-file-system): New procedure.
  (operating-system-derivation): Take the device name for GRUB from
  'operating-system-root-file-system'.  Pass the
  'operating-system-initrd' procedure the list of boot file systems.
* gnu/system/linux-initrd.scm (file-system->spec): New procedure.
  (qemu-initrd): Add 'file-systems' parameter, and remove #:mounts
  parameter.
  [file-system-type-predicate]: New procedure.
  [linux-modules]: Use it.
  Adjust #:mounts argument in 'boot-system' call.
  (gnu-system-initrd): Remove.
* gnu/system/vm.scm (%linux-vm-file-systems): New variable.
  (expression->derivation-in-linux-vm): Adjust call to 'qemu-initrd'.
  (virtualized-operating-system): New procedure.
  (system-qemu-image/shared-store-script)[initrd]: Remove.  Use
  'virtualized-operating-system'.  Get the 'initrd' file from OS-DRV.
* guix/build/linux-initrd.scm (mount-qemu-smb-share, mount-qemu-9p):
  Remove.
  (MS_RDONLY, MS_BIND): New global variables.
  (bind-mount): Remove local 'MS_BIND' definition.
  (mount-root-file-system): New procedure, with code formerly in
  'boot-system'.
  (mount-file-system): New procedure.
  (boot-system): Add #:root-fs-type parameter.  Remove 'MS_RDONLY' local
  variable.  Use 'mount-root-file-system' and 'mount-file-system'.
* doc/guix.texi (Using the Configuration System): Add 'file-system'
  declaration.
---
 gnu/system.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 47 insertions(+), 5 deletions(-)

(limited to 'gnu/system.scm')

diff --git a/gnu/system.scm b/gnu/system.scm
index 6c94eb90c5..7624b10ae4 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -51,9 +51,20 @@
             operating-system-timezone
             operating-system-locale
             operating-system-services
+            operating-system-file-systems
 
             operating-system-derivation
-            operating-system-profile))
+            operating-system-profile
+
+            <file-system>
+            file-system
+            file-system?
+            file-system-device
+            file-system-mount-point
+            file-system-type
+            file-system-needed-for-boot?
+            file-system-flags
+            file-system-options))
 
 ;;; Commentary:
 ;;;
@@ -72,8 +83,8 @@
               (default grub))
   (bootloader-entries operating-system-bootloader-entries ; list
                       (default '()))
-  (initrd operating-system-initrd                 ; monadic derivation
-          (default (gnu-system-initrd)))
+  (initrd operating-system-initrd                 ; (list fs) -> M derivation
+          (default qemu-initrd))
 
   (host-name operating-system-host-name)          ; string
 
@@ -112,6 +123,22 @@
   (sudoers operating-system-sudoers               ; /etc/sudoers contents
            (default %sudoers-specification)))
 
+;; File system declaration.
+(define-record-type* <file-system> file-system
+  make-file-system
+  file-system?
+  (device           file-system-device)           ; string
+  (mount-point      file-system-mount-point)      ; string
+  (type             file-system-type)             ; string
+  (flags            file-system-flags             ; list of symbols
+                    (default '()))
+  (options          file-system-options           ; string or #f
+                    (default #f))
+  (needed-for-boot? file-system-needed-for-boot?  ; Boolean
+                    (default #f))
+  (check?           file-system-check?            ; Boolean
+                    (default #t)))
+
 
 ;;;
 ;;; Derivation.
@@ -311,16 +338,30 @@ we're running in the final root."
                     (execl (string-append #$dmd "/bin/dmd")
                            "dmd" "--config" #$dmd-conf)))))
 
+(define (operating-system-root-file-system os)
+  "Return the root file system of OS."
+  (find (match-lambda
+         (($ <file-system> _ "/") #t)
+         (_ #f))
+        (operating-system-file-systems os)))
+
 (define (operating-system-derivation os)
   "Return a derivation that builds OS."
+  (define boot-file-systems
+    (filter (match-lambda
+             (($ <file-system> device mount-point type _ _ boot?)
+              (and boot? (not (string=? mount-point "/")))))
+            (operating-system-file-systems os)))
+
   (mlet* %store-monad
       ((profile     (operating-system-profile os))
        (etc         (operating-system-etc-directory os))
        (services    (sequence %store-monad (operating-system-services os)))
        (boot        (operating-system-boot-script os))
        (kernel  ->  (operating-system-kernel os))
-       (initrd      (operating-system-initrd os))
+       (initrd      ((operating-system-initrd os) boot-file-systems))
        (initrd-file -> #~(string-append #$initrd "/initrd"))
+       (root-fs ->  (operating-system-root-file-system os))
        (entries ->  (list (menu-entry
                            (label (string-append
                                    "GNU system with "
@@ -328,7 +369,8 @@ we're running in the final root."
                                    " (technology preview)"))
                            (linux kernel)
                            (linux-arguments
-                            (list "--root=/dev/sda1"
+                            (list (string-append "--root="
+                                                 (file-system-device root-fs))
                                   #~(string-append "--load=" #$boot)))
                            (initrd initrd-file))))
        (grub.cfg (grub-configuration-file entries)))
-- 
cgit v1.2.3