summaryrefslogtreecommitdiff
path: root/gnu/installer/connman.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/installer/connman.scm')
-rw-r--r--gnu/installer/connman.scm400
1 files changed, 400 insertions, 0 deletions
diff --git a/gnu/installer/connman.scm b/gnu/installer/connman.scm
new file mode 100644
index 0000000000..740df7424a
--- /dev/null
+++ b/gnu/installer/connman.scm
@@ -0,0 +1,400 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
+;;;
+;;; 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 connman)
+ #:use-module (gnu installer utils)
+ #:use-module (guix records)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 popen)
+ #:use-module (ice-9 regex)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:export (<technology>
+ technology
+ technology?
+ technology-name
+ technology-type
+ technology-powered?
+ technology-connected?
+
+ <service>
+ service
+ service?
+ service-name
+ service-type
+ service-path
+ service-strength
+ service-state
+
+ &connman-error
+ connman-error?
+ connman-error-command
+ connman-error-output
+ connman-error-status
+
+ &connman-connection-error
+ connman-connection-error?
+ connman-connection-error-service
+ connman-connection-error-output
+
+ &connman-password-error
+ connman-password-error?
+
+ &connman-already-connected-error
+ connman-already-connected-error?
+
+ connman-state
+ connman-technologies
+ connman-enable-technology
+ connman-disable-technology
+ connman-scan-technology
+ connman-services
+ connman-connect
+ connman-disconnect
+ connman-online?
+ connman-connect-with-auth))
+
+;;; Commentary:
+;;;
+;;; This module provides procedures for talking with the connman daemon.
+;;; The best approach would have been using connman dbus interface.
+;;; However, as Guile dbus bindings are not available yet, the console client
+;;; "connmanctl" is used to talk with the daemon.
+;;;
+
+
+;;;
+;;; Technology record.
+;;;
+
+;; The <technology> record encapsulates the "Technology" object of connman.
+;; Technology type will be typically "ethernet", "wifi" or "bluetooth".
+
+(define-record-type* <technology>
+ technology make-technology
+ technology?
+ (name technology-name) ; string
+ (type technology-type) ; string
+ (powered? technology-powered?) ; boolean
+ (connected? technology-connected?)) ; boolean
+
+
+;;;
+;;; Service record.
+;;;
+
+;; The <service> record encapsulates the "Service" object of connman.
+;; Service type is the same as the technology it is associated to, path is a
+;; unique identifier given by connman, strength describes the signal quality
+;; if applicable. Finally, state is "idle", "failure", "association",
+;; "configuration", "ready", "disconnect" or "online".
+
+(define-record-type* <service>
+ service make-service
+ service?
+ (name service-name) ; string
+ (type service-type) ; string
+ (path service-path) ; string
+ (strength service-strength) ; integer
+ (state service-state)) ; string
+
+
+;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &connman-error &error
+ connman-error?
+ (command connman-error-command)
+ (output connman-error-output)
+ (status connman-error-status))
+
+(define-condition-type &connman-connection-error &error
+ connman-connection-error?
+ (service connman-connection-error-service)
+ (output connman-connection-error-output))
+
+(define-condition-type &connman-password-error &connman-connection-error
+ connman-password-error?)
+
+(define-condition-type &connman-already-connected-error
+ &connman-connection-error connman-already-connected-error?)
+
+
+;;;
+;;; Procedures.
+;;;
+
+(define (connman-run command env arguments)
+ "Run the given COMMAND, with the specified ENV and ARGUMENTS. The error
+output is discarded and &connman-error condition is raised if the command
+returns a non zero exit code."
+ (let* ((command `("env" ,env ,command ,@arguments "2>" "/dev/null"))
+ (command-string (string-join command " "))
+ (pipe (open-input-pipe command-string))
+ (output (read-lines pipe))
+ (ret (close-pipe pipe)))
+ (case (status:exit-val ret)
+ ((0) output)
+ (else (raise (condition (&connman-error
+ (command command)
+ (output output)
+ (status ret))))))))
+
+(define (connman . arguments)
+ "Run connmanctl with the specified ARGUMENTS. Set the LANG environment
+variable to C because the command output will be parsed and we don't want it
+to be translated."
+ (connman-run "connmanctl" "LANG=C" arguments))
+
+(define (parse-keys keys)
+ "Parse the given list of strings KEYS, under the following format:
+
+ '((\"KEY = VALUE\") (\"KEY2 = VALUE2\") ...)
+
+Return the corresponding association list of '((KEY . VALUE) (KEY2 . VALUE2)
+...) elements."
+ (let ((key-regex (make-regexp "([^ ]+) = ([^$]+)")))
+ (map (lambda (key)
+ (let ((match-key (regexp-exec key-regex key)))
+ (cons (match:substring match-key 1)
+ (match:substring match-key 2))))
+ keys)))
+
+(define (connman-state)
+ "Return the state of connman. The nominal states are 'offline, 'idle,
+'ready, 'oneline. If an unexpected state is read, 'unknown is
+returned. Finally, an error is raised if the comman output could not be
+parsed, usually because the connman daemon is not responding."
+ (let* ((output (connman "state"))
+ (state-keys (parse-keys output)))
+ (let ((state (assoc-ref state-keys "State")))
+ (if state
+ (cond ((string=? state "offline") 'offline)
+ ((string=? state "idle") 'idle)
+ ((string=? state "ready") 'ready)
+ ((string=? state "online") 'online)
+ (else 'unknown))
+ (raise (condition
+ (&message
+ (message "Could not determine the state of connman."))))))))
+
+(define (split-technology-list technologies)
+ "Parse the given strings list TECHNOLOGIES, under the following format:
+
+ '((\"/net/connman/technology/xxx\")
+ (\"KEY = VALUE\")
+ ...
+ (\"/net/connman/technology/yyy\")
+ (\"KEY2 = VALUE2\")
+ ...)
+ Return the corresponding '(((\"KEY = VALUE\") ...) ((\"KEY2 = VALUE2\") ...))
+list so that each keys of a given technology are gathered in a separate list."
+ (let loop ((result '())
+ (cur-list '())
+ (input (reverse technologies)))
+ (if (null? input)
+ result
+ (let ((item (car input)))
+ (if (string-match "/net/connman/technology" item)
+ (loop (cons cur-list result) '() (cdr input))
+ (loop result (cons item cur-list) (cdr input)))))))
+
+(define (string->boolean string)
+ (equal? string "True"))
+
+(define (connman-technologies)
+ "Return a list of available <technology> records."
+
+ (define (technology-output->technology output)
+ (let ((keys (parse-keys output)))
+ (technology
+ (name (assoc-ref keys "Name"))
+ (type (assoc-ref keys "Type"))
+ (powered? (string->boolean (assoc-ref keys "Powered")))
+ (connected? (string->boolean (assoc-ref keys "Connected"))))))
+
+ (let* ((output (connman "technologies"))
+ (technologies (split-technology-list output)))
+ (map technology-output->technology technologies)))
+
+(define (connman-enable-technology technology)
+ "Enable the given TECHNOLOGY."
+ (let ((type (technology-type technology)))
+ (connman "enable" type)))
+
+(define (connman-disable-technology technology)
+ "Disable the given TECHNOLOGY."
+ (let ((type (technology-type technology)))
+ (connman "disable" type)))
+
+(define (connman-scan-technology technology)
+ "Run a scan for the given TECHNOLOGY."
+ (let ((type (technology-type technology)))
+ (connman "scan" type)))
+
+(define (connman-services)
+ "Return a list of available <services> records."
+
+ (define (service-output->service path output)
+ (let* ((service-keys
+ (match output
+ ((_ . rest) rest)))
+ (keys (parse-keys service-keys)))
+ (service
+ (name (assoc-ref keys "Name"))
+ (type (assoc-ref keys "Type"))
+ (path path)
+ (strength (and=> (assoc-ref keys "Strength") string->number))
+ (state (assoc-ref keys "State")))))
+
+ (let* ((out (connman "services"))
+ (out-filtered (delete "" out))
+ (services-path (map (lambda (service)
+ (match (string-split service #\ )
+ ((_ ... path) path)))
+ out-filtered))
+ (services-output (map (lambda (service)
+ (connman "services" service))
+ services-path)))
+ (map service-output->service services-path services-output)))
+
+(define (connman-connect service)
+ "Connect to the given SERVICE."
+ (let ((path (service-path service)))
+ (connman "connect" path)))
+
+(define (connman-disconnect service)
+ "Disconnect from the given SERVICE."
+ (let ((path (service-path service)))
+ (connman "disconnect" path)))
+
+(define (connman-online?)
+ (let ((state (connman-state)))
+ (eq? state 'online)))
+
+(define (connman-connect-with-auth service password-proc)
+ "Connect to the given SERVICE with the password returned by calling
+PASSWORD-PROC. This is only possible in the interactive mode of connmanctl
+because authentication is done by communicating with an agent.
+
+As the open-pipe procedure of Guile do not allow to read from stderr, we have
+to merge stdout and stderr using bash redirection. Then error messages are
+extracted from connmanctl output using a regexp. This makes the whole
+procedure even more unreliable.
+
+Raise &connman-connection-error if an error occured during connection. Raise
+&connman-password-error if the given password is incorrect."
+
+ (define connman-error-regexp (make-regexp "Error[ ]*([^\n]+)\n"))
+
+ (define (match-connman-error str)
+ (let ((match-error (regexp-exec connman-error-regexp str)))
+ (and match-error (match:substring match-error 1))))
+
+ (define* (read-regexps-or-error port regexps error-handler)
+ "Read characters from port until an error is detected, or one of the given
+REGEXPS is matched. If an error is detected, call ERROR-HANDLER with the error
+string as argument. Raise an error if the eof is reached before one of the
+regexps is matched."
+ (let loop ((res ""))
+ (let ((char (read-char port)))
+ (cond
+ ((eof-object? char)
+ (raise (condition
+ (&message
+ (message "Unable to find expected regexp.")))))
+ ((match-connman-error res)
+ =>
+ (lambda (match)
+ (error-handler match)))
+ ((or-map (lambda (regexp)
+ (and (regexp-exec regexp res) regexp))
+ regexps)
+ =>
+ (lambda (match)
+ match))
+ (else
+ (loop (string-append res (string char))))))))
+
+ (define* (read-regexp-or-error port regexp error-handler)
+ "Same as READ-REGEXPS-OR-ERROR above, but with a single REGEXP."
+ (read-regexps-or-error port (list regexp) error-handler))
+
+ (define (connman-error->condition path error)
+ (cond
+ ((string-match "Already connected" error)
+ (condition (&connman-already-connected-error
+ (service path)
+ (output error))))
+ (else
+ (condition (&connman-connection-error
+ (service path)
+ (output error))))))
+
+ (define (run-connection-sequence pipe)
+ "Run the connection sequence using PIPE as an opened port to an
+interactive connmanctl process."
+ (let* ((path (service-path service))
+ (error-handler (lambda (error)
+ (raise
+ (connman-error->condition path error)))))
+ ;; Start the agent.
+ (format pipe "agent on\n")
+ (read-regexp-or-error pipe (make-regexp "Agent registered") error-handler)
+
+ ;; Let's try to connect to the service. If the service does not require
+ ;; a password, the connection might succeed right after this call.
+ ;; Otherwise, connmanctl will prompt us for a password.
+ (format pipe "connect ~a\n" path)
+ (let* ((connected-regexp (make-regexp (format #f "Connected ~a" path)))
+ (passphrase-regexp (make-regexp "\nPassphrase\\?[ ]*"))
+ (regexps (list connected-regexp passphrase-regexp))
+ (result (read-regexps-or-error pipe regexps error-handler)))
+
+ ;; A password is required.
+ (when (eq? result passphrase-regexp)
+ (format pipe "~a~%" (password-proc))
+
+ ;; Now, we have to wait for the connection to succeed. If an error
+ ;; occurs, it is most likely because the password is incorrect.
+ ;; In that case, we escape from an eventual retry loop that would
+ ;; add complexity to this procedure, and raise a
+ ;; &connman-password-error condition.
+ (read-regexp-or-error pipe connected-regexp
+ (lambda (error)
+ ;; Escape from retry loop.
+ (format pipe "no\n")
+ (raise
+ (condition (&connman-password-error
+ (service path)
+ (output error))))))))))
+
+ ;; XXX: Find a better way to read stderr, like with the "subprocess"
+ ;; procedure of racket that return input ports piped on the process stdin and
+ ;; stderr.
+ (let ((pipe (open-pipe "connmanctl 2>&1" OPEN_BOTH)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (run-connection-sequence pipe)
+ #t)
+ (lambda ()
+ (format pipe "quit\n")
+ (close-pipe pipe)))))