test/lisp/net/dbus-tests.el

   1 ;;; dbus-tests.el --- Tests of D-Bus integration into Emacs
   2
   3 ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6
   7 ;; This program is free software: you can redistribute it and/or
   8 ;; modify it under the terms of the GNU General Public License as
   9 ;; published by the Free Software Foundation, either version 3 of the
  10 ;; License, or (at your option) any later version.
  11 ;;
  12 ;; This program is distributed in the hope that it will be useful, but
  13 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15 ;; General Public License for more details.
  16 ;;
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program.  If not, see `https://www.gnu.org/licenses/'.
  19
  20 ;;; Code:
  21
  22 (require 'ert)
  23 (require 'dbus)
  24
  25 (defvar dbus-debug nil)
  26 (declare-function dbus-get-unique-name "dbusbind.c" (bus))
  27
  28 (defvar dbus--test-enabled-session-bus
  29   (and (featurep 'dbusbind)
  30        (dbus-ignore-errors (dbus-get-unique-name :session)))
  31   "Check, whether we are registered at the session bus.")
  32
  33 (defvar dbus--test-enabled-system-bus
  34   (and (featurep 'dbusbind)
  35        (dbus-ignore-errors (dbus-get-unique-name :system)))
  36   "Check, whether we are registered at the system bus.")
  37
  38 (defun dbus--test-availability (bus)
  39   "Test availability of D-Bus BUS."
  40   (should (dbus-list-names bus))
  41   (should (dbus-list-activatable-names bus))
  42   (should (dbus-list-known-names bus))
  43   (should (dbus-get-unique-name bus)))
  44
  45 (ert-deftest dbus-test00-availability-session ()
  46   "Test availability of D-Bus `:session'."
  47   :expected-result (if dbus--test-enabled-session-bus :passed :failed)
  48   (dbus--test-availability :session))
  49
  50 (ert-deftest dbus-test00-availability-system ()
  51   "Test availability of D-Bus `:system'."
  52   :expected-result (if dbus--test-enabled-system-bus :passed :failed)
  53   (dbus--test-availability :system))
  54
  55 (ert-deftest dbus-test01-type-conversion ()
  56   "Check type conversion functions."
  57   (let ((ustr "0123abc_xyz\x01\xff")
  58         (mstr "Grüß Göttin"))
  59     (should
  60      (string-equal
  61       (dbus-byte-array-to-string (dbus-string-to-byte-array "")) ""))
  62     (should
  63      (string-equal
  64       (dbus-byte-array-to-string (dbus-string-to-byte-array ustr)) ustr))
  65     (should
  66      (string-equal
  67       (dbus-byte-array-to-string (dbus-string-to-byte-array mstr) 'multibyte)
  68       mstr))
  69     ;; Should not work for multibyte strings.
  70     (should-not
  71      (string-equal
  72       (dbus-byte-array-to-string (dbus-string-to-byte-array mstr)) mstr))
  73
  74     (should
  75      (string-equal
  76       (dbus-unescape-from-identifier (dbus-escape-as-identifier "")) ""))
  77     (should
  78      (string-equal
  79       (dbus-unescape-from-identifier (dbus-escape-as-identifier ustr)) ustr))
  80     ;; Should not work for multibyte strings.
  81     (should-not
  82      (string-equal
  83       (dbus-unescape-from-identifier (dbus-escape-as-identifier mstr)) mstr))))
  84
  85 (defun dbus--test-register-service (bus)
  86   "Check service registration at BUS."
  87   ;; Cleanup.
  88   (dbus-ignore-errors (dbus-unregister-service bus dbus-service-emacs))
  89
  90   ;; Register an own service.
  91   (should (eq (dbus-register-service bus dbus-service-emacs) :primary-owner))
  92   (should (member dbus-service-emacs (dbus-list-known-names bus)))
  93   (should (eq (dbus-register-service bus dbus-service-emacs) :already-owner))
  94   (should (member dbus-service-emacs (dbus-list-known-names bus)))
  95
  96   ;; Unregister the service.
  97   (should (eq (dbus-unregister-service bus dbus-service-emacs) :released))
  98   (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
  99   (should (eq (dbus-unregister-service bus dbus-service-emacs) :non-existent))
 100   (should-not (member dbus-service-emacs (dbus-list-known-names bus)))
 101
 102   ;; `dbus-service-dbus' is reserved for the BUS itself.
 103   (should-error (dbus-register-service bus dbus-service-dbus))
 104   (should-error (dbus-unregister-service bus dbus-service-dbus)))
 105
 106 (ert-deftest dbus-test02-register-service-session ()
 107   "Check service registration at `:session' bus."
 108   (skip-unless (and dbus--test-enabled-session-bus
 109                     (dbus-register-service :session dbus-service-emacs)))
 110   (dbus--test-register-service :session)
 111
 112   (let ((service "org.freedesktop.Notifications"))
 113     (when (member service (dbus-list-known-names :session))
 114       ;; Cleanup.
 115       (dbus-ignore-errors (dbus-unregister-service :session service))
 116
 117       (should (eq (dbus-register-service :session service) :in-queue))
 118       (should (eq (dbus-unregister-service :session service) :released))
 119
 120       (should
 121        (eq (dbus-register-service :session service :do-not-queue) :exists))
 122       (should (eq (dbus-unregister-service :session service) :not-owner)))))
 123
 124 (ert-deftest dbus-test02-register-service-system ()
 125   "Check service registration at `:system' bus."
 126   (skip-unless (and dbus--test-enabled-system-bus
 127                     (dbus-register-service :system dbus-service-emacs)))
 128   (dbus--test-register-service :system))
 129
 130 (ert-deftest dbus-test02-register-service-own-bus ()
 131   "Check service registration with an own bus.
 132 This includes initialization and closing the bus."
 133   ;; Start bus.
 134   (let ((output
 135          (ignore-errors
 136            (shell-command-to-string "dbus-launch --sh-syntax")))
 137         bus pid)
 138     (skip-unless (stringp output))
 139     (when (string-match "DBUS_SESSION_BUS_ADDRESS='\\(.+\\)';" output)
 140       (setq bus (match-string 1 output)))
 141     (when (string-match "DBUS_SESSION_BUS_PID=\\([[:digit:]]+\\);" output)
 142       (setq pid (match-string 1 output)))
 143     (unwind-protect
 144         (progn
 145           (skip-unless
 146            (dbus-ignore-errors
 147              (and bus pid
 148                   (featurep 'dbusbind)
 149                   (dbus-init-bus bus)
 150                   (dbus-get-unique-name bus)
 151                   (dbus-register-service bus dbus-service-emacs))))
 152           ;; Run the test.
 153           (dbus--test-register-service bus))
 154
 155       ;; Save exit.
 156       (when pid (call-process "kill" nil nil nil pid)))))
 157
 158 (ert-deftest dbus-test03-peer-interface ()
 159   "Check `dbus-interface-peer' methods."
 160   (skip-unless
 161    (and dbus--test-enabled-session-bus
 162         (dbus-register-service :session dbus-service-emacs)
 163         ;; "GetMachineId" is not implemented (yet).  When it returns a
 164         ;; value, another D-Bus client like dbus-monitor is reacting
 165         ;; on `dbus-interface-peer'.  We cannot test then.
 166         (not
 167          (dbus-ignore-errors
 168            (dbus-call-method
 169             :session dbus-service-emacs dbus-path-dbus
 170             dbus-interface-peer "GetMachineId" :timeout 100)))))
 171
 172   (should (dbus-ping :session dbus-service-emacs 100))
 173   (dbus-unregister-service :session dbus-service-emacs)
 174   (should-not (dbus-ping :session dbus-service-emacs 100)))
 175
 176 (defun dbus-test-all (&optional interactive)
 177   "Run all tests for \\[dbus]."
 178   (interactive "p")
 179   (funcall
 180    (if interactive 'ert-run-tests-interactively 'ert-run-tests-batch) "^dbus"))
 181
 182 (provide 'dbus-tests)
 183 ;;; dbus-tests.el ends here