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.

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)
+          (id 'user)
-          (description (G_ "User selection"))
+          (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))))
+                  (primitive-exit 1)))
-            ((installer-exit current-installer))))))
+
+              ((installer-exit current-installer)))))))
 
   (program-file
    "installer"

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))))

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)))

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)

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))))

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

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
+  (id                         installer-step-id) ;symbol
-  (description                  installer-step-description ;string
+  (description                installer-step-description ;string
-                                (default #f))
+                              (default #f))
-  (compute                      installer-step-compute) ;procedure
+  (compute                    installer-step-compute) ;procedure
-  (configuration-format-proc    installer-step-configuration-proc ;procedure
+  (configuration-formatter    installer-step-configuration-formatter ;procedure
-                                (default #f)))
+                              (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))))

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)))

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			\