aboutsummaryrefslogtreecommitdiff
# GNU Guix --- Functional package management for GNU
# Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
# Copyright © 2016 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
# Copyright © 2016, 2018 Mathieu Lirzin <mthl@gnu.org>
# Copyright © 2018, 2021 Julien Lepiller <julien@lepiller.eu>
# Copyright © 2019 Timothy Sample <samplet@ngyro.com>
# Copyright © 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
# Copyright © 2024 gemmaro <gemmaro.dev@gmail.com>
#
# 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/>.

# If adding a language, update the following variables, and info_TEXINFOS.
MANUAL_LANGUAGES = de es fr pt_BR ru zh_CN
COOKBOOK_LANGUAGES = de fr ko pt_BR sk sv

# Arg1: A list of languages codes.
# Arg2: The file name stem.
lang_to_texinfo = $(foreach lang,$(1),%D%/$(2).$(lang).texi)

# Automake does not understand GNU Make non-standard extensions,
# unfortunately, so we cannot use the above patsubst-based function here.
info_TEXINFOS = %D%/guix.texi			\
  %D%/guix.de.texi				\
  %D%/guix.es.texi				\
  %D%/guix.fr.texi				\
  %D%/guix.pt_BR.texi				\
  %D%/guix.ru.texi				\
  %D%/guix.zh_CN.texi				\
  %D%/guix-cookbook.texi			\
  %D%/guix-cookbook.de.texi			\
  %D%/guix-cookbook.fr.texi			\
  %D%/guix-cookbook.ko.texi			\
  %D%/guix-cookbook.pt_BR.texi			\
  %D%/guix-cookbook.sk.texi			\
  %D%/guix-cookbook.sv.texi

%C%_guix_TEXINFOS = \
  %D%/contributing.texi \
  %D%/fdl-1.3.texi

DOT_FILES =					\
  %D%/images/bootstrap-graph.dot		\
  %D%/images/bootstrap-packages.dot		\
  %D%/images/coreutils-graph.dot		\
  %D%/images/coreutils-bag-graph.dot		\
  %D%/images/gcc-core-mesboot0-graph.dot	\
  %D%/images/service-graph.dot			\
  %D%/images/shepherd-graph.dot

DOT_VECTOR_GRAPHICS =				\
  $(DOT_FILES:%.dot=%.eps)			\
  $(DOT_FILES:%.dot=%.pdf)

EXTRA_DIST +=					\
  %D%/htmlxref.cnf				\
  $(DOT_FILES)					\
  $(DOT_VECTOR_GRAPHICS)			\
  %D%/images/coreutils-size-map.eps		\
  %D%/environment-gdb.scm			\
  %D%/package-hello.scm				\
  %D%/package-hello.json

OS_CONFIG_EXAMPLES_TEXI =			\
  %D%/os-config-bare-bones.texi			\
  %D%/os-config-desktop.texi			\
  %D%/os-config-lightweight-desktop.texi	\
  %D%/he-config-bare-bones.scm

TRANSLATED_INFO = 						\
  $(call lang_to_texinfo,$(MANUAL_LANGUAGES),guix)		\
  $(call lang_to_texinfo,$(MANUAL_LANGUAGES),contributing)	\
  $(call lang_to_texinfo,$(COOKBOOK_LANGUAGES),guix-cookbook)

# Bundle this file so that makeinfo finds it in out-of-source-tree builds.
BUILT_SOURCES        += $(OS_CONFIG_EXAMPLES_TEXI) $(TRANSLATED_INFO)
EXTRA_DIST           += $(OS_CONFIG_EXAMPLES_TEXI) $(TRANSLATED_INFO)
MAINTAINERCLEANFILES  = $(OS_CONFIG_EXAMPLES_TEXI) $(TRANSLATED_INFO)

# When a change to guix.texi occurs, it is not translated immediately.
# Because @pxref and @xref commands are references to sections by name, they
# should be translated. If a modification adds a reference to a section, this
# reference is not translated, which means it references a section that does not
# exist.
define xref_command
$(top_builddir)/pre-inst-env $(GUILE) --no-auto-compile	\
  "$(top_srcdir)/build-aux/convert-xref.scm"		\
  $@.tmp $<
