projects/guix·blob python-team · refs

238 lines · 7.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018, 2020 Mathieu Othacehe <[email protected]>
3;;; Copyright © 2024 Janneke Nieuwenhuizen <[email protected]>
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 newt)
21 #:use-module (gnu installer record)
22 #:use-module (gnu installer utils)
23 #:use-module (gnu installer dump)
24 #:use-module (gnu installer newt ethernet)
25 #:use-module (gnu installer newt final)
26 #:use-module (gnu installer newt parameters)
27 #:use-module (gnu installer newt hostname)
28 #:use-module (gnu installer newt kernel)
29 #:use-module (gnu installer newt keymap)
30 #:use-module (gnu installer newt locale)
31 #:use-module (gnu installer newt menu)
32 #:use-module (gnu installer newt network)
33 #:use-module (gnu installer newt page)
34 #:use-module (gnu installer newt partition)
35 #:use-module (gnu installer newt services)
36 #:use-module (gnu installer newt substitutes)
37 #:use-module (gnu installer newt timezone)
38 #:use-module (gnu installer newt user)
39 #:use-module (gnu installer newt utils)
40 #:use-module (gnu installer newt welcome)
41 #:use-module (gnu installer newt wifi)
42 #:use-module (guix config)
43 #:use-module (guix discovery)
44 #:use-module (guix i18n)
45 #:use-module (srfi srfi-1)
46 #:use-module (srfi srfi-26)
47 #:use-module (srfi srfi-34)
48 #:use-module (srfi srfi-35)
49 #:use-module (ice-9 ftw)
50 #:use-module (ice-9 match)
51 #:use-module (newt)
52 #:export (newt-installer))
53
54(define (init)
55 (newt-init)
56 (clear-screen)
57 (set-screen-size!)
58 (installer-log-line "Display is ~ax~a." (screen-columns) (screen-rows))
59 (push-help-line
60 (format #f (G_ "Press <F1> for installation parameters."))))
61
62(define (exit)
63 (newt-finish)
64 (clear-screen))
65
66(define (exit-error error)
67 ;; Newt may be suspended in the context of the "install-system"
68 ;; procedure. Resume it unconditionally.
69 (newt-resume)
70 (newt-set-color COLORSET-ROOT "white" "red")
71 (define action
72 (run-textbox-page
73 #:info-text (G_ "The installer has encountered an unexpected problem. \
74The backtrace is displayed below. You may choose to exit or create a dump \
75archive.")
76 #:title (G_ "Unexpected problem")
77 #:content error
78 #:buttons-spec
79 (list
80 (cons (G_ "Dump") (const 'dump))
81 (cons (G_ "Exit") (const 'exit)))))
82 (newt-set-color COLORSET-ROOT "white" "blue")
83 action)
84
85(define (report-page dump-archive)
86 (define text
87 (format #f (G_ "The dump archive was created as ~a. Would you like to \
88send this archive to the Guix servers?") dump-archive))
89 (define title (G_ "Dump archive created"))
90 (when (run-confirmation-page text title)
91 (let* ((uploaded-name (send-dump-report dump-archive))
92 (text (if uploaded-name
93 (format #f (G_ "The dump was uploaded as ~a. Please \
94report it by email to ~a.") uploaded-name %guix-bug-report-address)
95 (G_ "The dump could not be uploaded."))))
96 (run-error-page
97 text
98 (G_ "Dump upload result")))))
99
100(define (dump-page dump-dir)
101 (define files
102 (scandir dump-dir (lambda (x)
103 (not (or (string=? x ".")
104 (string=? x ".."))))))
105 (fold (match-lambda*
106 (((file . enable?) acc)
107 (if enable?
108 (cons file acc)
109 acc)))
110 '()
111 (run-dump-page
112 dump-dir
113 (map (lambda (x)
114 (cons x #f))
115 files))))
116
117(define (newt-run-command . args)
118 (define command-output "")
119 (define (line-accumulator line)
120 (set! command-output
121 (string-append/shared command-output line)))
122 (define result (run-external-command-with-line-hooks (list line-accumulator)
123 args))
124 (define exit-val (status:exit-val result))
125 (define term-sig (status:term-sig result))
126 (define stop-sig (status:stop-sig result))
127
128 (if (and exit-val (zero? exit-val))
129 #t
130 (let ((info-text
131 (cond
132 (exit-val
133 (format #f (G_ "External command ~s exited with code ~a")
134 args exit-val))
135 (term-sig
136 (format #f (G_ "External command ~s terminated by signal ~a")
137 args term-sig))
138 (stop-sig
139 (format #f (G_ "External command ~s stopped by signal ~a")
140 args stop-sig)))))
141 (run-textbox-page #:title (G_ "External command error")
142 #:info-text info-text
143 #:content command-output
144 #:buttons-spec
145 (list
146 (cons (G_ "Ignore") (const #t))
147 (cons (G_ "Abort")
148 (lambda ()
149 (abort-to-prompt 'installer-step 'abort)))
150 (cons (G_ "Report")
151 (lambda ()
152 (raise
153 (condition
154 ((@@ (guix build utils)
155 &invoke-error)
156 (program (car args))
157 (arguments (cdr args))
158 (exit-status exit-val)
159 (term-signal term-sig)
160 (stop-signal stop-sig)))))))))))
161
162(define (final-page result prev-steps dry-run?)
163 (run-final-page result prev-steps dry-run?))
164
165(define* (locale-page #:key
166 supported-locales
167 iso639-languages
168 iso3166-territories
169 dry-run?)
170 (run-locale-page
171 #:supported-locales supported-locales
172 #:iso639-languages iso639-languages
173 #:iso3166-territories iso3166-territories
174 #:dry-run? dry-run?))
175
176(define (timezone-page zonetab)
177 (run-timezone-page zonetab))
178
179(define* (welcome-page logo #:key pci-database)
180 (run-welcome-page logo #:pci-database pci-database))
181
182(define (menu-page steps)
183 (run-menu-page steps))
184
185(define (keymap-page layouts context dry-run?)
186 (run-keymap-page layouts #:context context #:dry-run? dry-run?))
187
188(define (network-page)
189 (run-network-page))
190
191(define (substitutes-page)
192 (run-substitutes-page))
193
194(define (hostname-page)
195 (run-hostname-page))
196
197(define (kernel-page)
198 (run-kernel-page))
199
200(define (user-page)
201 (run-user-page))
202
203(define (partitioning-page)
204 (run-partitioning-page))
205
206(define (services-page)
207 (run-services-page))
208
209(define (parameters-menu menu-proc)
210 (newt-set-help-callback menu-proc))
211
212(define (parameters-page keyboard-layout-selection)
213 (run-parameters-page keyboard-layout-selection))
214
215(define newt-installer
216 (installer
217 (name 'newt)
218 (init init)
219 (exit exit)
220 (exit-error exit-error)
221 (final-page final-page)
222 (keymap-page keymap-page)
223 (kernel-page kernel-page)
224 (locale-page locale-page)
225 (menu-page menu-page)
226 (network-page network-page)
227 (substitutes-page substitutes-page)
228 (timezone-page timezone-page)
229 (hostname-page hostname-page)
230 (user-page user-page)
231 (partitioning-page partitioning-page)
232 (services-page services-page)
233 (welcome-page welcome-page)
234 (parameters-menu parameters-menu)
235 (parameters-page parameters-page)
236 (dump-page dump-page)
237 (run-command newt-run-command)
238 (report-page report-page)))