gnu: Add r-rsconnect.
[jackhill/guix/guix.git] / gnu / system / install.scm
1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
4 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
5 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
6 ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
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 install)
24 #:use-module (gnu)
25 #:use-module (gnu system)
26 #:use-module (gnu bootloader u-boot)
27 #:use-module (guix gexp)
28 #:use-module (guix store)
29 #:use-module (guix monads)
30 #:use-module ((guix packages) #:select (package-version))
31 #:use-module ((guix store) #:select (%store-prefix))
32 #:use-module (gnu installer)
33 #:use-module (gnu services dbus)
34 #:use-module (gnu services networking)
35 #:use-module (gnu services shepherd)
36 #:use-module (gnu services ssh)
37 #:use-module (gnu packages admin)
38 #:use-module (gnu packages bash)
39 #:use-module (gnu packages bootloaders)
40 #:use-module (gnu packages certs)
41 #:use-module (gnu packages file-systems)
42 #:use-module (gnu packages fonts)
43 #:use-module (gnu packages fontutils)
44 #:use-module (gnu packages guile)
45 #:use-module (gnu packages linux)
46 #:use-module (gnu packages ssh)
47 #:use-module (gnu packages cryptsetup)
48 #:use-module (gnu packages package-management)
49 #:use-module (gnu packages disk)
50 #:use-module (gnu packages texinfo)
51 #:use-module (gnu packages compression)
52 #:use-module (gnu packages nvi)
53 #:use-module (ice-9 match)
54 #:use-module (srfi srfi-26)
55 #:export (installation-os
56 a20-olinuxino-lime-installation-os
57 a20-olinuxino-lime2-emmc-installation-os
58 a20-olinuxino-micro-installation-os
59 bananapi-m2-ultra-installation-os
60 beaglebone-black-installation-os
61 mx6cuboxi-installation-os
62 nintendo-nes-classic-edition-installation-os
63 novena-installation-os
64 firefly-rk3399-installation-os
65 pine64-plus-installation-os
66 pinebook-installation-os
67 rock64-installation-os
68 rockpro64-installation-os
69 rk3399-puma-installation-os
70 wandboard-installation-os
71 os-with-u-boot))
72
73 ;;; Commentary:
74 ;;;
75 ;;; This module provides an 'operating-system' definition for use on images
76 ;;; for USB sticks etc., for the installation of the GNU system.
77 ;;;
78 ;;; Code:
79
80 \f
81 ;;;
82 ;;; Documentation service.
83 ;;;
84
85 (define %installation-node-names
86 ;; Translated name of the "System Installation" node of the manual. Ideally
87 ;; we'd extract it from the 'guix-manual' gettext domain, but that one is
88 ;; usually not available at run time, hence this hack.
89 '(("de" . "Systeminstallation")
90 ("en" . "System Installation")
91 ("es" . "Instalación del sistema")
92 ("fr" . "Installation du système")
93 ("ru" . "Установка системы")))
94
95 (define (log-to-info tty user)
96 "Return a script that spawns the Info reader on the right section of the
97 manual."
98 (program-file "log-to-info"
99 #~(let* ((tty (open-file #$(string-append "/dev/" tty)
100 "r0+"))
101 (locale (cadr (command-line)))
102 (language (string-take locale
103 (string-index locale #\_)))
104 (infodir "/run/current-system/profile/share/info")
105 (per-lang (string-append infodir "/guix." language
106 ".info.gz"))
107 (file (if (file-exists? per-lang)
108 per-lang
109 (string-append infodir "/guix.info")))
110 (node (or (assoc-ref '#$%installation-node-names
111 language)
112 "System Installation")))
113 (redirect-port tty (current-output-port))
114 (redirect-port tty (current-error-port))
115 (redirect-port tty (current-input-port))
116
117 (let ((pw (getpwnam #$user)))
118 (setgid (passwd:gid pw))
119 (setuid (passwd:uid pw)))
120
121 ;; 'gunzip' is needed to decompress the doc.
122 (setenv "PATH" (string-append #$gzip "/bin"))
123
124 ;; Change this process' locale so that command-line
125 ;; arguments to 'info' are properly encoded.
126 (catch #t
127 (lambda ()
128 (setlocale LC_ALL locale)
129 (setenv "LC_ALL" locale))
130 (lambda _
131 ;; Sometimes LOCALE itself is not available. In that
132 ;; case pick the one UTF-8 locale that's known to work
133 ;; instead of failing.
134 (setlocale LC_ALL "en_US.utf8")
135 (setenv "LC_ALL" "en_US.utf8")))
136
137 (execl #$(file-append info-reader "/bin/info")
138 "info" "-d" infodir "-f" file "-n" node))))
139
140 (define (documentation-shepherd-service tty)
141 (list (shepherd-service
142 (provision (list (symbol-append 'term- (string->symbol tty))))
143 (requirement '(user-processes host-name udev virtual-terminal))
144 (start #~(lambda* (#:optional (locale "en_US.utf8"))
145 (fork+exec-command
146 (list #$(log-to-info tty "documentation") locale)
147 #:environment-variables
148 `("GUIX_LOCPATH=/run/current-system/locale"
149 "TERM=linux"))))
150 (stop #~(make-kill-destructor)))))
151
152 (define %documentation-users
153 ;; User account for the Info viewer.
154 (list (user-account (name "documentation")
155 (system? #t)
156 (group "nogroup")
157 (home-directory "/var/empty"))))
158
159 (define documentation-service-type
160 ;; Documentation viewer service.
161 (service-type (name 'documentation)
162 (extensions
163 (list (service-extension shepherd-root-service-type
164 documentation-shepherd-service)
165 (service-extension account-service-type
166 (const %documentation-users))))
167 (description "Run the Info reader on a tty.")))
168
169 \f
170 (define %backing-directory
171 ;; Sub-directory used as the backing store for copy-on-write.
172 "/tmp/guix-inst")
173
174 (define (make-cow-store target)
175 "Return a gexp that makes the store copy-on-write, using TARGET as the
176 backing store. This is useful when TARGET is on a hard disk, whereas the
177 current store is on a RAM disk."
178
179 (define (set-store-permissions directory)
180 ;; Set the right perms on DIRECTORY to use it as the store.
181 #~(begin
182 (chown #$directory 0 30000) ;use the fixed 'guixbuild' GID
183 (chmod #$directory #o1775)))
184
185 #~(begin
186 ;; Bind-mount TARGET's /tmp in case we need space to build things.
187 (let ((tmpdir (string-append #$target "/tmp")))
188 (mkdir-p tmpdir)
189 (mount tmpdir "/tmp" "none" MS_BIND))
190
191 (let* ((rw-dir (string-append target #$%backing-directory))
192 (work-dir (string-append rw-dir "/../.overlayfs-workdir")))
193 (mkdir-p rw-dir)
194 (mkdir-p work-dir)
195 (mkdir-p "/.rw-store")
196 #$(set-store-permissions #~rw-dir)
197 #$(set-store-permissions "/.rw-store")
198
199 ;; Mount the overlay, then atomically make it the store.
200 (mount "none" "/.rw-store" "overlay" 0
201 (string-append "lowerdir=" #$(%store-prefix) ","
202 "upperdir=" rw-dir ","
203 "workdir=" work-dir))
204 (mount "/.rw-store" #$(%store-prefix) "" MS_MOVE)
205 (rmdir "/.rw-store"))))
206
207 (define cow-store-service-type
208 (shepherd-service-type
209 'cow-store
210 (lambda _
211 (shepherd-service
212 (requirement '(root-file-system user-processes))
213 (provision '(cow-store))
214 (documentation
215 "Make the store copy-on-write, with writes going to \
216 the given target.")
217
218 ;; This is meant to be explicitly started by the user.
219 (auto-start? #f)
220
221 (start #~(case-lambda
222 ((target)
223 #$(make-cow-store #~target)
224 target)
225 (else
226 ;; Do nothing, and mark the service as stopped.
227 #f)))
228 (stop #~(lambda (target)
229 ;; Delete the temporary directory, but leave everything
230 ;; mounted as there may still be processes using it since
231 ;; 'user-processes' doesn't depend on us. The 'user-file-systems'
232 ;; service will unmount TARGET eventually.
233 (delete-file-recursively
234 (string-append target #$%backing-directory))))))))
235
236 (define (cow-store-service)
237 "Return a service that makes the store copy-on-write, such that writes go to
238 the user's target storage device rather than on the RAM disk."
239 ;; See <http://bugs.gnu.org/18061> for the initial report.
240 (service cow-store-service-type 'mooooh!))
241
242
243 (define (/etc/configuration-files _)
244 "Return a list of tuples representing configuration templates to add to
245 /etc."
246 (define directory
247 (computed-file "configuration-templates"
248 (with-imported-modules '((guix build utils))
249 #~(begin
250 (mkdir #$output)
251 (for-each (lambda (file target)
252 (copy-file file
253 (string-append #$output "/"
254 target)))
255 '(#$(local-file "examples/bare-bones.tmpl")
256 #$(local-file "examples/beaglebone-black.tmpl")
257 #$(local-file "examples/desktop.tmpl")
258 #$(local-file "examples/lightweight-desktop.tmpl"))
259 '("bare-bones.scm"
260 "beaglebone-black.scm"
261 "desktop.scm"
262 "lightweight-desktop.scm"))
263 #t))))
264
265 `(("configuration" ,directory)))
266
267 (define configuration-template-service-type
268 (service-type (name 'configuration-template)
269 (extensions
270 (list (service-extension etc-service-type
271 /etc/configuration-files)))))
272
273 (define %configuration-template-service
274 (service configuration-template-service-type #t))
275
276
277 (define %nscd-minimal-caches
278 ;; Minimal in-memory caching policy for nscd.
279 (list (nscd-cache (database 'hosts)
280 (positive-time-to-live (* 3600 12))
281
282 ;; Do not cache lookup failures at all since they are
283 ;; quite likely (for instance when someone tries to ping a
284 ;; host before networking is functional.)
285 (negative-time-to-live 0)
286
287 (persistent? #f)
288 (max-database-size (* 5 (expt 2 20)))))) ;5 MiB
289
290 (define %installation-services
291 ;; List of services of the installation system.
292 (let ((motd (plain-file "motd" "
293 \x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m
294
295 \x1b[2m\
296 Using this shell, you can carry out the installation process \"manually.\"
297 Access documentation at any time by pressing Alt-F2.\x1b[0m
298 ")))
299 (define (normal-tty tty)
300 (mingetty-service (mingetty-configuration (tty tty)
301 (auto-login "root")
302 (login-pause? #t))))
303
304 (define bare-bones-os
305 (load "examples/bare-bones.tmpl"))
306
307 (list (service virtual-terminal-service-type)
308
309 (service kmscon-service-type
310 (kmscon-configuration
311 (virtual-terminal "tty1")
312 (login-program (installer-program))))
313
314 (login-service (login-configuration
315 (motd motd)))
316
317 ;; Documentation. The manual is in UTF-8, but
318 ;; 'console-font-service' sets up Unicode support and loads a font
319 ;; with all the useful glyphs like em dash and quotation marks.
320 (service documentation-service-type "tty2")
321
322 ;; Documentation add-on.
323 %configuration-template-service
324
325 ;; A bunch of 'root' ttys.
326 (normal-tty "tty3")
327 (normal-tty "tty4")
328 (normal-tty "tty5")
329 (normal-tty "tty6")
330
331 ;; The usual services.
332 (syslog-service)
333
334 ;; The build daemon. Register the default substitute server key(s)
335 ;; as trusted to allow the installation process to use substitutes by
336 ;; default.
337 (service guix-service-type
338 (guix-configuration (authorize-key? #t)))
339
340 ;; Start udev so that useful device nodes are available.
341 ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
342 ;; regulations-compliant WiFi access.
343 (udev-service #:rules (list lvm2 crda))
344
345 ;; Add the 'cow-store' service, which users have to start manually
346 ;; since it takes the installation directory as an argument.
347 (cow-store-service)
348
349 ;; Install Unicode support and a suitable font.
350 (service console-font-service-type
351 (map (match-lambda
352 ("tty2"
353 ;; Use a font that contains characters such as
354 ;; curly quotes as found in the manual.
355 '("tty2" . "LatGrkCyr-8x16"))
356 (tty
357 ;; Use a font that doesn't have more than 256
358 ;; glyphs so that we can use colors with varying
359 ;; brightness levels (see note in setfont(8)).
360 `(,tty . "lat9u-16")))
361 '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
362
363 ;; To facilitate copy/paste.
364 (service gpm-service-type)
365
366 ;; Add an SSH server to facilitate remote installs.
367 (service openssh-service-type
368 (openssh-configuration
369 (port-number 22)
370 (permit-root-login #t)
371 ;; The root account is passwordless, so make sure
372 ;; a password is set before allowing logins.
373 (allow-empty-passwords? #f)
374 (password-authentication? #t)
375
376 ;; Don't start it upfront.
377 (%auto-start? #f)))
378
379 ;; Since this is running on a USB stick with a overlayfs as the root
380 ;; file system, use an appropriate cache configuration.
381 (nscd-service (nscd-configuration
382 (caches %nscd-minimal-caches)))
383
384 ;; Having /bin/sh is a good idea. In particular it allows Tramp
385 ;; connections to this system to work.
386 (service special-files-service-type
387 `(("/bin/sh" ,(file-append (canonical-package bash)
388 "/bin/sh"))))
389
390 ;; Loopback device, needed by OpenSSH notably.
391 (service static-networking-service-type
392 (list (static-networking (interface "lo")
393 (ip "127.0.0.1")
394 (requirement '())
395 (provision '(loopback)))))
396
397 (service wpa-supplicant-service-type)
398 (dbus-service)
399 (service connman-service-type
400 (connman-configuration
401 (disable-vpn? #t)))
402
403 ;; Keep a reference to BARE-BONES-OS to make sure it can be
404 ;; installed without downloading/building anything. Also keep the
405 ;; things needed by 'profile-derivation' to minimize the amount of
406 ;; download.
407 (service gc-root-service-type
408 (list bare-bones-os
409 glibc-utf8-locales
410 texinfo
411 (canonical-package guile-2.2))))))
412
413 (define %issue
414 ;; Greeting.
415 "
416 \x1b[1;37mThis is an installation image of the GNU system. Welcome.\x1b[0m
417
418 \x1b[1;33mUse Alt-F2 for documentation.\x1b[0m
419 ")
420
421 (define installation-os
422 ;; The operating system used on installation images for USB sticks etc.
423 (operating-system
424 (host-name "gnu")
425 (timezone "Europe/Paris")
426 (locale "en_US.utf8")
427 (bootloader (bootloader-configuration
428 (bootloader grub-bootloader)
429 (target "/dev/sda")))
430 (label (string-append "GNU Guix installation "
431 (package-version guix)))
432
433 ;; XXX: The AMD Radeon driver is reportedly broken, which makes kmscon
434 ;; non-functional:
435 ;; <https://lists.gnu.org/archive/html/guix-devel/2019-03/msg00441.html>.
436 ;; Thus, blacklist it.
437 (kernel-arguments '("quiet" "modprobe.blacklist=radeon"))
438
439 (file-systems
440 ;; Note: the disk image build code overrides this root file system with
441 ;; the appropriate one.
442 (cons* (file-system
443 (mount-point "/")
444 (device (file-system-label "Guix_image"))
445 (type "ext4"))
446
447 ;; Make /tmp a tmpfs instead of keeping the overlayfs. This
448 ;; originally was used for unionfs because FUSE creates
449 ;; '.fuse_hiddenXYZ' files for each open file, and this confuses
450 ;; Guix's test suite, for instance (see
451 ;; <http://bugs.gnu.org/23056>). We keep this for overlayfs to be
452 ;; on the safe side.
453 (file-system
454 (mount-point "/tmp")
455 (device "none")
456 (type "tmpfs")
457 (check? #f))
458
459 ;; XXX: This should be %BASE-FILE-SYSTEMS but we don't need
460 ;; elogind's cgroup file systems.
461 (list %pseudo-terminal-file-system
462 %shared-memory-file-system
463 %immutable-store)))
464
465 (users (list (user-account
466 (name "guest")
467 (group "users")
468 (supplementary-groups '("wheel")) ; allow use of sudo
469 (password "")
470 (comment "Guest of GNU"))))
471
472 (issue %issue)
473 (services %installation-services)
474
475 ;; We don't need setuid programs, except for 'passwd', which can be handy
476 ;; if one is to allow remote SSH login to the machine being installed.
477 (setuid-programs (list (file-append shadow "/bin/passwd")))
478
479 (pam-services
480 ;; Explicitly allow for empty passwords.
481 (base-pam-services #:allow-empty-passwords? #t))
482
483 (packages (cons* (canonical-package glibc) ;for 'tzselect' & co.
484 parted gptfdisk ddrescue
485 fontconfig
486 font-dejavu font-gnu-unifont
487 grub ;mostly so xrefs to its manual work
488 cryptsetup
489 mdadm
490 dosfstools ;mkfs.fat, for the UEFI boot partition
491 btrfs-progs
492 jfsutils
493 openssh ;we already have sshd, having ssh/scp can help
494 wireless-tools iw wpa-supplicant-minimal iproute
495 ;; XXX: We used to have GNU fdisk here, but as of version
496 ;; 2.0.0a, that pulls Guile 1.8, which takes unreasonable
497 ;; space; furthermore util-linux's fdisk is already
498 ;; available here, so we keep that.
499 bash-completion
500 nvi ;:wq!
501 nss-certs ; To access HTTPS, use git, etc.
502 %base-packages))))
503
504 (define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
505 (triplet "arm-linux-gnueabihf"))
506 "Given OS, amend it with the u-boot bootloader for BOARD,
507 installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
508
509 If you want a serial console, make sure to specify one in your
510 operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
511 (operating-system (inherit os)
512 (bootloader (bootloader-configuration
513 (bootloader (bootloader (inherit u-boot-bootloader)
514 (package (make-u-boot-package board triplet))))
515 (target bootloader-target)))))
516
517 (define* (embedded-installation-os bootloader bootloader-target tty
518 #:key (extra-modules '()))
519 "Return an installation os for embedded systems.
520 The initrd gets the extra modules EXTRA-MODULES.
521 A getty is provided on TTY.
522 The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
523 (operating-system
524 (inherit installation-os)
525 (bootloader (bootloader-configuration
526 (bootloader bootloader)
527 (target bootloader-target)))
528 (kernel linux-libre)
529 (kernel-arguments
530 (cons (string-append "console=" tty)
531 (operating-system-user-kernel-arguments installation-os)))
532 (initrd-modules (append extra-modules %base-initrd-modules))))
533
534 (define beaglebone-black-installation-os
535 (embedded-installation-os u-boot-beaglebone-black-bootloader
536 "/dev/sda"
537 "ttyO0"
538 #:extra-modules
539 ;; This module is required to mount the sd card.
540 '("omap_hsmmc")))
541
542
543 (define a20-olinuxino-lime-installation-os
544 (embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
545 "/dev/mmcblk0" ; SD card storage
546 "ttyS0"))
547
548 (define a20-olinuxino-lime2-emmc-installation-os
549 (embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
550 "/dev/mmcblk1" ; eMMC storage
551 "ttyS0"))
552
553 (define a20-olinuxino-micro-installation-os
554 (embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
555 "/dev/mmcblk0" ; SD card storage
556 "ttyS0"))
557
558 (define bananapi-m2-ultra-installation-os
559 (embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
560 "/dev/mmcblk1" ; eMMC storage
561 "ttyS0"))
562
563 (define firefly-rk3399-installation-os
564 (embedded-installation-os u-boot-firefly-rk3399-bootloader
565 "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
566 "ttyS2")) ; UART2 connected on the Pi2 bus
567
568 (define mx6cuboxi-installation-os
569 (embedded-installation-os u-boot-mx6cuboxi-bootloader
570 "/dev/mmcblk0" ; SD card storage
571 "ttymxc0"))
572
573 (define novena-installation-os
574 (embedded-installation-os u-boot-novena-bootloader
575 "/dev/mmcblk1" ; SD card storage
576 "ttymxc1"))
577
578 (define nintendo-nes-classic-edition-installation-os
579 (embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
580 "/dev/mmcblk0" ; SD card (solder it yourself)
581 "ttyS0"))
582
583 (define pine64-plus-installation-os
584 (embedded-installation-os u-boot-pine64-plus-bootloader
585 "/dev/mmcblk0" ; SD card storage
586 "ttyS0"))
587
588 (define pinebook-installation-os
589 (embedded-installation-os u-boot-pinebook-bootloader
590 "/dev/mmcblk0" ; SD card storage
591 "ttyS0"))
592
593 (define rock64-installation-os
594 (embedded-installation-os u-boot-rock64-rk3328-bootloader
595 "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
596 "ttyS2")) ; UART2 connected on the Pi2 bus
597
598 (define rockpro64-installation-os
599 (embedded-installation-os u-boot-rockpro64-rk3399-bootloader
600 "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
601 "ttyS2")) ; UART2 connected on the Pi2 bus
602
603 (define rk3399-puma-installation-os
604 (embedded-installation-os u-boot-puma-rk3399-bootloader
605 "/dev/mmcblk0" ; SD card storage
606 "ttyS0"))
607
608 (define wandboard-installation-os
609 (embedded-installation-os u-boot-wandboard-bootloader
610 "/dev/mmcblk0" ; SD card storage
611 "ttymxc0"))
612
613 ;; Return the default os here so 'guix system' can consume it directly.
614 installation-os
615
616 ;;; install.scm ends here