aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-29 13:04:00 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-29 16:50:02 +0100
commit735c6dd7faec036adbfa44d927c823ffa9ea1243 (patch)
treeb960e8551312f75e7a3018dac579c8fde44c76e6 /gnu
parent413d5351aa3dd3e122f807cb944405c156d254e3 (diff)
downloadguix-735c6dd7faec036adbfa44d927c823ffa9ea1243.tar
guix-735c6dd7faec036adbfa44d927c823ffa9ea1243.tar.gz
gnu: Lower initrd makers from packages to monadic procedures.
* gnu/packages/linux-initrd.scm: Remove. * gnu/system/linux-initrd.scm: New file. * gnu-system.am (GNU_SYSTEM_MODULES): Adjust accordingly. * gnu/system.scm (<operating-system>): Change default 'initrd' value to (gnu-system-initrd). (operating-system-derivation): Bind 'operating-system-initrd'. Pass 'menu-entry' an initrd file name instead of a package. * gnu/system/grub.scm (grub-configuration-file): Expect 'initrd' to be file name.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/system.scm15
-rw-r--r--gnu/system/grub.scm7
-rw-r--r--gnu/system/linux-initrd.scm (renamed from gnu/packages/linux-initrd.scm)103
-rw-r--r--gnu/system/vm.scm17
4 files changed, 46 insertions, 96 deletions
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)