1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-05 22:20:24 -08:00

Make D-Bus properties type safe

* doc/misc/dbus.texi (Properties and Annotations):
Precise dbus-get-property and dbus-set-property.
(Type Conversion): Explain :byte and :boolean type conversion.
(Errors and Events): dbus-ignore-errors returns nil when there is
a D-Bus error.  Remove dbus-show-dbus-errors.

* etc/NEWS: Some D-Bus relevant changes.

* lisp/net/dbus.el (dbus-show-dbus-errors): Remove.
(dbus-ignore-errors): Replay implamentation without that variable.
(dbus-check-arguments): New defun.
(dbus-list-activatable-names, dbus-list-names)
(dbus-list-queued-owners, dbus-get-name-owner, dbus-introspect)
(dbus-get-all-properties, dbus-get-all-managed-objects): Don't debug.
(dbus-get-property, dbus-set-property): Propagate errors.
(dbus-register-property): Check for valid VALUE.
(dbus-property-handler): Simplify.

* src/dbusbind.c (Fdbus_message_internal): Adapt docstring.
Handle DBUS_MESSAGE_TYPE_INVALID.

* test/lisp/net/dbus-tests.el (dbus-show-dbus-errors): Don't declare.
(dbus-test06-register-property)
(dbus-test06-register-property-emits-signal): Adapt tests.
This commit is contained in:
Michael Albinus 2020-09-20 16:44:17 +02:00
parent 209dfa11a4
commit f8624fb834
5 changed files with 201 additions and 186 deletions

View file

@ -25,8 +25,6 @@
(defvar dbus-debug nil)
(declare-function dbus-get-unique-name "dbusbind.c" (bus))
(setq dbus-show-dbus-errors nil)
(defconst dbus--test-enabled-session-bus
(and (featurep 'dbusbind)
(dbus-ignore-errors (dbus-get-unique-name :session)))
@ -383,19 +381,14 @@ This includes initialization and closing the bus."
"foo"))
;; Due to `:read' access type, we don't get a proper reply
;; from `dbus-set-property'.
(should-not
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 "foofoo"))
(let ((dbus-show-dbus-errors t))
(should
(equal
(butlast
(should-error
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 "foofoo")))
`(dbus-error ,dbus-error-property-read-only))))
(should
(equal
(butlast
(should-error
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1 "foofoo")))
`(dbus-error ,dbus-error-property-read-only)))
(should
(string-equal
(dbus-get-property
@ -413,29 +406,29 @@ This includes initialization and closing the bus."
(,dbus--test-service ,dbus--test-path))))
;; Due to `:write' access type, we don't get a proper reply
;; from `dbus-get-property'.
(should-not
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2))
(let ((dbus-show-dbus-errors t))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2)))
`(dbus-error ,dbus-error-access-denied))))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2)))
`(dbus-error ,dbus-error-access-denied)))
(should
(string-equal
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2 "barbar")
"barbar"))
(should-not ;; Due to `:write' access type.
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2))
;; Still `:write' access type.
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property2)))
`(dbus-error ,dbus-error-access-denied)))
;; `:readwrite' property, typed value (Bug#43252).
(should
@ -465,32 +458,22 @@ This includes initialization and closing the bus."
"/baz/baz"))
;; Not registered property.
(should-not
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4))
(let ((dbus-show-dbus-errors t))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4)))
`(dbus-error ,dbus-error-unknown-property))))
(should-not
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4 "foobarbaz"))
(let ((dbus-show-dbus-errors t))
(should
(equal
(butlast
(should-error
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4 "foobarbaz")))
`(dbus-error ,dbus-error-unknown-property))))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4)))
`(dbus-error ,dbus-error-unknown-property)))
(should
(equal
(butlast
(should-error
(dbus-set-property
:session dbus--test-service dbus--test-path
dbus--test-interface property4 "foobarbaz")))
`(dbus-error ,dbus-error-unknown-property)))
;; `dbus-get-all-properties'. We cannot retrieve a value for
;; the property with `:write' access type.
@ -516,19 +499,14 @@ This includes initialization and closing the bus."
;; Unregister property.
(should (dbus-unregister-object registered))
(should-not (dbus-unregister-object registered))
(should-not
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1))
(let ((dbus-show-dbus-errors t))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1)))
`(dbus-error ,dbus-error-unknown-property)))))
(should
(equal
(butlast
(should-error
(dbus-get-property
:session dbus--test-service dbus--test-path
dbus--test-interface property1)))
`(dbus-error ,dbus-error-unknown-property))))
;; Cleanup.
(dbus-unregister-service :session dbus--test-service)))
@ -745,7 +723,7 @@ This includes initialization and closing the bus."
(read-event nil nil 0.1)))
(should
(equal
dbus--test-signal-received `(((,property ((((1) (2) (3)))))) ())))
dbus--test-signal-received `(((,property ((1 2 3)))) ())))
(should
(equal