X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/e957f9ae90f3cab1584c06877cbff075d52a6a9a..25a48bd06bd5979d201cddde99e2dec1eb54c184:/src/dbusbind.c diff --git a/src/dbusbind.c b/src/dbusbind.c index 37bfbf4bad..7e5104026c 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1,5 +1,5 @@ /* Elisp bindings for D-Bus. - Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + Copyright (C) 2007-2011 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,10 +16,9 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -#include "config.h" +#include #ifdef HAVE_DBUS -#include #include #include #include @@ -27,16 +26,19 @@ along with GNU Emacs. If not, see . */ #include "frame.h" #include "termhooks.h" #include "keyboard.h" +#include "process.h" /* Subroutines. */ Lisp_Object Qdbus_init_bus; +Lisp_Object Qdbus_close_bus; Lisp_Object Qdbus_get_unique_name; Lisp_Object Qdbus_call_method; Lisp_Object Qdbus_call_method_asynchronously; Lisp_Object Qdbus_method_return_internal; Lisp_Object Qdbus_method_error_internal; Lisp_Object Qdbus_send_signal; +Lisp_Object Qdbus_register_service; Lisp_Object Qdbus_register_signal; Lisp_Object Qdbus_register_method; @@ -49,6 +51,17 @@ Lisp_Object QCdbus_system_bus, QCdbus_session_bus; /* Lisp symbol for method call timeout. */ Lisp_Object QCdbus_timeout; +/* Lisp symbols for name request flags. */ +Lisp_Object QCdbus_request_name_allow_replacement; +Lisp_Object QCdbus_request_name_replace_existing; +Lisp_Object QCdbus_request_name_do_not_queue; + +/* Lisp symbols for name request replies. */ +Lisp_Object QCdbus_request_name_reply_primary_owner; +Lisp_Object QCdbus_request_name_reply_in_queue; +Lisp_Object QCdbus_request_name_reply_exists; +Lisp_Object QCdbus_request_name_reply_already_owner; + /* Lisp symbols of D-Bus types. */ Lisp_Object QCdbus_type_byte, QCdbus_type_boolean; Lisp_Object QCdbus_type_int16, QCdbus_type_uint16; @@ -56,15 +69,12 @@ Lisp_Object QCdbus_type_int32, QCdbus_type_uint32; Lisp_Object QCdbus_type_int64, QCdbus_type_uint64; Lisp_Object QCdbus_type_double, QCdbus_type_string; Lisp_Object QCdbus_type_object_path, QCdbus_type_signature; +#ifdef DBUS_TYPE_UNIX_FD +Lisp_Object QCdbus_type_unix_fd; +#endif Lisp_Object QCdbus_type_array, QCdbus_type_variant; Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry; -/* Hash table which keeps function definitions. */ -Lisp_Object Vdbus_registered_objects_table; - -/* Whether to debug D-Bus. */ -Lisp_Object Vdbus_debug; - /* Whether we are reading a D-Bus event. */ int xd_in_read_queued_messages = 0; @@ -111,7 +121,7 @@ int xd_in_read_queued_messages = 0; } while (0) /* Macros for debugging. In order to enable them, build with - "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */ + "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */ #ifdef DBUS_DEBUG #define XD_DEBUG_MESSAGE(...) \ do { \ @@ -143,6 +153,22 @@ int xd_in_read_queued_messages = 0; #endif /* Check whether TYPE is a basic DBusType. */ +#ifdef DBUS_TYPE_UNIX_FD +#define XD_BASIC_DBUS_TYPE(type) \ + ((type == DBUS_TYPE_BYTE) \ + || (type == DBUS_TYPE_BOOLEAN) \ + || (type == DBUS_TYPE_INT16) \ + || (type == DBUS_TYPE_UINT16) \ + || (type == DBUS_TYPE_INT32) \ + || (type == DBUS_TYPE_UINT32) \ + || (type == DBUS_TYPE_INT64) \ + || (type == DBUS_TYPE_UINT64) \ + || (type == DBUS_TYPE_DOUBLE) \ + || (type == DBUS_TYPE_STRING) \ + || (type == DBUS_TYPE_OBJECT_PATH) \ + || (type == DBUS_TYPE_SIGNATURE) \ + || (type == DBUS_TYPE_UNIX_FD)) +#else #define XD_BASIC_DBUS_TYPE(type) \ ((type == DBUS_TYPE_BYTE) \ || (type == DBUS_TYPE_BOOLEAN) \ @@ -156,6 +182,7 @@ int xd_in_read_queued_messages = 0; || (type == DBUS_TYPE_STRING) \ || (type == DBUS_TYPE_OBJECT_PATH) \ || (type == DBUS_TYPE_SIGNATURE)) +#endif /* This was a macro. On Solaris 2.11 it was said to compile for hours, when optimzation is enabled. So we have transferred it into @@ -163,8 +190,7 @@ int xd_in_read_queued_messages = 0; /* Determine the DBusType of a given Lisp symbol. OBJECT must be one of the predefined D-Bus type symbols. */ static int -xd_symbol_to_dbus_type (object) - Lisp_Object object; +xd_symbol_to_dbus_type (Lisp_Object object) { return ((EQ (object, QCdbus_type_byte)) ? DBUS_TYPE_BYTE @@ -179,6 +205,9 @@ xd_symbol_to_dbus_type (object) : (EQ (object, QCdbus_type_string)) ? DBUS_TYPE_STRING : (EQ (object, QCdbus_type_object_path)) ? DBUS_TYPE_OBJECT_PATH : (EQ (object, QCdbus_type_signature)) ? DBUS_TYPE_SIGNATURE +#ifdef DBUS_TYPE_UNIX_FD + : (EQ (object, QCdbus_type_unix_fd)) ? DBUS_TYPE_UNIX_FD +#endif : (EQ (object, QCdbus_type_array)) ? DBUS_TYPE_ARRAY : (EQ (object, QCdbus_type_variant)) ? DBUS_TYPE_VARIANT : (EQ (object, QCdbus_type_struct)) ? DBUS_TYPE_STRUCT @@ -221,10 +250,7 @@ xd_symbol_to_dbus_type (object) signature is embedded, or DBUS_TYPE_INVALID. It is needed for the check that DBUS_TYPE_DICT_ENTRY occurs only as array element. */ static void -xd_signature (signature, dtype, parent_type, object) - char *signature; - unsigned int dtype, parent_type; - Lisp_Object object; +xd_signature (char *signature, unsigned int dtype, unsigned int parent_type, Lisp_Object object) { unsigned int subtype; Lisp_Object elt; @@ -238,6 +264,9 @@ xd_signature (signature, dtype, parent_type, object) case DBUS_TYPE_UINT16: case DBUS_TYPE_UINT32: case DBUS_TYPE_UINT64: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif CHECK_NATNUM (object); sprintf (signature, "%c", dtype); break; @@ -393,10 +422,7 @@ xd_signature (signature, dtype, parent_type, object) `dbus-send-signal', into corresponding C values appended as arguments to a D-Bus message. */ static void -xd_append_arg (dtype, object, iter) - unsigned int dtype; - Lisp_Object object; - DBusMessageIter *iter; +xd_append_arg (unsigned int dtype, Lisp_Object object, DBusMessageIter *iter) { char signature[DBUS_MAXIMUM_SIGNATURE_LENGTH]; DBusMessageIter subiter; @@ -454,6 +480,9 @@ xd_append_arg (dtype, object, iter) } case DBUS_TYPE_UINT32: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif CHECK_NUMBER (object); { dbus_uint32_t val = XUINT (object); @@ -604,9 +633,7 @@ xd_append_arg (dtype, object, iter) D-Bus message must be a valid DBusType. Compound D-Bus types result always in a Lisp list. */ static Lisp_Object -xd_retrieve_arg (dtype, iter) - unsigned int dtype; - DBusMessageIter *iter; +xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter) { switch (dtype) @@ -653,6 +680,9 @@ xd_retrieve_arg (dtype, iter) } case DBUS_TYPE_UINT32: +#ifdef DBUS_TYPE_UNIX_FD + case DBUS_TYPE_UNIX_FD: +#endif { dbus_uint32_t val; dbus_message_iter_get_basic (iter, &val); @@ -722,37 +752,79 @@ xd_retrieve_arg (dtype, iter) } } -/* Initialize D-Bus connection. BUS is a Lisp symbol, either :system - or :session. It tells which D-Bus to be initialized. */ +/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system + or :session, or a string denoting the bus address. It tells which + D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error + when the connection cannot be initialized. */ static DBusConnection * -xd_initialize (bus) - Lisp_Object bus; +xd_initialize (Lisp_Object bus, int raise_error) { DBusConnection *connection; DBusError derror; /* Parameter check. */ - CHECK_SYMBOL (bus); - if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) - XD_SIGNAL2 (build_string ("Wrong bus name"), bus); + if (!STRINGP (bus)) + { + CHECK_SYMBOL (bus); + if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) + { + if (raise_error) + XD_SIGNAL2 (build_string ("Wrong bus name"), bus); + else + return NULL; + } - /* We do not want to have an autolaunch for the session bus. */ - if (EQ (bus, QCdbus_session_bus) - && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) - XD_SIGNAL2 (build_string ("No connection to bus"), bus); + /* We do not want to have an autolaunch for the session bus. */ + if (EQ (bus, QCdbus_session_bus) + && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) + { + if (raise_error) + XD_SIGNAL2 (build_string ("No connection to bus"), bus); + else + return NULL; + } + } /* Open a connection to the bus. */ dbus_error_init (&derror); - if (EQ (bus, QCdbus_system_bus)) - connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror); + if (STRINGP (bus)) + connection = dbus_connection_open (SDATA (bus), &derror); else - connection = dbus_bus_get (DBUS_BUS_SESSION, &derror); + if (EQ (bus, QCdbus_system_bus)) + connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror); + else + connection = dbus_bus_get (DBUS_BUS_SESSION, &derror); if (dbus_error_is_set (&derror)) - XD_ERROR (derror); + { + if (raise_error) + XD_ERROR (derror); + else + connection = NULL; + } + + /* If it is not the system or session bus, we must register + ourselves. Otherwise, we have called dbus_bus_get, which has + configured us to exit if the connection closes - we undo this + setting. */ + if (connection != NULL) + { + if (STRINGP (bus)) + dbus_bus_register (connection, &derror); + else + dbus_connection_set_exit_on_disconnect (connection, FALSE); + } - if (connection == NULL) + if (dbus_error_is_set (&derror)) + { + if (raise_error) + XD_ERROR (derror); + else + connection = NULL; + } + + if (connection == NULL && raise_error) XD_SIGNAL2 (build_string ("No connection to bus"), bus); /* Cleanup. */ @@ -762,98 +834,107 @@ xd_initialize (bus) return connection; } - -/* Add connection file descriptor to input_wait_mask, in order to - let select() detect, whether a new message has been arrived. */ -dbus_bool_t -xd_add_watch (watch, data) - DBusWatch *watch; - void *data; +/* Return the file descriptor for WATCH, -1 if not found. */ +static int +xd_find_watch_fd (DBusWatch *watch) { - /* We check only for incoming data. */ - if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE) - { #if HAVE_DBUS_WATCH_GET_UNIX_FD - /* TODO: Reverse these on Win32, which prefers the opposite. */ - int fd = dbus_watch_get_unix_fd(watch); - if (fd == -1) - fd = dbus_watch_get_socket(watch); + /* TODO: Reverse these on Win32, which prefers the opposite. */ + int fd = dbus_watch_get_unix_fd (watch); + if (fd == -1) + fd = dbus_watch_get_socket (watch); #else - int fd = dbus_watch_get_fd(watch); + int fd = dbus_watch_get_fd (watch); #endif - XD_DEBUG_MESSAGE ("fd %d", fd); + return fd; +} - if (fd == -1) - return FALSE; +/* Prototype. */ +static void +xd_read_queued_messages (int fd, void *data, int for_read); - /* Add the file descriptor to input_wait_mask. */ - add_keyboard_wait_descriptor (fd); - } +/* Start monitoring WATCH for possible I/O. */ +static dbus_bool_t +xd_add_watch (DBusWatch *watch, void *data) +{ + unsigned int flags = dbus_watch_get_flags (watch); + int fd = xd_find_watch_fd (watch); - /* Return. */ + XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d", + fd, flags & DBUS_WATCH_WRITABLE, + dbus_watch_get_enabled (watch)); + + if (fd == -1) + return FALSE; + + if (dbus_watch_get_enabled (watch)) + { + if (flags & DBUS_WATCH_WRITABLE) + add_write_fd (fd, xd_read_queued_messages, data); + if (flags & DBUS_WATCH_READABLE) + add_read_fd (fd, xd_read_queued_messages, data); + } return TRUE; } -/* Remove connection file descriptor from input_wait_mask. DATA is - the used bus, either QCdbus_system_bus or QCdbus_session_bus. */ -void -xd_remove_watch (watch, data) - DBusWatch *watch; - void *data; +/* Stop monitoring WATCH for possible I/O. + DATA is the used bus, either a string or QCdbus_system_bus or + QCdbus_session_bus. */ +static void +xd_remove_watch (DBusWatch *watch, void *data) { - /* We check only for incoming data. */ - if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE) - { -#if HAVE_DBUS_WATCH_GET_UNIX_FD - /* TODO: Reverse these on Win32, which prefers the opposite. */ - int fd = dbus_watch_get_unix_fd(watch); - if (fd == -1) - fd = dbus_watch_get_socket(watch); -#else - int fd = dbus_watch_get_fd(watch); -#endif - XD_DEBUG_MESSAGE ("fd %d", fd); + unsigned int flags = dbus_watch_get_flags (watch); + int fd = xd_find_watch_fd (watch); - if (fd == -1) - return; + XD_DEBUG_MESSAGE ("fd %d", fd); - /* Unset session environment. */ - if ((data != NULL) && (data == (void*) XHASH (QCdbus_session_bus))) - { - XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); - unsetenv ("DBUS_SESSION_BUS_ADDRESS"); - } + if (fd == -1) + return; - /* Remove the file descriptor from input_wait_mask. */ - delete_keyboard_wait_descriptor (fd); + /* Unset session environment. */ + if (data != NULL && data == (void*) XHASH (QCdbus_session_bus)) + { + XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); + unsetenv ("DBUS_SESSION_BUS_ADDRESS"); } - /* Return. */ - return; + if (flags & DBUS_WATCH_WRITABLE) + delete_write_fd (fd); + if (flags & DBUS_WATCH_READABLE) + delete_read_fd (fd); +} + +/* Toggle monitoring WATCH for possible I/O. */ +static void +xd_toggle_watch (DBusWatch *watch, void *data) +{ + if (dbus_watch_get_enabled (watch)) + xd_add_watch (watch, data); + else + xd_remove_watch (watch, data); } DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, - doc: /* Initialize connection to D-Bus BUS. -This is an internal function, it shall not be used outside dbus.el. */) - (bus) - Lisp_Object bus; + doc: /* Initialize connection to D-Bus BUS. */) + (Lisp_Object bus) { DBusConnection *connection; - /* Check parameters. */ - CHECK_SYMBOL (bus); - /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Add the watch functions. We pass also the bus as data, in order to distinguish between the busses in xd_remove_watch. */ if (!dbus_connection_set_watch_functions (connection, xd_add_watch, xd_remove_watch, - NULL, (void*) XHASH (bus), NULL)) + xd_toggle_watch, + (void*) XHASH (bus), NULL)) XD_SIGNAL1 (build_string ("Cannot add watch functions")); + /* Add bus to list of registered buses. */ + Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses); + /* We do not want to abort. */ putenv ("DBUS_FATAL_WARNINGS=0"); @@ -861,20 +942,35 @@ This is an internal function, it shall not be used outside dbus.el. */) return Qnil; } +DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0, + doc: /* Close connection to D-Bus BUS. */) + (Lisp_Object bus) +{ + DBusConnection *connection; + + /* Open a connection to the bus. */ + connection = xd_initialize (bus, TRUE); + + /* Decrement reference count to the bus. */ + dbus_connection_unref (connection); + + /* Remove bus from list of registered buses. */ + Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses); + + /* Return. */ + return Qnil; +} + DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, 1, 1, 0, doc: /* Return the unique name of Emacs registered at D-Bus BUS. */) - (bus) - Lisp_Object bus; + (Lisp_Object bus) { DBusConnection *connection; const char *name; - /* Check parameters. */ - CHECK_SYMBOL (bus); - /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Request the name. */ name = dbus_bus_get_unique_name (connection); @@ -888,7 +984,8 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0, doc: /* Call METHOD on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -921,6 +1018,7 @@ input arguments. It follows the mapping rules: DBUS_TYPE_UINT16 => number DBUS_TYPE_INT16 => integer DBUS_TYPE_UINT32 => number or float + DBUS_TYPE_UNIX_FD => number or float DBUS_TYPE_INT32 => integer or float DBUS_TYPE_UINT64 => number or float DBUS_TYPE_INT64 => integer or float @@ -953,9 +1051,7 @@ object is returned instead of a list containing this single Lisp object. => "i686" usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TIMEOUT &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, service, path, interface, method; Lisp_Object result; @@ -977,7 +1073,6 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI interface = args[3]; method = args[4]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -991,7 +1086,7 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI SDATA (method)); /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create the message. */ dmessage = dbus_message_new_method_call (SDATA (service), @@ -1092,7 +1187,8 @@ DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously, Sdbus_call_method_asynchronously, 6, MANY, 0, doc: /* Call METHOD on the D-Bus BUS asynchronously. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -1137,9 +1233,7 @@ Example: -| i686 usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLER &optional :timeout TIMEOUT &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, service, path, interface, method, handler; Lisp_Object result; @@ -1160,7 +1254,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE method = args[4]; handler = args[5]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1175,12 +1268,8 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE SDATA (interface), SDATA (method)); - /* Check dbus-registered-objects-table. */ - if (!HASH_TABLE_P (Vdbus_registered_objects_table)) - XD_SIGNAL1 (build_string ("dbus.el is not loaded")); - /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create the message. */ dmessage = dbus_message_new_method_call (SDATA (service), @@ -1252,9 +1341,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE result = Qnil; } - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1271,9 +1357,7 @@ DEFUN ("dbus-method-return-internal", Fdbus_method_return_internal, This is an internal function, it shall not be used outside dbus.el. usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, serial, service; struct gcpro gcpro1, gcpro2, gcpro3; @@ -1289,7 +1373,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) serial = args[1]; service = args[2]; - CHECK_SYMBOL (bus); CHECK_NUMBER (serial); CHECK_STRING (service); GCPRO3 (bus, serial, service); @@ -1297,7 +1380,7 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service)); /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create the message. */ dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_METHOD_RETURN); @@ -1346,9 +1429,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1365,9 +1445,7 @@ DEFUN ("dbus-method-error-internal", Fdbus_method_error_internal, This is an internal function, it shall not be used outside dbus.el. usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, serial, service; struct gcpro gcpro1, gcpro2, gcpro3; @@ -1383,7 +1461,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) serial = args[1]; service = args[2]; - CHECK_SYMBOL (bus); CHECK_NUMBER (serial); CHECK_STRING (service); GCPRO3 (bus, serial, service); @@ -1391,7 +1468,7 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) XD_DEBUG_MESSAGE ("%lu %s ", (unsigned long) XUINT (serial), SDATA (service)); /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create the message. */ dmessage = dbus_message_new (DBUS_MESSAGE_TYPE_ERROR); @@ -1441,9 +1518,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1456,7 +1530,8 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0, doc: /* Send signal SIGNAL on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -1482,9 +1557,7 @@ Example: "org.gnu.Emacs.FileManager" "FileModified" "/home/albinus/.emacs") usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, service, path, interface, signal; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; @@ -1502,7 +1575,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) interface = args[3]; signal = args[4]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1516,7 +1588,7 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) SDATA (signal)); /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create the message. */ dmessage = dbus_message_new_signal (SDATA (path), @@ -1561,9 +1633,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Signal sent"); /* Cleanup. */ @@ -1573,80 +1642,26 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) return Qt; } -/* Check, whether there is pending input in the message queue of the - D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */ -static Lisp_Object -xd_get_dispatch_status (bus) - Lisp_Object bus; -{ - DBusConnection *connection; - - /* Open a connection to the bus. */ - connection = xd_initialize (bus); - - /* Non blocking read of the next available message. */ - dbus_connection_read_write (connection, 0); - - /* Return. */ - return - (dbus_connection_get_dispatch_status (connection) - == DBUS_DISPATCH_DATA_REMAINS) - ? Qt : Qnil; -} - -/* Check for queued incoming messages from the system and session buses. */ -int -xd_pending_messages () -{ - int ret = FALSE; - xd_in_read_queued_messages = 1; - - /* Vdbus_registered_objects_table will be initialized as hash table - in dbus.el. When this package isn't loaded yet, it doesn't make - sense to handle D-Bus messages. */ - if (HASH_TABLE_P (Vdbus_registered_objects_table)) - { - ret = (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status, - QCdbus_system_bus))); - if (ret) goto theend; - - ret = ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL) && - (!NILP (internal_catch (Qdbus_error, xd_get_dispatch_status, - QCdbus_session_bus)))); - } - - /* Return. */ - theend: - xd_in_read_queued_messages = 0; - return ret; -} - -/* Read queued incoming message of the D-Bus BUS. BUS is a Lisp - symbol, either :system or :session. */ -static Lisp_Object -xd_read_message (bus) - Lisp_Object bus; +/* Read one queued incoming message of the D-Bus BUS. + BUS is either a Lisp symbol, :system or :session, or a string denoting + the bus address. */ +static void +xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) { Lisp_Object args, key, value; struct gcpro gcpro1; struct input_event event; - DBusConnection *connection; DBusMessage *dmessage; DBusMessageIter iter; unsigned int dtype; int mtype, serial; const char *uname, *path, *interface, *member; - /* Open a connection to the bus. */ - connection = xd_initialize (bus); - - /* Non blocking read of the next available message. */ - dbus_connection_read_write (connection, 0); dmessage = dbus_connection_pop_message (connection); /* Return if there is no queued message. */ if (dmessage == NULL) - return Qnil; + return; /* Collect the parameters. */ args = Qnil; @@ -1777,24 +1792,157 @@ xd_read_message (bus) cleanup: dbus_message_unref (dmessage); - RETURN_UNGCPRO (Qnil); + UNGCPRO; } -/* Read queued incoming messages from the system and session buses. */ -void -xd_read_queued_messages () +/* Read queued incoming messages of the D-Bus BUS. + BUS is either a Lisp symbol, :system or :session, or a string denoting + the bus address. */ +static Lisp_Object +xd_read_message (Lisp_Object bus) +{ + /* Open a connection to the bus. */ + DBusConnection *connection = xd_initialize (bus, TRUE); + + /* Non blocking read of the next available message. */ + dbus_connection_read_write (connection, 0); + + while (dbus_connection_get_dispatch_status (connection) + != DBUS_DISPATCH_COMPLETE) + xd_read_message_1 (connection, bus); + return Qnil; +} + +/* Callback called when something is ready to read or write. */ +static void +xd_read_queued_messages (int fd, void *data, int for_read) +{ + Lisp_Object busp = Vdbus_registered_buses; + Lisp_Object bus = Qnil; + + /* Find bus related to fd. */ + if (data != NULL) + while (!NILP (busp)) + { + if (data == (void*) XHASH (CAR_SAFE (busp))) + bus = CAR_SAFE (busp); + busp = CDR_SAFE (busp); + } + + if (NILP(bus)) + return; + + /* We ignore all Lisp errors during the call. */ + xd_in_read_queued_messages = 1; + internal_catch (Qdbus_error, xd_read_message, bus); + xd_in_read_queued_messages = 0; +} + +DEFUN ("dbus-register-service", Fdbus_register_service, Sdbus_register_service, + 2, MANY, 0, + doc: /* Register known name SERVICE on the D-Bus BUS. + +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. + +SERVICE is the D-Bus service name that should be registered. It must +be a known name. + +FLAGS are keywords, which control how the service name is registered. +The following keywords are recognized: + +`:allow-replacement': Allow another service to become the primary +owner if requested. + +`:replace-existing': Request to replace the current primary owner. + +`:do-not-queue': If we can not become the primary owner do not place +us in the queue. + +The function returns a keyword, indicating the result of the +operation. One of the following keywords is returned: + +`:primary-owner': Service has become the primary owner of the +requested name. + +`:in-queue': Service could not become the primary owner and has been +placed in the queue. + +`:exists': Service is already in the queue. + +`:already-owner': Service is already the primary owner. + +Example: + +\(dbus-register-service :session dbus-service-emacs) + + => :primary-owner. + +\(dbus-register-service + :session "org.freedesktop.TextEditor" + dbus-service-allow-replacement dbus-service-replace-existing) + + => :already-owner. + +usage: (dbus-register-service BUS SERVICE &rest FLAGS) */) + (int nargs, register Lisp_Object *args) { + Lisp_Object bus, service; + struct gcpro gcpro1, gcpro2; + DBusConnection *connection; + unsigned int i; + unsigned int value; + unsigned int flags = 0; + int result; + DBusError derror; - /* Vdbus_registered_objects_table will be initialized as hash table - in dbus.el. When this package isn't loaded yet, it doesn't make - sense to handle D-Bus messages. Furthermore, we ignore all Lisp - errors during the call. */ - if (HASH_TABLE_P (Vdbus_registered_objects_table)) + bus = args[0]; + service = args[1]; + + /* Check parameters. */ + CHECK_STRING (service); + + /* Process flags. */ + for (i = 2; i < nargs; ++i) { + value = ((EQ (args[i], QCdbus_request_name_replace_existing)) + ? DBUS_NAME_FLAG_REPLACE_EXISTING + : (EQ (args[i], QCdbus_request_name_allow_replacement)) + ? DBUS_NAME_FLAG_ALLOW_REPLACEMENT + : (EQ (args[i], QCdbus_request_name_do_not_queue)) + ? DBUS_NAME_FLAG_DO_NOT_QUEUE + : -1); + if (value == -1) + XD_SIGNAL2 (build_string ("Unrecognized name request flag"), args[i]); + flags |= value; + } + + /* Open a connection to the bus. */ + connection = xd_initialize (bus, TRUE); + + /* Request the known name from the bus. */ + dbus_error_init (&derror); + result = dbus_bus_request_name (connection, SDATA (service), flags, + &derror); + if (dbus_error_is_set (&derror)) + XD_ERROR (derror); + + /* Cleanup. */ + dbus_error_free (&derror); + + /* Return object. */ + switch (result) { - xd_in_read_queued_messages = 1; - internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus); - internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus); - xd_in_read_queued_messages = 0; + case DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER: + return QCdbus_request_name_reply_primary_owner; + case DBUS_REQUEST_NAME_REPLY_IN_QUEUE: + return QCdbus_request_name_reply_in_queue; + case DBUS_REQUEST_NAME_REPLY_EXISTS: + return QCdbus_request_name_reply_exists; + case DBUS_REQUEST_NAME_REPLY_ALREADY_OWNER: + return QCdbus_request_name_reply_already_owner; + default: + /* This should not happen. */ + XD_SIGNAL2 (build_string ("Could not register service"), service); } } @@ -1802,7 +1950,8 @@ DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal, 6, MANY, 0, doc: /* Register for signal SIGNAL on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name used by the sending D-Bus object. It can be either a known name or the unique name of the D-Bus object @@ -1837,9 +1986,7 @@ INTERFACE, SIGNAL and HANDLER must not be nil. Example: `dbus-unregister-object' for removing the registration. usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARGS) */) - (nargs, args) - int nargs; - register Lisp_Object *args; + (int nargs, register Lisp_Object *args) { Lisp_Object bus, service, path, interface, signal, handler; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; @@ -1858,7 +2005,6 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG signal = args[4]; handler = args[5]; - CHECK_SYMBOL (bus); if (!NILP (service)) CHECK_STRING (service); if (!NILP (path)) CHECK_STRING (path); CHECK_STRING (interface); @@ -1867,10 +2013,6 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG wrong_type_argument (intern ("functionp"), handler); GCPRO6 (bus, service, path, interface, signal, handler); - /* Check dbus-registered-objects-table. */ - if (!HASH_TABLE_P (Vdbus_registered_objects_table)) - XD_SIGNAL1 (build_string ("dbus.el is not loaded")); - /* Retrieve unique name of service. If service is a known name, we will register for the corresponding unique name, if any. Signals are sent always with the unique name as sender. Note: the unique @@ -1894,7 +2036,7 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG if (NILP (uname) || (SBYTES (uname) > 0)) { /* Open a connection to the bus. */ - connection = xd_initialize (bus); + connection = xd_initialize (bus, TRUE); /* Create a rule to receive related signals. */ sprintf (rule, @@ -1952,29 +2094,38 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG } 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 the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name of the D-Bus object METHOD is -registered for. It must be a known name. - -PATH is the D-Bus object path SERVICE is registered. INTERFACE is the -interface offered by SERVICE. It must provide METHOD. HANDLER is a -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. */) - (bus, service, path, interface, method, handler) - Lisp_Object bus, service, path, interface, method, handler; +registered for. It must be a known name (See discussion of +DONT-REGISTER-SERVICE below). + +PATH is the D-Bus object path SERVICE is registered (See discussion of +DONT-REGISTER-SERVICE below). INTERFACE is the interface offered by +SERVICE. It must provide METHOD. HANDLER is a 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. + +When DONT-REGISTER-SERVICE is non-nil, the known name SERVICE is not +registered. This means that other D-Bus clients have no way of +noticing the newly registered method. When interfaces are constructed +incrementally by adding single methods or properties at a time, +DONT-REGISTER-SERVICE can be use to prevent other clients from +discovering the still incomplete interface.*/) + (Lisp_Object bus, Lisp_Object service, Lisp_Object path, + Lisp_Object interface, Lisp_Object method, Lisp_Object handler, + Lisp_Object dont_register_service) { Lisp_Object key, key1, value; - DBusConnection *connection; - int result; DBusError derror; + Lisp_Object args[2] = { bus, service }; /* Check parameters. */ - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1984,19 +2135,9 @@ used for composing the returning D-Bus message. */) /* TODO: We must check for a valid service name, otherwise there is a segmentation fault. */ - /* Check dbus-registered-objects-table. */ - if (!HASH_TABLE_P (Vdbus_registered_objects_table)) - XD_SIGNAL1 (build_string ("dbus.el is not loaded")); - - /* Open a connection to the bus. */ - connection = xd_initialize (bus); - - /* 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); + /* Request the name. */ + if (NILP (dont_register_service)) + Fdbus_register_service (2, args); /* Create a hash table entry. We use nil for the unique name, because the method might be called from anybody. */ @@ -2007,22 +2148,23 @@ used for composing the returning D-Bus message. */) 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)); } void -syms_of_dbusbind () +syms_of_dbusbind (void) { Qdbus_init_bus = intern_c_string ("dbus-init-bus"); staticpro (&Qdbus_init_bus); defsubr (&Sdbus_init_bus); + Qdbus_close_bus = intern_c_string ("dbus-close-bus"); + staticpro (&Qdbus_close_bus); + defsubr (&Sdbus_close_bus); + Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name"); staticpro (&Qdbus_get_unique_name); defsubr (&Sdbus_get_unique_name); @@ -2047,6 +2189,10 @@ syms_of_dbusbind () staticpro (&Qdbus_send_signal); defsubr (&Sdbus_send_signal); + Qdbus_register_service = intern_c_string ("dbus-register-service"); + staticpro (&Qdbus_register_service); + defsubr (&Sdbus_register_service); + Qdbus_register_signal = intern_c_string ("dbus-register-signal"); staticpro (&Qdbus_register_signal); defsubr (&Sdbus_register_signal); @@ -2068,6 +2214,27 @@ syms_of_dbusbind () QCdbus_session_bus = intern_c_string (":session"); staticpro (&QCdbus_session_bus); + QCdbus_request_name_allow_replacement = intern_c_string (":allow-replacement"); + staticpro (&QCdbus_request_name_allow_replacement); + + QCdbus_request_name_replace_existing = intern_c_string (":replace-existing"); + staticpro (&QCdbus_request_name_replace_existing); + + QCdbus_request_name_do_not_queue = intern_c_string (":do-not-queue"); + staticpro (&QCdbus_request_name_do_not_queue); + + QCdbus_request_name_reply_primary_owner = intern_c_string (":primary-owner"); + staticpro (&QCdbus_request_name_reply_primary_owner); + + QCdbus_request_name_reply_exists = intern_c_string (":exists"); + staticpro (&QCdbus_request_name_reply_exists); + + QCdbus_request_name_reply_in_queue = intern_c_string (":in-queue"); + staticpro (&QCdbus_request_name_reply_in_queue); + + QCdbus_request_name_reply_already_owner = intern_c_string (":already-owner"); + staticpro (&QCdbus_request_name_reply_already_owner); + QCdbus_timeout = intern_c_string (":timeout"); staticpro (&QCdbus_timeout); @@ -2107,6 +2274,11 @@ syms_of_dbusbind () QCdbus_type_signature = intern_c_string (":signature"); staticpro (&QCdbus_type_signature); +#ifdef DBUS_TYPE_UNIX_FD + QCdbus_type_unix_fd = intern_c_string (":unix-fd"); + staticpro (&QCdbus_type_unix_fd); +#endif + QCdbus_type_array = intern_c_string (":array"); staticpro (&QCdbus_type_array); @@ -2119,18 +2291,25 @@ syms_of_dbusbind () QCdbus_type_dict_entry = intern_c_string (":dict-entry"); staticpro (&QCdbus_type_dict_entry); + DEFVAR_LISP ("dbus-registered-buses", + Vdbus_registered_buses, + doc: /* List of D-Bus buses we are polling for messages. */); + Vdbus_registered_buses = Qnil; + DEFVAR_LISP ("dbus-registered-objects-table", - &Vdbus_registered_objects_table, + Vdbus_registered_objects_table, doc: /* Hash table of registered functions for D-Bus. + There are two different uses of the hash table: for accessing registered interfaces properties, targeted by signals or method calls, 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 (BUS -INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol -`:session'. 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. +INTERFACE MEMBER). 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. The value in the hash table is a list of quadruple lists \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...). @@ -2142,17 +2321,20 @@ be called when a D-Bus message, which matches the key criteria, arrives (methods and signals), or a cons cell containing the value of the property. -In the second case, the key in the hash table is the list (BUS SERIAL). -BUS is either the symbol `:system' or the symbol `:session'. SERIAL -is the serial number of the non-blocking method call, a reply is -expected. Both arguments must not be nil. The value in the hash -table is HANDLER, the function to be called when the D-Bus reply -message arrives. */); - /* We initialize Vdbus_registered_objects_table in dbus.el, because - we need to define a hash table function first. */ - Vdbus_registered_objects_table = Qnil; - - DEFVAR_LISP ("dbus-debug", &Vdbus_debug, +In the second case, the key in the hash table is the list (BUS +SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a +string denoting the bus address. SERIAL is the serial number of the +non-blocking method call, a reply is expected. Both arguments must +not be nil. The value in the hash table is HANDLER, the function to +be called when the D-Bus reply message arrives. */); + { + Lisp_Object args[2]; + args[0] = QCtest; + args[1] = Qequal; + Vdbus_registered_objects_table = Fmake_hash_table (2, args); + } + + DEFVAR_LISP ("dbus-debug", Vdbus_debug, doc: /* If non-nil, debug messages of D-Bus bindings are raised. */); #ifdef DBUS_DEBUG Vdbus_debug = Qt; @@ -2169,5 +2351,3 @@ message arrives. */); #endif /* HAVE_DBUS */ -/* arch-tag: 0e828477-b571-4fe4-b559-5c9211bc14b8 - (do not change this comment) */