gnu: linux-initrd: Add (guix build linux-initrd) and use it.

* gnu/packages/linux-initrd.scm (qemu-initrd): Add #:modules argument.
  Factorize and move some of the code to...
* guix/build/linux-initrd.scm: ... here.  New file.
* Makefile.am (MODULES): Add it.

1 files changed, 19 insertions, 56 deletions

diff --git a/gnu/packages/linux-initrd.scm b/gnu/packages/linux-initrd.scm
index db54699ac1..2ed52e60f0 100644
--- a/gnu/packages/linux-initrd.scm
+++ b/gnu/packages/linux-initrd.scm
@@ -238,26 +238,17 @@ the Linux kernel.")
 (define-public qemu-initrd
   (expression->initrd
    '(begin
-      (use-modules (rnrs io ports)
-                   (srfi srfi-1)
+      (use-modules (srfi srfi-1)
                    (srfi srfi-26)
                    (ice-9 match)
-                   ((system foreign) #:select (string->pointer))
-                   ((system base compile) #:select (compile-file)))
+                   ((system base compile) #:select (compile-file))
+                   (guix build linux-initrd))
 
-      (display "Welcome, this is GNU/Guile!\n")
+      (display "Welcome, this is GNU's early boot Guile.\n")
       (display "Use '--repl' for an initrd REPL.\n\n")
 
-      (mkdir "/proc")
-      (mount "none" "/proc" "proc")
-
-      (mkdir "/sys")
-      (mount "none" "/sys" "sysfs")
-
-      (let* ((command (string-trim-both
-                       (call-with-input-file "/proc/cmdline"
-                         get-string-all)))
-             (args    (string-split command char-set:blank))
+      (mount-essential-file-systems)
+      (let* ((args    (linux-command-line))
              (option  (lambda (opt)
                         (let ((opt (string-append opt "=")))
                           (and=> (find (cut string-prefix? opt <>)
@@ -270,34 +261,13 @@ the Linux kernel.")
         (when (member "--repl" args)
           ((@ (system repl repl) start-repl)))
 
-        (let ((slurp (lambda (module)
-                       (call-with-input-file
-                           (string-append "/modules/" module)
-                         get-bytevector-all))))
-          (display "loading CIFS and companion modules...\n")
-          (for-each (compose load-linux-module slurp)
-                    (list "md4.ko" "ecb.ko" "cifs.ko")))
+        (display "loading CIFS and companion modules...\n")
+        (for-each (compose load-linux-module*
+                           (cut string-append "/modules/" <>))
+                  (list "md4.ko" "ecb.ko" "cifs.ko"))
 
-        ;; See net/slirp.c for default QEMU networking values.
-        (display "configuring network...\n")
-        (let* ((sock    (socket AF_INET SOCK_STREAM 0))
-               (address (make-socket-address AF_INET
-                                             (inet-pton AF_INET
-                                                        "10.0.2.10")
-                                             0))
-               (flags   (network-interface-flags sock "eth0")))
-          (set-network-interface-address sock "eth0" address)
-          (set-network-interface-flags sock "eth0"
-                                       (logior flags IFF_UP))
-          (if (logand (network-interface-flags sock "eth0") IFF_UP)
-              (display "network interface is up\n")
-              (display "network interface is DOWN\n"))
-
-          (mkdir "/etc")
-          (call-with-output-file "/etc/resolv.conf"
-            (lambda (p)
-              (display "nameserver 10.0.2.3\n" p)))
-          (sleep 1))
+        (unless (configure-qemu-networking)
+          (display "network interface is DOWN\n"))
 
         ;; Prepare the real root file system under /root.
         (unless (file-exists? "/root")
@@ -305,27 +275,19 @@ the Linux kernel.")
         (if root
             (mount root "/root" "ext3")
             (mount "none" "/root" "tmpfs"))
-        (mkdir "/root/proc")
-        (mount "none" "/root/proc" "proc")
-        (mkdir "/root/sys")
-        (mount "none" "/root/sys" "sysfs")
+        (mount-essential-file-systems #:root "/root")
+
         (mkdir "/root/xchg")
         (mkdir "/root/nix")
         (mkdir "/root/nix/store")
 
         (mkdir "/root/dev")
-        (let ((makedev (lambda (major minor)
-                         (+ (* major 256) minor))))
-          (mknod "/root/dev/null" 'char-special #o666 (makedev 1 3))
-          (mknod "/root/dev/zero" 'char-special #o666 (makedev 1 5)))
+        (mknod "/root/dev/null" 'char-special #o666 (device-number 1 3))
+        (mknod "/root/dev/zero" 'char-special #o666 (device-number 1 5))
 
         ;; Mount the host's store and exchange directory.
-        (display "mounting QEMU's SMB shares...\n")
-        (let ((server "10.0.2.4"))
-          (mount (string-append "//" server "/store") "/root/nix/store" "cifs" 0
-                 (string->pointer "guest,sec=none"))
-          (mount (string-append "//" server "/xchg") "/root/xchg" "cifs" 0
-                 (string->pointer "guest,sec=none")))
+        (mount-qemu-smb-share "/store" "/root/nix/store")
+        (mount-qemu-smb-share "/xchg" "/root/xchg")
 
         (if to-load
             (begin
@@ -346,6 +308,7 @@ the Linux kernel.")
               (display "entering a warm and cozy REPL\n")
               ((@ (system repl repl) start-repl))))))
    #:name "qemu-initrd"
+   #:modules '((guix build linux-initrd))
    #:linux linux-libre
    #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))