* 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.gn-latest-20200428
@@ -135,6 +135,12 @@ if test "x$have_guile_gcrypt" != "xyes"; then | |||
AC_MSG_ERROR([Guile-Gcrypt could not be found; please install it.]) | |||
fi | |||
dnl Guile-newt is used by the graphical installer. | |||
GUILE_MODULE_AVAILABLE([have_guile_newt], [(newt)]) | |||
if test "x$have_guile_newt" != "xyes"; then | |||
AC_MSG_ERROR([Guile-newt could not be found; please install it.]) | |||
fi | |||
dnl Make sure we have a full-fledged Guile. | |||
GUIX_ASSERT_GUILE_FEATURES([regex posix socket net-db threads]) | |||
@@ -0,0 +1,111 @@ | |||
;;; GNU Guix --- Functional package management for GNU | |||
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |||
;;; | |||
;;; This file is part of GNU Guix. | |||
;;; | |||
;;; GNU Guix is free software; you can redistribute it and/or modify it | |||
;;; under the terms of the GNU General Public License as published by | |||
;;; the Free Software Foundation; either version 3 of the License, or (at | |||
;;; your option) any later version. | |||
;;; | |||
;;; GNU Guix is distributed in the hope that it will be useful, but | |||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |||
;;; GNU General Public License for more details. | |||
;;; | |||
;;; You should have received a copy of the GNU General Public License | |||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |||
(define-module (gnu installer) | |||
#:use-module (guix discovery) | |||
#:use-module (guix records) | |||
#:use-module (guix ui) | |||
#:use-module (srfi srfi-1) | |||
#:export (<installer> | |||
installer | |||
make-installer | |||
installer? | |||
installer-name | |||
installer-modules | |||
installer-init | |||
installer-exit | |||
installer-exit-error | |||
installer-keymap-page | |||
installer-locale-page | |||
installer-menu-page | |||
installer-network-page | |||
installer-timezone-page | |||
installer-hostname-page | |||
installer-user-page | |||
installer-welcome-page | |||
%installers | |||
lookup-installer-by-name)) | |||
;;; | |||
;;; Installer record. | |||
;;; | |||
;; The <installer> record contains pages that will be run to prompt the user | |||
;; for the system configuration. The goal of the installer is to produce a | |||
;; complete <operating-system> record and install it. | |||
(define-record-type* <installer> | |||
installer make-installer | |||
installer? | |||
;; symbol | |||
(name installer-name) | |||
;; list of installer modules | |||
(modules installer-modules) | |||
;; procedure: void -> void | |||
(init installer-init) | |||
;; procedure: void -> void | |||
(exit installer-exit) | |||
;; procedure (key arguments) -> void | |||
(exit-error installer-exit-error) | |||
;; procedure (#:key models layouts) -> (list model layout variant) | |||
(keymap-page installer-keymap-page) | |||
;; procedure: (#:key supported-locales iso639-languages iso3166-territories) | |||
;; -> glibc-locale | |||
(locale-page installer-locale-page) | |||
;; procedure: (steps) -> step-id | |||
(menu-page installer-menu-page) | |||
;; procedure void -> void | |||
(network-page installer-network-page) | |||
;; procedure (zonetab) -> posix-timezone | |||
(timezone-page installer-timezone-page) | |||
;; procedure void -> void | |||
(hostname-page installer-hostname-page) | |||
;; procedure void -> void | |||
(user-page installer-user-page) | |||
;; procedure (logo) -> void | |||
(welcome-page installer-welcome-page)) | |||
;;; | |||
;;; Installers. | |||
;;; | |||
(define (installer-top-modules) | |||
"Return the list of installer modules." | |||
(all-modules (map (lambda (entry) | |||
`(,entry . "gnu/installer")) | |||
%load-path) | |||
#:warn warn-about-load-error)) | |||
(define %installers | |||
;; The list of publically-known installers. | |||
(delay (fold-module-public-variables (lambda (obj result) | |||
(if (installer? obj) | |||
(cons obj result) | |||
result)) | |||
'() | |||
(installer-top-modules)))) | |||
(define (lookup-installer-by-name name) | |||
"Return the installer called NAME." | |||
(or (find (lambda (installer) | |||
(eq? name (installer-name installer))) | |||
(force %installers)) | |||
(leave (G_ "~a: no such installer~%") name))) |
@@ -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 |
@@ -0,0 +1,19 @@ | |||
░░░ ░░░ | |||
░░▒▒░░░░░░░░░ ░░░░░░░░░▒▒░░ | |||
░░▒▒▒▒▒░░░░░░░ ░░░░░░░▒▒▒▒▒░ | |||
░▒▒▒░░▒▒▒▒▒ ░░░░░░░▒▒░ | |||
░▒▒▒▒░ ░░░░░░ | |||
▒▒▒▒▒ ░░░░░░ | |||
▒▒▒▒▒ ░░░░░ | |||
░▒▒▒▒▒ ░░░░░ | |||
▒▒▒▒▒ ░░░░░ | |||
▒▒▒▒▒ ░░░░░ | |||
░▒▒▒▒▒░░░░░ | |||
▒▒▒▒▒▒░░░ | |||
▒▒▒▒▒▒░ | |||
_____ _ _ _ _ _____ _ | |||
/ ____| \ | | | | | / ____| (_) | |||
| | __| \| | | | | | | __ _ _ ___ __ | |||
| | |_ | . ' | | | | | | |_ | | | | \ \/ / | |||
| |__| | |\ | |__| | | |__| | |_| | |> < | |||
\_____|_| \_|\____/ \_____|\__,_|_/_/\_\ |
@@ -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)) |
@@ -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))))) |
@@ -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))))) |
@@ -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))) |
@@ -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))) |
@@ -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)))) |
@@ -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"))) |
@@ -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))) |
@@ -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." | |||