unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* DBus methods without name grabbing
@ 2011-01-02 21:06 Jan Moringen
  2011-01-03 12:55 ` Michael Albinus
  0 siblings, 1 reply; 13+ messages in thread
From: Jan Moringen @ 2011-01-02 21:06 UTC (permalink / raw)
  To: emacs-devel

[-- Attachment #1: Type: text/plain, Size: 1072 bytes --]

Hi,

recently I ran into the following DBus-related problem: In order to
write a telepathy client [1], it is required to provide a certain
DBus-Interface under a special well-known name. Some telepathy component
seems to start calling methods immediately after the well-known name is
taken. Since the interface consists of multiple methods/properties, it
cannot be ensured that the interface is completely available when the
name is taken and the first calls are made using Emacs' current
DBus-interface. This is due to the fact that the function
`dbus-register-method' immediately takes the name.

To allow Emacs to work with this kind of DBus-interfaces, I suggest the
changes implemented in the attached patch. I don't known the Emacs C
code well very well, so it probably needs revision.

An example for which this change is necessary can be found in the
function `telepathy-client-register' in the attached file client.el from
my telepathy bindings.

Do you think this patch could be applied?

Kind regards,
Jan

[1] http://telepathy.freedesktop.org/spec/Client.html

[-- Attachment #2: dbus-dont-request-name.diff --]
[-- Type: text/x-patch, Size: 3732 bytes --]

=== modified file 'lisp/net/dbus.el'
--- lisp/net/dbus.el	2010-08-30 13:03:05 +0000
+++ lisp/net/dbus.el	2010-10-03 02:25:51 +0000
@@ -868,7 +868,8 @@
 	(add-to-list 'result (cons (car dict) (caadr dict)) 'append)))))
 
 (defun dbus-register-property
-  (bus service path interface property access value &optional emits-signal)
+  (bus service path interface property access value
+   &optional emits-signal dont-request-name)
   "Register property PROPERTY on the D-Bus BUS.
 
 BUS is either a Lisp symbol, `:system' or `:session', or a string