endef

# If /dev/null is used for this POT file path, a warning will be issued
# because the path extension is not 'pot'.
dummy_pot = $(shell mktemp --suffix=.pot)

%D%:
	$(AM_V_GEN)$(MKDIR_P) "$@"

%D%/guix.%.texi: po/doc/guix-manual.%.po %D%/contributing.%.texi \
		guix/build/po.go | %D%
	-$(AM_V_PO4A)$(PO4A) --no-update			\
	    --variable localized="$@.tmp"			\
	    --variable master="$(srcdir)/%D%/guix.texi"		\
	    --variable po="$<"					\
	    --variable pot=$(dummy_pot)			\
	    $(srcdir)/po/doc/po4a.cfg
	-sed -i "s|guix\.info|$$(basename "$@" | sed 's|texi$$|info|')|" "$@.tmp"
	-$(AM_V_POXREF)LC_ALL=en_US.UTF-8 $(xref_command)
	-mv "$@.tmp" "$@"

%D%/guix-cookbook.%.texi: po/doc/guix-cookbook.%.po guix/build/po.go | %D%
	-$(AM_V_PO4A)$(PO4A) --no-update			\
	    --variable localized="$@.tmp"			\
	    --variable master="$(srcdir)/%D%/guix-cookbook.texi" \
	    --variable po="$<"					\
	    --variable pot=$(dummy_pot)			\
	    $(srcdir)/po/doc/po4a.cfg
	-sed -i "s|guix-cookbook\.info|$$(basename "$@" | sed 's|texi$$|info|')|" "$@.tmp"
	-$(AM_V_POXREF)LC_ALL=en_US.UTF-8 $(xref_command)
	-mv "$@.tmp" "$@"

%D%/contributing.%.texi: po/doc/guix-manual.%.po guix/build/po.go | %D%
	-$(AM_V_PO4A)$(PO4A) --no-update			\
	    --variable localized="$@.tmp"			\
	    --variable master="$(srcdir)/%D%/contributing.texi"	\
	    --variable po="$<"					\
	    --variable pot=$(dummy_pot)			\
	    $(srcdir)/po/doc/po4a.cfg
	-$(AM_V_POXREF)LC_ALL=en_US.UTF-8 $(xref_command)
	-mv "$@.tmp" "$@"

%D%/os-config-%.texi: gnu/system/examples/%.tmpl | %D%
	cp "$<" "$@"

infoimagedir = $(infodir)/images
dist_infoimage_DATA =				\
  $(DOT_FILES:%.dot=%.png)			\
  %D%/images/coreutils-size-map.png		\
  %D%/images/installer-network.png		\
  %D%/images/installer-partitions.png		\
  %D%/images/installer-resume.png

# Ask for warnings about cross-referenced manuals that are not listed in
# htmlxref.cnf.
AM_MAKEINFOHTMLFLAGS = --set-customization-variable CHECK_HTMLXREF=true

# Try hard to obtain an image size and aspect that's reasonable for inclusion
# in an Info or PDF document.
DOT_OPTIONS =					\
  -Gratio=.9 -Gnodesep=.005 -Granksep=.00005	\
  -Nfontsize=9 -Nheight=.1 -Nwidth=.1

.dot.png:
	$(AM_V_GEN)$(MKDIR_P) "$$(dirname "$@")"
	$(AM_V_DOT)$(DOT) -Tpng $(DOT_OPTIONS) < "$<" > "$@.tmp"
	$(AM_V_at)mv "$@.tmp" "$@"

.dot.pdf:
	$(AM_V_GEN)$(MKDIR_P) "$$(dirname "$@")"
	$(AM_V_DOT)set -e; export TZ=UTC0;				\
	    $(DOT) -Tpdf $(DOT_OPTIONS) < "$<" > "$@.tmp"
	$(AM_V_at)sed -ri					\
	    -e 's,(/CreationDate \(D:).*\),\119700101000000),'	\
	    "$@.tmp"
	$(AM_V_at)mv "$@.tmp" "$@"

