diff options
Diffstat (limited to 'gnu/system')
| -rw-r--r-- | gnu/system/install.scm | 63 | ||||
| -rw-r--r-- | gnu/system/linux-initrd.scm | 129 |
2 files changed, 81 insertions, 111 deletions
diff --git a/gnu/system/install.scm b/gnu/system/install.scm index 3ec343570a..191ccf1680 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr> ;;; @@ -24,7 +24,6 @@ #:use-module (guix store) #:use-module (guix monads) #:use-module ((guix store) #:select (%store-prefix)) - #:use-module (guix profiles) #:use-module (gnu services shepherd) #:use-module (gnu packages admin) #:use-module (gnu packages bash) @@ -38,8 +37,7 @@ #:use-module (gnu packages nvi) #:use-module (ice-9 match) #:use-module (srfi srfi-26) - #:export (self-contained-tarball - installation-os)) + #:export (installation-os)) ;;; Commentary: ;;; @@ -49,63 +47,6 @@ ;;; Code: -(define* (self-contained-tarball #:key (guix guix)) - "Return a self-contained tarball containing a store initialized with the -closure of GUIX. The tarball contains /gnu/store, /var/guix, and a profile -under /root/.guix-profile where GUIX is installed." - (mlet %store-monad ((profile (profile-derivation - (manifest - (list (package->manifest-entry guix)))))) - (define build - (with-imported-modules '((guix build utils) - (guix build store-copy) - (gnu build install)) - #~(begin - (use-modules (guix build utils) - (gnu build install)) - - (define %root "root") - - (setenv "PATH" - (string-append #$guix "/sbin:" #$tar "/bin:" #$xz "/bin")) - - ;; Note: there is not much to gain here with deduplication and - ;; there is the overhead of the '.links' directory, so turn it - ;; off. - (populate-single-profile-directory %root - #:profile #$profile - #:closure "profile" - #:deduplicate? #f) - - ;; Create the tarball. Use GNU format so there's no file name - ;; length limitation. - (with-directory-excursion %root - (zero? (system* "tar" "--xz" "--format=gnu" - - ;; Avoid non-determinism in the archive. Use - ;; mtime = 1, not zero, because that is what the - ;; daemon does for files in the store (see the - ;; 'mtimeStore' constant in local-store.cc.) - "--sort=name" - "--mtime=@1" ;for files in /var/guix - "--owner=root:0" - "--group=root:0" - - "--check-links" - "-cvf" #$output - ;; Avoid adding / and /var to the tarball, so - ;; that the ownership and permissions of those - ;; directories will not be overwritten when - ;; extracting the archive. Do not include /root - ;; because the root account might have a - ;; different home directory. - "./var/guix" - (string-append "." (%store-directory)))))))) - - (gexp->derivation "guix-tarball.tar.xz" build - #:references-graphs `(("profile" ,profile))))) - - (define (log-to-info) "Return a script that spawns the Info reader on the right section of the manual." diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 4a753cdadb..81c1278c0c 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> +;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -41,6 +42,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:export (expression->initrd + raw-initrd base-initrd)) @@ -131,13 +133,79 @@ MODULES and taken from LINUX." (gexp->derivation "linux-modules" build-exp)) +(define* (raw-initrd file-systems + #:key + (linux linux-libre) + (linux-modules '()) + (mapped-devices '()) + (helper-packages '()) + qemu-networking? + volatile-root?) + "Return a monadic derivation that builds a raw 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'. LINUX-MODULES is a list of kernel +modules to be loaded at boot time. MAPPED-DEVICES is a list of device +mappings to realize before FILE-SYSTEMS are mounted. +HELPER-PACKAGES is a list of packages to be copied in the initrd. It may include +e2fsck/static or other packages needed by the initrd to check root partition. + +When QEMU-NETWORKING? is true, set up networking with the standard QEMU +parameters. +When VOLATILE-ROOT? is true, the root file system is writable but any changes +to it are lost." + (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)) + + (mlet %store-monad ((kodir (flat-linux-module-directory linux + linux-modules))) + (expression->initrd + (with-imported-modules (source-module-closure + '((gnu build linux-boot) + (guix build utils) + (guix build bournish) + (gnu build file-systems))) + #~(begin + (use-modules (gnu build linux-boot) + (guix build utils) + (guix build bournish) ;add the 'bournish' meta-command + (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)) + + (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) + #:pre-mount (lambda () + (and #$@device-mapping-commands)) + #:linux-modules '#$linux-modules + #:linux-module-directory '#$kodir + #:qemu-guest-networking? #$qemu-networking? + #:volatile-root? '#$volatile-root?))) + #:name "raw-initrd"))) + (define* (base-initrd file-systems #:key (linux linux-libre) (mapped-devices '()) qemu-networking? - (virtio? #t) volatile-root? + (virtio? #t) (extra-modules '())) "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 @@ -145,14 +213,12 @@ 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. -When QEMU-NETWORKING? is true, set up networking with the standard QEMU -parameters. When VIRTIO? is true, load additional modules so the initrd can +QEMU-NETWORKING? and VOLATILE-ROOT? behaves as in raw-initrd. + +When VIRTIO? is true, load additional modules so the initrd can be used as a QEMU guest with the root file system on a para-virtualized block device. -When VOLATILE-ROOT? is true, the root file system is writable but any changes -to it are lost. - 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 @@ -224,49 +290,12 @@ loaded at boot time in the order in which they appear." (list unionfs-fuse/static) '()))) - (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)) - - (mlet %store-monad ((kodir (flat-linux-module-directory linux - linux-modules))) - (expression->initrd - (with-imported-modules (source-module-closure - '((gnu build linux-boot) - (guix build utils) - (guix build bournish) - (gnu build file-systems))) - #~(begin - (use-modules (gnu build linux-boot) - (guix build utils) - (guix build bournish) ;add the 'bournish' meta-command - (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)) - - (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) - #:pre-mount (lambda () - (and #$@device-mapping-commands)) - #:linux-modules '#$linux-modules - #:linux-module-directory '#$kodir - #:qemu-guest-networking? #$qemu-networking? - #:volatile-root? '#$volatile-root?))) - #:name "base-initrd"))) + (raw-initrd file-systems + #:linux linux + #:linux-modules linux-modules + #:mapped-devices mapped-devices + #:helper-packages helper-packages + #:qemu-networking? qemu-networking? + #:volatile-root? volatile-root?)) ;;; linux-initrd.scm ends here |