projects/guix·blob javascript-team · refs

644 lines · 26.8 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2020 Mathieu Othacehe <[email protected]>
3;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <[email protected]>
4;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <[email protected]>
5;;; Copyright © 2020 Florian Pelz <[email protected]>
6;;; Copyright © 2024 Janneke Nieuwenhuizen <[email protected]>
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 installer)
24 #:use-module (guix build utils)
25 #:use-module (guix derivations)
26 #:use-module (guix discovery)
27 #:use-module (guix gexp)
28 #:use-module (guix modules)
29 #:use-module (guix monads)
30 #:use-module (guix packages)
31 #:use-module (guix store)
32 #:use-module (guix utils)
33 #:use-module (guix ui)
34 #:use-module ((guix self) #:select (make-config.scm))
35 #:use-module (guix describe)
36 #:use-module (guix channels)
37 #:use-module (guix packages)
38 #:use-module (guix git-download)
39 #:use-module (gnu installer utils)
40 #:use-module (gnu packages admin)
41 #:use-module (gnu packages base)
42 #:use-module (gnu packages bash)
43 #:use-module (gnu packages compression)
44 #:use-module (gnu packages connman)
45 #:use-module (gnu packages cryptsetup)
46 #:use-module (gnu packages disk)
47 #:use-module (gnu packages file-systems)
48 #:use-module (gnu packages guile)
49 #:use-module (gnu packages guile-xyz)
50 #:autoload (gnu packages gnupg) (guile-gcrypt)
51 #:use-module (gnu packages iso-codes)
52 #:use-module (gnu packages linux)
53 #:use-module (gnu packages ncurses)
54 #:use-module (gnu packages package-management)
55 #:use-module (gnu packages pciutils)
56 #:use-module (gnu packages text-editors)
57 #:use-module (gnu packages tls)
58 #:use-module (gnu packages xorg)
59 #:use-module (gnu system locale)
60 #:use-module (ice-9 match)
61 #:use-module (srfi srfi-1)
62 #:use-module (web uri)
63 #:export (installer-program
64 installer-steps
65 run-installer))
66
67(define module-to-import?
68 ;; Return true for modules that should be imported. For (gnu system …) and
69 ;; (gnu packages …) modules, we simply add the whole 'guix' package via
70 ;; 'with-extensions' (to avoid having to rebuild it all), which is why these
71 ;; modules are excluded here.
72 (match-lambda
73 (('guix 'config) #f)
74 (('gnu 'installer _ ...) #t)
75 (('gnu 'build _ ...) #t)
76 (('guix 'build _ ...) #t)
77 (('guix 'read-print) #t)
78 (_ #f)))
79
80(define not-config?
81 ;; Select (guix …) and (gnu …) modules, except (guix config).
82 (match-lambda
83 (('guix 'config) #f)
84 (('guix _ ...) #t)
85 (('gnu _ ...) #t)
86 (_ #f)))
87
88(define* (build-compiled-file name locale-builder)
89 "Return a file-like object that evaluates the gexp LOCALE-BUILDER and store
90its result in the scheme file NAME. The derivation will also build a compiled
91version of this file."
92 (define set-utf8-locale
93 #~(begin
94 (setenv "LOCPATH"
95 #$(file-append
96 (libc-utf8-locales-for-target) "/lib/locale/"
97 (version-major+minor
98 (package-version (libc-utf8-locales-for-target)))))
99 (setlocale LC_ALL "en_US.utf8")))
100
101 (define builder
102 (with-extensions (list guile-json-3)
103 (with-imported-modules `(,@(source-module-closure
104 '((gnu installer locale))
105 #:select? not-config?)
106 ((guix config) => ,(make-config.scm)))
107 #~(begin
108 (use-modules (gnu installer locale))
109
110 ;; The locale files contain non-ASCII characters.
111 #$set-utf8-locale
112
113 (mkdir #$output)
114 (let ((locale-file
115 (string-append #$output "/" #$name ".scm"))
116 (locale-compiled-file
117 (string-append #$output "/" #$name ".go")))
118 (call-with-output-file locale-file
119 (lambda (port)
120 (write #$locale-builder port)))
121 (compile-file locale-file
122 #:output-file locale-compiled-file))))))
123 (computed-file name builder))
124
125(define apply-locale
126 ;; Install the specified locale.
127 (with-imported-modules (source-module-closure '((gnu services herd)))
128 #~(lambda (locale)
129 (false-if-exception
130 (setlocale LC_ALL locale))
131
132 ;; Restart the documentation viewer so it displays the manual in
133 ;; language that corresponds to LOCALE. Make sure that nothing is
134 ;; printed on the console.
135 (parameterize ((shepherd-message-port
136 (%make-void-port "w")))
137 (stop-service 'term-tty2)
138 (start-service 'term-tty2 (list locale))))))
139
140(define* (compute-locale-step #:key
141 locales-name
142 iso639-languages-name
143 iso3166-territories-name
144 dry-run?)
145 "Return a gexp that run the locale-page of INSTALLER, and install the
146selected locale. The list of locales, languages and territories passed to
147locale-page are computed in derivations named respectively LOCALES-NAME,
148ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
149so that when the installer is run, all the lengthy operations have already
150been performed at build time."
151 (define (compiled-file-loader file name)
152 #~(load-compiled
153 (string-append #$file "/" #$name ".go")))
154
155 (let* ((supported-locales #~(supported-locales->locales
156 #+(glibc-supported-locales)))
157
158 ;; Note: Use the latest version of 'iso-codes', including
159 ;; Guix-specific changes, so that all languages known to glibc and
160 ;; returned by 'glibc-supported-locales'.
161 (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
162 (iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
163 (iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
164 (iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
165 (locales-file (build-compiled-file
166 locales-name
167 #~`(quote ,#$supported-locales)))
168 (iso639-file (build-compiled-file
169 iso639-languages-name
170 #~`(quote ,(iso639->iso639-languages
171 #$supported-locales
172 #$iso639-3 #$iso639-5))))
173 (iso3166-file (build-compiled-file
174 iso3166-territories-name
175 #~`(quote ,(iso3166->iso3166-territories #$iso3166))))
176 (locales-loader (compiled-file-loader locales-file
177 locales-name))
178 (iso639-loader (compiled-file-loader iso639-file
179 iso639-languages-name))
180 (iso3166-loader (compiled-file-loader iso3166-file
181 iso3166-territories-name)))
182 #~(lambda (current-installer)
183 (let ((result
184 ((installer-locale-page current-installer)
185 #:supported-locales #$locales-loader
186 #:iso639-languages #$iso639-loader
187 #:iso3166-territories #$iso3166-loader
188 #:dry-run? #$dry-run?)))
189 (if #$dry-run?
190 '()
191 (#$apply-locale result))
192 result))))
193
194(define apply-keymap
195 ;; Apply the specified keymap. Use the default keyboard model.
196 #~(match-lambda
197 ((layout variant options)
198 (kmscon-update-keymap (default-keyboard-model)
199 layout variant options))))
200
201(define (compute-keymap-step context dry-run?)
202 "Return a gexp that runs the keymap-page of INSTALLER and install the
203selected keymap."
204 #~(lambda (current-installer)
205 (let ((result
206 (call-with-values
207 (lambda ()
208 (xkb-rules->models+layouts
209 (string-append #$xkeyboard-config
210 "/share/X11/xkb/rules/base.xml")))
211 (lambda (models layouts)
212 ((installer-keymap-page current-installer)
213 layouts '#$context #$dry-run?)))))
214 (and result (#$apply-keymap result))
215 result)))
216
217(define* (installer-steps #:key dry-run?)
218 (let ((locale-step (compute-locale-step
219 #:locales-name "locales"
220 #:iso639-languages-name "iso639-languages"
221 #:iso3166-territories-name "iso3166-territories"
222 #:dry-run? dry-run?))
223 (timezone-data #~(string-append #$tzdata
224 "/share/zoneinfo/zone.tab")))
225 #~(lambda (current-installer)
226 ((installer-parameters-menu current-installer)
227 (lambda ()
228 ((installer-parameters-page current-installer)
229 (lambda _
230 (#$(compute-keymap-step 'param dry-run?)
231 current-installer)))))
232 (list
233 ;; Ask the user to choose a locale among those supported by
234 ;; the glibc. Install the selected locale right away, so that
235 ;; the user may benefit from any available translation for the
236 ;; installer messages.
237 (installer-step
238 (id 'locale)
239 (description (G_ "Locale"))
240 (compute (lambda _
241 (#$locale-step current-installer)))
242 (configuration-formatter locale->configuration))
243
244 ;; Welcome the user and ask them to choose between manual
245 ;; installation and graphical install.
246 (installer-step
247 (id 'welcome)
248 (compute (lambda _
249 ((installer-welcome-page current-installer)
250 #$(local-file "installer/aux-files/logo.txt")
251 #:pci-database
252 #$(file-append pciutils "/share/hwdata/pci.ids.gz")))))
253
254 ;; Ask the user to select a timezone under glibc format.
255 (installer-step
256 (id 'timezone)
257 (description (G_ "Timezone"))
258 (compute (lambda _
259 ((installer-timezone-page current-installer)
260 #$timezone-data)))
261 (configuration-formatter posix-tz->configuration))
262
263 ;; The installer runs in a kmscon virtual terminal where loadkeys
264 ;; won't work. kmscon uses libxkbcommon as a backend for keyboard
265 ;; input. It is possible to update kmscon current keymap by sending
266 ;; it a keyboard model, layout, variant and options, in a somehow
267 ;; similar way as what is done with setxkbmap utility.
268 ;;
269 ;; So ask for a keyboard model, layout and variant to update the
270 ;; current kmscon keymap. For non-Latin layouts, we add an
271 ;; appropriate second layout and toggle via Alt+Shift.
272 (installer-step
273 (id 'keymap)
274 (description (G_ "Keyboard mapping selection"))
275 (compute (lambda _
276 (if #$dry-run?
277 '("en" "US" #f)
278 (#$(compute-keymap-step 'default dry-run?)
279 current-installer))))
280 (configuration-formatter keyboard-layout->configuration))
281
282 ;; Ask the user to input a hostname for the system.
283 (installer-step
284 (id 'hostname)
285 (description (G_ "Hostname"))
286 (compute (lambda _
287 ((installer-hostname-page current-installer))))
288 (configuration-formatter hostname->configuration))
289
290 ;; Provide an interface above connmanctl, so that the user can select
291 ;; a network susceptible to acces Internet.
292 (installer-step
293 (id 'network)
294 (description (G_ "Network selection"))
295 (compute (lambda _
296 (if #$dry-run?
297 '()
298 ((installer-network-page current-installer))))))
299
300 ;; Ask whether to enable substitute server discovery.
301 (installer-step
302 (id 'substitutes)
303 (description (G_ "Substitute server discovery"))
304 (compute (lambda _
305 (if #$dry-run?
306 '()
307 ((installer-substitutes-page current-installer))))))
308
309 ;; Prompt for users (name, group and home directory).
310 (installer-step
311 (id 'user)
312 (description (G_ "User creation"))
313 (compute (lambda _
314 ((installer-user-page current-installer))))
315 (configuration-formatter users->configuration))
316
317 ;; Ask the user to select the kernel for the system,
318 ;; for x86 systems only.
319 (installer-step
320 (id 'kernel)
321 (description (G_ "Kernel"))
322 (compute (lambda _
323 (if (target-x86?)
324 ((installer-kernel-page current-installer))
325 '())))
326 (configuration-formatter (lambda (result)
327 (kernel->configuration result #$dry-run?))))
328
329 ;; Ask the user to choose one or many desktop environment(s).
330 (installer-step
331 (id 'services)
332 (description (G_ "Services"))
333 (compute (lambda _
334 ((installer-services-page current-installer))))
335 (configuration-formatter system-services->configuration))
336
337 ;; Run a partitioning tool allowing the user to modify
338 ;; partition tables, partitions and their mount points.
339 ;; Do this last so the user has something to boot if any
340 ;; of the previous steps didn't go as expected.
341 (installer-step
342 (id 'partition)
343 (description (G_ "Partitioning"))
344 (compute (lambda _
345 (if #$dry-run?
346 '()
347 ((installer-partitioning-page current-installer)))))
348 (configuration-formatter user-partitions->configuration))
349
350 (installer-step
351 (id 'final)
352 (description (G_ "Configuration file"))
353 (compute
354 (lambda (result prev-steps)
355 ((installer-final-page current-installer)
356 result prev-steps #$dry-run?))))))))
357
358(define (provenance-sexp)
359 "Return an sexp representing the currently-used channels, for logging
360purposes."
361 (match (match (current-channels)
362 (() (and=> (repository->guix-channel (dirname (current-filename)))
363 list))
364 (channels channels))
365 (#f
366 (warning (G_ "cannot determine installer provenance~%"))
367 'unknown)
368 ((channels ...)
369 (map (lambda (channel)
370 ;; NOTE: URL is not logged to synchronize the derivations
371 ;; coming out of pre-inst-env, time-machine and Cuirass
372 ;; for generating release artifacts.
373 `(channel ,(channel-name channel) ,(channel-commit channel)))
374 channels))))
375
376(define* (installer-program #:key dry-run? (guix-for-installer (current-guix)))
377 "Return a file-like object that runs the given INSTALLER."
378 (define init-gettext
379 ;; Initialize gettext support, so that installer messages can be
380 ;; translated.
381 #~(begin
382 (bindtextdomain "guix" (string-append #$guix "/share/locale"))
383 (textdomain "guix")
384 (setlocale LC_ALL "")))
385
386 (define set-installer-path
387 ;; Add the specified binary to PATH for later use by the installer.
388 #~(let* ((inputs
389 '#$(list bash ;start subshells
390 connman ;call connmanctl
391 cryptsetup
392 dosfstools ;mkfs.fat
393 e2fsprogs ;mkfs.ext4
394 lvm2-static ;dmsetup
395 btrfs-progs
396 jfsutils ;jfs_mkfs
397 ntfs-3g ;mkfs.ntfs
398 xfsprogs ;mkfs.xfs
399 kbd ;chvt
400 util-linux ;mkwap
401 nano
402 shadow
403 tar ;dump
404 gzip ;dump
405 coreutils)))
406 (with-output-to-port (%make-void-port "w")
407 (lambda ()
408 (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
409
410 (define steps (installer-steps #:dry-run? dry-run?))
411 (define modules
412 (scheme-modules*
413 (string-append (current-source-directory) "/..")
414 "gnu/installer"))
415
416 (define installer-builder
417 ;; Note: Include GUIX as an extension to get all the (gnu system …), (gnu
418 ;; packages …), etc. modules.
419 (with-extensions (list guile-gcrypt guile-newt
420 guile-parted guile-bytestructures
421 guile-json-3 guile-git guile-webutils
422 guile-gnutls
423 guile-zlib ;for (gnu build linux-modules)
424 guile-zstd ;for (gnu build linux-modules)
425 guix-for-installer)
426 (with-imported-modules `(,@(source-module-closure
427 `(,@modules
428 (gnu services herd)
429 (guix build utils))
430 #:select? module-to-import?)
431 ((guix config) => ,(make-config.scm)))
432 #~(begin
433 (use-modules (gnu installer record)
434 (gnu installer keymap)
435 (gnu installer steps)
436 (gnu installer dump)
437 (gnu installer final)
438 (gnu installer hostname)
439 (gnu installer kernel)
440 (gnu installer locale)
441 (gnu installer parted)
442 (gnu installer services)
443 (gnu installer timezone)
444 (gnu installer user)
445 (gnu installer utils)
446 (gnu installer newt)
447 ((gnu installer newt keymap)
448 #:select (keyboard-layout->configuration))
449 (gnu services herd)
450 (guix i18n)
451 (guix build utils)
452 (guix utils)
453 ((system repl debug)
454 #:select (terminal-width))
455 (ice-9 match)
456 (ice-9 textual-ports))
457
458 ;; Enable core dump generation.
459 (setrlimit 'core #f #f)
460 (unless #$dry-run?
461 (call-with-output-file "/proc/sys/kernel/core_pattern"
462 (lambda (port)
463 (format port %core-dump))))
464
465 ;; Initialize gettext support so that installers can use
466 ;; (guix i18n) module.
467 #$init-gettext
468
469 ;; Add some binaries used by the installers to PATH.
470 #$set-installer-path
471
472 ;; Arrange for language and territory name translations to be
473 ;; available. We need them at run time, not just compile time,
474 ;; because some territories have several corresponding languages
475 ;; (e.g., "French" is always displayed as "français", but
476 ;; "Belgium" could be translated to Dutch, French, or German.)
477 (bindtextdomain "iso_639-3" ;languages
478 #+(file-append iso-codes "/share/locale"))
479 (bindtextdomain "iso_3166-1" ;territories
480 #+(file-append iso-codes "/share/locale"))
481
482 ;; Likewise for XKB keyboard layout names.
483 (bindtextdomain "xkeyboard-config"
484 #+(file-append xkeyboard-config "/share/locale"))
485
486 ;; Initialize 'terminal-width' in (system repl debug)
487 ;; to a large-enough value to make backtrace more
488 ;; verbose.
489 (terminal-width 200)
490
491 (define current-installer newt-installer)
492 (define steps (#$steps current-installer))
493
494 (installer-log-line "installer provenance: ~s"
495 '#$(provenance-sexp))
496
497 (dynamic-wind
498 (installer-init current-installer)
499 (lambda ()
500 (parameterize
501 ((%run-command-in-installer
502 (if #$dry-run?
503 dry-run-command
504 (installer-run-command current-installer))))
505 (catch #t
506 (lambda ()
507 (define results
508 (run-installer-steps
509 #:rewind-strategy 'menu
510 #:menu-proc (installer-menu-page current-installer)
511 #:steps steps
512 #:dry-run? #$dry-run?))
513
514 (let ((result (result-step results 'final)))
515 (unless #$dry-run?
516 (match (result-step results 'final)
517 ('success
518 ;; We did it! Let's reboot!
519 (sync)
520 (stop-service 'root))
521 (_
522 ;; The installation failed, exit so that it is
523 ;; restarted by login.
524 #f)))))
525 (const #f)
526 (lambda (key . args)
527 (installer-log-line "crashing due to uncaught exception: ~s ~s"
528 key args)
529 (define dump-dir
530 (prepare-dump key args #:result %current-result))
531
532 (define user-abort?
533 (match args
534 (((? user-abort-error? obj)) #t)
535 (_ #f)))
536
537 (define action
538 (if user-abort?
539 'dump
540 ((installer-exit-error current-installer)
541 (get-string-all
542 (open-input-file
543 (string-append dump-dir
544 "/installer-backtrace"))))))
545
546 (match action
547 ('dump
548 (let* ((dump-files
549 ((installer-dump-page current-installer)
550 dump-dir))
551 (dump-archive
552 (make-dump dump-dir dump-files)))
553 ((installer-report-page current-installer)
554 dump-archive)))
555 (_ #f))
556 (exit 1)))))
557
558 (installer-exit current-installer))))))
559
560 (program-file
561 "installer"
562 #~(begin
563 ;; Set the default locale to install unicode support. For
564 ;; some reason, unicode support is not correctly installed
565 ;; when calling this in 'installer-builder'.
566 (setenv "LANG" "en_US.UTF-8")
567 (execl #$(program-file "installer-real" installer-builder
568 #:guile guile-3.0-latest)
569 "installer-real"))))
570
571(define* (installer-script #:key dry-run?
572 (steps (installer-steps #:dry-run? dry-run?)))
573 (program-file
574 "installer-script"
575 #~(begin
576 (use-modules (gnu installer)
577 (gnu installer record)
578 (gnu installer keymap)
579 (gnu installer steps)
580 (gnu installer dump)
581 (gnu installer final)
582 (gnu installer hostname)
583 (gnu installer kernel)
584 (gnu installer locale)
585 (gnu installer parted)
586 (gnu installer services)
587 (gnu installer timezone)
588 (gnu installer user)
589 (gnu installer utils)
590 (gnu installer newt)
591 ((gnu installer newt keymap)
592 #:select (keyboard-layout->configuration))
593 (gnu services herd)
594 (guix i18n)
595 (guix build utils)
596 (guix utils)
597 ((system repl debug)
598 #:select (terminal-width))
599 (ice-9 match)
600 (ice-9 textual-ports))
601 (terminal-width 200)
602 (let* ((current-installer newt-installer)
603 (steps (#$steps current-installer)))
604 (catch #t
605 (lambda _
606 ((installer-init current-installer))
607 (parameterize ((%run-command-in-installer
608 (if #$dry-run?
609 dry-run-command
610 (installer-run-command current-installer)))
611 (%installer-configuration-file
612 (if #$dry-run?
613 "config.scm"
614 (%installer-configuration-file))))
615 (let ((results (run-installer-steps
616 #:rewind-strategy 'menu
617 #:menu-proc
618 (installer-menu-page current-installer)
619 #:steps steps
620 #:dry-run? #$dry-run?)))
621 (result-step results 'final)
622 ((installer-exit current-installer)))))
623 (const #f)
624 (lambda (key . args)
625 (sleep 10)
626 ((installer-exit current-installer))
627 (display-backtrace (make-stack #t) (current-error-port))
628 (apply throw key args)))))))
629
630(define* (run-installer #:key dry-run?)
631 "To run the installer from Guile without building it:
632 ./pre-inst-env guile -c '((@ (gnu installer) run-installer) #:dry-run? #t)'
633when using #:dry-run? #t, no root access is required and the LOCALE, KEYMAP,
634and PARTITION pages are skipped."
635 (let* ((script (installer-script #:dry-run? dry-run?))
636 (store (open-connection))
637 (drv (run-with-store store
638 (lower-object script)))
639 (program (match (derivation->output-paths drv)
640 ((("out" . program)) program)))
641 (outputs (build-derivations store (list drv))))
642 (close-connection store)
643 (format #t "running installer: ~a\n" program)
644 (invoke "guile" program)))