Subject: bug#43146: 27.1; D-Bus property handling incomplete

From: Michael Albinus <[email-masked]>
Date: Thu, 03 Sep 2020 13:52:50 +0200

Hugh Daschbach <[email-masked]> writes:

Hi Hugh,

> I've tweaked the test script to examine the "Set" and "GetAll"
> methods. The updated version is attached below.

Thanks for the test file.

I've appended another patch, could you pls apply this instead of the
first one? Locally, I've tested your script successfully.

> Thanks again,
> Hugh

Best regards, Michael.

*** /tmp/ediffWCMSQF	2020-09-03 13:49:33.193916784 +0200
--- /home/albinus/src/emacs-27/lisp/net/dbus.el	2020-09-03 13:36:44.960364842 +0200
***************
*** 1477,1482 ****
--- 1477,1502 ----
  	       (nreverse result))
  	(push (cons (car dict) (cl-caadr dict)) result)))))

+ (defun dbus-get-this-registered-property (bus _service path interface property)
+   "Return PROPERTY entry of `dbus-registered-objects-table'.
+ Filter out not matching PATH."
+   ;; Remove entries not belonging to this case.
+   (seq-remove
+    (lambda (item)
+      (not (string-equal path (nth 2 item))))
+    (gethash (list :property bus interface property)
+             dbus-registered-objects-table)))
+
+ (defun dbus-get-other-registered-property (bus _service path interface property)
+   "Return PROPERTY entry of `dbus-registered-objects-table'.
+ Filter out matching PATH."
+   ;; Remove matching entries.
+   (seq-remove
+    (lambda (item)
+      (string-equal path (nth 2 item)))
+    (gethash (list :property bus interface property)
+             dbus-registered-objects-table)))
+
  (defun dbus-register-property
    (bus service path interface property access value
     &optional emits-signal dont-register-service)
***************
*** 1543,1554 ****
    ;; because the property might be accessed from anybody.
    (let ((key (list :property bus interface property))
  	(val
! 	 (list
  	  (list
  	   nil service path
  	   (cons
  	    (if emits-signal (list access :emits-signal) (list access))
! 	    value)))))
      (puthash key val dbus-registered-objects-table)

      ;; Return the object.
--- 1563,1576 ----
    ;; because the property might be accessed from anybody.
    (let ((key (list :property bus interface property))
  	(val
!          (cons
  	  (list
  	   nil service path
  	   (cons
  	    (if emits-signal (list access :emits-signal) (list access))
! 	    value))
!           (dbus-get-other-registered-property
!            bus service path interface property))))
      (puthash key val dbus-registered-objects-table)

      ;; Return the object.
***************
*** 1566,1581 ****
      (cond
       ;; "Get" returns a variant.
       ((string-equal method "Get")
!       (let ((entry (gethash (list :property bus interface property)
! 			    dbus-registered-objects-table)))
  	(when (string-equal path (nth 2 (car entry)))
  	  `((:variant ,(cdar (last (car entry))))))))

       ;; "Set" expects a variant.
       ((string-equal method "Set")
        (let* ((value (caar (cddr args)))
! 	     (entry (gethash (list :property bus interface property)
! 			     dbus-registered-objects-table))
  	     ;; The value of the hash table is a list; in case of
  	     ;; properties it contains just one element (UNAME SERVICE
  	     ;; PATH OBJECT).  OBJECT is a cons cell of a list, which
--- 1588,1603 ----
      (cond
       ;; "Get" returns a variant.
       ((string-equal method "Get")
!       (let ((entry (dbus-get-this-registered-property
!                     bus service path interface property)))
  	(when (string-equal path (nth 2 (car entry)))
  	  `((:variant ,(cdar (last (car entry))))))))

       ;; "Set" expects a variant.
       ((string-equal method "Set")
        (let* ((value (caar (cddr args)))
! 	     (entry (dbus-get-this-registered-property
!                      bus service path interface property))
  	     ;; The value of the hash table is a list; in case of
  	     ;; properties it contains just one element (UNAME SERVICE
  	     ;; PATH OBJECT).  OBJECT is a cons cell of a list, which
***************
*** 1590,1597 ****
  	  (signal 'dbus-error
  		  (list "Property not writable at path" property path)))
  	(puthash (list :property bus interface property)
! 		 (list (append (butlast (car entry))
! 			       (list (cons (car object) value))))
  		 dbus-registered-objects-table)
  	;; Send the "PropertiesChanged" signal.
  	(when (member :emits-signal (car object))
--- 1612,1621 ----
  	  (signal 'dbus-error
  		  (list "Property not writable at path" property path)))
  	(puthash (list :property bus interface property)
! 		 (cons (append (butlast (car entry))
! 			       (list (cons (car object) value)))
!                        (dbus-get-other-registered-property
!                         bus service path interface property))
  		 dbus-registered-objects-table)
  	;; Send the "PropertiesChanged" signal.
  	(when (member :emits-signal (car object))
***************
*** 1607,1620 ****
        (let (result)
  	(maphash
  	 (lambda (key val)
! 	   (when (and (equal (butlast key) (list :property bus interface))
! 		      (string-equal path (nth 2 (car val)))
! 		      (not (functionp (car (last (car val))))))
! 	     (push
! 	      (list :dict-entry
! 		    (car (last key))
! 		    (list :variant (cdar (last (car val)))))
!               result)))
  	 dbus-registered-objects-table)
  	;; Return the result, or an empty array.
  	(list :array (or result '(:signature "{sv}"))))))))
--- 1631,1645 ----
        (let (result)
  	(maphash
  	 (lambda (key val)
!            (dolist (item val)
! 	     (when (and (equal (butlast key) (list :property bus interface))
! 		        (string-equal path (nth 2 item))
! 		        (not (functionp (car (last item)))))
! 	       (push
! 	        (list :dict-entry
! 		      (car (last key))
! 		      (list :variant (cdar (last item))))
!                 result))))
  	 dbus-registered-objects-table)
  	;; Return the result, or an empty array.
  	(list :array (or result '(:signature "{sv}"))))))))