gnu/installer/newt/ethernet.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
   3 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
   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 ethernet)
  21   #:use-module (gnu installer connman)
  22   #:use-module (gnu installer steps)
  23   #:use-module (gnu installer newt utils)
  24   #:use-module (gnu installer newt page)
  25   #:use-module (guix i18n)
  26   #:use-module (ice-9 format)
  27   #:use-module (ice-9 match)
  28   #:use-module (srfi srfi-34)
  29   #:use-module (srfi srfi-35)
  30   #:use-module (newt)
  31   #:export (run-ethernet-page))
  32
  33 (define (ethernet-services)
  34   "Return all the connman services of ethernet type."
  35   (let ((services (connman-services)))
  36     (filter (lambda (service)
  37               (and (string=? (service-type service) "ethernet")
  38                    (not (string-null? (service-name service)))))
  39             services)))
  40
  41 (define (ethernet-service->text service)
  42   "Return a string describing the given ethernet SERVICE."
  43   (let* ((name (service-name service))
  44          (path (service-path service))
  45          (full-name (string-append name "-" path))
  46          (state (service-state service))
  47          (connected? (or (string=? state "online")
  48                          (string=? state "ready"))))
  49     (format #f "~c ~a~%"
  50             (if connected? #\* #\ )
  51             full-name)))
  52
  53 (define (connect-ethernet-service service)
  54   "Connect to the given ethernet SERVICE. Display a connecting page while the
  55 connection is pending."
  56   (let* ((service-name (service-name service))
  57          (form (draw-connecting-page service-name)))
  58     (connman-connect service)
  59     (destroy-form-and-pop form)
  60     service))
  61
  62 (define (run-ethernet-page)
  63   (match (ethernet-services)
  64     (()
  65      (run-error-page
  66       (G_ "No ethernet service available, please try again.")
  67       (G_ "No service"))
  68      (raise
  69       (condition
  70        (&installer-step-abort))))
  71     ((service)
  72      ;; Only one service is available so return it directly.
  73      service)
  74     ((services ...)
  75      (run-listbox-selection-page
  76       #:info-text (G_ "Please select an ethernet network.")
  77       #:title (G_ "Ethernet connection")
  78       #:listbox-items services
  79       #:listbox-item->text ethernet-service->text
  80       #:listbox-height (min (+ (length services) 2) 10)
  81       #:button-text (G_ "Exit")
  82       #:button-callback-procedure
  83       (lambda _
  84         (raise
  85          (condition
  86           (&installer-step-abort))))
  87       #:listbox-callback-procedure connect-ethernet-service))))