.dot.eps:
	$(AM_V_GEN)$(MKDIR_P) "$$(dirname "$@")"
	$(AM_V_DOT)$(DOT) -Teps $(DOT_OPTIONS) < "$<" > "$@.tmp"
	$(AM_v_at)! grep -q %%CreationDate "$@.tmp"
	$(AM_V_at)mv "$@.tmp" "$@"

.png.eps:
	$(AM_V_GEN)$(MKDIR_P) "$$(dirname "$@")"
	$(AM_V_GEN)convert "$<" "$@-tmp.eps"
	$(AM_V_at)mv "$@-tmp.eps" "$@"

# We cannot add new dependencies to `%D%/guix.pdf' & co. (info "(automake)
# Extending").  Using the `-local' rules is imperfect, because they may be
# triggered after the main rule.  Oh, well.
pdf-local: $(DOT_FILES=%.dot=$(top_srcdir)/%.pdf)
info-local: $(DOT_FILES=%.dot=$(top_srcdir)/%.png)
ps-local: $(DOT_FILES=%.dot=$(top_srcdir)/%.eps)		\
	  $(top_srcdir)/%D%/images/coreutils-size-map.eps
dvi-local: ps-local

## ----------- ##
##  Man pages. ##
## ----------- ##

# The man pages are generated using GNU Help2man.  In makefiles rules they
# depend not on the binary, but on the source files.  This usage allows a
# manual page to be generated by the maintainer and included in the
# distribution without requiring the end-user to have 'help2man' installed.
# They are built in $(srcdir) like info manuals.

sub_commands_mans =				\
  $(srcdir)/%D%/guix-archive.1			\
  $(srcdir)/%D%/guix-build.1			\
  $(srcdir)/%D%/guix-challenge.1		\
  $(srcdir)/%D%/guix-container.1		\
  $(srcdir)/%D%/guix-copy.1			\
  $(srcdir)/%D%/guix-deploy.1			\
  $(srcdir)/%D%/guix-describe.1			\
  $(srcdir)/%D%/guix-download.1			\
  $(srcdir)/%D%/guix-edit.1			\
  $(srcdir)/%D%/guix-environment.1		\
  $(srcdir)/%D%/guix-gc.1			\
  $(srcdir)/%D%/guix-git.1			\
  $(srcdir)/%D%/guix-graph.1			\
  $(srcdir)/%D%/guix-hash.1			\
  $(srcdir)/%D%/guix-home.1			\
  $(srcdir)/%D%/guix-import.1			\
  $(srcdir)/%D%/guix-lint.1			\
  $(srcdir)/%D%/guix-offload.1			\
  $(srcdir)/%D%/guix-pack.1			\
  $(srcdir)/%D%/guix-package.1			\
  $(srcdir)/%D%/guix-processes.1		\
  $(srcdir)/%D%/guix-publish.1			\
  $(srcdir)/%D%/guix-pull.1			\
  $(srcdir)/%D%/guix-refresh.1			\
  $(srcdir)/%D%/guix-repl.1			\
  $(srcdir)/%D%/guix-shell.1			\
  $(srcdir)/%D%/guix-size.1			\
  $(srcdir)/%D%/guix-style.1			\
  $(srcdir)/%D%/guix-system.1			\
  $(srcdir)/%D%/guix-time-machine.1		\
  $(srcdir)/%D%/guix-weather.1

# Assume that cross-compiled commands cannot be executed.
if !CROSS_COMPILING

dist_man1_MANS =				\
  $(srcdir)/%D%/guix.1				\
  $(sub_commands_mans)

endif

gen_man =						\
  LANGUAGE= $(top_builddir)/pre-inst-env $(HELP2MAN)	\
  $(HELP2MANFLAGS)

HELP2MANFLAGS = --source=GNU --info-page=$(PACKAGE_TARNAME)
# help2man reproducibility
SOURCE_DATE_EPOCH = $(shell git show HEAD --format=%ct --no-patch 2>/dev/null || echo 1)
export SOURCE_DATE_EPOCH

