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