projects/guix·blob python-team · refs

284 lines · 11.2 KiB

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