$(srcdir)/%D%/guix.1: scripts/guix.in $(sub_commands_mans)
	-$(AM_V_HELP2MAN)$(gen_man) --output="$@" `basename "$@" .1`

# The 'case' ensures the man pages are only generated if the corresponding
# source script (the first prerequisite) has been changed.  The $(GOBJECTS)
# prerequisite is solely meant to force these docs to be made only after all
# Guile modules have been compiled.  We also need the guix script to exist.
$(srcdir)/%D%/guix-%.1: guix/scripts/%.scm $(GOBJECTS) scripts/guix
	-@case '$?' in								\
	  *$<*) $(AM_V_HELP2MAN:@%=%)$(gen_man) --output="$@" "guix $*";;	\
	  *)    : ;;								\
	esac

if BUILD_DAEMON
if !CROSS_COMPILING

dist_man1_MANS += $(srcdir)/%D%/guix-daemon.1

$(srcdir)/%D%/guix-daemon.1: guix-daemon$(EXEEXT)
	-$(AM_V_HELP2MAN)$(gen_man) --output="$@" `basename "$@" .1`

endif
endif

# Reproducible tarball

DIST_CONFIGURE_FLAGS =				\
  --localstatedir=/var				\
  --sysconfdir=/etc

# Delete all Autotools-generated files and rerun configure to ensure
# a clean cache and distributing reproducible versions.
auto-clean: maintainer-clean-vti doc-clean
	rm -f ABOUT-NLS INSTALL
	rm -f aclocal.m4 configure libtool Makefile.in
	if test -e .git; then				\
	    git clean -fdx -- '.am*' build-aux m4 po;	\
	else						\
	    rm -rf .am*;				\
	    $(MAKE) -C po/guix maintainer-clean;	\
	    $(MAKE) -C po/packages maintainer-clean;	\
	fi
	rm -f guile
	rm -f guix-daemon nix/nix-daemon/guix_daemon-guix-daemon.o
# Automake fails if guix-cookbook-LANG.texi stubs are missing; running
# autoreconf -vif is not enough.
	./bootstrap
# The dependency chain for the guix-cookbook-LANG.texi was cut on purpose;
# they must be deleted to ensure a rebuild.
	rm -f $(filter-out %D%/guix.texi %D%/guix-cookbook.texi, $(info_TEXINFOS))
	./configure $(DIST_CONFIGURE_FLAGS)

