[jackhill/guix/guix.git] / gnu / installer.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer)
  #:use-module (guix discovery)
  #:use-module (guix packages)
  #:use-module (guix gexp)
  #:use-module (guix modules)
  #:use-module (guix utils)
  #:use-module (guix ui)
  #:use-module ((guix self) #:select (make-config.scm))
  #:use-module (gnu installer utils)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages connman)
  #:use-module (gnu packages cryptsetup)
  #:use-module (gnu packages disk)
  #:use-module (gnu packages file-systems)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages guile-xyz)
  #:autoload   (gnu packages gnupg) (guile-gcrypt)
  #:use-module (gnu packages iso-codes)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages ncurses)
  #:use-module (gnu packages package-management)
  #:use-module (gnu packages xorg)
  #:use-module (gnu system locale)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (installer-program))

(define module-to-import?
  ;; Return true for modules that should be imported.  For (gnu system …) and
  ;; (gnu packages …) modules, we simply add the whole 'guix' package via
  ;; 'with-extensions' (to avoid having to rebuild it all), which is why these
  ;; modules are excluded here.
  (match-lambda
    (('guix 'config) #f)
    (('gnu 'installer _ ...) #t)
    (('gnu 'build _ ...) #t)
    (('guix 'build _ ...) #t)
    (_ #f)))

(define* (build-compiled-file name locale-builder)
  "Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
its result in the scheme file NAME. The derivation will also build a compiled
version of this file."
  (define set-utf8-locale
    #~(begin
        (setenv "LOCPATH"
                #$(file-append glibc-utf8-locales "/lib/locale/"
                               (version-major+minor
                                (package-version glibc-utf8-locales))))
        (setlocale LC_ALL "en_US.utf8")))

  (define builder
    (with-extensions (list guile-json-3)
      (with-imported-modules (source-module-closure
                              '((gnu installer locale)))
        #~(begin
            (use-modules (gnu installer locale))

            ;; The locale files contain non-ASCII characters.
            #$set-utf8-locale

            (mkdir #$output)
            (let ((locale-file
                   (string-append #$output "/" #$name ".scm"))
                  (locale-compiled-file
                   (string-append #$output "/" #$name ".go")))
              (call-with-output-file locale-file
                (lambda (port)
                  (write #$locale-builder port)))
              (compile-file locale-file
                            #:output-file locale-compiled-file))))))
  (computed-file name builder))

(define apply-locale
  ;; Install the specified locale.
  (with-imported-modules (source-module-closure '((gnu services herd)))
    #~(lambda (locale)
        (false-if-exception
         (setlocale LC_ALL locale))

        ;; Restart the documentation viewer so it displays the manual in
        ;; language that corresponds to LOCALE.
        (with-error-to-port (%make-void-port "w")
          (lambda ()
            (stop-service 'term-tty2)
            (start-service 'term-tty2 (list locale)))))))

(define* (compute-locale-step #:key
                              locales-name
                              iso639-languages-name
                              iso3166-territories-name)
  "Return a gexp that run the locale-page of INSTALLER, and install the
selected locale. The list of locales, languages and territories passed to
locale-page are computed in derivations named respectively LOCALES-NAME,
ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
so that when the installer is run, all the lengthy operations have already
been performed at build time."
  (define (compiled-file-loader file name)
    #~(load-compiled
       (string-append #$file "/" #$name ".go")))

  (let* ((supported-locales #~(supported-locales->locales
                               #+(glibc-supported-locales)))
         (iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
         (iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
         (iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
         (iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
         (locales-file (build-compiled-file
                        locales-name
                        #~`(quote ,#$supported-locales)))
         (iso639-file (build-compiled-file
                       iso639-languages-name
                       #~`(quote ,(iso639->iso639-languages
                                   #$supported-locales
                                   #$iso639-3 #$iso639-5))))
         (iso3166-file (build-compiled-file
                        iso3166-territories-name
                        #~`(quote ,(iso3166->iso3166-territories #$iso3166))))
         (locales-loader (compiled-file-loader locales-file
                                               locales-name))
         (iso639-loader (compiled-file-loader iso639-file
                                              iso639-languages-name))
         (iso3166-loader (compiled-file-loader iso3166-file
                                               iso3166-territories-name)))
    #~(lambda (current-installer)
        (let ((result
               ((installer-locale-page current-installer)
                #:supported-locales #$locales-loader
                #:iso639-languages #$iso639-loader
                #:iso3166-territories #$iso3166-loader)))
          (#$apply-locale result)
          result))))

(define apply-keymap
  ;; Apply the specified keymap. Use the default keyboard model.
  #~(match-lambda
      ((layout variant)
       (kmscon-update-keymap (default-keyboard-model)
                             layout variant))))

(define* (compute-keymap-step)
  "Return a gexp that runs the keymap-page of INSTALLER and install the
selected keymap."
  #~(lambda (current-installer)
      (let ((result
             (call-with-values
                 (lambda ()
                   (xkb-rules->models+layouts
                    (string-append #$xkeyboard-config
                                   "/share/X11/xkb/rules/base.xml")))
               (lambda (models layouts)
                 ((installer-keymap-page current-installer)
                  layouts)))))
        (#$apply-keymap result)
        result)))

(define (installer-steps)
  (let ((locale-step (compute-locale-step
                      #:locales-name "locales"
                      #:iso639-languages-name "iso639-languages"
                      #:iso3166-territories-name "iso3166-territories"))
        (keymap-step (compute-keymap-step))
        (timezone-data #~(string-append #$tzdata
                                        "/share/zoneinfo/zone.tab")))
    #~(lambda (current-installer)
        (list
         ;; Ask the user to choose a locale among those supported by
         ;; the glibc.  Install the selected locale right away, so that
         ;; the user may benefit from any available translation for the
         ;; installer messages.
         (installer-step
          (id 'locale)
          (description (G_ "Locale"))
          (compute (lambda _
                     (#$locale-step current-installer)))
          (configuration-formatter locale->configuration))

         ;; Welcome the user and ask them to choose between manual
         ;; installation and graphical install.
         (installer-step
          (id 'welcome)
          (compute (lambda _
                     ((installer-welcome-page current-installer)
                      #$(local-file "installer/aux-files/logo.txt")))))

         ;; Ask the user to select a timezone under glibc format.
         (installer-step
          (id 'timezone)
          (description (G_ "Timezone"))
          (compute (lambda _
                     ((installer-timezone-page current-installer)
                      #$timezone-data)))
          (configuration-formatter posix-tz->configuration))

         ;; The installer runs in a kmscon virtual terminal where loadkeys
         ;; won't work. kmscon uses libxkbcommon as a backend for keyboard
         ;; input. It is possible to update kmscon current keymap by sending it
         ;; a keyboard model, layout and variant, in a somehow similar way as
         ;; what is done with setxkbmap utility.
         ;;
         ;; So ask for a keyboard model, layout and variant to update the
         ;; current kmscon keymap.
         (installer-step
          (id 'keymap)
          (description (G_ "Keyboard mapping selection"))
          (compute (lambda _
                     (#$keymap-step current-installer)))
          (configuration-formatter keyboard-layout->configuration))

         ;; Ask the user to input a hostname for the system.
         (installer-step
          (id 'hostname)
          (description (G_ "Hostname"))
          (compute (lambda _
                     ((installer-hostname-page current-installer))))
          (configuration-formatter hostname->configuration))

         ;; Provide an interface above connmanctl, so that the user can select
         ;; a network susceptible to acces Internet.
         (installer-step
          (id 'network)
          (description (G_ "Network selection"))
          (compute (lambda _
                     ((installer-network-page current-installer)))))

         ;; Prompt for users (name, group and home directory).
         (installer-step
          (id 'user)
          (description (G_ "User creation"))
          (compute (lambda _
                     ((installer-user-page current-installer))))
          (configuration-formatter users->configuration))

         ;; Ask the user to choose one or many desktop environment(s).
         (installer-step
          (id 'services)
          (description (G_ "Services"))
          (compute (lambda _
                     ((installer-services-page current-installer))))
	  (configuration-formatter system-services->configuration))

         ;; Run a partitioning tool allowing the user to modify
         ;; partition tables, partitions and their mount points.
         ;; Do this last so the user has something to boot if any
         ;; of the previous steps didn't go as expected.
         (installer-step
          (id 'partition)
          (description (G_ "Partitioning"))
          (compute (lambda _
                     ((installer-partition-page current-installer))))
          (configuration-formatter user-partitions->configuration))

	 (installer-step
          (id 'final)
          (description (G_ "Configuration file"))
          (compute
           (lambda (result prev-steps)
             ((installer-final-page current-installer)
              result prev-steps))))))))

(define (installer-program)
  "Return a file-like object that runs the given INSTALLER."
  (define init-gettext
    ;; Initialize gettext support, so that installer messages can be
    ;; translated.
    #~(begin
        (bindtextdomain "guix" (string-append #$guix "/share/locale"))
        (textdomain "guix")))

  (define set-installer-path
    ;; Add the specified binary to PATH for later use by the installer.
    #~(let* ((inputs
              '#$(append (list bash ;start subshells
                               connman ;call connmanctl
                               cryptsetup
                               dosfstools ;mkfs.fat
                               e2fsprogs ;mkfs.ext4
                               btrfs-progs ;mkfs.btrfs
                               jfsutils ;jfs_mkfs
                               kbd ;chvt
                               guix ;guix system init call
                               util-linux ;mkwap
                               shadow)
                         (map canonical-package (list coreutils)))))
        (with-output-to-port (%make-void-port "w")
          (lambda ()
            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))

  (define steps (installer-steps))
  (define modules
    (scheme-modules*
     (string-append (current-source-directory) "/..")
     "gnu/installer"))

  (define installer-builder
    ;; Note: Include GUIX as an extension to get all the (gnu system …), (gnu
    ;; packages …), etc. modules.
    (with-extensions (list guile-gcrypt guile-newt
                           guile-parted guile-bytestructures
                           guile-json-3 guile-git guix)
      (with-imported-modules `(,@(source-module-closure
                                  `(,@modules
                                    (gnu services herd)
                                    (guix build utils))
                                  #:select? module-to-import?)
                               ((guix config) => ,(make-config.scm)))
        #~(begin
            (use-modules (gnu installer record)
                         (gnu installer keymap)
                         (gnu installer steps)
                         (gnu installer final)
                         (gnu installer hostname)
                         (gnu installer locale)
                         (gnu installer parted)
                         (gnu installer services)
                         (gnu installer timezone)
                         (gnu installer user)
                         (gnu installer newt)
                         ((gnu installer newt keymap)
                          #:select (keyboard-layout->configuration))
                         (gnu services herd)
                         (guix i18n)
                         (guix build utils)
                         ((system repl debug)
                          #:select (terminal-width))
                         (ice-9 match))

            ;; Initialize gettext support so that installers can use
            ;; (guix i18n) module.
            #$init-gettext

            ;; Add some binaries used by the installers to PATH.
            #$set-installer-path

            ;; Arrange for language and territory name translations to be
            ;; available.  We need them at run time, not just compile time,
            ;; because some territories have several corresponding languages
            ;; (e.g., "French" is always displayed as "français", but
            ;; "Belgium" could be translated to Dutch, French, or German.)
            (bindtextdomain "iso_639-3"           ;languages
                            #+(file-append iso-codes "/share/locale"))
            (bindtextdomain "iso_3166-1"          ;territories
                            #+(file-append iso-codes "/share/locale"))

            ;; Likewise for XKB keyboard layout names.
            (bindtextdomain "xkeyboard-config"
                            #+(file-append xkeyboard-config "/share/locale"))

            ;; Initialize 'terminal-width' in (system repl debug)
            ;; to a large-enough value to make backtrace more
            ;; verbose.
            (terminal-width 200)

            (let* ((current-installer newt-installer)
                   (steps (#$steps current-installer)))
              ((installer-init current-installer))

              (catch #t
                (lambda ()
                  (define results
                    (run-installer-steps
                     #:rewind-strategy 'menu
                     #:menu-proc (installer-menu-page current-installer)
                     #:steps steps))

                  (match (result-step results 'final)
                    ('success
                     ;; We did it!  Let's reboot!
                     (sync)
                     (stop-service 'root))
                    (_
                     ;; The installation failed, exit so that it is restarted
                     ;; by login.
                     #f)))
                (const #f)
                (lambda (key . args)
                  (syslog "crashing due to uncaught exception: ~s ~s~%"
                          key args)
                  (let ((error-file "/tmp/last-installer-error"))
                    (call-with-output-file error-file
                      (lambda (port)
                        (display-backtrace (make-stack #t) port)
                        (print-exception port
                                         (stack-ref (make-stack #t) 1)
                                         key args)))
                    ((installer-exit-error current-installer)
                     error-file key args))
                  (primitive-exit 1)))

              ((installer-exit current-installer)))))))

  (program-file
   "installer"
   #~(begin
       ;; Set the default locale to install unicode support.  For
       ;; some reason, unicode support is not correctly installed
       ;; when calling this in 'installer-builder'.
       (setenv "LANG" "en_US.UTF-8")
       (execl #$(program-file "installer-real" installer-builder)
              "installer-real"))))
Commit	Line	Data
d0f3a672	1	;;; GNU Guix --- Functional package management for GNU
d008352b	2	;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
5c04b00c	3	;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
8fec416c	4	;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
d0f3a672 MO	5	;;;
	6	;;; This file is part of GNU Guix.
	7	;;;
	8	;;; GNU Guix is free software; you can redistribute it and/or modify it
	9	;;; under the terms of the GNU General Public License as published by
	10	;;; the Free Software Foundation; either version 3 of the License, or (at
	11	;;; your option) any later version.
	12	;;;
	13	;;; GNU Guix is distributed in the hope that it will be useful, but
	14	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	15	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	16	;;; GNU General Public License for more details.
	17	;;;
	18	;;; You should have received a copy of the GNU General Public License
	19	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	20
	21	(define-module (gnu installer)
69a934f2	22	#:use-module (guix discovery)
a49d633c MO	23	#:use-module (guix packages)
	24	#:use-module (guix gexp)
	25	#:use-module (guix modules)
	26	#:use-module (guix utils)
d0f3a672	27	#:use-module (guix ui)
a49d633c	28	#:use-module ((guix self) #:select (make-config.scm))
5c04b00c	29	#:use-module (gnu installer utils)
a49d633c MO	30	#:use-module (gnu packages admin)
	31	#:use-module (gnu packages base)
	32	#:use-module (gnu packages bash)
	33	#:use-module (gnu packages connman)
bf304dbc	34	#:use-module (gnu packages cryptsetup)
69a934f2	35	#:use-module (gnu packages disk)
8fec416c	36	#:use-module (gnu packages file-systems)
a49d633c	37	#:use-module (gnu packages guile)
0791437f	38	#:use-module (gnu packages guile-xyz)
a49d633c MO	39	#:autoload (gnu packages gnupg) (guile-gcrypt)
	40	#:use-module (gnu packages iso-codes)
	41	#:use-module (gnu packages linux)
	42	#:use-module (gnu packages ncurses)
	43	#:use-module (gnu packages package-management)
	44	#:use-module (gnu packages xorg)
76269f6b	45	#:use-module (gnu system locale)
a49d633c	46	#:use-module (ice-9 match)
d0f3a672	47	#:use-module (srfi srfi-1)
a49d633c	48	#:export (installer-program))
d0f3a672	49
50247be5 LC	50	(define module-to-import?
	51	;; Return true for modules that should be imported. For (gnu system …) and
	52	;; (gnu packages …) modules, we simply add the whole 'guix' package via
	53	;; 'with-extensions' (to avoid having to rebuild it all), which is why these
	54	;; modules are excluded here.
a49d633c MO	55	(match-lambda
a49d633c MO	56	(('guix 'config) #f)
50247be5 LC	57	(('gnu 'installer _ ...) #t)
	58	(('gnu 'build _ ...) #t)
	59	(('guix 'build _ ...) #t)
	60	(_ #f)))
a49d633c MO	61
	62	(define* (build-compiled-file name locale-builder)
	63	"Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
	64	its result in the scheme file NAME. The derivation will also build a compiled
	65	version of this file."
	66	(define set-utf8-locale
	67	#~(begin
	68	(setenv "LOCPATH"
	69	#$(file-append glibc-utf8-locales "/lib/locale/"
	70	(version-major+minor
	71	(package-version glibc-utf8-locales))))
	72	(setlocale LC_ALL "en_US.utf8")))
	73
	74	(define builder
81c3dc32	75	(with-extensions (list guile-json-3)
a49d633c MO	76	(with-imported-modules (source-module-closure
	77	'((gnu installer locale)))
	78	#~(begin
	79	(use-modules (gnu installer locale))
	80
	81	;; The locale files contain non-ASCII characters.
	82	#$set-utf8-locale
	83
	84	(mkdir #$output)
	85	(let ((locale-file
	86	(string-append #$output "/" #$name ".scm"))
	87	(locale-compiled-file
	88	(string-append #$output "/" #$name ".go")))
	89	(call-with-output-file locale-file
	90	(lambda (port)
	91	(write #$locale-builder port)))
	92	(compile-file locale-file
	93	#:output-file locale-compiled-file))))))
	94	(computed-file name builder))
	95
	96	(define apply-locale
	97	;; Install the specified locale.
c7dc6042 LC	98	(with-imported-modules (source-module-closure '((gnu services herd)))
	99	#~(lambda (locale)
	100	(false-if-exception
	101	(setlocale LC_ALL locale))
	102
	103	;; Restart the documentation viewer so it displays the manual in
	104	;; language that corresponds to LOCALE.
	105	(with-error-to-port (%make-void-port "w")
	106	(lambda ()
	107	(stop-service 'term-tty2)
	108	(start-service 'term-tty2 (list locale)))))))
a49d633c MO	109
	110	(define* (compute-locale-step #:key
	111	locales-name
	112	iso639-languages-name
	113	iso3166-territories-name)
	114	"Return a gexp that run the locale-page of INSTALLER, and install the
	115	selected locale. The list of locales, languages and territories passed to
	116	locale-page are computed in derivations named respectively LOCALES-NAME,
	117	ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
	118	so that when the installer is run, all the lengthy operations have already
	119	been performed at build time."
	120	(define (compiled-file-loader file name)
	121	#~(load-compiled
	122	(string-append #$file "/" #$name ".go")))
	123
	124	(let* ((supported-locales #~(supported-locales->locales
76269f6b	125	#+(glibc-supported-locales)))
a49d633c MO	126	(iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
	127	(iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
	128	(iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
	129	(iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
	130	(locales-file (build-compiled-file
	131	locales-name
	132	#~`(quote ,#$supported-locales)))
	133	(iso639-file (build-compiled-file
	134	iso639-languages-name
	135	#~`(quote ,(iso639->iso639-languages
	136	#$supported-locales
	137	#$iso639-3 #$iso639-5))))
	138	(iso3166-file (build-compiled-file
	139	iso3166-territories-name
	140	#~`(quote ,(iso3166->iso3166-territories #$iso3166))))
	141	(locales-loader (compiled-file-loader locales-file
	142	locales-name))
	143	(iso639-loader (compiled-file-loader iso639-file
	144	iso639-languages-name))
	145	(iso3166-loader (compiled-file-loader iso3166-file
	146	iso3166-territories-name)))
	147	#~(lambda (current-installer)
	148	(let ((result
	149	((installer-locale-page current-installer)
	150	#:supported-locales #$locales-loader
	151	#:iso639-languages #$iso639-loader
	152	#:iso3166-territories #$iso3166-loader)))
dc5f3275 MO	153	(#$apply-locale result)
dc5f3275 MO	154	result))))
a49d633c MO	155
a49d633c MO	156	(define apply-keymap
c088b2e4	157	;; Apply the specified keymap. Use the default keyboard model.
a49d633c	158	#~(match-lambda
c088b2e4 MO	159	((layout variant)
	160	(kmscon-update-keymap (default-keyboard-model)
	161	layout variant))))
a49d633c MO	162
	163	(define* (compute-keymap-step)
	164	"Return a gexp that runs the keymap-page of INSTALLER and install the
	165	selected keymap."
	166	#~(lambda (current-installer)
	167	(let ((result
	168	(call-with-values
	169	(lambda ()
	170	(xkb-rules->models+layouts
	171	(string-append #$xkeyboard-config
	172	"/share/X11/xkb/rules/base.xml")))
	173	(lambda (models layouts)
	174	((installer-keymap-page current-installer)
c088b2e4	175	layouts)))))
3191b5f6 LC	176	(#$apply-keymap result)
3191b5f6 LC	177	result)))
a49d633c MO	178
	179	(define (installer-steps)
	180	(let ((locale-step (compute-locale-step
	181	#:locales-name "locales"
	182	#:iso639-languages-name "iso639-languages"
	183	#:iso3166-territories-name "iso3166-territories"))
	184	(keymap-step (compute-keymap-step))
	185	(timezone-data #~(string-append #$tzdata
	186	"/share/zoneinfo/zone.tab")))
	187	#~(lambda (current-installer)
	188	(list
6efd8430 MO	189	;; Ask the user to choose a locale among those supported by
	190	;; the glibc. Install the selected locale right away, so that
	191	;; the user may benefit from any available translation for the
	192	;; installer messages.
a49d633c MO	193	(installer-step
a49d633c MO	194	(id 'locale)
dc5f3275	195	(description (G_ "Locale"))
a49d633c	196	(compute (lambda _
dc5f3275 MO	197	(#$locale-step current-installer)))
dc5f3275 MO	198	(configuration-formatter locale->configuration))
a49d633c	199
850ddf94 LC	200	;; Welcome the user and ask them to choose between manual
	201	;; installation and graphical install.
	202	(installer-step
	203	(id 'welcome)
	204	(compute (lambda _
	205	((installer-welcome-page current-installer)
	206	#$(local-file "installer/aux-files/logo.txt")))))
	207
a49d633c MO	208	;; Ask the user to select a timezone under glibc format.
	209	(installer-step
	210	(id 'timezone)
dc5f3275	211	(description (G_ "Timezone"))
a49d633c MO	212	(compute (lambda _
a49d633c MO	213	((installer-timezone-page current-installer)
dc5f3275 MO	214	#$timezone-data)))
dc5f3275 MO	215	(configuration-formatter posix-tz->configuration))
a49d633c MO	216
	217	;; The installer runs in a kmscon virtual terminal where loadkeys
	218	;; won't work. kmscon uses libxkbcommon as a backend for keyboard
	219	;; input. It is possible to update kmscon current keymap by sending it
	220	;; a keyboard model, layout and variant, in a somehow similar way as
	221	;; what is done with setxkbmap utility.
	222	;;
	223	;; So ask for a keyboard model, layout and variant to update the
	224	;; current kmscon keymap.
	225	(installer-step
	226	(id 'keymap)
	227	(description (G_ "Keyboard mapping selection"))
	228	(compute (lambda _
3191b5f6 LC	229	(#$keymap-step current-installer)))
3191b5f6 LC	230	(configuration-formatter keyboard-layout->configuration))
a49d633c MO	231
	232	;; Ask the user to input a hostname for the system.
	233	(installer-step
	234	(id 'hostname)
dc5f3275	235	(description (G_ "Hostname"))
a49d633c	236	(compute (lambda _
dc5f3275 MO	237	((installer-hostname-page current-installer))))
dc5f3275 MO	238	(configuration-formatter hostname->configuration))
a49d633c MO	239
	240	;; Provide an interface above connmanctl, so that the user can select
	241	;; a network susceptible to acces Internet.
	242	(installer-step
	243	(id 'network)
	244	(description (G_ "Network selection"))
	245	(compute (lambda _
	246	((installer-network-page current-installer)))))
	247
	248	;; Prompt for users (name, group and home directory).
	249	(installer-step
dc5f3275 MO	250	(id 'user)
	251	(description (G_ "User creation"))
	252	(compute (lambda _
	253	((installer-user-page current-installer))))
	254	(configuration-formatter users->configuration))
	255
b51bde71 MO	256	;; Ask the user to choose one or many desktop environment(s).
	257	(installer-step
	258	(id 'services)
	259	(description (G_ "Services"))
a49d633c	260	(compute (lambda _
b51bde71	261	((installer-services-page current-installer))))
75988317	262	(configuration-formatter system-services->configuration))
dc5f3275	263
d4d27ddb TGR	264	;; Run a partitioning tool allowing the user to modify
	265	;; partition tables, partitions and their mount points.
	266	;; Do this last so the user has something to boot if any
	267	;; of the previous steps didn't go as expected.
	268	(installer-step
	269	(id 'partition)
	270	(description (G_ "Partitioning"))
	271	(compute (lambda _
	272	((installer-partition-page current-installer))))
	273	(configuration-formatter user-partitions->configuration))
	274
b51bde71	275	(installer-step
dc5f3275 MO	276	(id 'final)
	277	(description (G_ "Configuration file"))
	278	(compute
	279	(lambda (result prev-steps)
	280	((installer-final-page current-installer)
b51bde71	281	result prev-steps))))))))
a49d633c MO	282
	283	(define (installer-program)
	284	"Return a file-like object that runs the given INSTALLER."
	285	(define init-gettext
	286	;; Initialize gettext support, so that installer messages can be
	287	;; translated.
	288	#~(begin
	289	(bindtextdomain "guix" (string-append #$guix "/share/locale"))
	290	(textdomain "guix")))
	291
	292	(define set-installer-path
	293	;; Add the specified binary to PATH for later use by the installer.
	294	#~(let* ((inputs
69a934f2 MO	295	'#$(append (list bash ;start subshells
69a934f2 MO	296	connman ;call connmanctl
bf304dbc	297	cryptsetup
69a934f2 MO	298	dosfstools ;mkfs.fat
69a934f2 MO	299	e2fsprogs ;mkfs.ext4
8fec416c TGR	300	btrfs-progs ;mkfs.btrfs
8fec416c TGR	301	jfsutils ;jfs_mkfs
69a934f2 MO	302	kbd ;chvt
	303	guix ;guix system init call
	304	util-linux ;mkwap
	305	shadow)
a49d633c MO	306	(map canonical-package (list coreutils)))))
	307	(with-output-to-port (%make-void-port "w")
	308	(lambda ()
	309	(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
	310
	311	(define steps (installer-steps))
69a934f2 MO	312	(define modules
	313	(scheme-modules*
	314	(string-append (current-source-directory) "/..")
	315	"gnu/installer"))
a49d633c MO	316
a49d633c MO	317	(define installer-builder
50247be5 LC	318	;; Note: Include GUIX as an extension to get all the (gnu system …), (gnu
50247be5 LC	319	;; packages …), etc. modules.
69a934f2 MO	320	(with-extensions (list guile-gcrypt guile-newt
69a934f2 MO	321	guile-parted guile-bytestructures
81c3dc32	322	guile-json-3 guile-git guix)
a49d633c	323	(with-imported-modules `(,@(source-module-closure
69a934f2	324	`(,@modules
98f03548	325	(gnu services herd)
a49d633c	326	(guix build utils))
50247be5	327	#:select? module-to-import?)
a49d633c MO	328	((guix config) => ,(make-config.scm)))
	329	#~(begin
	330	(use-modules (gnu installer record)
	331	(gnu installer keymap)
	332	(gnu installer steps)
dc5f3275	333	(gnu installer final)
b4658c25	334	(gnu installer hostname)
a49d633c	335	(gnu installer locale)
dc5f3275 MO	336	(gnu installer parted)
	337	(gnu installer services)
	338	(gnu installer timezone)
	339	(gnu installer user)
a49d633c	340	(gnu installer newt)
3191b5f6 LC	341	((gnu installer newt keymap)
3191b5f6 LC	342	#:select (keyboard-layout->configuration))
c7dc6042	343	(gnu services herd)
a49d633c MO	344	(guix i18n)
a49d633c MO	345	(guix build utils)
3114786e MO	346	((system repl debug)
3114786e MO	347	#:select (terminal-width))
a49d633c MO	348	(ice-9 match))
a49d633c MO	349
a49d633c MO	350	;; Initialize gettext support so that installers can use
	351	;; (guix i18n) module.
	352	#$init-gettext
	353
	354	;; Add some binaries used by the installers to PATH.
	355	#$set-installer-path
	356
7837a572 LC	357	;; Arrange for language and territory name translations to be
	358	;; available. We need them at run time, not just compile time,
	359	;; because some territories have several corresponding languages
	360	;; (e.g., "French" is always displayed as "français", but
	361	;; "Belgium" could be translated to Dutch, French, or German.)
	362	(bindtextdomain "iso_639-3" ;languages
	363	#+(file-append iso-codes "/share/locale"))
	364	(bindtextdomain "iso_3166-1" ;territories
	365	#+(file-append iso-codes "/share/locale"))
	366
feaa83a3 LC	367	;; Likewise for XKB keyboard layout names.
	368	(bindtextdomain "xkeyboard-config"
	369	#+(file-append xkeyboard-config "/share/locale"))
	370
3114786e MO	371	;; Initialize 'terminal-width' in (system repl debug)
	372	;; to a large-enough value to make backtrace more
	373	;; verbose.
	374	(terminal-width 200)
	375
dc5f3275 MO	376	(let* ((current-installer newt-installer)
dc5f3275 MO	377	(steps (#$steps current-installer)))
a49d633c MO	378	((installer-init current-installer))
	379
	380	(catch #t
	381	(lambda ()
98f03548 LC	382	(define results
	383	(run-installer-steps
	384	#:rewind-strategy 'menu
	385	#:menu-proc (installer-menu-page current-installer)
	386	#:steps steps))
	387
	388	(match (result-step results 'final)
	389	('success
	390	;; We did it! Let's reboot!
	391	(sync)
	392	(stop-service 'root))
d008352b MO	393	(_
	394	;; The installation failed, exit so that it is restarted
	395	;; by login.
98f03548	396	#f)))
a49d633c MO	397	(const #f)
a49d633c MO	398	(lambda (key . args)
5c04b00c LC	399	(syslog "crashing due to uncaught exception: ~s ~s~%"
5c04b00c LC	400	key args)
133c401f MO	401	(let ((error-file "/tmp/last-installer-error"))
	402	(call-with-output-file error-file
	403	(lambda (port)
	404	(display-backtrace (make-stack #t) port)
	405	(print-exception port
	406	(stack-ref (make-stack #t) 1)
	407	key args)))
	408	((installer-exit-error current-installer)
	409	error-file key args))
dc5f3275 MO	410	(primitive-exit 1)))
	411
	412	((installer-exit current-installer)))))))
d0f3a672	413
6b48825e MO	414	(program-file
	415	"installer"
	416	#~(begin
	417	;; Set the default locale to install unicode support. For
	418	;; some reason, unicode support is not correctly installed
	419	;; when calling this in 'installer-builder'.
	420	(setenv "LANG" "en_US.UTF-8")
6c849cdb LC	421	(execl #$(program-file "installer-real" installer-builder)
6c849cdb LC	422	"installer-real"))))