me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2014-01-29 13:04:00 +01:00
parent 413d5351aa
commit 735c6dd7fa
5 changed files with 46 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gnu-system.am
View File

@ -128,7 +128,6 @@ GNU_SYSTEM_MODULES = \
gnu/packages/libunwind.scm \ gnu/packages/libunwind.scm \
gnu/packages/lightning.scm \ gnu/packages/lightning.scm \
gnu/packages/linux.scm \ gnu/packages/linux.scm \
gnu/packages/linux-initrd.scm \
gnu/packages/lout.scm \ gnu/packages/lout.scm \
gnu/packages/lsh.scm \ gnu/packages/lsh.scm \
gnu/packages/lsof.scm \ gnu/packages/lsof.scm \
@ -221,6 +220,7 @@ GNU_SYSTEM_MODULES = \
gnu/system/dmd.scm \ gnu/system/dmd.scm \
gnu/system/grub.scm \ gnu/system/grub.scm \
gnu/system/linux.scm \ gnu/system/linux.scm \
gnu/system/linux-initrd.scm \
gnu/system/shadow.scm \ gnu/system/shadow.scm \
gnu/system/vm.scm gnu/system/vm.scm

15
gnu/system.scm
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.
;;; ;;;
@ -22,7 +22,6 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (gnu packages linux-initrd)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages admin) #:use-module (gnu packages admin)
@ -31,6 +30,7 @@
#:use-module (gnu system grub) #:use-module (gnu system grub)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system linux) #:use-module (gnu system linux)
#:use-module (gnu system linux-initrd)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -58,8 +58,8 @@
(default grub)) (default grub))
(bootloader-entries operating-system-bootloader-entries ; list (bootloader-entries operating-system-bootloader-entries ; list
(default '())) (default '()))
(initrd operating-system-initrd (initrd operating-system-initrd ; monadic derivation
(default gnu-system-initrd)) (default (gnu-system-initrd)))
(host-name operating-system-host-name) ; string (host-name operating-system-host-name) ; string
@ -321,8 +321,9 @@ alias ll='ls -l'
"--config" ,dmd-conf)))) "--config" ,dmd-conf))))
(kernel -> (operating-system-kernel os)) (kernel -> (operating-system-kernel os))
(kernel-dir (package-file kernel)) (kernel-dir (package-file kernel))
(initrd -> (operating-system-initrd os)) (initrd (operating-system-initrd os))
(initrd-file (package-file initrd)) (initrd-file -> (string-append (derivation->output-path initrd)
"/initrd"))
(entries -> (list (menu-entry (entries -> (list (menu-entry
(label (string-append (label (string-append
"GNU system with " "GNU system with "
@ -331,7 +332,7 @@ alias ll='ls -l'
(linux kernel) (linux kernel)
(linux-arguments `("--root=/dev/vda1" (linux-arguments `("--root=/dev/vda1"
,(string-append "--load=" boot))) ,(string-append "--load=" boot)))
(initrd initrd)))) (initrd initrd-file))))
(grub.cfg (grub-configuration-file entries)) (grub.cfg (grub-configuration-file entries))
(extras (links (delete-duplicates (extras (links (delete-duplicates
(append (append-map service-inputs services) (append (append-map service-inputs services)

7
gnu/system/grub.scm
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.
;;; ;;;
@ -41,7 +41,7 @@
(linux menu-entry-linux) (linux menu-entry-linux)
(linux-arguments menu-entry-linux-arguments (linux-arguments menu-entry-linux-arguments
(default '())) (default '()))
(initrd menu-entry-initrd)) (initrd menu-entry-initrd)) ; file name of the initrd
(define* (grub-configuration-file entries (define* (grub-configuration-file entries
#:key (default-entry 1) (timeout 5) #:key (default-entry 1) (timeout 5)
@ -66,10 +66,7 @@ search.file ~a~%"
(match-lambda (match-lambda
(($ <menu-entry> label linux arguments initrd) (($ <menu-entry> label linux arguments initrd)
(mlet %store-monad ((linux (package-file linux "bzImage" (mlet %store-monad ((linux (package-file linux "bzImage"
#:system system))
(initrd (package-file initrd "initrd"
#:system system))) #:system system)))
;; XXX: Assume that INITRD is a directory containing an 'initrd' file.
(return (format #f "menuentry ~s { (return (format #f "menuentry ~s {
linux ~a ~a linux ~a ~a
initrd ~a initrd ~a

93
gnu/packages/linux-initrd.scm → gnu/system/linux-initrd.scm
View File

@ -16,22 +16,18 @@
;;; You should have received a copy of the GNU General Public License ;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; 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 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 cpio)
#:use-module (gnu packages compression) #:use-module (gnu packages compression)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages guile) #:use-module (gnu packages guile)
#:use-module ((gnu packages make-bootstrap) #:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
#:use-module (guix packages) #:export (expression->initrd
#:use-module (guix download) qemu-initrd
#:use-module (guix build-system trivial)) gnu-system-initrd))
;;; Commentary: ;;; Commentary:
@ -42,49 +38,6 @@
;;; Code: ;;; 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 (define* (expression->initrd exp
#:key #:key
(guile %guile-static-stripped) (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")) (and (zero? (system* gzip "--best" "initrd"))
(rename-file "initrd.gz" "initrd"))))))))) (rename-file "initrd.gz" "initrd")))))))))
(package (mlet* %store-monad
(name name) ((source (imported-modules modules))
(version "0") (compiled (compiled-modules modules))
(source #f) (inputs (lower-inputs
(build-system trivial-build-system) `(("guile" ,guile)
(arguments `(#:modules ((guix build utils))
#:builder ,builder))
(inputs `(("guile" ,guile)
("cpio" ,cpio) ("cpio" ,cpio)
("gzip" ,gzip) ("gzip" ,gzip)
("modules" ,(module-package modules)) ("modules" ,source)
("modules/compiled" ,(compiled-module-package modules)) ("modules/compiled" ,compiled)
,@(if linux ,@(if linux
`(("linux" ,linux)) `(("linux" ,linux))
'()))) '())))))
(synopsis "An initial RAM disk (initrd) for the Linux kernel") (derivation-expression name builder
(description #:modules '((guix build utils))
"An initial RAM disk (initrd), really a gzipped cpio archive, for use by #:inputs inputs)))
the Linux kernel.")
(license gpl3+)
(home-page "http://www.gnu.org/software/guix/")))
(define-public qemu-initrd (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 (expression->initrd
'(begin '(begin
(use-modules (srfi srfi-1) (use-modules (srfi srfi-1)
@ -339,8 +288,8 @@ the Linux kernel.")
#:linux linux-libre #:linux linux-libre
#:linux-modules '("cifs.ko" "md4.ko" "ecb.ko"))) #:linux-modules '("cifs.ko" "md4.ko" "ecb.ko")))
(define-public gnu-system-initrd (define (gnu-system-initrd)
;; Initrd for the GNU system itself, with nothing QEMU-specific. "Initrd for the GNU system itself, with nothing QEMU-specific."
(expression->initrd (expression->initrd
'(begin '(begin
(use-modules (srfi srfi-1) (use-modules (srfi srfi-1)

17
gnu/system/vm.scm
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.
;;; ;;;
@ -35,7 +35,6 @@
#:use-module (gnu packages zile) #:use-module (gnu packages zile)
#:use-module (gnu packages grub) #:use-module (gnu packages grub)
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages linux-initrd)
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module ((gnu packages make-bootstrap) #:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
@ -43,6 +42,7 @@
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu system linux) #:use-module (gnu system linux)
#:use-module (gnu system linux-initrd)
#:use-module (gnu system grub) #:use-module (gnu system grub)
#:use-module (gnu system dmd) #:use-module (gnu system dmd)
#:use-module (gnu system) #:use-module (gnu system)
@ -67,7 +67,7 @@
(system (%current-system)) (system (%current-system))
(inputs '()) (inputs '())
(linux linux-libre) (linux linux-libre)
(initrd qemu-initrd) initrd
(qemu qemu/smb-shares) (qemu qemu/smb-shares)
(env-vars '()) (env-vars '())
(modules '()) (modules '())
@ -78,10 +78,10 @@
(references-graphs #f) (references-graphs #f)
(disk-image-size (disk-image-size
(* 100 (expt 2 20)))) (* 100 (expt 2 20))))
"Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD (a
virtual machine, EXP has access to all of INPUTS from the store; it should put derivation). In the virtual machine, EXP has access to all of INPUTS from the
its output files in the `/xchg' directory, which is copied to the derivation's store; it should put its output files in the `/xchg' directory, which is
output when the VM terminates. copied to the derivation's output when the VM terminates.
When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of
DISK-IMAGE-SIZE bytes and return it. 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" (user-builder (text-file "builder-in-linux-vm"
(object->string exp*))) (object->string exp*)))
(coreutils -> (car (assoc-ref %final-inputs "coreutils"))) (coreutils -> (car (assoc-ref %final-inputs "coreutils")))
(initrd (if initrd
(return initrd)
(qemu-initrd))) ; default initrd
(inputs (lower-inputs `(("qemu" ,qemu) (inputs (lower-inputs `(("qemu" ,qemu)
("linux" ,linux) ("linux" ,linux)
("initrd" ,initrd) ("initrd" ,initrd)