2013-02-16 02:25:59 +00:00
|
|
|
|
;;; GNU Guix --- Functional package management for GNU
|
2016-01-17 10:22:45 +00:00
|
|
|
|
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
2016-01-22 23:29:40 +00:00
|
|
|
|
;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
|
2013-02-16 02:25:59 +00:00
|
|
|
|
;;;
|
|
|
|
|
;;; This file is part of GNU Guix.
|
|
|
|
|
;;;
|
|
|
|
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
|
|
|
|
;;; under the terms of the GNU General Public License as published by
|
|
|
|
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
|
|
|
;;; your option) any later version.
|
|
|
|
|
;;;
|
|
|
|
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
|
|
|
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
;;; GNU General Public License for more details.
|
|
|
|
|
;;;
|
|
|
|
|
;;; You should have received a copy of the GNU General Public License
|
|
|
|
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
|
2014-01-29 12:04:00 +00:00
|
|
|
|
(define-module (gnu system linux-initrd)
|
|
|
|
|
#:use-module (guix monads)
|
monads: Move '%store-monad' and related procedures where they belong.
This turns (guix monads) into a generic module for monads, and moves the
store monad and related monadic procedures in their corresponding
module.
* guix/monads.scm (store-return, store-bind, %store-monad, store-lift,
text-file, interned-file, package-file, package->derivation,
package->cross-derivation, origin->derivation, imported-modules,
compiled, modules, built-derivations, run-with-store): Move to...
* guix/store.scm (store-return, store-bind, %store-monad, store-lift,
text-file, interned-file): ... here.
(%guile-for-build): New variable.
(run-with-store): Moved from monads.scm. Remove default value for
#:guile-for-build.
* guix/packages.scm (default-guile): Export.
(set-guile-for-build): New procedure.
(package-file, package->derivation, package->cross-derivation,
origin->derivation): Moved from monads.scm.
* guix/derivations.scm (%guile-for-build): Remove.
(imported-modules): Rename to...
(%imported-modules): ... this.
(compiled-modules): Rename to...
(%compiled-modules): ... this.
(built-derivations, imported-modules, compiled-modules): New
procedures.
* gnu/services/avahi.scm, gnu/services/base.scm, gnu/services/dbus.scm,
gnu/services/dmd.scm, gnu/services/networking.scm,
gnu/services/ssh.scm, gnu/services/xorg.scm, gnu/system/install.scm,
gnu/system/linux-initrd.scm, gnu/system/shadow.scm, guix/download.scm,
guix/gexp.scm, guix/git-download.scm, guix/profiles.scm,
guix/svn-download.scm, tests/monads.scm: Adjust imports accordingly.
* guix/monad-repl.scm (default-guile-derivation): New procedure.
(store-monad-language, run-in-store): Use it.
* build-aux/hydra/gnu-system.scm (qemu-jobs): Add explicit
'set-guile-for-build' call.
* guix/scripts/archive.scm (derivation-from-expression): Likewise.
* guix/scripts/build.scm (options/resolve-packages): Likewise.
* guix/scripts/environment.scm (guix-environment): Likewise.
* guix/scripts/system.scm (guix-system): Likewise.
* doc/guix.texi (The Store Monad): Adjust module names accordingly.
2015-01-14 12:34:52 +00:00
|
|
|
|
#:use-module (guix store)
|
2014-04-27 21:06:15 +00:00
|
|
|
|
#:use-module (guix gexp)
|
2013-02-16 02:25:59 +00:00
|
|
|
|
#:use-module (guix utils)
|
2014-01-29 20:57:56 +00:00
|
|
|
|
#:use-module ((guix store)
|
|
|
|
|
#:select (%store-prefix))
|
2014-04-14 21:59:08 +00:00
|
|
|
|
#:use-module ((guix derivations)
|
|
|
|
|
#:select (derivation->output-path))
|
2013-02-16 02:25:59 +00:00
|
|
|
|
#:use-module (gnu packages compression)
|
|
|
|
|
#:use-module (gnu packages linux)
|
2013-08-28 21:59:14 +00:00
|
|
|
|
#:use-module (gnu packages guile)
|
2013-02-16 02:25:59 +00:00
|
|
|
|
#:use-module ((gnu packages make-bootstrap)
|
|
|
|
|
#:select (%guile-static-stripped))
|
2014-05-20 19:59:08 +00:00
|
|
|
|
#:use-module (gnu system file-systems)
|
2016-04-17 15:53:20 +00:00
|
|
|
|
#:use-module (gnu system mapped-devices)
|
2014-04-14 21:59:08 +00:00
|
|
|
|
#:use-module (ice-9 match)
|
2014-01-31 11:01:23 +00:00
|
|
|
|
#:use-module (ice-9 regex)
|
2014-05-02 22:26:07 +00:00
|
|
|
|
#:use-module (srfi srfi-1)
|
2014-09-08 21:46:48 +00:00
|
|
|
|
#:use-module (srfi srfi-26)
|
2014-01-29 12:04:00 +00:00
|
|
|
|
#:export (expression->initrd
|
2014-06-30 18:56:45 +00:00
|
|
|
|
base-initrd))
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;;; Commentary:
|
|
|
|
|
;;;
|
|
|
|
|
;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
|
|
|
|
|
;;; particular initrd's that run Guile.
|
|
|
|
|
;;;
|
|
|
|
|
;;; Code:
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define* (expression->initrd exp
|
|
|
|
|
#:key
|
|
|
|
|
(guile %guile-static-stripped)
|
|
|
|
|
(gzip gzip)
|
|
|
|
|
(name "guile-initrd")
|
|
|
|
|
(system (%current-system))
|
2014-09-08 21:46:48 +00:00
|
|
|
|
(modules '()))
|
2014-07-17 15:49:34 +00:00
|
|
|
|
"Return a derivation that builds a Linux initrd (a gzipped cpio archive)
|
2014-09-08 21:27:40 +00:00
|
|
|
|
containing GUILE and that evaluates EXP, a G-expression, upon booting. All
|
|
|
|
|
the derivations referenced by EXP are automatically copied to the initrd.
|
2014-07-17 15:49:34 +00:00
|
|
|
|
|
2014-09-08 21:46:48 +00:00
|
|
|
|
MODULES is a list of Guile module names to be embedded in the initrd."
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
|
|
|
|
;; General Linux overview in `Documentation/early-userspace/README' and
|
|
|
|
|
;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
|
|
|
|
|
|
2014-09-08 21:46:48 +00:00
|
|
|
|
(mlet %store-monad ((init (gexp->script "init" exp
|
|
|
|
|
#:modules modules
|
|
|
|
|
#:guile guile)))
|
2014-04-27 21:06:15 +00:00
|
|
|
|
(define builder
|
|
|
|
|
#~(begin
|
2014-09-08 21:20:34 +00:00
|
|
|
|
(use-modules (gnu build linux-initrd))
|
2014-04-14 21:59:08 +00:00
|
|
|
|
|
2014-09-08 20:26:05 +00:00
|
|
|
|
(mkdir #$output)
|
2014-09-08 21:20:34 +00:00
|
|
|
|
(build-initrd (string-append #$output "/initrd")
|
|
|
|
|
#:guile #$guile
|
|
|
|
|
#:init #$init
|
2014-09-08 21:46:48 +00:00
|
|
|
|
;; Copy everything INIT refers to into the initrd.
|
2014-09-08 21:27:40 +00:00
|
|
|
|
#:references-graphs '("closure")
|
2014-09-08 21:20:34 +00:00
|
|
|
|
#:gzip (string-append #$gzip "/bin/gzip"))))
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
2014-04-27 21:06:15 +00:00
|
|
|
|
(gexp->derivation name builder
|
2015-06-24 15:41:43 +00:00
|
|
|
|
#:modules '((guix cpio)
|
|
|
|
|
(guix build utils)
|
2014-09-06 21:30:28 +00:00
|
|
|
|
(guix build store-copy)
|
|
|
|
|
(gnu build linux-initrd))
|
2014-09-08 21:27:40 +00:00
|
|
|
|
#:references-graphs `(("closure" ,init)))))
|
2014-01-29 12:04:00 +00:00
|
|
|
|
|
2014-09-04 20:50:10 +00:00
|
|
|
|
(define (flat-linux-module-directory linux modules)
|
|
|
|
|
"Return a flat directory containing the Linux kernel modules listed in
|
|
|
|
|
MODULES and taken from LINUX."
|
|
|
|
|
(define build-exp
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (ice-9 match) (ice-9 regex)
|
2014-11-27 23:01:29 +00:00
|
|
|
|
(srfi srfi-1)
|
|
|
|
|
(guix build utils)
|
|
|
|
|
(gnu build linux-modules))
|
2014-09-04 20:50:10 +00:00
|
|
|
|
|
|
|
|
|
(define (string->regexp str)
|
|
|
|
|
;; Return a regexp that matches STR exactly.
|
|
|
|
|
(string-append "^" (regexp-quote str) "$"))
|
|
|
|
|
|
|
|
|
|
(define module-dir
|
|
|
|
|
(string-append #$linux "/lib/modules"))
|
|
|
|
|
|
2014-11-27 23:01:29 +00:00
|
|
|
|
(define (lookup module)
|
|
|
|
|
(let ((name (ensure-dot-ko module)))
|
|
|
|
|
(match (find-files module-dir (string->regexp name))
|
|
|
|
|
((file)
|
|
|
|
|
file)
|
|
|
|
|
(()
|
|
|
|
|
(error "module not found" name module-dir))
|
|
|
|
|
((_ ...)
|
|
|
|
|
(error "several modules by that name"
|
|
|
|
|
name module-dir)))))
|
|
|
|
|
|
|
|
|
|
(define modules
|
|
|
|
|
(let ((modules (map lookup '#$modules)))
|
|
|
|
|
(append modules
|
|
|
|
|
(recursive-module-dependencies modules
|
|
|
|
|
#:lookup-module lookup))))
|
|
|
|
|
|
2014-09-04 20:50:10 +00:00
|
|
|
|
(mkdir #$output)
|
|
|
|
|
(for-each (lambda (module)
|
2014-11-27 23:01:29 +00:00
|
|
|
|
(format #t "copying '~a'...~%" module)
|
|
|
|
|
(copy-file module
|
|
|
|
|
(string-append #$output "/"
|
|
|
|
|
(basename module))))
|
|
|
|
|
(delete-duplicates modules))))
|
2014-09-04 20:50:10 +00:00
|
|
|
|
|
|
|
|
|
(gexp->derivation "linux-modules" build-exp
|
2014-11-27 23:01:29 +00:00
|
|
|
|
#:modules '((guix build utils)
|
|
|
|
|
(guix elf)
|
|
|
|
|
(gnu build linux-modules))))
|
2014-09-04 20:50:10 +00:00
|
|
|
|
|
2014-06-30 18:56:45 +00:00
|
|
|
|
(define* (base-initrd file-systems
|
2014-05-02 22:26:07 +00:00
|
|
|
|
#:key
|
2015-04-05 20:47:16 +00:00
|
|
|
|
(linux linux-libre)
|
2014-09-22 09:06:42 +00:00
|
|
|
|
(mapped-devices '())
|
2014-06-30 18:52:38 +00:00
|
|
|
|
qemu-networking?
|
2015-04-05 21:13:58 +00:00
|
|
|
|
(virtio? #t)
|
2014-06-30 04:49:38 +00:00
|
|
|
|
volatile-root?
|
2014-09-18 21:05:22 +00:00
|
|
|
|
(extra-modules '()))
|
2015-04-05 20:47:16 +00:00
|
|
|
|
"Return a monadic derivation that builds a generic initrd, with kernel
|
|
|
|
|
modules taken from LINUX. FILE-SYSTEMS is a list of file-systems to be
|
|
|
|
|
mounted by the initrd, possibly in addition to the root file system specified
|
|
|
|
|
on the kernel command line via '--root'. MAPPED-DEVICES is a list of device
|
|
|
|
|
mappings to realize before FILE-SYSTEMS are mounted.
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
2014-05-23 20:35:08 +00:00
|
|
|
|
When QEMU-NETWORKING? is true, set up networking with the standard QEMU
|
2014-06-30 04:49:38 +00:00
|
|
|
|
parameters. When VIRTIO? is true, load additional modules so the initrd can
|
2015-04-05 21:13:58 +00:00
|
|
|
|
be used as a QEMU guest with the root file system on a para-virtualized block
|
|
|
|
|
device.
|
2014-05-23 20:35:08 +00:00
|
|
|
|
|
2014-05-02 22:26:07 +00:00
|
|
|
|
When VOLATILE-ROOT? is true, the root file system is writable but any changes
|
|
|
|
|
to it are lost.
|
2013-08-31 20:46:52 +00:00
|
|
|
|
|
2014-07-13 21:43:00 +00:00
|
|
|
|
The initrd is automatically populated with all the kernel modules necessary
|
|
|
|
|
for FILE-SYSTEMS and for the given options. However, additional kernel
|
|
|
|
|
modules can be listed in EXTRA-MODULES. They will be added to the initrd, and
|
2014-09-18 21:05:22 +00:00
|
|
|
|
loaded at boot time in the order in which they appear."
|
2014-06-30 04:49:38 +00:00
|
|
|
|
(define virtio-modules
|
|
|
|
|
;; Modules for Linux para-virtualized devices, for use in QEMU guests.
|
2014-12-08 22:06:57 +00:00
|
|
|
|
'("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
|
|
|
|
|
"virtio_console"))
|
2014-06-30 04:49:38 +00:00
|
|
|
|
|
2014-01-29 20:57:56 +00:00
|
|
|
|
(define cifs-modules
|
|
|
|
|
;; Modules needed to mount CIFS file systems.
|
2014-11-27 23:06:54 +00:00
|
|
|
|
'("md4" "ecb" "cifs"))
|
2013-08-28 22:04:04 +00:00
|
|
|
|
|
2014-01-31 11:21:10 +00:00
|
|
|
|
(define virtio-9p-modules
|
|
|
|
|
;; Modules for the 9p paravirtualized file system.
|
2014-11-27 23:06:54 +00:00
|
|
|
|
'("9p" "9pnet_virtio"))
|
2014-01-31 11:21:10 +00:00
|
|
|
|
|
2014-05-02 22:26:07 +00:00
|
|
|
|
(define (file-system-type-predicate type)
|
|
|
|
|
(lambda (fs)
|
|
|
|
|
(string=? (file-system-type fs) type)))
|
|
|
|
|
|
2014-01-29 20:57:56 +00:00
|
|
|
|
(define linux-modules
|
|
|
|
|
;; Modules added to the initrd and loaded from the initrd.
|
2015-01-27 20:24:32 +00:00
|
|
|
|
`("ahci" ;for SATA controllers
|
|
|
|
|
"usb-storage" "uas" ;for the installation image etc.
|
2016-01-22 23:29:40 +00:00
|
|
|
|
"usbhid" "hid-generic" "hid-apple" ;keyboards during early boot
|
2016-01-23 01:53:04 +00:00
|
|
|
|
"dm-crypt" "xts" "serpent_generic" "wp512" ;for encrypted root partitions
|
2015-08-27 22:37:30 +00:00
|
|
|
|
,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
|
|
|
|
|
'("pata_acpi" "pata_atiixp" ;for ATA controllers
|
|
|
|
|
"isci") ;for SAS controllers like Intel C602
|
|
|
|
|
'())
|
2014-07-18 15:03:02 +00:00
|
|
|
|
,@(if (or virtio? qemu-networking?)
|
2014-06-30 04:49:38 +00:00
|
|
|
|
virtio-modules
|
|
|
|
|
'())
|
2014-05-02 22:26:07 +00:00
|
|
|
|
,@(if (find (file-system-type-predicate "cifs") file-systems)
|
2014-01-31 11:21:10 +00:00
|
|
|
|
cifs-modules
|
|
|
|
|
'())
|
2014-05-02 22:26:07 +00:00
|
|
|
|
,@(if (find (file-system-type-predicate "9p") file-systems)
|
2014-01-31 11:21:10 +00:00
|
|
|
|
virtio-9p-modules
|
2014-04-14 21:59:08 +00:00
|
|
|
|
'())
|
|
|
|
|
,@(if volatile-root?
|
2014-11-27 23:06:54 +00:00
|
|
|
|
'("fuse")
|
2014-07-13 21:43:00 +00:00
|
|
|
|
'())
|
|
|
|
|
,@extra-modules))
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
2014-05-03 22:30:39 +00:00
|
|
|
|
(define helper-packages
|
|
|
|
|
;; Packages to be copied on the initrd.
|
|
|
|
|
`(,@(if (find (lambda (fs)
|
|
|
|
|
(string-prefix? "ext" (file-system-type fs)))
|
|
|
|
|
file-systems)
|
|
|
|
|
(list e2fsck/static)
|
|
|
|
|
'())
|
|
|
|
|
,@(if volatile-root?
|
|
|
|
|
(list unionfs-fuse/static)
|
|
|
|
|
'())))
|
|
|
|
|
|
2014-09-22 09:06:42 +00:00
|
|
|
|
(define device-mapping-commands
|
|
|
|
|
;; List of gexps to open the mapped devices.
|
|
|
|
|
(map (lambda (md)
|
|
|
|
|
(let* ((source (mapped-device-source md))
|
|
|
|
|
(target (mapped-device-target md))
|
|
|
|
|
(type (mapped-device-type md))
|
|
|
|
|
(open (mapped-device-kind-open type)))
|
|
|
|
|
(open source target)))
|
|
|
|
|
mapped-devices))
|
|
|
|
|
|
2015-04-05 20:47:16 +00:00
|
|
|
|
(mlet %store-monad ((kodir (flat-linux-module-directory linux
|
2014-09-08 21:46:48 +00:00
|
|
|
|
linux-modules)))
|
|
|
|
|
(expression->initrd
|
|
|
|
|
#~(begin
|
|
|
|
|
(use-modules (gnu build linux-boot)
|
|
|
|
|
(guix build utils)
|
2016-02-08 22:23:35 +00:00
|
|
|
|
(guix build bournish) ;add the 'bournish' meta-command
|
2016-04-17 22:23:16 +00:00
|
|
|
|
(srfi srfi-26)
|
|
|
|
|
|
|
|
|
|
;; FIXME: The following modules are for
|
|
|
|
|
;; LUKS-DEVICE-MAPPING. We should instead propagate
|
|
|
|
|
;; this info via gexps.
|
|
|
|
|
((gnu build file-systems)
|
|
|
|
|
#:select (find-partition-by-luks-uuid))
|
|
|
|
|
(rnrs bytevectors))
|
2014-09-08 21:46:48 +00:00
|
|
|
|
|
|
|
|
|
(with-output-to-port (%make-void-port "w")
|
|
|
|
|
(lambda ()
|
|
|
|
|
(set-path-environment-variable "PATH" '("bin" "sbin")
|
|
|
|
|
'#$helper-packages)))
|
|
|
|
|
|
|
|
|
|
(boot-system #:mounts '#$(map file-system->spec file-systems)
|
2014-09-22 09:06:42 +00:00
|
|
|
|
#:pre-mount (lambda ()
|
|
|
|
|
(and #$@device-mapping-commands))
|
2014-11-27 22:59:26 +00:00
|
|
|
|
#:linux-modules '#$linux-modules
|
|
|
|
|
#:linux-module-directory '#$kodir
|
2014-09-08 21:46:48 +00:00
|
|
|
|
#:qemu-guest-networking? #$qemu-networking?
|
|
|
|
|
#:volatile-root? '#$volatile-root?))
|
|
|
|
|
#:name "base-initrd"
|
2016-02-08 22:23:35 +00:00
|
|
|
|
#:modules '((guix build bournish)
|
|
|
|
|
(guix build utils)
|
2015-07-10 13:47:07 +00:00
|
|
|
|
(guix build syscalls)
|
2014-09-08 21:46:48 +00:00
|
|
|
|
(gnu build linux-boot)
|
2014-11-27 22:59:26 +00:00
|
|
|
|
(gnu build linux-modules)
|
|
|
|
|
(gnu build file-systems)
|
|
|
|
|
(guix elf)))))
|
2013-02-16 02:25:59 +00:00
|
|
|
|
|
|
|
|
|
;;; linux-initrd.scm ends here
|