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

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 packages admin)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages connman)
  #:use-module (gnu packages disk)
  #:use-module (gnu packages guile)
  #: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 (ice-9 match)
  #:use-module (srfi srfi-1)
  #:export (installer-program))

(define not-config?
  ;; Select (guix …) and (gnu …) modules, except (guix config).
  (match-lambda
    (('guix 'config) #f)
    (('guix rest ...) #t)
    (('gnu rest ...) #t)
    (rest #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)
      (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.
  #~(lambda (locale-name)
      (false-if-exception
       (setlocale LC_ALL locale-name))))

(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
                               #$(local-file "installer/aux-files/SUPPORTED")))
         (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))))

(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
         ;; Welcome the user and ask him 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 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))

         ;; 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))))

         ;; Run a partitionment tool allowing the user to modify
         ;; partition tables, partitions and their mount points.
         (installer-step
          (id 'partition)
          (description (G_ "Partitionment"))
          (compute (lambda _
                     ((installer-partition-page current-installer))))
          (configuration-formatter user-partitions->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
           desktop-environments->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
                               dosfstools ;mkfs.fat
                               e2fsprogs ;mkfs.ext4
                               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
    (with-extensions (list guile-gcrypt guile-newt
                           guile-parted guile-bytestructures
                           guile-json)
      (with-imported-modules `(,@(source-module-closure
                                  `(,@modules
                                    (guix build utils))
                                  #:select? not-config?)
                               ((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)
                         (guix i18n)
                         (guix build utils)
                         (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

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

              (catch #t
                (lambda ()
                  (run-installer-steps
                   #:rewind-strategy 'menu
                   #:menu-proc (installer-menu-page current-installer)
                   #:steps steps))
                (const #f)
                (lambda (key . args)
                  ((installer-exit-error current-installer) key args)

                  ;; Be sure to call newt-finish, to restore the terminal into
                  ;; its original state before printing the error report.
                  (call-with-output-file "/tmp/error"
                    (lambda (port)
                      (display-backtrace (make-stack #t) port)
                      (print-exception port
                                       (stack-ref (make-stack #t) 1)
                                       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")
       (system #$(program-file "installer-real" installer-builder)))))
Commit	Line	Data
d0f3a672 MO	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu installer)
69a934f2	20	#:use-module (guix discovery)
a49d633c MO	21	#:use-module (guix packages)
	22	#:use-module (guix gexp)
	23	#:use-module (guix modules)
	24	#:use-module (guix utils)
d0f3a672	25	#:use-module (guix ui)
a49d633c MO	26	#:use-module ((guix self) #:select (make-config.scm))
	27	#:use-module (gnu packages admin)
	28	#:use-module (gnu packages base)
	29	#:use-module (gnu packages bash)
	30	#:use-module (gnu packages connman)
69a934f2	31	#:use-module (gnu packages disk)
a49d633c MO	32	#:use-module (gnu packages guile)
	33	#:autoload (gnu packages gnupg) (guile-gcrypt)
	34	#:use-module (gnu packages iso-codes)
	35	#:use-module (gnu packages linux)
	36	#:use-module (gnu packages ncurses)
	37	#:use-module (gnu packages package-management)
	38	#:use-module (gnu packages xorg)
	39	#:use-module (ice-9 match)
d0f3a672	40	#:use-module (srfi srfi-1)
a49d633c	41	#:export (installer-program))
d0f3a672	42
a49d633c MO	43	(define not-config?
	44	;; Select (guix …) and (gnu …) modules, except (guix config).
	45	(match-lambda
	46	(('guix 'config) #f)
	47	(('guix rest ...) #t)
	48	(('gnu rest ...) #t)
	49	(rest #f)))
	50
	51	(define* (build-compiled-file name locale-builder)
	52	"Return a file-like object that evalutes the gexp LOCALE-BUILDER and store
	53	its result in the scheme file NAME. The derivation will also build a compiled
	54	version of this file."
	55	(define set-utf8-locale
	56	#~(begin
	57	(setenv "LOCPATH"
	58	#$(file-append glibc-utf8-locales "/lib/locale/"
	59	(version-major+minor
	60	(package-version glibc-utf8-locales))))
	61	(setlocale LC_ALL "en_US.utf8")))
	62
	63	(define builder
	64	(with-extensions (list guile-json)
	65	(with-imported-modules (source-module-closure
	66	'((gnu installer locale)))
	67	#~(begin
	68	(use-modules (gnu installer locale))
	69
	70	;; The locale files contain non-ASCII characters.
	71	#$set-utf8-locale
	72
	73	(mkdir #$output)
	74	(let ((locale-file
	75	(string-append #$output "/" #$name ".scm"))
	76	(locale-compiled-file
	77	(string-append #$output "/" #$name ".go")))
	78	(call-with-output-file locale-file
	79	(lambda (port)
	80	(write #$locale-builder port)))
	81	(compile-file locale-file
	82	#:output-file locale-compiled-file))))))
	83	(computed-file name builder))
	84
	85	(define apply-locale
	86	;; Install the specified locale.
	87	#~(lambda (locale-name)
	88	(false-if-exception
	89	(setlocale LC_ALL locale-name))))
	90
	91	(define* (compute-locale-step #:key
	92	locales-name
	93	iso639-languages-name
	94	iso3166-territories-name)
	95	"Return a gexp that run the locale-page of INSTALLER, and install the
	96	selected locale. The list of locales, languages and territories passed to
	97	locale-page are computed in derivations named respectively LOCALES-NAME,
	98	ISO639-LANGUAGES-NAME and ISO3166-TERRITORIES-NAME. Those lists are compiled,
	99	so that when the installer is run, all the lengthy operations have already
	100	been performed at build time."
	101	(define (compiled-file-loader file name)
	102	#~(load-compiled
	103	(string-append #$file "/" #$name ".go")))
	104
	105	(let* ((supported-locales #~(supported-locales->locales
	106	#$(local-file "installer/aux-files/SUPPORTED")))
107	(iso-codes #~(string-append #$iso-codes "/share/iso-codes/json/"))
108	(iso639-3 #~(string-append #$iso-codes "iso_639-3.json"))
109	(iso639-5 #~(string-append #$iso-codes "iso_639-5.json"))
110	(iso3166 #~(string-append #$iso-codes "iso_3166-1.json"))
111	(locales-file (build-compiled-file
112	locales-name
113	#~`(quote ,#$supported-locales)))
114	(iso639-file (build-compiled-file
115	iso639-languages-name
116	#~`(quote ,(iso639->iso639-languages
117	#$supported-locales
118	#$iso639-3 #$iso639-5))))
119	(iso3166-file (build-compiled-file
120	iso3166-territories-name
121	#~`(quote ,(iso3166->iso3166-territories #$iso3166))))
122	(locales-loader (compiled-file-loader locales-file
123	locales-name))
124	(iso639-loader (compiled-file-loader iso639-file
125	iso639-languages-name))
126	(iso3166-loader (compiled-file-loader iso3166-file
127	iso3166-territories-name)))
128	#~(lambda (current-installer)
129	(let ((result
130	((installer-locale-page current-installer)
131	#:supported-locales #$locales-loader
132	#:iso639-languages #$iso639-loader
133	#:iso3166-territories #$iso3166-loader)))
dc5f3275 MO	134	(#$apply-locale result)
dc5f3275 MO	135	result))))
a49d633c MO	136
a49d633c MO	137	(define apply-keymap
c088b2e4	138	;; Apply the specified keymap. Use the default keyboard model.
a49d633c	139	#~(match-lambda
c088b2e4 MO	140	((layout variant)
	141	(kmscon-update-keymap (default-keyboard-model)
	142	layout variant))))
a49d633c MO	143
	144	(define* (compute-keymap-step)
	145	"Return a gexp that runs the keymap-page of INSTALLER and install the
	146	selected keymap."
	147	#~(lambda (current-installer)
	148	(let ((result
	149	(call-with-values
	150	(lambda ()
	151	(xkb-rules->models+layouts
	152	(string-append #$xkeyboard-config
	153	"/share/X11/xkb/rules/base.xml")))
	154	(lambda (models layouts)
	155	((installer-keymap-page current-installer)
c088b2e4	156	layouts)))))
a49d633c MO	157	(#$apply-keymap result))))
	158
	159	(define (installer-steps)
	160	(let ((locale-step (compute-locale-step
	161	#:locales-name "locales"
	162	#:iso639-languages-name "iso639-languages"
	163	#:iso3166-territories-name "iso3166-territories"))
	164	(keymap-step (compute-keymap-step))
	165	(timezone-data #~(string-append #$tzdata
	166	"/share/zoneinfo/zone.tab")))
	167	#~(lambda (current-installer)
	168	(list
6efd8430 MO	169	;; Welcome the user and ask him to choose between manual
6efd8430 MO	170	;; installation and graphical install.
a49d633c MO	171	(installer-step
	172	(id 'welcome)
	173	(compute (lambda _
	174	((installer-welcome-page current-installer)
	175	#$(local-file "installer/aux-files/logo.txt")))))
	176
6efd8430 MO	177	;; Ask the user to choose a locale among those supported by
	178	;; the glibc. Install the selected locale right away, so that
	179	;; the user may benefit from any available translation for the
	180	;; installer messages.
a49d633c MO	181	(installer-step
a49d633c MO	182	(id 'locale)
dc5f3275	183	(description (G_ "Locale"))
a49d633c	184	(compute (lambda _
dc5f3275 MO	185	(#$locale-step current-installer)))
dc5f3275 MO	186	(configuration-formatter locale->configuration))
a49d633c MO	187
	188	;; Ask the user to select a timezone under glibc format.
	189	(installer-step
	190	(id 'timezone)
dc5f3275	191	(description (G_ "Timezone"))
a49d633c MO	192	(compute (lambda _
a49d633c MO	193	((installer-timezone-page current-installer)
dc5f3275 MO	194	#$timezone-data)))
dc5f3275 MO	195	(configuration-formatter posix-tz->configuration))
a49d633c MO	196
	197	;; The installer runs in a kmscon virtual terminal where loadkeys
	198	;; won't work. kmscon uses libxkbcommon as a backend for keyboard
	199	;; input. It is possible to update kmscon current keymap by sending it
	200	;; a keyboard model, layout and variant, in a somehow similar way as
	201	;; what is done with setxkbmap utility.
	202	;;
	203	;; So ask for a keyboard model, layout and variant to update the
	204	;; current kmscon keymap.
	205	(installer-step
	206	(id 'keymap)
	207	(description (G_ "Keyboard mapping selection"))
	208	(compute (lambda _
	209	(#$keymap-step current-installer))))
	210
5bfdde50 MO	211	;; Run a partitionment tool allowing the user to modify
	212	;; partition tables, partitions and their mount points.
	213	(installer-step
	214	(id 'partition)
	215	(description (G_ "Partitionment"))
	216	(compute (lambda _
	217	((installer-partition-page current-installer))))
	218	(configuration-formatter user-partitions->configuration))
	219
a49d633c MO	220	;; Ask the user to input a hostname for the system.
	221	(installer-step
	222	(id 'hostname)
dc5f3275	223	(description (G_ "Hostname"))
a49d633c	224	(compute (lambda _
dc5f3275 MO	225	((installer-hostname-page current-installer))))
dc5f3275 MO	226	(configuration-formatter hostname->configuration))
a49d633c MO	227
	228	;; Provide an interface above connmanctl, so that the user can select
	229	;; a network susceptible to acces Internet.
	230	(installer-step
	231	(id 'network)
	232	(description (G_ "Network selection"))
	233	(compute (lambda _
	234	((installer-network-page current-installer)))))
	235
	236	;; Prompt for users (name, group and home directory).
	237	(installer-step
dc5f3275 MO	238	(id 'user)
	239	(description (G_ "User creation"))
	240	(compute (lambda _
	241	((installer-user-page current-installer))))
	242	(configuration-formatter users->configuration))
	243
b51bde71 MO	244	;; Ask the user to choose one or many desktop environment(s).
	245	(installer-step
	246	(id 'services)
	247	(description (G_ "Services"))
a49d633c	248	(compute (lambda _
b51bde71 MO	249	((installer-services-page current-installer))))
	250	(configuration-formatter
	251	desktop-environments->configuration))
dc5f3275	252
b51bde71	253	(installer-step
dc5f3275 MO	254	(id 'final)
	255	(description (G_ "Configuration file"))
	256	(compute
	257	(lambda (result prev-steps)
	258	((installer-final-page current-installer)
b51bde71	259	result prev-steps))))))))
a49d633c MO	260
	261	(define (installer-program)
	262	"Return a file-like object that runs the given INSTALLER."
	263	(define init-gettext
	264	;; Initialize gettext support, so that installer messages can be
	265	;; translated.
	266	#~(begin
	267	(bindtextdomain "guix" (string-append #$guix "/share/locale"))
	268	(textdomain "guix")))
	269
	270	(define set-installer-path
	271	;; Add the specified binary to PATH for later use by the installer.
	272	#~(let* ((inputs
69a934f2 MO	273	'#$(append (list bash ;start subshells
	274	connman ;call connmanctl
	275	dosfstools ;mkfs.fat
	276	e2fsprogs ;mkfs.ext4
	277	kbd ;chvt
	278	guix ;guix system init call
	279	util-linux ;mkwap
	280	shadow)
a49d633c MO	281	(map canonical-package (list coreutils)))))
	282	(with-output-to-port (%make-void-port "w")
	283	(lambda ()
	284	(set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
	285
	286	(define steps (installer-steps))
69a934f2 MO	287	(define modules
	288	(scheme-modules*
	289	(string-append (current-source-directory) "/..")
	290	"gnu/installer"))
a49d633c MO	291
a49d633c MO	292	(define installer-builder
69a934f2 MO	293	(with-extensions (list guile-gcrypt guile-newt
	294	guile-parted guile-bytestructures
	295	guile-json)
a49d633c	296	(with-imported-modules `(,@(source-module-closure
69a934f2	297	`(,@modules
a49d633c MO	298	(guix build utils))
	299	#:select? not-config?)
	300	((guix config) => ,(make-config.scm)))
	301	#~(begin
	302	(use-modules (gnu installer record)
	303	(gnu installer keymap)
	304	(gnu installer steps)
dc5f3275	305	(gnu installer final)
b4658c25	306	(gnu installer hostname)
a49d633c	307	(gnu installer locale)
dc5f3275 MO	308	(gnu installer parted)
	309	(gnu installer services)
	310	(gnu installer timezone)
	311	(gnu installer user)
a49d633c MO	312	(gnu installer newt)
	313	(guix i18n)
	314	(guix build utils)
	315	(ice-9 match))
	316
a49d633c MO	317	;; Initialize gettext support so that installers can use
	318	;; (guix i18n) module.
	319	#$init-gettext
	320
	321	;; Add some binaries used by the installers to PATH.
	322	#$set-installer-path
	323
dc5f3275 MO	324	(let* ((current-installer newt-installer)
dc5f3275 MO	325	(steps (#$steps current-installer)))
a49d633c MO	326	((installer-init current-installer))
	327
	328	(catch #t
	329	(lambda ()
	330	(run-installer-steps
	331	#:rewind-strategy 'menu
	332	#:menu-proc (installer-menu-page current-installer)
dc5f3275	333	#:steps steps))
a49d633c MO	334	(const #f)
	335	(lambda (key . args)
	336	((installer-exit-error current-installer) key args)
	337
	338	;; Be sure to call newt-finish, to restore the terminal into
	339	;; its original state before printing the error report.
	340	(call-with-output-file "/tmp/error"
	341	(lambda (port)
	342	(display-backtrace (make-stack #t) port)
	343	(print-exception port
	344	(stack-ref (make-stack #t) 1)
	345	key args)))
dc5f3275 MO	346	(primitive-exit 1)))
	347
	348	((installer-exit current-installer)))))))
d0f3a672	349
6b48825e MO	350	(program-file
	351	"installer"
	352	#~(begin
	353	;; Set the default locale to install unicode support. For
	354	;; some reason, unicode support is not correctly installed
	355	;; when calling this in 'installer-builder'.
	356	(setenv "LANG" "en_US.UTF-8")
	357	(system #$(program-file "installer-real" installer-builder)))))