;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer newt ethernet)
  #:use-module (gnu installer connman)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer newt utils)
  #:use-module (gnu installer newt page)
  #:use-module (guix i18n)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:use-module (newt)
  #:export (run-ethernet-page))

(define (ethernet-services)
  "Return all the connman services of ethernet type."
  (let ((services (connman-services)))
    (filter (lambda (service)
              (and (string=? (service-type service) "ethernet")
                   (not (string-null? (service-name service)))))
            services)))

(define (ethernet-service->text service)
  "Return a string describing the given ethernet SERVICE."
  (let* ((name (service-name service))
         (path (service-path service))
         (full-name (string-append name "-" path))
         (state (service-state service))
         (connected? (or (string=? state "online")
                         (string=? state "ready"))))
    (format #f "~c ~a~%"
            (if connected? #\* #\ )
            full-name)))

(define (connect-ethernet-service service)
  "Connect to the given ethernet SERVICE. Display a connecting page while the
connection is pending."
  (let* ((service-name (service-name service))
         (form (draw-connecting-page service-name)))
    (connman-connect service)
    (destroy-form-and-pop form)
    service))

(define (run-ethernet-page)
  (match (ethernet-services)
    (()
     (run-error-page
      (G_ "No ethernet service available, please try again.")
      (G_ "No service"))
     (raise
      (condition
       (&installer-step-abort))))
    ((service)
     ;; Only one service is available so return it directly.
     service)
    ((services ...)
     (run-listbox-selection-page
      #:info-text (G_ "Please select an ethernet network.")
      #:title (G_ "Ethernet connection")
      #:listbox-items services
      #:listbox-item->text ethernet-service->text
      #:listbox-height (min (+ (length services) 2) 5)
      #:button-text (G_ "Exit")
      #:button-callback-procedure
      (lambda _
        (raise
         (condition
          (&installer-step-abort))))
      #:listbox-callback-procedure connect-ethernet-service))))
<span title='2021-10-16 01:44:30 -0400'>2021-10-16</span></td><td><a href='/guix/commit/.gitignore?id=a599fcd4b09f3df3d6be66b4e64512e482697a96'>.gitignore: Ignore more temporary test directories.</a><span class='msg-avail'>...</span></td><td>Sarah Morgensen</td></tr>
<tr><td><span title='2021-09-20 14:18:21 +0000'>2021-09-20</span></td><td><a href='/guix/commit/.gitignore?id=5c4fd77097e2cecfd4780e099af7954f86779fe1'>etc: Add systemd files for running ‘guix gc’ periodically</a><span class='msg-avail'>...</span></td><td>Thiago Jung Bauermann</td></tr>
<tr><td><span title='2021-05-10 22:33:08 -0400'>2021-05-10</span></td><td><a href='/guix/commit/.gitignore?id=abff6f0fac2104c3ba2129166a4409568e9c7b16'>.gitignore: Ignore .mo files.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2021-05-05 16:31:05 -0400'>2021-05-05</span></td><td><a href='/guix/commit/.gitignore?id=214b77b5e749e2ca5891bfc87f946031cf8934e6'>.gitignore: Ignore .tarball-ignore.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2021-04-23 23:39:33 -0400'>2021-04-23</span></td><td><a href='/guix/commit/.gitignore?id=8b5339acfe381dca887b38634dcfdecae738ce7b'>.gitignore: Ignore release artifacts.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2021-04-23 21:32:46 -0400'>2021-04-23</span></td><td><a href='/guix/commit/.gitignore?id=129823c4997c65ad0ee711ab2fcfc91d00e6278c'>.gitignore: Ignore generated .pot files.</a><span class='msg-avail'>...</span></td><td>Maxim Cournoyer</td></tr>
<tr><td><span title='2020-10-20 19:16:21 +0200'>2020-10-20</span></td><td><a href='/guix/commit/.gitignore?id=e6994bff2ef461a2860e4207095746a5565cbf0e'>gitignore: Ignore generated guile binary and intermediate products.</a><span class='msg-avail'>...</span></td><td>Julien Lepiller</td></tr>
<tr><td><span title='2020-09-17 14:10:42 +0200'>2020-09-17</span></td><td><a href='/guix/commit/.gitignore?id=cabac732deffafc796537658a6c33c6c4aec821e'>guix-install.sh: Support OpenRC.</a><span class='msg-avail'>...</span></td><td>Morgan Smith</td></tr>
<tr><td><span title='2020-07-17 15:23:53 +0200'>2020-07-17</span></td><td><a href='/guix/commit/.gitignore?id=d6b05ba3534b030f8de976e340c19ac8a4118ff4'>gitignore: Don't ignore daemon source code.</a><span class='msg-avail'>...</span></td><td>Jakub Kądziołka</td></tr>
<tr><td><span title='2020-06-28 13:28:25 +0200'>2020-06-28</span></td><td><a href='/guix/commit/.gitignore?id=b9edefbc46da76fea6d56e08462618a398192189'>.gitignore: Ignore 'etc/committer.scm'.</a><span class='msg-avail'>...</span></td><td>Brice Waegeneire</td></tr>