1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
4 ;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
5 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
6 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
7 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
9 ;;; This file is part of GNU Guix.
11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or (at
14 ;;; your option) any later version.
16 ;;; GNU Guix is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
24 (define-module (gnu system)
25 #:use-module (guix inferior)
26 #:use-module (guix store)
27 #:use-module (guix monads)
28 #:use-module (guix gexp)
29 #:use-module (guix records)
30 #:use-module (guix packages)
31 #:use-module (guix derivations)
32 #:use-module (guix profiles)
33 #:use-module (guix ui)
34 #:use-module (gnu packages base)
35 #:use-module (gnu packages bash)
36 #:use-module (gnu packages guile)
37 #:use-module (gnu packages guile-xyz)
38 #:use-module (gnu packages admin)
39 #:use-module (gnu packages linux)
40 #:use-module (gnu packages pciutils)
41 #:use-module (gnu packages package-management)
42 #:use-module (gnu packages less)
43 #:use-module (gnu packages zile)
44 #:use-module (gnu packages nano)
45 #:use-module (gnu packages gawk)
46 #:use-module (gnu packages man)
47 #:use-module (gnu packages texinfo)
48 #:use-module (gnu packages compression)
49 #:use-module (gnu packages firmware)
50 #:use-module (gnu services)
51 #:use-module (gnu services shepherd)
52 #:use-module (gnu services base)
53 #:use-module (gnu bootloader)
54 #:use-module (gnu system shadow)
55 #:use-module (gnu system nss)
56 #:use-module (gnu system locale)
57 #:use-module (gnu system pam)
58 #:use-module (gnu system linux-initrd)
59 #:use-module (gnu system uuid)
60 #:use-module (gnu system file-systems)
61 #:use-module (gnu system mapped-devices)
62 #:use-module (ice-9 match)
63 #:use-module (srfi srfi-1)
64 #:use-module (srfi srfi-26)
65 #:use-module (srfi srfi-34)
66 #:use-module (srfi srfi-35)
67 #:use-module (rnrs bytevectors)
68 #:export (operating-system
72 operating-system-bootloader
73 operating-system-services
74 operating-system-essential-services
75 operating-system-default-essential-services
76 operating-system-user-services
77 operating-system-packages
78 operating-system-host-name
79 operating-system-hosts-file
80 operating-system-kernel
81 operating-system-kernel-file
82 operating-system-kernel-arguments
83 operating-system-label
84 operating-system-default-label
85 operating-system-initrd-modules
86 operating-system-initrd
87 operating-system-users
88 operating-system-groups
89 operating-system-issue
90 operating-system-timezone
91 operating-system-locale
92 operating-system-locale-definitions
93 operating-system-locale-libcs
94 operating-system-mapped-devices
95 operating-system-file-systems
96 operating-system-store-file-system
97 operating-system-user-mapped-devices
98 operating-system-boot-mapped-devices
99 operating-system-activation-script
100 operating-system-user-accounts
101 operating-system-shepherd-service-names
102 operating-system-user-kernel-arguments
104 operating-system-derivation
105 operating-system-profile
106 operating-system-bootcfg
107 operating-system-etc-directory
108 operating-system-locale-directory
109 operating-system-boot-script
111 system-linux-image-file-name
112 operating-system-with-gc-roots
113 operating-system-with-provenance
117 boot-parameters-label
118 boot-parameters-root-device
119 boot-parameters-bootloader-name
120 boot-parameters-bootloader-menu-entries
121 boot-parameters-store-device
122 boot-parameters-store-mount-point
123 boot-parameters-kernel
124 boot-parameters-kernel-arguments
125 boot-parameters-initrd
127 read-boot-parameters-file
128 boot-parameters->menu-entry
138 ;;; This module supports whole-system configuration.
142 (define (bootable-kernel-arguments system root-device)
143 "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
144 (list (string-append "--root="
145 (cond ((uuid? root-device)
147 ;; Note: Always use the DCE format because that's
148 ;; what (gnu build linux-boot) expects for the
149 ;; '--root' kernel command-line option.
150 (uuid->string (uuid-bytevector root-device)
152 ((file-system-label? root-device)
153 (file-system-label->string root-device))
155 #~(string-append "--system=" #$system)
156 #~(string-append "--load=" #$system "/boot")))
158 ;; System-wide configuration.
159 ;; TODO: Add per-field docstrings/stexi.
160 (define-record-type* <operating-system> operating-system
161 make-operating-system
163 this-operating-system
165 (kernel operating-system-kernel ; package
166 (default linux-libre))
167 (kernel-arguments operating-system-user-kernel-arguments
168 (default '("quiet"))) ; list of gexps/strings
169 (bootloader operating-system-bootloader) ; <bootloader-configuration>
170 (label operating-system-label ; string
172 (default (operating-system-default-label this-operating-system)))
174 (keyboard-layout operating-system-keyboard-layout ;#f | <keyboard-layout>
176 (initrd operating-system-initrd ; (list fs) -> file-like
177 (default base-initrd))
178 (initrd-modules operating-system-initrd-modules ; list of strings
179 (thunked) ; it's system-dependent
180 (default %base-initrd-modules))
182 (firmware operating-system-firmware ; list of packages
183 (default %base-firmware))
185 (host-name operating-system-host-name) ; string
186 (hosts-file operating-system-hosts-file ; file-like | #f
189 (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
191 (file-systems operating-system-file-systems) ; list of fs
192 (swap-devices operating-system-swap-devices ; list of strings
195 (users operating-system-users ; list of user accounts
196 (default %base-user-accounts))
197 (groups operating-system-groups ; list of user groups
198 (default %base-groups))
200 (skeletons operating-system-skeletons ; list of name/file-like value
201 (default (default-skeletons)))
202 (issue operating-system-issue ; string
203 (default %default-issue))
205 (packages operating-system-packages ; list of (PACKAGE OUTPUT...)
206 (default %base-packages)) ; or just PACKAGE
208 (timezone operating-system-timezone) ; string
209 (locale operating-system-locale ; string
210 (default "en_US.utf8"))
211 (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
212 (default %default-locale-definitions))
213 (locale-libcs operating-system-locale-libcs ; list of <packages>
214 (default %default-locale-libcs))
215 (name-service-switch operating-system-name-service-switch ; <name-service-switch>
216 (default %default-nss))
218 (essential-services operating-system-essential-services ; list of services
220 (default (operating-system-default-essential-services
221 this-operating-system)))
222 (services operating-system-user-services ; list of services
223 (default %base-services))
225 (pam-services operating-system-pam-services ; list of PAM services
226 (default (base-pam-services)))
227 (setuid-programs operating-system-setuid-programs
228 (default %setuid-programs)) ; list of string-valued gexps
230 (sudoers-file operating-system-sudoers-file ; file-like
231 (default %sudoers-specification)))
233 (define (operating-system-kernel-arguments os root-device)
234 "Return all the kernel arguments, including the ones not specified
235 directly by the user."
236 (append (bootable-kernel-arguments os root-device)
237 (operating-system-user-kernel-arguments os)))
244 (define-record-type* <boot-parameters>
245 boot-parameters make-boot-parameters boot-parameters?
246 (label boot-parameters-label)
247 ;; Because we will use the 'store-device' to create the GRUB search command,
248 ;; the 'store-device' has slightly different semantics than 'root-device'.
249 ;; The 'store-device' can be a file system uuid, a file system label, or #f,
250 ;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
251 ;; understand that. The 'root-device', on the other hand, corresponds
252 ;; exactly to the device field of the <file-system> object representing the
253 ;; OS's root file system, so it might be a device path like "/dev/sda3".
254 (root-device boot-parameters-root-device)
255 (bootloader-name boot-parameters-bootloader-name)
256 (bootloader-menu-entries ;list of <menu-entry>
257 boot-parameters-bootloader-menu-entries)
258 (store-device boot-parameters-store-device)
259 (store-mount-point boot-parameters-store-mount-point)
260 (kernel boot-parameters-kernel)
261 (kernel-arguments boot-parameters-kernel-arguments)
262 (initrd boot-parameters-initrd))
264 (define (ensure-not-/dev device)
265 "If DEVICE starts with a slash, return #f. This is meant to filter out
266 Linux device names such as /dev/sda, and to preserve GRUB device names and
268 (if (and (string? device) (string-prefix? "/" device))
272 (define (read-boot-parameters port)
273 "Read boot parameters from PORT and return the corresponding
274 <boot-parameters> object or #f if the format is unrecognized."
275 (define device-sexp->device
277 (('uuid (? symbol? type) (? bytevector? bv))
278 (bytevector->uuid bv type))
279 (('file-system-label (? string? label))
280 (file-system-label label))
281 ((? bytevector? bv) ;old format
282 (bytevector->uuid bv 'dce))
284 ;; It used to be that we would not distinguish between labels and
285 ;; device names. Try to infer the right thing here.
286 (if (string-prefix? "/dev/" device)
288 (file-system-label device)))))
291 (('boot-parameters ('version 0)
292 ('label label) ('root-device root)
297 (root-device (device-sexp->device root))
300 (match (assq 'bootloader-name rest)
302 (#f 'grub))) ; for compatibility reasons.
304 (bootloader-menu-entries
305 (match (assq 'bootloader-menu-entries rest)
306 ((_ entries) (map sexp->menu-entry entries))
309 ;; In the past, we would store the directory name of the kernel instead
310 ;; of the absolute file name of its image. Detect that and correct it.
311 (kernel (if (string=? linux (direct-store-path linux))
312 (string-append linux "/"
313 (system-linux-image-file-name))
317 (match (assq 'kernel-arguments rest)
319 (#f '()))) ;the old format
322 (match (assq 'initrd rest)
323 (('initrd ('string-append directory file)) ;the old format
324 (string-append directory file))
325 (('initrd (? string? file))
329 ;; Linux device names like "/dev/sda1" are not suitable GRUB device
330 ;; identifiers, so we just filter them out.
332 (match (assq 'store rest)
333 (('store ('device #f) _ ...)
335 (('store ('device device) _ ...)
336 (device-sexp->device device))
341 (match (assq 'store rest)
342 (('store ('device _) ('mount-point mount-point) _ ...)
346 (x ;unsupported format
347 (warning (G_ "unrecognized boot parameters at '~a'~%")
348 (port-filename port))
351 (define (read-boot-parameters-file system)
352 "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
353 file and returns the corresponding <boot-parameters> object or #f if the
354 format is unrecognized.
355 The object has its kernel-arguments extended in order to make it bootable."
356 (let* ((file (string-append system "/parameters"))
357 (params (call-with-input-file file read-boot-parameters))
358 (root (boot-parameters-root-device params)))
361 (kernel-arguments (append (bootable-kernel-arguments system root)
362 (boot-parameters-kernel-arguments params))))))
364 (define (boot-parameters->menu-entry conf)
366 (label (boot-parameters-label conf))
367 (device (boot-parameters-store-device conf))
368 (device-mount-point (boot-parameters-store-mount-point conf))
369 (linux (boot-parameters-kernel conf))
370 (linux-arguments (boot-parameters-kernel-arguments conf))
371 (initrd (boot-parameters-initrd conf))))
379 (define (non-boot-file-system-service os)
380 "Return the file system service for the file systems of OS that are not
381 marked as 'needed-for-boot'."
383 (remove file-system-needed-for-boot?
384 (operating-system-file-systems os)))
386 (define mapped-devices-for-boot
387 (operating-system-boot-mapped-devices os))
389 (define (device-mappings fs)
390 (let ((device (file-system-device fs)))
391 (if (string? device) ;title is 'device
393 (string=? (string-append "/dev/mapper/"
394 (mapped-device-target md))
396 (operating-system-mapped-devices os))
399 (define (add-dependencies fs)
400 ;; Add the dependencies due to device mappings to FS.
405 (remove (cut member <> mapped-devices-for-boot)
406 (append (device-mappings fs)
407 (file-system-dependencies fs)))
410 (service file-system-service-type
411 (map add-dependencies file-systems)))
413 (define (mapped-device-users device file-systems)
414 "Return the subset of FILE-SYSTEMS that use DEVICE."
415 (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
417 (or (member device (file-system-dependencies fs))
418 (and (string? (file-system-device fs))
419 (string=? (file-system-device fs) target))))
422 (define (operating-system-user-mapped-devices os)
423 "Return the subset of mapped devices that can be installed in
424 user-land--i.e., those not needed during boot."
425 (let ((devices (operating-system-mapped-devices os))
426 (file-systems (operating-system-file-systems os)))
428 (let ((users (mapped-device-users md file-systems)))
429 (not (any file-system-needed-for-boot? users))))
432 (define (operating-system-boot-mapped-devices os)
433 "Return the subset of mapped devices that must be installed during boot,
435 (let ((devices (operating-system-mapped-devices os))
436 (file-systems (operating-system-file-systems os)))
438 (let ((users (mapped-device-users md file-systems)))
439 (any file-system-needed-for-boot? users)))
442 (define (device-mapping-services os)
443 "Return the list of device-mapping services for OS as a list."
444 (map device-mapping-service
445 (operating-system-user-mapped-devices os)))
447 (define (swap-services os)
448 "Return the list of swap services for OS."
449 (map swap-service (operating-system-swap-devices os)))
451 (define* (system-linux-image-file-name)
452 "Return the basename of the kernel image file for SYSTEM."
453 ;; FIXME: Evaluate the conditional based on the actual current system.
454 (let ((target (or (%current-target-system) (%current-system))))
456 ((string-prefix? "arm" target) "zImage")
457 ((string-prefix? "mips" target) "vmlinuz")
458 ((string-prefix? "aarch64" target) "Image")
461 (define (operating-system-kernel-file os)
462 "Return an object representing the absolute file name of the kernel image of
464 (file-append (operating-system-kernel os)
465 "/" (system-linux-image-file-name)))
467 (define* (operating-system-directory-base-entries os)
468 "Return the basic entries of the 'system' directory of OS for use as the
469 value of the SYSTEM-SERVICE-TYPE service."
470 (let ((locale (operating-system-locale-directory os)))
471 (mlet %store-monad ((kernel -> (operating-system-kernel os))
472 (initrd -> (operating-system-initrd-file os))
473 (params (operating-system-boot-parameters-file os)))
474 (return `(("kernel" ,kernel)
475 ("parameters" ,params)
477 ("locale" ,locale)))))) ;used by libc
479 (define (operating-system-default-essential-services os)
480 "Return the list of essential services for OS. These are special services
481 that implement part of what's declared in OS are responsible for low-level
484 (map file-system-mount-point (operating-system-file-systems os)))
486 (let* ((mappings (device-mapping-services os))
487 (root-fs (root-file-system-service))
488 (other-fs (non-boot-file-system-service os))
489 (swaps (swap-services os))
490 (procs (service user-processes-service-type))
491 (host-name (host-name-service (operating-system-host-name os)))
492 (entries (operating-system-directory-base-entries os)))
493 (cons* (service system-service-type entries)
496 ;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that
497 ;; execs shepherd comes last in the boot script (XXX). Likewise,
498 ;; the cleanup service must come first so that its gexp runs before
500 (service cleanup-service-type #f)
502 %shepherd-root-service
504 (pam-root-service (operating-system-pam-services os))
505 (account-service (append (operating-system-accounts os)
506 (operating-system-groups os))
507 (operating-system-skeletons os))
508 (operating-system-etc-service os)
509 (service fstab-service-type
510 (filter file-system-needed-for-boot?
511 (operating-system-file-systems os)))
512 (session-environment-service
513 (operating-system-environment-variables os))
514 host-name procs root-fs
515 (service setuid-program-service-type
516 (operating-system-setuid-programs os))
517 (service profile-service-type
518 (operating-system-packages os))
520 (append mappings swaps
522 ;; Add the firmware service.
523 (list %linux-bare-metal-service
524 (service firmware-service-type
525 (operating-system-firmware os)))))))
527 (define* (operating-system-services os)
528 "Return all the services of OS, including \"essential\" services."
529 (instantiate-missing-services
530 (append (operating-system-user-services os)
531 (operating-system-essential-services os))))
533 (define (operating-system-with-gc-roots os roots)
534 "Return a variant of OS where ROOTS are registered as GC roots."
538 ;; We use this procedure for the installation OS, which already defines GC
539 ;; roots. Add ROOTS to those.
540 (services (cons (simple-service 'extra-root
541 gc-root-service-type roots)
542 (operating-system-user-services os)))))
544 (define* (operating-system-with-provenance os #:optional config-file)
545 "Return a variant of OS that stores its own provenance information,
546 including CONFIG-FILE, if available. This is achieved by adding an instance
547 of PROVENANCE-SERVICE-TYPE to its services."
550 (services (cons (service provenance-service-type config-file)
551 (operating-system-user-services os)))))
558 (define %base-firmware
559 ;; Firmware usable by default.
560 (list ath9k-htc-firmware
563 (define %base-packages
564 ;; Default set of packages globally visible. It should include anything
565 ;; required for basic administrator tasks.
566 (cons* procps psmisc which less zile nano
570 (@ (gnu packages admin) shadow) ;for 'passwd'
572 ;; wireless-tools is deprecated in favor of iw, but it's still what
573 ;; many people are familiar with, so keep it around.
577 net-tools ; XXX: remove when Inetutils suffices
579 info-reader ;the standalone Info reader (no Perl)
581 ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
582 ;; want the other commands and the man pages (notably because
583 ;; auto-completion in Emacs shell relies on man pages.)
586 ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
587 ;; already depends on it anyway.
594 ;; XXX: We don't use (canonical-package guile-2.2) here because that
595 ;; would create a collision in the global profile between the GMP
596 ;; variant propagated by 'guile-final' and the GMP variant propagated
597 ;; by 'gnutls', itself propagated by 'guix'.
599 guile-readline guile-colorized
601 ;; The packages below are also in %FINAL-INPUTS, so take them from
602 ;; there to avoid duplication.
603 (map canonical-package
604 (list bash coreutils findutils grep sed
605 diffutils patch gawk tar gzip bzip2 xz lzip))))
607 (define %default-issue
608 ;; Default contents for /etc/issue.
610 This is the GNU system. Welcome.\n")
612 (define (local-host-aliases host-name)
613 "Return aliases for HOST-NAME, to be used in /etc/hosts."
614 (string-append "127.0.0.1 localhost " host-name "\n"
615 "::1 localhost " host-name "\n"))
617 (define (default-/etc/hosts host-name)
618 "Return the default /etc/hosts file."
619 (plain-file "hosts" (local-host-aliases host-name)))
621 (define* (operating-system-etc-service os)
622 "Return a <service> that builds containing the static part of the /etc
625 (plain-file "login.defs"
627 "# Default paths for non-login shells started by su(1).\n"
628 "ENV_PATH /run/setuid-programs:"
629 "/run/current-system/profile/bin:"
630 "/run/current-system/profile/sbin\n"
631 "ENV_SUPATH /run/setuid-programs:"
632 "/run/current-system/profile/bin:"
633 "/run/current-system/profile/sbin\n")))
635 (issue (plain-file "issue" (operating-system-issue os)))
636 (nsswitch (plain-file "nsswitch.conf"
637 (name-service-switch->string
638 (operating-system-name-service-switch os))))
640 ;; Startup file for POSIX-compliant login shells, which set system-wide
641 ;; environment variables.
642 (profile (mixed-text-file "profile" "\
643 # Crucial variables that could be missing in the profiles' 'etc/profile'
644 # because they would require combining both profiles.
645 # FIXME: See <http://bugs.gnu.org/20255>.
646 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
647 export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
648 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
649 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
651 # Make sure libXcursor finds cursors installed into user or system profiles. See <http://bugs.gnu.org/24445>
652 export XCURSOR_PATH=$HOME/.icons:$HOME/.guix-profile/share/icons:/run/current-system/profile/share/icons
654 # Ignore the default value of 'PATH'.
657 # Load the system profile's settings.
658 GUIX_PROFILE=/run/current-system/profile ; \\
659 . /run/current-system/profile/etc/profile
661 # Since 'lshd' does not use pam_env, /etc/environment must be explicitly
662 # loaded when someone logs in via SSH. See <http://bugs.gnu.org/22175>.
663 # We need 'PATH' to be defined here, for 'cat' and 'cut'. Do this before
664 # reading the user's 'etc/profile' to allow variables to be overridden.
665 if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
666 -a -z \"$LINUX_MODULE_DIRECTORY\" ]
669 export `cat /etc/environment | cut -d= -f1`
672 # Arrange so that ~/.config/guix/current comes first.
673 for profile in \"$HOME/.guix-profile\" \"$HOME/.config/guix/current\"
675 if [ -f \"$profile/etc/profile\" ]
677 # Load the user profile's settings.
678 GUIX_PROFILE=\"$profile\" ; \\
679 . \"$profile/etc/profile\"
681 # At least define this one so that basic things just work
682 # when the user installs their first package.
683 export PATH=\"$profile/bin:$PATH\"
687 # Prepend setuid programs.
688 export PATH=/run/setuid-programs:$PATH
690 # Arrange so that ~/.config/guix/current/share/info comes first.
691 export INFOPATH=\"$HOME/.config/guix/current/share/info:$INFOPATH\"
693 # Set the umask, notably for users logging in via 'lsh'.
694 # See <http://bugs.gnu.org/22650>.
697 # Allow Hunspell-based applications (IceCat, LibreOffice, etc.) to
699 export DICPATH=\"$HOME/.guix-profile/share/hunspell:/run/current-system/profile/share/hunspell\"
701 # Allow GStreamer-based applications to find plugins.
702 export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
704 if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
706 # Load Bash-specific initialization code.
711 (bashrc (plain-file "bashrc" "\
712 # Bash-specific initialization.
714 # The 'bash-completion' package.
715 if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
717 # Bash-completion sources ~/.bash_completion. It installs a dynamic
718 # completion loader that searches its own completion files as well
719 # as those in ~/.guix-profile and /run/current-system/profile.
720 source /run/current-system/profile/etc/profile.d/bash_completion.sh
723 `(("services" ,(file-append net-base "/etc/services"))
724 ("protocols" ,(file-append net-base "/etc/protocols"))
725 ("rpc" ,(file-append net-base "/etc/rpc"))
726 ("login.defs" ,#~#$login.defs)
728 ("nsswitch.conf" ,#~#$nsswitch)
729 ("profile" ,#~#$profile)
730 ("bashrc" ,#~#$bashrc)
731 ("hosts" ,#~#$(or (operating-system-hosts-file os)
732 (default-/etc/hosts (operating-system-host-name os))))
733 ;; Write the operating-system-host-name to /etc/hostname to prevent
734 ;; NetworkManager from changing the system's hostname when connecting
735 ;; to certain networks. Some discussion at
736 ;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html
737 ("hostname" ,(plain-file "hostname" (operating-system-host-name os)))
738 ;; Some programs (e.g., GLib) look at /etc/timezone to find the
739 ;; name of the current timezone. For details, see
740 ;; https://lists.gnu.org/archive/html/guix-devel/2019-07/msg00166.html
741 ("timezone" ,(plain-file "timezone" (operating-system-timezone os)))
742 ("localtime" ,(file-append tzdata "/share/zoneinfo/"
743 (operating-system-timezone os)))
744 ("sudoers" ,(operating-system-sudoers-file os))))))
746 (define %root-account
747 ;; Default root account.
751 (uid 0) (group "root")
752 (comment "System administrator")
753 (home-directory "/root")))
755 (define (operating-system-accounts os)
756 "Return the user accounts for OS, including an obligatory 'root' account,
757 and excluding accounts requested by services."
758 ;; Make sure there's a root account.
759 (if (find (lambda (user)
760 (and=> (user-account-uid user) zero?))
761 (operating-system-users os))
762 (operating-system-users os)
763 (cons %root-account (operating-system-users os))))
765 (define (maybe-string->file file-name thing)
766 "If THING is a string, return a <plain-file> with THING as its content.
767 Otherwise just return THING.
769 This is for backward-compatibility of fields that used to be strings and are
770 now file-like objects.."
773 (warning (G_ "using a string for file '~a' is deprecated; \
774 use 'plain-file' instead~%")
776 (plain-file file-name thing))
780 (define (maybe-file->monadic file-name thing)
781 "If THING is a value in %STORE-MONAD, return it as is; otherwise return
782 THING in the %STORE-MONAD.
784 This is for backward-compatibility of fields that used to be monadic values
785 and are now file-like objects."
786 (with-monad %store-monad
789 (warning (G_ "using a monadic value for '~a' is deprecated; \
790 use 'plain-file' instead~%")
796 (define (operating-system-etc-directory os)
797 "Return that static part of the /etc directory of OS."
799 (fold-services (operating-system-services os)
800 #:target-type etc-service-type)))
802 (define (operating-system-environment-variables os)
803 "Return the environment variables of OS for
804 @var{session-environment-service-type}, to be used in @file{/etc/environment}."
805 `(("LANG" . ,(operating-system-locale os))
806 ;; Note: No need to set 'TZ' since (1) we provide /etc/localtime, and (2)
807 ;; it doesn't work for setuid binaries. See <https://bugs.gnu.org/29212>.
808 ("TZDIR" . ,(file-append tzdata "/share/zoneinfo"))
809 ;; Tell 'modprobe' & co. where to look for modules.
810 ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
811 ;; These variables are honored by OpenSSL (libssl) and Git.
812 ("SSL_CERT_DIR" . "/etc/ssl/certs")
813 ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
814 ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
816 ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are
818 ("GTK_DATA_PREFIX" . "/run/current-system/profile")
820 ;; By default, applications that use D-Bus, such as Emacs, abort at startup
821 ;; when /etc/machine-id is missing. Make sure these warnings are non-fatal.
822 ("DBUS_FATAL_WARNINGS" . "0")
824 ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package
825 ;; used to look things up in 'PREFIX/lib/locale' instead of
826 ;; '/run/current-system/locale' as was intended. Keep this hack around so
827 ;; that people who still have glibc@2.23-using packages in their profiles
828 ;; can use them correctly.
829 ;; TODO: Remove when glibc@2.23 is long gone.
830 ("GUIX_LOCPATH" . "/run/current-system/locale")))
832 (define %setuid-programs
833 ;; Default set of setuid-root programs.
834 (let ((shadow (@ (gnu packages admin) shadow)))
835 (list (file-append shadow "/bin/passwd")
836 (file-append shadow "/bin/su")
837 (file-append shadow "/bin/newuidmap")
838 (file-append shadow "/bin/newgidmap")
839 (file-append inetutils "/bin/ping")
840 (file-append inetutils "/bin/ping6")
841 (file-append sudo "/bin/sudo")
842 (file-append sudo "/bin/sudoedit")
843 (file-append fuse "/bin/fusermount")
845 ;; To allow mounts with the "user" option, "mount" and "umount" must
847 (file-append util-linux "/bin/mount")
848 (file-append util-linux "/bin/umount"))))
850 (define %sudoers-specification
851 ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
852 ;; group can do anything. See
853 ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
854 ;; TODO: Add a declarative API.
855 (plain-file "sudoers" "\
857 %wheel ALL=(ALL) ALL\n"))
859 (define* (operating-system-activation-script os)
860 "Return the activation script for OS---i.e., the code that \"activates\" the
861 stateful part of OS, including user accounts and groups, special directories,
863 (let* ((services (operating-system-services os))
864 (activation (fold-services services
865 #:target-type activation-service-type)))
866 (activation-service->script activation)))
868 (define* (operating-system-boot-script os)
869 "Return the boot script for OS---i.e., the code started by the initrd once
870 we're running in the final root."
871 (let* ((services (operating-system-services os))
872 (boot (fold-services services #:target-type boot-service-type)))
873 (service-value boot)))
875 (define (operating-system-user-accounts os)
876 "Return the list of user accounts of OS."
877 (let* ((services (operating-system-services os))
878 (account (fold-services services
879 #:target-type account-service-type)))
880 (filter user-account?
881 (service-value account))))
883 (define (operating-system-shepherd-service-names os)
884 "Return the list of Shepherd service names for OS."
885 (append-map shepherd-service-provision
887 (fold-services (operating-system-services os)
889 shepherd-root-service-type))))
891 (define* (operating-system-derivation os)
892 "Return a derivation that builds OS."
893 (let* ((services (operating-system-services os))
894 (system (fold-services services)))
895 ;; SYSTEM contains the derivation as a monadic value.
896 (service-value system)))
898 (define* (operating-system-profile os)
899 "Return a derivation that builds the system profile of OS."
901 ((services -> (operating-system-services os))
902 (profile (fold-services services
903 #:target-type profile-service-type)))
908 (define (operating-system-root-file-system os)
909 "Return the root file system of OS."
911 (string=? "/" (file-system-mount-point fs)))
912 (operating-system-file-systems os)))
914 (define (operating-system-initrd-file os)
915 "Return a gexp denoting the initrd file of OS."
916 (define boot-file-systems
917 (filter file-system-needed-for-boot?
918 (operating-system-file-systems os)))
920 (define mapped-devices
921 (operating-system-boot-mapped-devices os))
924 (operating-system-initrd os))
926 (make-initrd boot-file-systems
927 #:linux (operating-system-kernel os)
929 (operating-system-initrd-modules os)
930 #:mapped-devices mapped-devices
931 #:keyboard-layout (operating-system-keyboard-layout os)))
933 (define (locale-name->definition* name)
934 "Variant of 'locale-name->definition' that raises an error upon failure."
935 (match (locale-name->definition name)
939 (message (format #f (G_ "~a: invalid locale name") name))))))
942 (define (operating-system-locale-directory os)
943 "Return the directory containing the locales compiled for the definitions
944 listed in OS. The C library expects to find it under
945 /run/current-system/locale."
947 (operating-system-locale os))
950 ;; While we're at it, check whether NAME is defined and add it if needed.
951 (if (member name (map locale-definition-name
952 (operating-system-locale-definitions os)))
953 (operating-system-locale-definitions os)
954 (cons (locale-name->definition* name)
955 (operating-system-locale-definitions os))))
957 (locale-directory definitions
958 #:libcs (operating-system-locale-libcs os)))
960 (define (kernel->boot-label kernel)
961 "Return a label for the bootloader menu entry that boots KERNEL."
962 (cond ((package? kernel)
963 (string-append "GNU with "
964 (string-titlecase (package-name kernel)) " "
965 (package-version kernel)))
966 ((inferior-package? kernel)
967 (string-append "GNU with "
968 (string-titlecase (inferior-package-name kernel)) " "
969 (inferior-package-version kernel)))
972 (define (operating-system-default-label os)
973 "Return the default label for OS, as it will appear in the bootloader menu
975 (kernel->boot-label (operating-system-kernel os)))
977 (define (store-file-system file-systems)
978 "Return the file system object among FILE-SYSTEMS that contains the store."
979 (match (filter (lambda (fs)
980 (and (file-system-mount? fs)
981 (not (memq 'bind-mount (file-system-flags fs)))
982 (string-prefix? (file-system-mount-point fs)
985 ((and candidates (head . tail))
986 (reduce (lambda (fs1 fs2)
987 (if (> (string-length (file-system-mount-point fs1))
988 (string-length (file-system-mount-point fs2)))
994 (define (operating-system-store-file-system os)
995 "Return the file system that contains the store of OS."
996 (store-file-system (operating-system-file-systems os)))
998 (define* (operating-system-bootcfg os #:optional (old-entries '()))
999 "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
1000 a list of <menu-entry>, to populate the \"old entries\" menu."
1001 (let* ((root-fs (operating-system-root-file-system os))
1002 (root-device (file-system-device root-fs))
1003 (params (operating-system-boot-parameters
1005 #:system-kernel-arguments? #t))
1006 (entry (boot-parameters->menu-entry params))
1007 (bootloader-conf (operating-system-bootloader os)))
1008 (define generate-config-file
1009 (bootloader-configuration-file-generator
1010 (bootloader-configuration-bootloader bootloader-conf)))
1012 (generate-config-file bootloader-conf (list entry)
1013 #:old-entries old-entries)))
1015 (define* (operating-system-boot-parameters os root-device
1016 #:key system-kernel-arguments?)
1017 "Return a monadic <boot-parameters> record that describes the boot
1018 parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
1019 such as '--root' and '--load' to <boot-parameters>."
1020 (let* ((initrd (operating-system-initrd-file os))
1021 (store (operating-system-store-file-system os))
1022 (bootloader (bootloader-configuration-bootloader
1023 (operating-system-bootloader os)))
1024 (bootloader-name (bootloader-name bootloader))
1025 (label (operating-system-label os)))
1028 (root-device root-device)
1029 (kernel (operating-system-kernel-file os))
1031 (if system-kernel-arguments?
1032 (operating-system-kernel-arguments os root-device)
1033 (operating-system-user-kernel-arguments os)))
1035 (bootloader-name bootloader-name)
1036 (bootloader-menu-entries
1037 (bootloader-configuration-menu-entries (operating-system-bootloader os)))
1038 (store-device (ensure-not-/dev (file-system-device store)))
1039 (store-mount-point (file-system-mount-point store)))))
1041 (define (device->sexp device)
1042 "Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
1045 `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
1046 ((? file-system-label? label)
1047 `(file-system-label ,(file-system-label->string label)))
1051 (define* (operating-system-boot-parameters-file os
1052 #:key system-kernel-arguments?)
1053 "Return a file that describes the boot parameters of OS. The primary use of
1054 this file is the reconstruction of GRUB menu entries for old configurations.
1056 When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root'
1057 and '--load' to the returned file (since the returned file is then usually
1058 stored into the content-addressed \"system\" directory, it's usually not a
1059 good idea to give it because the content hash would change by the content hash
1060 being stored into the \"parameters\" file)."
1061 (let* ((root (operating-system-root-file-system os))
1062 (device (file-system-device root))
1063 (params (operating-system-boot-parameters
1065 #:system-kernel-arguments?
1066 system-kernel-arguments?)))
1067 (gexp->file "parameters"
1070 (label #$(boot-parameters-label params))
1073 (boot-parameters-root-device params)))
1074 (kernel #$(boot-parameters-kernel params))
1076 #$(boot-parameters-kernel-arguments params))
1077 (initrd #$(boot-parameters-initrd params))
1078 (bootloader-name #$(boot-parameters-bootloader-name params))
1079 (bootloader-menu-entries
1080 #$(map menu-entry->sexp
1081 (or (and=> (operating-system-bootloader os)
1082 bootloader-configuration-menu-entries)
1086 #$(device->sexp (boot-parameters-store-device params)))
1087 (mount-point #$(boot-parameters-store-mount-point params))))
1088 #:set-load-path? #f)))
1090 (define-gexp-compiler (operating-system-compiler (os <operating-system>)
1094 ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
1095 ;; 'operating-system-derivation'.
1096 (run-with-store store (operating-system-derivation os)
1098 #:target target)))))
1100 ;;; system.scm ends here