@@ -899,7 +900,8 @@
     (signal 'dbus-error (list "Access type invalid" access)))
 
   ;; Register SERVICE.
-  (unless (member service (dbus-list-names bus))
+  (unless (or dont-request-name
+	      (member service (dbus-list-names bus)))
     (dbus-call-method
      bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
      "RequestName" service 0))
@@ -907,11 +909,14 @@
   ;; Add the handler.  We use `dbus-service-emacs' as service name, in
   ;; order to let unregister SERVICE despite of this default handler.
   (dbus-register-method
-   bus service path dbus-interface-properties "Get" 'dbus-property-handler)
+   bus service path dbus-interface-properties "Get" 'dbus-property-handler
+   dont-request-name)
   (dbus-register-method
-   bus service path dbus-interface-properties "GetAll" 'dbus-property-handler)
+   bus service path dbus-interface-properties "GetAll" 'dbus-property-handler
+   dont-request-name)
   (dbus-register-method
-   bus service path dbus-interface-properties "Set" 'dbus-property-handler)
+   bus service path dbus-interface-properties "Set" 'dbus-property-handler
+   dont-request-name)
 
   ;; Send the PropertiesChanged signal.
   (when emits-signal

=== modified file 'src/dbusbind.c'
--- src/dbusbind.c	2010-10-01 13:56:33 +0000
+++ src/dbusbind.c	2010-10-03 02:17:34 +0000
@@ -1947,7 +1947,7 @@
 }
 
 DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method,
-       6, 6, 0,
+       6, 7, 0,
        doc: /* Register for method METHOD on the D-Bus BUS.
 
 BUS is either a Lisp symbol, `:system' or `:session', or a string
@@ -1961,7 +1961,7 @@
 Lisp function to be called when a method call is received.  It must
 accept the input arguments of METHOD.  The return value of HANDLER is
 used for composing the returning D-Bus message.  */)
-  (Lisp_Object bus, Lisp_Object service, Lisp_Object path, Lisp_Object interface, Lisp_Object method, Lisp_Object handler)
+  (Lisp_Object bus, Lisp_Object service, Lisp_Object path, Lisp_Object interface, Lisp_Object method, Lisp_Object handler, Lisp_Object dont_request_name)
 {
   Lisp_Object key, key1, value;
   DBusConnection *connection;
@@ -1983,10 +1983,16 @@
 
   /* Request the known name from the bus.  We can ignore the result,
      it is set to -1 if there is an error - kind of redundancy.  */
-  dbus_error_init (&derror);
-  result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
-  if (dbus_error_is_set (&derror))
-    XD_ERROR (derror);
+  if (!dont_request_name || NILP (dont_request_name))
+    {
+      dbus_error_init (&derror);
+      result = dbus_bus_request_name (connection, SDATA (service), 0, &derror);
+      if (dbus_error_is_set (&derror))
+	XD_ERROR (derror);
+
+      /* Cleanup.  */
+      dbus_error_free (&derror);
+    }
 
   /* Create a hash table entry.  We use nil for the unique name,
      because the method might be called from anybody.  */
@@ -1997,9 +2003,6 @@
   if (NILP (Fmember (key1, value)))
     Fputhash (key, Fcons (key1, value), Vdbus_registered_objects_table);
 
-  /* Cleanup.  */
-  dbus_error_free (&derror);
-
   /* Return object.  */
   return list2 (key, list3 (service, path, handler));
 }


[-- Attachment #3: client.el --]
[-- Type: text/x-emacs-lisp, Size: 8494 bytes --]

;;; client.el ---
;;
;; Copyright (C) 2010, 2011 Jan Moringen
;;
;; Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
;; Keywords: telepathy, communication, instant messaging
;;
;; This Program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This Program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses>.

\f
;;; Commentary:
;;

\f
;;; History:
;;
;; 0.1 - Initial version

\f
;;; Code:
;;

(require 'dbus)

(require 'telepathy/util)

\f
;;;
;;

(defconst telepathy-client-introspection-data
  "<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\"
\"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">
<node name=\"/org/freedesktop/Telepathy/Client/%s\">
  <interface name=\"org.freedesktop.DBus.Introspectable\">
    <method name=\"Introspect\">
      <arg name=\"data\" direction=\"out\" type=\"s\"/>
    </method>
  </interface>
  <interface name=\"org.freedesktop.DBus.Properties\">
    <method name=\"Get\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"propname\" direction=\"in\" type=\"s\"/>
      <arg name=\"value\" direction=\"out\" type=\"v\"/>
    </method>
    <method name=\"Set\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"propname\" direction=\"in\" type=\"s\"/>
      <arg name=\"value\" direction=\"in\" type=\"v\"/>
    </method>
    <method name=\"GetAll\">
      <arg name=\"interface\" direction=\"in\" type=\"s\"/>
      <arg name=\"props\" direction=\"out\" type=\"a{sv}\"/>
    </method>
  </interface>
  <interface name=\"org.freedesktop.Telepathy.Client.Handler\">
    <method name=\"HandleChannels\">
      <arg name=\"Account\" type=\"o\" direction=\"in\"/>
      <arg name=\"Connection\" type=\"o\" direction=\"in\"/>
      <arg name=\"Channels\" type=\"a(oa{sv})\" direction=\"in\"/>
      <arg name=\"Requests_Satisfied\" type=\"ao\" direction=\"in\"/>
      <arg name=\"User_Action_Time\" type=\"t\" direction=\"in\"/>
      <arg name=\"Handler_Info\" type=\"a{sv}\" direction=\"in\"/>
    </method>
  </interface>
</node>"
  "")

\f
;;;
;;

(defvar telepathy-client-handlers (make-hash-table :test 'equal)
  "")

(defun telepathy-client-handler-services ()
  ""
  (let ((result))
    (maphash (lambda (key value) (push key result))
	     telepathy-client-handlers)
    result))

(defun telepathy-client-add-handler (service handler &optional client)
  ""
  (unless client
    (setq client "Emacs"))

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-unregister client))

  (puthash service handler telepathy-client-handlers)

  (telepathy-client-register client))

(defun telepathy-client-remove-handler (service &optional client)
  ""
  (unless client
    (setq client "Emacs"))

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-unregister client))

  (remhash service telepathy-client-handlers)

  (unless (zerop (hash-table-count telepathy-client-handlers))
    (telepathy-client-register client)))

\f
;;;
;;

(defun telepath-client-channel-handler (account connection-path channels &rest args)
  ""
  (dolist (channel-data channels)
    (let* ((connection         (telepathy-make-remote-proxy-from-path
				:session connection-path))

	   ;; Analyze the properties of the channel.
	   (channel-properties (second channel-data))

	   (contact-handle     (telepathy-prop-get
				telepathy-key-target-handle channel-properties))
	   (contact            (telepathy-make-contact
				connection contact-handle))

	   (service            (telepathy-prop-get
				telepathy-key-service channel-properties))
	   (handler            (gethash service telepathy-client-handlers))

	   ;; Obtain object path of channel object.
	   (channel-path       (first channel-data))
	   (channel-service    (let ((bla (telepathy-path->service channel-path)))
				 (substring bla 0 (position ?. bla :from-end t))))
	   (channel-object     (dbus-proxy-make-remote-proxy
				:session channel-service channel-path
				nil 'telepathy-tube))) ;; TODO could be a different kind of channel
      (oset channel-object :contact contact)

      (message "Channel")
      (message "  Path       %s" channel-path)
      (message "  Service    %s" service)
      (message "  Contact    %s" contact)
      (funcall handler channel-object)))
  :ignore)

(defun telepathy-client-register (name)
  ""
  ;; Create a DBus object to handle tube requests.
  (let ((service (format "org.freedesktop.Telepathy.Client.%s" name))
	(path    (format "/org/freedesktop/Telepathy/Client/%s" name)))
    ;; Install introspection information.
    (lexical-let ((introspection-data
		   (format telepathy-client-introspection-data name)))
      (dbus-register-method
       :session service path
       "org.freedesktop.DBus.Introspectable"
       "Introspect"
       (lambda (&rest args) introspection-data)
       t)) ;; don't request the name, yet

    ;; Register all properties belonging to the handler object.
    (dolist (name-and-value `(("HandlerChannelFilter"
			       ,(mapcar
				 #'telepathy-client-make-channel-filter
				 (telepathy-client-handler-services)))
			      ("BypassApproval"  t) ;; TODO was nil
			      ("Capabilities"    (:array :signature "as"))
			      ("HandledChannels" (:array :signature "ao"))))
      (destructuring-bind (name value) name-and-value
	(dbus-register-property
	 :session service path
	 "org.freedesktop.Telepathy.Client.Handler"
	 name :read value nil t))) ;; don't request the name, yet

    ;; TODO store the dbus objects for unregistering?
    (dbus-register-method
     :session service path
     "org.freedesktop.Telepathy.Client.Handler"
     "HandleChannels" #'telepath-client-channel-handler
     t) ;; don't request the name, yet

    (dbus-register-property
     :session service path
     "org.freedesktop.Telepathy.Client"
     "Interfaces"
     :read
     '("org.freedesktop.Telepathy.Client.Handler")
     nil t) ;; don't request the name, yet

    ;; Now that everything is in place, request the name.
    (dbus-call-method
     :session dbus-service-dbus dbus-path-dbus dbus-interface-dbus
     "RequestName" service 0)))

;; (/org/freedesktop/Telepathy/Connection/gabble/jabber/scymtym_2dtest_40jabber_2eorg_2fbe153d1c/StreamTubeChannel_2_1273735221
;;  ((org.freedesktop.Telepathy.Channel.InitiatorID
;;    (scymtym@jabber.org))
;;   (org.freedesktop.Telepathy.Channel.TargetHandleType
;;    (1))
;;   (org.freedesktop.Telepathy.Channel.TargetHandle
;;    (2))
;;   (org.freedesktop.Telepathy.Channel.TargetID
;;    (scymtym@jabber.org))
;;   (org.freedesktop.Telepathy.Channel.Requested
;;    (nil))
;;   (org.freedesktop.Telepathy.Channel.Type.StreamTube.SupportedSocketTypes
;;    (((0 (0 3)) (2 (0 1)) (3 (0 1)))))
;;   (org.freedesktop.Telepathy.Channel.Type.StreamTube.Service
;;    (org.gnu.emacs.rudel.announce))
;;   (org.freedesktop.Telepathy.Channel.Interface.Tube.Parameters
;;    (nil))
;;   (org.freedesktop.Telepathy.Channel.ChannelType
;;    (org.freedesktop.Telepathy.Channel.Type.StreamTube))
;;   (org.freedesktop.Telepathy.Channel.InitiatorHandle
;;    (2))
;;   (org.freedesktop.Telepathy.Channel.Interfaces
;;    ((org.freedesktop.Telepathy.Channel.Interface.Tube)))))

(defun telepathy-client-unregister (name)
  ""
  (dbus-unregister-service
   :session
   (format "org.freedesktop.Telepathy.Client.%s" name)))

\f
;;; Helper functions
;;

(defun telepathy-client-make-channel-filter (service)
  ""
  `((:dict-entry
     "org.freedesktop.Telepathy.Channel.ChannelType"
     (:variant :string "org.freedesktop.Telepathy.Channel.Type.StreamTube"))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.TargetHandleType"
     (:variant :uint32 1))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.Requested"
     (:variant :boolean nil))
    (:dict-entry
     "org.freedesktop.Telepathy.Channel.Type.StreamTube.Service"
     (:variant :string ,service))
    ))

(provide 'telepathy/client)
;;; client.el ends here

^ permalink raw reply	[flat|nested] 13+ messages in thread
end of thread, other threads:[~2011-01-10 11:40 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2011-01-02 21:06 DBus methods without name grabbing Jan Moringen
2011-01-03 12:55 ` Michael Albinus
2011-01-04  2:42   ` Jan Moringen
2011-01-04 10:10     ` Michael Albinus
2011-01-04 10:29       ` Jan Moringen
2011-01-04 13:09         ` Michael Albinus
2011-01-05  4:17       ` Jan Moringen
2011-01-05 11:45         ` Michael Albinus
2011-01-08  5:48           ` Jan Moringen
2011-01-09  9:42             ` Michael Albinus
2011-01-09 16:08               ` Jan Moringen
2011-01-10 11:40                 ` Michael Albinus
     [not found]       ` <1294201048.2508.1.camel@gunhead>
2011-01-05 10:46         ` Jan Moringen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).