gnu/system/linux-initrd.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2016 Mark H Weaver <mhw@netris.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu system linux-initrd)
  21   #:use-module (guix monads)
  22   #:use-module (guix store)
  23   #:use-module (guix gexp)
  24   #:use-module (guix utils)
  25   #:use-module ((guix store)
  26                 #:select (%store-prefix))
  27   #:use-module ((guix derivations)
  28                 #:select (derivation->output-path))
  29   #:use-module (gnu packages compression)
  30   #:use-module (gnu packages linux)
  31   #:use-module (gnu packages guile)
  32   #:use-module ((gnu packages make-bootstrap)
  33                 #:select (%guile-static-stripped))
  34   #:use-module (gnu system file-systems)
  35   #:use-module (ice-9 match)
  36   #:use-module (ice-9 regex)
  37   #:use-module (srfi srfi-1)
  38   #:use-module (srfi srfi-26)
  39   #:export (expression->initrd
  40             base-initrd))
  41
  42 \f
  43 ;;; Commentary:
  44 ;;;
  45 ;;; Tools to build initial RAM disks (initrd's) for Linux-Libre, and in
  46 ;;; particular initrd's that run Guile.
  47 ;;;
  48 ;;; Code:
  49
  50
  51 (define* (expression->initrd exp
  52                              #:key
  53                              (guile %guile-static-stripped)
  54                              (gzip gzip)
  55                              (name "guile-initrd")
  56                              (system (%current-system))
  57                              (modules '()))
  58   "Return a derivation that builds a Linux initrd (a gzipped cpio archive)
  59 containing GUILE and that evaluates EXP, a G-expression, upon booting.  All
  60 the derivations referenced by EXP are automatically copied to the initrd.
  61
  62 MODULES is a list of Guile module names to be embedded in the initrd."
  63
  64   ;; General Linux overview in `Documentation/early-userspace/README' and
  65   ;; `Documentation/filesystems/ramfs-rootfs-initramfs.txt'.
  66
  67   (mlet %store-monad ((init (gexp->script "init" exp
  68                                           #:modules modules
  69                                           #:guile guile)))
  70     (define builder
  71       #~(begin
  72           (use-modules (gnu build linux-initrd))
  73
  74           (mkdir #$output)
  75           (build-initrd (string-append #$output "/initrd")
  76                         #:guile #$guile
  77                         #:init #$init
  78                         ;; Copy everything INIT refers to into the initrd.
  79                         #:references-graphs '("closure")
  80                         #:gzip (string-append #$gzip "/bin/gzip"))))
  81
  82    (gexp->derivation name builder
  83                      #:modules '((guix cpio)
  84                                  (guix build utils)
  85                                  (guix build store-copy)
  86                                  (gnu build linux-initrd))
  87                      #:references-graphs `(("closure" ,init)))))
  88
  89 (define (flat-linux-module-directory linux modules)
  90   "Return a flat directory containing the Linux kernel modules listed in
  91 MODULES and taken from LINUX."
  92   (define build-exp
  93     #~(begin
  94         (use-modules (ice-9 match) (ice-9 regex)
  95                      (srfi srfi-1)
  96                      (guix build utils)
  97                      (gnu build linux-modules))
  98
  99         (define (string->regexp str)
 100           ;; Return a regexp that matches STR exactly.
 101           (string-append "^" (regexp-quote str) "$"))
 102
 103         (define module-dir
 104           (string-append #$linux "/lib/modules"))
 105
 106         (define (lookup module)
 107           (let ((name (ensure-dot-ko module)))
 108             (match (find-files module-dir (string->regexp name))
 109               ((file)
 110                file)
 111               (()
 112                (error "module not found" name module-dir))
 113               ((_ ...)
 114                (error "several modules by that name"
 115                       name module-dir)))))
 116
 117         (define modules
 118           (let ((modules (map lookup '#$modules)))
 119             (append modules
 120                     (recursive-module-dependencies modules
 121                                                    #:lookup-module lookup))))
 122
 123         (mkdir #$output)
 124         (for-each (lambda (module)
 125                     (format #t "copying '~a'...~%" module)
 126                     (copy-file module
 127                                (string-append #$output "/"
 128                                               (basename module))))
 129                   (delete-duplicates modules))))
 130
 131   (gexp->derivation "linux-modules" build-exp
 132                     #:modules '((guix build utils)
 133                                 (guix elf)
 134                                 (gnu build linux-modules))))
 135
 136 (define* (base-initrd file-systems
 137                       #:key
 138                       (linux linux-libre)
 139                       (mapped-devices '())
 140                       qemu-networking?
 141                       (virtio? #t)
 142                       volatile-root?
 143                       (extra-modules '()))
 144   "Return a monadic derivation that builds a generic initrd, with kernel
 145 modules taken from LINUX.  FILE-SYSTEMS is a list of file-systems to be
 146 mounted by the initrd, possibly in addition to the root file system specified
 147 on the kernel command line via '--root'.  MAPPED-DEVICES is a list of device
 148 mappings to realize before FILE-SYSTEMS are mounted.
 149
 150 When QEMU-NETWORKING? is true, set up networking with the standard QEMU
 151 parameters.  When VIRTIO? is true, load additional modules so the initrd can
 152 be used as a QEMU guest with the root file system on a para-virtualized block
 153 device.
 154
 155 When VOLATILE-ROOT? is true, the root file system is writable but any changes
 156 to it are lost.
 157
 158 The initrd is automatically populated with all the kernel modules necessary
 159 for FILE-SYSTEMS and for the given options.  However, additional kernel
 160 modules can be listed in EXTRA-MODULES.  They will be added to the initrd, and
 161 loaded at boot time in the order in which they appear."
 162   (define virtio-modules
 163     ;; Modules for Linux para-virtualized devices, for use in QEMU guests.
 164     '("virtio_pci" "virtio_balloon" "virtio_blk" "virtio_net"
 165       "virtio_console"))
 166
 167   (define cifs-modules
 168     ;; Modules needed to mount CIFS file systems.
 169     '("md4" "ecb" "cifs"))
 170
 171   (define virtio-9p-modules
 172     ;; Modules for the 9p paravirtualized file system.
 173     '("9p" "9pnet_virtio"))
 174
 175   (define (file-system-type-predicate type)
 176     (lambda (fs)
 177       (string=? (file-system-type fs) type)))
 178
 179   (define linux-modules
 180     ;; Modules added to the initrd and loaded from the initrd.
 181     `("ahci"                                  ;for SATA controllers
 182       "usb-storage" "uas"                     ;for the installation image etc.
 183       "usbhid" "hid-generic" "hid-apple"      ;keyboards during early boot
 184       "dm-crypt" "xts"                        ;for encrypted root partitions
 185       ,@(if (string-match "^(x86_64|i[3-6]86)-" (%current-system))
 186             '("pata_acpi" "pata_atiixp"    ;for ATA controllers
 187               "isci")                      ;for SAS controllers like Intel C602
 188             '())
 189       ,@(if (or virtio? qemu-networking?)
 190             virtio-modules
 191             '())
 192       ,@(if (find (file-system-type-predicate "cifs") file-systems)
 193             cifs-modules
 194             '())
 195       ,@(if (find (file-system-type-predicate "9p") file-systems)
 196             virtio-9p-modules
 197             '())
 198       ,@(if volatile-root?
 199             '("fuse")
 200             '())
 201       ,@extra-modules))
 202
 203   (define helper-packages
 204     ;; Packages to be copied on the initrd.
 205     `(,@(if (find (lambda (fs)
 206                     (string-prefix? "ext" (file-system-type fs)))
 207                   file-systems)
 208             (list e2fsck/static)
 209             '())
 210       ,@(if volatile-root?
 211             (list unionfs-fuse/static)
 212             '())))
 213
 214   (define device-mapping-commands
 215     ;; List of gexps to open the mapped devices.
 216     (map (lambda (md)
 217            (let* ((source (mapped-device-source md))
 218                   (target (mapped-device-target md))
 219                   (type   (mapped-device-type md))
 220                   (open   (mapped-device-kind-open type)))
 221              (open source target)))
 222          mapped-devices))
 223
 224   (mlet %store-monad ((kodir (flat-linux-module-directory linux
 225                                                           linux-modules)))
 226     (expression->initrd
 227      #~(begin
 228          (use-modules (gnu build linux-boot)
 229                       (guix build utils)
 230                       (srfi srfi-26))
 231
 232          (with-output-to-port (%make-void-port "w")
 233            (lambda ()
 234              (set-path-environment-variable "PATH" '("bin" "sbin")
 235                                             '#$helper-packages)))
 236
 237          (boot-system #:mounts '#$(map file-system->spec file-systems)
 238                       #:pre-mount (lambda ()
 239                                     (and #$@device-mapping-commands))
 240                       #:linux-modules '#$linux-modules
 241                       #:linux-module-directory '#$kodir
 242                       #:qemu-guest-networking? #$qemu-networking?
 243                       #:volatile-root? '#$volatile-root?))
 244      #:name "base-initrd"
 245      #:modules '((guix build utils)
 246                  (guix build syscalls)
 247                  (gnu build linux-boot)
 248                  (gnu build linux-modules)
 249                  (gnu build file-systems)
 250                  (guix elf)))))
 251
 252 ;;; linux-initrd.scm ends here