ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Add configuration formatter.

Browse source 
* 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.
This commit is contained in:
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 @@ (define (compiled-file-loader file name)
#: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 @@ (define (installer-steps)
;; 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 @@ (define (installer-steps)
;; 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 @@ (define (installer-steps)
;; 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 @@ (define installer-builder
(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 @@ (define installer-builder
;; 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 @@ (define installer-builder
(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 @@ (define installer-builder
(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 @@ (define-module (gnu installer locale)
language-code->language-name
iso3166->iso3166-territories
territory-code->territory-name))
territory-code->territory-name
locale->configuration))
;;;
@ -197,3 +199,12 @@ (define (territory-code->territory-name territories 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)
(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 @@ (define newt-installer
(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 @@ (define-module (gnu installer record)
installer-init
installer-exit
installer-exit-error
installer-final-page
installer-keymap-page
installer-locale-page
installer-menu-page
@ -57,6 +58,8 @@ (define-record-type* <installer>
;; 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

58
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 @@ (define-module (gnu installer steps)
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
@ -64,7 +73,7 @@ (define-record-type* <installer-step>
(description installer-step-description ;string
(default #f))
(compute installer-step-compute) ;procedure
(configuration-format-proc installer-step-configuration-proc ;procedure
(configuration-formatter installer-step-configuration-formatter ;procedure
(default #f)))
(define* (run-installer-steps #:key
@ -157,7 +166,7 @@ (define* (run result #:key todo-steps done-steps)
(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 @@ (define (result-step-done? results step-id)
"Return #t if the installer-step specified by STEP-ID has a COMPUTE value
stored in RESULTS. Return #f otherwise."
(and (assoc step-id results) #t))
(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 @@ (define-module (gnu installer timezone)
#: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 @@ (define (timezone-has-child? tree timezone)
(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 \