gnu: qemu-initrd: Adjust to allow booting with a non-empty /root.

* gnu/packages/linux-initrd.scm (qemu-initrd): Use 'mkdir-p' instead of
  'mkdir' for /root/xchg and /root/{share,lib}.  When TO-LOAD is a
  symlink, resolve it.
  (gnu-system-initrd): Fix typo in message.
This commit is contained in:
Ludovic Courtès 2014-01-28 23:38:19 +01:00
parent f06afd4da2
commit b0dd47a8d0
1 changed files with 15 additions and 7 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -280,7 +280,7 @@ the Linux kernel.")
(mount "none" "/root" "tmpfs")) (mount "none" "/root" "tmpfs"))
(mount-essential-file-systems #:root "/root") (mount-essential-file-systems #:root "/root")
(mkdir "/root/xchg") (mkdir-p "/root/xchg")
(mkdir-p "/root/nix/store") (mkdir-p "/root/nix/store")
(unless (file-exists? "/root/dev") (unless (file-exists? "/root/dev")
@ -294,8 +294,8 @@ the Linux kernel.")
;; Copy the directories that contain .scm and .go files so that the ;; Copy the directories that contain .scm and .go files so that the
;; child process in the chroot can load modules (we would bind-mount ;; child process in the chroot can load modules (we would bind-mount
;; them but for some reason that fails with EINVAL -- XXX). ;; them but for some reason that fails with EINVAL -- XXX).
(mkdir "/root/share") (mkdir-p "/root/share")
(mkdir "/root/lib") (mkdir-p "/root/lib")
(mount "none" "/root/share" "tmpfs") (mount "none" "/root/share" "tmpfs")
(mount "none" "/root/lib" "tmpfs") (mount "none" "/root/lib" "tmpfs")
(copy-recursively "/share" "/root/share" (copy-recursively "/share" "/root/share"
@ -305,9 +305,17 @@ the Linux kernel.")
(if to-load (if to-load
(begin (letrec ((resolve
(lambda (file)
;; If FILE is a symlink to an absolute file name,
;; resolve it as if we were under /root.
(let ((st (lstat file)))
(if (eq? 'symlink (stat:type st))
(let ((target (readlink file)))
(resolve (string-append "/root" target)))
file)))))
(format #t "loading boot file '~a'...\n" to-load) (format #t "loading boot file '~a'...\n" to-load)
(compile-file (string-append "/root/" to-load) (compile-file (resolve (string-append "/root/" to-load))
#:output-file "/root/loader.go" #:output-file "/root/loader.go"
#:opts %auto-compilation-options) #:opts %auto-compilation-options)
(match (primitive-fork) (match (primitive-fork)
@ -392,7 +400,7 @@ the Linux kernel.")
(sleep 2) (sleep 2)
(reboot)) (reboot))
(begin (begin
(display "no init file passed via '--exec'\n") (display "no init file passed via '--load'\n")
(display "entering a warm and cozy REPL\n") (display "entering a warm and cozy REPL\n")
((@ (system repl repl) start-repl)))))) ((@ (system repl repl) start-repl))))))
#:name "qemu-system-initrd" #:name "qemu-system-initrd"