Commit | Line | Data |
---|---|---|
d0f3a672 MO |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu installer newt network) | |
20 | #:use-module (gnu installer connman) | |
21 | #:use-module (gnu installer steps) | |
22 | #:use-module (gnu installer utils) | |
23 | #:use-module (gnu installer newt ethernet) | |
24 | #:use-module (gnu installer newt page) | |
25 | #:use-module (gnu installer newt wifi) | |
26 | #:use-module (guix i18n) | |
27 | #:use-module (srfi srfi-1) | |
28 | #:use-module (srfi srfi-11) | |
29 | #:use-module (srfi srfi-34) | |
30 | #:use-module (srfi srfi-35) | |
31 | #:use-module (newt) | |
32 | #:export (run-network-page)) | |
33 | ||
34 | ;; Maximum length of a technology name. | |
35 | (define technology-name-max-length (make-parameter 20)) | |
36 | ||
37 | (define (technology->text technology) | |
38 | "Return a string describing the given TECHNOLOGY." | |
39 | (let* ((name (technology-name technology)) | |
40 | (padded-name (string-pad-right name | |
41 | (technology-name-max-length)))) | |
42 | (format #f "~a~%" padded-name))) | |
43 | ||
44 | (define (run-technology-page) | |
45 | "Run a page to ask the user which technology shall be used to access | |
46 | Internet and return the selected technology. For now, only technologies with | |
47 | \"ethernet\" or \"wifi\" types are supported." | |
48 | (define (technology-items) | |
49 | (filter (lambda (technology) | |
50 | (let ((type (technology-type technology))) | |
51 | (or | |
52 | (string=? type "ethernet") | |
53 | (string=? type "wifi")))) | |
54 | (connman-technologies))) | |
55 | ||
77c00b1e MO |
56 | (let ((items (technology-items))) |
57 | (if (null? items) | |
58 | (case (choice-window | |
59 | (G_ "Internet access") | |
60 | (G_ "Continue") | |
61 | (G_ "Exit") | |
d1557774 | 62 | (G_ "The install process requires Internet access but no \ |
77c00b1e MO |
63 | network device were found. Do you want to continue anyway?")) |
64 | ((1) (raise | |
65 | (condition | |
66 | (&installer-step-break)))) | |
67 | ((2) (raise | |
68 | (condition | |
69 | (&installer-step-abort))))) | |
70 | (run-listbox-selection-page | |
d1557774 | 71 | #:info-text (G_ "The install process requires Internet access.\ |
77c00b1e MO |
72 | Please select a network device.") |
73 | #:title (G_ "Internet access") | |
74 | #:listbox-items items | |
75 | #:listbox-item->text technology->text | |
76 | #:button-text (G_ "Exit") | |
77 | #:button-callback-procedure | |
78 | (lambda _ | |
79 | (raise | |
80 | (condition | |
81 | (&installer-step-abort)))))))) | |
d0f3a672 MO |
82 | |
83 | (define (find-technology-by-type technologies type) | |
84 | "Find and return a technology with the given TYPE in TECHNOLOGIES list." | |
85 | (find (lambda (technology) | |
86 | (string=? (technology-type technology) | |
87 | type)) | |
88 | technologies)) | |
89 | ||
90 | (define (wait-technology-powered technology) | |
91 | "Wait and display a progress bar until the given TECHNOLOGY is powered." | |
92 | (let ((name (technology-name technology)) | |
93 | (full-value 5)) | |
94 | (run-scale-page | |
95 | #:title (G_ "Powering technology") | |
3cc033f2 LC |
96 | #:info-text (format #f (G_ "Waiting for technology ~a to be powered.") |
97 | name) | |
d0f3a672 MO |
98 | #:scale-full-value full-value |
99 | #:scale-update-proc | |
100 | (lambda (value) | |
101 | (let* ((technologies (connman-technologies)) | |
102 | (type (technology-type technology)) | |
103 | (updated-technology | |
104 | (find-technology-by-type technologies type)) | |
105 | (technology-powered? updated-technology)) | |
106 | (sleep 1) | |
107 | (if technology-powered? | |
108 | full-value | |
109 | (+ value 1))))))) | |
110 | ||
111 | (define (wait-service-online) | |
112 | "Display a newt scale until connman detects an Internet access. Do | |
113 | FULL-VALUE tentatives, spaced by 1 second." | |
114 | (let* ((full-value 5)) | |
115 | (run-scale-page | |
116 | #:title (G_ "Checking connectivity") | |
82f29e5b | 117 | #:info-text (G_ "Waiting for Internet access establishment...") |
d0f3a672 MO |
118 | #:scale-full-value full-value |
119 | #:scale-update-proc | |
120 | (lambda (value) | |
121 | (sleep 1) | |
122 | (if (connman-online?) | |
123 | full-value | |
124 | (+ value 1)))) | |
125 | (unless (connman-online?) | |
126 | (run-error-page | |
82f29e5b LC |
127 | (G_ "The selected network does not provide access to the \ |
128 | Internet, please try again.") | |
d0f3a672 MO |
129 | (G_ "Connection error")) |
130 | (raise | |
131 | (condition | |
132 | (&installer-step-abort)))))) | |
133 | ||
134 | (define (run-network-page) | |
135 | "Run a page to allow the user to configure connman so that it can access the | |
136 | Internet." | |
137 | (define network-steps | |
138 | (list | |
139 | ;; Ask the user to choose between ethernet and wifi technologies. | |
140 | (installer-step | |
141 | (id 'select-technology) | |
142 | (compute | |
143 | (lambda _ | |
144 | (run-technology-page)))) | |
145 | ;; Enable the previously selected technology. | |
146 | (installer-step | |
147 | (id 'power-technology) | |
148 | (compute | |
54754efc | 149 | (lambda (result _) |
d0f3a672 MO |
150 | (let ((technology (result-step result 'select-technology))) |
151 | (connman-enable-technology technology) | |
152 | (wait-technology-powered technology))))) | |
153 | ;; Propose the user to connect to one of the service available for the | |
154 | ;; previously selected technology. | |
155 | (installer-step | |
156 | (id 'connect-service) | |
157 | (compute | |
54754efc | 158 | (lambda (result _) |
d0f3a672 MO |
159 | (let* ((technology (result-step result 'select-technology)) |
160 | (type (technology-type technology))) | |
161 | (cond | |
162 | ((string=? "wifi" type) | |
163 | (run-wifi-page)) | |
164 | ((string=? "ethernet" type) | |
165 | (run-ethernet-page))))))) | |
166 | ;; Wait for connman status to switch to 'online, which means it can | |
167 | ;; access Internet. | |
168 | (installer-step | |
169 | (id 'wait-online) | |
170 | (compute (lambda _ | |
171 | (wait-service-online)))))) | |
172 | (run-installer-steps | |
173 | #:steps network-steps | |
174 | #:rewind-strategy 'start)) |