nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

installer: Add configuration formatter. 

* gnu/installer.scm (installer-steps): Add configuration-formatter procedures.
* gnu/installer/final.scm: New file.
* gnu/installer/locale.scm (locale->configuration): New exported procedure.
* gnu/installer/newt.scm (newt-installer): Add final page.
* gnu/installer/newt/final.scm: New file.
* gnu/installer/record.scm (installer): Add final-page field.
* gnu/installer/timezone.scm (posix-tz->configuration): New exported
procedure.
* gnu/installer/steps.scm (installer-step): Rename configuration-proc field to
configuration-formatter.
(%installer-configuration-file): New exported parameter,
(%installer-target-dir): ditto,
(%configuration-file-width): ditto,
(format-configuration): new exported procedure,
(configuration->file): new exported procedure.
master
Mathieu Othacehe 2018-12-05 14:30:16 +09:00 committed by Ludovic Courtès
parent 3ad8f7757c
commit dc5f3275ec
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
9 changed files with 249 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
gnu/installer.scm
View File

@ -129,7 +129,8 @@ been performed at build time."
#:supported-locales #$locales-loader
#:iso639-languages #$iso639-loader
#:iso3166-territories #$iso3166-loader)))
(#$apply-locale result)))))
(#$apply-locale result)
result))))
(define apply-keymap
;; Apply the specified keymap.
@ -176,17 +177,19 @@ selected keymap."
;; benefit from any available translation for the installer messages.
(installer-step
(id 'locale)
(description (G_ "Locale selection"))
(description (G_ "Locale"))
(compute (lambda _
(#$locale-step current-installer))))
(#$locale-step current-installer)))
(configuration-formatter locale->configuration))
;; Ask the user to select a timezone under glibc format.
(installer-step
(id 'timezone)
(description (G_ "Timezone selection"))
(description (G_ "Timezone"))
(compute (lambda _
((installer-timezone-page current-installer)
#$timezone-data))))
#$timezone-data)))
(configuration-formatter posix-tz->configuration))
;; The installer runs in a kmscon virtual terminal where loadkeys
;; won't work. kmscon uses libxkbcommon as a backend for keyboard
@ -205,9 +208,10 @@ selected keymap."
;; Ask the user to input a hostname for the system.
(installer-step
(id 'hostname)
(description (G_ "Hostname selection"))
(description (G_ "Hostname"))
(compute (lambda _
((installer-hostname-page current-installer)))))
((installer-hostname-page current-installer))))
(configuration-formatter hostname->configuration))
;; Provide an interface above connmanctl, so that the user can select
;; a network susceptible to acces Internet.
@ -219,10 +223,22 @@ selected keymap."
;; Prompt for users (name, group and home directory).
(installer-step
(id 'hostname)
(description (G_ "User selection"))
(id 'user)
(description (G_ "User creation"))
(compute (lambda _
((installer-user-page current-installer)))))))))
((installer-user-page current-installer))))
(configuration-formatter users->configuration))
(compute (lambda _
((installer-user-page current-installer)))))
(installer-step
(id 'final)
(description (G_ "Configuration file"))
(compute
(lambda (result prev-steps)
((installer-final-page current-installer)
result prev-steps)))))))
(define (installer-program)
"Return a file-like object that runs the given INSTALLER."
@ -255,7 +271,12 @@ selected keymap."
(use-modules (gnu installer record)
(gnu installer keymap)
(gnu installer steps)
(gnu installer final)
(gnu installer locale)
(gnu installer parted)
(gnu installer services)
(gnu installer timezone)
(gnu installer user)
(gnu installer newt)
(guix i18n)
(guix build utils)
@ -268,7 +289,8 @@ selected keymap."
;; Add some binaries used by the installers to PATH.
#$set-installer-path
(let ((current-installer newt-installer))
(let* ((current-installer newt-installer)
(steps (#$steps current-installer)))
((installer-init current-installer))
(catch #t
@ -276,7 +298,7 @@ selected keymap."
(run-installer-steps
#:rewind-strategy 'menu
#:menu-proc (installer-menu-page current-installer)
#:steps (#$steps current-installer)))
#:steps steps))
(const #f)
(lambda (key . args)
((installer-exit-error current-installer) key args)
@ -289,8 +311,9 @@ selected keymap."
(print-exception port
(stack-ref (make-stack #t) 1)
key args)))
(primitive-exit 1))))
((installer-exit current-installer))))))
(primitive-exit 1)))
((installer-exit current-installer)))))))
(program-file
"installer"

36
gnu/installer/final.scm Normal file
View File

@ -0,0 +1,36 @@
;;; 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 final)
#:use-module (gnu installer newt page)
#:use-module (gnu installer steps)
#:use-module (gnu installer utils)
#:use-module (gnu services herd)
#:use-module (guix build utils)
#:export (install-system))
(define (install-system)
"Start COW-STORE service on target directory and launch guix install command
in a subshell."
(let ((install-command
(format #f "guix system init ~a ~a"
(%installer-configuration-file)
(%installer-target-dir))))
(mkdir-p (%installer-target-dir))
(start-service 'cow-store (list (%installer-target-dir)))
(false-if-exception (run-shell-command install-command))))

13
gnu/installer/locale.scm
View File

@ -35,7 +35,9 @@
language-code->language-name
iso3166->iso3166-territories
territory-code->territory-name))
territory-code->territory-name
locale->configuration))
;;;
@ -197,3 +199,12 @@ territory name corresponding to the given TERRITORY-CODE."
territory-code)))
territories)))
(iso3166-territory-name iso3166-territory)))
;;;
;;; Configuration formatter.
;;;
(define (locale->configuration locale)
"Return the configuration field for LOCALE."
`((locale ,locale)))

5
gnu/installer/newt.scm
View File

@ -19,6 +19,7 @@
(define-module (gnu installer newt)
#:use-module (gnu installer record)
#:use-module (gnu installer newt ethernet)
#:use-module (gnu installer newt final)
#:use-module (gnu installer newt hostname)
#:use-module (gnu installer newt keymap)
#:use-module (gnu installer newt locale)
@ -46,6 +47,9 @@
(define (exit-error key . args)
(newt-finish))
(define (final-page result prev-steps)
(run-final-page result prev-steps))
(define* (locale-page #:key
supported-locales
iso639-languages
@ -83,6 +87,7 @@
(init init)
(exit exit)
(exit-error exit-error)
(final-page final-page)
(keymap-page keymap-page)
(locale-page locale-page)
(menu-page menu-page)

84
gnu/installer/newt/final.scm Normal file
View File

@ -0,0 +1,84 @@
;;; 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 final)
#:use-module (gnu installer final)
#:use-module (gnu installer parted)
#:use-module (gnu installer steps)
#:use-module (gnu installer utils)
#:use-module (gnu installer newt page)
#:use-module (gnu installer newt utils)
#:use-module (guix i18n)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (newt)
#:export (run-final-page))
(define (run-config-display-page)
(let ((width (%configuration-file-width))
(height (nearest-exact-integer
(/ (screen-rows) 2))))
(run-file-textbox-page
#:info-text (G_ "Congratulations, the installation is almost over! A \
system configuration file has been generated, it is displayed just below. The \
new system will be created from this file when pression the Ok button.")
#:title (G_ "Configuration file")
#:file (%installer-configuration-file)
#:info-textbox-width width
#:file-textbox-width width
#:file-textbox-height height
#:cancel-button-callback-procedure
(lambda ()
(raise
(condition
(&installer-step-abort)))))))
(define (run-install-success-page)
(message-window
(G_ "Installation complete")
(G_ "Reboot")
(G_ "The installation finished with success. You may now remove the device \
with the installation image and press the button to reboot.")))
(define (run-install-failed-page)
(choice-window
(G_ "Installation failed")
(G_ "Restart installer")
(G_ "Retry system install")
(G_ "The final system installation step failed. You can retry the \
last step, or restart the installer.")))
(define (run-install-shell)
(clear-screen)
(newt-suspend)
(let ((install-ok? (install-system)))
(newt-resume)
install-ok?))
(define (run-final-page result prev-steps)
(let* ((configuration (format-configuration prev-steps result))
(user-partitions (result-step result 'partition))
(install-ok?
(with-mounted-partitions
user-partitions
(configuration->file configuration)
(run-config-display-page)
(run-install-shell))))
(if install-ok?
(run-install-success-page)
(run-install-failed-page))))

3
gnu/installer/record.scm
View File

@ -27,6 +27,7 @@
installer-init
installer-exit
installer-exit-error
installer-final-page
installer-keymap-page
installer-locale-page
installer-menu-page
@ -57,6 +58,8 @@
;; procedure (key arguments) -> void
(exit-error installer-exit-error)
;; procedure (#:key models layouts) -> (list model layout variant)
;; procedure void -> void
(final-page installer-final-page)
(keymap-page installer-keymap-page)
;; procedure: (#:key supported-locales iso639-languages iso3166-territories)
;; -> glibc-locale

68
gnu/installer/steps.scm
View File

@ -18,10 +18,13 @@
(define-module (gnu installer steps)
#:use-module (guix records)
#:use-module (guix build utils)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs io ports)
#:export (&installer-step-abort
installer-step-abort?
@ -35,13 +38,19 @@
installer-step-id
installer-step-description
installer-step-compute
installer-step-configuration-proc
installer-step-configuration-formatter
run-installer-steps
find-step-by-id
result->step-ids
result-step
result-step-done?))
result-step-done?
%installer-configuration-file
%installer-target-dir
%configuration-file-width
format-configuration
configuration->file))
;; This condition may be raised to abort the current step.
(define-condition-type &installer-step-abort &condition
@ -60,12 +69,12 @@
(define-record-type* <installer-step>
installer-step make-installer-step
installer-step?
(id installer-step-id) ;symbol
(description installer-step-description ;string
(default #f))
(compute installer-step-compute) ;procedure
(configuration-format-proc installer-step-configuration-proc ;procedure
(default #f)))
(id installer-step-id) ;symbol
(description installer-step-description ;string
(default #f))
(compute installer-step-compute) ;procedure
(configuration-formatter installer-step-configuration-formatter ;procedure
(default #f)))
(define* (run-installer-steps #:key
steps
@ -157,7 +166,7 @@ return the accumalated result so far."
(reverse result)))
(let* ((id (installer-step-id step))
(compute (installer-step-compute step))
(res (compute result)))
(res (compute result done-steps)))
(run (alist-cons id res result)
#:todo-steps rest-steps
#:done-steps (append done-steps (list step))))))))
@ -185,3 +194,44 @@ RESULTS."
"Return #t if the installer-step specified by STEP-ID has a COMPUTE value
stored in RESULTS. Return #f otherwise."
(and (assoc step-id results) #t))
(define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
(define %installer-target-dir (make-parameter "/mnt"))
(define %configuration-file-width (make-parameter 79))
(define (format-configuration steps results)
"Return the list resulting from the application of the procedure defined in
CONFIGURATION-FORMATTER field of <installer-step> on the associated result
found in RESULTS."
(let ((configuration
(append-map
(lambda (step)
(let* ((step-id (installer-step-id step))
(conf-formatter
(installer-step-configuration-formatter step))
(result-step (result-step results step-id)))
(if (and result-step conf-formatter)
(conf-formatter result-step)
'())))
steps))
(modules '((use-modules (gnu))
(use-service-modules desktop))))
`(,@modules
()
(operating-system ,@configuration))))
(define* (configuration->file configuration
#:key (filename (%installer-configuration-file)))
"Write the given CONFIGURATION to FILENAME."
(mkdir-p (dirname filename))
(call-with-output-file filename
(lambda (port)
(format port ";; This is an operating system configuration generated~%")
(format port ";; by the graphical installer.~%")
(newline port)
(for-each (lambda (part)
(if (null? part)
(newline port)
(pretty-print part port)))
configuration)
(flush-output-port port))))

12
gnu/installer/timezone.scm
View File

@ -28,7 +28,8 @@
#:export (locate-childrens
timezone->posix-tz
timezone-has-child?
zonetab->timezone-tree))
zonetab->timezone-tree
posix-tz->configuration))
(define %not-blank
(char-set-complement char-set:blank))
@ -115,3 +116,12 @@ TREE. Raise a condition if the PATH could not be found."
(define* (zonetab->timezone-tree zonetab)
"Return the timezone tree corresponding to the given ZONETAB file."
(timezones->timezone-tree (zonetab->timezones zonetab)))
;;;
;;; Configuration formatter.
;;;
(define (posix-tz->configuration timezone)
"Return the configuration field for TIMEZONE."
`((timezone ,timezone)))

2
gnu/local.mk
View File

@ -569,6 +569,7 @@ GNU_SYSTEM_MODULES += \
%D%/installer.scm \
%D%/installer/record.scm \
%D%/installer/connman.scm \
%D%/installer/final.scm \
%D%/installer/keymap.scm \
%D%/installer/locale.scm \
%D%/installer/newt.scm \
@ -577,6 +578,7 @@ GNU_SYSTEM_MODULES += \
%D%/installer/utils.scm \
\
%D%/installer/newt/ethernet.scm \
%D%/installer/newt/final.scm \
%D%/installer/newt/hostname.scm \
%D%/installer/newt/keymap.scm \
%D%/installer/newt/locale.scm \