gnu: Add graphical installer support.

* configure.ac: Require that guile-newt is available. * gnu/installer.scm: New file. * gnu/installer/aux-files/logo.txt: New file. * gnu/installer/build-installer.scm: New file. * gnu/installer/connman.scm: New file. * gnu/installer/keymap.scm: New file. * gnu/installer/locale.scm: New file. * gnu/installer/newt.scm: New file. * gnu/installer/newt/ethernet.scm: New file. * gnu/installer/newt/hostname.scm: New file. * gnu/installer/newt/keymap.scm: New file. * gnu/installer/newt/locale.scm: New file. * gnu/installer/newt/menu.scm: New file. * gnu/installer/newt/network.scm: New file. * gnu/installer/newt/page.scm: New file. * gnu/installer/newt/timezone.scm: New file. * gnu/installer/newt/user.scm: New file. * gnu/installer/newt/utils.scm: New file. * gnu/installer/newt/welcome.scm: New file. * gnu/installer/newt/wifi.scm: New file. * gnu/installer/steps.scm: New file. * gnu/installer/timezone.scm: New file. * gnu/installer/utils.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add previous files. * gnu/system.scm: Export %root-account. * gnu/system/install.scm (%installation-services): Use kmscon instead of linux VT for all tty. (installation-os)[users]: Add the graphical installer as shell of the root account. [packages]: Add font related packages. * po/guix/POTFILES.in: Add installer files.
author: Mathieu Othacehe <m.othacehe@gmail.com> 2018-11-16 20:43:55 +0900
committer: Ludovic Courtès <ludo@gnu.org> 2019-01-17 14:04:20 +0100
commit: d0f3a672dcbdfefd3556b6a21985ff0e35eed3be (patch)
tree: 6ca7cc2fc874343791a3b555181177be488a3a8a /gnu/installer
parent: 08af580bde01ffd8e6968b6f9f9eff14c4f9cc5a (diff)
22 files changed, 3616 insertions, 0 deletions
diff --git a/gnu/installer/aux-files/SUPPORTED b/gnu/installer/aux-files/SUPPORTED
new file mode 100644
index 0000000000..24aae1e089
--- /dev/null
+++ b/gnu/installer/aux-files/SUPPORTED
@@ -0,0 +1,484 @@
+aa_DJ.UTF-8 UTF-8
+aa_DJ ISO-8859-1
+aa_ER UTF-8
+aa_ER@saaho UTF-8
+aa_ET UTF-8
+af_ZA.UTF-8 UTF-8
+af_ZA ISO-8859-1
+agr_PE UTF-8
+ak_GH UTF-8
+am_ET UTF-8
+an_ES.UTF-8 UTF-8
+an_ES ISO-8859-15
+anp_IN UTF-8
+ar_AE.UTF-8 UTF-8
+ar_AE ISO-8859-6
+ar_BH.UTF-8 UTF-8
+ar_BH ISO-8859-6
+ar_DZ.UTF-8 UTF-8
+ar_DZ ISO-8859-6
+ar_EG.UTF-8 UTF-8
+ar_EG ISO-8859-6
+ar_IN UTF-8
+ar_IQ.UTF-8 UTF-8
+ar_IQ ISO-8859-6
+ar_JO.UTF-8 UTF-8
+ar_JO ISO-8859-6
+ar_KW.UTF-8 UTF-8
+ar_KW ISO-8859-6
+ar_LB.UTF-8 UTF-8
+ar_LB ISO-8859-6
+ar_LY.UTF-8 UTF-8
+ar_LY ISO-8859-6
+ar_MA.UTF-8 UTF-8
+ar_MA ISO-8859-6
+ar_OM.UTF-8 UTF-8
+ar_OM ISO-8859-6
+ar_QA.UTF-8 UTF-8
+ar_QA ISO-8859-6
+ar_SA.UTF-8 UTF-8
+ar_SA ISO-8859-6
+ar_SD.UTF-8 UTF-8
+ar_SD ISO-8859-6
+ar_SS UTF-8
+ar_SY.UTF-8 UTF-8
+ar_SY ISO-8859-6
+ar_TN.UTF-8 UTF-8
+ar_TN ISO-8859-6
+ar_YE.UTF-8 UTF-8
+ar_YE ISO-8859-6
+ayc_PE UTF-8
+az_AZ UTF-8
+az_IR UTF-8
+as_IN UTF-8
+ast_ES.UTF-8 UTF-8
+ast_ES ISO-8859-15
+be_BY.UTF-8 UTF-8
+be_BY CP1251
+be_BY@latin UTF-8
+bem_ZM UTF-8
+ber_DZ UTF-8
+ber_MA UTF-8
+bg_BG.UTF-8 UTF-8
+bg_BG CP1251
+bhb_IN.UTF-8 UTF-8
+bho_IN UTF-8
+bho_NP UTF-8
+bi_VU UTF-8
+bn_BD UTF-8
+bn_IN UTF-8
+bo_CN UTF-8
+bo_IN UTF-8
+br_FR.UTF-8 UTF-8
+br_FR ISO-8859-1
+br_FR@euro ISO-8859-15
+brx_IN UTF-8
+bs_BA.UTF-8 UTF-8
+bs_BA ISO-8859-2
+byn_ER UTF-8
+ca_AD.UTF-8 UTF-8
+ca_AD ISO-8859-15
+ca_ES.UTF-8 UTF-8
+ca_ES ISO-8859-1
+ca_ES@euro ISO-8859-15
+ca_ES@valencia UTF-8
+ca_FR.UTF-8 UTF-8
+ca_FR ISO-8859-15
+ca_IT.UTF-8 UTF-8
+ca_IT ISO-8859-15
+ce_RU UTF-8
+chr_US UTF-8
+cmn_TW UTF-8
+crh_UA UTF-8
+cs_CZ.UTF-8 UTF-8
+cs_CZ ISO-8859-2
+csb_PL UTF-8
+cv_RU UTF-8
+cy_GB.UTF-8 UTF-8
+cy_GB ISO-8859-14
+da_DK.UTF-8 UTF-8
+da_DK ISO-8859-1
+de_AT.UTF-8 UTF-8
+de_AT ISO-8859-1
+de_AT@euro ISO-8859-15
+de_BE.UTF-8 UTF-8
+de_BE ISO-8859-1
+de_BE@euro ISO-8859-15
+de_CH.UTF-8 UTF-8
+de_CH ISO-8859-1
+de_DE.UTF-8 UTF-8
+de_DE ISO-8859-1
+de_DE@euro ISO-8859-15
+de_IT.UTF-8 UTF-8
+de_IT ISO-8859-1
+de_LI.UTF-8 UTF-8
+de_LU.UTF-8 UTF-8
+de_LU ISO-8859-1
+de_LU@euro ISO-8859-15
+doi_IN UTF-8
+dv_MV UTF-8
+dz_BT UTF-8
+el_GR.UTF-8 UTF-8
+el_GR ISO-8859-7
+el_GR@euro ISO-8859-7
+el_CY.UTF-8 UTF-8
+el_CY ISO-8859-7
+en_AG UTF-8
+en_AU.UTF-8 UTF-8
+en_AU ISO-8859-1
+en_BW.UTF-8 UTF-8
+en_BW ISO-8859-1
+en_CA.UTF-8 UTF-8
+en_CA ISO-8859-1
+en_DK.UTF-8 UTF-8
+en_DK ISO-8859-1
+en_GB.UTF-8 UTF-8
+en_GB ISO-8859-1
+en_HK.UTF-8 UTF-8
+en_HK ISO-8859-1
+en_IE.UTF-8 UTF-8
+en_IE ISO-8859-1
+en_IE@euro ISO-8859-15
+en_IL UTF-8
+en_IN UTF-8
+en_NG UTF-8
+en_NZ.UTF-8 UTF-8
+en_NZ ISO-8859-1
+en_PH.UTF-8 UTF-8
+en_PH ISO-8859-1
+en_SC.UTF-8 UTF-8
+en_SG.UTF-8 UTF-8
+en_SG ISO-8859-1
+en_US.UTF-8 UTF-8
+en_US ISO-8859-1
+en_ZA.UTF-8 UTF-8
+en_ZA ISO-8859-1
+en_ZM UTF-8
+en_ZW.UTF-8 UTF-8
+en_ZW ISO-8859-1
+eo UTF-8
+es_AR.UTF-8 UTF-8
+es_AR ISO-8859-1
+es_BO.UTF-8 UTF-8
+es_BO ISO-8859-1
+es_CL.UTF-8 UTF-8
+es_CL ISO-8859-1
+es_CO.UTF-8 UTF-8
+es_CO ISO-8859-1
+es_CR.UTF-8 UTF-8
+es_CR ISO-8859-1
+es_CU UTF-8
+es_DO.UTF-8 UTF-8
+es_DO ISO-8859-1
+es_EC.UTF-8 UTF-8
+es_EC ISO-8859-1
+es_ES.UTF-8 UTF-8
+es_ES ISO-8859-1
+es_ES@euro ISO-8859-15
+es_GT.UTF-8 UTF-8
+es_GT ISO-8859-1
+es_HN.UTF-8 UTF-8
+es_HN ISO-8859-1
+es_MX.UTF-8 UTF-8
+es_MX ISO-8859-1
+es_NI.UTF-8 UTF-8
+es_NI ISO-8859-1
+es_PA.UTF-8 UTF-8
+es_PA ISO-8859-1
+es_PE.UTF-8 UTF-8
+es_PE ISO-8859-1
+es_PR.UTF-8 UTF-8
+es_PR ISO-8859-1
+es_PY.UTF-8 UTF-8
+es_PY ISO-8859-1
+es_SV.UTF-8 UTF-8
+es_SV ISO-8859-1
+es_US.UTF-8 UTF-8
+es_US ISO-8859-1
+es_UY.UTF-8 UTF-8
+es_UY ISO-8859-1
+es_VE.UTF-8 UTF-8
+es_VE ISO-8859-1
+et_EE.UTF-8 UTF-8
+et_EE ISO-8859-1
+et_EE.ISO-8859-15 ISO-8859-15
+eu_ES.UTF-8 UTF-8
+eu_ES ISO-8859-1
+eu_ES@euro ISO-8859-15
+fa_IR UTF-8
+ff_SN UTF-8
+fi_FI.UTF-8 UTF-8
+fi_FI ISO-8859-1
+fi_FI@euro ISO-8859-15
+fil_PH UTF-8
+fo_FO.UTF-8 UTF-8
+fo_FO ISO-8859-1
+fr_BE.UTF-8 UTF-8
+fr_BE ISO-8859-1
+fr_BE@euro ISO-8859-15
+fr_CA.UTF-8 UTF-8
+fr_CA ISO-8859-1
+fr_CH.UTF-8 UTF-8
+fr_CH ISO-8859-1
+fr_FR.UTF-8 UTF-8
+fr_FR ISO-8859-1
+fr_FR@euro ISO-8859-15
+fr_LU.UTF-8 UTF-8
+fr_LU ISO-8859-1
+fr_LU@euro ISO-8859-15
+fur_IT UTF-8
+fy_NL UTF-8
+fy_DE UTF-8
+ga_IE.UTF-8 UTF-8
+ga_IE ISO-8859-1
+ga_IE@euro ISO-8859-15
+gd_GB.UTF-8 UTF-8
+gd_GB ISO-8859-15
+gez_ER UTF-8
+gez_ER@abegede UTF-8
+gez_ET UTF-8
+gez_ET@abegede UTF-8
+gl_ES.UTF-8 UTF-8
+gl_ES ISO-8859-1
+gl_ES@euro ISO-8859-15
+gu_IN UTF-8
+gv_GB.UTF-8 UTF-8
+gv_GB ISO-8859-1
+ha_NG UTF-8
+hak_TW UTF-8
+he_IL.UTF-8 UTF-8
+he_IL ISO-8859-8
+hi_IN UTF-8
+hif_FJ UTF-8
+hne_IN UTF-8
+hr_HR.UTF-8 UTF-8
+hr_HR ISO-8859-2
+hsb_DE ISO-8859-2
+hsb_DE.UTF-8 UTF-8
+ht_HT UTF-8
+hu_HU.UTF-8 UTF-8
+hu_HU ISO-8859-2
+hy_AM UTF-8
+hy_AM.ARMSCII-8 ARMSCII-8
+ia_FR UTF-8
+id_ID.UTF-8 UTF-8
+id_ID ISO-8859-1
+ig_NG UTF-8
+ik_CA UTF-8
+is_IS.UTF-8 UTF-8
+is_IS ISO-8859-1
+it_CH.UTF-8 UTF-8
+it_CH ISO-8859-1
+it_IT.UTF-8 UTF-8
+it_IT ISO-8859-1
+it_IT@euro ISO-8859-15
+iu_CA UTF-8
+ja_JP.EUC-JP EUC-JP
+ja_JP.UTF-8 UTF-8
+ka_GE.UTF-8 UTF-8
+ka_GE GEORGIAN-PS
+kab_DZ UTF-8
+kk_KZ.UTF-8 UTF-8
+kk_KZ PT154
+kl_GL.UTF-8 UTF-8
+kl_GL ISO-8859-1
+km_KH UTF-8
+kn_IN UTF-8
+ko_KR.EUC-KR EUC-KR
+ko_KR.UTF-8 UTF-8
+kok_IN UTF-8
+ks_IN UTF-8
+ks_IN@devanagari UTF-8
+ku_TR.UTF-8 UTF-8
+ku_TR ISO-8859-9
+kw_GB.UTF-8 UTF-8
+kw_GB ISO-8859-1
+ky_KG UTF-8
+lb_LU UTF-8
+lg_UG.UTF-8 UTF-8
+lg_UG ISO-8859-10
+li_BE UTF-8
+li_NL UTF-8
+lij_IT UTF-8
+ln_CD UTF-8
+lo_LA UTF-8
+lt_LT.UTF-8 UTF-8
+lt_LT ISO-8859-13
+lv_LV.UTF-8 UTF-8
+lv_LV ISO-8859-13
+lzh_TW UTF-8
+mag_IN UTF-8
+mai_IN UTF-8
+mai_NP UTF-8
+mfe_MU UTF-8
+mg_MG.UTF-8 UTF-8
+mg_MG ISO-8859-15
+mhr_RU UTF-8
+mi_NZ.UTF-8 UTF-8
+mi_NZ ISO-8859-13
+miq_NI UTF-8
+mjw_IN UTF-8
+mk_MK.UTF-8 UTF-8
+mk_MK ISO-8859-5
+ml_IN UTF-8
+mn_MN UTF-8
+mni_IN UTF-8
+mr_IN UTF-8
+ms_MY.UTF-8 UTF-8
+ms_MY ISO-8859-1
+mt_MT.UTF-8 UTF-8
+mt_MT ISO-8859-3
+my_MM UTF-8
+nan_TW UTF-8
+nan_TW@latin UTF-8
+nb_NO.UTF-8 UTF-8
+nb_NO ISO-8859-1
+nds_DE UTF-8
+nds_NL UTF-8
+ne_NP UTF-8
+nhn_MX UTF-8
+niu_NU UTF-8
+niu_NZ UTF-8
+nl_AW UTF-8
+nl_BE.UTF-8 UTF-8
+nl_BE ISO-8859-1
+nl_BE@euro ISO-8859-15
+nl_NL.UTF-8 UTF-8
+nl_NL ISO-8859-1
+nl_NL@euro ISO-8859-15
+nn_NO.UTF-8 UTF-8
+nn_NO ISO-8859-1
+nr_ZA UTF-8
+nso_ZA UTF-8
+oc_FR.UTF-8 UTF-8
+oc_FR ISO-8859-1
+om_ET UTF-8
+om_KE.UTF-8 UTF-8
+om_KE ISO-8859-1
+or_IN UTF-8
+os_RU UTF-8
+pa_IN UTF-8
+pa_PK UTF-8
+pap_AW UTF-8
+pap_CW UTF-8
+pl_PL.UTF-8 UTF-8
+pl_PL ISO-8859-2
+ps_AF UTF-8
+pt_BR.UTF-8 UTF-8
+pt_BR ISO-8859-1
+pt_PT.UTF-8 UTF-8
+pt_PT ISO-8859-1
+pt_PT@euro ISO-8859-15
+quz_PE UTF-8
+raj_IN UTF-8
+ro_RO.UTF-8 UTF-8
+ro_RO ISO-8859-2
+ru_RU.KOI8-R KOI8-R
+ru_RU.UTF-8 UTF-8
+ru_RU ISO-8859-5
+ru_UA.UTF-8 UTF-8
+ru_UA KOI8-U
+rw_RW UTF-8
+sa_IN UTF-8
+sat_IN UTF-8
+sc_IT UTF-8
+sd_IN UTF-8
+sd_IN@devanagari UTF-8
+se_NO UTF-8
+sgs_LT UTF-8
+shn_MM UTF-8
+shs_CA UTF-8
+si_LK UTF-8
+sid_ET UTF-8
+sk_SK.UTF-8 UTF-8
+sk_SK ISO-8859-2
+sl_SI.UTF-8 UTF-8
+sl_SI ISO-8859-2
+sm_WS UTF-8
+so_DJ.UTF-8 UTF-8
+so_DJ ISO-8859-1
+so_ET UTF-8
+so_KE.UTF-8 UTF-8
+so_KE ISO-8859-1
+so_SO.UTF-8 UTF-8
+so_SO ISO-8859-1
+sq_AL.UTF-8 UTF-8
+sq_AL ISO-8859-1
+sq_MK UTF-8
+sr_ME UTF-8
+sr_RS UTF-8
+sr_RS@latin UTF-8
+ss_ZA UTF-8
+st_ZA.UTF-8 UTF-8
+st_ZA ISO-8859-1
+sv_FI.UTF-8 UTF-8
+sv_FI ISO-8859-1
+sv_FI@euro ISO-8859-15
+sv_SE.UTF-8 UTF-8
+sv_SE ISO-8859-1
+sw_KE UTF-8
+sw_TZ UTF-8
+szl_PL UTF-8
+ta_IN UTF-8
+ta_LK UTF-8
+tcy_IN.UTF-8 UTF-8
+te_IN UTF-8
+tg_TJ.UTF-8 UTF-8
+tg_TJ KOI8-T
+th_TH.UTF-8 UTF-8
+th_TH TIS-620
+the_NP UTF-8
+ti_ER UTF-8
+ti_ET UTF-8
+tig_ER UTF-8
+tk_TM UTF-8
+tl_PH.UTF-8 UTF-8
+tl_PH ISO-8859-1
+tn_ZA UTF-8
+to_TO UTF-8
+tpi_PG UTF-8
+tr_CY.UTF-8 UTF-8
+tr_CY ISO-8859-9
+tr_TR.UTF-8 UTF-8
+tr_TR ISO-8859-9
+ts_ZA UTF-8
+tt_RU UTF-8
+tt_RU@iqtelif UTF-8
+ug_CN UTF-8
+uk_UA.UTF-8 UTF-8
+uk_UA KOI8-U
+unm_US UTF-8
+ur_IN UTF-8
+ur_PK UTF-8
+uz_UZ.UTF-8 UTF-8
+uz_UZ ISO-8859-1
+uz_UZ@cyrillic UTF-8
+ve_ZA UTF-8
+vi_VN UTF-8
+wa_BE ISO-8859-1
+wa_BE@euro ISO-8859-15
+wa_BE.UTF-8 UTF-8
+wae_CH UTF-8
+wal_ET UTF-8
+wo_SN UTF-8
+xh_ZA.UTF-8 UTF-8
+xh_ZA ISO-8859-1
+yi_US.UTF-8 UTF-8
+yi_US CP1255
+yo_NG UTF-8
+yue_HK UTF-8
+yuw_PG UTF-8
+zh_CN.GB18030 GB18030
+zh_CN.GBK GBK
+zh_CN.UTF-8 UTF-8
+zh_CN GB2312
+zh_HK.UTF-8 UTF-8
+zh_HK BIG5-HKSCS
+zh_SG.UTF-8 UTF-8
+zh_SG.GBK GBK
+zh_SG GB2312
+zh_TW.EUC-TW EUC-TW
+zh_TW.UTF-8 UTF-8
+zh_TW BIG5
+zu_ZA.UTF-8 UTF-8
+zu_ZA ISO-8859-1
diff --git a/gnu/installer/aux-files/logo.txt b/gnu/installer/aux-files/logo.txt
new file mode 100644
index 0000000000..52418d88c1
--- /dev/null
+++ b/gnu/installer/aux-files/logo.txt
@@ -0,0 +1,19 @@
+ ░░░                                     ░░░
+ ░░▒▒░░░░░░░░░               ░░░░░░░░░▒▒░░
+  ░░▒▒▒▒▒░░░░░░░           ░░░░░░░▒▒▒▒▒░
+      ░▒▒▒░░▒▒▒▒▒         ░░░░░░░▒▒░
+            ░▒▒▒▒░       ░░░░░░
+             ▒▒▒▒▒      ░░░░░░
+              ▒▒▒▒▒     ░░░░░
+              ░▒▒▒▒▒   ░░░░░
+               ▒▒▒▒▒   ░░░░░
+                ▒▒▒▒▒ ░░░░░
+                ░▒▒▒▒▒░░░░░
+                 ▒▒▒▒▒▒░░░
+                  ▒▒▒▒▒▒░
+  _____ _   _ _    _    _____       _
+ / ____| \ | | |  | |  / ____|     (_)
+| |  __|  \| | |  | | | |  __ _   _ ___  __
+| | |_ | . ' | |  | | | | |_ | | | | \ \/ /
+| |__| | |\  | |__| | | |__| | |_| | |>  <
+ \_____|_| \_|\____/   \_____|\__,_|_/_/\_\
diff --git a/gnu/installer/build-installer.scm b/gnu/installer/build-installer.scm
new file mode 100644
index 0000000000..1a084bc3dc
--- /dev/null
+++ b/gnu/installer/build-installer.scm
@@ -0,0 +1,290 @@
+;;; 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 build-installer)
+  #: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)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages connman)
+  #: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 installer
+                              #: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 "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)))
+    #~(let ((result
+             (#$(installer-locale-page installer)
+              #:supported-locales #$locales-loader
+              #:iso639-languages #$iso639-loader
+              #:iso3166-territories #$iso3166-loader)))
+        (#$apply-locale result))))
+
+(define apply-keymap
+  ;; Apply the specified keymap.
+  #~(match-lambda
+      ((model layout variant)
+       (kmscon-update-keymap model layout variant))))
+
+(define* (compute-keymap-step installer)
+  "Return a gexp that runs the keymap-page of INSTALLER and install the
+selected keymap."
+  #~(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 installer)
+                #:models models
+                #:layouts layouts)))))
+      (#$apply-keymap result)))
+
+(define (installer-steps installer)
+  (let ((locale-step (compute-locale-step
+                      installer
+                      #:locales-name "locales"
+                      #:iso639-languages-name "iso639-languages"
+                      #:iso3166-territories-name "iso3166-territories"))
+        (keymap-step (compute-keymap-step installer))
+        (timezone-data #~(string-append #$tzdata
+                                        "/share/zoneinfo/zone.tab")))
+    #~(list
+       ;; Welcome the user and ask him to choose between manual installation
+       ;; and graphical install.
+       (installer-step
+        (id 'welcome)
+        (compute (lambda _
+                   #$(installer-welcome-page installer))))
+
+       ;; 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 selection"))
+        (compute (lambda _
+                   #$locale-step)))
+
+       ;; Ask the user to select a timezone under glibc format.
+       (installer-step
+        (id 'timezone)
+        (description (G_ "Timezone selection"))
+        (compute (lambda _
+                   (#$(installer-timezone-page installer)
+                    #$timezone-data))))
+
+       ;; 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)))
+
+       ;; Ask the user to input a hostname for the system.
+       (installer-step
+        (id 'hostname)
+        (description (G_ "Hostname selection"))
+        (compute (lambda _
+                   #$(installer-hostname-page installer))))
+
+       ;; 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 installer))))
+
+       ;; Prompt for users (name, group and home directory).
+       (installer-step
+        (id 'hostname)
+        (description (G_ "User selection"))
+        (compute (lambda _
+                   #$(installer-user-page installer)))))))
+
+(define (installer-program installer)
+  "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 connman shadow)
+                         (map canonical-package (list coreutils)))))
+        (with-output-to-port (%make-void-port "w")
+          (lambda ()
+            (set-path-environment-variable "PATH" '("bin" "sbin") inputs)))))
+
+  (define installer-builder
+    (with-extensions (list guile-gcrypt guile-newt guile-json)
+      (with-imported-modules `(,@(source-module-closure
+                                  `(,@(installer-modules installer)
+                                    (guix build utils))
+                                  #:select? not-config?)
+                               ((guix config) => ,(make-config.scm)))
+        #~(begin
+            (use-modules (gnu installer keymap)
+                         (gnu installer steps)
+                         (gnu installer locale)
+                         #$@(installer-modules installer)
+                         (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
+
+            #$(installer-init installer)
+
+            (catch #t
+              (lambda ()
+                (run-installer-steps
+                 #:rewind-strategy 'menu
+                 #:menu-proc #$(installer-menu-page installer)
+                 #:steps #$(installer-steps installer)))
+              (const #f)
+              (lambda (key . args)
+                (#$(installer-exit-error 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 installer)))))
+
+  (program-file "installer" installer-builder))
diff --git a/gnu/installer/connman.scm b/gnu/installer/connman.scm
new file mode 100644
index 0000000000..740df7424a
--- /dev/null
+++ b/gnu/installer/connman.scm
@@ -0,0 +1,400 @@
+;;; 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 connman)
+  #:use-module (gnu installer utils)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (<technology>
+            technology
+            technology?
+            technology-name
+            technology-type
+            technology-powered?
+            technology-connected?
+
+            <service>
+            service
+            service?
+            service-name
+            service-type
+            service-path
+            service-strength
+            service-state
+
+            &connman-error
+            connman-error?
+            connman-error-command
+            connman-error-output
+            connman-error-status
+
+            &connman-connection-error
+            connman-connection-error?
+            connman-connection-error-service
+            connman-connection-error-output
+
+            &connman-password-error
+            connman-password-error?
+
+            &connman-already-connected-error
+            connman-already-connected-error?
+
+            connman-state
+            connman-technologies
+            connman-enable-technology
+            connman-disable-technology
+            connman-scan-technology
+            connman-services
+            connman-connect
+            connman-disconnect
+            connman-online?
+            connman-connect-with-auth))
+
+;;; Commentary:
+;;;
+;;; This module provides procedures for talking with the connman daemon.
+;;; The best approach would have been using connman dbus interface.
+;;; However, as Guile dbus bindings are not available yet, the console client
+;;; "connmanctl" is used to talk with the daemon.
+;;;
+
+
+;;;
+;;; Technology record.
+;;;
+
+;; The <technology> record encapsulates the "Technology" object of connman.
+;; Technology type will be typically "ethernet", "wifi" or "bluetooth".
+
+(define-record-type* <technology>
+  technology make-technology
+  technology?
+  (name            technology-name) ; string
+  (type            technology-type) ; string
+  (powered?        technology-powered?) ; boolean
+  (connected?      technology-connected?)) ; boolean
+
+
+;;;
+;;; Service record.
+;;;
+
+;; The <service> record encapsulates the "Service" object of connman.
+;; Service type is the same as the technology it is associated to, path is a
+;; unique identifier given by connman, strength describes the signal quality
+;; if applicable. Finally, state is "idle", "failure", "association",
+;; "configuration", "ready", "disconnect" or "online".
+
+(define-record-type* <service>
+  service make-service
+  service?
+  (name            service-name) ; string
+  (type            service-type) ; string
+  (path            service-path) ; string
+  (strength        service-strength) ; integer
+  (state           service-state)) ; string
+
+
+;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &connman-error &error
+  connman-error?
+  (command connman-error-command)
+  (output connman-error-output)
+  (status connman-error-status))
+
+(define-condition-type &connman-connection-error &error
+  connman-connection-error?
+  (service connman-connection-error-service)
+  (output  connman-connection-error-output))
+
+(define-condition-type &connman-password-error &connman-connection-error
+  connman-password-error?)
+
+(define-condition-type &connman-already-connected-error
+  &connman-connection-error connman-already-connected-error?)
+
+
+;;;
+;;; Procedures.
+;;;
+
+(define (connman-run command env arguments)
+  "Run the given COMMAND, with the specified ENV and ARGUMENTS.  The error
+output is discarded and &connman-error condition is raised if the command
+returns a non zero exit code."
+  (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null"))
+         (command-string (string-join command " "))
+         (pipe (open-input-pipe command-string))
+         (output (read-lines pipe))
+         (ret (close-pipe pipe)))
+    (case (status:exit-val ret)
+      ((0) output)
+      (else (raise (condition (&connman-error
+                               (command command)
+                               (output output)
+                               (status ret))))))))
+
+(define (connman . arguments)
+  "Run connmanctl with the specified ARGUMENTS. Set the LANG environment
+variable to C because the command output will be parsed and we don't want it
+to be translated."
+  (connman-run "connmanctl" "LANG=C" arguments))
+
+(define (parse-keys keys)
+  "Parse the given list of strings KEYS, under the following format:
+
+     '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...)
+
+Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
+...)  elements."
+  (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)")))
+    (map (lambda (key)
+           (let ((match-key (regexp-exec key-regex key)))
+             (cons (match:substring match-key 1)
+                   (match:substring match-key 2))))
+         keys)))
+
+(define (connman-state)
+  "Return the state of connman. The nominal states are 'offline, 'idle,
+'ready, 'oneline.  If an unexpected state is read, 'unknown is
+returned. Finally, an error is raised if the comman output could not be
+parsed, usually because the connman daemon is not responding."
+  (let* ((output (connman "state"))
+         (state-keys (parse-keys output)))
+    (let ((state (assoc-ref state-keys "State")))
+      (if state
+          (cond ((string=? state "offline") 'offline)
+                ((string=? state "idle") 'idle)
+                ((string=? state "ready") 'ready)
+                ((string=? state "online") 'online)
+                (else 'unknown))
+          (raise (condition
+                  (&message
+                   (message "Could not determine the state of connman."))))))))
+
+(define (split-technology-list technologies)
+  "Parse the given strings list TECHNOLOGIES, under the following format:
+
+	'((\"/net/connman/technology/xxx\")
+          (\"KEY = VALUE\")
+          ...
+          (\"/net/connman/technology/yyy\")
+          (\"KEY2 = VALUE2\")
+          ...)
+ Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...))
+list so that each keys of a given technology are gathered in a separate list."
+  (let loop ((result '())
+             (cur-list '())
+             (input (reverse technologies)))
+    (if (null? input)
+        result
+        (let ((item (car input)))
+          (if (string-match "/net/connman/technology" item)
+              (loop (cons cur-list result) '() (cdr input))
+              (loop result (cons item cur-list) (cdr input)))))))
+
+(define (string->boolean string)
+  (equal? string "True"))
+
+(define (connman-technologies)
+  "Return a list of available <technology> records."
+
+  (define (technology-output->technology output)
+    (let ((keys (parse-keys output)))
+      (technology
+       (name (assoc-ref keys "Name"))
+       (type (assoc-ref keys "Type"))
+       (powered? (string->boolean (assoc-ref keys "Powered")))
+       (connected? (string->boolean (assoc-ref keys "Connected"))))))
+
+  (let* ((output (connman "technologies"))
+         (technologies (split-technology-list output)))
+    (map technology-output->technology technologies)))
+
+(define (connman-enable-technology technology)
+  "Enable the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "enable" type)))
+
+(define (connman-disable-technology technology)
+  "Disable the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "disable" type)))
+
+(define (connman-scan-technology technology)
+  "Run a scan for the given TECHNOLOGY."
+  (let ((type (technology-type technology)))
+    (connman "scan" type)))
+
+(define (connman-services)
+  "Return a list of available <services> records."
+
+  (define (service-output->service path output)
+    (let* ((service-keys
+            (match output
+              ((_ . rest) rest)))
+           (keys (parse-keys service-keys)))
+      (service
+       (name (assoc-ref keys "Name"))
+       (type (assoc-ref keys "Type"))
+       (path path)
+       (strength (and=> (assoc-ref keys "Strength") string->number))
+       (state (assoc-ref keys "State")))))
+
+  (let* ((out (connman "services"))
+         (out-filtered (delete "" out))
+         (services-path (map (lambda (service)
+                               (match (string-split service #\ )
+                                 ((_ ... path) path)))
+                             out-filtered))
+         (services-output (map (lambda (service)
+                                 (connman "services" service))
+                               services-path)))
+    (map service-output->service services-path services-output)))
+
+(define (connman-connect service)
+  "Connect to the given SERVICE."
+  (let ((path (service-path service)))
+    (connman "connect" path)))
+
+(define (connman-disconnect service)
+  "Disconnect from the given SERVICE."
+  (let ((path (service-path service)))
+    (connman "disconnect" path)))
+
+(define (connman-online?)
+  (let ((state (connman-state)))
+    (eq? state 'online)))
+
+(define (connman-connect-with-auth service password-proc)
+  "Connect to the given SERVICE with the password returned by calling
+PASSWORD-PROC. This is only possible in the interactive mode of connmanctl
+because authentication is done by communicating with an agent.
+
+As the open-pipe procedure of Guile do not allow to read from stderr, we have
+to merge stdout and stderr using bash redirection. Then error messages are
+extracted from connmanctl output using a regexp. This makes the whole
+procedure even more unreliable.
+
+Raise &connman-connection-error if an error occured during connection. Raise
+&connman-password-error if the given password is incorrect."
+
+  (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n"))
+
+  (define (match-connman-error str)
+    (let ((match-error (regexp-exec connman-error-regexp str)))
+      (and match-error (match:substring match-error 1))))
+
+  (define* (read-regexps-or-error port regexps error-handler)
+    "Read characters from port until an error is detected, or one of the given
+REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error
+string as argument. Raise an error if the eof is reached before one of the
+regexps is matched."
+    (let loop ((res ""))
+      (let ((char (read-char port)))
+        (cond
+         ((eof-object? char)
+          (raise (condition
+                  (&message
+                   (message "Unable to find expected regexp.")))))
+         ((match-connman-error res)
+          =>
+          (lambda (match)
+            (error-handler match)))
+         ((or-map (lambda (regexp)
+                    (and (regexp-exec regexp res) regexp))
+                  regexps)
+          =>
+          (lambda (match)
+            match))
+         (else
+          (loop (string-append res (string char))))))))
+
+  (define* (read-regexp-or-error port regexp error-handler)
+    "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP."
+    (read-regexps-or-error port (list regexp) error-handler))
+
+  (define (connman-error->condition path error)
+    (cond
+     ((string-match "Already connected" error)
+      (condition (&connman-already-connected-error
+                  (service path)
+                  (output error))))
+     (else
+      (condition (&connman-connection-error
+                  (service path)
+                  (output error))))))
+
+  (define (run-connection-sequence pipe)
+    "Run the connection sequence using PIPE as an opened port to an
+interactive connmanctl process."
+    (let* ((path (service-path service))
+           (error-handler (lambda (error)
+                            (raise
+                             (connman-error->condition path error)))))
+      ;; Start the agent.
+      (format pipe "agent on\n")
+      (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler)
+
+      ;; Let's try to connect to the service. If the service does not require
+      ;; a password, the connection might succeed right after this call.
+      ;; Otherwise, connmanctl will prompt us for a password.
+      (format pipe "connect ~a\n" path)
+      (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path)))
+             (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*"))
+             (regexps (list connected-regexp passphrase-regexp))
+             (result (read-regexps-or-error pipe regexps error-handler)))
+
+        ;; A password is required.
+        (when (eq? result passphrase-regexp)
+          (format pipe "~a~%" (password-proc))
+
+          ;; Now, we have to wait for the connection to succeed. If an error
+          ;; occurs, it is most likely because the password is incorrect.
+          ;; In that case, we escape from an eventual retry loop that would
+          ;; add complexity to this procedure, and raise a
+          ;; &connman-password-error condition.
+          (read-regexp-or-error pipe connected-regexp
+                                (lambda (error)
+                                  ;; Escape from retry loop.
+                                  (format pipe "no\n")
+                                  (raise
+                                   (condition (&connman-password-error
+                                               (service path)
+                                               (output error))))))))))
+
+  ;; XXX: Find a better way to read stderr, like with the "subprocess"
+  ;; procedure of racket that return input ports piped on the process stdin and
+  ;; stderr.
+  (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (run-connection-sequence pipe)
+        #t)
+      (lambda ()
+        (format pipe "quit\n")
+        (close-pipe pipe)))))
diff --git a/gnu/installer/keymap.scm b/gnu/installer/keymap.scm
new file mode 100644
index 0000000000..78065aa6c6
--- /dev/null
+++ b/gnu/installer/keymap.scm
@@ -0,0 +1,162 @@
+;;; 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 keymap)
+  #:use-module (guix records)
+  #:use-module (sxml match)
+  #:use-module (sxml simple)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (<x11-keymap-model>
+            x11-keymap-model
+            make-x11-keymap-model
+            x11-keymap-model?
+            x11-keymap-model-name
+            x11-keymap-model-description
+
+            <x11-keymap-layout>
+            x11-keymap-layout
+            make-x11-keymap-layout
+            x11-keymap-layout?
+            x11-keymap-layout-name
+            x11-keymap-layout-description
+            x11-keymap-layout-variants
+
+            <x11-keymap-variant>
+            x11-keymap-variant
+            make-x11-keymap-variant
+            x11-keymap-variant?
+            x11-keymap-variant-name
+            x11-keymap-variant-description
+
+            xkb-rules->models+layouts
+            kmscon-update-keymap))
+
+(define-record-type* <x11-keymap-model>
+  x11-keymap-model make-x11-keymap-model
+  x11-keymap-model?
+  (name            x11-keymap-model-name) ;string
+  (description     x11-keymap-model-description)) ;string
+
+(define-record-type* <x11-keymap-layout>
+  x11-keymap-layout make-x11-keymap-layout
+  x11-keymap-layout?
+  (name            x11-keymap-layout-name) ;string
+  (description     x11-keymap-layout-description) ;string
+  (variants        x11-keymap-layout-variants)) ;list of <x11-keymap-variant>
+
+(define-record-type* <x11-keymap-variant>
+  x11-keymap-variant make-x11-keymap-variant
+  x11-keymap-variant?
+  (name            x11-keymap-variant-name) ;string
+  (description     x11-keymap-variant-description)) ;string
+
+(define (xkb-rules->models+layouts file)
+  "Parse FILE and return two values, the list of supported X11-KEYMAP-MODEL
+and X11-KEYMAP-LAYOUT records. FILE is an XML file from the X Keyboard
+Configuration Database, describing possible XKB configurations."
+  (define (model m)
+    (sxml-match m
+                [(model
+                  (configItem
+                   (name ,name)
+                   (description ,description)
+                   . ,rest))
+                 (x11-keymap-model
+                  (name name)
+                  (description description))]))
+
+  (define (variant v)
+    (sxml-match v
+                [(variant
+                  ;; According to xbd-rules DTD, the definition of a
+                  ;; configItem is: <!ELEMENT configItem
+                  ;; (name,shortDescription*,description*,vendor?,
+                  ;; countryList?,languageList?,hwList?)>
+                  ;;
+                  ;; shortDescription and description are optional elements
+                  ;; but sxml-match does not support default values for
+                  ;; elements (only attributes). So to avoid writing as many
+                  ;; patterns as existing possibilities, gather all the
+                  ;; remaining elements but name in REST-VARIANT.
+                  (configItem
+                   (name ,name)
+                   . ,rest-variant))
+                 (x11-keymap-variant
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-variant 'description))))]))
+
+  (define (layout l)
+    (sxml-match l
+                [(layout
+                  (configItem
+                   (name ,name)
+                   . ,rest-layout)
+                  (variantList ,[variant -> v] ...))
+                 (x11-keymap-layout
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-layout 'description)))
+                  (variants (list v ...)))]
+                [(layout
+                  (configItem
+                   (name ,name)
+                   . ,rest-layout))
+                 (x11-keymap-layout
+                  (name name)
+                  (description (car
+                                (assoc-ref rest-layout 'description)))
+                  (variants '()))]))
+
+  (let ((sxml (call-with-input-file file
+                (lambda (port)
+                  (xml->sxml port #:trim-whitespace? #t)))))
+    (match
+        (sxml-match sxml
+                    [(*TOP*
+                      ,pi
+                      (xkbConfigRegistry
+                       (@ . ,ignored)
+                       (modelList ,[model -> m] ...)
+                       (layoutList ,[layout -> l] ...)
+                       . ,rest))
+                     (list
+                      (list m ...)
+                      (list l ...))])
+      ((models layouts)
+       (values models layouts)))))
+
+(define (kmscon-update-keymap model layout variant)
+  (let ((keymap-file (getenv "KEYMAP_UPDATE")))
+    (unless (and keymap-file
+                 (file-exists? keymap-file))
+      (error "Unable to locate keymap update file"))
+
+    (call-with-output-file keymap-file
+        (lambda (port)
+          (format port model)
+          (put-u8 port 0)
+
+          (format port layout)
+          (put-u8 port 0)
+
+          (format port variant)
+          (put-u8 port 0)))))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
new file mode 100644
index 0000000000..504070d41d
--- /dev/null
+++ b/gnu/installer/locale.scm
@@ -0,0 +1,199 @@
+;;; 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 locale)
+  #:use-module (gnu installer utils)
+  #:use-module (guix records)
+  #:use-module (json)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:export (locale-language
+            locale-territory
+            locale-codeset
+            locale-modifier
+
+            locale->locale-string
+            supported-locales->locales
+
+            iso639->iso639-languages
+            language-code->language-name
+
+            iso3166->iso3166-territories
+            territory-code->territory-name))
+
+
+;;;
+;;; Locale.
+;;;
+
+;; A glibc locale string has the following format:
+;; language[_territory[.codeset][@modifier]].
+(define locale-regexp "^([^_@]+)(_([^\\.@]+))?(\\.([^@]+))?(@([^$]+))?$")
+
+;; LOCALE will be better expressed in a (guix record) that in an association
+;; list. However, loading large files containing records does not scale
+;; well. The same thing goes for ISO639 and ISO3166 association lists used
+;; later in this module.
+(define (locale-language assoc)
+  (assoc-ref assoc 'language))
+(define (locale-territory assoc)
+  (assoc-ref assoc 'territory))
+(define (locale-codeset assoc)
+  (assoc-ref assoc 'codeset))
+(define (locale-modifier assoc)
+  (assoc-ref assoc 'modifier))
+
+(define (locale-string->locale string)
+  "Return the locale association list built from the parsing of STRING."
+  (let ((matches (string-match locale-regexp string)))
+    `((language  . ,(match:substring matches 1))
+      (territory . ,(match:substring matches 3))
+      (codeset   . ,(match:substring matches 5))
+      (modifier  . ,(match:substring matches 7)))))
+
+(define (locale->locale-string locale)
+  "Reverse operation of locale-string->locale."
+  (let ((language (locale-language locale))
+        (territory (locale-territory locale))
+        (codeset (locale-codeset locale))
+        (modifier (locale-modifier locale)))
+    (apply string-append
+           `(,language
+             ,@(if territory
+                   `("_" ,territory)
+                   '())
+             ,@(if codeset
+                   `("." ,codeset)
+                   '())
+             ,@(if modifier
+                   `("@" ,modifier)
+                   '())))))
+
+(define (supported-locales->locales supported-locales)
+  "Parse the SUPPORTED-LOCALES file from the glibc and return the matching
+list of LOCALE association lists."
+ (call-with-input-file supported-locales
+    (lambda (port)
+      (let ((lines (read-lines port)))
+        (map (lambda (line)
+               (match (string-split line #\ )
+                 ((locale-string codeset)
+                  (let ((line-locale (locale-string->locale locale-string)))
+                    (assoc-set! line-locale 'codeset codeset)))))
+             lines)))))
+
+
+;;;
+;;; Language.
+;;;
+
+(define (iso639-language-alpha2 assoc)
+  (assoc-ref assoc 'alpha2))
+
+(define (iso639-language-alpha3 assoc)
+  (assoc-ref assoc 'alpha3))
+
+(define (iso639-language-name assoc)
+  (assoc-ref assoc 'name))
+
+(define (supported-locale? locales alpha2 alpha3)
+  "Find a locale in LOCALES whose alpha2 field matches ALPHA-2 or alpha3 field
+matches ALPHA-3. The ISO639 standard specifies that ALPHA-2 is optional. Thus,
+if ALPHA-2 is #f, only consider ALPHA-3. Return #f if not matching locale was
+found."
+  (find (lambda (locale)
+          (let ((language (locale-language locale)))
+            (or (and=> alpha2
+                       (lambda (code)
+                         (string=? language code)))
+                (string=? language alpha3))))
+        locales))
+
+(define (iso639->iso639-languages locales iso639-3 iso639-5)
+  "Return a list of ISO639 association lists created from the parsing of
+ISO639-3 and ISO639-5 files."
+  (call-with-input-file iso639-3
+    (lambda (port-iso639-3)
+      (call-with-input-file iso639-5
+        (lambda (port-iso639-5)
+          (filter-map
+           (lambda (hash)
+             (let ((alpha2 (hash-ref hash "alpha_2"))
+                   (alpha3 (hash-ref hash "alpha_3"))
+                   (name   (hash-ref hash "name")))
+               (and (supported-locale? locales alpha2 alpha3)
+                    `((alpha2 . ,alpha2)
+                      (alpha3 . ,alpha3)
+                      (name   . ,name)))))
+           (append
+            (hash-ref (json->scm port-iso639-3) "639-3")
+            (hash-ref (json->scm port-iso639-5) "639-5"))))))))
+
+(define (language-code->language-name languages language-code)
+  "Using LANGUAGES as a list of ISO639 association lists, return the language
+name corresponding to the given LANGUAGE-CODE."
+  (let ((iso639-language
+         (find (lambda (language)
+                 (or
+                  (and=> (iso639-language-alpha2 language)
+                         (lambda (alpha2)
+                           (string=? alpha2 language-code)))
+                  (string=? (iso639-language-alpha3 language)
+                            language-code)))
+               languages)))
+    (iso639-language-name iso639-language)))
+
+
+;;;
+;;; Territory.
+;;;
+
+(define (iso3166-territory-alpha2 assoc)
+  (assoc-ref assoc 'alpha2))
+
+(define (iso3166-territory-alpha3 assoc)
+  (assoc-ref assoc 'alpha3))
+
+(define (iso3166-territory-name assoc)
+  (assoc-ref assoc 'name))
+
+(define (iso3166->iso3166-territories iso3166)
+  "Return a list of ISO3166 association lists created from the parsing of
+ISO3166 file."
+  (call-with-input-file iso3166
+    (lambda (port)
+      (map (lambda (hash)
+             `((alpha2 . ,(hash-ref hash "alpha_2"))
+               (alpha3 . ,(hash-ref hash "alpha_3"))
+               (name   . ,(hash-ref hash "name"))))
+           (hash-ref (json->scm port) "3166-1")))))
+
+(define (territory-code->territory-name territories territory-code)
+  "Using TERRITORIES as a list of ISO3166 association lists return the
+territory name corresponding to the given TERRITORY-CODE."
+  (let ((iso3166-territory
+         (find (lambda (territory)
+                 (or
+                  (and=> (iso3166-territory-alpha2 territory)
+                         (lambda (alpha2)
+                           (string=? alpha2 territory-code)))
+                  (string=? (iso3166-territory-alpha3 territory)
+                            territory-code)))
+               territories)))
+    (iso3166-territory-name iso3166-territory)))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
new file mode 100644
index 0000000000..abf752959b
--- /dev/null
+++ b/gnu/installer/newt.scm
@@ -0,0 +1,102 @@
+;;; 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 newt)
+  #:use-module (gnu installer)
+  #:use-module (guix discovery)
+  #:use-module (guix gexp)
+  #:use-module (guix ui)
+  #:export (newt-installer))
+
+(define (modules)
+  (cons '(newt)
+        (map module-name
+             (scheme-modules
+              (dirname (search-path %load-path "guix.scm"))
+              "gnu/installer/newt"
+              #:warn warn-about-load-error))))
+
+(define init
+  #~(begin
+      (newt-init)
+      (clear-screen)
+      (set-screen-size!)))
+
+(define exit
+  #~(begin
+      (newt-finish)))
+
+(define exit-error
+  #~(lambda (key args)
+      (newt-finish)))
+
+(define locale-page
+  #~(lambda* (#:key
+              supported-locales
+              iso639-languages
+              iso3166-territories)
+      (run-locale-page
+       #:supported-locales supported-locales
+       #:iso639-languages iso639-languages
+       #:iso3166-territories iso3166-territories)))
+
+(define timezone-page
+  #~(lambda* (zonetab)
+      (run-timezone-page zonetab)))
+
+(define logo
+  (string-append
+   (dirname (search-path %load-path "guix.scm"))
+   "/gnu/installer/aux-files/logo.txt"))
+
+(define welcome-page
+  #~(run-welcome-page #$(local-file logo)))
+
+(define menu-page
+  #~(lambda (steps)
+      (run-menu-page steps)))
+
+(define keymap-page
+  #~(lambda* (#:key models layouts)
+      (run-keymap-page #:models models
+                       #:layouts layouts)))
+
+(define network-page
+  #~(run-network-page))
+
+(define hostname-page
+  #~(run-hostname-page))
+
+(define user-page
+  #~(run-user-page))
+
+(define newt-installer
+  (installer
+   (name 'newt)
+   (modules (modules))
+   (init init)
+   (exit exit)
+   (exit-error exit-error)
+   (keymap-page keymap-page)
+   (locale-page locale-page)
+   (menu-page menu-page)
+   (network-page network-page)
+   (timezone-page timezone-page)
+   (hostname-page hostname-page)
+   (user-page user-page)
+   (welcome-page welcome-page)))
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
new file mode 100644
index 0000000000..2cbbfddacd
--- /dev/null
+++ b/gnu/installer/newt/ethernet.scm
@@ -0,0 +1,80 @@
+;;; 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 newt ethernet)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-ethernet-page))
+
+(define (ethernet-services)
+  "Return all the connman services of ethernet type."
+  (let ((services (connman-services)))
+    (filter (lambda (service)
+              (and (string=? (service-type service) "ethernet")
+                   (not (string-null? (service-name service)))))
+            services)))
+
+(define (ethernet-service->text service)
+  "Return a string describing the given ethernet SERVICE."
+  (let* ((name (service-name service))
+         (path (service-path service))
+         (full-name (string-append name "-" path))
+         (state (service-state service))
+         (connected? (or (string=? state "online")
+                         (string=? state "ready"))))
+    (format #f "~c ~a~%"
+            (if connected? #\* #\ )
+            full-name)))
+
+(define (connect-ethernet-service service)
+  "Connect to the given ethernet SERVICE. Display a connecting page while the
+connection is pending."
+  (let* ((service-name (service-name service))
+         (form (draw-connecting-page service-name)))
+    (connman-connect service)
+    (destroy-form-and-pop form)))
+
+(define (run-ethernet-page)
+  (let ((services (ethernet-services)))
+    (if (null? services)
+        (begin
+          (run-error-page
+           (G_ "No ethernet service available, please try again.")
+           (G_ "No service"))
+          (raise
+           (condition
+            (&installer-step-abort))))
+        (run-listbox-selection-page
+         #:info-text (G_ "Please select an ethernet network.")
+         #:title (G_ "Ethernet connection")
+         #:listbox-items services
+         #:listbox-item->text ethernet-service->text
+         #:button-text (G_ "Cancel")
+         #:button-callback-procedure
+         (lambda _
+           (raise
+            (condition
+             (&installer-step-abort))))
+         #:listbox-callback-procedure connect-ethernet-service))))
diff --git a/gnu/installer/newt/hostname.scm b/gnu/installer/newt/hostname.scm
new file mode 100644
index 0000000000..acbee64a6a
--- /dev/null
+++ b/gnu/installer/newt/hostname.scm
@@ -0,0 +1,26 @@
+;;; 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 newt hostname)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:export (run-hostname-page))
+
+(define (run-hostname-page)
+  (run-input-page (G_ "Please enter the system hostname")
+                  (G_ "Hostname selection")))
diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm
new file mode 100644
index 0000000000..219ac3f8e2
--- /dev/null
+++ b/gnu/installer/newt/keymap.scm
@@ -0,0 +1,132 @@
+;;; 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 newt keymap)
+  #:use-module (gnu installer keymap)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (newt)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (run-keymap-page))
+
+(define (run-layout-page layouts layout->text)
+  (let ((title (G_ "Layout selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Please choose your keyboard layout.")
+     #:listbox-items layouts
+     #:listbox-item->text layout->text
+     #:button-text (G_ "Cancel")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-variant-page variants variant->text)
+  (let ((title (G_ "Variant selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Please choose a variant for your keyboard layout.")
+     #:listbox-items variants
+     #:listbox-item->text variant->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-model-page models model->text)
+  (let ((title (G_ "Keyboard model selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Please choose your keyboard model.")
+     #:listbox-items models
+     #:listbox-item->text model->text
+     #:listbox-default-item (find (lambda (model)
+                                    (string=? (x11-keymap-model-name model)
+                                              "pc105"))
+                                  models)
+     #:sort-listbox-items? #f
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define* (run-keymap-page #:key models layouts)
+  "Run a page asking the user to select a keyboard model, layout and
+variant. MODELS and LAYOUTS are lists of supported X11-KEYMAP-MODEL and
+X11-KEYMAP-LAYOUT. Return a list of three elements, the names of the selected
+keyboard model, layout and variant."
+  (define keymap-steps
+    (list
+     (installer-step
+      (id 'model)
+      (compute
+       (lambda _
+         ;; TODO: Understand why (run-model-page models x11-keymap-model-name)
+         ;; fails with: warning: possibly unbound variable
+         ;; `%x11-keymap-model-description-procedure.
+         (run-model-page models (lambda (model)
+                                  (x11-keymap-model-description
+                                   model))))))
+     (installer-step
+      (id 'layout)
+      (compute
+       (lambda _
+         (let* ((layout (run-layout-page
+                         layouts
+                         (lambda (layout)
+                           (x11-keymap-layout-description layout)))))
+           (if (null? (x11-keymap-layout-variants layout))
+               ;; Break if this layout does not have any variant.
+               (raise
+                (condition
+                 (&installer-step-break)))
+               layout)))))
+     ;; Propose the user to select a variant among those supported by the
+     ;; previously selected layout.
+     (installer-step
+      (id 'variant)
+      (compute
+       (lambda (result)
+         (let ((variants (x11-keymap-layout-variants
+                          (result-step result 'layout))))
+           (run-variant-page variants
+                             (lambda (variant)
+                               (x11-keymap-variant-description
+                                variant)))))))))
+
+  (define (format-result result)
+    (let ((model (x11-keymap-model-name
+                  (result-step result 'model)))
+          (layout (x11-keymap-layout-name
+                   (result-step result 'layout)))
+          (variant (and=> (result-step result 'variant)
+                          (lambda (variant)
+                            (x11-keymap-variant-name variant)))))
+      (list model layout (or variant ""))))
+  (format-result
+   (run-installer-steps #:steps keymap-steps)))
diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm
new file mode 100644
index 0000000000..5444a07598
--- /dev/null
+++ b/gnu/installer/newt/locale.scm
@@ -0,0 +1,193 @@
+;;; 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 newt locale)
+  #:use-module (gnu installer locale)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:export (run-locale-page))
+
+(define (run-language-page languages language->text)
+  (let ((title (G_ "Language selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose the language to be used for the installation \
+process. The selected language will also be the default \
+language for the installed system.")
+     #:listbox-items languages
+     #:listbox-item->text language->text
+     #:button-text (G_ "Cancel")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-territory-page territories territory->text)
+  (let ((title (G_ "Location selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your location. This is a shortlist of locations \
+based on the language you selected.")
+     #:listbox-items territories
+     #:listbox-item->text territory->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-codeset-page codesets)
+  (let ((title (G_ "Codeset selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your codeset. If UTF-8 is available, it should be \
+preferred.")
+     #:listbox-items codesets
+     #:listbox-item->text identity
+     #:listbox-default-item "UTF-8"
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define (run-modifier-page modifiers modifier->text)
+  (let ((title (G_ "Modifier selection")))
+    (run-listbox-selection-page
+     #:title title
+     #:info-text (G_ "Choose your modifier.")
+     #:listbox-items modifiers
+     #:listbox-item->text modifier->text
+     #:button-text (G_ "Back")
+     #:button-callback-procedure
+     (lambda _
+       (raise
+        (condition
+         (&installer-step-abort)))))))
+
+(define* (run-locale-page #:key
+                          supported-locales
+                          iso639-languages
+                          iso3166-territories)
+
+  (define (break-on-locale-found locales)
+    "Raise the &installer-step-break condition if LOCALES contains exactly one
+element."
+    (and (= (length locales) 1)
+         (raise
+          (condition (&installer-step-break)))))
+
+  (define (filter-locales locales result)
+    "Filter the list of locale records LOCALES using the RESULT returned by
+the installer-steps defined below."
+    (filter
+     (lambda (locale)
+       (and-map identity
+                `(,(string=? (locale-language locale)
+                             (result-step result 'language))
+                  ,@(if (result-step-done? result 'territory)
+                        (list (equal? (locale-territory locale)
+                                      (result-step result 'territory)))
+                        '())
+                  ,@(if (result-step-done? result 'codeset)
+                        (list (equal? (locale-codeset locale)
+                                      (result-step result 'codeset)))
+                        '())
+                  ,@(if (result-step-done? result 'modifier)
+                        (list (equal? (locale-modifier locale)
+                                      (result-step result 'modifier)))
+                        '()))))
+     locales))
+
+  (define (result->locale-string locales result)
+    "Supposing that LOCALES contains exactly one locale record, turn it into a
+glibc locale string and return it."
+    (match (filter-locales locales result)
+      ((locale)
+       (locale->locale-string locale))))
+
+  (define locale-steps
+    (list
+     (installer-step
+      (id 'language)
+      (compute
+       (lambda _
+         (run-language-page
+          (delete-duplicates (map locale-language supported-locales))
+          (cut language-code->language-name iso639-languages <>)))))
+     (installer-step
+      (id 'territory)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Stop the process if the language returned by the previous step
+           ;; is matching one and only one supported locale.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask the user to select a territory among those
+           ;; supported by the previously selected language.
+           (run-territory-page
+            (delete-duplicates (map locale-territory locales))
+            (lambda (territory-code)
+              (if territory-code
+                  (territory-code->territory-name iso3166-territories
+                                                  territory-code)
+                  (G_ "No location"))))))))
+     (installer-step
+      (id 'codeset)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same as above but we now have a language and a territory to
+           ;; narrow down the search of a locale.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask for a codeset.
+           (run-codeset-page
+            (delete-duplicates (map locale-codeset locales)))))))
+     (installer-step
+      (id 'modifier)
+      (compute
+       (lambda (result)
+         (let ((locales (filter-locales supported-locales result)))
+           ;; Same thing with a language, a territory and a codeset this time.
+           (break-on-locale-found locales)
+
+           ;; Otherwise, ask for a modifier.
+           (run-modifier-page
+            (delete-duplicates (map locale-modifier locales))
+            (lambda (modifier)
+              (or modifier (G_ "No modifier"))))))))))
+
+  ;; If run-installer-steps returns locally, it means that the user had to go
+  ;; through all steps (language, territory, codeset and modifier) to select a
+  ;; locale. In that case, like if we exited by raising &installer-step-break
+  ;; condition, turn the result into a glibc locale string and return it.
+  (result->locale-string
+   supported-locales
+   (run-installer-steps #:steps locale-steps)))
diff --git a/gnu/installer/newt/menu.scm b/gnu/installer/newt/menu.scm
new file mode 100644
index 0000000000..756b582a50
--- /dev/null
+++ b/gnu/installer/newt/menu.scm
@@ -0,0 +1,44 @@
+;;; 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 newt menu)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:export (run-menu-page))
+
+(define (run-menu-page steps)
+  "Run a menu page, asking the user to select where to resume the install
+process from."
+  (define (steps->items steps)
+    (filter (lambda (step)
+              (installer-step-description step))
+            steps))
+
+  (run-listbox-selection-page
+   #:info-text (G_ "Choose where you want to resume the install.\
+You can also abort the installion by pressing the button.")
+   #:title (G_ "Installation menu")
+   #:listbox-items (steps->items steps)
+   #:listbox-item->text installer-step-description
+   #:sort-listbox-items? #f
+   #:button-text (G_ "Abort")
+   #:button-callback-procedure (lambda ()
+                                 (newt-finish)
+                                 (primitive-exit 1))))
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
new file mode 100644
index 0000000000..c6ba69d4e8
--- /dev/null
+++ b/gnu/installer/newt/network.scm
@@ -0,0 +1,159 @@
+;;; 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 newt network)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt ethernet)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt wifi)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-network-page))
+
+;; Maximum length of a technology name.
+(define technology-name-max-length (make-parameter 20))
+
+(define (technology->text technology)
+  "Return a string describing the given TECHNOLOGY."
+  (let* ((name (technology-name technology))
+         (padded-name (string-pad-right name
+                                        (technology-name-max-length))))
+    (format #f "~a~%" padded-name)))
+
+(define (run-technology-page)
+  "Run a page to ask the user which technology shall be used to access
+Internet and return the selected technology. For now, only technologies with
+\"ethernet\" or \"wifi\" types are supported."
+  (define (technology-items)
+    (filter (lambda (technology)
+              (let ((type (technology-type technology)))
+                (or
+                 (string=? type "ethernet")
+                 (string=? type "wifi"))))
+            (connman-technologies)))
+
+  (run-listbox-selection-page
+   #:info-text (G_ "The install process requires an internet access.\
+ Please select a network technology.")
+   #:title (G_ "Technology selection")
+   #:listbox-items (technology-items)
+   #:listbox-item->text technology->text
+   #:button-text (G_ "Cancel")
+   #:button-callback-procedure
+   (lambda _
+     (raise
+      (condition
+       (&installer-step-abort))))))
+
+(define (find-technology-by-type technologies type)
+  "Find and return a technology with the given TYPE in TECHNOLOGIES list."
+  (find (lambda (technology)
+          (string=? (technology-type technology)
+                    type))
+        technologies))
+
+(define (wait-technology-powered technology)
+  "Wait and display a progress bar until the given TECHNOLOGY is powered."
+  (let ((name (technology-name technology))
+        (full-value 5))
+    (run-scale-page
+     #:title (G_ "Powering technology")
+     #:info-text (format #f "Waiting for technology ~a to be powered." name)
+     #:scale-full-value full-value
+     #:scale-update-proc
+     (lambda (value)
+       (let* ((technologies (connman-technologies))
+              (type (technology-type technology))
+              (updated-technology
+               (find-technology-by-type technologies type))
+              (technology-powered? updated-technology))
+         (sleep 1)
+         (if technology-powered?
+             full-value
+             (+ value 1)))))))
+
+(define (wait-service-online)
+  "Display a newt scale until connman detects an Internet access. Do
+FULL-VALUE tentatives, spaced by 1 second."
+  (let* ((full-value 5))
+    (run-scale-page
+     #:title (G_ "Checking connectivity")
+     #:info-text (G_ "Waiting internet access is established")
+     #:scale-full-value full-value
+     #:scale-update-proc
+     (lambda (value)
+       (sleep 1)
+       (if (connman-online?)
+           full-value
+           (+ value 1))))
+    (unless (connman-online?)
+      (run-error-page
+       (G_ "The selected network does not provide an Internet \
+access, please try again.")
+       (G_ "Connection error"))
+      (raise
+       (condition
+        (&installer-step-abort))))))
+
+(define (run-network-page)
+  "Run a page to allow the user to configure connman so that it can access the
+Internet."
+  (define network-steps
+    (list
+     ;; Ask the user to choose between ethernet and wifi technologies.
+     (installer-step
+      (id 'select-technology)
+      (compute
+       (lambda _
+         (run-technology-page))))
+     ;; Enable the previously selected technology.
+     (installer-step
+      (id 'power-technology)
+      (compute
+       (lambda (result)
+         (let ((technology (result-step result 'select-technology)))
+           (connman-enable-technology technology)
+           (wait-technology-powered technology)))))
+     ;; Propose the user to connect to one of the service available for the
+     ;; previously selected technology.
+     (installer-step
+      (id 'connect-service)
+      (compute
+       (lambda (result)
+         (let* ((technology (result-step result 'select-technology))
+                (type (technology-type technology)))
+           (cond
+            ((string=? "wifi" type)
+             (run-wifi-page))
+            ((string=? "ethernet" type)
+             (run-ethernet-page)))))))
+     ;; Wait for connman status to switch to 'online, which means it can
+     ;; access Internet.
+     (installer-step
+      (id 'wait-online)
+      (compute (lambda _
+                 (wait-service-online))))))
+  (run-installer-steps
+   #:steps network-steps
+   #:rewind-strategy 'start))
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
new file mode 100644
index 0000000000..bcede3e333
--- /dev/null
+++ b/gnu/installer/newt/page.scm
@@ -0,0 +1,313 @@
+;;; 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 newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (draw-info-page
+            draw-connecting-page
+            run-input-page
+            run-error-page
+            run-listbox-selection-page
+            run-scale-page))
+
+;;; Commentary:
+;;;
+;;; Some helpers around guile-newt to draw or run generic pages. The
+;;; difference between 'draw' and 'run' terms comes from newt library. A page
+;;; is drawn when the form it contains does not expect any user
+;;; interaction. In that case, it is necessary to call (newt-refresh) to force
+;;; the page to be displayed. When a form is 'run', it is blocked waiting for
+;;; any action from the user (press a button, input some text, ...).
+;;;
+;;; Code:
+
+(define (draw-info-page text title)
+  "Draw an informative page with the given TEXT as content.  Set the title of
+this page to TITLE."
+  (let* ((text-box
+          (make-reflowed-textbox -1 -1 text 40
+                                 #:flags FLAG-BORDER))
+         (grid (make-grid 1 1))
+         (form (make-form)))
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (add-component-to-form form text-box)
+    (make-wrapped-grid-window grid title)
+    (draw-form form)
+    ;; This call is imperative, otherwise the form won't be displayed. See the
+    ;; explanation in the above commentary.
+    (newt-refresh)
+    form))
+
+(define (draw-connecting-page service-name)
+  "Draw a page to indicate a connection in in progress."
+  (draw-info-page
+   (format #f (G_ "Connecting to ~a, please wait.") service-name)
+   (G_ "Connection in progress")))
+
+(define* (run-input-page text title
+                         #:key
+                         (allow-empty-input? #f)
+                         (input-field-width 40))
+  "Run a page to prompt user for an input. The given TEXT will be displayed
+above the input field. The page title is set to TITLE. Unless
+allow-empty-input? is set to #t, an error page will be displayed if the user
+enters an empty input."
+  (let* ((text-box
+          (make-reflowed-textbox -1 -1 text
+                                 input-field-width
+                                 #:flags FLAG-BORDER))
+         (grid (make-grid 1 3))
+         (input-entry (make-entry -1 -1 20))
+         (ok-button (make-button -1 -1 (G_ "Ok")))
+         (form (make-form)))
+
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT input-entry
+                    #:pad-top 1)
+    (set-grid-field grid 0 2 GRID-ELEMENT-COMPONENT ok-button
+                    #:pad-top 1)
+
+    (add-components-to-form form text-box input-entry ok-button)
+    (make-wrapped-grid-window grid title)
+    (let ((error-page (lambda ()
+                        (run-error-page (G_ "Please enter a non empty input")
+                                        (G_ "Empty input")))))
+      (let loop ()
+        (receive (exit-reason argument)
+            (run-form form)
+          (let ((input (entry-value input-entry)))
+            (if (and (not allow-empty-input?)
+                     (eq? exit-reason 'exit-component)
+                     (string=? input ""))
+                (begin
+                  ;; Display the error page.
+                  (error-page)
+                  ;; Set the focus back to the input input field.
+                  (set-current-component form input-entry)
+                  (loop))
+                (begin
+                  (destroy-form-and-pop form)
+                  input))))))))
+
+(define (run-error-page text title)
+  "Run a page to inform the user of an error. The page contains the given TEXT
+to explain the error and an \"OK\" button to acknowledge the error. The title
+of the page is set to TITLE."
+  (let* ((text-box
+          (make-reflowed-textbox -1 -1 text 40
+                                 #:flags FLAG-BORDER))
+         (grid (make-grid 1 2))
+         (ok-button (make-button -1 -1 "Ok"))
+         (form (make-form)))
+
+    (set-grid-field grid 0 0 GRID-ELEMENT-COMPONENT text-box)
+    (set-grid-field grid 0 1 GRID-ELEMENT-COMPONENT ok-button
+                    #:pad-top 1)
+
+    ;; Set the background color to red to indicate something went wrong.
+    (newt-set-color COLORSET-ROOT "white" "red")
+    (add-components-to-form form text-box ok-button)
+    (make-wrapped-grid-window grid title)
+    (run-form form)
+    ;; Restore the background to its original color.
+    (newt-set-color COLORSET-ROOT "white" "blue")
+    (destroy-form-and-pop form)))
+
+(define* (run-listbox-selection-page #:key
+                                     info-text
+                                     title
+                                     (info-textbox-width 50)
+                                     listbox-items
+                                     listbox-item->text
+                                     (listbox-height 20)
+                                     (listbox-default-item #f)
+                                     (listbox-allow-multiple? #f)
+                                     (sort-listbox-items? #t)
+                                     button-text
+                                     (button-callback-procedure
+                                      (const #t))
+                                     (listbox-callback-procedure
+                                      (const #t)))
+  "Run a page asking the user to select an item in a listbox. The page
+contains, stacked vertically from the top to the bottom, an informative text
+set to INFO-TEXT, a listbox and a button. The listbox will be filled with
+LISTBOX-ITEMS converted to text by applying the procedure LISTBOX-ITEM->TEXT
+on every item. The selected item from LISTBOX-ITEMS is returned. The button
+text is set to BUTTON-TEXT and the procedure BUTTON-CALLBACK-PROCEDURE called
+when it is pressed. The procedure LISTBOX-CALLBACK-PROCEDURE is called when an
+item from the listbox is selected (by pressing the <ENTER> key).
+
+INFO-TEXTBOX-WIDTH is the width of the textbox where INFO-TEXT will be
+displayed. LISTBOX-HEIGHT is the height of the listbox.
+
+If LISTBOX-DEFAULT-ITEM is set to the value of one of the items in
+LISTBOX-ITEMS, it will be selected by default. Otherwise, the first element of
+the listbox is selected.
+
+If LISTBOX-ALLOW-MULTIPLE? is set to #t, multiple items from the listbox can
+be selected (using the <SPACE> key). It that case, a list containing the
+selected items will be returned.
+
+If SORT-LISTBOX-ITEMS? is set to #t, the listbox items are sorted using
+'string<=' procedure (after being converted to text)."
+
+  (define (fill-listbox listbox items)
+    "Append the given ITEMS to LISTBOX, once they have been converted to text
+with LISTBOX-ITEM->TEXT. Each item appended to the LISTBOX is given a key by
+newt. Save this key by returning an association list under the form:
+
+	((NEWT-LISTBOX-KEY . ITEM) ...)
+
+where NEWT-LISTBOX-KEY is the key returned by APPEND-ENTRY-TO-LISTBOX, when
+ITEM was inserted into LISTBOX."
+    (map (lambda (item)
+           (let* ((text (listbox-item->text item))
+                  (key (append-entry-to-listbox listbox text)))
+             (cons key item)))
+         items))
+
+  (define (sort-listbox-items listbox-items)
+    "Return LISTBOX-ITEMS sorted using the 'string<=' procedure on the text
+corresponding to each item in the list."
+    (let* ((items (map (lambda (item)
+                         (cons item (listbox-item->text item)))
+                       listbox-items))
+           (sorted-items
+            (sort items (lambda (a b)
+                          (let ((text-a (cdr a))
+                                (text-b (cdr b)))
+                            (string<= text-a text-b))))))
+      (map car sorted-items)))
+
+  (define (set-default-item listbox listbox-keys default-item)
+    "Set the default item of LISTBOX to DEFAULT-ITEM. LISTBOX-KEYS is the
+association list returned by the FILL-LISTBOX procedure. It is used because
+the current listbox item has to be selected by key."
+    (for-each (match-lambda
+                ((key . item)
+                 (when (equal? item default-item)
+                   (set-current-listbox-entry-by-key listbox key))))
+              listbox-keys))
+
+  (let* ((listbox (make-listbox
+                   -1 -1
+                   listbox-height
+                   (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT
+                           (if listbox-allow-multiple?
+                               FLAG-MULTIPLE
+                               0))))
+         (form (make-form))
+         (info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (button (make-button -1 -1 button-text))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT listbox
+                GRID-ELEMENT-COMPONENT button))
+         (sorted-items (if sort-listbox-items?
+                           (sort-listbox-items listbox-items)
+                           listbox-items))
+         (keys (fill-listbox listbox sorted-items)))
+
+    (when listbox-default-item
+      (set-default-item listbox keys listbox-default-item))
+
+    (add-form-to-grid grid form #t)
+    (make-wrapped-grid-window grid title)
+
+    (receive (exit-reason argument)
+        (run-form form)
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (when (eq? exit-reason 'exit-component)
+            (cond
+             ((components=? argument button)
+              (button-callback-procedure))
+             ((components=? argument listbox)
+              (if listbox-allow-multiple?
+                  (let* ((entries (listbox-selection listbox))
+                         (items (map (lambda (entry)
+                                       (assoc-ref keys entry))
+                                     entries)))
+                    (listbox-callback-procedure items)
+                    items)
+                  (let* ((entry (current-listbox-entry listbox))
+                         (item (assoc-ref keys entry)))
+                    (listbox-callback-procedure item)
+                    item))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
+(define* (run-scale-page #:key
+                         title
+                         info-text
+                         (info-textbox-width 50)
+                         (scale-width 40)
+                         (scale-full-value 100)
+                         scale-update-proc
+                         (max-scale-update 5))
+  "Run a page with a progress bar (called 'scale' in newt). The given
+INFO-TEXT is displayed in a textbox above the scale. The width of the textbox
+is set to INFO-TEXTBOX-WIDTH. The width of the scale is set to
+SCALE-WIDTH. SCALE-FULL-VALUE indicates the value that correspond to 100% of
+the scale.
+
+The procedure SCALE-UPDATE-PROC shall return a new scale
+value. SCALE-UPDATE-PROC will be called until the returned value is superior
+or equal to SCALE-FULL-VALUE, but no more than MAX-SCALE-UPDATE times. An
+error is raised if the MAX-SCALE-UPDATE limit is reached."
+  (let* ((info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 info-textbox-width
+                                 #:flags FLAG-BORDER))
+         (scale (make-scale -1 -1 scale-width scale-full-value))
+         (grid (vertically-stacked-grid
+                GRID-ELEMENT-COMPONENT info-textbox
+                GRID-ELEMENT-COMPONENT scale))
+         (form (make-form)))
+
+    (add-form-to-grid grid form #t)
+    (make-wrapped-grid-window grid title)
+
+    (draw-form form)
+    ;; This call is imperative, otherwise the form won't be displayed. See the
+    ;; explanation in the above commentary.
+    (newt-refresh)
+
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (let loop ((i max-scale-update)
+                   (last-value 0))
+          (let ((value (scale-update-proc last-value)))
+            (set-scale-value scale value)
+            ;; Same as above.
+            (newt-refresh)
+            (unless (>= value scale-full-value)
+              (if (> i 0)
+                  (loop (- i 1) value)
+                  (error "Max scale updates reached."))))))
+      (lambda ()
+        (destroy-form-and-pop form)))))
diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm
new file mode 100644
index 0000000000..a2c9b458f5
--- /dev/null
+++ b/gnu/installer/newt/timezone.scm
@@ -0,0 +1,83 @@
+;;; 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 newt timezone)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer timezone)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (run-timezone-page))
+
+;; Heigth of the listbox displaying timezones.
+(define timezone-listbox-heigth (make-parameter 20))
+
+;; Information textbox width.
+(define info-textbox-width (make-parameter 40))
+
+(define (fill-timezones listbox timezones)
+  "Fill the given LISTBOX with TIMEZONES. Return an association list
+correlating listbox keys with timezones."
+  (map (lambda (timezone)
+         (let ((key (append-entry-to-listbox listbox timezone)))
+           (cons key timezone)))
+       timezones))
+
+(define (run-timezone-page zonetab)
+  "Run a page displaying available timezones, grouped by regions. The user is
+invited to select a timezone. The selected timezone, under Posix format is
+returned."
+  (define (all-but-last list)
+    (reverse (cdr (reverse list))))
+
+  (define (run-page timezone-tree)
+    (define (loop path)
+      (let ((timezones (locate-childrens timezone-tree path)))
+        (run-listbox-selection-page
+         #:title (G_ "Timezone selection")
+         #:info-text (G_ "Please select a timezone.")
+         #:listbox-items timezones
+         #:listbox-item->text identity
+         #:button-text (if (null? path)
+                           (G_ "Cancel")
+                           (G_ "Back"))
+         #:button-callback-procedure
+         (if (null? path)
+             (lambda _
+               (raise
+                (condition
+                 (&installer-step-abort))))
+             (lambda _
+               (loop (all-but-last path))))
+         #:listbox-callback-procedure
+         (lambda (timezone)
+           (let* ((timezone* (append path (list timezone)))
+                  (tz (timezone->posix-tz timezone*)))
+             (if (timezone-has-child? timezone-tree timezone*)
+                 (loop timezone*)
+                 tz))))))
+    (loop '()))
+
+  (let ((timezone-tree (zonetab->timezone-tree zonetab)))
+    (run-page timezone-tree)))
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
new file mode 100644
index 0000000000..f342caae04
--- /dev/null
+++ b/gnu/installer/newt/user.scm
@@ -0,0 +1,181 @@
+;;; 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 newt user)
+  #:use-module (gnu installer newt page)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix i18n)
+  #:use-module (newt)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:export (run-user-page))
+
+(define (run-user-add-page)
+  (define (pad-label label)
+    (string-pad-right label 20))
+
+  (let* ((label-name
+          (make-label -1 -1 (pad-label (G_ "Name"))))
+         (label-group
+          (make-label -1 -1 (pad-label (G_ "Group"))))
+         (label-home-directory
+          (make-label -1 -1 (pad-label (G_ "Home directory"))))
+         (entry-width 30)
+         (entry-name (make-entry -1 -1 entry-width))
+         (entry-group (make-entry -1 -1 entry-width
+                                  #:initial-value "users"))
+         (entry-home-directory (make-entry -1 -1 entry-width))
+         (entry-grid (make-grid 2 3))
+         (button-grid (make-grid 1 1))
+         (ok-button (make-button -1 -1 (G_ "Ok")))
+         (grid (make-grid 1 2))
+         (title (G_ "User creation"))
+         (set-entry-grid-field
+          (cut set-grid-field entry-grid <> <> GRID-ELEMENT-COMPONENT <>))
+         (form (make-form)))
+
+    (set-entry-grid-field 0 0 label-name)
+    (set-entry-grid-field 1 0 entry-name)
+    (set-entry-grid-field 0 1 label-group)
+    (set-entry-grid-field 1 1 entry-group)
+    (set-entry-grid-field 0 2 label-home-directory)
+    (set-entry-grid-field 1 2 entry-home-directory)
+
+    (set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button)
+
+    (add-component-callback
+     entry-name
+     (lambda (component)
+       (set-entry-text entry-home-directory
+                       (string-append "/home/" (entry-value entry-name)))))
+
+    (add-components-to-form form
+                            label-name label-group label-home-directory
+                            entry-name entry-group entry-home-directory
+                            ok-button)
+
+    (make-wrapped-grid-window (vertically-stacked-grid
+                               GRID-ELEMENT-SUBGRID entry-grid
+                               GRID-ELEMENT-SUBGRID button-grid)
+                              title)
+    (let ((error-page
+           (lambda ()
+             (run-error-page (G_ "Empty inputs are not allowed")
+                             (G_ "Empty input")))))
+      (receive (exit-reason argument)
+          (run-form form)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (when (eq? exit-reason 'exit-component)
+              (cond
+               ((components=? argument ok-button)
+                (let ((name (entry-value entry-name))
+                      (group (entry-value entry-group))
+                      (home-directory (entry-value entry-home-directory)))
+                  (if (or (string=? name "")
+                          (string=? group "")
+                          (string=? home-directory ""))
+                      (begin
+                        (error-page)
+                        (run-user-add-page))
+                      `((name . ,name)
+                        (group . ,group)
+                        (home-directory . ,home-directory))))))))
+          (lambda ()
+            (destroy-form-and-pop form)))))))
+
+(define (run-user-page)
+  (define (run users)
+    (let* ((listbox (make-listbox
+                     -1 -1 10
+                     (logior FLAG-SCROLL FLAG-BORDER)))
+           (info-textbox
+            (make-reflowed-textbox
+             -1 -1
+             (G_ "Please add at least one user to system\
+ using the 'Add' button.")
+             40 #:flags FLAG-BORDER))
+           (add-button (make-compact-button -1 -1 (G_ "Add")))
+           (del-button (make-compact-button -1 -1 (G_ "Delete")))
+           (listbox-button-grid
+            (apply
+             vertically-stacked-grid
+             GRID-ELEMENT-COMPONENT add-button
+             `(,@(if (null? users)
+                     '()
+                     (list GRID-ELEMENT-COMPONENT del-button)))))
+           (ok-button (make-button -1 -1 (G_ "Ok")))
+           (cancel-button (make-button -1 -1 (G_ "Cancel")))
+           (title "User selection")
+           (grid
+            (vertically-stacked-grid
+             GRID-ELEMENT-COMPONENT info-textbox
+             GRID-ELEMENT-SUBGRID (horizontal-stacked-grid
+                                   GRID-ELEMENT-COMPONENT listbox
+                                   GRID-ELEMENT-SUBGRID listbox-button-grid)
+             GRID-ELEMENT-SUBGRID (horizontal-stacked-grid
+                                   GRID-ELEMENT-COMPONENT ok-button
+                                   GRID-ELEMENT-COMPONENT cancel-button)))
+           (sorted-users (sort users (lambda (a b)
+                                       (string<= (assoc-ref a 'name)
+                                                 (assoc-ref b 'name)))))
+           (listbox-elements
+            (map
+             (lambda (user)
+               `((key . ,(append-entry-to-listbox listbox
+                                                  (assoc-ref user 'name)))
+                 (user . ,user)))
+             sorted-users))
+           (form (make-form)))
+
+
+      (add-form-to-grid grid form #t)
+      (make-wrapped-grid-window grid title)
+      (if (null? users)
+          (set-current-component form add-button)
+          (set-current-component form ok-button))
+
+      (receive (exit-reason argument)
+          (run-form form)
+        (dynamic-wind
+          (const #t)
+          (lambda ()
+            (when (eq? exit-reason 'exit-component)
+              (cond
+               ((components=? argument add-button)
+                (run (cons (run-user-add-page) users)))
+               ((components=? argument del-button)
+                (let* ((current-user-key (current-listbox-entry listbox))
+                       (users
+                        (map (cut assoc-ref <> 'user)
+                             (remove (lambda (element)
+                                       (equal? (assoc-ref element 'key)
+                                               current-user-key))
+                                     listbox-elements))))
+                  (run users)))
+               ((components=? argument ok-button)
+                (when (null? users)
+                  (run-error-page (G_ "Please create at least one user.")
+                                  (G_ "No user"))
+                  (run users))))))
+          (lambda ()
+            (destroy-form-and-pop form))))))
+  (run '()))
diff --git a/gnu/installer/newt/utils.scm b/gnu/installer/newt/utils.scm
new file mode 100644
index 0000000000..1c2ce4e628
--- /dev/null
+++ b/gnu/installer/newt/utils.scm
@@ -0,0 +1,43 @@
+;;; 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 newt utils)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (screen-columns
+            screen-rows
+
+            destroy-form-and-pop
+            set-screen-size!))
+
+;; Number of columns and rows of the terminal.
+(define screen-columns (make-parameter 0))
+(define screen-rows    (make-parameter 0))
+
+(define (destroy-form-and-pop form)
+  "Destory the given FORM and pop the current window."
+  (destroy-form form)
+  (pop-window))
+
+(define (set-screen-size!)
+  "Set the parameters 'screen-columns' and 'screen-rows' to the number of
+columns and rows respectively of the current terminal."
+  (receive (columns rows)
+      (screen-size)
+    (screen-columns columns)
+    (screen-rows rows)))
diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm
new file mode 100644
index 0000000000..8ed9f68918
--- /dev/null
+++ b/gnu/installer/newt/welcome.scm
@@ -0,0 +1,122 @@
+;;; 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
+
+;;;
+;;; 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 newt welcome)
+  #:use-module (gnu installer utils)
+  #:use-module (gnu installer newt utils)
+  #:use-module (guix build syscalls)
+  #:use-module (guix i18n)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:use-module (newt)
+  #:export (run-welcome-page))
+
+;; Margin between screen border and newt root window.
+(define margin-left (make-parameter 3))
+(define margin-top (make-parameter 3))
+
+;; Expected width and height for the logo.
+(define logo-width (make-parameter 50))
+(define logo-height (make-parameter 23))
+
+(define (nearest-exact-integer x)
+  "Given a real number X, return the nearest exact integer, with ties going to
+the nearest exact even integer."
+  (inexact->exact (round x)))
+
+(define* (run-menu-page title logo
+                        #:key
+                        listbox-items
+                        listbox-item->text)
+  "Run a page with the given TITLE, to ask the user to choose between
+LISTBOX-ITEMS displayed in a listbox. The listbox items are converted to text
+using LISTBOX-ITEM->TEXT procedure. Display the textual LOGO in the center of
+the page. Contrary to other pages, we cannot resort to grid layouts, because
+we want this page to occupy all the screen space available."
+  (define (fill-listbox listbox items)
+    (map (lambda (item)
+           (let* ((text (listbox-item->text item))
+                  (key (append-entry-to-listbox listbox text)))
+             (cons key item)))
+         items))
+
+  (let* ((windows
+          (make-window (margin-left)
+                       (margin-top)
+                       (- (screen-columns) (* 2 (margin-left)))
+                       (- (screen-rows) (* 2 (margin-top)))
+                       title))
+         (logo-textbox
+          (make-textbox (nearest-exact-integer
+                         (- (/ (screen-columns) 2)
+                            (+ (/ (logo-width) 2) (margin-left))))
+                        (margin-top) (logo-width) (logo-height) 0))
+         (text (set-textbox-text logo-textbox
+                                 (read-all logo)))
+         (options-listbox
+          (make-listbox (margin-left)
+                        (+ (logo-height) (margin-top))
+                        (- (screen-rows) (+ (logo-height)
+                                            (* (margin-top) 4)))
+                        (logior FLAG-BORDER FLAG-RETURNEXIT)))
+         (keys (fill-listbox options-listbox listbox-items))
+         (form (make-form)))
+    (set-listbox-width options-listbox (- (screen-columns)
+                                          (* (margin-left) 4)))
+    (add-components-to-form form logo-textbox options-listbox)
+
+    (receive (exit-reason argument)
+        (run-form form)
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (when (eq? exit-reason 'exit-component)
+            (cond
+             ((components=? argument options-listbox)
+              (let* ((entry (current-listbox-entry options-listbox))
+                     (item (assoc-ref keys entry)))
+                (match item
+                  ((text . proc)
+                   (proc))))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
+
+(define (run-welcome-page logo)
+  "Run a welcome page with the given textual LOGO displayed at the center of
+the page. Ask the user to choose between manual installation, graphical
+installation and reboot."
+  (run-menu-page
+   (G_ "GNU GuixSD install")
+   logo
+   #:listbox-items
+   `((,(G_ "Install using the unguided shell based process")
+      .
+      ,(lambda ()
+         (clear-screen)
+         (newt-suspend)
+         (system* "bash" "-l")
+         (newt-resume)))
+     (,(G_ "Graphical install using a guided terminal based interface")
+      .
+      ,(const #t))
+     (,(G_ "Reboot")
+      .
+      ,(lambda ()
+         (newt-finish)
+         (reboot))))
+   #:listbox-item->text car))
diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm
new file mode 100644
index 0000000000..6cac54399a
--- /dev/null
+++ b/gnu/installer/newt/wifi.scm
@@ -0,0 +1,243 @@
+;;; 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 newt wifi)
+  #:use-module (gnu installer connman)
+  #:use-module (gnu installer steps)
+  #:use-module (gnu installer newt utils)
+  #:use-module (gnu installer newt page)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 rdelim)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (newt)
+  #:export (run-wifi-page))
+
+;; This record associates a connman service to its key the listbox.
+(define-record-type* <service-item>
+  service-item make-service-item
+  service-item?
+  (service   service-item-service) ; connman <service>
+  (key       service-item-key)) ; newt listbox-key
+
+(define (strength->string strength)
+  "Convert STRENGTH as an integer percentage into a text printable strength
+bar using unicode characters. Taken from NetworkManager's
+nmc_wifi_strength_bars."
+  (let ((quarter #\x2582)
+        (half #\x2584)
+        (three-quarter #\x2586)
+        (full #\x2588))
+    (cond
+     ((> strength 80)
+      ;; ▂▄▆█
+      (string quarter half three-quarter full))
+     ((> strength 55)
+      ;; ▂▄▆_
+      (string quarter half three-quarter #\_))
+     ((> strength 30)
+      ;; ▂▄__
+      (string quarter half #\_ #\_))
+     ((> strength 5)
+      ;; ▂___
+      (string quarter #\_ #\_ #\_))
+     (else
+      ;; ____
+      (string quarter #\_ #\_ #\_ #\_)))))
+
+(define (force-wifi-scan)
+  "Force a wifi scan. Raise a condition if no wifi technology is available."
+  (let* ((technologies (connman-technologies))
+         (wifi-technology
+          (find (lambda (technology)
+                  (string=? (technology-type technology) "wifi"))
+                technologies)))
+    (if wifi-technology
+        (connman-scan-technology wifi-technology)
+        (raise (condition
+                (&message
+                 (message (G_ "Unable to find a wifi technology"))))))))
+
+(define (draw-scanning-page)
+  "Draw a page to indicate a wifi scan in in progress."
+  (draw-info-page (G_ "Scanning wifi for available networks, please wait.")
+                  (G_ "Scan in progress")))
+
+(define (run-wifi-password-page)
+  "Run a page prompting user for a password and return it."
+  (run-input-page (G_ "Please enter the wifi password")
+                  (G_ "Password required")))
+
+(define (run-wrong-password-page service-name)
+  "Run a page to inform user of a wrong password input."
+  (run-error-page
+   (format #f (G_ "The password you entered for ~a is incorrect.")
+           service-name)
+   (G_ "Wrong password")))
+
+(define (run-unknown-error-page service-name)
+  "Run a page to inform user that a connection error happened."
+  (run-error-page
+   (format #f
+           (G_ "An error occured while trying to connect to ~a, please retry.")
+           service-name)
+   (G_ "Connection error")))
+
+(define (password-callback)
+  (run-wifi-password-page))
+
+(define (connect-wifi-service listbox service-items)
+  "Connect to the wifi service selected in LISTBOX. SERVICE-ITEMS is the list
+of <service-item> records present in LISTBOX."
+  (let* ((listbox-key (current-listbox-entry listbox))
+         (item (find (lambda (item)
+                       (eq? (service-item-key item) listbox-key))
+                     service-items))
+         (service (service-item-service item))
+         (service-name (service-name service))
+         (form (draw-connecting-page service-name)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (guard (c ((connman-password-error? c)
+                   (run-wrong-password-page service-name)
+                   #f)
+                  ((connman-already-connected-error? c)
+                   #t)
+                  ((connman-connection-error? c)
+                   (run-unknown-error-page service-name)
+                   #f))
+          (connman-connect-with-auth service password-callback)))
+      (lambda ()
+        (destroy-form-and-pop form)))))
+
+(define (run-wifi-scan-page)
+  "Force a wifi scan and draw a page during the operation."
+  (let ((form (draw-scanning-page)))
+    (force-wifi-scan)
+    (destroy-form-and-pop form)))
+
+(define (wifi-services)
+  "Return all the connman services of wifi type."
+  (let ((services (connman-services)))
+    (filter (lambda (service)
+              (and (string=? (service-type service) "wifi")
+                   (not (string-null? (service-name service)))))
+            services)))
+
+(define* (fill-wifi-services listbox wifi-services)
+  "Append all the services in WIFI-SERVICES to the given LISTBOX."
+  (clear-listbox listbox)
+  (map (lambda (service)
+         (let* ((text (service->text service))
+                (key (append-entry-to-listbox listbox text)))
+           (service-item
+            (service service)
+            (key key))))
+       wifi-services))
+
+;; Maximum length of a wifi service name.
+(define service-name-max-length (make-parameter 20))
+
+;; Heigth of the listbox displaying wifi services.
+(define wifi-listbox-heigth (make-parameter 20))
+
+;; Information textbox width.
+(define info-textbox-width (make-parameter 40))
+
+(define (service->text service)
+  "Return a string composed of the name and the strength of the given
+SERVICE. A '*' preceding the service name indicates that it is connected."
+  (let* ((name (service-name service))
+         (padded-name (string-pad-right name
+                                        (service-name-max-length)))
+         (strength (service-strength service))
+         (strength-string (strength->string strength))
+         (state (service-state service))
+         (connected? (or (string=? state "online")
+                         (string=? state "ready"))))
+    (format #f "~c ~a ~a~%"
+            (if connected? #\* #\ )
+            padded-name
+            strength-string)))
+
+(define (run-wifi-page)
+  "Run a page displaying available wifi networks in a listbox. Connect to the
+network when the corresponding listbox entry is selected. A button allow to
+force a wifi scan."
+  (let* ((listbox (make-listbox
+                   -1 -1
+                   (wifi-listbox-heigth)
+                   (logior FLAG-SCROLL FLAG-BORDER FLAG-RETURNEXIT)))
+         (form (make-form))
+         (buttons-grid (make-grid 1 1))
+         (middle-grid (make-grid 2 1))
+         (info-text (G_ "Please select a wifi network."))
+         (info-textbox
+          (make-reflowed-textbox -1 -1 info-text
+                                 (info-textbox-width)
+                                 #:flags FLAG-BORDER))
+         (cancel-button (make-button -1 -1 (G_ "Cancel")))
+         (scan-button (make-button -1 -1 (G_ "Scan")))
+         (services (wifi-services))
+         (service-items '()))
+
+    (if (null? services)
+        (append-entry-to-listbox listbox (G_ "No wifi detected"))
+        (set! service-items (fill-wifi-services listbox services)))
+
+    (set-grid-field middle-grid 0 0 GRID-ELEMENT-COMPONENT listbox)
+    (set-grid-field middle-grid 1 0 GRID-ELEMENT-COMPONENT scan-button
+                    #:anchor ANCHOR-TOP
+                    #:pad-left 2)
+    (set-grid-field buttons-grid 0 0 GRID-ELEMENT-COMPONENT cancel-button)
+
+    (add-components-to-form form
+                            info-textbox
+                            listbox scan-button
+                            cancel-button)
+    (make-wrapped-grid-window
+     (basic-window-grid info-textbox middle-grid buttons-grid)
+     (G_ "Wifi selection"))
+
+    (receive (exit-reason argument)
+        (run-form form)
+      (dynamic-wind
+        (const #t)
+        (lambda ()
+          (when (eq? exit-reason 'exit-component)
+            (cond
+             ((components=? argument scan-button)
+              (run-wifi-scan-page)
+              (run-wifi-page))
+             ((components=? argument cancel-button)
+              (raise
+               (condition
+                (&installer-step-abort))))
+             ((components=? argument listbox)
+              (let ((result (connect-wifi-service listbox service-items)))
+                (unless result
+                  (run-wifi-page)))))))
+        (lambda ()
+          (destroy-form-and-pop form))))))
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
new file mode 100644
index 0000000000..5fd54356dd
--- /dev/null
+++ b/gnu/installer/steps.scm
@@ -0,0 +1,187 @@
+;;; 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 steps)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (&installer-step-abort
+            installer-step-abort?
+
+            &installer-step-break
+            installer-step-break?
+
+            <installer-step>
+            installer-step
+            make-installer-step
+            installer-step?
+            installer-step-id
+            installer-step-description
+            installer-step-compute
+            installer-step-configuration-proc
+
+            run-installer-steps
+            find-step-by-id
+            result->step-ids
+            result-step
+            result-step-done?))
+
+;; This condition may be raised to abort the current step.
+(define-condition-type &installer-step-abort &condition
+  installer-step-abort?)
+
+;; This condition may be raised to break out from the steps execution.
+(define-condition-type &installer-step-break &condition
+  installer-step-break?)
+
+;; An installer-step record is basically an id associated to a compute
+;; procedure. The COMPUTE procedure takes exactly one argument, an association
+;; list containing the results of previously executed installer-steps (see
+;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
+;; procedure will be stored in the results list passed to the next
+;; installer-step and so on.
+(define-record-type* <installer-step>
+  installer-step make-installer-step
+  installer-step?
+  (id                           installer-step-id) ;symbol
+  (description                  installer-step-description ;string
+                                (default #f))
+  (compute                      installer-step-compute) ;procedure
+  (configuration-format-proc    installer-step-configuration-proc ;procedure
+                                (default #f)))
+
+(define* (run-installer-steps #:key
+                              steps
+                              (rewind-strategy 'previous)
+                              (menu-proc (const #f)))
+  "Run the COMPUTE procedure of all <installer-step> records in STEPS
+sequencially. If the &installer-step-abort condition is raised, fallback to a
+previous install-step, accordingly to the specified REWIND-STRATEGY.
+
+REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
+is selected, the execution will resume at the previous installer-step. If
+'menu is selected, the MENU-PROC procedure will be called. Its return value
+has to be an installer-step ID to jump to. The ID has to be the one of a
+previously executed step. It is impossible to jump forward. Finally if 'start
+is selected, the execution will resume at the first installer-step.
+
+The result of every COMPUTE procedures is stored in an association list, under
+the form:
+
+		'((STEP-ID . COMPUTE-RESULT) ...)
+
+where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
+result of the associated COMPUTE procedure. This result association list is
+passed as argument of every COMPUTE procedure. It is finally returned when the
+computation is over.
+
+If the &installer-step-break condition is raised, stop the computation and
+return the accumalated result so far."
+  (define (pop-result list)
+    (cdr list))
+
+  (define (first-step? steps step)
+    (match steps
+      ((first-step . rest-steps)
+       (equal? first-step step))))
+
+  (define* (skip-to-step step result
+                         #:key todo-steps done-steps)
+    (match (list todo-steps done-steps)
+      (((todo . rest-todo) (prev-done ... last-done))
+       (if (eq? (installer-step-id todo)
+                (installer-step-id step))
+           (run result
+                #:todo-steps todo-steps
+                #:done-steps done-steps)
+           (skip-to-step step (pop-result result)
+                         #:todo-steps (cons last-done todo-steps)
+                         #:done-steps prev-done)))))
+
+  (define* (run result #:key todo-steps done-steps)
+    (match todo-steps
+      (() (reverse result))
+      ((step . rest-steps)
+       (guard (c ((installer-step-abort? c)
+                  (case rewind-strategy
+                    ((previous)
+                     (match done-steps
+                       (()
+                        ;; We cannot go previous the first step. So re-raise
+                        ;; the exception. It might be useful in the case of
+                        ;; nested run-installer-steps. Abort to 'raise-above
+                        ;; prompt to prevent the condition from being catched
+                        ;; by one of the previously installed guard.
+                        (abort-to-prompt 'raise-above c))
+                       ((prev-done ... last-done)
+                        (run (pop-result result)
+                             #:todo-steps (cons last-done todo-steps)
+                             #:done-steps prev-done))))
+                    ((menu)
+                     (let ((goto-step (menu-proc
+                                       (append done-steps (list step)))))
+                       (if (eq? goto-step step)
+                           (run result
+                                #:todo-steps todo-steps
+                                #:done-steps done-steps)
+                           (skip-to-step goto-step result
+                                         #:todo-steps todo-steps
+                                         #:done-steps done-steps))))
+                    ((start)
+                     (if (null? done-steps)
+                         ;; Same as above, it makes no sense to jump to start
+                         ;; when we are at the first installer-step. Abort to
+                         ;; 'raise-above prompt to re-raise the condition.
+                         (abort-to-prompt 'raise-above c)
+                         (run '()
+                              #:todo-steps steps
+                              #:done-steps '())))))
+                 ((installer-step-break? c)
+                  (reverse result)))
+         (let* ((id (installer-step-id step))
+                (compute (installer-step-compute step))
+                (res (compute result)))
+           (run (alist-cons id res result)
+                #:todo-steps rest-steps
+                #:done-steps (append done-steps (list step))))))))
+
+  (call-with-prompt 'raise-above
+    (lambda ()
+      (run '()
+           #:todo-steps steps
+           #:done-steps '()))
+    (lambda (k condition)
+      (raise condition))))
+
+(define (find-step-by-id steps id)
+  "Find and return the step in STEPS whose id is equal to ID."
+  (find (lambda (step)
+          (eq? (installer-step-id step) id))
+        steps))
+
+(define (result-step results step-id)
+  "Return the result of the installer-step specified by STEP-ID in
+RESULTS."
+  (assoc-ref results step-id))
+
+(define (result-step-done? results step-id)
+  "Return #t if the installer-step specified by STEP-ID has a COMPUTE value
+stored in RESULTS. Return #f otherwise."
+  (and (assoc step-id results) #t))
diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm
new file mode 100644
index 0000000000..061e8c2e48
--- /dev/null
+++ b/gnu/installer/timezone.scm
@@ -0,0 +1,117 @@
+;;; 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 timezone)
+  #:use-module (gnu installer utils)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
+  #:export (locate-childrens
+            timezone->posix-tz
+            timezone-has-child?
+            zonetab->timezone-tree))
+
+(define %not-blank
+  (char-set-complement char-set:blank))
+
+(define (posix-tz->timezone tz)
+  "Convert given TZ in Posix format like \"Europe/Paris\" into a list like
+(\"Europe\" \"Paris\")."
+  (string-split tz #\/))
+
+(define (timezone->posix-tz timezone)
+  "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone
+like \"Europe/Paris\"."
+  (string-join timezone "/"))
+
+(define (zonetab->timezones zonetab)
+  "Parse ZONETAB file and return the corresponding list of timezones."
+
+  (define (zonetab-line->posix-tz line)
+    (let ((tokens (string-tokenize line %not-blank)))
+      (match tokens
+        ((code coordinates tz _ ...)
+         tz))))
+
+  (call-with-input-file zonetab
+    (lambda (port)
+      (let* ((lines (read-lines port))
+             ;; Filter comment lines starting with '#' character.
+             (tz-lines (filter (lambda (line)
+                                 (not (eq? (string-ref line 0)
+                                           #\#)))
+                               lines)))
+        (map (lambda (line)
+               (posix-tz->timezone
+                (zonetab-line->posix-tz line)))
+             tz-lines)))))
+
+(define (timezones->timezone-tree timezones)
+  "Convert the list of timezones, TIMEZONES into a tree under the form:
+
+	(\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\"))
+
+representing America/North_Dakota/New_Salem and America/North_Dakota/Center
+timezones."
+
+  (define (remove-first lists)
+    "Remove the first element of every sublists in the argument LISTS."
+    (map (lambda (list)
+           (if (null? list) list (cdr list)))
+         lists))
+
+  (let loop ((cur-timezones timezones))
+    (match cur-timezones
+      (() '())
+      (((region . rest-region) . rest-timezones)
+       (if (null? rest-region)
+           (cons (list region) (loop rest-timezones))
+           (receive (same-region other-region)
+               (partition (lambda (timezone)
+                            (string=? (car timezone) region))
+                          cur-timezones)
+             (acons region
+                    (loop (remove-first same-region))
+                    (loop other-region))))))))
+
+(define (locate-childrens tree path)
+  "Return the childrens of the timezone indicated by PATH in the given
+TREE. Raise a condition if the PATH could not be found."
+  (let ((extract-proc (cut map car <>)))
+    (match path
+      (() (sort (extract-proc tree) string<?))
+      ((region . rest)
+       (or (and=> (assoc-ref tree region)
+                  (cut locate-childrens <> rest))
+           (raise
+            (condition
+             (&message
+              (message
+               (format #f (G_ "Unable to locate path: ~a.") path))))))))))
+
+(define (timezone-has-child? tree timezone)
+  "Return #t if the given TIMEZONE any child in TREE and #f otherwise."
+  (not (null? (locate-childrens tree timezone))))
+
+(define* (zonetab->timezone-tree zonetab)
+  "Return the timezone tree corresponding to the given ZONETAB file."
+  (timezones->timezone-tree (zonetab->timezones zonetab)))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
new file mode 100644
index 0000000000..5087683715
--- /dev/null
+++ b/gnu/installer/utils.scm
@@ -0,0 +1,37 @@
+;;; 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 utils)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 textual-ports)
+  #:export (read-lines
+            read-all))
+
+(define* (read-lines #:optional (port (current-input-port)))
+  "Read lines from PORT and return them as a list."
+  (let loop ((line (read-line port))
+             (lines '()))
+    (if (eof-object? line)
+        (reverse lines)
+        (loop (read-line port)
+              (cons line lines)))))
+
+(define (read-all file)
+  "Return the content of the given FILE as a string."
+  (call-with-input-file file
+    get-string-all))
author	Mathieu Othacehe <m.othacehe@gmail.com>	2018-11-16 20:43:55 +0900
committer	Ludovic Courtès <ludo@gnu.org>	2019-01-17 14:04:20 +0100
commit	d0f3a672dcbdfefd3556b6a21985ff0e35eed3be (patch)
tree	6ca7cc2fc874343791a3b555181177be488a3a8a /gnu/installer
parent	08af580bde01ffd8e6968b6f9f9eff14c4f9cc5a (diff)