mirrored from git://git.sv.gnu.org/emacs.git
-
Notifications
You must be signed in to change notification settings - Fork 1.3k
/
Copy pathdbus.el
2311 lines (1980 loc) · 87.6 KB
/
dbus.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; dbus.el --- Elisp bindings for D-Bus. -*- lexical-binding: t -*-
;; Copyright (C) 2007-2025 Free Software Foundation, Inc.
;; Author: Michael Albinus <[email protected]>
;; Keywords: comm, hardware
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides language bindings for the D-Bus API. D-Bus
;; is a message bus system, a simple way for applications to talk to
;; one another. See <https://dbus.freedesktop.org/> for details.
;; Low-level language bindings are implemented in src/dbusbind.c.
;; D-Bus support in the Emacs core can be disabled with configuration
;; option "--without-dbus".
;;; Code:
;; Declare used subroutines and variables.
(declare-function dbus-message-internal "dbusbind.c")
(declare-function dbus--init-bus "dbusbind.c")
(declare-function libxml-parse-xml-region "xml.c")
(defvar dbus-debug)
(defvar dbus-message-type-invalid)
(defvar dbus-message-type-method-call)
(defvar dbus-message-type-method-return)
(defvar dbus-message-type-error)
(defvar dbus-message-type-signal)
(defvar dbus-registered-objects-table)
;; The following symbols are defined in dbusbind.c. We need them also
;; when Emacs is compiled without D-Bus support.
(unless (boundp 'dbus-error)
(define-error 'dbus-error "D-Bus error"))
(unless (boundp 'dbus-debug)
(defvar dbus-debug nil))
(require 'cl-lib)
(require 'seq)
(require 'subr-x)
(require 'xml)
;;; D-Bus constants.
(defconst dbus-compound-types '(:array :variant :struct :dict-entry)
"D-Bus compound types, represented as list.")
(defconst dbus-service-dbus "org.freedesktop.DBus"
"The bus name used to talk to the bus itself.")
(defconst dbus-path-dbus "/org/freedesktop/DBus"
"The object path used to talk to the bus itself.")
(defconst dbus-path-local (concat dbus-path-dbus "/Local")
"The object path used in local/in-process-generated messages.")
;;; Default D-Bus interfaces.
(defconst dbus-interface-dbus "org.freedesktop.DBus"
"The interface exported by the service `dbus-service-dbus'.")
(defconst dbus-interface-peer (concat dbus-interface-dbus ".Peer")
"The interface for peer objects.
See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-peer'.")
;; <interface name="org.freedesktop.DBus.Peer">
;; <method name="Ping">
;; </method>
;; <method name="GetMachineId">
;; <arg name="machine_uuid" type="s" direction="out"/>
;; </method>
;; </interface>
(defconst dbus-interface-introspectable
(concat dbus-interface-dbus ".Introspectable")
"The interface supported by introspectable objects.
See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-introspectable'.")
;; <interface name="org.freedesktop.DBus.Introspectable">
;; <method name="Introspect">
;; <arg name="data" type="s" direction="out"/>
;; </method>
;; </interface>
(defconst dbus-interface-properties (concat dbus-interface-dbus ".Properties")
"The interface for property objects.
See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-properties'.")
;; <interface name="org.freedesktop.DBus.Properties">
;; <method name="Get">
;; <arg name="interface" type="s" direction="in"/>
;; <arg name="propname" type="s" direction="in"/>
;; <arg name="value" type="v" direction="out"/>
;; </method>
;; <method name="Set">
;; <arg name="interface" type="s" direction="in"/>
;; <arg name="propname" type="s" direction="in"/>
;; <arg name="value" type="v" direction="in"/>
;; </method>
;; <method name="GetAll">
;; <arg name="interface" type="s" direction="in"/>
;; <arg name="props" type="a{sv}" direction="out"/>
;; </method>
;; <signal name="PropertiesChanged">
;; <arg name="interface" type="s"/>
;; <arg name="changed_properties" type="a{sv}"/>
;; <arg name="invalidated_properties" type="as"/>
;; </signal>
;; </interface>
(defconst dbus-interface-objectmanager
(concat dbus-interface-dbus ".ObjectManager")
"The object manager interface.
See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#standard-interfaces-objectmanager'.")
;; <interface name="org.freedesktop.DBus.ObjectManager">
;; <method name="GetManagedObjects">
;; <arg name="object_paths_interfaces_and_properties"
;; type="a{oa{sa{sv}}}" direction="out"/>
;; </method>
;; <signal name="InterfacesAdded">
;; <arg name="object_path" type="o"/>
;; <arg name="interfaces_and_properties" type="a{sa{sv}}"/>
;; </signal>
;; <signal name="InterfacesRemoved">
;; <arg name="object_path" type="o"/>
;; <arg name="interfaces" type="as"/>
;; </signal>
;; </interface>
(defconst dbus-interface-monitoring (concat dbus-interface-dbus ".Monitoring")
"The monitoring interface.
See URL `https://dbus.freedesktop.org/doc/dbus-specification.html#bus-messages-become-monitor'.")
;; <interface name="org.freedesktop.DBus.Monitoring">
;; <method name="BecomeMonitor">
;; <arg name="rule" type="as" direction="in"/>
;; <arg name="flags" type="u" direction="in"/> ;; Not used, must be 0.
;; </method>
;; </interface>
(defconst dbus-interface-local (concat dbus-interface-dbus ".Local")
"An interface whose methods can only be invoked by the local implementation.")
;; <interface name="org.freedesktop.DBus.Local">
;; <signal name="Disconnected">
;; <arg name="object_path" type="o"/>
;; </signal>
;; </interface>
(defconst dbus-annotation-deprecated (concat dbus-interface-dbus ".Deprecated")
"An annotation indicating a deprecated interface, method, signal, or property.")
;;; Default D-Bus errors.
(defgroup dbus nil
"Elisp bindings for D-Bus."
:group 'comm
:link '(custom-manual "(dbus)Top")
:version "28.1")
(defconst dbus-error-dbus "org.freedesktop.DBus.Error"
"The namespace for default error names.
See /usr/include/dbus-1.0/dbus/dbus-protocol.h.")
(defconst dbus-error-access-denied (concat dbus-error-dbus ".AccessDenied")
"Security restrictions don't allow doing what you're trying to do.")
(defconst dbus-error-disconnected (concat dbus-error-dbus ".Disconnected")
"The connection is disconnected and you're trying to use it.")
(defconst dbus-error-failed (concat dbus-error-dbus ".Failed")
"A generic error; \"something went wrong\" - see the error message for more.")
(defconst dbus-error-interactive-authorization-required
(concat dbus-error-dbus ".InteractiveAuthorizationRequired")
"Interactive authentication required.")
(defconst dbus-error-invalid-args (concat dbus-error-dbus ".InvalidArgs")
"Invalid arguments passed to a method call.")
(defconst dbus-error-no-reply (concat dbus-error-dbus ".NoReply")
"No reply to a message expecting one, usually means a timeout occurred.")
(defconst dbus-error-property-read-only
(concat dbus-error-dbus ".PropertyReadOnly")
"Property you tried to set is read-only.")
(defconst dbus-error-service-unknown (concat dbus-error-dbus ".ServiceUnknown")
"The bus doesn't know how to launch a service to supply the bus name you wanted.")
(defconst dbus-error-unknown-interface
(concat dbus-error-dbus ".UnknownInterface")
"Interface you invoked a method on isn't known by the object.")
(defconst dbus-error-unknown-method (concat dbus-error-dbus ".UnknownMethod")
"Method name you invoked isn't known by the object you invoked it on.")
(defconst dbus-error-unknown-object (concat dbus-error-dbus ".UnknownObject")
"Object you invoked a method on isn't known.")
(defconst dbus-error-unknown-property (concat dbus-error-dbus ".UnknownProperty")
"Property you tried to access isn't known by the object.")
;;; Emacs defaults.
(defconst dbus-service-emacs "org.gnu.Emacs"
"The well known service name of Emacs.")
(defconst dbus-path-emacs "/org/gnu/Emacs"
"The object path namespace used by Emacs.
All object paths provided by the service `dbus-service-emacs'
shall be subdirectories of this path.")
(defconst dbus-interface-emacs "org.gnu.Emacs"
"The interface namespace used by Emacs.")
;;; Basic D-Bus message functions.
(defmacro dbus-ignore-errors (&rest body)
"Execute BODY; signal D-Bus error when `dbus-debug' is non-nil.
Otherwise, return result of last form in BODY, or all other errors."
(declare (indent 0) (debug t))
`(condition-case err
(progn ,@body)
(dbus-error (when dbus-debug (signal (car err) (cdr err))))))
(defvar dbus-event-error-functions
'(dbus-notice-synchronous-call-errors
dbus-warn-interactive-authorization-required)
"Functions to be called when a D-Bus error happens in the event handler.
Every function must accept two arguments, the event and the error variable
caught in `condition-case' by `dbus-error'.")
(defvar dbus-return-values-table (make-hash-table :test #'equal)
"Hash table for temporarily storing arguments of reply messages.
A key in this hash table is a list (:serial BUS SERIAL), like in
`dbus-registered-objects-table'. BUS is either a Lisp keyword,
`:system' or `:session', or a string denoting the bus address.
SERIAL is the serial number of the reply message.
The value of an entry is a cons (STATE . RESULT). STATE can be
either `:pending' (we are still waiting for the result),
`:complete' (the result is available) or `:error' (the reply
message was an error message).")
(defun dbus-call-method-handler (&rest args)
"Handler for reply messages of asynchronous D-Bus message calls.
It calls the function stored in `dbus-registered-objects-table'.
The result will be made available in `dbus-return-values-table'."
(let* ((key (list :serial
(dbus-event-bus-name last-input-event)
(dbus-event-serial-number last-input-event)))
(result (gethash key dbus-return-values-table)))
(when (consp result)
(setcar result :complete)
(setcdr result (if (length= args 1) (car args) args)))))
(defun dbus-notice-synchronous-call-errors (ev er)
"Detect errors resulting from pending synchronous calls."
(let* ((key (list :serial
(dbus-event-bus-name ev)
(dbus-event-serial-number ev)))
(result (gethash key dbus-return-values-table)))
(when (consp result)
(setcar result :error)
(setcdr result er))))
(defun dbus-warn-interactive-authorization-required (ev er)
"Detect `dbus-error-interactive-authorization-required'."
(when (string-equal (cadr er) dbus-error-interactive-authorization-required)
(lwarn 'dbus :warning "%S" (cdr er))
(let* ((key (list :serial
(dbus-event-bus-name ev)
(dbus-event-serial-number ev)))
(result (gethash key dbus-return-values-table)))
(when (consp result)
(setcar result :complete)
(setcdr result nil)))))
(defun dbus-call-method (bus service path interface method &rest args)
"Call METHOD on the D-Bus BUS.
BUS is either a Lisp keyword, `: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
offered by SERVICE. It must provide METHOD.
If the parameter `:timeout' is given, the following integer
TIMEOUT specifies the maximum number of milliseconds before the
method call must return. The default value is 25,000. If the
method call doesn't return in time, a D-Bus error is raised.
If the parameter `:authorizable' is given and the following AUTH
is non-nil, the invoked method may interactively prompt the user
for authorization. The default is nil.
All other arguments ARGS are passed to METHOD as arguments. They are
converted into D-Bus types via the following rules:
t and nil => DBUS_TYPE_BOOLEAN
number => DBUS_TYPE_UINT32
integer => DBUS_TYPE_INT32
float => DBUS_TYPE_DOUBLE
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
All arguments can be preceded by a type keyword. For details
about type keywords, see Info node `(dbus)Type Conversion'.
`dbus-call-method' returns the resulting values of METHOD as a list of
Lisp objects. The type conversion happens the other direction as for
input arguments. It follows the mapping rules:
DBUS_TYPE_BOOLEAN => t or nil
DBUS_TYPE_BYTE => natural number
DBUS_TYPE_UINT16 => natural number
DBUS_TYPE_INT16 => integer
DBUS_TYPE_UINT32 => natural number
DBUS_TYPE_UNIX_FD => natural number
DBUS_TYPE_INT32 => integer
DBUS_TYPE_UINT64 => natural number
DBUS_TYPE_INT64 => integer
DBUS_TYPE_DOUBLE => float
DBUS_TYPE_STRING => string
DBUS_TYPE_OBJECT_PATH => string
DBUS_TYPE_SIGNATURE => string
DBUS_TYPE_ARRAY => list
DBUS_TYPE_VARIANT => list
DBUS_TYPE_STRUCT => list
DBUS_TYPE_DICT_ENTRY => list
Example:
\(dbus-call-method
:session \"org.gnome.seahorse\" \"/org/gnome/seahorse/keys/openpgp\"
\"org.gnome.seahorse.Keys\" \"GetKeyField\"
\"openpgp:657984B8C7A966DD\" \"simple-name\")
=> (t (\"Philip R. Zimmermann\"))
If the result of the METHOD call is just one value, the converted Lisp
object is returned instead of a list containing this single Lisp object.
\(dbus-call-method
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
\"org.freedesktop.Hal.Device\" \"GetPropertyString\"
\"system.kernel.machine\")
=> \"i686\""
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (stringp path)
(signal 'wrong-type-argument (list 'stringp path)))
(or (stringp interface)
(signal 'wrong-type-argument (list 'stringp interface)))
(or (stringp method)
(signal 'wrong-type-argument (list 'stringp method)))
(let ((timeout (plist-get args :timeout))
(check-interval 0.001)
(key
(apply
#'dbus-message-internal dbus-message-type-method-call
bus service path interface method #'dbus-call-method-handler args))
(result (cons :pending nil)))
;; Wait until `dbus-call-method-handler' has put the result into
;; `dbus-return-values-table'. If no timeout is given, use the
;; default 25". Events which are not from D-Bus must be restored.
;; `read-event' performs a redisplay. This must be suppressed; it
;; hurts when reading D-Bus events asynchronously.
;; Work around bug#16775 by busy-waiting with gradual backoff for
;; dbus calls to complete. A better approach would involve either
;; adding arbitrary wait condition support to read-event or
;; restructuring dbus as a kind of process object. Poll at most
;; about once per second for completion.
(puthash key result dbus-return-values-table)
(unwind-protect
(progn
(with-timeout
((if timeout (/ timeout 1000.0) 25)
(signal 'dbus-error `(,dbus-error-no-reply "Call timed out")))
(while (eq (car result) :pending)
(let ((event (let ((inhibit-redisplay t) unread-command-events)
(read-event nil nil check-interval))))
(when event
(if (ignore-errors (dbus-check-event event))
(setf result (gethash key dbus-return-values-table))
(setf unread-command-events
(nconc unread-command-events
(cons event nil)))))
(when (< check-interval 1)
(setf check-interval (* check-interval 1.05))))))
(when (eq (car result) :error)
(signal (cadr result) (cddr result)))
(cdr result))
(remhash key dbus-return-values-table))))
(defun dbus-call-method-asynchronously
(bus service path interface method handler &rest args)
"Call METHOD on the D-Bus BUS asynchronously.
BUS is either a Lisp keyword, `: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
offered by SERVICE. It must provide METHOD.
HANDLER is a Lisp function, which is called when the corresponding
return message has arrived. If HANDLER is nil, no return message
will be expected.
If the parameter `:timeout' is given, the following integer
TIMEOUT specifies the maximum number of milliseconds before the
method call must return. The default value is 25,000. If the
method call doesn't return in time, a D-Bus error is raised.
If the parameter `:authorizable' is given and the following AUTH
is non-nil, the invoked method may interactively prompt the user
for authorization. The default is nil.
All other arguments ARGS are passed to METHOD as arguments. They are
converted into D-Bus types via the following rules:
t and nil => DBUS_TYPE_BOOLEAN
number => DBUS_TYPE_UINT32
integer => DBUS_TYPE_INT32
float => DBUS_TYPE_DOUBLE
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
All arguments can be preceded by a type keyword. For details
about type keywords, see Info node `(dbus)Type Conversion'.
If HANDLER is a Lisp function, the function returns a key into the
hash table `dbus-registered-objects-table'. The corresponding entry
in the hash table is removed, when the return message arrives,
and HANDLER is called.
Example:
\(dbus-call-method-asynchronously
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/devices/computer\"
\"org.freedesktop.Hal.Device\" \"GetPropertyString\" #\\='message
\"system.kernel.machine\")
-| i686
=> (:serial :system 2)"
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (stringp path)
(signal 'wrong-type-argument (list 'stringp path)))
(or (stringp interface)
(signal 'wrong-type-argument (list 'stringp interface)))
(or (stringp method)
(signal 'wrong-type-argument (list 'stringp method)))
(or (null handler) (functionp handler)
(signal 'wrong-type-argument (list 'functionp handler)))
(apply #'dbus-message-internal dbus-message-type-method-call
bus service path interface method handler args))
(defun dbus-send-signal (bus service path interface signal &rest args)
"Send signal SIGNAL on the D-Bus BUS.
BUS is either a Lisp keyword, `:system' or `:session', or a
string denoting the bus address. The signal is sent from the
D-Bus object Emacs is registered at BUS.
SERVICE is the D-Bus name SIGNAL is sent to. It can be either a known
name or a unique name. If SERVICE is nil, the signal is sent as
broadcast message. PATH is the D-Bus object path SIGNAL is sent from.
INTERFACE is an interface available at PATH. It must provide signal
SIGNAL.
All other arguments ARGS are passed to SIGNAL as arguments. They are
converted into D-Bus types via the following rules:
t and nil => DBUS_TYPE_BOOLEAN
number => DBUS_TYPE_UINT32
integer => DBUS_TYPE_INT32
float => DBUS_TYPE_DOUBLE
string => DBUS_TYPE_STRING
list => DBUS_TYPE_ARRAY
All arguments can be preceded by a type keyword. For details
about type keywords, see Info node `(dbus)Type Conversion'.
Example:
\(dbus-send-signal
:session nil \"/org/gnu/Emacs\" \"org.gnu.Emacs.FileManager\"
\"FileModified\" \"/home/albinus/.emacs\")"
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (null service) (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (stringp path)
(signal 'wrong-type-argument (list 'stringp path)))
(or (stringp interface)
(signal 'wrong-type-argument (list 'stringp interface)))
(or (stringp signal)
(signal 'wrong-type-argument (list 'stringp signal)))
(apply #'dbus-message-internal dbus-message-type-signal
bus service path interface signal args))
(defun dbus-method-return-internal (bus service serial &rest args)
"Return for message SERIAL on the D-Bus BUS.
This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
(apply #'dbus-message-internal dbus-message-type-method-return
bus service serial args))
(defun dbus-method-error-internal (bus service serial error-name &rest args)
"Return error message for message SERIAL on the D-Bus BUS.
ERROR-NAME must belong to the \"org.freedesktop.DBus.Error\" namespace.
This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(or (natnump serial)
(signal 'wrong-type-argument (list 'natnump serial)))
(apply #'dbus-message-internal dbus-message-type-error
bus service serial error-name args))
(defun dbus-check-arguments (bus service &rest args)
"Check arguments ARGS by side effect.
BUS, SERVICE and ARGS have the same format as in `dbus-call-method'.
Any wrong argument triggers a D-Bus error. Otherwise, return t.
This is an internal function, it shall not be used outside dbus.el."
(or (featurep 'dbusbind)
(signal 'dbus-error (list "Emacs not compiled with dbus support")))
(or (memq bus '(:system :session :system-private :session-private))
(stringp bus)
(signal 'wrong-type-argument (list 'keywordp bus)))
(or (stringp service)
(signal 'wrong-type-argument (list 'stringp service)))
(apply #'dbus-message-internal dbus-message-type-invalid bus service args))
;;; Hash table of registered functions.
(defun dbus-list-hash-table ()
"Return all registered member registrations to D-Bus.
The return value is a list, with elements of kind (KEY . VALUE).
See `dbus-registered-objects-table' for a description of the
hash table."
(let (result)
(maphash
(lambda (key value) (push (cons key value) result))
dbus-registered-objects-table)
result))
(defun dbus-setenv (bus variable value)
"Set the value of the BUS environment variable named VARIABLE to VALUE.
BUS is either a Lisp keyword, `:system' or `:session', or a
string denoting the bus address. Both VARIABLE and VALUE should
be strings.
Normally, services inherit the environment of the BUS daemon. This
function adds to or modifies that environment when activating services.
Some bus instances, such as `:system', may disable setting the environment."
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus
dbus-interface-dbus "UpdateActivationEnvironment"
`(:array (:dict-entry ,variable ,value))))
(defun dbus-register-service (bus service &rest flags)
"Register known name SERVICE on the D-Bus BUS.
BUS is either a Lisp keyword, `: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."
;; Add Peer handler.
(dbus-register-method
bus service nil dbus-interface-peer "Ping"
#'dbus-peer-handler 'dont-register)
;; Add ObjectManager handler.
(dbus-register-method
bus service nil dbus-interface-objectmanager "GetManagedObjects"
#'dbus-managed-objects-handler 'dont-register)
(let ((arg 0)
reply)
(dolist (flag flags)
(setq arg
(+ arg
(pcase flag
(:allow-replacement 1)
(:replace-existing 2)
(:do-not-queue 4)
(_ (signal 'wrong-type-argument (list flag)))))))
(setq reply (dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"RequestName" service arg))
(pcase reply
(1 :primary-owner)
(2 :in-queue)
(3 :exists)
(4 :already-owner)
(_ (signal 'dbus-error (list "Could not register service" service))))))
(defun dbus-unregister-service (bus service)
"Unregister all objects related to SERVICE from D-Bus BUS.
BUS is either a Lisp keyword, `:system' or `:session', or a
string denoting the bus address. SERVICE must be a known service
name.
The function returns a keyword, indicating the result of the
operation. One of the following keywords is returned:
`:released': We successfully released the service.
`:non-existent': Service name does not exist on this bus.
`:not-owner': We are neither the primary owner nor waiting in the
queue of this service.
When SERVICE is not a known name but a unique name, the function returns nil."
(maphash
(lambda (key value)
(unless (eq :serial (car key))
(dolist (elt value)
(ignore-errors
(when (and (equal bus (cadr key)) (string-equal service (cadr elt)))
(unless
(puthash key (delete elt value) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table)))))))
dbus-registered-objects-table)
(unless (string-prefix-p ":" service)
(let ((reply (dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"ReleaseName" service)))
(pcase reply
(1 :released)
(2 :non-existent)
(3 :not-owner)
(_ (signal
'dbus-error (list "Could not unregister service" service)))))))
(defun dbus-register-signal
(bus service path interface signal handler &rest args)
"Register for a signal on the D-Bus BUS.
BUS is either a Lisp keyword, `: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
sending the signal.
PATH is the D-Bus object path SERVICE is registered at.
INTERFACE is an interface offered by SERVICE. It must provide
SIGNAL. HANDLER is a Lisp function to be called when the signal
is received. It must accept as arguments the values SIGNAL is
sending.
SERVICE, PATH, INTERFACE and SIGNAL can be nil. This is
interpreted as a wildcard for the respective argument.
The remaining arguments ARGS can be keywords or keyword string pairs.
Their meaning is as follows:
`:argN' STRING:
`:pathN' STRING: This stands for the Nth argument of the
signal. `:pathN' arguments can be used for object path wildcard
matches as specified by D-Bus, while an `:argN' argument
requires an exact match.
`:arg-namespace' STRING: Register for those signals, whose first
argument names a service or interface within the namespace
STRING.
`:path-namespace' STRING: Register for the object path namespace
STRING. All signals sent from an object path, which has STRING as
the preceding string, are matched. This requires PATH to be nil.
`:eavesdrop': Register for unicast signals which are not directed
to the D-Bus object Emacs is registered at D-Bus BUS, if the
security policy of BUS allows this.
Example:
\(defun my-signal-handler (device)
(message \"Device %s added\" device))
\(dbus-register-signal
:system \"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\"
\"org.freedesktop.Hal.Manager\" \"DeviceAdded\" #\\='my-signal-handler)
=> ((:signal :system \"org.freedesktop.Hal.Manager\" \"DeviceAdded\")
(\"org.freedesktop.Hal\" \"/org/freedesktop/Hal/Manager\" my-signal-handler))
`dbus-register-signal' returns an object, which can be used in
`dbus-unregister-object' for removing the registration."
(let ((counter 0)
(rule "type='signal'")
uname key key1 value)
;; 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 name of `dbus-service-dbus' is that string itself.
(if (and (stringp service)
(length> service 0)
(not (string-equal service dbus-service-dbus))
(/= (string-to-char service) ?:))
(setq uname (dbus-get-name-owner bus service))
(setq uname service))
(setq rule (concat rule
(when uname (format ",sender='%s'" uname))
(when interface (format ",interface='%s'" interface))
(when signal (format ",member='%s'" signal))
(when path (format ",path='%s'" path))))
;; Add arguments to the rule.
(if (or (stringp (car args)) (null (car args)))
;; As backward compatibility option, we allow just strings.
(dolist (arg args)
(if (stringp arg)
(setq rule (concat rule (format ",arg%d='%s'" counter arg)))
(if arg (signal 'wrong-type-argument (list "Wrong argument" arg))))
(setq counter (1+ counter)))
;; Parse keywords.
(while args
(setq
key (car args)
rule (concat
rule
(cond
;; `:arg0' .. `:arg63', `:path0' .. `:path63'.
((and (keywordp key)
(string-match
"\\`:\\(arg\\|path\\)\\([[:digit:]]+\\)\\'"
(symbol-name key)))
(setq counter (match-string 2 (symbol-name key))
args (cdr args)
value (car args))
(unless (and (<= (string-to-number counter) 63)
(stringp value))
(signal 'wrong-type-argument
(list "Wrong argument" key value)))
(format
",arg%s%s='%s'"
counter
(if (string-equal (match-string 1 (symbol-name key)) "path")
"path" "")
value))
;; `:arg-namespace', `:path-namespace'.
((memq key '(:arg-namespace :path-namespace))
(setq args (cdr args)
value (car args))
(unless (stringp value)
(signal 'wrong-type-argument
(list "Wrong argument" key value)))
(format
",%s='%s'"
(if (eq key :path-namespace) "path_namespace" "arg0namespace")
value))
;; `:eavesdrop'.
((eq key :eavesdrop)
",eavesdrop='true'")
(t (signal 'wrong-type-argument (list "Wrong argument" key)))))
args (cdr args))))
;; Add the rule to the bus.
(condition-case err
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule)
(dbus-error
(if (not (string-match-p "eavesdrop" rule))
(signal (car err) (cdr err))
;; The D-Bus spec says we shall fall back to a rule without eavesdrop.
(when dbus-debug (message "Removing eavesdrop from rule %s" rule))
(setq rule (replace-regexp-in-string ",eavesdrop='true'" "" rule t t))
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"AddMatch" rule))))
(when dbus-debug (message "Matching rule \"%s\" created" rule))
;; Create a hash table entry.
(setq key (list :signal bus interface signal)
key1 (list uname service path handler rule)
value (gethash key dbus-registered-objects-table))
(unless (member key1 value)
(puthash key (cons key1 value) dbus-registered-objects-table))
;; Return the object.
(list key (list service path handler))))
(defun dbus-register-method
(bus service path interface method handler &optional dont-register-service)
"Register METHOD on the D-Bus BUS.
BUS is either a Lisp keyword, `: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 (see discussion of
DONT-REGISTER-SERVICE below).
PATH is the D-Bus object path SERVICE is registered at (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. If HANDLER returns a reply message with an empty
argument list, HANDLER must return the keyword `:ignore' in order
to distinguish it from nil (the boolean false).
If HANDLER detects an error, it shall return the list `(:error
ERROR-NAME ERROR-MESSAGE)'. ERROR-NAME is a namespaced string
which characterizes the error type, and ERROR-MESSAGE is a free
text string. Alternatively, any Emacs signal `dbus-error' in
HANDLER raises a D-Bus error message with the error name
\"org.freedesktop.DBus.Error.Failed\".
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 used to prevent other clients from
discovering the still incomplete interface."
;; Register SERVICE.
(unless (or dont-register-service
(member service (dbus-list-names bus)))
(dbus-register-service bus service))
;; Create a hash table entry. We use nil for the unique name,
;; because the method might be called from anybody.
(let* ((key (list :method bus interface method))
(key1 (list nil service path handler))
(value (gethash key dbus-registered-objects-table)))
(unless (member key1 value)
(puthash key (cons key1 value) dbus-registered-objects-table))
;; Return the object.
(list key (list service path handler))))
(defun dbus-unregister-object (object)
"Unregister OBJECT from D-Bus.
OBJECT must be the result of a preceding `dbus-register-method',
`dbus-register-signal', `dbus-register-property' or
`dbus-register-monitor' call. The function returns t if OBJECT
has been unregistered, nil otherwise.
When OBJECT identifies the last method or property, which is
registered for the respective service, Emacs releases its
association to the service from D-Bus."
;; Check parameter.
(unless (and (consp object) (not (null (car object))) (consp (cdr object)))
(signal 'wrong-type-argument (list 'D-Bus object)))
;; Find the corresponding entry in the hash table.
(let* ((key (car object))
(type (car key))
(bus (cadr key))
(value (cadr object))
(service (car value))
(entry (gethash key dbus-registered-objects-table))
ret)
;; key has the structure (TYPE BUS INTERFACE MEMBER).
;; value has the structure (SERVICE PATH [HANDLER]).
;; entry has the structure ((UNAME SERVICE PATH MEMBER [RULE]) ...).
;; MEMBER is either a string (the handler), or a cons cell (a
;; property value). UNAME and property values are not taken into
;; account for comparison.
;; Loop over the registered functions.
(dolist (elt entry)
(when (equal value (take (length value) (cdr elt)))
(setq ret t)
;; Compute new hash value. If it is empty, remove it from the
;; hash table.
(unless (puthash key (delete elt entry) dbus-registered-objects-table)
(remhash key dbus-registered-objects-table))
;; Remove match rule of signals.
(when (eq type :signal)
(dbus-call-method
bus dbus-service-dbus dbus-path-dbus dbus-interface-dbus
"RemoveMatch" (nth 4 elt)))
;; Delete monitor connection by reestablishing private bus.
(when (eq type :monitor)
(dbus-init-bus bus 'private))))
;; Check, whether there is still a registered function or property
;; for the given service. If not, unregister the service from the
;; bus.
(when (and service (memq type '(:method :property))
(not (catch :found
(progn
(maphash
(lambda (k v)
(when (consp v)
(dolist (e v)