gnu: Add graphical installer support.

* configure.ac: Require that guile-newt is available.
* gnu/installer.scm: New file.
* gnu/installer/aux-files/logo.txt: New file.
* gnu/installer/build-installer.scm: New file.
* gnu/installer/connman.scm: New file.
* gnu/installer/keymap.scm: New file.
* gnu/installer/locale.scm: New file.
* gnu/installer/newt.scm: New file.
* gnu/installer/newt/ethernet.scm: New file.
* gnu/installer/newt/hostname.scm: New file.
* gnu/installer/newt/keymap.scm: New file.
* gnu/installer/newt/locale.scm: New file.
* gnu/installer/newt/menu.scm: New file.
* gnu/installer/newt/network.scm: New file.
* gnu/installer/newt/page.scm: New file.
* gnu/installer/newt/timezone.scm: New file.
* gnu/installer/newt/user.scm: New file.
* gnu/installer/newt/utils.scm: New file.
* gnu/installer/newt/welcome.scm: New file.
* gnu/installer/newt/wifi.scm: New file.
* gnu/installer/steps.scm: New file.
* gnu/installer/timezone.scm: New file.
* gnu/installer/utils.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add previous files.
* gnu/system.scm: Export %root-account.
* gnu/system/install.scm (%installation-services): Use kmscon instead of linux
VT for all tty.
(installation-os)[users]: Add the graphical installer as shell of the root
account.
[packages]: Add font related packages.
* po/guix/POTFILES.in: Add installer files.

1 files changed, 187 insertions, 0 deletions

diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
new file mode 100644
index 0000000000..5fd54356dd
--- /dev/null
+++ b/gnu/installer/steps.scm
@@ -0,0 +1,187 @@
+;;; 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 steps)
+  #:use-module (guix records)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (&installer-step-abort
+            installer-step-abort?
+
+            &installer-step-break
+            installer-step-break?
+
+            <installer-step>
+            installer-step
+            make-installer-step
+            installer-step?
+            installer-step-id
+            installer-step-description
+            installer-step-compute
+            installer-step-configuration-proc
+
+            run-installer-steps
+            find-step-by-id
+            result->step-ids
+            result-step
+            result-step-done?))
+
+;; This condition may be raised to abort the current step.
+(define-condition-type &installer-step-abort &condition
+  installer-step-abort?)
+
+;; This condition may be raised to break out from the steps execution.
+(define-condition-type &installer-step-break &condition
+  installer-step-break?)
+
+;; An installer-step record is basically an id associated to a compute
+;; procedure. The COMPUTE procedure takes exactly one argument, an association
+;; list containing the results of previously executed installer-steps (see
+;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
+;; procedure will be stored in the results list passed to the next
+;; installer-step and so on.
+(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)))
+
+(define* (run-installer-steps #:key
+                              steps
+                              (rewind-strategy 'previous)
+                              (menu-proc (const #f)))
+  "Run the COMPUTE procedure of all <installer-step> records in STEPS
+sequencially. If the &installer-step-abort condition is raised, fallback to a
+previous install-step, accordingly to the specified REWIND-STRATEGY.
+
+REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
+is selected, the execution will resume at the previous installer-step. If
+'menu is selected, the MENU-PROC procedure will be called. Its return value
+has to be an installer-step ID to jump to. The ID has to be the one of a
+previously executed step. It is impossible to jump forward. Finally if 'start
+is selected, the execution will resume at the first installer-step.
+
+The result of every COMPUTE procedures is stored in an association list, under
+the form:
+
+		'((STEP-ID . COMPUTE-RESULT) ...)
+
+where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
+result of the associated COMPUTE procedure. This result association list is
+passed as argument of every COMPUTE procedure. It is finally returned when the
+computation is over.
+
+If the &installer-step-break condition is raised, stop the computation and
+return the accumalated result so far."
+  (define (pop-result list)
+    (cdr list))
+
+  (define (first-step? steps step)
+    (match steps
+      ((first-step . rest-steps)
+       (equal? first-step step))))
+
+  (define* (skip-to-step step result
+                         #:key todo-steps done-steps)
+    (match (list todo-steps done-steps)
+      (((todo . rest-todo) (prev-done ... last-done))
+       (if (eq? (installer-step-id todo)
+                (installer-step-id step))
+           (run result
+                #:todo-steps todo-steps
+                #:done-steps done-steps)
+           (skip-to-step step (pop-result result)
+                         #:todo-steps (cons last-done todo-steps)
+                         #:done-steps prev-done)))))
+
+  (define* (run result #:key todo-steps done-steps)
+    (match todo-steps
+      (() (reverse result))
+      ((step . rest-steps)
+       (guard (c ((installer-step-abort? c)
+                  (case rewind-strategy
+                    ((previous)
+                     (match done-steps
+                       (()
+                        ;; We cannot go previous the first step. So re-raise
+                        ;; the exception. It might be useful in the case of
+                        ;; nested run-installer-steps. Abort to 'raise-above
+                        ;; prompt to prevent the condition from being catched
+                        ;; by one of the previously installed guard.
+                        (abort-to-prompt 'raise-above c))
+                       ((prev-done ... last-done)
+                        (run (pop-result result)
+                             #:todo-steps (cons last-done todo-steps)
+                             #:done-steps prev-done))))
+                    ((menu)
+                     (let ((goto-step (menu-proc
+                                       (append done-steps (list step)))))
+                       (if (eq? goto-step step)
+                           (run result
+                                #:todo-steps todo-steps
+                                #:done-steps done-steps)
+                           (skip-to-step goto-step result
+                                         #:todo-steps todo-steps
+                                         #:done-steps done-steps))))
+                    ((start)
+                     (if (null? done-steps)
+                         ;; Same as above, it makes no sense to jump to start
+                         ;; when we are at the first installer-step. Abort to
+                         ;; 'raise-above prompt to re-raise the condition.
+                         (abort-to-prompt 'raise-above c)
+                         (run '()
+                              #:todo-steps steps
+                              #:done-steps '())))))
+                 ((installer-step-break? c)
+                  (reverse result)))
+         (let* ((id (installer-step-id step))
+                (compute (installer-step-compute step))
+                (res (compute result)))
+           (run (alist-cons id res result)
+                #:todo-steps rest-steps
+                #:done-steps (append done-steps (list step))))))))
+
+  (call-with-prompt 'raise-above
+    (lambda ()
+      (run '()
+           #:todo-steps steps
+           #:done-steps '()))
+    (lambda (k condition)
+      (raise condition))))
+
+(define (find-step-by-id steps id)
+  "Find and return the step in STEPS whose id is equal to ID."
+  (find (lambda (step)
+          (eq? (installer-step-id step) id))
+        steps))
+
+(define (result-step results step-id)
+  "Return the result of the installer-step specified by STEP-ID in
+RESULTS."
+  (assoc-ref results step-id))
+
+(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))