aboutsummaryrefslogtreecommitdiff
path: root/gnu/system/examples/vm-image.tmpl
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/system/examples/vm-image.tmpl')
0 files changed, 0 insertions, 0 deletions
generated by cgit
Do you want to continue anyway?")) ((1) (abort-to-prompt 'installer-step 'break)) ((2) (abort-to-prompt 'installer-step 'abort)))) ((technology) ;; Since there's only one technology available, skip the selection ;; screen. technology) ((items ...) (run-listbox-selection-page #:info-text (G_ "The install process requires Internet access.\ Please select a network device.") #:title (G_ "Internet access") #:listbox-items items #:listbox-item->text technology->text #:listbox-height (min (+ (length items) 2) 5) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ (abort-to-prompt 'installer-step 'abort)))))) (define (find-technology-by-type technologies type) "Find and return a technology with the given TYPE in TECHNOLOGIES list." (find (lambda (technology) (string=? (technology-type technology) type)) technologies)) (define (wait-technology-powered technology) "Wait and display a progress bar until the given TECHNOLOGY is powered." (let ((name (technology-name technology)) (full-value 5)) (run-scale-page #:title (G_ "Powering technology") #:info-text (format #f (G_ "Waiting for technology ~a to be powered.") name) #:scale-full-value full-value #:scale-update-proc (lambda (value) (let* ((technologies (connman-technologies)) (type (technology-type technology)) (updated-technology (find-technology-by-type technologies type)) (technology-powered? updated-technology)) (sleep 1) (if technology-powered? full-value (+ value 1))))))) (define (wait-service-online) "Display a newt scale until connman detects an Internet access. Do FULL-VALUE tentatives, spaced by 1 second." (define (url-alive? url) (false-if-exception (= (response-code (http-request url)) 200))) (define (ci-available?) (dynamic-wind (lambda () (sigaction SIGALRM (lambda _ #f)) (alarm 3)) (lambda () (or (url-alive? "https://bordeaux.guix.gnu.org") (url-alive? "https://ci.guix.gnu.org"))) (lambda () (alarm 0)))) (define (online?) (or (and (connman-online?) (ci-available?)) (file-exists? "/tmp/installer-assume-online"))) (let* ((full-value 5)) (run-scale-page #:title (G_ "Checking connectivity") #:info-text (G_ "Waiting for Internet access establishment...") #:scale-full-value full-value #:scale-update-proc (lambda (value) (sleep 1) (if (online?) full-value (+ value 1)))) (unless (online?) (run-error-page (G_ "The selected network does not provide access to the \ Internet and the Guix substitute server, please try again.") (G_ "Connection error")) (abort-to-prompt 'installer-step 'abort)))) (define (run-network-page) "Run a page to allow the user to configure connman so that it can access the Internet." (define network-steps (list ;; Ask the user to choose between ethernet and wifi technologies. (installer-step (id 'select-technology) (compute (lambda _ (run-technology-page)))) ;; Enable the previously selected technology. (installer-step (id 'power-technology) (compute (lambda (result _) (let ((technology (result-step result 'select-technology))) (connman-enable-technology technology) (wait-technology-powered technology))))) ;; Propose the user to connect to one of the service available for the ;; previously selected technology. (installer-step (id 'connect-service) (compute (lambda (result _) (let* ((technology (result-step result 'select-technology)) (type (technology-type technology))) (cond ((string=? "wifi" type) (run-wifi-page)) ((string=? "ethernet" type) (run-ethernet-page))))))) ;; Wait for connman status to switch to 'online, which means it can ;; access Internet. (installer-step (id 'wait-online) (compute (lambda _ (wait-service-online)))))) (run-installer-steps #:steps network-steps #:rewind-strategy 'start))
generated by cgit