;; Per-directory local variables for GNU Emacs 23 and later. ((nil . ((fill-column . 78) (tab-width . 8) (sentence-end-double-space . t) ;; For use with 'bug-reference-prog-mode'. (bug-reference-url-format . "http://bugs.gnu.org/%s") (bug-reference-bug-regexp . "") ;; Emacs-Guix (eval . (setq-local guix-directory (locate-dominating-file default-directory ".dir-locals.el"))) ;; Geiser ;; This allows automatically setting the `geiser-guile-load-path' ;; variable when using various Guix checkouts (e.g., via git worktrees). (eval . (let ((root-dir-unexpanded (locate-dominating-file default-directory ".dir-locals.el"))) ;; While Guix should in theory always have a .dir-locals.el ;; (we are reading this file, after all) there seems to
aboutsummaryrefslogtreecommitdiff
;;; 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 or #f
  (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 (m