aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/installer.scm51
-rw-r--r--gnu/installer/final.scm36
-rw-r--r--gnu/installer/locale.scm13
-rw-r--r--gnu/installer/newt.scm5
-rw-r--r--gnu/installer/newt/final.scm84
-rw-r--r--gnu/installer/record.scm3
-rw-r--r--gnu/installer/steps.scm68
-rw-r--r--gnu/installer/timezone.scm12
-rw-r--r--gnu/local.mk2
9 files changed, 249 insertions, 25 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm
index b3eb2a6b08..e53acb12f4 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -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))))
+ (configuration-formatter users->configuration))
+
(compute (lambda _
- ((installer-user-page current-installer)))))))))
+ ((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"
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
new file mode 100644
index 0000000000..e1c62f5ce0
--- /dev/null
+++ b/gnu/installer/final.scm
@@ -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))))
diff --git a/gnu/installer/locale.scm b/gnu/installer/locale.scm
index 504070d41d..2b45b2200a 100644
--- a/gnu/installer/locale.scm
+++ b/gnu/installer/locale.scm
@@ -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)))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index db57c732d1..77a7e6dca2 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -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)
diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm
new file mode 100644
index 0000000000..023777cc0a
--- /dev/null
+++ b/gnu/installer/newt/final.scm
@@ -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))))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 9c10c65758..bf74040699 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -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
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index 5fd54356dd..3f0bdad4f7 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -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))))
diff --git a/gnu/installer/timezone.scm b/gnu/installer/timezone.scm
index 061e8c2e48..32bc2ed6bb 100644
--- a/gnu/installer/timezone.scm
+++ b/gnu/installer/timezone.scm
@@ -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)))
diff --git a/gnu/local.mk b/gnu/local.mk
index b0ec16de34..d4acb8d2ec 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -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 \