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