linux-boot: Update 'make-hurd-device-nodes'.

[jackhill/guix/guix.git] / gnu / build / linux-boot.scm

diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm
index 787665e..d62c670 100644 (file)
--- a/gnu/build/linux-boot.scm
+++ b/gnu/build/linux-boot.scm
@@ -40,6 +40,7 @@
             find-long-option
             find-long-options
             make-essential-device-nodes
+            make-hurd-device-nodes
             make-static-device-nodes
             configure-qemu-networking
 
@@ -323,6 +324,51 @@ one specific hardware device. These we have to create."
   ;; File systems in user space (FUSE).
   (mknod (scope "dev/fuse") 'char-special #o666 (device-number 10 229)))
 
+(define* (make-hurd-device-nodes #:optional (root "/"))
+  "Make some of the nodes needed on GNU/Hurd."
+  (define (scope dir)
+    (string-append root
+                   (if (string-suffix? "/" root)
+                       ""
+                       "/")
+                   dir))
+
+  (mkdir (scope "dev"))
+  (for-each (lambda (file)
+              (call-with-output-file (scope file)
+                (lambda (port)
+                  (display file port)   ;avoid hard-linking
+                  (chmod port #o666))))
+            '("dev/null"
+              "dev/zero"
+              "dev/full"
+              "dev/random"
+              "dev/urandom"))
+  ;; Don't create /dev/console, /dev/vcs, etc.: they are created by
+  ;; console-run on first boot.
+
+  (mkdir (scope "servers"))
+  (for-each (lambda (file)
+              (call-with-output-file (scope (string-append "servers/" file))
+                (lambda (port)
+                  (display file port)   ;avoid hard-linking
+                  (chmod port #o444))))
+            '("startup"
+              "exec"
+              "proc"
+              "password"
+              "default-pager"
+              "crash-dump-core"
+              "kill"
+              "suspend"))
+
+  (mkdir (scope "servers/socket"))
+  ;; Don't create /servers/socket/1 & co: runsystem does that on first boot.
+
+  ;; TODO: Set the 'gnu.translator' extended attribute for passive translator
+  ;; settings?
+  )
+
 (define %host-qemu-ipv4-address
   (inet-pton AF_INET "10.0.2.10"))
 
@@ -467,25 +513,13 @@ upon error."
   (define (root-mount-point? fs)
     (string=? (file-system-mount-point fs) "/"))
 
-  (define root-fs-type
-    (or (any (lambda (fs)
-               (and (root-mount-point? fs)
-                    (file-system-type fs)))
-             mounts)
-        "ext4"))
-
-  (define root-fs-flags
-    (mount-flags->bit-mask (or (any (lambda (fs)
-                                      (and (root-mount-point? fs)
-                                           (file-system-flags fs)))
-                                    mounts)
-                               '())))
-
-  (define root-fs-options
-    (any (lambda (fs)
-           (and (root-mount-point? fs)
-                (file-system-options fs)))
-         mounts))
+  (define (device-string->file-system-device device-string)
+    ;; The "--root=SPEC" kernel command-line option always provides a
+    ;; string, but the string can represent a device, a UUID, or a
+    ;; label.  So check for all three.
+    (cond ((string-prefix? "/" device-string) device-string)
+          ((uuid device-string) => identity)
+          (else (file-system-label device-string))))
 
   (display "Welcome, this is GNU's early boot Guile.\n")
   (display "Use '--repl' for an initrd REPL.\n\n")
@@ -495,7 +529,21 @@ upon error."
       (mount-essential-file-systems)
       (let* ((args    (linux-command-line))
              (to-load (find-long-option "--load" args))
-             (root    (find-long-option "--root" args)))
+             (root-fs (find root-mount-point? mounts))
+             (root-fs-type (or (and=> root-fs file-system-type)
+                               "ext4"))
+             (root-fs-device (and=> root-fs file-system-device))
+             (root-fs-flags (mount-flags->bit-mask
+                             (or (and=> root-fs file-system-flags)
+                                 '())))
+             (root-options (if root-fs
+                               (file-system-options root-fs)
+                               #f))
+             ;; --root takes precedence over the 'device' field of the root
+             ;; <file-system> record.
+             (root-device (or (and=> (find-long-option "--root" args)
+                                     device-string->file-system-device)
+                              root-fs-device)))
 
         (when (member "--repl" args)
           (start-repl))
@@ -530,18 +578,12 @@ upon error."
 
         (setenv "EXT2FS_NO_MTAB_OK" "1")
 
-        (if root
-            ;; The "--root=SPEC" kernel command-line option always provides a
-            ;; string, but the string can represent a device, a UUID, or a
-            ;; label.  So check for all three.
-            (let ((root (cond ((string-prefix? "/" root) root)
-                              ((uuid root) => identity)
-                              (else (file-system-label root)))))
-              (mount-root-file-system (canonicalize-device-spec root)
-                                      root-fs-type
-                                      #:volatile-root? volatile-root?
-                                      #:flags root-fs-flags
-                                      #:options root-fs-options))
+        (if root-device
+            (mount-root-file-system (canonicalize-device-spec root-device)
+                                    root-fs-type
+                                    #:volatile-root? volatile-root?
+                                    #:flags root-fs-flags
+                                    #:options root-options)
             (mount "none" "/root" "tmpfs"))
 
         ;; Mount the specified file systems.