gnu/installer/steps.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018, 2019 Mathieu Othacehe <m.othacehe@gmail.com>
   3 ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu installer steps)
  21   #:use-module (guix records)
  22   #:use-module (guix build utils)
  23   #:use-module (guix i18n)
  24   #:use-module (guix read-print)
  25   #:use-module (gnu installer utils)
  26   #:use-module (ice-9 match)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-34)
  29   #:use-module (srfi srfi-35)
  30   #:use-module (rnrs io ports)
  31   #:export (<installer-step>
  32             installer-step
  33             make-installer-step
  34             installer-step?
  35             installer-step-id
  36             installer-step-description
  37             installer-step-compute
  38             installer-step-configuration-formatter
  39
  40             run-installer-steps
  41             find-step-by-id
  42             result->step-ids
  43             result-step
  44             result-step-done?
  45
  46             %installer-configuration-file
  47             %installer-target-dir
  48             format-configuration
  49             configuration->file
  50
  51             %current-result))
  52
  53 ;; Hash table storing the step results. Use it only for logging and debug
  54 ;; purposes.
  55 (define %current-result (make-hash-table))
  56
  57 ;; An installer-step record is basically an id associated to a compute
  58 ;; procedure. The COMPUTE procedure takes exactly one argument, an association
  59 ;; list containing the results of previously executed installer-steps (see
  60 ;; RUN-INSTALLER-STEPS description). The value returned by the COMPUTE
  61 ;; procedure will be stored in the results list passed to the next
  62 ;; installer-step and so on.
  63 (define-record-type* <installer-step>
  64   installer-step make-installer-step
  65   installer-step?
  66   (id                         installer-step-id) ;symbol
  67   (description                installer-step-description ;string
  68                               (default #f)
  69
  70                               ;; Make it thunked so that 'G_' is called at the
  71                               ;; right time, as opposed to being called once
  72                               ;; when the installer starts.
  73                               (thunked))
  74   (compute                    installer-step-compute) ;procedure
  75   (configuration-formatter    installer-step-configuration-formatter ;procedure
  76                               (default #f)))
  77
  78 (define* (run-installer-steps #:key
  79                               steps
  80                               (rewind-strategy 'previous)
  81                               (menu-proc (const #f)))
  82   "Run the COMPUTE procedure of all <installer-step> records in STEPS
  83 sequentially, inside a the 'installer-step prompt.  When aborted to with a
  84 parameter of 'abort, fallback to a previous install-step, accordingly to the
  85 specified REWIND-STRATEGY.  When aborted to with a parameter of 'break, stop
  86 the computation and return the accumalated result so far.
  87
  88 REWIND-STRATEGY possible values are 'previous, 'menu and 'start.  If 'previous
  89 is selected, the execution will resume at the previous installer-step. If
  90 'menu is selected, the MENU-PROC procedure will be called. Its return value
  91 has to be an installer-step ID to jump to. The ID has to be the one of a
  92 previously executed step. It is impossible to jump forward. Finally if 'start
  93 is selected, the execution will resume at the first installer-step.
  94
  95 The result of every COMPUTE procedures is stored in an association list, under
  96 the form:
  97
  98                 '((STEP-ID . COMPUTE-RESULT) ...)
  99
 100 where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the
 101 result of the associated COMPUTE procedure. This result association list is
 102 passed as argument of every COMPUTE procedure. It is finally returned when the
 103 computation is over."
 104   (define (pop-result list)
 105     (cdr list))
 106
 107   (define (first-step? steps step)
 108     (match steps
 109       ((first-step . rest-steps)
 110        (equal? first-step step))))
 111
 112   (define* (skip-to-step step result
 113                          #:key todo-steps done-steps)
 114     (match todo-steps
 115       ((todo . rest-todo)
 116        (let ((found? (eq? (installer-step-id todo)
 117                           (installer-step-id step))))
 118          (cond
 119           (found?
 120            (run result
 121                 #:todo-steps todo-steps
 122                 #:done-steps done-steps))
 123           ((and (not found?)
 124                 (null? done-steps))
 125            (error (format #f "Step ~a not found" (installer-step-id step))))
 126           (else
 127            (match done-steps
 128              ((prev-done ... last-done)
 129               (skip-to-step step (pop-result result)
 130                             #:todo-steps (cons last-done todo-steps)
 131                             #:done-steps prev-done)))))))))
 132
 133   (define* (run result #:key todo-steps done-steps)
 134     (match todo-steps
 135       (() (reverse result))
 136       ((step . rest-steps)
 137        (call-with-prompt 'installer-step
 138          (lambda ()
 139            (installer-log-line "running step '~a'" (installer-step-id step))
 140            (let* ((id (installer-step-id step))
 141                   (compute (installer-step-compute step))
 142                   (res (compute result done-steps)))
 143              (hash-set! %current-result id res)
 144              (run (alist-cons id res result)
 145                   #:todo-steps rest-steps
 146                   #:done-steps (append done-steps (list step)))))
 147          (lambda (k action)
 148            (match action
 149              ('abort
 150               (case rewind-strategy
 151                 ((previous)
 152                  (match done-steps
 153                    (()
 154                     ;; We cannot go previous the first step. Abort again to
 155                     ;; 'installer-step prompt. It might be useful in the case
 156                     ;; of nested run-installer-steps.
 157                     (abort-to-prompt 'installer-step action))
 158                    ((prev-done ... last-done)
 159                     (run (pop-result result)
 160                          #:todo-steps (cons last-done todo-steps)
 161                          #:done-steps prev-done))))
 162                 ((menu)
 163                  (let ((goto-step (menu-proc
 164                                    (append done-steps (list step)))))
 165                    (if (eq? goto-step step)
 166                        (run result
 167                             #:todo-steps todo-steps
 168                             #:done-steps done-steps)
 169                        (skip-to-step goto-step result
 170                                      #:todo-steps todo-steps
 171                                      #:done-steps done-steps))))
 172                 ((start)
 173                  (if (null? done-steps)
 174                      ;; Same as above, it makes no sense to jump to start
 175                      ;; when we are at the first installer-step. Abort to
 176                      ;; 'installer-step prompt again.
 177                      (abort-to-prompt 'installer-step action)
 178                      (run '()
 179                           #:todo-steps steps
 180                           #:done-steps '())))))
 181              ('break
 182               (reverse result))))))))
 183
 184   ;; Ignore SIGPIPE so that we don't die if a client closes the connection
 185   ;; prematurely.
 186   (sigaction SIGPIPE SIG_IGN)
 187
 188   (with-server-socket
 189     (run '()
 190          #:todo-steps steps
 191          #:done-steps '())))
 192
 193 (define (find-step-by-id steps id)
 194   "Find and return the step in STEPS whose id is equal to ID."
 195   (find (lambda (step)
 196           (eq? (installer-step-id step) id))
 197         steps))
 198
 199 (define (result-step results step-id)
 200   "Return the result of the installer-step specified by STEP-ID in
 201 RESULTS."
 202   (assoc-ref results step-id))
 203
 204 (define (result-step-done? results step-id)
 205   "Return #t if the installer-step specified by STEP-ID has a COMPUTE value
 206 stored in RESULTS. Return #f otherwise."
 207   (and (assoc step-id results) #t))
 208
 209 (define %installer-configuration-file (make-parameter "/mnt/etc/config.scm"))
 210 (define %installer-target-dir (make-parameter "/mnt"))
 211
 212 (define (format-configuration steps results)
 213   "Return the list resulting from the application of the procedure defined in
 214 CONFIGURATION-FORMATTER field of <installer-step> on the associated result
 215 found in RESULTS."
 216   (let ((configuration
 217          (append-map
 218           (lambda (step)
 219             (let* ((step-id (installer-step-id step))
 220                    (conf-formatter
 221                     (installer-step-configuration-formatter step))
 222                    (result-step (result-step results step-id)))
 223               (if (and result-step conf-formatter)
 224                   (conf-formatter result-step)
 225                   '())))
 226           steps))
 227         (modules `(,(vertical-space 1)
 228                    ,(comment (G_ "\
 229 ;; Indicate which modules to import to access the variables
 230 ;; used in this configuration.\n"))
 231                    (use-modules (gnu))
 232                    (use-service-modules cups desktop networking ssh xorg))))
 233     `(,@modules
 234       ,(vertical-space 1)
 235       (operating-system ,@configuration))))
 236
 237 (define* (configuration->file configuration
 238                               #:key (filename (%installer-configuration-file)))
 239   "Write the given CONFIGURATION to FILENAME."
 240   (mkdir-p (dirname filename))
 241   (call-with-output-file filename
 242     (lambda (port)
 243       ;; TRANSLATORS: This is a comment within a Scheme file.  Each line must
 244       ;; start with ";; " (two semicolons and a space).  Please keep line
 245       ;; length below 60 characters.
 246       (display (G_ "\
 247 ;; This is an operating system configuration generated
 248 ;; by the graphical installer.
 249 ;;
 250 ;; Once installation is complete, you can learn and modify
 251 ;; this file to tweak the system configuration, and pass it
 252 ;; to the 'guix system reconfigure' command to effect your
 253 ;; changes.\n")
 254                port)
 255       (newline port)
 256       (pretty-print-with-comments/splice port configuration
 257                                          #:max-width 75
 258                                          #:format-comment
 259                                          (lambda (c indent)
 260                                            ;; Localize C.
 261                                            (comment (G_ (comment->string c))
 262                                                     (comment-margin? c))))
 263
 264       (flush-output-port port))))
 265
 266 ;;; Local Variables:
 267 ;;; eval: (put 'with-server-socket 'scheme-indent-function 0)
 268 ;;; End: