Commit | Line | Data |
---|---|---|
d0f3a672 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |
f901f5d2 | 3 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> |
d0f3a672 MO |
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 network) | |
21 | #:use-module (gnu installer connman) | |
22 | #:use-module (gnu installer steps) | |
23 | #:use-module (gnu installer utils) | |
24 | #:use-module (gnu installer newt ethernet) | |
25 | #:use-module (gnu installer newt page) | |
26 | #:use-module (gnu installer newt wifi) | |
27 | #:use-module (guix i18n) | |
28 | #:use-module (srfi srfi-1) | |
29 | #:use-module (srfi srfi-11) | |
30 | #:use-module (srfi srfi-34) | |
31 | #:use-module (srfi srfi-35) | |
46c102ca | 32 | #:use-module (ice-9 match) |
d0f3a672 MO |
33 | #:use-module (newt) |
34 | #:export (run-network-page)) | |
35 | ||
36 | ;; Maximum length of a technology name. | |
37 | (define technology-name-max-length (make-parameter 20)) | |
38 | ||
39 | (define (technology->text technology) | |
40 | "Return a string describing the given TECHNOLOGY." | |
41 | (let* ((name (technology-name technology)) | |
42 | (padded-name (string-pad-right name | |
43 | (technology-name-max-length)))) | |
44 | (format #f "~a~%" padded-name))) | |
45 | ||
46 | (define (run-technology-page) | |
47 | "Run a page to ask the user which technology shall be used to access | |
48 | Internet and return the selected technology. For now, only technologies with | |
49 | \"ethernet\" or \"wifi\" types are supported." | |
50 | (define (technology-items) | |
51 | (filter (lambda (technology) | |
52 | (let ((type (technology-type technology))) | |
53 | (or | |
54 | (string=? type "ethernet") | |
55 | (string=? type "wifi")))) | |
56 | (connman-technologies))) | |
57 | ||
46c102ca LC |
58 | (match (technology-items) |
59 | (() | |
60 | (case (choice-window | |
61 | (G_ "Internet access") | |
62 | (G_ "Continue") | |
63 | (G_ "Exit") | |
64 | (G_ "The install process requires Internet access but no \ | |
232a7e69 | 65 | network devices were found. Do you want to continue anyway?")) |
46c102ca LC |
66 | ((1) (raise |
67 | (condition | |
68 | (&installer-step-break)))) | |
69 | ((2) (raise | |
70 | (condition | |
71 | (&installer-step-abort)))))) | |
72 | ((technology) | |
73 | ;; Since there's only one technology available, skip the selection | |
74 | ;; screen. | |
75 | technology) | |
76 | ((items ...) | |
77 | (run-listbox-selection-page | |
78 | #:info-text (G_ "The install process requires Internet access.\ | |
77c00b1e | 79 | Please select a network device.") |
46c102ca LC |
80 | #:title (G_ "Internet access") |
81 | #:listbox-items items | |
82 | #:listbox-item->text technology->text | |
83 | #:listbox-height (min (+ (length items) 2) 10) | |
84 | #:button-text (G_ "Exit") | |
85 | #:button-callback-procedure | |
86 | (lambda _ | |
87 | (raise | |
88 | (condition | |
89 | (&installer-step-abort)))))))) | |
d0f3a672 MO |
90 | |
91 | (define (find-technology-by-type technologies type) | |
92 | "Find and return a technology with the given TYPE in TECHNOLOGIES list." | |
93 | (find (lambda (technology) | |
94 | (string=? (technology-type technology) | |
95 | type)) | |
96 | technologies)) | |
97 | ||
98 | (define (wait-technology-powered technology) | |
99 | "Wait and display a progress bar until the given TECHNOLOGY is powered." | |
100 | (let ((name (technology-name technology)) | |
101 | (full-value 5)) | |
102 | (run-scale-page | |
103 | #:title (G_ "Powering technology") | |
3cc033f2 LC |
104 | #:info-text (format #f (G_ "Waiting for technology ~a to be powered.") |
105 | name) | |
d0f3a672 MO |
106 | #:scale-full-value full-value |
107 | #:scale-update-proc | |
108 | (lambda (value) | |
109 | (let* ((technologies (connman-technologies)) | |
110 | (type (technology-type technology)) | |
111 | (updated-technology | |
112 | (find-technology-by-type technologies type)) | |
113 | (technology-powered? updated-technology)) | |
114 | (sleep 1) | |
115 | (if technology-powered? | |
116 | full-value | |
117 | (+ value 1))))))) | |
118 | ||
119 | (define (wait-service-online) | |
120 | "Display a newt scale until connman detects an Internet access. Do | |
121 | FULL-VALUE tentatives, spaced by 1 second." | |
f901f5d2 LC |
122 | (define (online?) |
123 | (or (connman-online?) | |
124 | (file-exists? "/tmp/installer-assume-online"))) | |
125 | ||
d0f3a672 MO |
126 | (let* ((full-value 5)) |
127 | (run-scale-page | |
128 | #:title (G_ "Checking connectivity") | |
82f29e5b | 129 | #:info-text (G_ "Waiting for Internet access establishment...") |
d0f3a672 MO |
130 | #:scale-full-value full-value |
131 | #:scale-update-proc | |
132 | (lambda (value) | |
133 | (sleep 1) | |
f901f5d2 | 134 | (if (online?) |
d0f3a672 MO |
135 | full-value |
136 | (+ value 1)))) | |
f901f5d2 | 137 | (unless (online?) |
d0f3a672 | 138 | (run-error-page |
82f29e5b LC |
139 | (G_ "The selected network does not provide access to the \ |
140 | Internet, please try again.") | |
d0f3a672 MO |
141 | (G_ "Connection error")) |
142 | (raise | |
143 | (condition | |
144 | (&installer-step-abort)))))) | |
145 | ||
146 | (define (run-network-page) | |
147 | "Run a page to allow the user to configure connman so that it can access the | |
148 | Internet." | |
149 | (define network-steps | |
150 | (list | |
151 | ;; Ask the user to choose between ethernet and wifi technologies. | |
152 | (installer-step | |
153 | (id 'select-technology) | |
154 | (compute | |
155 | (lambda _ | |
156 | (run-technology-page)))) | |
157 | ;; Enable the previously selected technology. | |
158 | (installer-step | |
159 | (id 'power-technology) | |
160 | (compute | |
54754efc | 161 | (lambda (result _) |
d0f3a672 MO |
162 | (let ((technology (result-step result 'select-technology))) |
163 | (connman-enable-technology technology) | |
164 | (wait-technology-powered technology))))) | |
165 | ;; Propose the user to connect to one of the service available for the | |
166 | ;; previously selected technology. | |
167 | (installer-step | |
168 | (id 'connect-service) | |
169 | (compute | |
54754efc | 170 | (lambda (result _) |
d0f3a672 MO |
171 | (let* ((technology (result-step result 'select-technology)) |
172 | (type (technology-type technology))) | |
173 | (cond | |
174 | ((string=? "wifi" type) | |
175 | (run-wifi-page)) | |
176 | ((string=? "ethernet" type) | |
177 | (run-ethernet-page))))))) | |
178 | ;; Wait for connman status to switch to 'online, which means it can | |
179 | ;; access Internet. | |
180 | (installer-step | |
181 | (id 'wait-online) | |
182 | (compute (lambda _ | |
183 | (wait-service-online)))))) | |
184 | (run-installer-steps | |
185 | #:steps network-steps | |
186 | #:rewind-strategy 'start)) |