gnu/installer/newt/network.scm

   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
  56   (let ((items (technology-items)))
  57     (if (null? items)
  58         (case (choice-window
  59                (G_ "Internet access")
  60                (G_ "Continue")
  61                (G_ "Exit")
  62                (G_ "The install process requires Internet access but no \
  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
  71          #:info-text (G_ "The install process requires Internet access.\
  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))))))))
  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")
  96      #:info-text (format #f (G_ "Waiting for technology ~a to be powered.")
  97                          name)
  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")
 117      #:info-text (G_ "Waiting for Internet access establishment...")
 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
 127        (G_ "The selected network does not provide access to the \
 128 Internet, please try again.")
 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
 149        (lambda (result _)
 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
 158        (lambda (result _)
 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))