summaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/aux-files/SUPPORTED484
-rw-r--r--gnu/installer/locale.scm24
-rw-r--r--gnu/installer/newt/ethernet.scm48
-rw-r--r--gnu/installer/newt/menu.scm2
-rw-r--r--gnu/installer/newt/network.scm56
-rw-r--r--gnu/installer/newt/page.scm42
-rw-r--r--gnu/installer/newt/partition.scm21
-rw-r--r--gnu/installer/newt/user.scm40
-rw-r--r--gnu/installer/parted.scm52
-rw-r--r--gnu/installer/services.scm6
-rw-r--r--gnu/installer/steps.scm7
11 files changed, 193 insertions, 589 deletions
diff --git a/gnu/installer/aux-files/SUPPORTED b/gnu/installer/aux-files/SUPPORTED
deleted file mode 100644
index 24aae1e089..0000000000
--- a/gnu/installer/aux-files/SUPPORTED
+++ /dev/null
@@ -1,484 +0,0 @@
-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/locale.scm b/gnu/installer/locale.scm
index 284062a6e7..2ee5eecd96 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -62,12 +62,13 @@
(define (locale-modifier assoc)
(assoc-ref assoc 'modifier))
-(define (locale-string->locale string)
- "Return the locale association list built from the parsing of STRING."
+(define* (locale-string->locale string #:optional codeset)
+ "Return the locale association list built from the parsing of STRING and,
+optionally, CODESET."
(let ((matches (string-match locale-regexp string)))
`((language . ,(match:substring matches 1))
(territory . ,(match:substring matches 3))
- (codeset . ,(match:substring matches 5))
+ (codeset . ,(or codeset (match:substring matches 5)))
(modifier . ,(match:substring matches 7)))))
(define (normalize-codeset codeset)
@@ -107,17 +108,12 @@
'())))))
(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)))))
+ "Given SUPPORTED-LOCALES, a file produced by 'glibc-supported-locales',
+return a list of locales where each locale is an alist."
+ (map (match-lambda
+ ((locale . codeset)
+ (locale-string->locale locale codeset)))
+ (call-with-input-file supported-locales read)))
;;;
diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm
index d1f357243b..ba5e222a37 100644
--- a/gnu/installer/newt/ethernet.scm
+++ b/gnu/installer/newt/ethernet.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (ice-9 format)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (newt)
@@ -58,24 +60,28 @@ connection is pending."
service))
(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_ "Exit")
- #:button-callback-procedure
- (lambda _
- (raise
- (condition
- (&installer-step-abort))))
- #:listbox-callback-procedure connect-ethernet-service))))
+ (match (ethernet-services)
+ (()
+ (run-error-page
+ (G_ "No ethernet service available, please try again.")
+ (G_ "No service"))
+ (raise
+ (condition
+ (&installer-step-abort))))
+ ((service)
+ ;; Only one service is available so return it directly.
+ service)
+ ((services ...)
+ (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
+ #:listbox-height (min (+ (length services) 2) 10)
+ #:button-text (G_ "Exit")
+ #:button-callback-procedure
+ (lambda _
+ (raise
+ (condition
+ (&installer-step-abort))))
+ #:listbox-callback-procedure connect-ethernet-service))))
diff --git a/gnu/installer/newt/menu.scm b/gnu/installer/newt/menu.scm
index 161266a94a..e153d3d756 100644
--- a/gnu/installer/newt/menu.scm
+++ b/gnu/installer/newt/menu.scm
@@ -32,7 +32,7 @@ process from."
steps))
(run-listbox-selection-page
- #:info-text (G_ "Choose where you want to resume the install.\
+ #:info-text (G_ "Choose where you want to resume the install. \
You can also abort the installation by pressing the Abort button.")
#:title (G_ "Installation menu")
#:listbox-items (steps->items steps)
diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm
index cf27a8cca2..0a938db103 100644
--- a/gnu/installer/newt/network.scm
+++ b/gnu/installer/newt/network.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -28,6 +29,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (ice-9 match)
#:use-module (newt)
#:export (run-network-page))
@@ -53,32 +55,38 @@ Internet and return the selected technology. For now, only technologies with
(string=? type "wifi"))))
(connman-technologies)))
- (let ((items (technology-items)))
- (if (null? items)
- (case (choice-window
- (G_ "Internet access")
- (G_ "Continue")
- (G_ "Exit")
- (G_ "The install process requires Internet access but no \
+ (match (technology-items)
+ (()
+ (case (choice-window
+ (G_ "Internet access")
+ (G_ "Continue")
+ (G_ "Exit")
+ (G_ "The install process requires Internet access but no \
network device were found. Do you want to continue anyway?"))
- ((1) (raise
- (condition
- (&installer-step-break))))
- ((2) (raise
- (condition
- (&installer-step-abort)))))
- (run-listbox-selection-page
- #:info-text (G_ "The install process requires Internet access.\
+ ((1) (raise
+ (condition
+ (&installer-step-break))))
+ ((2) (raise
+ (condition
+ (&installer-step-abort))))))
+ ((technology)
+ ;; Since there's only one technology available, skip the selection
+ ;; screen.
+ technology)
+ ((items ...)
+ (run-listbox-selection-page
+ #:info-text (G_ "The install process requires Internet access.\
Please select a network device.")
- #:title (G_ "Internet access")
- #:listbox-items items
- #:listbox-item->text technology->text
- #:button-text (G_ "Exit")
- #:button-callback-procedure
- (lambda _
- (raise
- (condition
- (&installer-step-abort))))))))
+ #:title (G_ "Internet access")
+ #:listbox-items items
+ #:listbox-item->text technology->text
+ #:listbox-height (min (+ (length items) 2) 10)
+ #:button-text (G_ "Exit")
+ #: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."
diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm
index 3173d54737..728721c08f 100644
--- a/gnu/installer/newt/page.scm
+++ b/gnu/installer/newt/page.scm
@@ -75,6 +75,7 @@ this page to TITLE."
#:key
(allow-empty-input? #f)
(default-text #f)
+ (input-hide-checkbox? #f)
(input-field-width 40)
(input-flags 0))
"Run a page to prompt user for an input. The given TEXT will be displayed
@@ -86,22 +87,38 @@ input box, such as FLAG-PASSWORD."
(make-reflowed-textbox -1 -1 text
input-field-width
#:flags FLAG-BORDER))
- (grid (make-grid 1 3))
+ (input-visible-cb
+ (make-checkbox -1 -1 (G_ "Hide") #\x "x "))
+ (input-flags* (if input-hide-checkbox?
+ (logior FLAG-PASSWORD FLAG-SCROLL
+ input-flags)
+ input-flags))
(input-entry (make-entry -1 -1 20
- #:flags input-flags))
+ #:flags input-flags*))
(ok-button (make-button -1 -1 (G_ "OK")))
+ (grid (vertically-stacked-grid
+ GRID-ELEMENT-COMPONENT text-box
+ GRID-ELEMENT-SUBGRID
+ (apply
+ horizontal-stacked-grid
+ GRID-ELEMENT-COMPONENT input-entry
+ `(,@(if input-hide-checkbox?
+ (list GRID-ELEMENT-COMPONENT input-visible-cb)
+ '())))
+ GRID-ELEMENT-COMPONENT ok-button))
(form (make-form)))
+ (add-component-callback
+ input-visible-cb
+ (lambda (component)
+ (set-entry-flags input-entry
+ FLAG-PASSWORD
+ FLAG-ROLE-TOGGLE)))
+
(when default-text
(set-entry-text input-entry default-text))
- (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)
+ (add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
(let ((error-page (lambda ()
(run-error-page (G_ "Please enter a non empty input.")
@@ -559,7 +576,12 @@ ITEMS when 'Ok' is pressed."
'())))))
(form (make-form)))
- (set-textbox-text file-textbox file-text)
+ (set-textbox-text file-textbox
+ (receive (_w _h text)
+ (reflow-text file-text
+ file-textbox-width
+ 0 0)
+ text))
(add-form-to-grid grid form #t)
(make-wrapped-grid-window grid title)
diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm
index 2b22ac85b4..cd9d46316a 100644
--- a/gnu/installer/newt/partition.scm
+++ b/gnu/installer/newt/partition.scm
@@ -49,6 +49,8 @@
#:title (G_ "Partition scheme")
#:listbox-items items
#:listbox-item->text cdr
+ #:listbox-height 4
+ #:sort-listbox-items? #f ;keep the 'root' option first
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action)))
(car result)))
@@ -77,6 +79,7 @@ DEVICES list."
#:title (G_ "Disk")
#:listbox-items (device-items)
#:listbox-item->text cdr
+ #:listbox-height 10
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action))
(device (car result)))
@@ -117,7 +120,7 @@ Be careful, all data on the disk will be lost.")
(run-listbox-selection-page
#:info-text (G_ "Please select the file-system type for this partition.")
#:title (G_ "File-system type")
- #:listbox-items '(ext4 btrfs fat32 swap)
+ #:listbox-items '(ext4 btrfs fat16 fat32 swap)
#:listbox-item->text user-fs-type-name
#:sort-listbox-items? #f
#:button-text (G_ "Exit")
@@ -152,21 +155,18 @@ USER-PARTITIONS list. Return this list with password fields filled-in."
(file-name (user-partition-file-name user-part))
(password-page
(lambda ()
- ;; Note: Don't use FLAG-PASSWORD here because this is the
- ;; first bit of text that the user types in, so it's
- ;; probably safer if they can see that the keyboard layout
- ;; they chose is in effect.
(run-input-page
(format #f (G_ "Please enter the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
- (G_ "Password required"))))
+ (G_ "Password required")
+ #:input-hide-checkbox? #t)))
(password-confirm-page
(lambda ()
(run-input-page
(format #f (G_ "Please confirm the password for the \
encryption of partition ~a (label: ~a).") file-name crypt-label)
(G_ "Password confirmation required")
- #:input-flags FLAG-PASSWORD))))
+ #:input-hide-checkbox? #t))))
(if crypt-label
(let loop ()
(let ((password (password-page))
@@ -731,8 +731,10 @@ by pressing the Exit button.~%~%")))
(result (run-listbox-selection-page
#:info-text (G_ "Please select a partitioning method.")
#:title (G_ "Partitioning method")
+ #:listbox-height (+ (length items) 2)
#:listbox-items items
#:listbox-item->text cdr
+ #:sort-listbox-items? #f
#:button-text (G_ "Exit")
#:button-callback-procedure button-exit-action))
(method (car result)))
@@ -750,10 +752,7 @@ by pressing the Exit button.~%~%")))
(disk-commit disk)
disk)))
(scheme (symbol-append method '- (run-scheme-page)))
- (user-partitions (append
- (auto-partition disk #:scheme scheme)
- (create-special-user-partitions
- (disk-partitions disk)))))
+ (user-partitions (auto-partition! disk #:scheme scheme)))
(run-disk-page (list disk) user-partitions
#:guided? #t)))
((eq? method 'manual)
diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm
index deab056e0c..dab805198f 100644
--- a/gnu/installer/newt/user.scm
+++ b/gnu/installer/newt/user.scm
@@ -19,6 +19,7 @@
(define-module (gnu installer newt user)
#:use-module (gnu installer user)
+ #:use-module ((gnu installer steps) #:select (&installer-step-abort))
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
@@ -27,6 +28,8 @@
#:use-module (ice-9 receive)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:export (run-user-page))
(define* (run-user-add-page #:key (name "") (real-name "")
@@ -34,7 +37,7 @@
"Run a form to enter the user name, home directory, and password. Use NAME,
REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
(define (pad-label label)
- (string-pad-right label 20))
+ (string-pad-right label 25))
(let* ((label-name
(make-label -1 -1 (pad-label (G_ "Name"))))
@@ -44,16 +47,19 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
(make-label -1 -1 (pad-label (G_ "Home directory"))))
(label-password
(make-label -1 -1 (pad-label (G_ "Password"))))
- (entry-width 30)
+ (entry-width 35)
(entry-name (make-entry -1 -1 entry-width
#:initial-value name))
(entry-real-name (make-entry -1 -1 entry-width
#:initial-value real-name))
(entry-home-directory (make-entry -1 -1 entry-width
#:initial-value home-directory))
+ (password-visible-cb
+ (make-checkbox -1 -1 (G_ "Hide") #\x "x "))
(entry-password (make-entry -1 -1 entry-width
- #:flags FLAG-PASSWORD))
- (entry-grid (make-grid 2 5))
+ #:flags (logior FLAG-PASSWORD
+ FLAG-SCROLL)))
+ (entry-grid (make-grid 3 5))
(button-grid (make-grid 1 1))
(ok-button (make-button -1 -1 (G_ "OK")))
(grid (make-grid 1 2))
@@ -71,6 +77,12 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
(set-entry-grid-field 0 3 label-password)
(set-entry-grid-field 1 3 entry-password)
+ (set-grid-field entry-grid
+ 2 3
+ GRID-ELEMENT-COMPONENT
+ password-visible-cb
+ #:pad-left 1)
+
(set-grid-field button-grid 0 0 GRID-ELEMENT-COMPONENT ok-button)
(add-component-callback
@@ -83,11 +95,19 @@ REAL-NAME, and HOME-DIRECTORY as the initial values in the form."
(set-entry-text entry-real-name
(string-titlecase (entry-value entry-name))))))
+ (add-component-callback
+ password-visible-cb
+ (lambda (component)
+ (set-entry-flags entry-password
+ FLAG-PASSWORD
+ FLAG-ROLE-TOGGLE)))
+
(add-components-to-form form
label-name label-real-name
label-home-directory label-password
entry-name entry-real-name
entry-home-directory entry-password
+ password-visible-cb
ok-button)
(make-wrapped-grid-window (vertically-stacked-grid
@@ -136,7 +156,7 @@ a thunk, if the confirmation doesn't match PASSWORD, and return its result."
(run-input-page (G_ "Please confirm the password.")
(G_ "Password confirmation required")
#:allow-empty-input? #t
- #:input-flags FLAG-PASSWORD))
+ #:input-hide-checkbox? #t))
(if (string=? password confirmation)
password
@@ -153,7 +173,7 @@ a thunk, if the confirmation doesn't match PASSWORD, and return its result."
(run-input-page (G_ "Please choose a password for the system \
administrator (\"root\").")
(G_ "System administrator password")
- #:input-flags FLAG-PASSWORD))
+ #:input-hide-checkbox? #t))
(confirm-password password run-root-password-page))
@@ -179,7 +199,7 @@ administrator (\"root\").")
(list GRID-ELEMENT-COMPONENT del-button)))))
(ok-button (make-button -1 -1 (G_ "OK")))
(exit-button (make-button -1 -1 (G_ "Exit")))
- (title "User creation")
+ (title (G_ "User creation"))
(grid
(vertically-stacked-grid
GRID-ELEMENT-COMPONENT info-textbox
@@ -231,7 +251,11 @@ administrator (\"root\").")
(run-error-page (G_ "Please create at least one user.")
(G_ "No user"))
(run users))
- (reverse users)))))
+ (reverse users))
+ ((components=? argument exit-button)
+ (raise
+ (condition
+ (&installer-step-abort)))))))
(lambda ()
(destroy-form-and-pop form))))))
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 7cc2217cbe..bd2640d1ad 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -105,8 +105,7 @@
mkpart
rmpart
- create-adjacent-partitions
- auto-partition
+ auto-partition!
&no-root-mount-point
no-root-mount-point?
@@ -259,6 +258,7 @@ inferior to MAX-SIZE, #f otherwise."
(case fs-type
((ext4) "ext4")
((btrfs) "btrfs")
+ ((fat16) "fat16")
((fat32) "fat32")
((swap) "linux-swap")))
@@ -267,6 +267,7 @@ inferior to MAX-SIZE, #f otherwise."
(case fs-type
((ext4) "ext4")
((btrfs) "btrfs")
+ ((fat16) "fat")
((fat32) "vfat")))
(define (partition-filesystem-user-type partition)
@@ -278,6 +279,7 @@ of <user-partition> record."
(cond
((string=? name "ext4") 'ext4)
((string=? name "btrfs") 'btrfs)
+ ((string=? name "fat16") 'fat16)
((string=? name "fat32") 'fat32)
((or (string=? name "swsusp")
(string=? name "linux-swap(v0)")
@@ -818,8 +820,8 @@ cause them to cross."
;; Auto partitionning.
;;
-(define* (create-adjacent-partitions disk partitions
- #:key (last-partition-end 0))
+(define* (create-adjacent-partitions! disk partitions
+ #:key (last-partition-end 0))
"Create the given PARTITIONS on DISK. LAST-PARTITION-END is the sector from
which we want to start creating partitions. The START and END of each created
partition are computed from its SIZE value and the position of the last
@@ -885,15 +887,18 @@ USER-PARTITIONS list and return the updated list."
(need-formatting? #t)))
user-partitions))
-(define* (auto-partition disk
- #:key
- (scheme 'entire-root))
+(define* (auto-partition! disk
+ #:key
+ (scheme 'entire-root))
"Automatically create partitions on DISK. All the previous
partitions (except the ESP on a GPT disk, if present) are wiped. SCHEME is the
desired partitioning scheme. It can be 'entire-root or
'entire-root-home. 'entire-root will create a swap partition and a root
partition occupying all the remaining space. 'entire-root-home will create a
-swap partition, a root partition and a home partition."
+swap partition, a root partition and a home partition.
+
+Return the complete list of partitions on DISK, including the ESP when it
+exists."
(let* ((device (disk-device disk))
(disk-type (disk-disk-type disk))
(has-extended? (disk-type-check-feature
@@ -999,10 +1004,13 @@ swap partition, a root partition and a home partition."
(mount-point "/home")))))))
(new-partitions* (force-user-partitions-formatting
new-partitions)))
- (create-adjacent-partitions disk
- new-partitions*
- #:last-partition-end
- (or end-esp-partition 0)))))
+ (append (if esp-partition
+ (list (partition->user-partition esp-partition))
+ '())
+ (create-adjacent-partitions! disk
+ new-partitions*
+ #:last-partition-end
+ (or end-esp-partition 0))))))
;;
@@ -1042,13 +1050,23 @@ bit bucket."
(with-error-to-port (%make-void-port "w")
(lambda () exp ...)))))
+(define (create-btrfs-file-system partition)
+ "Create an btrfs file-system for PARTITION file-name."
+ (with-null-output-ports
+ (invoke "mkfs.btrfs" "-f" partition)))
+
(define (create-ext4-file-system partition)
"Create an ext4 file-system for PARTITION file-name."
(with-null-output-ports
(invoke "mkfs.ext4" "-F" partition)))
+(define (create-fat16-file-system partition)
+ "Create a fat16 file-system for PARTITION file-name."
+ (with-null-output-ports
+ (invoke "mkfs.fat" "-F16" partition)))
+
(define (create-fat32-file-system partition)
- "Create an ext4 file-system for PARTITION file-name."
+ "Create a fat32 file-system for PARTITION file-name."
(with-null-output-ports
(invoke "mkfs.fat" "-F32" partition)))
@@ -1106,10 +1124,18 @@ NEED-FORMATING? field set to #t."
(luks-format-and-open user-partition))
(case fs-type
+ ((btrfs)
+ (and need-formatting?
+ (not (eq? type 'extended))
+ (create-btrfs-file-system file-name)))
((ext4)
(and need-formatting?
(not (eq? type 'extended))
(create-ext4-file-system file-name)))
+ ((fat16)
+ (and need-formatting?
+ (not (eq? type 'extended))
+ (create-fat16-file-system file-name)))
((fat32)
(and need-formatting?
(not (eq? type 'extended))
diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm
index fbfcdac4e5..d1dc516568 100644
--- a/gnu/installer/services.scm
+++ b/gnu/installer/services.scm
@@ -130,11 +130,13 @@
(if (null? snippets)
`(,@(if (null? packages)
'()
- `((packages (list ,@packages))))
+ `((packages (append (list ,@packages)
+ %base-packages))))
(services ,base))
`(,@(if (null? packages)
'()
- `((packages (list ,@packages))))
+ `((packages (append (list ,@packages)
+ %base-packages))))
(services (append (list ,@snippets
,@(if desktop?
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 039dd0ca10..4e90f32f95 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -71,7 +71,12 @@
installer-step?
(id installer-step-id) ;symbol
(description installer-step-description ;string
- (default #f))
+ (default #f)
+
+ ;; Make it thunked so that 'G_' is called at the
+ ;; right time, as opposed to being called once
+ ;; when the installer starts.
+ (thunked))
(compute installer-step-compute) ;procedure
(configuration-formatter installer-step-configuration-formatter ;procedure
(default #f)))
generated by cgit v1.2.3 (git 2.45.2) at 2024-09-02 13:11:38 +0000