(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
+(require 'seq)
+(require 'subr-x)
(require 'xml)
;;; D-Bus constants.
"The namespace for default error names.
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
-(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
- "A generic error; \"something went wrong\" - see the error message for more.")
-
(defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied")
"Security restrictions don't allow doing what you're trying to do.")
+(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected")
+ "The connection is disconnected and you're trying to use it.")
+
+(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
+ "A generic error; \"something went wrong\" - see the error message for more.")
+
(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
"Invalid arguments passed to a method call.")
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
+(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown")
+ "The bus doesn't know how to launch a service to supply the bus name you wanted.")
+
(defconst dbus-error-unknown-interface
(concat dbus-error-dbus ".UnknownInterface")
"Interface you invoked a method on isn't known by the object.")
"Set" :timeout 500 interface property (cons :variant args))
;; Return VALUE.
(or (dbus-get-property bus service path interface property)
- (if (symbolp (car args)) (cadr args) (car args)))))
+ (if (keywordp (car args)) (cadr args) (car args)))))
(defun dbus-get-all-properties (bus service path interface)
"Return all properties of INTERFACE at BUS, SERVICE, PATH.
\(dbus-register-property BUS SERVICE PATH INTERFACE PROPERTY ACCESS \
[TYPE] VALUE &optional EMITS-SIGNAL DONT-REGISTER-SERVICE)"
(let (;; Read basic type symbol.
- (type (when (symbolp (car args)) (pop args)))
+ (type (when (keywordp (car args)) (pop args)))
(value (pop args))
(emits-signal (pop args))
(dont-register-service (pop args)))
;; changed_properties.
(if (eq access :write)
'(:array: :signature "{sv}")
- `(:array
- (:dict-entry
- ,property
- ,(if type (list :variant type value) (list :variant value)))))
+ `(:array (:dict-entry ,property ,value)))
;; invalidated_properties.
(if (eq access :write)
`(:array ,property)
(handler #'dbus--test-method-handler)
registered)
+ ;; The service is not registered yet.
+ (should
+ (equal
+ (should-error
+ (dbus-call-method
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface method1 :timeout 10 "foo"))
+ `(dbus-error
+ ,dbus-error-service-unknown "The name is not activatable")))
+
+ ;; Register.
(should
(equal
(setq
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
-;; TODO: Test emits-signal.
-(ert-deftest dbus-test05-register-property ()
+(defvar dbus--test-signal-received nil
+ "Received signal value in `dbus--test-signal-handler'.")
+
+(defun dbus--test-signal-handler (&rest args)
+ "Signal handler for `dbus-test05-register-signal'."
+ (setq dbus--test-signal-received args))
+
+(ert-deftest dbus-test05-register-signal ()
+ "Check signal registration for an own service."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((member "Member")
+ (handler #'dbus--test-signal-handler)
+ registered)
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (setq
+ registered
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member handler))
+ `((:signal :session ,dbus--test-interface ,member)
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Send one argument, basic type.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member "foo")
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1))
+ (should (equal dbus--test-signal-received '("foo")))
+
+ ;; Send two arguments, compound types.
+ (setq dbus--test-signal-received nil)
+ (dbus-send-signal
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface member
+ '(:array :byte 1 :byte 2 :byte 3) '(:variant :string "bar"))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1))
+ (should (equal dbus--test-signal-received '((1 2 3) ("bar"))))
+
+ ;; Unregister signal.
+ (should (dbus-unregister-object registered))
+ (should-not (dbus-unregister-object registered)))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
+(ert-deftest dbus-test06-register-property ()
"Check property registration for an own service."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
(dbus-unregister-service :session dbus--test-service)))
;; The following test is inspired by Bug#43146.
-(ert-deftest dbus-test05-register-property-several-paths ()
+(ert-deftest dbus-test06-register-property-several-paths ()
"Check property registration for an own service at several paths."
(skip-unless dbus--test-enabled-session-bus)
(dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
+(ert-deftest dbus-test06-register-property-emits-signal ()
+ "Check property registration for an own service, including signalling."
+ (skip-unless dbus--test-enabled-session-bus)
+ (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service))
+
+ (unwind-protect
+ (let ((property "Property")
+ (handler #'dbus--test-signal-handler))
+
+ ;; Register signal handler.
+ (should
+ (equal
+ (dbus-register-signal
+ :session dbus--test-service dbus--test-path
+ dbus-interface-properties "PropertiesChanged" handler)
+ `((:signal :session ,dbus-interface-properties "PropertiesChanged")
+ (,dbus--test-service ,dbus--test-path ,handler))))
+
+ ;; Register property.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-register-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property :readwrite "foo" 'emits-signal)
+ `((:property :session ,dbus--test-interface ,property)
+ (,dbus--test-service ,dbus--test-path))))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1))
+ ;; It returns two arguments, "changed_properties" (an array of
+ ;; dict entries) and "invalidated_properties" (an array of
+ ;; strings).
+ (should (equal dbus--test-signal-received `(((,property ("foo"))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ "foo"))
+
+ ;; Set property. The new value shall be signalled.
+ (setq dbus--test-signal-received nil)
+ (should
+ (equal
+ (dbus-set-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property
+ '(:array :byte 1 :byte 2 :byte 3))
+ '(1 2 3)))
+ (while (null dbus--test-signal-received)
+ (read-event nil nil 0.1))
+ (should
+ (equal
+ dbus--test-signal-received `(((,property ((((1) (2) (3)))))) ())))
+
+ (should
+ (equal
+ (dbus-get-property
+ :session dbus--test-service dbus--test-path
+ dbus--test-interface property)
+ '(1 2 3))))
+
+ ;; Cleanup.
+ (dbus-unregister-service :session dbus--test-service)))
+
(defun dbus-test-all (&optional interactive)
"Run all tests for \\[dbus]."
(interactive "p")