gnu: linux-libre@4.19: Update to 4.19.27.
[guix.git] / gnu / installer / connman.scm
blobef8cca3952ae1cb6e67e55c588d5b548ef40b04c
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/>.
19 (define-module (gnu installer connman)
20   #:use-module (gnu installer utils)
21   #:use-module (guix records)
22   #:use-module (ice-9 match)
23   #:use-module (ice-9 popen)
24   #:use-module (ice-9 regex)
25   #:use-module (srfi srfi-11)
26   #:use-module (srfi srfi-34)
27   #:use-module (srfi srfi-35)
28   #:export (<technology>
29             technology
30             technology?
31             technology-name
32             technology-type
33             technology-powered?
34             technology-connected?
36             <service>
37             service
38             service?
39             service-name
40             service-type
41             service-path
42             service-strength
43             service-state
45             &connman-error
46             connman-error?
47             connman-error-command
48             connman-error-output
49             connman-error-status
51             &connman-connection-error
52             connman-connection-error?
53             connman-connection-error-service
54             connman-connection-error-output
56             &connman-password-error
57             connman-password-error?
59             &connman-already-connected-error
60             connman-already-connected-error?
62             connman-state
63             connman-technologies
64             connman-enable-technology
65             connman-disable-technology
66             connman-scan-technology
67             connman-services
68             connman-connect
69             connman-disconnect
70             connman-online?
71             connman-connect-with-auth))
73 ;;; Commentary:
74 ;;;
75 ;;; This module provides procedures for talking with the connman daemon.
76 ;;; The best approach would have been using connman dbus interface.
77 ;;; However, as Guile dbus bindings are not available yet, the console client
78 ;;; "connmanctl" is used to talk with the daemon.
79 ;;;
82 ;;;
83 ;;; Technology record.
84 ;;;
86 ;; The <technology> record encapsulates the "Technology" object of connman.
87 ;; Technology type will be typically "ethernet", "wifi" or "bluetooth".
89 (define-record-type* <technology>
90   technology make-technology
91   technology?
92   (name            technology-name) ; string
93   (type            technology-type) ; string
94   (powered?        technology-powered?) ; boolean
95   (connected?      technology-connected?)) ; boolean
98 ;;;
99 ;;; Service record.
102 ;; The <service> record encapsulates the "Service" object of connman.
103 ;; Service type is the same as the technology it is associated to, path is a
104 ;; unique identifier given by connman, strength describes the signal quality
105 ;; if applicable. Finally, state is "idle", "failure", "association",
106 ;; "configuration", "ready", "disconnect" or "online".
108 (define-record-type* <service>
109   service make-service
110   service?
111   (name            service-name) ; string
112   (type            service-type) ; string
113   (path            service-path) ; string
114   (strength        service-strength) ; integer
115   (state           service-state)) ; string
119 ;;; Condition types.
122 (define-condition-type &connman-error &error
123   connman-error?
124   (command connman-error-command)
125   (output connman-error-output)
126   (status connman-error-status))
128 (define-condition-type &connman-connection-error &error
129   connman-connection-error?
130   (service connman-connection-error-service)
131   (output  connman-connection-error-output))
133 (define-condition-type &connman-password-error &connman-connection-error
134   connman-password-error?)
136 (define-condition-type &connman-already-connected-error
137   &connman-connection-error connman-already-connected-error?)
141 ;;; Procedures.
144 (define (connman-run command env arguments)
145   "Run the given COMMAND, with the specified ENV and ARGUMENTS.  The error
146 output is discarded and &connman-error condition is raised if the command
147 returns a non zero exit code."
148   (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null"))
149          (command-string (string-join command " "))
150          (pipe (open-input-pipe command-string))
151          (output (read-lines pipe))
152          (ret (close-pipe pipe)))
153     (case (status:exit-val ret)
154       ((0) output)
155       (else (raise (condition (&connman-error
156                                (command command)
157                                (output output)
158                                (status ret))))))))
160 (define (connman . arguments)
161   "Run connmanctl with the specified ARGUMENTS. Set the LANG environment
162 variable to C because the command output will be parsed and we don't want it
163 to be translated."
164   (connman-run "connmanctl" "LANG=C" arguments))
166 (define (parse-keys keys)
167   "Parse the given list of strings KEYS, under the following format:
169      '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...)
171 Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
172 ...)  elements."
173   (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)")))
174     (map (lambda (key)
175            (let ((match-key (regexp-exec key-regex key)))
176              (cons (match:substring match-key 1)
177                    (match:substring match-key 2))))
178          keys)))
180 (define (connman-state)
181   "Return the state of connman. The nominal states are 'offline, 'idle,
182 'ready, 'oneline.  If an unexpected state is read, 'unknown is
183 returned. Finally, an error is raised if the comman output could not be
184 parsed, usually because the connman daemon is not responding."
185   (let* ((output (connman "state"))
186          (state-keys (parse-keys output)))
187     (let ((state (assoc-ref state-keys "State")))
188       (if state
189           (cond ((string=? state "offline") 'offline)
190                 ((string=? state "idle") 'idle)
191                 ((string=? state "ready") 'ready)
192                 ((string=? state "online") 'online)
193                 (else 'unknown))
194           (raise (condition
195                   (&message
196                    (message "Could not determine the state of connman."))))))))
198 (define (split-technology-list technologies)
199   "Parse the given strings list TECHNOLOGIES, under the following format:
201         '((\"/net/connman/technology/xxx\")
202           (\"KEY = VALUE\")
203           ...
204           (\"/net/connman/technology/yyy\")
205           (\"KEY2 = VALUE2\")
206           ...)
207  Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...))
208 list so that each keys of a given technology are gathered in a separate list."
209   (let loop ((result '())
210              (cur-list '())
211              (input (reverse technologies)))
212     (if (null? input)
213         result
214         (let ((item (car input)))
215           (if (string-match "/net/connman/technology" item)
216               (loop (cons cur-list result) '() (cdr input))
217               (loop result (cons item cur-list) (cdr input)))))))
219 (define (string->boolean string)
220   (equal? string "True"))
222 (define (connman-technologies)
223   "Return a list of available <technology> records."
225   (define (technology-output->technology output)
226     (let ((keys (parse-keys output)))
227       (technology
228        (name (assoc-ref keys "Name"))
229        (type (assoc-ref keys "Type"))
230        (powered? (string->boolean (assoc-ref keys "Powered")))
231        (connected? (string->boolean (assoc-ref keys "Connected"))))))
233   (let* ((output (connman "technologies"))
234          (technologies (split-technology-list output)))
235     (map technology-output->technology technologies)))
237 (define (connman-enable-technology technology)
238   "Enable the given TECHNOLOGY."
239   (let ((type (technology-type technology)))
240     (connman "enable" type)))
242 (define (connman-disable-technology technology)
243   "Disable the given TECHNOLOGY."
244   (let ((type (technology-type technology)))
245     (connman "disable" type)))
247 (define (connman-scan-technology technology)
248   "Run a scan for the given TECHNOLOGY."
249   (let ((type (technology-type technology)))
250     (connman "scan" type)))
252 (define (connman-services)
253   "Return a list of available <services> records."
255   (define (service-output->service path output)
256     (let* ((service-keys
257             (match output
258               ((_ . rest) rest)))
259            (keys (parse-keys service-keys)))
260       (service
261        (name (assoc-ref keys "Name"))
262        (type (assoc-ref keys "Type"))
263        (path path)
264        (strength (and=> (assoc-ref keys "Strength") string->number))
265        (state (assoc-ref keys "State")))))
267   (let* ((out (connman "services"))
268          (out-filtered (delete "" out))
269          (services-path (map (lambda (service)
270                                (match (string-split service #\ )
271                                  ((_ ... path) path)))
272                              out-filtered))
273          (services-output (map (lambda (service)
274                                  (connman "services" service))
275                                services-path)))
276     (map service-output->service services-path services-output)))
278 (define (connman-connect service)
279   "Connect to the given SERVICE."
280   (let ((path (service-path service)))
281     (connman "connect" path)))
283 (define (connman-disconnect service)
284   "Disconnect from the given SERVICE."
285   (let ((path (service-path service)))
286     (connman "disconnect" path)))
288 (define (connman-online?)
289   (let ((state (connman-state)))
290     (eq? state 'online)))
292 (define (connman-connect-with-auth service password-proc)
293   "Connect to the given SERVICE with the password returned by calling
294 PASSWORD-PROC. This is only possible in the interactive mode of connmanctl
295 because authentication is done by communicating with an agent.
297 As the open-pipe procedure of Guile do not allow to read from stderr, we have
298 to merge stdout and stderr using bash redirection. Then error messages are
299 extracted from connmanctl output using a regexp. This makes the whole
300 procedure even more unreliable.
302 Raise &connman-connection-error if an error occurred during connection. Raise
303 &connman-password-error if the given password is incorrect."
305   (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n"))
307   (define (match-connman-error str)
308     (let ((match-error (regexp-exec connman-error-regexp str)))
309       (and match-error (match:substring match-error 1))))
311   (define* (read-regexps-or-error port regexps error-handler)
312     "Read characters from port until an error is detected, or one of the given
313 REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error
314 string as argument. Raise an error if the eof is reached before one of the
315 regexps is matched."
316     (let loop ((res ""))
317       (let ((char (read-char port)))
318         (cond
319          ((eof-object? char)
320           (raise (condition
321                   (&message
322                    (message "Unable to find expected regexp.")))))
323          ((match-connman-error res)
324           =>
325           (lambda (match)
326             (error-handler match)))
327          ((or-map (lambda (regexp)
328                     (and (regexp-exec regexp res) regexp))
329                   regexps)
330           =>
331           (lambda (match)
332             match))
333          (else
334           (loop (string-append res (string char))))))))
336   (define* (read-regexp-or-error port regexp error-handler)
337     "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP."
338     (read-regexps-or-error port (list regexp) error-handler))
340   (define (connman-error->condition path error)
341     (cond
342      ((string-match "Already connected" error)
343       (condition (&connman-already-connected-error
344                   (service path)
345                   (output error))))
346      (else
347       (condition (&connman-connection-error
348                   (service path)
349                   (output error))))))
351   (define (run-connection-sequence pipe)
352     "Run the connection sequence using PIPE as an opened port to an
353 interactive connmanctl process."
354     (let* ((path (service-path service))
355            (error-handler (lambda (error)
356                             (raise
357                              (connman-error->condition path error)))))
358       ;; Start the agent.
359       (format pipe "agent on\n")
360       (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler)
362       ;; Let's try to connect to the service. If the service does not require
363       ;; a password, the connection might succeed right after this call.
364       ;; Otherwise, connmanctl will prompt us for a password.
365       (format pipe "connect ~a\n" path)
366       (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path)))
367              (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*"))
368              (regexps (list connected-regexp passphrase-regexp))
369              (result (read-regexps-or-error pipe regexps error-handler)))
371         ;; A password is required.
372         (when (eq? result passphrase-regexp)
373           (format pipe "~a~%" (password-proc))
375           ;; Now, we have to wait for the connection to succeed. If an error
376           ;; occurs, it is most likely because the password is incorrect.
377           ;; In that case, we escape from an eventual retry loop that would
378           ;; add complexity to this procedure, and raise a
379           ;; &connman-password-error condition.
380           (read-regexp-or-error pipe connected-regexp
381                                 (lambda (error)
382                                   ;; Escape from retry loop.
383                                   (format pipe "no\n")
384                                   (raise
385                                    (condition (&connman-password-error
386                                                (service path)
387                                                (output error))))))))))
389   ;; XXX: Find a better way to read stderr, like with the "subprocess"
390   ;; procedure of racket that return input ports piped on the process stdin and
391   ;; stderr.
392   (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH)))
393     (dynamic-wind
394       (const #t)
395       (lambda ()
396         (run-connection-sequence pipe)
397         #t)
398       (lambda ()
399         (format pipe "quit\n")
400         (close-pipe pipe)))))