gnu/build/linux-boot.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2016, 2017, 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
   4 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   5 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu build linux-boot)
  23   #:use-module (rnrs io ports)
  24   #:use-module (system repl error-handling)
  25   #:autoload   (system repl repl) (start-repl)
  26   #:use-module (srfi srfi-1)
  27   #:use-module (srfi srfi-9)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (ice-9 match)
  30   #:use-module (ice-9 rdelim)
  31   #:use-module (ice-9 regex)
  32   #:use-module (ice-9 ftw)
  33   #:use-module (guix build utils)
  34   #:use-module ((guix build syscalls)
  35                 #:hide (file-system-type))
  36   #:use-module (gnu build linux-modules)
  37   #:use-module (gnu build file-systems)
  38   #:use-module (gnu system file-systems)
  39   #:export (mount-essential-file-systems
  40             linux-command-line
  41             find-long-option
  42             find-long-options
  43             make-essential-device-nodes
  44             make-static-device-nodes
  45             configure-qemu-networking
  46
  47             device-number
  48             boot-system))
  49
  50 ;;; Commentary:
  51 ;;;
  52 ;;; Utility procedures useful in a Linux initial RAM disk (initrd).  Note that
  53 ;;; many of these use procedures not yet available in vanilla Guile (`mount',
  54 ;;; `load-linux-module', etc.); these are provided by a Guile patch used in
  55 ;;; the GNU distribution.
  56 ;;;
  57 ;;; Code:
  58
  59 (define* (mount-essential-file-systems #:key (root "/"))
  60   "Mount /dev, /proc, and /sys under ROOT."
  61   (define (scope dir)
  62     (string-append root
  63                    (if (string-suffix? "/" root)
  64                        ""
  65                        "/")
  66                    dir))
  67
  68   (unless (file-exists? (scope "proc"))
  69     (mkdir (scope "proc")))
  70   (mount "none" (scope "proc") "proc")
  71
  72   (unless (file-exists? (scope "dev"))
  73     (mkdir (scope "dev")))
  74   (mount "none" (scope "dev") "devtmpfs")
  75
  76   (unless (file-exists? (scope "sys"))
  77     (mkdir (scope "sys")))
  78   (mount "none" (scope "sys") "sysfs"))
  79
  80 (define (move-essential-file-systems root)
  81   "Move currently mounted essential file systems to ROOT."
  82   (for-each (lambda (dir)
  83               (let ((target (string-append root dir)))
  84                 (unless (file-exists? target)
  85                   (mkdir target))
  86                 (mount dir target "" MS_MOVE)))
  87             '("/dev" "/proc" "/sys")))
  88
  89 (define (linux-command-line)
  90   "Return the Linux kernel command line as a list of strings."
  91   (string-tokenize
  92    (call-with-input-file "/proc/cmdline"
  93      get-string-all)))
  94
  95 (define (find-long-option option arguments)
  96   "Find OPTION among ARGUMENTS, where OPTION is something like \"--load\".
  97 Return the value associated with OPTION, or #f on failure."
  98   (let ((opt (string-append option "=")))
  99     (and=> (find (cut string-prefix? opt <>)
 100                  arguments)
 101            (lambda (arg)
 102              (substring arg (+ 1 (string-index arg #\=)))))))
 103
 104 (define (find-long-options option arguments)
 105   "Find OPTIONs among ARGUMENTS, where OPTION is something like \"console\".
 106 Return the values associated with OPTIONs as a list, or the empty list if
 107 OPTION doesn't appear in ARGUMENTS."
 108   (let ((opt (string-append option "=")))
 109     (filter-map (lambda (arg)
 110                   (and (string-prefix? opt arg)
 111                        (substring arg (+ 1 (string-index arg #\=)))))
 112                 arguments)))
 113
 114 (define (resume-if-hibernated device)
 115   "Resume from hibernation if possible.  This is safe ONLY if no on-disk file
 116 systems have been mounted; calling it later risks severe file system corruption!
 117 See <Documentation/swsusp.txt> in the kernel source directory.  This is the
 118 caller's responsibility, as is catching exceptions if resumption was supposed to
 119 happen but didn't.
 120
 121 Resume only from DEVICE if it's a string.  If it's #f, use the kernel's default
 122 hibernation device (CONFIG_PM_STD_PARTITION).  Never return if resumption
 123 succeeds.  Return nothing otherwise.  The kernel logs any details to dmesg."
 124
 125   (define (string->major:minor string)
 126     "Return a string with MAJOR:MINOR numbers of the device specified by STRING"
 127
 128     ;; The "resume=" kernel command-line option always provides a string, which
 129     ;; can represent a device, a UUID, or a label.  Check for all three.
 130     (let* ((spec (cond ((string-prefix? "/" string) string)
 131                        ((uuid string) => identity)
 132                        (else (file-system-label string))))
 133            ;; XXX The kernel's swsusp_resume_can_resume() waits if ‘resumewait’
 134            ;; is found on the command line; our canonicalize-device-spec gives
 135            ;; up after 20 seconds.  We could emulate the former by looping…
 136            (device (canonicalize-device-spec spec))
 137            (rdev (stat:rdev (stat device)))
 138            ;; For backwards compatibility, device numbering is a baroque affair.
 139            ;; This is the full 64-bit scheme used by glibc's <sys/sysmacros.h>.
 140            (major (logior (ash (logand #x00000000000fff00 rdev) -8)
 141                           (ash (logand #xfffff00000000000 rdev) -32)))
 142            (minor (logior      (logand #x00000000000000ff rdev)
 143                           (ash (logand #x00000ffffff00000 rdev) -12))))
 144       (format #f "~a:~a" major minor)))
 145
 146   ;; Write the resume DEVICE to this magic file, using the MAJOR:MINOR device
 147   ;; numbers if possible.  The kernel will immediately try to resume from it.
 148   (let ((resume "/sys/power/resume"))
 149     (when (file-exists? resume)         ; this kernel supports hibernation
 150       ;; Honour the kernel's default device (only) if none other was given.
 151       (let ((major:minor (if device
 152                              (or (false-if-exception (string->major:minor
 153                                                       device))
 154                                  ;; We can't parse it.  Maybe the kernel can.
 155                                  device)
 156                              (let ((default (call-with-input-file resume
 157                                               read-line)))
 158                                ;; Don't waste time echoing 0:0 to /sys.
 159                                (if (string=? "0:0" default)
 160                                    #f
 161                                    default)))))
 162         (when major:minor
 163           (call-with-output-file resume ; may throw an ‘Invalid argument’
 164             (cut display major:minor <>))))))) ; may never return
 165
 166 (define* (make-disk-device-nodes base major #:optional (minor 0))
 167   "Make the block device nodes around BASE (something like \"/root/dev/sda\")
 168 with the given MAJOR number, starting with MINOR."
 169   (mknod base 'block-special #o644 (device-number major minor))
 170   (let loop ((i 1))
 171     (when (< i 16)
 172       (mknod (string-append base (number->string i))
 173              'block-special #o644 (device-number major (+ minor i)))
 174       (loop (+ i 1)))))
 175
 176 ;; Representation of a /dev node.
 177 (define-record-type <device-node>
 178   (device-node name type major minor module)
 179   device-node?
 180   (name device-node-name)
 181   (type device-node-type)
 182   (major device-node-major)
 183   (minor device-node-minor)
 184   (module device-node-module))
 185
 186 (define (read-static-device-nodes port)
 187   "Read from PORT a list of <device-node> written in the format used by
 188 /lib/modules/*/*.devname files."
 189   (let loop ((line (read-line port)))
 190     (if (eof-object? line)
 191       '()
 192       (match (string-split line #\space)
 193        (((? (cut string-prefix? "#" <>)) _ ...)
 194         (loop (read-line port)))
 195        ((module-name device-name device-spec)
 196         (let* ((device-parts
 197                (string-match "([bc])([0-9][0-9]*):([0-9][0-9]*)"
 198                              device-spec))
 199                (type-string (match:substring device-parts 1))
 200                (type (match type-string
 201                       ("c" 'char-special)
 202                       ("b" 'block-special)))
 203                (major-string (match:substring device-parts 2))
 204                (major (string->number major-string 10))
 205                (minor-string (match:substring device-parts 3))
 206                (minor (string->number minor-string 10)))
 207           (cons (device-node device-name type major minor module-name)
 208                 (loop (read-line port)))))
 209        (_
 210         (begin
 211           (format (current-error-port)
 212                   "read-static-device-nodes: ignored devname line '~a'~%" line)
 213           (loop (read-line port))))))))
 214
 215 (define* (mkdir-p* dir #:optional (mode #o755))
 216   "This is a variant of 'mkdir-p' that works around
 217 <http://bugs.gnu.org/24659> by passing MODE explicitly in each 'mkdir' call."
 218   (define absolute?
 219     (string-prefix? "/" dir))
 220
 221   (define not-slash
 222     (char-set-complement (char-set #\/)))
 223
 224   (let loop ((components (string-tokenize dir not-slash))
 225              (root       (if absolute?
 226                              ""
 227                              ".")))
 228     (match components
 229       ((head tail ...)
 230        (let ((path (string-append root "/" head)))
 231          (catch 'system-error
 232            (lambda ()
 233              (mkdir path mode)
 234              (loop tail path))
 235            (lambda args
 236              (if (= EEXIST (system-error-errno args))
 237                  (loop tail path)
 238                  (apply throw args))))))
 239       (() #t))))
 240
 241 (define (report-system-error name . args)
 242   "Report a system error for the file NAME."
 243   (let ((errno (system-error-errno args)))
 244     (format (current-error-port) "could not create '~a': ~a~%" name
 245             (strerror errno))))
 246
 247 ;; Catch a system-error, log it and don't die from it.
 248 (define-syntax-rule (catch-system-error name exp)
 249   (catch 'system-error
 250     (lambda ()
 251       exp)
 252     (lambda args
 253       (apply report-system-error name args))))
 254
 255 ;; Create a device node like the <device-node> passed here on the file system.
 256 (define create-device-node
 257   (match-lambda
 258     (($ <device-node> xname type major minor module)
 259      (let ((name (string-append "/dev/" xname)))
 260        (mkdir-p* (dirname name))
 261        (catch-system-error name
 262          (mknod name type #o600 (device-number major minor)))))))
 263
 264 (define* (make-static-device-nodes linux-release-module-directory)
 265   "Create static device nodes required by the given Linux release.
 266 This is required in order to solve a chicken-or-egg problem:
 267 The Linux kernel has a feature to autoload modules when a device is first
 268 accessed.
 269 And udev has a feature to set the permissions of static nodes correctly
 270 when it is starting up and also to automatically create nodes when hardware
 271 is hotplugged. That leaves universal device files which are not linked to
 272 one specific hardware device. These we have to create."
 273   (let ((devname-name (string-append linux-release-module-directory "/"
 274                                      "modules.devname")))
 275     (for-each create-device-node
 276               (call-with-input-file devname-name
 277                                     read-static-device-nodes))))
 278
 279 (define* (make-essential-device-nodes #:optional (root "/"))
 280   "Make essential device nodes under ROOT/dev."
 281   ;; The hand-made devtmpfs/udev!
 282
 283   (define (scope dir)
 284     (string-append root
 285                    (if (string-suffix? "/" root)
 286                        ""
 287                        "/")
 288                    dir))
 289
 290   (unless (file-exists? (scope "dev"))
 291     (mkdir (scope "dev")))
 292
 293   ;; Make the device nodes for SCSI disks.
 294   (make-disk-device-nodes (scope "dev/sda") 8)
 295   (make-disk-device-nodes (scope "dev/sdb") 8 16)
 296   (make-disk-device-nodes (scope "dev/sdc") 8 32)
 297   (make-disk-device-nodes (scope "dev/sdd") 8 48)
 298
 299   ;; SCSI CD-ROM devices (aka. "/dev/sr0" etc.).
 300   (mknod (scope "dev/scd0") 'block-special #o644 (device-number 11 0))
 301   (mknod (scope "dev/scd1") 'block-special #o644 (device-number 11 1))
 302
 303   ;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
 304   (make-disk-device-nodes (scope "dev/vda") 252)
 305
 306   ;; Memory (used by Xorg's VESA driver.)
 307   (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
 308   (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2))
 309
 310   ;; Inputs (used by Xorg.)
 311   (unless (file-exists? (scope "dev/input"))
 312     (mkdir (scope "dev/input")))
 313   (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63))
 314   (mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
 315   (mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
 316
 317   ;; System console.  This node is magically created by the kernel on the
 318   ;; initrd's root, so don't try to create it in that case.
 319   (unless (string=? root "/")
 320     (mknod (scope "dev/console") 'char-special #o600
 321            (device-number 5 1)))
 322
 323   ;; TTYs.
 324   (mknod (scope "dev/tty") 'char-special #o600
 325          (device-number 5 0))
 326   (chmod (scope "dev/tty") #o666)
 327   (let loop ((n 0))
 328     (and (< n 50)
 329          (let ((name (format #f "dev/tty~a" n)))
 330            (mknod (scope name) 'char-special #o600
 331                   (device-number 4 n))
 332            (loop (+ 1 n)))))
 333
 334   ;; Serial line.
 335   (mknod (scope "dev/ttyS0") 'char-special #o660
 336          (device-number 4 64))
 337
 338   ;; Pseudo ttys.
 339   (mknod (scope "dev/ptmx") 'char-special #o666
 340          (device-number 5 2))
 341   (chmod (scope "dev/ptmx") #o666)
 342
 343   ;; Create /dev/pts; it will be mounted later, at boot time.
 344   (unless (file-exists? (scope "dev/pts"))
 345     (mkdir (scope "dev/pts")))
 346
 347   ;; Rendez-vous point for syslogd.
 348   (mknod (scope "dev/log") 'socket #o666 0)
 349   (mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11))
 350
 351   ;; Other useful nodes, notably relied on by guix-daemon.
 352   (for-each (match-lambda
 353              ((file major minor)
 354               (mknod (scope file) 'char-special #o666
 355                      (device-number major minor))
 356               (chmod (scope file) #o666)))
 357             '(("dev/null" 1 3)
 358               ("dev/zero" 1 5)
 359               ("dev/full" 1 7)
 360               ("dev/random" 1 8)
 361               ("dev/urandom" 1 9)))
 362
 363   (symlink "/proc/self/fd" (scope "dev/fd"))
 364   (symlink "/proc/self/fd/0" (scope "dev/stdin"))
 365   (symlink "/proc/self/fd/1" (scope "dev/stdout"))
 366   (symlink "/proc/self/fd/2" (scope "dev/stderr"))
 367
 368   ;; Loopback devices.
 369   (let loop ((i 0))
 370     (when (< i 8)
 371       (mknod (scope (string-append "dev/loop" (number->string i)))
 372              'block-special #o660
 373              (device-number 7 i))
 374       (loop (+ 1 i))))
 375
 376   ;; File systems in user space (FUSE).
 377   (mknod (scope "dev/fuse") 'char-special #o666 (device-number 10 229)))
 378
 379 (define %host-qemu-ipv4-address
 380   (inet-pton AF_INET "10.0.2.10"))
 381
 382 (define* (configure-qemu-networking #:optional (interface "eth0"))
 383   "Setup the INTERFACE network interface and /etc/resolv.conf according to
 384 QEMU's default networking settings (see net/slirp.c in QEMU for default
 385 networking values.)  Return #t if INTERFACE is up, #f otherwise."
 386   (display "configuring QEMU networking...\n")
 387   (let* ((sock    (socket AF_INET SOCK_STREAM 0))
 388          (address (make-socket-address AF_INET %host-qemu-ipv4-address 0))
 389          (flags   (network-interface-flags sock interface)))
 390     (set-network-interface-address sock interface address)
 391     (set-network-interface-flags sock interface (logior flags IFF_UP))
 392
 393     ;; Hello!  We used to create /etc/resolv.conf here, with "nameserver
 394     ;; 10.0.2.3\n".  However, with Linux-libre 3.16, we're getting ENOSPC.
 395     ;; And since it's actually unnecessary, it's gone.
 396
 397     (logand (network-interface-flags sock interface) IFF_UP)))
 398
 399 (define (device-number major minor)
 400   "Return the device number for the device with MAJOR and MINOR, for use as
 401 the last argument of `mknod'."
 402   (+ (* major 256) minor))
 403
 404 (define (pidof program)
 405   "Return the PID of the first presumed instance of PROGRAM."
 406   (let ((program (basename program)))
 407     (find (lambda (pid)
 408             (let ((exe (format #f "/proc/~a/exe" pid)))
 409               (and=> (false-if-exception (readlink exe))
 410                      (compose (cut string=? program <>) basename))))
 411           (filter-map string->number (scandir "/proc")))))
 412
 413 (define* (mount-root-file-system root type
 414                                  #:key volatile-root? (flags 0) options)
 415   "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is
 416 true, mount ROOT read-only and make it an overlay with a writable tmpfs using
 417 the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use
 418 to mount ROOT, and behave the same as for the `mount' procedure."
 419
 420   (if volatile-root?
 421       (begin
 422         (mkdir-p "/real-root")
 423         (mount root "/real-root" type (logior MS_RDONLY flags) options)
 424         (mkdir-p "/rw-root")
 425         (mount "none" "/rw-root" "tmpfs")
 426
 427         ;; Create the upperdir and the workdir of the overlayfs
 428         (mkdir-p "/rw-root/upper")
 429         (mkdir-p "/rw-root/work")
 430
 431         ;; We want read-write /dev nodes.
 432         (mkdir-p "/rw-root/upper/dev")
 433         (mount "none" "/rw-root/upper/dev" "devtmpfs")
 434
 435         ;; Make /root an overlay of the tmpfs and the actual root.
 436         (mount "none" "/root" "overlay" 0
 437                "lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
 438       (begin
 439         (check-file-system root type)
 440         (mount root "/root" type flags options)))
 441
 442   ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
 443   (false-if-exception
 444     (delete-file "/root/etc/mtab"))
 445   (mkdir-p "/root/etc")
 446   (symlink "/proc/self/mounts" "/root/etc/mtab"))
 447
 448 (define (switch-root root)
 449   "Switch to ROOT as the root file system, in a way similar to what
 450 util-linux' switch_root(8) does."
 451   (move-essential-file-systems root)
 452   (chdir root)
 453
 454   ;; Since we're about to 'rm -rf /', try to make sure we're on an initrd.
 455   ;; TODO: Use 'statfs' to check the fs type, like klibc does.
 456   (when (or (not (file-exists? "/init")) (directory-exists? "/home"))
 457     (format (current-error-port)
 458             "The root file system is probably not an initrd; \
 459 bailing out.~%root contents: ~s~%" (scandir "/"))
 460     (force-output (current-error-port))
 461     (exit 1))
 462
 463   ;; Delete files from the old root, without crossing mount points (assuming
 464   ;; there are no mount points in sub-directories.)  That means we're leaving
 465   ;; the empty ROOT directory behind us, but that's OK.
 466   (let ((root-device (stat:dev (stat "/"))))
 467     (for-each (lambda (file)
 468                 (unless (member file '("." ".."))
 469                   (let* ((file   (string-append "/" file))
 470                          (device (stat:dev (lstat file))))
 471                     (when (= device root-device)
 472                       (delete-file-recursively file)))))
 473               (scandir "/")))
 474
 475   ;; Make ROOT the new root.
 476   (mount root "/" "" MS_MOVE)
 477   (chroot ".")
 478   (chdir "/")
 479
 480   (when (file-exists? "/dev/console")
 481     ;; Close the standard file descriptors since they refer to the old
 482     ;; /dev/console, and reopen them.
 483     (let ((console (open-file "/dev/console" "r+b0")))
 484       (for-each close-fdes '(0 1 2))
 485
 486       (dup2 (fileno console) 0)
 487       (dup2 (fileno console) 1)
 488       (dup2 (fileno console) 2)
 489
 490       (close-port console))))
 491
 492 \f
 493 (define* (boot-system #:key
 494                       (linux-modules '())
 495                       linux-module-directory
 496                       keymap-file
 497                       qemu-guest-networking?
 498                       volatile-root?
 499                       pre-mount
 500                       (mounts '())
 501                       (on-error 'debug))
 502   "This procedure is meant to be called from an initrd.  Boot a system by
 503 first loading LINUX-MODULES (a list of module names) from
 504 LINUX-MODULE-DIRECTORY, then installing KEYMAP-FILE with 'loadkeys' (if
 505 KEYMAP-FILE is true), then setting up QEMU guest networking if
 506 QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems
 507 specified in MOUNTS, and finally booting into the new root if any.  The initrd
 508 supports kernel command-line options '--load', '--root', and '--repl'.
 509
 510 Mount the root file system, specified by the '--root' command-line argument,
 511 if any.
 512
 513 MOUNTS must be a list of <file-system> objects.
 514
 515 When VOLATILE-ROOT? is true, the root file system is writable but any changes
 516 to it are lost.
 517
 518 ON-ERROR is passed to 'call-with-error-handling'; it determines what happens
 519 upon error."
 520   (define (root-mount-point? fs)
 521     (string=? (file-system-mount-point fs) "/"))
 522
 523   (define (device-string->file-system-device device-string)
 524     ;; The "--root=SPEC" kernel command-line option always provides a
 525     ;; string, but the string can represent a device, an nfs-root, a UUID, or a
 526     ;; label.  So check for all four.
 527     (cond ((string-prefix? "/" device-string) device-string)
 528           ((string-contains device-string ":/") device-string) ; nfs-root
 529           ((uuid device-string) => identity)
 530           (else (file-system-label device-string))))
 531
 532   (display "Welcome, this is GNU's early boot Guile.\n")
 533   (display "Use '--repl' for an initrd REPL.\n\n")
 534
 535   (call-with-error-handling
 536     (lambda ()
 537       (mount-essential-file-systems)
 538       (let* ((args    (linux-command-line))
 539              (to-load (find-long-option "--load" args))
 540              (root-fs (find root-mount-point? mounts))
 541              (root-fs-type (or (and=> root-fs file-system-type)
 542                                "ext4"))
 543              (root-fs-device (and=> root-fs file-system-device))
 544              (root-fs-flags (mount-flags->bit-mask
 545                              (or (and=> root-fs file-system-flags)
 546                                  '())))
 547              (root-options (if root-fs
 548                                (file-system-options root-fs)
 549                                #f))
 550              ;; --root takes precedence over the 'device' field of the root
 551              ;; <file-system> record.
 552              (root-device (or (and=> (find-long-option "--root" args)
 553                                      device-string->file-system-device)
 554                               root-fs-device)))
 555
 556         (when (member "--repl" args)
 557           (start-repl))
 558
 559         (display "loading kernel modules...\n")
 560         (load-linux-modules-from-directory linux-modules
 561                                            linux-module-directory)
 562
 563         (unless (or (member "hibernate=noresume" args)
 564                     ;; Also handle the equivalent old-style argument.
 565                     ;; See Documentation/admin-guide/kernel-parameters.txt.
 566                     (member "noresume" args))
 567           ;; Try to resume immediately after loading (storage) modules
 568           ;; but before any on-disk file systems have been mounted.
 569           (false-if-exception           ; failure is not fatal
 570            (resume-if-hibernated (find-long-option "resume" args))))
 571
 572         (when keymap-file
 573           (let ((status (system* "loadkeys" keymap-file)))
 574             (unless (zero? status)
 575               ;; Emit a warning rather than abort when we cannot load
 576               ;; KEYMAP-FILE.
 577               (format (current-error-port)
 578                       "warning: 'loadkeys' exited with status ~a~%"
 579                       status))))
 580
 581         (when qemu-guest-networking?
 582           (unless (configure-qemu-networking)
 583             (display "network interface is DOWN\n")))
 584
 585         ;; Prepare the real root file system under /root.
 586         (unless (file-exists? "/root")
 587           (mkdir "/root"))
 588
 589         (when (procedure? pre-mount)
 590           ;; Do whatever actions are needed before mounting the root file
 591           ;; system--e.g., installing device mappings.  Error out when the
 592           ;; return value is false.
 593           (unless (pre-mount)
 594             (error "pre-mount actions failed")))
 595
 596         (setenv "EXT2FS_NO_MTAB_OK" "1")
 597
 598         (if root-device
 599             (mount-root-file-system (canonicalize-device-spec root-device)
 600                                     root-fs-type
 601                                     #:volatile-root? volatile-root?
 602                                     #:flags root-fs-flags
 603                                     #:options root-options)
 604             (mount "none" "/root" "tmpfs"))
 605
 606         ;; Mount the specified file systems.
 607         (for-each mount-file-system
 608                   (remove root-mount-point? mounts))
 609
 610         (setenv "EXT2FS_NO_MTAB_OK" #f)
 611
 612         (if to-load
 613             (begin
 614               (switch-root "/root")
 615               (format #t "loading '~a'...\n" to-load)
 616
 617               (primitive-load to-load)
 618
 619               (format (current-error-port)
 620                       "boot program '~a' terminated, rebooting~%"
 621                       to-load)
 622               (sleep 2)
 623               (reboot))
 624             (begin
 625               (display "no boot file passed via '--load'\n")
 626               (display "entering a warm and cozy REPL\n")
 627               (start-repl)))))
 628     #:on-error on-error))
 629
 630 ;;; linux-boot.scm ends here