gnu: Add nxbelld.
[guix.git] / gnu / system.scm
blobce2c05f4e109eff56d2dcf4a459dd065cdd9f203
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2013, 2014, 2015, 2016, 2017 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 ;;;
8 ;;; This file is part of GNU Guix.
9 ;;;
10 ;;; GNU Guix is free software; you can redistribute it and/or modify it
11 ;;; under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 3 of the License, or (at
13 ;;; your option) any later version.
14 ;;;
15 ;;; GNU Guix is distributed in the hope that it will be useful, but
16 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;;; GNU General Public License for more details.
19 ;;;
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
23 (define-module (gnu system)
24   #:use-module (guix store)
25   #:use-module (guix monads)
26   #:use-module (guix gexp)
27   #:use-module (guix records)
28   #:use-module (guix packages)
29   #:use-module (guix derivations)
30   #:use-module (guix profiles)
31   #:use-module (guix ui)
32   #:use-module (gnu packages base)
33   #:use-module (gnu packages bash)
34   #:use-module (gnu packages guile)
35   #:use-module (gnu packages admin)
36   #:use-module (gnu packages linux)
37   #:use-module (gnu packages pciutils)
38   #:use-module (gnu packages package-management)
39   #:use-module (gnu packages less)
40   #:use-module (gnu packages zile)
41   #:use-module (gnu packages nano)
42   #:use-module (gnu packages lsof)
43   #:use-module (gnu packages gawk)
44   #:use-module (gnu packages man)
45   #:use-module (gnu packages texinfo)
46   #:use-module (gnu packages compression)
47   #:use-module (gnu packages firmware)
48   #:use-module (gnu services)
49   #:use-module (gnu services shepherd)
50   #:use-module (gnu services base)
51   #:use-module (gnu bootloader)
52   #:use-module (gnu system shadow)
53   #:use-module (gnu system nss)
54   #:use-module (gnu system locale)
55   #:use-module (gnu system pam)
56   #:use-module (gnu system linux-initrd)
57   #:use-module (gnu system uuid)
58   #:use-module (gnu system file-systems)
59   #:use-module (gnu system mapped-devices)
60   #:use-module (ice-9 match)
61   #:use-module (srfi srfi-1)
62   #:use-module (srfi srfi-26)
63   #:use-module (srfi srfi-34)
64   #:use-module (srfi srfi-35)
65   #:use-module (rnrs bytevectors)
66   #:export (operating-system
67             operating-system?
69             operating-system-bootloader
70             operating-system-services
71             operating-system-user-services
72             operating-system-packages
73             operating-system-host-name
74             operating-system-hosts-file
75             operating-system-kernel
76             operating-system-kernel-file
77             operating-system-kernel-arguments
78             operating-system-initrd
79             operating-system-users
80             operating-system-groups
81             operating-system-issue
82             operating-system-timezone
83             operating-system-locale
84             operating-system-locale-definitions
85             operating-system-locale-libcs
86             operating-system-mapped-devices
87             operating-system-file-systems
88             operating-system-store-file-system
89             operating-system-user-mapped-devices
90             operating-system-boot-mapped-devices
91             operating-system-activation-script
92             operating-system-user-accounts
93             operating-system-shepherd-service-names
95             operating-system-derivation
96             operating-system-profile
97             operating-system-bootcfg
98             operating-system-etc-directory
99             operating-system-locale-directory
100             operating-system-boot-script
102             system-linux-image-file-name
104             boot-parameters
105             boot-parameters?
106             boot-parameters-label
107             boot-parameters-root-device
108             boot-parameters-bootloader-name
109             boot-parameters-store-device
110             boot-parameters-store-mount-point
111             boot-parameters-kernel
112             boot-parameters-kernel-arguments
113             boot-parameters-initrd
114             read-boot-parameters
115             read-boot-parameters-file
116             boot-parameters->menu-entry
118             local-host-aliases
119             %setuid-programs
120             %base-packages
121             %base-firmware))
123 ;;; Commentary:
125 ;;; This module supports whole-system configuration.
127 ;;; Code:
129 (define (bootable-kernel-arguments kernel-arguments system.drv root-device)
130   "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
131 booted from ROOT-DEVICE"
132   (cons* (string-append "--root="
133                         (if (uuid? root-device)
135                             ;; Note: Always use the DCE format because that's
136                             ;; what (gnu build linux-boot) expects for the
137                             ;; '--root' kernel command-line option.
138                             (uuid->string (uuid-bytevector root-device) 'dce)
139                             root-device))
140          #~(string-append "--system=" #$system.drv)
141          #~(string-append "--load=" #$system.drv "/boot")
142          kernel-arguments))
144 ;; System-wide configuration.
145 ;; TODO: Add per-field docstrings/stexi.
146 (define-record-type* <operating-system> operating-system
147   make-operating-system
148   operating-system?
149   (kernel operating-system-kernel                 ; package
150           (default linux-libre))
151   (kernel-arguments operating-system-user-kernel-arguments
152                     (default '()))                ; list of gexps/strings
153   (bootloader operating-system-bootloader)        ; <bootloader-configuration>
155   (initrd operating-system-initrd                 ; (list fs) -> M derivation
156           (default base-initrd))
157   (firmware operating-system-firmware             ; list of packages
158             (default %base-firmware))
160   (host-name operating-system-host-name)          ; string
161   (hosts-file operating-system-hosts-file         ; file-like | #f
162               (default #f))
164   (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
165                   (default '()))
166   (file-systems operating-system-file-systems)    ; list of fs
167   (swap-devices operating-system-swap-devices     ; list of strings
168                 (default '()))
170   (users operating-system-users                   ; list of user accounts
171          (default %base-user-accounts))
172   (groups operating-system-groups                 ; list of user groups
173           (default %base-groups))
175   (skeletons operating-system-skeletons           ; list of name/monadic value
176              (default (default-skeletons)))
177   (issue operating-system-issue                   ; string
178          (default %default-issue))
180   (packages operating-system-packages             ; list of (PACKAGE OUTPUT...)
181             (default %base-packages))             ; or just PACKAGE
183   (timezone operating-system-timezone)            ; string
184   (locale   operating-system-locale               ; string
185             (default "en_US.utf8"))
186   (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
187                       (default %default-locale-definitions))
188   (locale-libcs operating-system-locale-libcs     ; list of <packages>
189                 (default %default-locale-libcs))
190   (name-service-switch operating-system-name-service-switch ; <name-service-switch>
191                        (default %default-nss))
193   (services operating-system-user-services        ; list of monadic services
194             (default %base-services))
196   (pam-services operating-system-pam-services     ; list of PAM services
197                 (default (base-pam-services)))
198   (setuid-programs operating-system-setuid-programs
199                    (default %setuid-programs))    ; list of string-valued gexps
201   (sudoers-file operating-system-sudoers-file     ; file-like
202                 (default %sudoers-specification)))
204 (define (operating-system-kernel-arguments os system.drv root-device)
205   "Return all the kernel arguments, including the ones not specified
206 directly by the user."
207   (bootable-kernel-arguments (operating-system-user-kernel-arguments os)
208                              system.drv
209                              root-device))
213 ;;; Boot parameters
216 (define-record-type* <boot-parameters>
217   boot-parameters make-boot-parameters boot-parameters?
218   (label            boot-parameters-label)
219   ;; Because we will use the 'store-device' to create the GRUB search command,
220   ;; the 'store-device' has slightly different semantics than 'root-device'.
221   ;; The 'store-device' can be a file system uuid, a file system label, or #f,
222   ;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
223   ;; understand that.  The 'root-device', on the other hand, corresponds
224   ;; exactly to the device field of the <file-system> object representing the
225   ;; OS's root file system, so it might be a device path like "/dev/sda3".
226   (root-device      boot-parameters-root-device)
227   (bootloader-name  boot-parameters-bootloader-name)
228   (store-device     boot-parameters-store-device)
229   (store-mount-point boot-parameters-store-mount-point)
230   (kernel           boot-parameters-kernel)
231   (kernel-arguments boot-parameters-kernel-arguments)
232   (initrd           boot-parameters-initrd))
234 (define (ensure-not-/dev device)
235   "If DEVICE starts with a slash, return #f.  This is meant to filter out
236 Linux device names such as /dev/sda, and to preserve GRUB device names and
237 file system labels."
238   (if (and (string? device) (string-prefix? "/" device))
239       #f
240       device))
242 (define (read-boot-parameters port)
243   "Read boot parameters from PORT and return the corresponding
244 <boot-parameters> object or #f if the format is unrecognized."
245   (define device-sexp->device
246     (match-lambda
247       (('uuid (? symbol? type) (? bytevector? bv))
248        (bytevector->uuid bv type))
249       ((? bytevector? bv)                         ;old format
250        (bytevector->uuid bv 'dce))
251       ((? string? device)
252        device)))
254   (match (read port)
255     (('boot-parameters ('version 0)
256                        ('label label) ('root-device root)
257                        ('kernel linux)
258                        rest ...)
259      (boot-parameters
260       (label label)
261       (root-device (device-sexp->device root))
263       (bootloader-name
264        (match (assq 'bootloader-name rest)
265          ((_ args) args)
266          (#f       'grub))) ; for compatibility reasons.
268       ;; In the past, we would store the directory name of the kernel instead
269       ;; of the absolute file name of its image.  Detect that and correct it.
270       (kernel (if (string=? linux (direct-store-path linux))
271                   (string-append linux "/"
272                                  (system-linux-image-file-name))
273                   linux))
275       (kernel-arguments
276        (match (assq 'kernel-arguments rest)
277          ((_ args) args)
278          (#f       '())))                         ;the old format
280       (initrd
281        (match (assq 'initrd rest)
282          (('initrd ('string-append directory file)) ;the old format
283           (string-append directory file))
284          (('initrd (? string? file))
285           file)))
287       (store-device
288        ;; Linux device names like "/dev/sda1" are not suitable GRUB device
289        ;; identifiers, so we just filter them out.
290        (ensure-not-/dev
291         (match (assq 'store rest)
292           (('store ('device #f) _ ...)
293            root-device)
294           (('store ('device device) _ ...)
295            (device-sexp->device device))
296           (_                                      ;the old format
297            root-device))))
299       (store-mount-point
300        (match (assq 'store rest)
301          (('store ('device _) ('mount-point mount-point) _ ...)
302           mount-point)
303          (_                                       ;the old format
304           "/")))))
305     (x                                            ;unsupported format
306      (warning (G_ "unrecognized boot parameters for '~a'~%")
307               system)
308      #f)))
310 (define (read-boot-parameters-file system)
311   "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
312 file and returns the corresponding <boot-parameters> object or #f if the
313 format is unrecognized.
314 The object has its kernel-arguments extended in order to make it bootable."
315   (let* ((file (string-append system "/parameters"))
316          (params (call-with-input-file file read-boot-parameters))
317          (root (boot-parameters-root-device params))
318          (kernel-arguments (boot-parameters-kernel-arguments params)))
319     (if params
320       (boot-parameters
321         (inherit params)
322         (kernel-arguments (bootable-kernel-arguments kernel-arguments
323                                                      system root)))
324       #f)))
326 (define (boot-parameters->menu-entry conf)
327   (menu-entry
328    (label (boot-parameters-label conf))
329    (device (boot-parameters-store-device conf))
330    (device-mount-point (boot-parameters-store-mount-point conf))
331    (linux (boot-parameters-kernel conf))
332    (linux-arguments (boot-parameters-kernel-arguments conf))
333    (initrd (boot-parameters-initrd conf))))
338 ;;; Services.
341 (define (non-boot-file-system-service os)
342   "Return the file system service for the file systems of OS that are not
343 marked as 'needed-for-boot'."
344   (define file-systems
345     (remove file-system-needed-for-boot?
346             (operating-system-file-systems os)))
348   (define (device-mappings fs)
349     (let ((device (file-system-device fs)))
350       (if (string? device)                        ;title is 'device
351           (filter (lambda (md)
352                     (string=? (string-append "/dev/mapper/"
353                                              (mapped-device-target md))
354                               device))
355                   (operating-system-mapped-devices os))
356           '())))
358   (define (add-dependencies fs)
359     ;; Add the dependencies due to device mappings to FS.
360     (file-system
361       (inherit fs)
362       (dependencies
363        (delete-duplicates (append (device-mappings fs)
364                                   (file-system-dependencies fs))
365                           eq?))))
367   (service file-system-service-type
368            (map add-dependencies file-systems)))
370 (define (mapped-device-user device file-systems)
371   "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
372   (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
373     (find (lambda (fs)
374             (or (member device (file-system-dependencies fs))
375                 (and (eq? 'device (file-system-title fs))
376                      (string=? (file-system-device fs) target))))
377           file-systems)))
379 (define (operating-system-user-mapped-devices os)
380   "Return the subset of mapped devices that can be installed in
381 user-land--i.e., those not needed during boot."
382   (let ((devices      (operating-system-mapped-devices os))
383         (file-systems (operating-system-file-systems os)))
384    (filter (lambda (md)
385              (let ((user (mapped-device-user md file-systems)))
386                (or (not user)
387                    (not (file-system-needed-for-boot? user)))))
388            devices)))
390 (define (operating-system-boot-mapped-devices os)
391   "Return the subset of mapped devices that must be installed during boot,
392 from the initrd."
393   (let ((devices      (operating-system-mapped-devices os))
394         (file-systems (operating-system-file-systems os)))
395    (filter (lambda (md)
396              (let ((user (mapped-device-user md file-systems)))
397                (and user (file-system-needed-for-boot? user))))
398            devices)))
400 (define (device-mapping-services os)
401   "Return the list of device-mapping services for OS as a list."
402   (map device-mapping-service
403        (operating-system-user-mapped-devices os)))
405 (define (swap-services os)
406   "Return the list of swap services for OS."
407   (map swap-service (operating-system-swap-devices os)))
409 (define* (system-linux-image-file-name #:optional (system (%current-system)))
410   "Return the basename of the kernel image file for SYSTEM."
411   ;; FIXME: Evaluate the conditional based on the actual current system.
412   (cond
413    ((string-prefix? "arm" (%current-system)) "zImage")
414    ((string-prefix? "mips" (%current-system)) "vmlinuz")
415    ((string-prefix? "aarch64" (%current-system)) "Image")
416    (else "bzImage")))
418 (define (operating-system-kernel-file os)
419   "Return an object representing the absolute file name of the kernel image of
420 OS."
421   (file-append (operating-system-kernel os)
422                "/" (system-linux-image-file-name os)))
424 (define* (operating-system-directory-base-entries os #:key container?)
425   "Return the basic entries of the 'system' directory of OS for use as the
426 value of the SYSTEM-SERVICE-TYPE service."
427   (let ((locale (operating-system-locale-directory os)))
428     (with-monad %store-monad
429       (if container?
430           (return `(("locale" ,locale)))
431           (mlet %store-monad
432               ((kernel  ->  (operating-system-kernel os))
433                (initrd      (operating-system-initrd-file os))
434                (params      (operating-system-boot-parameters-file os)))
435             (return `(("kernel" ,kernel)
436                       ("parameters" ,params)
437                       ("initrd" ,initrd)
438                       ("locale" ,locale))))))))   ;used by libc
440 (define* (essential-services os #:key container?)
441   "Return the list of essential services for OS.  These are special services
442 that implement part of what's declared in OS are responsible for low-level
443 bookkeeping.  CONTAINER? determines whether to return the list of services for
444 a container or that of a \"bare metal\" system."
445   (define known-fs
446     (map file-system-mount-point (operating-system-file-systems os)))
448   (let* ((mappings  (device-mapping-services os))
449          (root-fs   (root-file-system-service))
450          (other-fs  (non-boot-file-system-service os))
451          (unmount   (user-unmount-service known-fs))
452          (swaps     (swap-services os))
453          (procs     (user-processes-service))
454          (host-name (host-name-service (operating-system-host-name os)))
455          (entries   (operating-system-directory-base-entries
456                      os #:container? container?)))
457     (cons* (service system-service-type entries)
458            %boot-service
460            ;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
461            ;; execs shepherd comes last in the boot script (XXX).  Likewise,
462            ;; the cleanup service must come last so that its gexp runs before
463            ;; activation code.
464            %shepherd-root-service
465            %activation-service
466            (service cleanup-service-type #f)
468            (pam-root-service (operating-system-pam-services os))
469            (account-service (append (operating-system-accounts os)
470                                     (operating-system-groups os))
471                             (operating-system-skeletons os))
472            (operating-system-etc-service os)
473            (service fstab-service-type '())
474            (session-environment-service
475             (operating-system-environment-variables os))
476            host-name procs root-fs unmount
477            (service setuid-program-service-type
478                     (operating-system-setuid-programs os))
479            (service profile-service-type
480                     (operating-system-packages os))
481            other-fs
482            (append mappings swaps
484                    ;; Add the firmware service, unless we are building for a
485                    ;; container.
486                    (if container?
487                        '()
488                        (list %linux-bare-metal-service
489                              (service firmware-service-type
490                                       (operating-system-firmware os))))))))
492 (define* (operating-system-services os #:key container?)
493   "Return all the services of OS, including \"internal\" services that do not
494 explicitly appear in OS."
495   (append (operating-system-user-services os)
496           (essential-services os #:container? container?)))
500 ;;; /etc.
503 (define %base-firmware
504   ;; Firmware usable by default.
505   (list ath9k-htc-firmware
506         openfwwf-firmware))
508 (define %base-packages
509   ;; Default set of packages globally visible.  It should include anything
510   ;; required for basic administrator tasks.
511   (cons* procps psmisc which less zile nano
512          lsof                                 ;for Guix's 'list-runtime-roots'
513          pciutils usbutils
514          util-linux inetutils isc-dhcp
515          (@ (gnu packages admin) shadow)          ;for 'passwd'
517          ;; wireless-tools is deprecated in favor of iw, but it's still what
518          ;; many people are familiar with, so keep it around.
519          iw wireless-tools rfkill
521          iproute
522          net-tools                        ; XXX: remove when Inetutils suffices
523          man-db
524          info-reader                     ;the standalone Info reader (no Perl)
526          ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
527          ;; want the other commands and the man pages (notably because
528          ;; auto-completion in Emacs shell relies on man pages.)
529          sudo
531          ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
532          ;; already depends on it anyway.
533          kmod eudev
535          e2fsprogs kbd
537          bash-completion
539          ;; XXX: We don't use (canonical-package guile-2.2) here because that
540          ;; would create a collision in the global profile between the GMP
541          ;; variant propagated by 'guile-final' and the GMP variant propagated
542          ;; by 'gnutls', itself propagated by 'guix'.
543          guile-2.2
545          ;; The packages below are also in %FINAL-INPUTS, so take them from
546          ;; there to avoid duplication.
547          (map canonical-package
548               (list bash coreutils findutils grep sed
549                     diffutils patch gawk tar gzip bzip2 xz lzip))))
551 (define %default-issue
552   ;; Default contents for /etc/issue.
553   "
554 This is the GNU system.  Welcome.\n")
556 (define (local-host-aliases host-name)
557   "Return aliases for HOST-NAME, to be used in /etc/hosts."
558   (string-append "127.0.0.1 localhost " host-name "\n"
559                  "::1       localhost " host-name "\n"))
561 (define (default-/etc/hosts host-name)
562   "Return the default /etc/hosts file."
563   (plain-file "hosts" (local-host-aliases host-name)))
565 (define* (operating-system-etc-service os)
566   "Return a <service> that builds containing the static part of the /etc
567 directory."
568   (let ((login.defs (plain-file "login.defs" "# Empty for now.\n"))
570         (issue      (plain-file "issue" (operating-system-issue os)))
571         (nsswitch   (plain-file "nsswitch.conf"
572                                 (name-service-switch->string
573                                  (operating-system-name-service-switch os))))
575         ;; Startup file for POSIX-compliant login shells, which set system-wide
576         ;; environment variables.
577         (profile    (mixed-text-file "profile"  "\
578 # Crucial variables that could be missing in the profiles' 'etc/profile'
579 # because they would require combining both profiles.
580 # FIXME: See <http://bugs.gnu.org/20255>.
581 export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
582 export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
583 export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
584 export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
586 # Make sure libXcursor finds cursors installed into user or system profiles.  See <http://bugs.gnu.org/24445>
587 export XCURSOR_PATH=$HOME/.icons:$HOME/.guix-profile/share/icons:/run/current-system/profile/share/icons
589 # Ignore the default value of 'PATH'.
590 unset PATH
592 # Load the system profile's settings.
593 GUIX_PROFILE=/run/current-system/profile \\
594 . /run/current-system/profile/etc/profile
596 # Prepend setuid programs.
597 export PATH=/run/setuid-programs:$PATH
599 # Since 'lshd' does not use pam_env, /etc/environment must be explicitly
600 # loaded when someone logs in via SSH.  See <http://bugs.gnu.org/22175>.
601 # We need 'PATH' to be defined here, for 'cat' and 'cut'.  Do this before
602 # reading the user's 'etc/profile' to allow variables to be overridden.
603 if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
604      -a -z \"$LINUX_MODULE_DIRECTORY\" ]
605 then
606   . /etc/environment
607   export `cat /etc/environment | cut -d= -f1`
610 if [ -f \"$HOME/.guix-profile/etc/profile\" ]
611 then
612   # Load the user profile's settings.
613   GUIX_PROFILE=\"$HOME/.guix-profile\" \\
614   . \"$HOME/.guix-profile/etc/profile\"
615 else
616   # At least define this one so that basic things just work
617   # when the user installs their first package.
618   export PATH=\"$HOME/.guix-profile/bin:$PATH\"
621 # Set the umask, notably for users logging in via 'lsh'.
622 # See <http://bugs.gnu.org/22650>.
623 umask 022
625 # Allow Hunspell-based applications (IceCat, LibreOffice, etc.) to
626 # find dictionaries.
627 export DICPATH=\"$HOME/.guix-profile/share/hunspell:/run/current-system/profile/share/hunspell\"
629 # Allow GStreamer-based applications to find plugins.
630 export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
632 if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
633 then
634   # Load Bash-specific initialization code.
635   . /etc/bashrc
639         (bashrc    (plain-file "bashrc" "\
640 # Bash-specific initialization.
642 # The 'bash-completion' package.
643 if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
644 then
645   # Bash-completion sources ~/.bash_completion.  It installs a dynamic
646   # completion loader that searches its own completion files as well
647   # as those in ~/.guix-profile and /run/current-system/profile.
648   source /run/current-system/profile/etc/profile.d/bash_completion.sh
649 fi\n")))
650     (etc-service
651      `(("services" ,(file-append net-base "/etc/services"))
652        ("protocols" ,(file-append net-base "/etc/protocols"))
653        ("rpc" ,(file-append net-base "/etc/rpc"))
654        ("login.defs" ,#~#$login.defs)
655        ("issue" ,#~#$issue)
656        ("nsswitch.conf" ,#~#$nsswitch)
657        ("profile" ,#~#$profile)
658        ("bashrc" ,#~#$bashrc)
659        ("hosts" ,#~#$(or (operating-system-hosts-file os)
660                          (default-/etc/hosts (operating-system-host-name os))))
661        ;; Write the operating-system-host-name to /etc/hostname to prevent
662        ;; NetworkManager from changing the system's hostname when connecting
663        ;; to certain networks.  Some discussion at
664        ;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html
665        ("hostname" ,(plain-file "hostname" (operating-system-host-name os)))
666        ("localtime" ,(file-append tzdata "/share/zoneinfo/"
667                                   (operating-system-timezone os)))
668        ("sudoers" ,(operating-system-sudoers-file os))))))
670 (define %root-account
671   ;; Default root account.
672   (user-account
673    (name "root")
674    (password "")
675    (uid 0) (group "root")
676    (comment "System administrator")
677    (home-directory "/root")))
679 (define (operating-system-accounts os)
680   "Return the user accounts for OS, including an obligatory 'root' account,
681 and excluding accounts requested by services."
682   ;; Make sure there's a root account.
683   (if (find (lambda (user)
684               (and=> (user-account-uid user) zero?))
685             (operating-system-users os))
686       (operating-system-users os)
687       (cons %root-account (operating-system-users os))))
689 (define (maybe-string->file file-name thing)
690   "If THING is a string, return a <plain-file> with THING as its content.
691 Otherwise just return THING.
693 This is for backward-compatibility of fields that used to be strings and are
694 now file-like objects.."
695   (match thing
696     ((? string?)
697      (warning (G_ "using a string for file '~a' is deprecated; \
698 use 'plain-file' instead~%")
699               file-name)
700      (plain-file file-name thing))
701     (x
702      x)))
704 (define (maybe-file->monadic file-name thing)
705   "If THING is a value in %STORE-MONAD, return it as is; otherwise return
706 THING in the %STORE-MONAD.
708 This is for backward-compatibility of fields that used to be monadic values
709 and are now file-like objects."
710   (with-monad %store-monad
711     (match thing
712       ((? procedure?)
713        (warning (G_ "using a monadic value for '~a' is deprecated; \
714 use 'plain-file' instead~%")
715                 file-name)
716        thing)
717       (x
718        (return x)))))
720 (define (operating-system-etc-directory os)
721   "Return that static part of the /etc directory of OS."
722   (etc-directory
723    (fold-services (operating-system-services os)
724                   #:target-type etc-service-type)))
726 (define (operating-system-environment-variables os)
727   "Return the environment variables of OS for
728 @var{session-environment-service-type}, to be used in @file{/etc/environment}."
729   `(("LANG" . ,(operating-system-locale os))
730     ;; Note: No need to set 'TZ' since (1) we provide /etc/localtime, and (2)
731     ;; it doesn't work for setuid binaries.  See <https://bugs.gnu.org/29212>.
732     ("TZDIR" . ,(file-append tzdata "/share/zoneinfo"))
733     ;; Tell 'modprobe' & co. where to look for modules.
734     ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
735     ;; These variables are honored by OpenSSL (libssl) and Git.
736     ("SSL_CERT_DIR" . "/etc/ssl/certs")
737     ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
738     ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
740     ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are
741     ;; searched for.
742     ("GTK_DATA_PREFIX" . "/run/current-system/profile")
744     ;; By default, applications that use D-Bus, such as Emacs, abort at startup
745     ;; when /etc/machine-id is missing.  Make sure these warnings are non-fatal.
746     ("DBUS_FATAL_WARNINGS" . "0")
748     ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package
749     ;; used to look things up in 'PREFIX/lib/locale' instead of
750     ;; '/run/current-system/locale' as was intended.  Keep this hack around so
751     ;; that people who still have glibc@2.23-using packages in their profiles
752     ;; can use them correctly.
753     ;; TODO: Remove when glibc@2.23 is long gone.
754     ("GUIX_LOCPATH" . "/run/current-system/locale")))
756 (define %setuid-programs
757   ;; Default set of setuid-root programs.
758   (let ((shadow (@ (gnu packages admin) shadow)))
759     (list (file-append shadow "/bin/passwd")
760           (file-append shadow "/bin/su")
761           (file-append shadow "/bin/newuidmap")
762           (file-append shadow "/bin/newgidmap")
763           (file-append inetutils "/bin/ping")
764           (file-append inetutils "/bin/ping6")
765           (file-append sudo "/bin/sudo")
766           (file-append fuse "/bin/fusermount"))))
768 (define %sudoers-specification
769   ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
770   ;; group can do anything.  See
771   ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
772   ;; TODO: Add a declarative API.
773   (plain-file "sudoers" "\
774 root ALL=(ALL) ALL
775 %wheel ALL=(ALL) ALL\n"))
777 (define* (operating-system-activation-script os #:key container?)
778   "Return the activation script for OS---i.e., the code that \"activates\" the
779 stateful part of OS, including user accounts and groups, special directories,
780 etc."
781   (let* ((services   (operating-system-services os #:container? container?))
782          (activation (fold-services services
783                                     #:target-type activation-service-type)))
784     (activation-service->script activation)))
786 (define* (operating-system-boot-script os #:key container?)
787   "Return the boot script for OS---i.e., the code started by the initrd once
788 we're running in the final root.  When CONTAINER? is true, skip all
789 hardware-related operations as necessary when booting a Linux container."
790   (let* ((services (operating-system-services os #:container? container?))
791          (boot     (fold-services services #:target-type boot-service-type)))
792     ;; BOOT is the script as a monadic value.
793     (service-value boot)))
795 (define (operating-system-user-accounts os)
796   "Return the list of user accounts of OS."
797   (let* ((services (operating-system-services os))
798          (account  (fold-services services
799                                   #:target-type account-service-type)))
800     (filter user-account?
801             (service-value account))))
803 (define (operating-system-shepherd-service-names os)
804   "Return the list of Shepherd service names for OS."
805   (append-map shepherd-service-provision
806               (service-value
807                (fold-services (operating-system-services os)
808                               #:target-type
809                               shepherd-root-service-type))))
811 (define* (operating-system-derivation os #:key container?)
812   "Return a derivation that builds OS."
813   (let* ((services (operating-system-services os #:container? container?))
814          (system   (fold-services services)))
815     ;; SYSTEM contains the derivation as a monadic value.
816     (service-value system)))
818 (define* (operating-system-profile os #:key container?)
819   "Return a derivation that builds the system profile of OS."
820   (mlet* %store-monad
821       ((services -> (operating-system-services os #:container? container?))
822        (profile (fold-services services
823                                #:target-type profile-service-type)))
824     (match profile
825       (("profile" profile)
826        (return profile)))))
828 (define (operating-system-root-file-system os)
829   "Return the root file system of OS."
830   (find (match-lambda
831          (($ <file-system> device title "/") #t)
832          (x #f))
833         (operating-system-file-systems os)))
835 (define (operating-system-initrd-file os)
836   "Return a gexp denoting the initrd file of OS."
837   (define boot-file-systems
838     (filter file-system-needed-for-boot?
839             (operating-system-file-systems os)))
841   (define mapped-devices
842     (operating-system-boot-mapped-devices os))
844   (define make-initrd
845     (operating-system-initrd os))
847   (mlet %store-monad ((initrd (make-initrd boot-file-systems
848                                            #:linux (operating-system-kernel os)
849                                            #:mapped-devices mapped-devices)))
850     (return (file-append initrd "/initrd"))))
852 (define (locale-name->definition* name)
853   "Variant of 'locale-name->definition' that raises an error upon failure."
854   (match (locale-name->definition name)
855     (#f
856      (raise (condition
857              (&message
858               (message (format #f (G_ "~a: invalid locale name") name))))))
859     (def def)))
861 (define (operating-system-locale-directory os)
862   "Return the directory containing the locales compiled for the definitions
863 listed in OS.  The C library expects to find it under
864 /run/current-system/locale."
865   (define name
866     (operating-system-locale os))
868   (define definitions
869     ;; While we're at it, check whether NAME is defined and add it if needed.
870     (if (member name (map locale-definition-name
871                           (operating-system-locale-definitions os)))
872         (operating-system-locale-definitions os)
873         (cons (locale-name->definition* name)
874               (operating-system-locale-definitions os))))
876   (locale-directory definitions
877                     #:libcs (operating-system-locale-libcs os)))
879 (define (kernel->boot-label kernel)
880   "Return a label for the bootloader menu entry that boots KERNEL."
881   (string-append "GNU with "
882                  (string-titlecase (package-name kernel)) " "
883                  (package-version kernel)
884                  " (beta)"))
886 (define (store-file-system file-systems)
887   "Return the file system object among FILE-SYSTEMS that contains the store."
888   (match (filter (lambda (fs)
889                    (and (file-system-mount? fs)
890                         (not (memq 'bind-mount (file-system-flags fs)))
891                         (string-prefix? (file-system-mount-point fs)
892                                         (%store-prefix))))
893                  file-systems)
894     ((and candidates (head . tail))
895      (reduce (lambda (fs1 fs2)
896                (if (> (string-length (file-system-mount-point fs1))
897                       (string-length (file-system-mount-point fs2)))
898                    fs1
899                    fs2))
900              head
901              candidates))))
903 (define (operating-system-store-file-system os)
904   "Return the file system that contains the store of OS."
905   (store-file-system (operating-system-file-systems os)))
907 (define* (operating-system-bootcfg os #:optional (old-entries '()))
908   "Return the bootloader configuration file for OS.  Use OLD-ENTRIES
909 (which is a list of <menu-entry>) to populate the \"old entries\" menu."
910   (mlet* %store-monad
911       ((system      (operating-system-derivation os))
912        (root-fs ->  (operating-system-root-file-system os))
913        (root-device -> (file-system-device root-fs))
914        (params (operating-system-boot-parameters os system root-device))
915        (entry -> (boot-parameters->menu-entry params))
916        (bootloader-conf -> (operating-system-bootloader os)))
917     ((bootloader-configuration-file-generator
918       (bootloader-configuration-bootloader bootloader-conf))
919      bootloader-conf (list entry) #:old-entries old-entries)))
921 (define (fs->boot-device fs)
922   "Given FS, a <file-system> object, return a value suitable for use as the
923 device in a <menu-entry>."
924   (case (file-system-title fs)
925     ((uuid label device) (file-system-device fs))
926     (else #f)))
928 (define (operating-system-boot-parameters os system.drv root-device)
929   "Return a monadic <boot-parameters> record that describes the boot parameters
930 of OS.  SYSTEM.DRV is either a derivation or #f.  If it's a derivation, adds
931 kernel arguments for that derivation to <boot-parameters>."
932   (mlet* %store-monad
933       ((initrd (operating-system-initrd-file os))
934        (store -> (operating-system-store-file-system os))
935        (bootloader  -> (bootloader-configuration-bootloader
936                         (operating-system-bootloader os)))
937        (bootloader-name -> (bootloader-name bootloader))
938        (label -> (kernel->boot-label (operating-system-kernel os))))
939     (return (boot-parameters
940              (label label)
941              (root-device root-device)
942              (kernel (operating-system-kernel-file os))
943              (kernel-arguments
944               (if system.drv
945                 (operating-system-kernel-arguments os system.drv root-device)
946                 (operating-system-user-kernel-arguments os)))
947              (initrd initrd)
948              (bootloader-name bootloader-name)
949              (store-device (ensure-not-/dev (fs->boot-device store)))
950              (store-mount-point (file-system-mount-point store))))))
952 (define (device->sexp device)
953   "Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
954   (match device
955     ((? uuid? uuid)
956      `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
957     (_
958      device)))
960 (define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
961    "Return a file that describes the boot parameters of OS.  The primary use of
962 this file is the reconstruction of GRUB menu entries for old configurations.
963 SYSTEM.DRV is optional.  If given, adds kernel arguments for that system to the
964 returned file (since the returned file is then usually stored into the
965 content-addressed \"system\" directory, it's usually not a good idea
966 to give it because the content hash would change by the content hash
967 being stored into the \"parameters\" file)."
968   (mlet* %store-monad ((root -> (operating-system-root-file-system os))
969                        (device -> (file-system-device root))
970                        (params (operating-system-boot-parameters os
971                                                                  system.drv
972                                                                  device)))
973      (gexp->file "parameters"
974                  #~(boot-parameters
975                     (version 0)
976                     (label #$(boot-parameters-label params))
977                     (root-device
978                      #$(device->sexp
979                         (boot-parameters-root-device params)))
980                     (kernel #$(boot-parameters-kernel params))
981                     (kernel-arguments
982                      #$(boot-parameters-kernel-arguments params))
983                     (initrd #$(boot-parameters-initrd params))
984                     (bootloader-name #$(boot-parameters-bootloader-name params))
985                     (store
986                      (device
987                       #$(device->sexp (boot-parameters-store-device params)))
988                      (mount-point #$(boot-parameters-store-mount-point params))))
989                  #:set-load-path? #f)))
991 (define-gexp-compiler (operating-system-compiler (os <operating-system>)
992                                                  system target)
993   ((store-lift
994     (lambda (store)
995       ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
996       ;; 'operating-system-derivation'.
997       (run-with-store store (operating-system-derivation os)
998                       #:system system
999                       #:target target)))))
1001 ;;; system.scm ends here