gnu: r-geneplotter: Update to 1.58.0.
[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>
033adfe7
LC
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/>.
22
23(define-module (gnu system)
24 #:use-module (guix store)
25 #:use-module (guix monads)
02100028 26 #:use-module (guix gexp)
033adfe7
LC
27 #:use-module (guix records)
28 #:use-module (guix packages)
29 #:use-module (guix derivations)
29fce8b6 30 #:use-module (guix profiles)
84765839 31 #:use-module (guix ui)
033adfe7
LC
32 #:use-module (gnu packages base)
33 #:use-module (gnu packages bash)
bdb36958 34 #:use-module (gnu packages guile)
9de46ffb 35 #:use-module (gnu packages admin)
8a07c289 36 #:use-module (gnu packages linux)
a96a82d7 37 #:use-module (gnu packages pciutils)
033adfe7 38 #:use-module (gnu packages package-management)
6f436c54
LC
39 #:use-module (gnu packages less)
40 #:use-module (gnu packages zile)
55e70e65 41 #:use-module (gnu packages nano)
a68c6967 42 #:use-module (gnu packages gawk)
18316d86 43 #:use-module (gnu packages man)
939c5c31 44 #:use-module (gnu packages texinfo)
a68c6967 45 #:use-module (gnu packages compression)
f34c56be 46 #:use-module (gnu packages firmware)
db4fdc04 47 #:use-module (gnu services)
0190c1c0 48 #:use-module (gnu services shepherd)
db4fdc04 49 #:use-module (gnu services base)
b09a8da4 50 #:use-module (gnu bootloader)
033adfe7 51 #:use-module (gnu system shadow)
996ed739 52 #:use-module (gnu system nss)
598e19dc 53 #:use-module (gnu system locale)
6e828634 54 #:use-module (gnu system pam)
735c6dd7 55 #:use-module (gnu system linux-initrd)
9b336338 56 #:use-module (gnu system uuid)
c5df1839 57 #:use-module (gnu system file-systems)
060d62a7 58 #:use-module (gnu system mapped-devices)
033adfe7
LC
59 #:use-module (ice-9 match)
60 #:use-module (srfi srfi-1)
61 #:use-module (srfi srfi-26)
598e19dc
LC
62 #:use-module (srfi srfi-34)
63 #:use-module (srfi srfi-35)
3382bfe9 64 #:use-module (rnrs bytevectors)
033adfe7
LC
65 #:export (operating-system
66 operating-system?
d5b429ab
LC
67
68 operating-system-bootloader
033adfe7 69 operating-system-services
217a5b85 70 operating-system-user-services
033adfe7 71 operating-system-packages
fd3bfc44 72 operating-system-host-name
c65e1834 73 operating-system-hosts-file
fd3bfc44 74 operating-system-kernel
44d5f54e 75 operating-system-kernel-file
33f0aa88 76 operating-system-kernel-arguments
bc499b11 77 operating-system-initrd-modules
fd3bfc44
LC
78 operating-system-initrd
79 operating-system-users
80 operating-system-groups
548d4c13 81 operating-system-issue
fd3bfc44
LC
82 operating-system-timezone
83 operating-system-locale
598e19dc 84 operating-system-locale-definitions
34760ae7 85 operating-system-locale-libcs
5dae0186 86 operating-system-mapped-devices
83bcd0b8 87 operating-system-file-systems
6b779207 88 operating-system-store-file-system
2bdd7ac1
LC
89 operating-system-user-mapped-devices
90 operating-system-boot-mapped-devices
b25937e3 91 operating-system-activation-script
b2fef041
LC
92 operating-system-user-accounts
93 operating-system-shepherd-service-names
20abb8c4 94 operating-system-user-kernel-arguments
033adfe7 95
1aa0033b 96 operating-system-derivation
83bcd0b8 97 operating-system-profile
c76b3046 98 operating-system-bootcfg
239db054
DT
99 operating-system-etc-directory
100 operating-system-locale-directory
101 operating-system-boot-script
102
43fe431c
DC
103 system-linux-image-file-name
104
b8300494
AK
105 boot-parameters
106 boot-parameters?
107 boot-parameters-label
108 boot-parameters-root-device
f96752e3 109 boot-parameters-bootloader-name
1ef8b72a
CM
110 boot-parameters-store-device
111 boot-parameters-store-mount-point
b8300494
AK
112 boot-parameters-kernel
113 boot-parameters-kernel-arguments
d7b342d8 114 boot-parameters-initrd
4e4e0185 115 read-boot-parameters
9530e73b 116 read-boot-parameters-file
1975c754 117 boot-parameters->menu-entry
b8300494 118
568841d4 119 local-host-aliases
df5ce088 120 %setuid-programs
5dae0186 121 %base-packages
374f14c2 122 %base-firmware))
033adfe7
LC
123
124;;; Commentary:
125;;;
126;;; This module supports whole-system configuration.
127;;;
128;;; Code:
129
33f0aa88
DM
130(define (bootable-kernel-arguments kernel-arguments system.drv root-device)
131 "Prepend extra arguments to KERNEL-ARGUMENTS that allow SYSTEM.DRV to be
132booted from ROOT-DEVICE"
9b336338 133 (cons* (string-append "--root="
a5acc17a
LC
134 (cond ((uuid? root-device)
135
136 ;; Note: Always use the DCE format because that's
137 ;; what (gnu build linux-boot) expects for the
138 ;; '--root' kernel command-line option.
139 (uuid->string (uuid-bytevector root-device)
140 'dce))
141 ((file-system-label? root-device)
142 (file-system-label->string root-device))
143 (else root-device)))
33f0aa88
DM
144 #~(string-append "--system=" #$system.drv)
145 #~(string-append "--load=" #$system.drv "/boot")
146 kernel-arguments))
147
033adfe7
LC
148;; System-wide configuration.
149;; TODO: Add per-field docstrings/stexi.
150(define-record-type* <operating-system> operating-system
151 make-operating-system
152 operating-system?
153 (kernel operating-system-kernel ; package
57082417 154 (default linux-libre))
af98d25a 155 (kernel-arguments operating-system-user-kernel-arguments
ee2a6304 156 (default '())) ; list of gexps/strings
b09a8da4 157 (bootloader operating-system-bootloader) ; <bootloader-configuration>
d5b429ab 158
83bcd0b8 159 (initrd operating-system-initrd ; (list fs) -> M derivation
060238ae 160 (default base-initrd))
bc499b11
LC
161 (initrd-modules operating-system-initrd-modules ; list of strings
162 (thunked) ; it's system-dependent
163 (default %base-initrd-modules))
164
f34c56be
LC
165 (firmware operating-system-firmware ; list of packages
166 (default %base-firmware))
033adfe7
LC
167
168 (host-name operating-system-host-name) ; string
24e02c28 169 (hosts-file operating-system-hosts-file ; file-like | #f
c65e1834 170 (default #f))
033adfe7 171
5dae0186
LC
172 (mapped-devices operating-system-mapped-devices ; list of <mapped-device>
173 (default '()))
8a6d2731 174 (file-systems operating-system-file-systems) ; list of fs
2a13d05e
LC
175 (swap-devices operating-system-swap-devices ; list of strings
176 (default '()))
033adfe7
LC
177
178 (users operating-system-users ; list of user accounts
bf87f38a 179 (default %base-user-accounts))
033adfe7 180 (groups operating-system-groups ; list of user groups
773e956d 181 (default %base-groups))
033adfe7 182
40281c54
LC
183 (skeletons operating-system-skeletons ; list of name/monadic value
184 (default (default-skeletons)))
548d4c13
LC
185 (issue operating-system-issue ; string
186 (default %default-issue))
40281c54 187
033adfe7 188 (packages operating-system-packages ; list of (PACKAGE OUTPUT...)
6f436c54 189 (default %base-packages)) ; or just PACKAGE
033adfe7
LC
190
191 (timezone operating-system-timezone) ; string
8a6d2731 192 (locale operating-system-locale ; string
598e19dc
LC
193 (default "en_US.utf8"))
194 (locale-definitions operating-system-locale-definitions ; list of <locale-definition>
195 (default %default-locale-definitions))
34760ae7
LC
196 (locale-libcs operating-system-locale-libcs ; list of <packages>
197 (default %default-locale-libcs))
996ed739
LC
198 (name-service-switch operating-system-name-service-switch ; <name-service-switch>
199 (default %default-nss))
033adfe7 200
217a5b85 201 (services operating-system-user-services ; list of monadic services
09e028f4
LC
202 (default %base-services))
203
204 (pam-services operating-system-pam-services ; list of PAM services
205 (default (base-pam-services)))
206 (setuid-programs operating-system-setuid-programs
69689380 207 (default %setuid-programs)) ; list of string-valued gexps
033adfe7 208
f5a9ffa0
AK
209 (sudoers-file operating-system-sudoers-file ; file-like
210 (default %sudoers-specification)))
033adfe7 211
33f0aa88
DM
212(define (operating-system-kernel-arguments os system.drv root-device)
213 "Return all the kernel arguments, including the ones not specified
214directly by the user."
215 (bootable-kernel-arguments (operating-system-user-kernel-arguments os)
216 system.drv
217 root-device))
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))
331 (root (boot-parameters-root-device params))
8e815c5b
LC
332 (kernel-arguments (boot-parameters-kernel-arguments params)))
333 (if params
334 (boot-parameters
335 (inherit params)
336 (kernel-arguments (bootable-kernel-arguments kernel-arguments
9b336338 337 system root)))
8e815c5b 338 #f)))
8b22107e 339
1975c754
DM
340(define (boot-parameters->menu-entry conf)
341 (menu-entry
342 (label (boot-parameters-label conf))
343 (device (boot-parameters-store-device conf))
344 (device-mount-point (boot-parameters-store-mount-point conf))
345 (linux (boot-parameters-kernel conf))
346 (linux-arguments (boot-parameters-kernel-arguments conf))
347 (initrd (boot-parameters-initrd conf))))
348
8b22107e 349
8e815c5b 350\f
40281c54
LC
351;;;
352;;; Services.
353;;;
354
aa1145df
LC
355(define (non-boot-file-system-service os)
356 "Return the file system service for the file systems of OS that are not
357marked as 'needed-for-boot'."
023f391c 358 (define file-systems
4d6b879c 359 (remove file-system-needed-for-boot?
023f391c
LC
360 (operating-system-file-systems 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
377 (delete-duplicates (append (device-mappings fs)
378 (file-system-dependencies fs))
379 eq?))))
380
aa1145df
LC
381 (service file-system-service-type
382 (map add-dependencies file-systems)))
023f391c 383
de1c158f
LC
384(define (mapped-device-user device file-systems)
385 "Return a file system among FILE-SYSTEMS that uses DEVICE, or #f."
386 (let ((target (string-append "/dev/mapper/" (mapped-device-target device))))
387 (find (lambda (fs)
2bdd7ac1 388 (or (member device (file-system-dependencies fs))
a5acc17a 389 (and (string? (file-system-device fs))
2bdd7ac1 390 (string=? (file-system-device fs) target))))
de1c158f
LC
391 file-systems)))
392
393(define (operating-system-user-mapped-devices os)
394 "Return the subset of mapped devices that can be installed in
395user-land--i.e., those not needed during boot."
9cb426b8
LC
396 (let ((devices (operating-system-mapped-devices os))
397 (file-systems (operating-system-file-systems os)))
398 (filter (lambda (md)
399 (let ((user (mapped-device-user md file-systems)))
400 (or (not user)
401 (not (file-system-needed-for-boot? user)))))
402 devices)))
de1c158f
LC
403
404(define (operating-system-boot-mapped-devices os)
405 "Return the subset of mapped devices that must be installed during boot,
406from the initrd."
9cb426b8
LC
407 (let ((devices (operating-system-mapped-devices os))
408 (file-systems (operating-system-file-systems os)))
409 (filter (lambda (md)
410 (let ((user (mapped-device-user md file-systems)))
411 (and user (file-system-needed-for-boot? user))))
412 devices)))
de1c158f 413
5dae0186 414(define (device-mapping-services os)
be1c2c54 415 "Return the list of device-mapping services for OS as a list."
4da8c19e 416 (map device-mapping-service
be1c2c54 417 (operating-system-user-mapped-devices os)))
5dae0186 418
2a13d05e 419(define (swap-services os)
be1c2c54
LC
420 "Return the list of swap services for OS."
421 (map swap-service (operating-system-swap-devices os)))
2a13d05e 422
44d5f54e
LC
423(define* (system-linux-image-file-name #:optional (system (%current-system)))
424 "Return the basename of the kernel image file for SYSTEM."
425 ;; FIXME: Evaluate the conditional based on the actual current system.
43fe431c
DC
426 (cond
427 ((string-prefix? "arm" (%current-system)) "zImage")
428 ((string-prefix? "mips" (%current-system)) "vmlinuz")
fd900d68 429 ((string-prefix? "aarch64" (%current-system)) "Image")
43fe431c 430 (else "bzImage")))
44d5f54e
LC
431
432(define (operating-system-kernel-file os)
433 "Return an object representing the absolute file name of the kernel image of
434OS."
435 (file-append (operating-system-kernel os)
436 "/" (system-linux-image-file-name os)))
437
d62e201c
LC
438(define* (operating-system-directory-base-entries os #:key container?)
439 "Return the basic entries of the 'system' directory of OS for use as the
440value of the SYSTEM-SERVICE-TYPE service."
b19a49d0
LC
441 (let ((locale (operating-system-locale-directory os)))
442 (with-monad %store-monad
443 (if container?
444 (return `(("locale" ,locale)))
445 (mlet %store-monad
446 ((kernel -> (operating-system-kernel os))
447 (initrd (operating-system-initrd-file os))
448 (params (operating-system-boot-parameters-file os)))
449 (return `(("kernel" ,kernel)
450 ("parameters" ,params)
451 ("initrd" ,initrd)
452 ("locale" ,locale)))))))) ;used by libc
d62e201c 453
0adfe95a 454(define* (essential-services os #:key container?)
217a5b85
LC
455 "Return the list of essential services for OS. These are special services
456that implement part of what's declared in OS are responsible for low-level
0adfe95a
LC
457bookkeeping. CONTAINER? determines whether to return the list of services for
458a container or that of a \"bare metal\" system."
d6e2a622
LC
459 (define known-fs
460 (map file-system-mount-point (operating-system-file-systems os)))
461
be1c2c54
LC
462 (let* ((mappings (device-mapping-services os))
463 (root-fs (root-file-system-service))
aa1145df 464 (other-fs (non-boot-file-system-service os))
be1c2c54 465 (swaps (swap-services os))
206a28d8 466 (procs (service user-processes-service-type))
d62e201c
LC
467 (host-name (host-name-service (operating-system-host-name os)))
468 (entries (operating-system-directory-base-entries
469 os #:container? container?)))
470 (cons* (service system-service-type entries)
471 %boot-service
0adfe95a 472
d4053c71
AK
473 ;; %SHEPHERD-ROOT-SERVICE must come first so that the gexp that
474 ;; execs shepherd comes last in the boot script (XXX). Likewise,
475 ;; the cleanup service must come last so that its gexp runs before
476 ;; activation code.
477 %shepherd-root-service
be7be9e8
LC
478 %activation-service
479 (service cleanup-service-type #f)
0adfe95a
LC
480
481 (pam-root-service (operating-system-pam-services os))
482 (account-service (append (operating-system-accounts os)
483 (operating-system-groups os))
484 (operating-system-skeletons os))
485 (operating-system-etc-service os)
e43e84ba 486 (service fstab-service-type '())
6bad7524
SB
487 (session-environment-service
488 (operating-system-environment-variables os))
6c445817 489 host-name procs root-fs
0adfe95a
LC
490 (service setuid-program-service-type
491 (operating-system-setuid-programs os))
af4c3fd5
LC
492 (service profile-service-type
493 (operating-system-packages os))
aa1145df
LC
494 other-fs
495 (append mappings swaps
0adfe95a
LC
496
497 ;; Add the firmware service, unless we are building for a
498 ;; container.
499 (if container?
500 '()
a241a7ac
LC
501 (list %linux-bare-metal-service
502 (service firmware-service-type
0adfe95a
LC
503 (operating-system-firmware os))))))))
504
505(define* (operating-system-services os #:key container?)
217a5b85
LC
506 "Return all the services of OS, including \"internal\" services that do not
507explicitly appear in OS."
d466b1fc
LC
508 (instantiate-missing-services
509 (append (operating-system-user-services os)
510 (essential-services os #:container? container?))))
217a5b85 511
40281c54
LC
512\f
513;;;
514;;; /etc.
515;;;
516
f34c56be
LC
517(define %base-firmware
518 ;; Firmware usable by default.
52db41af
EB
519 (list ath9k-htc-firmware
520 openfwwf-firmware))
f34c56be 521
6f436c54
LC
522(define %base-packages
523 ;; Default set of packages globally visible. It should include anything
524 ;; required for basic administrator tasks.
55e70e65 525 (cons* procps psmisc which less zile nano
a96a82d7 526 pciutils usbutils
af23710f
LF
527 ;; temporary package to fix CVE-2018-7738 without a graft
528 util-linux-2.31.1
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
95f92d4e 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
LC
619
620# Prepend setuid programs.
621export PATH=/run/setuid-programs:$PATH
622
cad7e6ab
CSLL
623# Since 'lshd' does not use pam_env, /etc/environment must be explicitly
624# loaded when someone logs in via SSH. See <http://bugs.gnu.org/22175>.
625# We need 'PATH' to be defined here, for 'cat' and 'cut'. Do this before
626# reading the user's 'etc/profile' to allow variables to be overridden.
627if [ -f /etc/environment -a -n \"$SSH_CLIENT\" \\
628 -a -z \"$LINUX_MODULE_DIRECTORY\" ]
629then
630 . /etc/environment
631 export `cat /etc/environment | cut -d= -f1`
632fi
633
507c71d6 634if [ -f \"$HOME/.guix-profile/etc/profile\" ]
d9959421
LC
635then
636 # Load the user profile's settings.
bd7e136d 637 GUIX_PROFILE=\"$HOME/.guix-profile\" ; \\
669786da 638 . \"$HOME/.guix-profile/etc/profile\"
d9959421
LC
639else
640 # At least define this one so that basic things just work
641 # when the user installs their first package.
642 export PATH=\"$HOME/.guix-profile/bin:$PATH\"
643fi
644
11202482
LC
645# Set the umask, notably for users logging in via 'lsh'.
646# See <http://bugs.gnu.org/22650>.
647umask 022
2a5f0db4 648
c08da2ee
LC
649# Allow Hunspell-based applications (IceCat, LibreOffice, etc.) to
650# find dictionaries.
651export DICPATH=\"$HOME/.guix-profile/share/hunspell:/run/current-system/profile/share/hunspell\"
652
4af7c83b
LC
653# Allow GStreamer-based applications to find plugins.
654export GST_PLUGIN_PATH=\"$HOME/.guix-profile/lib/gstreamer-1.0\"
655
1d167b6e
LC
656if [ -n \"$BASH_VERSION\" -a -f /etc/bashrc ]
657then
658 # Load Bash-specific initialization code.
669786da 659 . /etc/bashrc
1d167b6e 660fi
40281c54 661"))
1d167b6e 662
0adfe95a 663 (bashrc (plain-file "bashrc" "\
1d167b6e
LC
664# Bash-specific initialization.
665
666# The 'bash-completion' package.
667if [ -f /run/current-system/profile/etc/profile.d/bash_completion.sh ]
668then
669 # Bash-completion sources ~/.bash_completion. It installs a dynamic
670 # completion loader that searches its own completion files as well
671 # as those in ~/.guix-profile and /run/current-system/profile.
672 source /run/current-system/profile/etc/profile.d/bash_completion.sh
0adfe95a
LC
673fi\n")))
674 (etc-service
9e41130b
LC
675 `(("services" ,(file-append net-base "/etc/services"))
676 ("protocols" ,(file-append net-base "/etc/protocols"))
677 ("rpc" ,(file-append net-base "/etc/rpc"))
0adfe95a
LC
678 ("login.defs" ,#~#$login.defs)
679 ("issue" ,#~#$issue)
680 ("nsswitch.conf" ,#~#$nsswitch)
0adfe95a
LC
681 ("profile" ,#~#$profile)
682 ("bashrc" ,#~#$bashrc)
683 ("hosts" ,#~#$(or (operating-system-hosts-file os)
684 (default-/etc/hosts (operating-system-host-name os))))
c694520b
TD
685 ;; Write the operating-system-host-name to /etc/hostname to prevent
686 ;; NetworkManager from changing the system's hostname when connecting
687 ;; to certain networks. Some discussion at
688 ;; https://lists.gnu.org/archive/html/help-guix/2017-09/msg00037.html
689 ("hostname" ,(plain-file "hostname" (operating-system-host-name os)))
9e41130b
LC
690 ("localtime" ,(file-append tzdata "/share/zoneinfo/"
691 (operating-system-timezone os)))
0adfe95a 692 ("sudoers" ,(operating-system-sudoers-file os))))))
033adfe7 693
ab6a279a
LC
694(define %root-account
695 ;; Default root account.
696 (user-account
697 (name "root")
698 (password "")
699 (uid 0) (group "root")
700 (comment "System administrator")
701 (home-directory "/root")))
702
0b6f49ef 703(define (operating-system-accounts os)
0adfe95a
LC
704 "Return the user accounts for OS, including an obligatory 'root' account,
705and excluding accounts requested by services."
706 ;; Make sure there's a root account.
707 (if (find (lambda (user)
708 (and=> (user-account-uid user) zero?))
709 (operating-system-users os))
710 (operating-system-users os)
711 (cons %root-account (operating-system-users os))))
0b6f49ef 712
84765839
LC
713(define (maybe-string->file file-name thing)
714 "If THING is a string, return a <plain-file> with THING as its content.
715Otherwise just return THING.
716
717This is for backward-compatibility of fields that used to be strings and are
718now file-like objects.."
719 (match thing
720 ((? string?)
69daee23 721 (warning (G_ "using a string for file '~a' is deprecated; \
84765839
LC
722use 'plain-file' instead~%")
723 file-name)
724 (plain-file file-name thing))
725 (x
726 x)))
727
24e02c28
LC
728(define (maybe-file->monadic file-name thing)
729 "If THING is a value in %STORE-MONAD, return it as is; otherwise return
730THING in the %STORE-MONAD.
731
732This is for backward-compatibility of fields that used to be monadic values
733and are now file-like objects."
734 (with-monad %store-monad
735 (match thing
736 ((? procedure?)
69daee23 737 (warning (G_ "using a monadic value for '~a' is deprecated; \
24e02c28
LC
738use 'plain-file' instead~%")
739 file-name)
740 thing)
741 (x
742 (return x)))))
743
0b6f49ef
LC
744(define (operating-system-etc-directory os)
745 "Return that static part of the /etc directory of OS."
0adfe95a
LC
746 (etc-directory
747 (fold-services (operating-system-services os)
748 #:target-type etc-service-type)))
033adfe7 749
6bad7524
SB
750(define (operating-system-environment-variables os)
751 "Return the environment variables of OS for
752@var{session-environment-service-type}, to be used in @file{/etc/environment}."
753 `(("LANG" . ,(operating-system-locale os))
54757499
LC
754 ;; Note: No need to set 'TZ' since (1) we provide /etc/localtime, and (2)
755 ;; it doesn't work for setuid binaries. See <https://bugs.gnu.org/29212>.
9e41130b 756 ("TZDIR" . ,(file-append tzdata "/share/zoneinfo"))
6bad7524
SB
757 ;; Tell 'modprobe' & co. where to look for modules.
758 ("LINUX_MODULE_DIRECTORY" . "/run/booted-system/kernel/lib/modules")
759 ;; These variables are honored by OpenSSL (libssl) and Git.
760 ("SSL_CERT_DIR" . "/etc/ssl/certs")
761 ("SSL_CERT_FILE" . "/etc/ssl/certs/ca-certificates.crt")
762 ("GIT_SSL_CAINFO" . "/etc/ssl/certs/ca-certificates.crt")
ae05e366
LC
763
764 ;; 'GTK_DATA_PREFIX' must name one directory where GTK+ themes are
765 ;; searched for.
766 ("GTK_DATA_PREFIX" . "/run/current-system/profile")
767
6bad7524
SB
768 ;; By default, applications that use D-Bus, such as Emacs, abort at startup
769 ;; when /etc/machine-id is missing. Make sure these warnings are non-fatal.
946465bb
LC
770 ("DBUS_FATAL_WARNINGS" . "0")
771
772 ;; XXX: Normally we wouldn't need to do this, but our glibc@2.23 package
773 ;; used to look things up in 'PREFIX/lib/locale' instead of
774 ;; '/run/current-system/locale' as was intended. Keep this hack around so
775 ;; that people who still have glibc@2.23-using packages in their profiles
776 ;; can use them correctly.
777 ;; TODO: Remove when glibc@2.23 is long gone.
778 ("GUIX_LOCPATH" . "/run/current-system/locale")))
6bad7524 779
09e028f4
LC
780(define %setuid-programs
781 ;; Default set of setuid-root programs.
3b65abac 782 (let ((shadow (@ (gnu packages admin) shadow)))
9e41130b
LC
783 (list (file-append shadow "/bin/passwd")
784 (file-append shadow "/bin/su")
852241eb
SB
785 (file-append shadow "/bin/newuidmap")
786 (file-append shadow "/bin/newgidmap")
9e41130b
LC
787 (file-append inetutils "/bin/ping")
788 (file-append inetutils "/bin/ping6")
789 (file-append sudo "/bin/sudo")
790 (file-append fuse "/bin/fusermount"))))
69689380
LC
791
792(define %sudoers-specification
793 ;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
794 ;; group can do anything. See
795 ;; <http://www.sudo.ws/sudo/man/1.8.10/sudoers.man.html>.
796 ;; TODO: Add a declarative API.
84765839
LC
797 (plain-file "sudoers" "\
798root ALL=(ALL) ALL
799%wheel ALL=(ALL) ALL\n"))
09e028f4 800
239db054 801(define* (operating-system-activation-script os #:key container?)
484a2b3a
LC
802 "Return the activation script for OS---i.e., the code that \"activates\" the
803stateful part of OS, including user accounts and groups, special directories,
804etc."
0adfe95a
LC
805 (let* ((services (operating-system-services os #:container? container?))
806 (activation (fold-services services
807 #:target-type activation-service-type)))
808 (activation-service->script activation)))
484a2b3a 809
239db054 810(define* (operating-system-boot-script os #:key container?)
484a2b3a 811 "Return the boot script for OS---i.e., the code started by the initrd once
239db054
DT
812we're running in the final root. When CONTAINER? is true, skip all
813hardware-related operations as necessary when booting a Linux container."
0adfe95a 814 (let* ((services (operating-system-services os #:container? container?))
d62e201c 815 (boot (fold-services services #:target-type boot-service-type)))
0adfe95a 816 ;; BOOT is the script as a monadic value.
efe7d19a 817 (service-value boot)))
2106d3fc 818
b2fef041
LC
819(define (operating-system-user-accounts os)
820 "Return the list of user accounts of OS."
821 (let* ((services (operating-system-services os))
822 (account (fold-services services
823 #:target-type account-service-type)))
824 (filter user-account?
efe7d19a 825 (service-value account))))
b2fef041
LC
826
827(define (operating-system-shepherd-service-names os)
828 "Return the list of Shepherd service names for OS."
829 (append-map shepherd-service-provision
efe7d19a 830 (service-value
b2fef041
LC
831 (fold-services (operating-system-services os)
832 #:target-type
833 shepherd-root-service-type))))
834
d62e201c
LC
835(define* (operating-system-derivation os #:key container?)
836 "Return a derivation that builds OS."
837 (let* ((services (operating-system-services os #:container? container?))
838 (system (fold-services services)))
839 ;; SYSTEM contains the derivation as a monadic value.
efe7d19a 840 (service-value system)))
d62e201c 841
af4c3fd5
LC
842(define* (operating-system-profile os #:key container?)
843 "Return a derivation that builds the system profile of OS."
844 (mlet* %store-monad
845 ((services -> (operating-system-services os #:container? container?))
846 (profile (fold-services services
847 #:target-type profile-service-type)))
848 (match profile
849 (("profile" profile)
850 (return profile)))))
851
83bcd0b8
LC
852(define (operating-system-root-file-system os)
853 "Return the root file system of OS."
a48d3450
LC
854 (find (lambda (fs)
855 (string=? "/" (file-system-mount-point fs)))
83bcd0b8
LC
856 (operating-system-file-systems os)))
857
b4140694
LC
858(define (operating-system-initrd-file os)
859 "Return a gexp denoting the initrd file of OS."
83bcd0b8 860 (define boot-file-systems
4d6b879c 861 (filter file-system-needed-for-boot?
83bcd0b8
LC
862 (operating-system-file-systems os)))
863
de1c158f
LC
864 (define mapped-devices
865 (operating-system-boot-mapped-devices os))
866
867 (define make-initrd
868 (operating-system-initrd os))
869
870 (mlet %store-monad ((initrd (make-initrd boot-file-systems
0d275f4a 871 #:linux (operating-system-kernel os)
bc499b11
LC
872 #:linux-modules
873 (operating-system-initrd-modules os)
de1c158f 874 #:mapped-devices mapped-devices)))
ab20d74a 875 (return (file-append initrd "/initrd"))))
b4140694 876
f5582b2c
LC
877(define (locale-name->definition* name)
878 "Variant of 'locale-name->definition' that raises an error upon failure."
879 (match (locale-name->definition name)
880 (#f
881 (raise (condition
882 (&message
69daee23 883 (message (format #f (G_ "~a: invalid locale name") name))))))
f5582b2c
LC
884 (def def)))
885
598e19dc
LC
886(define (operating-system-locale-directory os)
887 "Return the directory containing the locales compiled for the definitions
888listed in OS. The C library expects to find it under
889/run/current-system/locale."
f5582b2c
LC
890 (define name
891 (operating-system-locale os))
892
893 (define definitions
894 ;; While we're at it, check whether NAME is defined and add it if needed.
895 (if (member name (map locale-definition-name
896 (operating-system-locale-definitions os)))
897 (operating-system-locale-definitions os)
898 (cons (locale-name->definition* name)
899 (operating-system-locale-definitions os))))
900
901 (locale-directory definitions
34760ae7 902 #:libcs (operating-system-locale-libcs os)))
598e19dc 903
c2e9942b
MO
904(define (kernel->boot-label kernel)
905 "Return a label for the bootloader menu entry that boots KERNEL."
42de9608 906 (string-append "GNU with "
2d23e6f0
LC
907 (string-titlecase (package-name kernel)) " "
908 (package-version kernel)
d0a65256 909 " (beta)"))
2d23e6f0 910
6b779207
LC
911(define (store-file-system file-systems)
912 "Return the file system object among FILE-SYSTEMS that contains the store."
913 (match (filter (lambda (fs)
914 (and (file-system-mount? fs)
915 (not (memq 'bind-mount (file-system-flags fs)))
916 (string-prefix? (file-system-mount-point fs)
917 (%store-prefix))))
918 file-systems)
919 ((and candidates (head . tail))
920 (reduce (lambda (fs1 fs2)
921 (if (> (string-length (file-system-mount-point fs1))
922 (string-length (file-system-mount-point fs2)))
923 fs1
924 fs2))
925 head
926 candidates))))
927
928(define (operating-system-store-file-system os)
929 "Return the file system that contains the store of OS."
930 (store-file-system (operating-system-file-systems os)))
931
c76b3046 932(define* (operating-system-bootcfg os #:optional (old-entries '()))
1975c754
DM
933 "Return the bootloader configuration file for OS. Use OLD-ENTRIES
934(which is a list of <menu-entry>) to populate the \"old entries\" menu."
0b6f49ef 935 (mlet* %store-monad
b4140694 936 ((system (operating-system-derivation os))
83bcd0b8 937 (root-fs -> (operating-system-root-file-system os))
9b336338 938 (root-device -> (file-system-device root-fs))
1975c754
DM
939 (params (operating-system-boot-parameters os system root-device))
940 (entry -> (boot-parameters->menu-entry params))
b09a8da4
MO
941 (bootloader-conf -> (operating-system-bootloader os)))
942 ((bootloader-configuration-file-generator
943 (bootloader-configuration-bootloader bootloader-conf))
944 bootloader-conf (list entry) #:old-entries old-entries)))
b4140694 945
360874dd
DM
946(define (operating-system-boot-parameters os system.drv root-device)
947 "Return a monadic <boot-parameters> record that describes the boot parameters
948of OS. SYSTEM.DRV is either a derivation or #f. If it's a derivation, adds
949kernel arguments for that derivation to <boot-parameters>."
40fad1c2
DM
950 (mlet* %store-monad
951 ((initrd (operating-system-initrd-file os))
952 (store -> (operating-system-store-file-system os))
bcaf67c4
MO
953 (bootloader -> (bootloader-configuration-bootloader
954 (operating-system-bootloader os)))
f96752e3 955 (bootloader-name -> (bootloader-name bootloader))
40fad1c2
DM
956 (label -> (kernel->boot-label (operating-system-kernel os))))
957 (return (boot-parameters
958 (label label)
959 (root-device root-device)
960 (kernel (operating-system-kernel-file os))
961 (kernel-arguments
360874dd
DM
962 (if system.drv
963 (operating-system-kernel-arguments os system.drv root-device)
964 (operating-system-user-kernel-arguments os)))
40fad1c2 965 (initrd initrd)
f96752e3 966 (bootloader-name bootloader-name)
a5acc17a 967 (store-device (ensure-not-/dev (file-system-device store)))
40fad1c2
DM
968 (store-mount-point (file-system-mount-point store))))))
969
9b336338
LC
970(define (device->sexp device)
971 "Serialize DEVICE as an sexp (really, as an object with a read syntax.)"
972 (match device
973 ((? uuid? uuid)
075681d3 974 `(uuid ,(uuid-type uuid) ,(uuid-bytevector uuid)))
a5acc17a
LC
975 ((? file-system-label? label)
976 `(file-system-label ,(file-system-label->string label)))
9b336338
LC
977 (_
978 device)))
979
40fad1c2
DM
980(define* (operating-system-boot-parameters-file os #:optional (system.drv #f))
981 "Return a file that describes the boot parameters of OS. The primary use of
982this file is the reconstruction of GRUB menu entries for old configurations.
983SYSTEM.DRV is optional. If given, adds kernel arguments for that system to the
984returned file (since the returned file is then usually stored into the
985content-addressed \"system\" directory, it's usually not a good idea
986to give it because the content hash would change by the content hash
987being stored into the \"parameters\" file)."
988 (mlet* %store-monad ((root -> (operating-system-root-file-system os))
989 (device -> (file-system-device root))
990 (params (operating-system-boot-parameters os
991 system.drv
992 device)))
993 (gexp->file "parameters"
994 #~(boot-parameters
995 (version 0)
996 (label #$(boot-parameters-label params))
9b336338
LC
997 (root-device
998 #$(device->sexp
999 (boot-parameters-root-device params)))
40fad1c2
DM
1000 (kernel #$(boot-parameters-kernel params))
1001 (kernel-arguments
1002 #$(boot-parameters-kernel-arguments params))
1003 (initrd #$(boot-parameters-initrd params))
f96752e3 1004 (bootloader-name #$(boot-parameters-bootloader-name params))
40fad1c2 1005 (store
9b336338
LC
1006 (device
1007 #$(device->sexp (boot-parameters-store-device params)))
40fad1c2
DM
1008 (mount-point #$(boot-parameters-store-mount-point params))))
1009 #:set-load-path? #f)))
64e40dbb 1010
96da5d62
LC
1011(define-gexp-compiler (operating-system-compiler (os <operating-system>)
1012 system target)
1013 ((store-lift
1014 (lambda (store)
1015 ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
1016 ;; 'operating-system-derivation'.
1017 (run-with-store store (operating-system-derivation os)
1018 #:system system
1019 #:target target)))))
1020
033adfe7 1021;;; system.scm ends here