diff options
| -rw-r--r-- | lisp/net/dbus.el | 10 | ||||
| -rw-r--r-- | src/dbusbind.c | 22 | ||||
| -rw-r--r-- | test/lisp/net/dbus-tests.el | 73 |
3 files changed, 84 insertions, 21 deletions
diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index fec9d3c7ab8..23ba191e3cf 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -2026,7 +2026,7 @@ either a method name, a signal name, or an error name." ;; Create a hash table entry. (setq key (list :monitor bus-private) - key1 (list nil nil nil handler) + key1 (list nil nil nil handler rule) value (gethash key dbus-registered-objects-table)) (unless (member key1 value) (puthash key (cons key1 value) dbus-registered-objects-table)) @@ -2060,8 +2060,11 @@ either a method name, a signal name, or an error name." (defun dbus-monitor-handler (&rest _args) "Default handler for the \"org.freedesktop.DBus.Monitoring.BecomeMonitor\" interface. -It will be applied for all objects created by -`dbus-register-monitor' which don't declare an own handler.." +It will be applied for all objects created by `dbus-register-monitor' +which don't declare an own handler. The printed timestamps do +not reflect the time the D-Bus message has passed the D-Bus +daemon, it is rather the timestamp the corresponding D-Bus event +has been handled by this function." (with-current-buffer (get-buffer-create "*D-Bus Monitor*") (special-mode) ;; Move forward and backward between messages. @@ -2071,6 +2074,7 @@ It will be applied for all objects created by (local-set-key (kbd "RET") #'dbus-monitor-goto-serial) (local-set-key [mouse-2] #'dbus-monitor-goto-serial) (let* ((inhibit-read-only t) + (text-quoting-style 'grave) (point (point)) (eobp (eobp)) (event last-input-event) diff --git a/src/dbusbind.c b/src/dbusbind.c index 09f0317be91..b06077d3b58 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -380,8 +380,9 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) break; case DBUS_TYPE_BOOLEAN: - /* Any non-nil object will be regarded as `t', so we don't apply - further type check. */ + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (intern ("booleanp"), object); sprintf (signature, "%c", dtype); break; @@ -405,6 +406,8 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: + /* We dont check the syntax of object path and signature. This + will be done by libdbus. */ CHECK_STRING (object); sprintf (signature, "%c", dtype); break; @@ -615,6 +618,9 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) } case DBUS_TYPE_BOOLEAN: + /* There must be an argument. */ + if (EQ (QCboolean, object)) + wrong_type_argument (intern ("booleanp"), object); { dbus_bool_t val = (NILP (object)) ? FALSE : TRUE; XD_DEBUG_MESSAGE ("%c %s", dtype, (val == FALSE) ? "false" : "true"); @@ -713,6 +719,8 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: + /* We dont check the syntax of object path and signature. + This will be done by libdbus. */ CHECK_STRING (object); { /* We need to send a valid UTF-8 string. We could encode `object' @@ -1927,11 +1935,11 @@ and for calling handlers in case of non-blocking method call returns. In the first case, the key in the hash table is the list (TYPE BUS INTERFACE MEMBER). TYPE is one of the Lisp symbols `:method', -`:signal' or `:property'. BUS is either a Lisp symbol, `:system' or -`:session', or a string denoting the bus address. INTERFACE is a -string which denotes a D-Bus interface, and MEMBER, also a string, is -either a method, a signal or a property INTERFACE is offering. All -arguments but BUS must not be nil. +`:signal', `:property' or `:monitor'. BUS is either a Lisp symbol, +`:system', `:session', `:system-private' or `:session-private', or a +string denoting the bus address. INTERFACE is a string which denotes +a D-Bus interface, and MEMBER, also a string, is either a method, a +signal or a property INTERFACE is offering. All arguments can be nil. The value in the hash table is a list of quadruple lists ((UNAME SERVICE PATH OBJECT [RULE]) ...). SERVICE is the service name as diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index b853542a1f0..74c0dddcf52 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -99,7 +99,10 @@ "Check basic D-Bus type arguments." (skip-unless dbus--test-enabled-session-bus) - ;; Unknown keyword. + ;; No argument or unknown keyword. + (should-error + (dbus-check-arguments :session dbus--test-service) + :type 'wrong-number-of-arguments) (should-error (dbus-check-arguments :session dbus--test-service :keyword) :type 'wrong-type-argument) @@ -108,6 +111,9 @@ (should (dbus-check-arguments :session dbus--test-service "string")) (should (dbus-check-arguments :session dbus--test-service :string "string")) (should-error + (dbus-check-arguments :session dbus--test-service :string) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :string 0.5) :type 'wrong-type-argument) @@ -116,6 +122,10 @@ (dbus-check-arguments :session dbus--test-service :object-path "/object/path")) (should-error + (dbus-check-arguments :session dbus--test-service :object-path) + :type 'wrong-type-argument) + ;; Raises an error on stdin. + (should-error (dbus-check-arguments :session dbus--test-service :object-path "string") :type 'dbus-error) (should-error @@ -125,6 +135,10 @@ ;; `:signature'. (should (dbus-check-arguments :session dbus--test-service :signature "as")) (should-error + (dbus-check-arguments :session dbus--test-service :signature) + :type 'wrong-type-argument) + ;; Raises an error on stdin. + (should-error (dbus-check-arguments :session dbus--test-service :signature "string") :type 'dbus-error) (should-error @@ -136,10 +150,10 @@ (should (dbus-check-arguments :session dbus--test-service t)) (should (dbus-check-arguments :session dbus--test-service :boolean nil)) (should (dbus-check-arguments :session dbus--test-service :boolean t)) - ;; Will be handled as `nil'. - (should (dbus-check-arguments :session dbus--test-service :boolean)) - ;; Will be handled as `t'. (should (dbus-check-arguments :session dbus--test-service :boolean 'whatever)) + (should-error + (dbus-check-arguments :session dbus--test-service :boolean) + :type 'wrong-type-argument) ;; `:byte'. (should (dbus-check-arguments :session dbus--test-service :byte 0)) @@ -147,6 +161,9 @@ (should (dbus-check-arguments :session dbus--test-service :byte most-positive-fixnum)) (should-error + (dbus-check-arguments :session dbus--test-service :byte) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :byte -1) :type 'wrong-type-argument) (should-error @@ -161,6 +178,9 @@ (should (dbus-check-arguments :session dbus--test-service :int16 #x7fff)) (should (dbus-check-arguments :session dbus--test-service :int16 #x-8000)) (should-error + (dbus-check-arguments :session dbus--test-service :int16) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :int16 #x8000) :type 'args-out-of-range) (should-error @@ -177,6 +197,9 @@ (should (dbus-check-arguments :session dbus--test-service :uint16 0)) (should (dbus-check-arguments :session dbus--test-service :uint16 #xffff)) (should-error + (dbus-check-arguments :session dbus--test-service :uint16) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :uint16 #x10000) :type 'args-out-of-range) (should-error @@ -194,6 +217,9 @@ (should (dbus-check-arguments :session dbus--test-service :int32 #x7fffffff)) (should (dbus-check-arguments :session dbus--test-service :int32 #x-80000000)) (should-error + (dbus-check-arguments :session dbus--test-service :int32) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :int32 #x80000000) :type 'args-out-of-range) (should-error @@ -211,6 +237,9 @@ (should (dbus-check-arguments :session dbus--test-service :uint32 0)) (should (dbus-check-arguments :session dbus--test-service :uint32 #xffffffff)) (should-error + (dbus-check-arguments :session dbus--test-service :uint32) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :uint32 #x100000000) :type 'args-out-of-range) (should-error @@ -230,6 +259,9 @@ (should (dbus-check-arguments :session dbus--test-service :int64 #x-8000000000000000)) (should-error + (dbus-check-arguments :session dbus--test-service :int64) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :int64 #x8000000000000000) :type 'args-out-of-range) (should-error @@ -247,6 +279,9 @@ (should (dbus-check-arguments :session dbus--test-service :uint64 #xffffffffffffffff)) (should-error + (dbus-check-arguments :session dbus--test-service :uint64) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :uint64 #x10000000000000000) :type 'args-out-of-range) (should-error @@ -268,6 +303,9 @@ (should (dbus-check-arguments :session dbus--test-service :double 1.0e+INF)) (should (dbus-check-arguments :session dbus--test-service :double 0.0e+NaN)) (should-error + (dbus-check-arguments :session dbus--test-service :double) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :double "string") :type 'wrong-type-argument) @@ -279,6 +317,9 @@ ;; type range fail. (should (dbus-check-arguments :session dbus--test-service :unix-fd 0)) (should-error + (dbus-check-arguments :session dbus--test-service :unix-fd) + :type 'wrong-type-argument) + (should-error (dbus-check-arguments :session dbus--test-service :unix-fd -1) :type 'args-out-of-range) (should-error @@ -300,7 +341,7 @@ (should (dbus-check-arguments :session dbus--test-service '(:array :string "string1" "string2"))) - ;; Empty array. + ;; Empty array (of strings). (should (dbus-check-arguments :session dbus--test-service '(:array))) (should (dbus-check-arguments :session dbus--test-service '(:array :signature "o"))) @@ -318,7 +359,11 @@ (should (dbus-check-arguments :session dbus--test-service '(:variant (:array "string")))) - ;; More than one element. + ;; No or more than one element. + ;; FIXME. + ;; (should-error + ;; (dbus-check-arguments :session dbus--test-service '(:variant)) + ;; :type 'wrong-type-argument) (should-error (dbus-check-arguments :session dbus--test-service @@ -336,10 +381,13 @@ (dbus-check-arguments :session dbus--test-service '(:array :dict-entry (:string "string" :boolean t)))) - ;; The second element is `nil' (implicitly). FIXME: Is this right? - (should - (dbus-check-arguments - :session dbus--test-service '(:array (:dict-entry :string "string")))) + ;; 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. (should-error (dbus-check-arguments @@ -357,7 +405,8 @@ (dbus-check-arguments :session dbus--test-service '(:dict-entry :string "string" :boolean t)) :type 'wrong-type-argument) - ;; Different dict entry types can be part of an array. + ;; FIXME:! This doesn't look right. + ;; Different dict entry types can be part of an array ??? (should (dbus-check-arguments :session dbus--test-service @@ -366,6 +415,8 @@ (:dict-entry :string "string2" :object-path "/object/path")))) ;; `: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 |