# Delete all generated doc files to ensure a clean cache and distributing
# reproducible versions.
doc-clean:
	rm -f $(srcdir)/doc/*.1
	rm -f $(srcdir)/doc/stamp*
	rm -f $(DOT_FILES:%.dot=%.png)
	rm -f $(DOT_VECTOR_GRAPHICS)
	rm -f doc/images/coreutils-size-map.eps
generated by cgit
device nodes under ROOT/dev." ;; The hand-made devtmpfs/udev! (define (scope dir) (string-append root (if (string-suffix? "/" root) "" "/") dir)) (unless (file-exists? (scope "dev")) (mkdir (scope "dev"))) ;; Make the device nodes for SCSI disks. (make-disk-device-nodes (scope "dev/sda") 8) (make-disk-device-nodes (scope "dev/sdb") 8 16) (make-disk-device-nodes (scope "dev/sdc") 8 32) (make-disk-device-nodes (scope "dev/sdd") 8 48) ;; SCSI CD-ROM devices (aka. "/dev/sr0" etc.). (mknod (scope "dev/scd0") 'block-special #o644 (device-number 11 0)) (mknod (scope "dev/scd1") 'block-special #o644 (device-number 11 1)) ;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM. (make-disk-device-nodes (scope "dev/vda") 252) ;; Memory (used by Xorg's VESA driver.) (mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1)) (mknod (scope "dev/kmem") 'char-special #o640 (device-number 1 2)) ;; Inputs (used by Xorg.) (unless (file-exists? (scope "dev/input")) (mkdir (scope "dev/input"))) (mknod (scope "dev/input/mice") 'char-special #o640 (device-number 13 63)) (mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32)) (mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64)) ;; System console. This node is magically created by the kernel on the ;; initrd's root, so don't try to create it in that case. (unless (string=? root "/") (mknod (scope "dev/console") 'char-special #o600 (device-number 5 1))) ;; TTYs. (mknod (scope "dev/tty") 'char-special #o600 (device-number 5 0)) (chmod (scope "dev/tty") #o666) (let loop ((n 0)) (and (< n 50) (let ((name (format #f "dev/tty~a" n))) (mknod (scope name) 'char-special #o600 (device-number 4 n)) (loop (+ 1 n))))) ;; Serial line. (mknod (scope "dev/ttyS0") 'char-special #o660 (device-number 4 64)) ;; Pseudo ttys. (mknod (scope "dev/ptmx") 'char-special #o666 (device-number 5 2)) (chmod (scope "dev/ptmx") #o666) ;; Create /dev/pts; it will be mounted later, at boot time. (unless (file-exists? (scope "dev/pts")) (mkdir (scope "dev/pts"))) ;; Rendez-vous point for syslogd. (mknod (scope "dev/log") 'socket #o666 0) (mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11)) ;; Other useful nodes, notably relied on by guix-daemon. (for-each (match-lambda ((file major minor) (mknod (scope file) 'char-special #o666 (device-number major minor)) (chmod (scope file) #o666))) '(("dev/null" 1 3) ("dev/zero" 1 5) ("dev/full" 1 7) ("dev/random" 1 8) ("dev/urandom" 1 9))) (symlink "/proc/self/fd" (scope "dev/fd")) (symlink "/proc/self/fd/0" (scope "dev/stdin")) (symlink "/proc/self/fd/1" (scope "dev/stdout")) (symlink "/proc/self/fd/2" (scope "dev/stderr")) ;; Loopback devices. (let loop ((i 0)) (when (< i 8) (mknod (scope (string-append "dev/loop" (number->string i))) 'block-special #o660 (device-number 7 i)) (loop (+ 1 i)))) ;; File systems in user space (FUSE). (mknod (scope "dev/fuse") 'char-special #o666 (device-number 10 229))) (define %host-qemu-ipv4-address (inet-pton AF_INET "10.0.2.10")) (define* (configure-qemu-networking #:optional (interface "eth0")) "Setup the INTERFACE network interface and /etc/resolv.conf according to QEMU's default networking settings (see net/slirp.c in QEMU for default networking values.) Return #t if INTERFACE is up, #f otherwise." (display "configuring QEMU networking...\n") (let* ((sock (socket AF_INET SOCK_STREAM 0)) (address (make-socket-address AF_INET %host-qemu-ipv4-address 0)) (flags (network-interface-flags sock interface))) (set-network-interface-address sock interface address) (set-network-interface-flags sock interface (logior flags IFF_UP)) (logand (network-interface-flags sock interface) IFF_UP))) (define (pidof program) "Return the PID of the first presumed instance of PROGRAM." (let ((program (basename program))) (find (lambda (pid) (let ((exe (format #f "/proc/~a/exe" pid))) (and=> (false-if-exception (readlink exe)) (compose (cut string=? program <>) basename)))) (filter-map string->number (scandir "/proc"))))) (define* (mount-root-file-system root type #:key volatile-root? (flags 0) options check? skip-check-if-clean? repair) "Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is true, mount ROOT read-only and make it an overlay with a writable tmpfs using the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use to mount ROOT, and behave the same as for the `mount' procedure. If CHECK? is true, first run ROOT's fsck tool (if any) non-interactively. If SKIP-CHECK-IF-CLEAN? is true, ask fsck to return immediately if ROOT is marked as clean. If REPAIR is true, fsck may write to ROOT to perform repairs. If REPAIR is also 'PREEN, ask fsck to perform only those repairs that it considers safe." (if volatile-root? (begin (mkdir-p "/real-root") (mount root "/real-root" type (logior MS_RDONLY flags) options) (mkdir-p "/rw-root") (mount "none" "/rw-root" "tmpfs") ;; Create the upperdir and the workdir of the overlayfs (mkdir-p "/rw-root/upper") (mkdir-p "/rw-root/work") ;; We want read-write /dev nodes. (mkdir-p "/rw-root/upper/dev") (mount "none" "/rw-root/upper/dev" "devtmpfs") ;; Make /root an overlay of the tmpfs and the actual root. (mount "none" "/root" "overlay" 0 "lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work")) (begin (when check? (check-file-system root type (not skip-check-if-clean?) repair)) (mount root "/root" type flags options))) ;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts. (false-if-exception (delete-file "/root/etc/mtab")) (mkdir-p "/root/etc") (symlink "/proc/self/mounts" "/root/etc/mtab")) (define (switch-root root) "Switch to ROOT as the root file system, in a way similar to what util-linux' switch_root(8) does." (move-essential-file-systems root) (chdir root) ;; Since we're about to 'rm -rf /', try to make sure we're on an initrd. ;; TODO: Use 'statfs' to check the fs type, like klibc does. (when (or (not (file-exists? "/init")) (directory-exists? "/home")) (format (current-error-port) "The root file system is probably not an initrd; \ bailing out.~%root contents: ~s~%" (scandir "/")) (force-output (current-error-port)) (exit 1)) ;; Delete files from the old root, without crossing mount points (assuming ;; there are no mount points in sub-directories.) That means we're leaving ;; the empty ROOT directory behind us, but that's OK. (let ((root-device (stat:dev (stat "/")))) (for-each (lambda (file) (unless (member file '("." "..")) (let* ((file (string-append "/" file)) (device (stat:dev (lstat file)))) (when (= device root-device) (delete-file-recursively file))))) (scandir "/"))) ;; Make ROOT the new root. (mount root "/" "" MS_MOVE) (chroot ".") (chdir "/") (when (file-exists? "/dev/console") ;; Close the standard file descriptors since they refer to the old ;; /dev/console, and reopen them. (let ((console (open-file "/dev/console" "r+b0"))) (for-each close-fdes '(0 1 2)) (dup2 (fileno console) 0) (dup2 (fileno console) 1) (dup2 (fileno console) 2) (close-port console)))) (define* (boot-system #:key (linux-modules '()) linux-module-directory keymap-file qemu-guest-networking? volatile-root? pre-mount (mounts '()) (on-error 'debug)) "This procedure is meant to be called from an initrd. Boot a system by first loading LINUX-MODULES (a list of module names) from LINUX-MODULE-DIRECTORY, then installing KEYMAP-FILE with 'loadkeys' (if KEYMAP-FILE is true), then setting up QEMU guest networking if QEMU-GUEST-NETWORKING? is true, calling PRE-MOUNT, mounting the file systems specified in MOUNTS, and finally booting into the new root if any. The initrd supports the kernel command-line options 'gnu.load' and 'gnu.repl'. It also honors a subset of the Linux kernel command-line parameters such as 'fsck.mode', 'resume', 'rootdelay', rootflags and rootfstype. Mount the root file system, specified by the 'root' command-line argument, if any. MOUNTS must be a list of <file-system> objects. When VOLATILE-ROOT? is true, the root file system is writable but any changes to it are lost. ON-ERROR is passed to 'call-with-error-handling'; it determines what happens upon error." (define (root-mount-point? fs) (string=? (file-system-mount-point fs) "/")) (define (device-string->file-system-device device-string) ;; The "root=SPEC" kernel command-line option always provides a string, ;; but the string can represent a device, an nfs-root, a UUID, or a label. ;; So check for all four. (cond ((string-prefix? "/" device-string) device-string) ((string-contains device-string ":/") device-string) ; nfs-root ((uuid device-string) => identity) (else (file-system-label device-string)))) (display "Welcome, this is GNU's early boot Guile.\n") (display "Use 'gnu.repl' for an initrd REPL.\n\n") (call-with-error-handling (lambda () (mount-essential-file-systems) (let* ((args (linux-command-line)) (to-load (find-long-option "gnu.load" args)) ;; If present, ‘root’ on the kernel command line takes precedence ;; over the ‘device’ field of the root <file-system> record. (root-device (and=> (find-long-option "root" args) device-string->file-system-device)) (rootfstype (find-long-option "rootfstype" args)) (rootflags (find-long-option "rootflags" args)) (root-fs* (find root-mount-point? mounts)) (fsck.mode (find-long-option "fsck.mode" args))) (unless (or root-fs* (and root-device rootfstype)) (error "no root file system or 'root' and 'rootfstype' parameters")) ;; If present, ‘root’ on the kernel command line takes precedence over ;; the ‘device’ field of the root <file-system> record; likewise for ;; the 'rootfstype' and 'rootflags' arguments. (define root-fs (if root-fs* (file-system (inherit root-fs*) (device (or root-device (file-system-device root-fs*))) (type (or rootfstype (file-system-type root-fs*))) (options (or rootflags (file-system-options root-fs*)))) (file-system (device root-device) (mount-point "/") (type rootfstype) (options rootflags)))) (define (check? fs) (match fsck.mode ("skip" #f) ("force" #t) (_ (file-system-check? fs)))) ; assume "auto" (define (skip-check-if-clean? fs) (match fsck.mode ("force" #f) (_ (file-system-skip-check-if-clean? fs)))) (define (repair fs) (let ((arg (find-long-option "fsck.repair" args))) (if arg (match arg ("no" #f) ("yes" #t) (_ 'preen)) (file-system-repair fs)))) (when (member "gnu.repl" args) (start-repl)) (display "loading kernel modules...\n") (load-linux-modules-from-directory linux-modules linux-module-directory) (when keymap-file (let ((status (system* "loadkeys" keymap-file))) (unless (zero? status) ;; Emit a warning rather than abort when we cannot load ;; KEYMAP-FILE. (format (current-error-port) "warning: 'loadkeys' exited with status ~a~%" status)))) (when qemu-guest-networking? (unless (configure-qemu-networking) (display "network interface is DOWN\n"))) ;; A big ugly hammer, to be used only for debugging and in desperate ;; situations where no proper device synchonisation is possible. (let ((root-delay (and=> (find-long-option "rootdelay" args) string->number))) (when root-delay (format #t "Pausing for rootdelay=~a seconds before mounting \ the root file system...\n" root-delay) (sleep root-delay))) (when (procedure? pre-mount) ;; Do whatever actions are needed before mounting the root file ;; system--e.g., installing device mappings. Error out when the ;; return value is false. (unless (pre-mount) (error "pre-mount actions failed"))) (unless (or (member "hibernate=noresume" args) ;; Also handle the equivalent old-style argument. ;; See Documentation/admin-guide/kernel-parameters.txt. (member "noresume" args)) ;; Try to resume immediately after loading (storage) modules ;; but before any on-disk file systems have been mounted. (false-if-exception ; failure is not fatal (resume-if-hibernated (find-long-option "resume" args)))) ;; Prepare the real root file system under /root. (unless (file-exists? "/root") (mkdir "/root")) (setenv "EXT2FS_NO_MTAB_OK" "1") ;; Mount the root file system. (mount-root-file-system (canonicalize-device-spec (file-system-device root-fs)) (file-system-type root-fs) #:volatile-root? volatile-root? #:flags (mount-flags->bit-mask (file-system-flags root-fs)) #:options (file-system-options root-fs) #:check? (check? root-fs) #:skip-check-if-clean? (skip-check-if-clean? root-fs) #:repair (repair root-fs)) ;; Mount the specified non-root file systems. (for-each (lambda (fs) (mount-file-system fs #:check? (check? fs) #:skip-check-if-clean? (skip-check-if-clean? fs) #:repair (repair fs))) (remove root-mount-point? mounts)) (setenv "EXT2FS_NO_MTAB_OK" #f) (if to-load (begin (switch-root "/root") (format #t "loading '~a'...\n" to-load) (primitive-load to-load) (format (current-error-port) "boot program '~a' terminated, rebooting~%" to-load) (sleep 2) (reboot)) (begin (display "no boot file passed via 'gnu.load'\n") (display "entering a warm and cozy REPL\n") (start-repl))))) #:on-error on-error)) ;;; linux-boot.scm ends here
generated by cgit