From 88840f02469de4686d5d67f44baa47e436602e27 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 29 Aug 2013 00:04:04 +0200 Subject: 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. --- gnu/packages/linux-initrd.scm | 75 +++++++++++-------------------------------- 1 file changed, 19 insertions(+), 56 deletions(-) (limited to 'gnu') 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"))) -- cgit v1.2.3