From b7224f9629ce549806ae3b4c974ce937bb20e840 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Wed, 30 Sep 2020 15:28:53 +0200 Subject: [PATCH] Stricter checks for D-Bus compound types. * src/dbusbind.c (XD_DBUS_TYPE_P, Fdbus__init_bus) (xd_read_queued_messages): Use Fkeywordp instead of SYMBOLP. (xd_signature): Stricter checks for compound types. * test/lisp/net/dbus-tests.el (dbus-test01-compound-types): Extend test. --- src/dbusbind.c | 14 ++++++---- test/lisp/net/dbus-tests.el | 54 ++++++++++++++++++++----------------- 2 files changed, 38 insertions(+), 30 deletions(-) diff --git a/src/dbusbind.c b/src/dbusbind.c index b06077d3b58..36f86556944 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -211,7 +211,7 @@ xd_dbus_type_to_symbol (int type) /* Check whether a Lisp symbol is a predefined D-Bus type symbol. */ #define XD_DBUS_TYPE_P(object) \ - (SYMBOLP (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID))) + Fkeywordp (object) && ((xd_symbol_to_dbus_type (object) != DBUS_TYPE_INVALID)) /* Determine the DBusType of a given Lisp OBJECT. It is used to convert Lisp objects, being arguments of `dbus-call-method' or @@ -463,6 +463,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); @@ -474,11 +475,12 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_STRUCT: - /* A struct list might contain any number of elements with - different types. No further check needed. */ + /* A struct list might contain any (but zero) number of elements + with different types. No further check needed. */ CHECK_CONS (object); elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); /* Compose the signature from the elements. It is enclosed by parentheses. */ @@ -509,6 +511,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* First element. */ elt = XD_NEXT_VALUE (elt); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -518,6 +521,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) /* Second element. */ elt = CDR_SAFE (XD_NEXT_VALUE (elt)); + CHECK_CONS (elt); subtype = XD_OBJECT_TO_DBUS_TYPE (CAR_SAFE (elt)); xd_signature (x, subtype, dtype, CAR_SAFE (XD_NEXT_VALUE (elt))); xd_signature_cat (signature, x); @@ -1227,7 +1231,7 @@ this connection to those buses. */) xd_add_watch, xd_remove_watch, xd_toggle_watch, - SYMBOLP (bus) + Fkeywordp (bus) ? (void *) XSYMBOL (bus) : (void *) XSTRING (bus), NULL)) @@ -1793,7 +1797,7 @@ xd_read_queued_messages (int fd, void *data) while (!NILP (busp)) { key = CAR_SAFE (CAR_SAFE (busp)); - if ((SYMBOLP (key) && XSYMBOL (key) == data) + if ((Fkeywordp (key) && XSYMBOL (key) == data) || (STRINGP (key) && XSTRING (key) == data)) bus = key; busp = CDR_SAFE (busp); diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 6c77f60ec90..759cd102892 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -366,11 +366,11 @@ (should (dbus-check-arguments :session dbus--test-service '(:variant (:array "string")))) - ;; No or more than one element. - ;; FIXME. - ;; (should-error - ;; (dbus-check-arguments :session dbus--test-service '(:variant)) - ;; :type 'wrong-type-argument) + ;; Empty variant. + (should-error + (dbus-check-arguments :session dbus--test-service '(:variant)) + :type 'wrong-type-argument) + ;; More than one element. (should-error (dbus-check-arguments :session dbus--test-service @@ -382,20 +382,22 @@ (should (dbus-check-arguments :session dbus--test-service - '(:array (:dict-entry :string "string" :boolean t)))) + '(:array (:dict-entry :string "string" :boolean nil)))) ;; This is an alternative syntax. FIXME: Shall this be supported? (should (dbus-check-arguments :session dbus--test-service '(:array :dict-entry (:string "string" :boolean t)))) - ;; FIXME: Must be errors. - ;; (should - ;; (dbus-check-arguments - ;; :session dbus--test-service '(:array (:dict-entry)))) - ;; (should - ;; (dbus-check-arguments - ;; :session dbus--test-service '(:array (:dict-entry :string "string")))) - ;; Not two elements. + ;; Empty dict-entry. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:array (:dict-entry))) + :type 'wrong-type-argument) + ;; One element. + (should-error + (dbus-check-arguments + :session dbus--test-service '(:array (:dict-entry :string "string"))) + :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service @@ -412,25 +414,27 @@ (dbus-check-arguments :session dbus--test-service '(:dict-entry :string "string" :boolean t)) :type 'wrong-type-argument) - ;; FIXME:! This doesn't look right. - ;; Different dict entry types can be part of an array ??? - (should - (dbus-check-arguments - :session dbus--test-service - '(:array - (:dict-entry :string "string1" :boolean t) - (:dict-entry :string "string2" :object-path "/object/path")))) + ;; Different dict entry types are not ched. FIXME: Add check. + ;; (should-error + ;; (dbus-check-arguments + ;; :session dbus--test-service + ;; '(:array + ;; (:dict-entry :string "string1" :boolean t) + ;; (:dict-entry :string "string2" :object-path "/object/path"))) + ;; :type 'wrong-type-argument) ;; `:struct'. There is no restriction what could be an element of a struct. - ;; Empty struct. FIXME: Is this right? - ;; (should (dbus-check-arguments :session dbus--test-service '(:struct))) (should (dbus-check-arguments :session dbus--test-service '(:struct :string "string" :object-path "/object/path" - (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4)))))) + (:variant (:array :unix-fd 1 :unix-fd 2 :unix-fd 3 :unix-fd 4))))) + ;; Empty struct. + (should-error + (dbus-check-arguments :session dbus--test-service '(:struct)) + :type 'wrong-type-argument)) (defun dbus--test-register-service (bus) "Check service registration at BUS." -- 2.39.5