HCoop / jackhill / guix / guix.git / blame
| 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 ethernet) | |
| 20 | #:use-module (gnu installer connman) | |
| 21 | #:use-module (gnu installer steps) | |
| 22 | #:use-module (gnu installer newt utils) | |
| 23 | #:use-module (gnu installer newt page) | |
| 24 | #:use-module (guix i18n) | |
| 25 | #:use-module (ice-9 format) | |
| 26 | #:use-module (srfi srfi-34) | |
| 27 | #:use-module (srfi srfi-35) | |
| 28 | #:use-module (newt) | |
| 29 | #:export (run-ethernet-page)) | |
| 30 | ||
| 31 | (define (ethernet-services) | |
| 32 | "Return all the connman services of ethernet type." | |
| 33 | (let ((services (connman-services))) | |
| 34 | (filter (lambda (service) | |
| 35 | (and (string=? (service-type service) "ethernet") | |
| 36 | (not (string-null? (service-name service))))) | |
| 37 | services))) | |
| 38 | ||
| 39 | (define (ethernet-service->text service) | |
| 40 | "Return a string describing the given ethernet SERVICE." | |
| 41 | (let* ((name (service-name service)) | |
| 42 | (path (service-path service)) | |
| 43 | (full-name (string-append name "-" path)) | |
| 44 | (state (service-state service)) | |
| 45 | (connected? (or (string=? state "online") | |
| 46 | (string=? state "ready")))) | |
| 47 | (format #f "~c ~a~%" | |
| 48 | (if connected? #\* #\ ) | |
| 49 | full-name))) | |
| 50 | ||
| 51 | (define (connect-ethernet-service service) | |
| 52 | "Connect to the given ethernet SERVICE. Display a connecting page while the | |
| 53 | connection is pending." | |
| 54 | (let* ((service-name (service-name service)) | |
| 55 | (form (draw-connecting-page service-name))) | |
| 56 | (connman-connect service) | |
| fb1675cb MO |
57 | (destroy-form-and-pop form) |
| 58 | service)) | |
| d0f3a672 MO |
59 | |
| 60 | (define (run-ethernet-page) | |
| 61 | (let ((services (ethernet-services))) | |
| 62 | (if (null? services) | |
| 63 | (begin | |
| 64 | (run-error-page | |
| 65 | (G_ "No ethernet service available, please try again.") | |
| 66 | (G_ "No service")) | |
| 67 | (raise | |
| 68 | (condition | |
| 69 | (&installer-step-abort)))) | |
| 70 | (run-listbox-selection-page | |
| 71 | #:info-text (G_ "Please select an ethernet network.") | |
| 72 | #:title (G_ "Ethernet connection") | |
| 73 | #:listbox-items services | |
| 74 | #:listbox-item->text ethernet-service->text | |
| 7d812901 | 75 | #:button-text (G_ "Exit") |
| d0f3a672 MO |
76 | #:button-callback-procedure |
| 77 | (lambda _ | |
| 78 | (raise | |
| 79 | (condition | |
| 80 | (&installer-step-abort)))) | |
| 81 | #:listbox-callback-procedure connect-ethernet-service)))) |