gnu: linkchecker: Fix most test failures.
[jackhill/guix/guix.git] / gnu / system.scm
CommitLineData
033adfe7 1;;; GNU Guix --- Functional package management for GNU
d466b1fc 2;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
5e738ac2 3;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
5dccaffe 4;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
1ef8b72a 5;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
c76b3046 6;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
5144df2c 7;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
033adfe7
LC
8;;;
9;;; This file is part of GNU Guix.
10;;;
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.
15;;;
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.
20;;;
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/>.
23
24(define-module (gnu system)
bdc61ff9 25 #:use-module (guix inferior)
033adfe7
LC
26 #:use-module (guix store)
27 #:use-module (guix monads)
02100028 28 #:use-module (guix gexp)
033adfe7
LC
29 #:use-module (guix records)
30 #:use-module (guix packages)
31 #:use-module (guix derivations)
29fce8b6 32 #:use-module (guix profiles)
84765839 33 #:use-module (guix ui)
033adfe7
LC
34 #:use-module (gnu packages base)
35 #:use-module (gnu packages bash)
bdb36958 36 #:use-module (gnu packages guile)
9de46ffb 37 #:use-module (gnu packages admin)
8a07c289 38 #:use-module (gnu packages linux)
a96a82d7 39 #:use-module (gnu packages pciutils)
033adfe7 40 #:use-module (gnu packages package-management)
6f436c54
LC
41 #:use-module (gnu packages less)
42 #:use-module (gnu packages zile)
55e70e65 43 #:use-module (gnu packages nano)
a68c6967 44 #:use-module (gnu packages gawk)
18316d86 45 #:use-module (gnu packages man)
939c5c31 46 #:use-module (gnu packages texinfo)
a68c6967 47 #:use-module (gnu packages compression)
f34c56be 48 #:use-module (gnu packages firmware)
db4fdc04 49 #:use-module (gnu services)
0190c1c0 50 #:use-module (gnu services shepherd)
db4fdc04 51 #:use-module (gnu services base)
b09a8da4 52 #:use-module (gnu bootloader)
033adfe7 53 #:use-module (gnu system shadow)
996ed739 54 #:use-module (gnu system nss)
598e19dc 55 #:use-module (gnu system locale)
6e828634 56 #:use-module (gnu system pam)
735c6dd7 57 #:use-module (gnu system linux-initrd)
9b336338 58 #:use-module (gnu system uuid)
c5df1839 59 #:use-module (gnu system file-systems)
060d62a7 60 #:use-module (gnu system mapped-devices)
033adfe7
LC
61 #:use-module (ice-9 match)
62 #:use-module (srfi srfi-1)
63 #:use-module (srfi srfi-26)
598e19dc
LC
64 #:use-module (srfi srfi-34)
65 #:use-module (srfi srfi-35)
3382bfe9 66 #:use-module (rnrs bytevectors)
033adfe7
LC
67 #:export (operating-system
68 operating-system?
d5b429ab
LC
69
70 operating-system-bootloader
033adfe7 71 operating-system-services
217a5b85 72 operating-system-user-services
033adfe7 73 operating-system-packages
fd3bfc44 74 operating-system-host-name
c65e1834 75 operating-system-hosts-file
fd3bfc44 76 operating-system-kernel
44d5f54e 77 operating-system-kernel-file
33f0aa88 78 operating-system-kernel-arguments
bc499b11 79 operating-system-initrd-modules
fd3bfc44
LC
80 operating-system-initrd
81 operating-system-users
82 operating-system-groups
548d4c13 83 operating-system-issue
fd3bfc44
LC
84 operating-system-timezone
85 operating-system-locale
598e19dc 86 operating-system-locale-definitions
34760ae7 87 operating-system-locale-libcs
5dae0186 88 operating-system-mapped-devices
83bcd0b8 89 operating-system-file-systems
6b779207 90 operating-system-store-file-system
2bdd7ac1
LC
91 operating-system-user-mapped-devices
92 operating-system-boot-mapped-devices
b25937e3 93 operating-system-activation-script
b2fef041
LC
94 operating-system-user-accounts
95 operating-system-shepherd-service-names
20abb8c4 96 operating-system-user-kernel-arguments
033adfe7 97
1aa0033b 98 operating-system-derivation
83bcd0b8 99 operating-system-profile
c76b3046 100 operating-system-bootcfg
239db054
DT
101 operating-system-etc-directory
102 operating-system-locale-directory
103 operating-system-boot-script
104
43fe431c
DC
105 system-linux-image-file-name
106
b8300494
AK
107 boot-parameters
108 boot-parameters?
109 boot-parameters-label
110 boot-parameters-root-device
f96752e3 111 boot-parameters-bootloader-name
1ef8b72a
CM
112 boot-parameters-store-device
113 boot-parameters-store-mount-point
b8300494
AK
114 boot-parameters-kernel
115 boot-parameters-kernel-arguments
d7b342d8 116 boot-parameters-initrd
4e4e0185 117 read-boot-parameters
9530e73b 118 read-boot-parameters-file
1975c754 119 boot-parameters->menu-entry
b8300494 120
568841d4 121 local-host-aliases
d0f3a672 122 %root-account
df5ce088 123 %setuid-programs
5dae0186 124 %base-packages
374f14c2 125 %base-firmware))
033adfe7
LC
126
127;;; Commentary:
128;;;
129;;; This module supports whole-system configuration.
130;;;
131;;; Code:
132
a7ef45d9
LC
133(define (bootable-kernel-arguments system root-device)
134 "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE."
135 (list (string-append "--root="
136 (cond ((uuid? root-device)
137
138 ;; Note: Always use the DCE format because that's
139 ;; what (gnu build linux-boot) expects for the
140 ;; '--root' kernel command-line option.
141 (uuid->string (uuid-bytevector root-device)
142 'dce))
143 ((file-system-label? root-device)
144 (file-system-label->string root-device))
145 (else root-device)))
146 #~(string-append "--system=" #$system)
147 #~(string-append "--load=" #$system "/boot")))
33f0aa88 148
033adfe7
LC
149;; System-wide configuration.
150;; TODO: Add per-field docstrings/stexi.
151(define-record-type* <operating-system> operating-system
152 make-operating-system
153 operating-system?
154 (kernel operating-system-kernel ; package
57082417 155 (default linux-libre))
af98d25a 156 (kernel-arguments operating-system-user-kernel-arguments
ee2a6304 157 (default '())) ; list of gexps/strings
b09a8da4 158 (bootloader operating-system-bootloader) ; <bootloader-configuration>
d5b429ab 159
e34ae75d 160 (initrd operating-system-initrd ; (list fs) -> file-like
060238ae 161 (default base-initrd))
bc499b11
LC
162 (initrd-modules operating-system-initrd-modules ; list of strings
163 (thunked) ; it's system-dependent
164 (default %base-initrd-modules))
165
f34c56be
LC
166 (firmware operating-system-firmware ; list of packages
167 (default %base-firmware))
033adfe7
LC
168
169 (host-name operating-system-host-name) ; string
24e02c28 170 (hosts-file operating-system-hosts-file ; file-like | #f
c65e1834 171 (default #f))
033adfe7 172
5dae0186
LC
173 (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
174 (default '()))
8a6d2731 175 (file-systems operating-system-file-systems) ; list of fs
2a13d05e
LC
176 (swap-devices operating-system-swap-devices ; list of strings
177 (default '()))
033adfe7
LC
178
179 (users operating-system-users ; list of user accounts
bf87f38a 180 (default %base-user-accounts))
033adfe7 181 (groups operating-system-groups ; list of user groups
773e956d 182 (default %base-groups))
033adfe7 183
40281c54
LC
184 (skeletons operating-system-skeletons ; list of name/monadic value
185 (default (default-skeletons)))
548d4c13
LC
186 (issue operating-system-issue ; string
187 (default %default-issue))
40281c54 188
033adfe7 189 (packages operating-system-packages ; list of (PACKAGE OUTPUT...)
6f436c54 190 (default %base-packages)) ; or just PACKAGE
033adfe7
LC
191
192 (timezone operating-system-timezone) ; string
8a6d2731 193 (locale operating-system-locale ; string
598e19dc
LC
194 (default "en_US.utf8"))
195 (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
196 (default %default-locale-definitions))
34760ae7
LC
197 (locale-libcs operating-system-locale-libcs ; list of <packages>
198 (default %default-locale-libcs))
996ed739
LC
199 (name-service-switch operating-system-name-service-switch ; <name-service-switch>
200 (default %default-nss))
033adfe7 201
217a5b85 202 (services operating-system-user-services ; list of monadic services
09e028f4
LC
203 (default %base-services))
204
205 (pam-services operating-system-pam-services ; list of PAM services
206 (default (base-pam-services)))
207 (setuid-programs operating-system-setuid-programs
69689380 208 (default %setuid-programs)) ; list of string-valued gexps
033adfe7 209
f5a9ffa0
AK
210 (sudoers-file operating-system-sudoers-file ; file-like
211 (default %sudoers-specification)))
033adfe7 212
a7ef45d9 213(define (operating-system-kernel-arguments os root-device)
33f0aa88
DM
214 "Return all the kernel arguments, including the ones not specified
215directly by the user."
a7ef45d9
LC
216 (append (bootable-kernel-arguments os root-device)
217 (operating-system-user-kernel-arguments os)))
33f0aa88 218
2717a89a 219\f
8e815c5b
LC
220;;;
221;;; Boot parameters
222;;;
223
224(define-record-type* <boot-parameters>
225 boot-parameters make-boot-parameters boot-parameters?
226 (label boot-parameters-label)
227 ;; Because we will use the 'store-device' to create the GRUB search command,
228 ;; the 'store-device' has slightly different semantics than 'root-device'.
229 ;; The 'store-device' can be a file system uuid, a file system label, or #f,
230 ;; but it cannot be a device path such as "/dev/sda3", since GRUB would not
231 ;; understand that. The 'root-device', on the other hand, corresponds
232 ;; exactly to the device field of the <file-system> object representing the
233 ;; OS's root file system, so it might be a device path like "/dev/sda3".
234 (root-device boot-parameters-root-device)
f96752e3 235 (bootloader-name boot-parameters-bootloader-name)
8e815c5b
LC
236 (store-device boot-parameters-store-device)
237 (store-mount-point boot-parameters-store-mount-point)
238 (kernel boot-parameters-kernel)
239 (kernel-arguments boot-parameters-kernel-arguments)
240 (initrd boot-parameters-initrd))
241
90d23ed9
LC
242(define (ensure-not-/dev device)
243 "If DEVICE starts with a slash, return #f. This is meant to filter out
244Linux device names such as /dev/sda, and to preserve GRUB device names and
245file system labels."
246 (if (and (string? device) (string-prefix? "/" device))
247 #f
248 device))
249
8e815c5b
LC
250(define (read-boot-parameters port)
251 "Read boot parameters from PORT and return the corresponding
252<boot-parameters> object or #f if the format is unrecognized."
075681d3
LC
253 (define device-sexp->device
254 (match-lambda
255 (('uuid (? symbol? type) (? bytevector? bv))
256 (bytevector->uuid bv type))
a5acc17a
LC
257 (('file-system-label (? string? label))
258 (file-system-label label))
075681d3
LC
259 ((? bytevector? bv) ;old format
260 (bytevector->uuid bv 'dce))
261 ((? string? device)
a5acc17a
LC
262 ;; It used to be that we would not distinguish between labels and
263 ;; device names. Try to infer the right thing here.
264 (if (string-prefix? "/dev/" device)
265 device
266 (file-system-label device)))))
075681d3 267
8e815c5b
LC
268 (match (read port)
269 (('boot-parameters ('version 0)
270 ('label label) ('root-device root)
271 ('kernel linux)
272 rest ...)
273 (boot-parameters
274 (label label)
7940188e 275 (root-device (device-sexp->device root))
8e815c5b 276
f96752e3
MO
277 (bootloader-name
278 (match (assq 'bootloader-name rest)
bcaf67c4
MO
279 ((_ args) args)
280 (#f 'grub))) ; for compatibility reasons.
281
8e815c5b
LC
282 ;; In the past, we would store the directory name of the kernel instead
283 ;; of the absolute file name of its image. Detect that and correct it.
284 (kernel (if (string=? linux (direct-store-path linux))
285 (string-append linux "/"
286 (system-linux-image-file-name))
287 linux))
288
289 (kernel-arguments
290 (match (assq 'kernel-arguments rest)
291 ((_ args) args)
292 (#f '()))) ;the old format
293
294 (initrd
295 (match (assq 'initrd rest)
296 (('initrd ('string-append directory file)) ;the old format
297 (string-append directory file))
298 (('initrd (? string? file))
299 file)))
300
301 (store-device
db4e8fd5
LC
302 ;; Linux device names like "/dev/sda1" are not suitable GRUB device
303 ;; identifiers, so we just filter them out.
304 (ensure-not-/dev
305 (match (assq 'store rest)
306 (('store ('device #f) _ ...)
307 root-device)
308 (('store ('device device) _ ...)
309 (device-sexp->device device))
310 (_ ;the old format
311 root-device))))
8e815c5b
LC
312
313 (store-mount-point
314 (match (assq 'store rest)
315 (('store ('device _) ('mount-point mount-point) _ ...)
316 mount-point)
317 (_ ;the old format
318 "/")))))
319 (x ;unsupported format
b1059b38
LC
320 (warning (G_ "unrecognized boot parameters at '~a'~%")
321 (port-filename port))
8e815c5b
LC
322 #f)))
323
324(define (read-boot-parameters-file system)
325 "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
326file and returns the corresponding <boot-parameters> object or #f if the
327format is unrecognized.
328The object has its kernel-arguments extended in order to make it bootable."
329 (let* ((file (string-append system "/parameters"))
330 (params (call-with-input-file file read-boot-parameters))
a7ef45d9
LC
331 (root (boot-parameters-root-device params)))
332 (boot-parameters
333 (inherit params)
334 (kernel-arguments (append (bootable-kernel-arguments system root)
335 (boot-parameters-kernel-arguments params))))))
8b22107e 336
1975c754
DM
337(define (boot-parameters->menu-entry conf)
338 (menu-entry
339 (label (boot-parameters-label conf))
340 (device (boot-parameters-store-device conf))
341 (device-mount-point (boot-parameters-store-mount-point conf))
342 (linux (boot-parameters-kernel conf))
343 (linux-arguments (boot-parameters-kernel-arguments conf))
344 (initrd (boot-parameters-initrd conf))))
345
8b22107e 346
8e815c5b 347\f
40281c54
LC
348;;;
349;;; Services.
350;;;
351
aa1145df
LC
352(define (non-boot-file-system-service os)
353 "Return the file system service for the file systems of OS that are not
354marked as 'needed-for-boot'."
023f391c 355 (define file-systems
4d6b879c 356 (remove file-system-needed-for-boot?
023f391c
LC
357 (operating-system-file-systems os)))
358
68a58775
LC
359 (define mapped-devices-for-boot
360 (operating-system-boot-mapped-devices os))
361
5dae0186 362 (define (device-mappings fs)
ab64483f 363 (let ((device (file-system-device fs)))
29824d80 364 (if (string? device) ;title is 'device
ab64483f
LC
365 (filter (lambda (md)
366 (string=? (string-append "/dev/mapper/"
367 (mapped-device-target md))
368 device))
369 (operating-system-mapped-devices os))
370 '())))
5dae0186 371
e502bf89
LC
372 (define (add-dependencies fs)
373 ;; Add the dependencies due to device mappings to FS.
374 (file-system
375 (inherit fs)
376 (dependencies
68a58775
LC
377 (delete-duplicates
378 (remove (cut member <> mapped-devices-for-boot)
379 (append (device-mappings fs)
380 (file-system-dependencies fs)))
381 eq?))))
e502bf89 382
aa1145df
LC
383 (service file-system-service-type
384 (map add-dependencies file-systems)))
023f391c 385
68a58775
LC
386(define (mapped-device-users device file-systems)
387 "Return the subset of FILE-SYSTEMS that use DEVICE."
de1c158f 388 (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
68a58775
LC
389 (filter (lambda (fs)
390 (or (member device (file-system-dependencies fs))
391 (and (string? (file-system-device fs))
392 (string=? (file-system-device fs) target))))
393 file-systems)))
de1c158f
LC
394
395(define (operating-system-user-mapped-devices os)
396 "Return the subset of mapped devices that can be installed in
397user-land--i.e., those not needed during boot."
9cb426b8
LC
398 (let ((devices (operating-system-mapped-devices os))
399 (file-systems (operating-system-file-systems os)))
400 (filter (lambda (md)
68a58775
LC
401 (let ((users (mapped-device-users md file-systems)))
402 (not (any file-system-needed-for-boot? users))))
9cb426b8 403 devices)))
de1c158f
LC
404
405(define (operating-system-boot-mapped-devices os)
406 "Return the subset of mapped devices that must be installed during boot,
407from the initrd."
9cb426b8
LC
408 (let ((devices (operating-system-mapped-devices os))
409 (file-systems (operating-system-file-systems os)))
410 (filter (lambda (md)
68a58775
LC
411 (let ((users (mapped-device-users md file-systems)))
412 (any file-system-needed-for-boot? users)))
9cb426b8 413 devices)))
de1c158f 414
5dae0186 415(define (device-mapping-services os)
be1c2c54 416 "Return the list of device-mapping services for OS as a list."
4da8c19e 417 (map device-mapping-service
be1c2c54 418 (operating-system-user-mapped-devices os)))
5dae0186 419
2a13d05e 420(define (swap-services os)
be1c2c54
LC
421 "Return the list of swap services for OS."
422 (map swap-service (operating-system-swap-devices os)))
2a13d05e 423
44d5f54e
LC
424(define* (system-linux-image-file-name #:optional (system (%current-system)))
425 "Return the basename of the kernel image file for SYSTEM."
426 ;; FIXME: Evaluate the conditional based on the actual current system.
43fe431c
DC
427 (cond
428 ((string-prefix? "arm" (%current-system)) "zImage")
429 ((string-prefix? "mips" (%current-system)) "vmlinuz")
fd900d68 430 ((string-prefix? "aarch64" (%current-system)) "Image")
43fe431c 431 (else "bzImage")))
44d5f54e
LC
432
433(define (operating-system-kernel-file os)
434 "Return an object representing the absolute file name of the kernel image of
435OS."
436 (file-append (operating-system-kernel os)
437 "/" (system-linux-image-file-name os)))
438
d62e201c
LC
439(define* (operating-system-directory-base-entries os #:key container?)
440 "Return the basic entries of the 'system' directory of OS for use as the
441value of the SYSTEM-SERVICE-TYPE service."
b19a49d0
LC
442 (let ((locale (operating-system-locale-directory os)))
443 (with-monad %store-monad
444 (if container?
445 (return `(("locale" ,locale)))
446 (mlet %store-monad
447 ((kernel -> (operating-system-kernel os))
e34ae75d 448 (initrd -> (operating-system-initrd-file os))
b19a49d0
LC
449 (params (operating-system-boot-parameters-file os)))
450 (return `(("kernel" ,kernel)
451 ("parameters" ,params)
452 ("initrd" ,initrd)
453 ("locale" ,locale)))))))) ;used by libc
d62e201c 454
0adfe95a 455(define* (essential-services os #:key container?)
217a5b85
LC
456 "Return the list of essential services for OS. These are special services
457that implement part of what's declared in OS are responsible for low-level
0adfe95a
LC
458bookkeeping. CONTAINER? determines whether to return the list of services for
459a container or that of a \"bare metal\" system."
d6e2a622
LC
460 (define known-fs
461 (map file-system-mount-point (operating-system-file-systems os)))
462
be1c2c54
LC
463 (let* ((mappings (device-mapping-services os))
464 (root-fs (root-file-system-service))
aa1145df 465 (other-fs (non-boot-file-system-service os))
be1c2c54 466 (swaps (swap-services os))
206a28d8 467 (procs (service user-processes-service-type))
d62e201c
LC
468 (host-name (host-name-service (operating-system-host-name os)))
469 (entries (operating-system-directory-base-entries
470 os #:container? container?)))
471 (cons* (service system-service-type entries)
472 %boot-service
0adfe95a 473
661c237b 474 ;; %SHEPHERD-ROOT-SERVICE must come last so that the gexp that
d4053c71 475 ;; execs shepherd comes last in the boot script (XXX). Likewise,
661c237b 476 ;; the cleanup service must come first so that its gexp runs before
d4053c71 477 ;; activation code.
be7be9e8 478 (service cleanup-service-type #f)
661c237b
LC
479 %activation-service
480 %shepherd-root-service
0adfe95a
LC
481
482 (pam-root-service (operating-system-pam-services os))
483 (account-service (append (operating-system-accounts os)
484 (operating-system-groups os))
485 (operating-system-skeletons os))
486 (operating-system-etc-service os)
e43e84ba 487 (service fstab-service-type '())
6bad7524
SB
488 (session-environment-service
489 (operating-system-environment-variables os))
6c445817 490 host-name procs root-fs
0adfe95a
LC
491 (service setuid-program-service-type
492 (operating-system-setuid-programs os))
af4c3fd5
LC
493 (service profile-service-type
494 (operating-system-packages os))
aa1145df
LC
495 other-fs
496 (append mappings swaps
0adfe95a
LC
497
498 ;; Add the firmware service, unless we are building for a
499 ;; container.
500 (if container?
a56c4eb8 501 (list %containerized-shepherd-service)
a241a7ac
LC
502 (list %linux-bare-metal-service
503 (service firmware-service-type
0adfe95a
LC
504 (operating-system-firmware os))))))))
505
506(define* (operating-system-services os #:key container?)
217a5b85
LC
507 "Return all the services of OS, including \"internal\" services that do not
508explicitly appear in OS."
d466b1fc
LC
509 (instantiate-missing-services
510 (append (operating-system-user-services os)
511 (essential-services os #:container? container?))))
217a5b85 512
40281c54
LC
513\f
514;;;
515;;; /etc.
516;;;
517
f34c56be
LC
518(define %base-firmware
519 ;; Firmware usable by default.
52db41af
EB
520 (list ath9k-htc-firmware
521 openfwwf-firmware))
f34c56be 522
6f436c54
LC
523(define %base-packages
524 ;; Default set of packages globally visible. It should include anything
525 ;; required for basic administrator tasks.
55e70e65 526 (cons* procps psmisc which less zile nano
a96a82d7 527 pciutils usbutils
5576cfab 528 util-linux
af23710f 529 inetutils isc-dhcp
87941d1d 530 (@ (gnu packages admin) shadow) ;for 'passwd'
be681773
LC
531
532 ;; wireless-tools is deprecated in favor of iw, but it's still what
533 ;; many people are familiar with, so keep it around.
5146f22b 534 iw wireless-tools
be681773 535
5dccaffe 536 iproute
9b762b8d 537 net-tools ; XXX: remove when Inetutils suffices
18316d86 538 man-db
02683c33 539 info-reader ;the standalone Info reader (no Perl)
03e9998f 540
a8a086e3
LC
541 ;; The 'sudo' command is already in %SETUID-PROGRAMS, but we also
542 ;; want the other commands and the man pages (notably because
543 ;; auto-completion in Emacs shell relies on man pages.)
544 sudo
545
03e9998f
LC
546 ;; Get 'insmod' & co. from kmod, not module-init-tools, since udev
547 ;; already depends on it anyway.
255f7308 548 kmod eudev
03e9998f 549
b63dbd44 550 e2fsprogs kbd
9b762b8d 551
1d167b6e
LC
552 bash-completion
553
86f23092
LC
554 ;; XXX: We don't use (canonical-package guile-2.2) here because that
555 ;; would create a collision in the global profile between the GMP
556 ;; variant propagated by 'guile-final' and the GMP variant propagated
557 ;; by 'gnutls', itself propagated by 'guix'.
558 guile-2.2
559
9b762b8d
LC
560 ;; The packages below are also in %FINAL-INPUTS, so take them from
561 ;; there to avoid duplication.
562 (map canonical-package
86f23092 563 (list bash coreutils findutils grep sed
4b164c45 564 diffutils patch gawk tar gzip bzip2 xz lzip))))
6f436c54 565
548d4c13
LC
566(define %default-issue
567 ;; Default contents for /etc/issue.
568 "
569This is the GNU system. Welcome.\n")
570
568841d4
LC
571(define (local-host-aliases host-name)
572 "Return aliases for HOST-NAME, to be used in /etc/hosts."
573 (string-append "127.0.0.1 localhost " host-name "\n"
574 "::1 localhost " host-name "\n"))
575
c65e1834
LC
576(define (default-/etc/hosts host-name)
577 "Return the default /etc/hosts file."
24e02c28 578 (plain-file "hosts" (local-host-aliases host-name)))
c65e1834 579
0adfe95a
LC
580(define* (operating-system-etc-service os)
581 "Return a <service> that builds containing the static part of the /etc
582directory."
e453da13
LF
583 (let ((login.defs
584 (plain-file "login.defs"
585 (string-append
586 "# Default paths for non-login shells started by su(1).\n"
587 "ENV_PATH /run/setuid-programs:"
588 "/run/current-system/profile/bin:"
589 "/run/current-system/profile/sbin\n"
590 "ENV_SUPATH /run/setuid-programs:"
591 "/run/current-system/profile/bin:"
592 "/run/current-system/profile/sbin\n")))
0adfe95a 593
0adfe95a
LC
594 (issue (plain-file "issue" (operating-system-issue os)))
595 (nsswitch (plain-file "nsswitch.conf"
596 (name-service-switch->string
597 (operating-system-name-service-switch os))))
598
599 ;; Startup file for POSIX-compliant login shells, which set system-wide
600 ;; environment variables.
601 (profile (mixed-text-file "profile" "\
c05c4321 602# Crucial variables that could be missing in the profiles' 'etc/profile'
d9959421
LC
603# because they would require combining both profiles.
604# FIXME: See <http://bugs.gnu.org/20255>.
97ab2c0f 605export MANPATH=$HOME/.guix-profile/share/man:/run/current-system/profile/share/man
8d09bfe2 606export INFOPATH=$HOME/.guix-profile/share/info:/run/current-system/profile/share/info
00239d05
SB
607export XDG_DATA_DIRS=$HOME/.guix-profile/share:/run/current-system/profile/share
608export XDG_CONFIG_DIRS=$HOME/.guix-profile/etc/xdg:/run/current-system/profile/etc/xdg
609
ce380150
TD
610# Make sure libXcursor finds cursors installed into user or system profiles. See <http://bugs.gnu.org/24445>
611export XCURSOR_PATH=$HOME/.icons:$HOME/.guix-profile/share/icons:/run/current-system/profile/share/icons
612
d9959421
LC
613# Ignore the default value of 'PATH'.
614unset PATH
615
616# Load the system profile's settings.
bd7e136d 617GUIX_PROFILE=/run/current-system/profile ; \\
669786da 618. /run/current-system/profile/etc/profile
d9959421 619
cad7e6ab
CSLL
620# Since 'lshd' does not use pam_env, /etc/environment must be explicitly
621# loaded when someone logs in via SSH. See <http://bugs.gnu.org/22175>.
622# We need 'PATH' to be defined here, for 'cat' and 'cut'. Do this before
623# reading the user's 'etc/profile' to allow variables to be overridden.
624if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
625 -a -z \"$LINUX_MODULE_DIRECTORY\" ]
626then
627 . /etc/environment
628 export `cat /etc/environment | cut -d= -f1`
629fi
630
8d09bfe2
LC
631# Arrange so that ~/.config/guix/current comes first.
632for profile in \"$HOME/.guix-profile\" \"$HOME/.config/guix/current\"
cdc5b932
LC
633do
634 if [ -f \"$profile/etc/profile\" ]
635 then
636 # Load the user profile's settings.
637 GUIX_PROFILE=\"$profile\" ; \\
638 . \"$profile/etc/profile\"
639 else
640 # At least define this one so that basic things just work
641 # when the user installs their first package.
642 export PATH=\"$profile/bin:$PATH\"
643 fi
644done
d9959421 645
a854525a
LC
646# Prepend setuid programs.
647export PATH=/run/setuid-programs:$PATH
648
8d09bfe2
LC
649# Arrange so that ~/.config/guix/current/share/info comes first.
650export INFOPATH=\"$HOME/.config/guix/current/share/info:$INFOPATH\"
651
11202482
LC
652# Set the umask, notably for users logging in via 'lsh'.
653# See <http://bugs.gnu.org/22650>.
654umask 022
2a5f0db4 655
c08da2ee
LC
656# Allow Hunspell-based applications (IceCat, LibreOffice, etc.) to
657# find dictionaries.
658export DICPATH=\"$HOME/.guix-profile/share/hunspell:/run/current-system/profile/share/hunspell\"
659
4af7c83b
LC
660# Allow GStreamer-based applications to find plugins.
661export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
662
1d167b6e
LC
663if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
664then
665 # Load Bash-specific initialization code.
669786da 666 . /etc/bashrc
1d167b6e 667fi
40281c54 668"))
1d167b6e 669
0adfe95a 670 (bashrc (plain-file "bashrc" "\
1d167b6e
LC
671# Bash-specific initialization.
672
673# The 'bash-completion' package.
674if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
675then
676 # Bash-completion sources ~/.bash_completion. It installs a dynamic
677 # completion loader that searches its own completion files as well
678 # as those in ~/.guix-profile and /run/current-system/profile.
679 source /run/current-system/profile/etc/profile.d/bash_completion.sh
0adfe95a
LC
680fi\n")))
681 (etc-service
9e41130b
LC
682 `(("services" ,(file-append net-base "/etc/services"))
683 ("protocols" ,(file-append net-base "/etc/protocols"))
684 ("rpc" ,(file-append net-base "/etc/rpc"))
0adfe95a
LC
685 ("login.defs" ,#~#$login.defs)
686 ("issue" ,#~#$issue)
687 ("nsswitch.conf" ,#~#$nsswitch)
0adfe95a
LC
688 ("profile" ,#~#$profile)
689 ("bashrc" ,#~#$bashrc)
690 ("hosts" ,#~#$(or (operating-system-hosts-file os)
691 (default-/etc/hosts (operating-system-host-name os))))
c694520b
TD
692 ;; Write the operating-system-host-name to /etc/hostname to prevent
693 ;; NetworkManager from changing the system's hostname when connecting
694 ;; to certain networks. Some discussion at
695 ;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html
696 ("hostname" ,(plain-file "hostname" (operating-system-host-name os)))
9e41130b
LC
697 ("localtime" ,(file-append tzdata "/share/zoneinfo/"
698 (operating-system-timezone os)))
0adfe95a 699 ("sudoers" ,(operating-system-sudoers-file os))))))
033adfe7 700
ab6a279a
LC
701(define %root-account
702 ;; Default root account.
703 (user-account
704 (name "root")
705 (password "")
706 (uid 0) (group "root")
707 (comment "System administrator")
708 (home-directory "/root")))
709
0b6f49ef 710(define (operating-system-accounts os)
0adfe95a
LC
711 "Return the user accounts for OS, including an obligatory 'root' account,
712and excluding accounts requested by services."
713 ;; Make sure there's a root account.
714 (if (find (lambda (user)
715 (and=> (user-account-uid user) zero?))
716 (operating-system-users os))
717 (operating-system-users os)
718 (cons %root-account (operating-system-users os))))
0b6f49ef 719
84765839
LC
720(define (maybe-string->file file-name thing)
721 "If THING is a string, return a <plain-file> with THING as its content.
722Otherwise just return THING.
723
724This is for backward-compatibility of fields that used to be strings and are
725now file-like objects.."
726 (match thing
727 ((? string?)
69daee23 728 (warning (G_ "using a string for file '~a' is deprecated; \
84765839
LC
729use 'plain-file' instead~%")
730 file-name)
731 (plain-file file-name thing))
732 (x
733 x)))
734
24e02c28
LC
735(define (maybe-file->monadic file-name thing)
736 "If THING is a value in %STORE-MONAD, return it as is; otherwise return
737THING in the %STORE-MONAD.
738
739This is for backward-compatibility of fields that used to be monadic values
740and are now file-like objects."
741 (with-monad %store-monad
742 (match thing
743 ((? procedure?)
69daee23 744 (warning (G_ "using a monadic value for '~a' is deprecated; \
24e02c28
LC
745use 'plain-file' instead~%")
746 file-name)
747 thing)
748 (x
749 (return x)))))
750
0b6f49ef
LC
751(define (operating-system-etc-directory os)
752 "Return that static part of the /etc directory of OS."
0adfe95a
LC
753 (etc-directory
754 (fold-services (operating-system-services os)
755 #:target-type etc-service-type)))
033adfe7 756
6bad7524
SB
757(define (operating-system-environment-variables os)
758 "Return the environment variables of OS for
759@var{session-environment-service-type}, to be used in @file{/etc/environment}."
760 `(("LANG" . ,(operating-system-locale os))
54757499
LC
761 ;; Note: No need to set 'TZ' since (1) we provide /etc/localtime, and (2)
762 ;; it doesn't work for setuid binaries. See <https://bugs.gnu.org/29212>.
9e41130b 763 ("TZDIR" . ,(file-append tzdata "/share/zoneinfo"))
6bad7524
SB
764 ;; Tell 'modprobe' & co. where to look for modules.
765 ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
766 ;; These variables are honored by OpenSSL (libssl) and Git.
767 ("SSL_CERT_DIR" . "/etc/ssl/certs")
768 ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
769 ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
ae05e366
LC
770
771 ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are
772 ;; searched for.
773 ("GTK_DATA_PREFIX" . "/run/current-system/profile")
774
6bad7524
SB
775 ;; By default, applications that use D-Bus, such as Emacs, abort at startup
776 ;; when /etc/machine-id is missing. Make sure these warnings are non-fatal.
946465bb
LC
777 ("DBUS_FATAL_WARNINGS" . "0")
778
779 ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package
780 ;; used to look things up in 'PREFIX/lib/locale' instead of
781 ;; '/run/current-system/locale' as was intended. Keep this hack around so
782 ;; that people who still have glibc@2.23-using packages in their profiles
783 ;; can use them correctly.
784 ;; TODO: Remove when glibc@2.23 is long gone.
785 ("GUIX_LOCPATH" . "/run/current-system/locale")))
6bad7524 786
09e028f4
LC
787(define %setuid-programs
788 ;; Default set of setuid-root programs.
3b65abac 789 (let ((shadow (@ (gnu packages admin) shadow)))
9e41130b
LC
790 (list (file-append shadow "/bin/passwd")
791 (file-append shadow "/bin/su")
852241eb
SB
792 (file-append shadow "/bin/newuidmap")
793 (file-append shadow "/bin/newgidmap")
9e41130b
LC
794 (file-append inetutils "/bin/ping")
795 (file-append inetutils "/bin/ping6")
796 (file-append sudo "/bin/sudo")
5144df2c 797 (file-append sudo "/bin/sudoedit")
9e41130b 798 (file-append fuse "/bin/fusermount"))))
69689380
LC
799
800(define %sudoers-specification
801 ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
802 ;; group can do anything. See
803 ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
804 ;; TODO: Add a declarative API.
84765839
LC
805 (plain-file "sudoers" "\
806root ALL=(ALL) ALL
807%wheel ALL=(ALL) ALL\n"))
09e028f4 808
239db054 809(define* (operating-system-activation-script os #:key container?)
484a2b3a
LC
810 "Return the activation script for OS---i.e., the code that \"activates\" the
811stateful part of OS, including user accounts and groups, special directories,
812etc."
0adfe95a
LC
813 (let* ((services (operating-system-services os #:container? container?))
814 (activation (fold-services services
815 #:target-type activation-service-type)))
816 (activation-service->script activation)))
484a2b3a 817
239db054 818(define* (operating-system-boot-script os #:key container?)
484a2b3a 819 "Return the boot script for OS---i.e., the code started by the initrd once
239db054
DT
820we're running in the final root. When CONTAINER? is true, skip all
821hardware-related operations as necessary when booting a Linux container."
0adfe95a 822 (let* ((services (operating-system-services os #:container? container?))
d62e201c 823 (boot (fold-services services #:target-type boot-service-type)))
efe7d19a 824 (service-value boot)))
2106d3fc 825
b2fef041
LC
826(define (operating-system-user-accounts os)
827 "Return the list of user accounts of OS."
828 (let* ((services (operating-system-services os))
829 (account (fold-services services
830 #:target-type account-service-type)))
831 (filter user-account?
efe7d19a 832 (service-value account))))
b2fef041
LC
833
834(define (operating-system-shepherd-service-names os)
835 "Return the list of Shepherd service names for OS."
836 (append-map shepherd-service-provision
efe7d19a 837 (service-value
b2fef041
LC
838 (fold-services (operating-system-services os)
839 #:target-type
840 shepherd-root-service-type))))
841
d62e201c
LC
842(define* (operating-system-derivation os #:key container?)
843 "Return a derivation that builds OS."
844 (let* ((services (operating-system-services os #:container? container?))
845 (system (fold-services services)))
846 ;; SYSTEM contains the derivation as a monadic value.
efe7d19a 847 (service-value system)))
d62e201c 848
af4c3fd5
LC
849(define* (operating-system-profile os #:key container?)
850 "Return a derivation that builds the system profile of OS."
851 (mlet* %store-monad
852 ((services -> (operating-system-services os #:container? container?))
853 (profile (fold-services services
854 #:target-type profile-service-type)))
855 (match profile
856 (("profile" profile)
857 (return profile)))))
858
83bcd0b8
LC
859(define (operating-system-root-file-system os)
860 "Return the root file system of OS."
a48d3450
LC
861 (find (lambda (fs)
862 (string=? "/" (file-system-mount-point fs)))
83bcd0b8
LC
863 (operating-system-file-systems os)))
864
b4140694
LC
865(define (operating-system-initrd-file os)
866 "Return a gexp denoting the initrd file of OS."
83bcd0b8 867 (define boot-file-systems
4d6b879c 868 (filter file-system-needed-for-boot?
83bcd0b8
LC
869 (operating-system-file-systems os)))
870
de1c158f
LC
871 (define mapped-devices
872 (operating-system-boot-mapped-devices os))
873
874 (define make-initrd
875 (operating-system-initrd os))
876
d422cbb3
LC
877 (make-initrd boot-file-systems
878 #:linux (operating-system-kernel os)
879 #:linux-modules
880 (operating-system-initrd-modules os)
881 #:mapped-devices mapped-devices))
b4140694 882
f5582b2c
LC
883(define (locale-name->definition* name)
884 "Variant of 'locale-name->definition' that raises an error upon failure."
885 (match (locale-name->definition name)
886 (#f
887 (raise (condition
888 (&message
69daee23 889 (message (format #f (G_ "~a: invalid locale name") name))))))
f5582b2c
LC
890 (def def)))
891
598e19dc
LC
892(define (operating-system-locale-directory os)
893 "Return the directory containing the locales compiled for the definitions
894listed in OS. The C library expects to find it under
895/run/current-system/locale."
f5582b2c
LC
896 (define name
897 (operating-system-locale os))
898
899 (define definitions
900 ;; While we're at it, check whether NAME is defined and add it if needed.
901 (if (member name (map locale-definition-name
902 (operating-system-locale-definitions os)))
903 (operating-system-locale-definitions os)
904 (cons (locale-name->definition* name)
905 (operating-system-locale-definitions os))))
906
907 (locale-directory definitions
34760ae7 908 #:libcs (operating-system-locale-libcs os)))
598e19dc 909
c2e9942b
MO
910(define (kernel->boot-label kernel)
911 "Return a label for the bootloader menu entry that boots KERNEL."
bdc61ff9
P
912 (cond ((package? kernel)
913 (string-append "GNU with "
914 (string-titlecase (package-name kernel)) " "
915 (package-version kernel)
916 " (beta)"))
917 ((inferior-package? kernel)
918 (string-append "GNU with "
b12f8720 919 (string-titlecase (inferior-package-name kernel)) " "
bdc61ff9
P
920 (inferior-package-version kernel)
921 " (beta)"))
922 (else "GNU")))
2d23e6f0 923
6b779207
LC
924(define (store-file-system file-systems)
925 "Return the file system object among FILE-SYSTEMS that contains the store."
926 (match (filter (lambda (fs)
927 (and (file-system-mount? fs)
928 (not (memq 'bind-mount (file-system-flags fs)))
929 (string-prefix? (file-system-mount-point fs)
930 (%store-prefix))))
931 file-systems)
932 ((and candidates (head . tail))
933 (reduce (lambda (fs1 fs2)
934 (if (> (string-length (file-system-mount-point fs1))
935 (string-length (file-system-mount-point fs2)))
936 fs1
937 fs2))
938 head
939 candidates))))
940
941(define (operating-system-store-file-system os)
942 "Return the file system that contains the store of OS."
943 (store-file-system (operating-system-file-systems os)))
944
c76b3046 945(define* (operating-system-bootcfg os #:optional (old-entries '()))
5ece56dc
LC
946 "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
947a list of <menu-entry>, to populate the \"old entries\" menu."
9782c822
LC
948 (let* ((root-fs (operating-system-root-file-system os))
949 (root-device (file-system-device root-fs))
950 (params (operating-system-boot-parameters
951 os root-device
952 #:system-kernel-arguments? #t))
953 (entry (boot-parameters->menu-entry params))
954 (bootloader-conf (operating-system-bootloader os)))
46c296dc
LC
955 (define generate-config-file
956 (bootloader-configuration-file-generator
957 (bootloader-configuration-bootloader bootloader-conf)))
958
9782c822
LC
959 (generate-config-file bootloader-conf (list entry)
960 #:old-entries old-entries)))
b4140694 961
a7ef45d9
LC
962(define* (operating-system-boot-parameters os root-device
963 #:key system-kernel-arguments?)
964 "Return a monadic <boot-parameters> record that describes the boot
965parameters of OS. When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments
966such as '--root' and '--load' to <boot-parameters>."
35b44681
LC
967 (let* ((initrd (operating-system-initrd-file os))
968 (store (operating-system-store-file-system os))
969 (bootloader (bootloader-configuration-bootloader
970 (operating-system-bootloader os)))
971 (bootloader-name (bootloader-name bootloader))
972 (label (kernel->boot-label (operating-system-kernel os))))
973 (boot-parameters
974 (label label)
975 (root-device root-device)
976 (kernel (operating-system-kernel-file os))
977 (kernel-arguments
978 (if system-kernel-arguments?
979 (operating-system-kernel-arguments os root-device)
980 (operating-system-user-kernel-arguments os)))
981 (initrd initrd)
982 (bootloader-name bootloader-name)
983 (store-device (ensure-not-/dev (file-system-device store)))
984 (store-mount-point (file-system-mount-point store)))))
40fad1c2 985
9b336338
LC
986(define (device->sexp device)
987 "Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
988 (match device
989 ((? uuid? uuid)
075681d3 990 `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
a5acc17a
LC
991 ((? file-system-label? label)
992 `(file-system-label ,(file-system-label->string label)))
9b336338
LC
993 (_
994 device)))
995
a7ef45d9
LC
996(define* (operating-system-boot-parameters-file os
997 #:key system-kernel-arguments?)
40fad1c2
DM
998 "Return a file that describes the boot parameters of OS. The primary use of
999this file is the reconstruction of GRUB menu entries for old configurations.
a7ef45d9
LC
1000
1001When SYSTEM-KERNEL-ARGUMENTS? is true, add kernel arguments such as '--root'
1002and '--load' to the returned file (since the returned file is then usually
1003stored into the content-addressed \"system\" directory, it's usually not a
1004good idea to give it because the content hash would change by the content hash
40fad1c2 1005being stored into the \"parameters\" file)."
35b44681
LC
1006 (let* ((root (operating-system-root-file-system os))
1007 (device (file-system-device root))
1008 (params (operating-system-boot-parameters
1009 os device
1010 #:system-kernel-arguments?
1011 system-kernel-arguments?)))
40fad1c2
DM
1012 (gexp->file "parameters"
1013 #~(boot-parameters
1014 (version 0)
1015 (label #$(boot-parameters-label params))
9b336338
LC
1016 (root-device
1017 #$(device->sexp
1018 (boot-parameters-root-device params)))
40fad1c2
DM
1019 (kernel #$(boot-parameters-kernel params))
1020 (kernel-arguments
1021 #$(boot-parameters-kernel-arguments params))
1022 (initrd #$(boot-parameters-initrd params))
f96752e3 1023 (bootloader-name #$(boot-parameters-bootloader-name params))
40fad1c2 1024 (store
9b336338
LC
1025 (device
1026 #$(device->sexp (boot-parameters-store-device params)))
40fad1c2
DM
1027 (mount-point #$(boot-parameters-store-mount-point params))))
1028 #:set-load-path? #f)))
64e40dbb 1029
96da5d62
LC
1030(define-gexp-compiler (operating-system-compiler (os <operating-system>)
1031 system target)
1032 ((store-lift
1033 (lambda (store)
1034 ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
1035 ;; 'operating-system-derivation'.
1036 (run-with-store store (operating-system-derivation os)
1037 #:system system
1038 #:target target)))))
1039
033adfe7 1040;;; system.scm ends here