diff options
| -rw-r--r-- | gnu-system.am | 2 | ||||
| -rw-r--r-- | gnu/system.scm | 15 | ||||
| -rw-r--r-- | gnu/system/grub.scm | 7 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm (renamed from gnu/packages/linux-initrd.scm) | 103 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 17 |
5 files changed, 47 insertions, 97 deletions
diff --git a/gnu-system.am b/gnu-system.am index 473346c6ee..1f7327e865 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -128,7 +128,6 @@ GNU_SYSTEM_MODULES = \ gnu/packages/libunwind.scm \ gnu/packages/lightning.scm \ gnu/packages/linux.scm \ - gnu/packages/linux-initrd.scm \ gnu/packages/lout.scm \ gnu/packages/lsh.scm \ gnu/packages/lsof.scm \ @@ -221,6 +220,7 @@ GNU_SYSTEM_MODULES = \ gnu/system/dmd.scm \ gnu/system/grub.scm \ gnu/system/linux.scm \ + gnu/system/linux-initrd.scm \ gnu/system/shadow.scm \ gnu/system/vm.scm diff --git a/gnu/system.scm b/gnu/system.scm index 6fd753f8fd..5fb4a7483e 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -22,7 +22,6 @@ #:use-module (guix records) #:use-module (guix packages) #:use-module (guix derivations) - #:use-module (gnu packages linux-initrd) #:use-module (gnu packages base) #:use-module (gnu packages bash) #:use-module (gnu packages admin) @@ -31,6 +30,7 @@ #:use-module (gnu system grub) #:use-module (gnu system shadow) #:use-module (gnu system linux) + #:use-module (gnu system linux-initrd) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -58,8 +58,8 @@ (default grub)) (bootloader-entries operating-system-bootloader-entries ; list (default '())) - (initrd operating-system-initrd - (default gnu-system-initrd)) + (initrd operating-system-initrd ; monadic derivation + (default (gnu-system-initrd))) (host-name operating-system-host-name) ; string @@ -321,8 +321,9 @@ alias ll='ls -l' "--config" ,dmd-conf)))) (kernel -> (operating-system-kernel os)) (kernel-dir (package-file kernel)) - (initrd -> (operating-system-initrd os)) - (initrd-file (package-file initrd)) + (initrd (operating-system-initrd os)) + (initrd-file -> (string-append (derivation->output-path initrd) + "/initrd")) (entries -> (list (menu-entry (label (string-append "GNU system with " @@ -331,7 +332,7 @@ alias ll='ls -l' (linux kernel) (linux-arguments `("--root=/dev/vda1" ,(string-append "--load=" boot))) - (initrd initrd)))) + (initrd initrd-file)))) (grub.cfg (grub-configuration-file entries)) (extras (links (delete-duplicates (append (append-map service-inputs services) diff --git a/gnu/system/grub.scm b/gnu/system/grub.scm index 86fa9b504d..5dc0b85ff2 100644 --- a/gnu/system/grub.scm +++ b/gnu/system/grub.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -41,7 +41,7 @@ (linux menu-entry-linux) (linux-arguments menu-entry-linux-arguments (default '())) - (initrd menu-entry-initrd)) + (initrd menu-entry-initrd)) ; file name of the initrd (define* (grub-configuration-file entries #:key (default-entry 1) (timeout 5) @@ -66,10 +66,7 @@ search.file ~a~%" (match-lambda (($ <menu-entry> label linux arguments initrd) (mlet %store-monad ((linux (package-file linux "bzImage" - #:system system)) - (initrd (package-file initrd "initrd" #:system system))) - ;; XXX: Assume that INITRD is a directory containing an 'initrd' file. (return (format #f "menuentry ~s { linux ~a ~a initrd ~a diff --git a/gnu/packages/linux-initrd.scm b/gnu/system/linux-initrd.scm index 5495e16e30..a28b913c3e 100644 --- a/gnu/packages/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -16,22 +16,18 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. -(define-module (gnu packages linux-initrd) +(define-module (gnu system linux-initrd) + #:use-module (guix monads) #:use-module (guix utils) - #:use-module (guix licenses) - #:use-module (guix build-system) - #:use-module ((guix derivations) - #:select (imported-modules compiled-modules %guile-for-build)) - #:use-module (gnu packages) #:use-module (gnu packages cpio) #:use-module (gnu packages compression) #:use-module (gnu packages linux) #:use-module (gnu packages guile) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) - #:use-module (guix packages) - #:use-module (guix download) - #:use-module (guix build-system trivial)) + #:export (expression->initrd + qemu-initrd + gnu-system-initrd)) ;;; Commentary: @@ -42,49 +38,6 @@ ;;; Code: -(define-syntax-rule (raw-build-system (store system name inputs) body ...) - "Lift BODY to a package build system." - ;; TODO: Generalize. - (build-system - (name "raw") - (description "Raw build system") - (build (lambda* (store name source inputs #:key system #:allow-other-keys) - (parameterize ((%guile-for-build (package-derivation store - guile-2.0))) - body ...))))) - -(define (module-package modules) - "Return a package that contains all of MODULES, a list of Guile module -names." - (package - (name "guile-modules") - (version "0") - (source #f) - (build-system (raw-build-system (store system name inputs) - (imported-modules store modules - #:name name - #:system system))) - (synopsis "Set of Guile modules") - (description synopsis) - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - -(define (compiled-module-package modules) - "Return a package that contains the .go files corresponding to MODULES, a -list of Guile module names." - (package - (name "guile-compiled-modules") - (version "0") - (source #f) - (build-system (raw-build-system (store system name inputs) - (compiled-modules store modules - #:name name - #:system system))) - (synopsis "Set of compiled Guile modules") - (description synopsis) - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - (define* (expression->initrd exp #:key (guile %guile-static-stripped) @@ -212,29 +165,25 @@ list of Guile module names to be embedded in the initrd." (and (zero? (system* gzip "--best" "initrd")) (rename-file "initrd.gz" "initrd"))))))))) - (package - (name name) - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:modules ((guix build utils)) - #:builder ,builder)) - (inputs `(("guile" ,guile) - ("cpio" ,cpio) - ("gzip" ,gzip) - ("modules" ,(module-package modules)) - ("modules/compiled" ,(compiled-module-package modules)) - ,@(if linux - `(("linux" ,linux)) - '()))) - (synopsis "An initial RAM disk (initrd) for the Linux kernel") - (description - "An initial RAM disk (initrd), really a gzipped cpio archive, for use by -the Linux kernel.") - (license gpl3+) - (home-page "http://www.gnu.org/software/guix/"))) - -(define-public qemu-initrd + (mlet* %store-monad + ((source (imported-modules modules)) + (compiled (compiled-modules modules)) + (inputs (lower-inputs + `(("guile" ,guile) + ("cpio" ,cpio) + ("gzip" ,gzip) + ("modules" ,source) + ("modules/compiled" ,compiled) + ,@(if linux + `(("linux" ,linux)) + '()))))) + (derivation-expression name builder + #:modules '((guix build utils)) + #:inputs inputs))) + +(define (qemu-initrd) + "Return a monadic derivation that builds an initrd for use in a QEMU guest +where the store is shared with the host." (expression->initrd '(begin (use-modules (srfi srfi-1) @@ -339,8 +288,8 @@ the Linux kernel.") #:linux linux-libre #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) -(define-public gnu-system-initrd - ;; Initrd for the GNU system itself, with nothing QEMU-specific. +(define (gnu-system-initrd) + "Initrd for the GNU system itself, with nothing QEMU-specific." (expression->initrd '(begin (use-modules (srfi srfi-1) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index e75c09d859..fa93654144 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -1,5 +1,5 @@ ;;; 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. ;;; @@ -35,7 +35,6 @@ #:use-module (gnu packages zile) #:use-module (gnu packages grub) #:use-module (gnu packages linux) - #:use-module (gnu packages linux-initrd) #:use-module (gnu packages package-management) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) @@ -43,6 +42,7 @@ #:use-module (gnu system shadow) #:use-module (gnu system linux) + #:use-module (gnu system linux-initrd) #:use-module (gnu system grub) #:use-module (gnu system dmd) #:use-module (gnu system) @@ -67,7 +67,7 @@ (system (%current-system)) (inputs '()) (linux linux-libre) - (initrd qemu-initrd) + initrd (qemu qemu/smb-shares) (env-vars '()) (modules '()) @@ -78,10 +78,10 @@ (references-graphs #f) (disk-image-size (* 100 (expt 2 20)))) - "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the -virtual machine, EXP has access to all of INPUTS from the store; it should put -its output files in the `/xchg' directory, which is copied to the derivation's -output when the VM terminates. + "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a +derivation). In the virtual machine, EXP has access to all of INPUTS from the +store; it should put its output files in the `/xchg' directory, which is +copied to the derivation's output when the VM terminates. When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of DISK-IMAGE-SIZE bytes and return it. @@ -178,6 +178,9 @@ made available under the /xchg CIFS share." (user-builder (text-file "builder-in-linux-vm" (object->string exp*))) (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) + (initrd (if initrd + (return initrd) + (qemu-initrd))) ; default initrd (inputs (lower-inputs `(("qemu" ,qemu) ("linux" ,linux) ("initrd" ,initrd) |