aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2026-01-17 11:40:31 +0100
committerMichael Albinus2026-01-17 11:40:31 +0100
commitab77b4b60ca1837e2da5147e6604cd2020567b80 (patch)
tree2904dc0a52c8c96bc44efca75dec15b2d250a114
parent6287637ccd9f66a219844231380ab9873d049c6e (diff)
downloademacs-ab77b4b60ca1837e2da5147e6604cd2020567b80.tar.gz
emacs-ab77b4b60ca1837e2da5147e6604cd2020567b80.zip
New D-Bus functions to support systemd inhibitor locks
* doc/misc/dbus.texi (Top): Add "Inhibitor Locks" submenu. Remove trailing period from chapter and section titles. (Inhibitor Locks): New node. * etc/NEWS: New D-Bus functions to support systemd inhibitor locks. Presentational fixes and improvements. * src/dbusbind.c (xd_registered_inhibitor_locks): New variable. (Fdbus_make_inhibitor_lock, Fdbus_close_inhibitor_lock) (Fdbus_registered_inhibitor_locks): New DEFUNs. (Bug#79963) (syms_of_dbusbind_for_pdumper): Initialize `xd_registered_inhibitor_locks'. (syms_of_dbusbind): Declare subroutines `Sdbus_make_inhibitor_lock', `Sdbus_close_inhibitor_lock' and `Sdbus_registered_inhibitor_locks'. Declare symbol `Qdbus_call_method'. staticpro `xd_registered_inhibitor_locks'. * test/lisp/net/dbus-tests.el (dbus--test-systemd-service) (dbus--test-systemd-path, dbus--test-systemd-manager-interface): New defconsts. (dbus-test10-inhibitor-locks): New test.
-rw-r--r--doc/misc/dbus.texi142
-rw-r--r--etc/NEWS33
-rw-r--r--src/dbusbind.c109
-rw-r--r--test/lisp/net/dbus-tests.el93
4 files changed, 348 insertions, 29 deletions
diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi
index 7fad406520c..946e7666629 100644
--- a/doc/misc/dbus.texi
+++ b/doc/misc/dbus.texi
@@ -64,6 +64,7 @@ another. An overview of D-Bus can be found at
64* Alternative Buses:: Alternative buses and environments. 64* Alternative Buses:: Alternative buses and environments.
65* Errors and Events:: Errors and events. 65* Errors and Events:: Errors and events.
66* Monitoring Messages:: Monitoring messages. 66* Monitoring Messages:: Monitoring messages.
67* Inhibitor Locks:: Inhibit system shutdowns and sleep states.
67* Index:: Index including concepts, functions, variables. 68* Index:: Index including concepts, functions, variables.
68 69
69* GNU Free Documentation License:: The license for this documentation. 70* GNU Free Documentation License:: The license for this documentation.
@@ -124,7 +125,7 @@ name could be @samp{org.gnu.Emacs.TextEditor} or
124 125
125 126
126@node Inspection 127@node Inspection
127@chapter Inspection of D-Bus services. 128@chapter Inspection of D-Bus services
128@cindex inspection 129@cindex inspection
129 130
130@menu 131@menu
@@ -139,7 +140,7 @@ name could be @samp{org.gnu.Emacs.TextEditor} or
139 140
140 141
141@node Version 142@node Version
142@section D-Bus version. 143@section D-Bus version
143 144
144D-Bus has evolved over the years. New features have been added with 145D-Bus has evolved over the years. New features have been added with
145new D-Bus versions. There are two variables, which allow the determination 146new D-Bus versions. There are two variables, which allow the determination
@@ -158,7 +159,7 @@ It is also @code{nil}, if it cannot be determined at runtime.
158 159
159 160
160@node Bus names 161@node Bus names
161@section Bus names. 162@section Bus names
162 163
163There are several basic functions which inspect the buses for 164There are several basic functions which inspect the buses for
164registered names. Internally they use the basic interface 165registered names. Internally they use the basic interface
@@ -267,7 +268,7 @@ at D-Bus @var{bus}, as a string.
267 268
268 269
269@node Introspection 270@node Introspection
270@section Knowing the details of D-Bus services. 271@section Knowing the details of D-Bus services
271 272
272D-Bus services publish their interfaces. This can be retrieved and 273D-Bus services publish their interfaces. This can be retrieved and
273analyzed during runtime, in order to understand the used 274analyzed during runtime, in order to understand the used
@@ -483,7 +484,7 @@ If @var{object} has no @var{attribute}, the function returns
483 484
484 485
485@node Nodes and Interfaces 486@node Nodes and Interfaces
486@section Detecting object paths and interfaces. 487@section Detecting object paths and interfaces
487 488
488The first elements, to be introspected for a D-Bus object, are further 489The first elements, to be introspected for a D-Bus object, are further
489object paths and interfaces. 490object paths and interfaces.
@@ -593,7 +594,7 @@ data from a running system:
593 594
594 595
595@node Methods and Signal 596@node Methods and Signal
596@section Applying the functionality. 597@section Applying the functionality
597 598
598Methods and signals are the communication means to D-Bus. The 599Methods and signals are the communication means to D-Bus. The
599following functions return their specifications. 600following functions return their specifications.
@@ -673,7 +674,7 @@ Example:
673 674
674 675
675@node Properties and Annotations 676@node Properties and Annotations
676@section What else to know about interfaces. 677@section What else to know about interfaces
677 678
678Interfaces can have properties. These can be exposed via the 679Interfaces can have properties. These can be exposed via the
679@samp{org.freedesktop.DBus.Properties} interface@footnote{See 680@samp{org.freedesktop.DBus.Properties} interface@footnote{See
@@ -894,7 +895,7 @@ An attribute value can be retrieved by
894 895
895 896
896@node Arguments and Signatures 897@node Arguments and Signatures
897@section The final details. 898@section The final details
898 899
899Methods and signals have arguments. They are described in the 900Methods and signals have arguments. They are described in the
900@code{arg} XML elements. 901@code{arg} XML elements.
@@ -962,7 +963,7 @@ non-@code{nil}, @var{direction} must be @samp{out}. Example:
962 963
963 964
964@node Type Conversion 965@node Type Conversion
965@chapter Mapping Lisp types and D-Bus types. 966@chapter Mapping Lisp types and D-Bus types
966@cindex type conversion 967@cindex type conversion
967 968
968D-Bus method calls and signals accept usually several arguments as 969D-Bus method calls and signals accept usually several arguments as
@@ -975,7 +976,7 @@ applied Lisp object @expansion{} D-Bus type for input parameters, and
975D-Bus type @expansion{} Lisp object for output parameters. 976D-Bus type @expansion{} Lisp object for output parameters.
976 977
977 978
978@section Input parameters. 979@section Input parameters
979 980
980Input parameters for D-Bus methods and signals occur as arguments of a 981Input parameters for D-Bus methods and signals occur as arguments of a
981Lisp function call. The following mapping to D-Bus types is 982Lisp function call. The following mapping to D-Bus types is
@@ -1116,7 +1117,7 @@ lower-case hex digits. As a special case, "" is escaped to
1116@end defun 1117@end defun
1117 1118
1118 1119
1119@section Output parameters. 1120@section Output parameters
1120 1121
1121Output parameters of D-Bus methods and signals are mapped to Lisp 1122Output parameters of D-Bus methods and signals are mapped to Lisp
1122objects. 1123objects.
@@ -1199,7 +1200,7 @@ that string:
1199 1200
1200 1201
1201@node Synchronous Methods 1202@node Synchronous Methods
1202@chapter Calling methods in a blocking way. 1203@chapter Calling methods in a blocking way
1203@cindex method calls, synchronous 1204@cindex method calls, synchronous
1204@cindex synchronous method calls 1205@cindex synchronous method calls
1205 1206
@@ -1319,7 +1320,7 @@ emulate the @code{lshal} command on GNU/Linux systems:
1319 1320
1320 1321
1321@node Asynchronous Methods 1322@node Asynchronous Methods
1322@chapter Calling methods non-blocking. 1323@chapter Calling methods non-blocking
1323@cindex method calls, asynchronous 1324@cindex method calls, asynchronous
1324@cindex asynchronous method calls 1325@cindex asynchronous method calls
1325 1326
@@ -1371,7 +1372,7 @@ message arrives, and @var{handler} is called. Example:
1371 1372
1372 1373
1373@node Register Objects 1374@node Register Objects
1374@chapter Offering own services. 1375@chapter Offering own services
1375@cindex method calls, returning 1376@cindex method calls, returning
1376@cindex returning method calls 1377@cindex returning method calls
1377 1378
@@ -1722,7 +1723,7 @@ to the service from D-Bus.
1722 1723
1723 1724
1724@node Signals 1725@node Signals
1725@chapter Sending and receiving signals. 1726@chapter Sending and receiving signals
1726@cindex signals 1727@cindex signals
1727 1728
1728Signals are one way messages. They carry input parameters, which are 1729Signals are one way messages. They carry input parameters, which are
@@ -1859,7 +1860,7 @@ for a dummy signal, and check the result:
1859 1860
1860 1861
1861@node Alternative Buses 1862@node Alternative Buses
1862@chapter Alternative buses and environments. 1863@chapter Alternative buses and environments
1863@cindex bus names 1864@cindex bus names
1864@cindex UNIX domain socket 1865@cindex UNIX domain socket
1865@cindex TCP/IP socket 1866@cindex TCP/IP socket
@@ -1986,7 +1987,7 @@ running. This could be achieved by
1986 1987
1987 1988
1988@node Errors and Events 1989@node Errors and Events
1989@chapter Errors and events. 1990@chapter Errors and events
1990@cindex debugging 1991@cindex debugging
1991@cindex errors 1992@cindex errors
1992@cindex events 1993@cindex events
@@ -2145,7 +2146,7 @@ whether a given D-Bus error is related to them.
2145 2146
2146 2147
2147@node Monitoring Messages 2148@node Monitoring Messages
2148@chapter Monitoring messages. 2149@chapter Monitoring messages
2149@cindex monitoring 2150@cindex monitoring
2150 2151
2151@defun dbus-register-monitor bus &optional handler &key type sender destination path interface member 2152@defun dbus-register-monitor bus &optional handler &key type sender destination path interface member
@@ -2204,6 +2205,111 @@ switches to the monitor buffer.
2204@end deffn 2205@end deffn
2205 2206
2206 2207
2208@node Inhibitor Locks
2209@chapter Inhibit system shutdowns and sleep states
2210
2211@uref{https://systemd.io/INHIBITOR_LOCKS/, Systemd} includes a logic to
2212inhibit system shutdowns and sleep states. It can be controlled by a
2213D-Bus API@footnote{@uref{https://www.freedesktop.org/software/systemd/man/latest/org.freedesktop.login1.html}}.
2214Because this API includes handling of file descriptors, not all
2215functions can be implemented by simple D-Bus method calls. Therefore,
2216the following functions are provided.
2217
2218@defun dbus-make-inhibitor-lock what why &optional block
2219This function creates an inhibitor for system shutdowns and sleep states.
2220
2221@var{what} is a colon-separated string of lock types: @samp{shutdown},
2222@samp{sleep}, @samp{idle}, @samp{handle-power-key},
2223@samp{handle-suspend-key}, @samp{handle-hibernate-key},
2224@samp{handle-lid-switch}. Example: @samp{shutdown:idle}.
2225
2226@c@var{who} is a descriptive string of who is taking the lock. If it is
2227@c@code{nil}, it defaults to @samp{Emacs}.
2228
2229@var{why} is a descriptive string of why the lock is taken. Example:
2230@samp{Package Update in Progress}.
2231
2232The optional @var{block} is the mode of the inhibitor lock, either
2233@samp{block} (@var{block} is non-@code{nil}), or @samp{delay}.
2234
2235Note, that the @code{who} argument of the inhibitor lock object of the
2236systemd manager is always set to the string @samp{Emacs}.
2237
2238It returns a file descriptor or @code{nil}, if the lock cannot be
2239acquired. If there is already an inhibitor lock for the triple
2240@code{(WHAT WHY BLOCK)}, this lock is returned. Example:
2241
2242@lisp
2243(dbus-make-inhibitor-lock "sleep" "Test")
2244
2245@result{} 25
2246@end lisp
2247@end defun
2248
2249@defun dbus-registered-inhibitor-locks
2250Return registered inhibitor locks, an alist.
2251This allows to check, whether other packages of the running Emacs
2252instance have acquired an inhibitor lock as well.
2253
2254An entry in this list is a list @code{(@var{fd} @var{what} @var{why}
2255@var{block})}. The car of the list is the file descriptor retrieved
2256from a @code{dbus-make-inhibitor-lock} call. The cdr of the list
2257represents the three arguments @code{dbus-make-inhibitor-lock} was
2258called with. Example:
2259
2260@lisp
2261(dbus-registered-inhibitor-locks)
2262
2263@result{} ((25 "sleep" "Test" nil))
2264@end lisp
2265@end defun
2266
2267@defun dbus-close-inhibitor-lock lock
2268Close inhibitor lock file descriptor.
2269
2270@var{lock}, a file descriptor, must be the result of a
2271@code{dbus-make-inhibitor-lock} call. It returns @code{t} in case of
2272success, or @code{nil} if it isn't be possible to close the lock, or if
2273the lock is closed already. Example:
2274
2275@lisp
2276(dbus-close-inhibitor-lock 25)
2277
2278@result{} t
2279
2280@end lisp
2281@end defun
2282
2283A typical scenario for these functions is to register for the
2284D-Bus signal @samp{org.freedesktop.login1.Manager.PrepareForSleep}:
2285
2286@lisp
2287(defvar my-inhibitor-lock
2288 (dbus-make-inhibitor-lock "sleep" "Test"))
2289
2290(defun my-dbus-PrepareForSleep-handler (start)
2291 (if start ;; The system goes down for sleep
2292 (progn
2293 @dots{}
2294 ;; Release inhibitor lock.
2295 (when (natnump my-inhibitor-lock)
2296 (dbus-close-inhibitor-lock my-inhibitor-lock)
2297 (setq my-inhibitor-lock nil)))
2298 ;; Reacquire inhibitor lock.
2299 (setq my-inhibitor-lock
2300 (dbus-make-inhibitor-lock "sleep" "Test"))))
2301
2302(dbus-register-signal
2303 :system "org.freedesktop.login1" "/org/freedesktop/login1/Manager"
2304 "org.freedesktop.login1.Manager" "PrepareForSleep"
2305 #'my-dbus-PrepareForSleep-handler)
2306
2307@result{} ((:signal :system "org.freedesktop.login1.Manager" "PrepareForSleep")
2308 ("org.freedesktop.login1" "/org/freedesktop/login1/Manager"
2309 my-dbus-PrepareForSleep-handler))
2310@end lisp
2311
2312
2207@node Index 2313@node Index
2208@unnumbered Index 2314@unnumbered Index
2209 2315
diff --git a/etc/NEWS b/etc/NEWS
index 17a6a6c68b0..0b4fcadb620 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -201,10 +201,10 @@ large or inefficient completion tables this can slow down typing.
201 201
202+++ 202+++
203*** New optional value of 'minibuffer-visible-completions'. 203*** New optional value of 'minibuffer-visible-completions'.
204If the value of this option is 'up-down', only the <UP> and <DOWN> arrow 204If the value of this option is 'up-down', only the '<up>' and '<down>'
205keys move point between candidates shown in the *Completions* buffer 205arrow keys move point between candidates shown in the "*Completions*"
206display, while <RIGHT> and <LEFT> arrows move point in the minibuffer 206buffer display, while '<right>' and '<left>' arrows move point in the
207window. 207minibuffer window.
208 208
209--- 209---
210*** 'RET' chooses the completion selected with 'M-<up>/M-<down>'. 210*** 'RET' chooses the completion selected with 'M-<up>/M-<down>'.
@@ -513,7 +513,7 @@ Each non-tooltip frame is assigned a unique integer id. This allows you
513to unambiguously identify frames even if they share the same name or 513to unambiguously identify frames even if they share the same name or
514title. When 'undelete-frame-mode' is enabled, each deleted frame's id 514title. When 'undelete-frame-mode' is enabled, each deleted frame's id
515is stored for resurrection. The function 'frame-id' returns a frame's 515is stored for resurrection. The function 'frame-id' returns a frame's
516id (in C, use the frame struct member id). 516id (in C, use the frame struct member 'id').
517 517
518** Mode Line 518** Mode Line
519 519
@@ -2062,9 +2062,9 @@ you exit the Emacs session or kill the IELM buffer.
2062 2062
2063--- 2063---
2064*** New value 'point' for user option 'ielm-dynamic-return'. 2064*** New value 'point' for user option 'ielm-dynamic-return'.
2065When 'ielm-dynamic-return' is set to 'point', typing RET has dynamic 2065When 'ielm-dynamic-return' is set to 'point', typing 'RET' has dynamic
2066behavior based on whether point is inside an sexp. While point is 2066behavior based on whether point is inside an sexp. While point is
2067inside an sexp typing RET inserts a newline, and otherwise Emacs 2067inside an sexp typing 'RET' inserts a newline, and otherwise Emacs
2068proceeds with evaluating the expression. This is useful when 2068proceeds with evaluating the expression. This is useful when
2069'electric-pair-mode', or a similar automatic pairing mode, is enabled. 2069'electric-pair-mode', or a similar automatic pairing mode, is enabled.
2070 2070
@@ -2889,7 +2889,7 @@ The user option 'package-review-policy' can configure which packages
2889the user should be allowed to review before any processing takes place. 2889the user should be allowed to review before any processing takes place.
2890The package review can include reading the downloaded source code, 2890The package review can include reading the downloaded source code,
2891presenting a diff between the downloaded code and a previous 2891presenting a diff between the downloaded code and a previous
2892installation or displaying a changelog. 2892installation or displaying a ChangeLog.
2893 2893
2894** Rcirc 2894** Rcirc
2895 2895
@@ -3750,12 +3750,21 @@ without marking it as automatically buffer-local.
3750** The obsolete face attribute ':reverse-video' has been removed. 3750** The obsolete face attribute ':reverse-video' has been removed.
3751Use ':inverse-video' instead. 3751Use ':inverse-video' instead.
3752 3752
3753** D-Bus
3754
3753+++ 3755+++
3754** Support interactive D-Bus authorization. 3756*** Support interactive D-Bus authorization.
3755A new ':authorizable t' parameter has been added to 'dbus-call-method' 3757A new ':authorizable t' parameter has been added to 'dbus-call-method'
3756and 'dbus-call-method-asynchronously' to allow the user to interactively 3758and 'dbus-call-method-asynchronously' to allow the user to interactively
3757authorize the invoked D-Bus method (for example via polkit). 3759authorize the invoked D-Bus method (for example via polkit).
3758 3760
3761+++
3762*** New D-Bus functions to support systemd inhibitor locks.
3763The functions 'dbus-make-inhibitor-lock', 'dbus-close-inhibitor-lock'
3764and 'dbus-registered-inhibitor-locks' implement acquiring and releasing
3765systemd inhibitor locks. See the Info node "(dbus) Inhibitor Locks" for
3766details.
3767
3759** The customization group 'wp' has been removed. 3768** The customization group 'wp' has been removed.
3760It has been obsolete since Emacs 26.1. Use the group 'text' instead. 3769It has been obsolete since Emacs 26.1. Use the group 'text' instead.
3761 3770
@@ -3926,15 +3935,17 @@ When the theme is set on PGTK, Android, or MS-Windows systems,
3926variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be 3935variable 'toolkit-theme' as either symbol 'dark' or 'light', but may be
3927extended to encompass other toolkit-specific symbols in the future. 3936extended to encompass other toolkit-specific symbols in the future.
3928 3937
3938** Progress reporter
3939
3929+++ 3940+++
3930** Progress reporter callbacks. 3941*** Progress reporter callbacks.
3931'make-progress-reporter' now accepts optional arguments UPDATE-CALLBACK, 3942'make-progress-reporter' now accepts optional arguments UPDATE-CALLBACK,
3932called on progress steps, and DONE-CALLBACK, called when the progress 3943called on progress steps, and DONE-CALLBACK, called when the progress
3933reporter is done. See the 'make-progress-reporter' docstring for a full 3944reporter is done. See the 'make-progress-reporter' docstring for a full
3934specification of these new optional arguments. 3945specification of these new optional arguments.
3935 3946
3936+++ 3947+++
3937** Progress reporter context. 3948*** Progress reporter context.
3938'make-progress-reporter' now accepts the optional argument CONTEXT, 3949'make-progress-reporter' now accepts the optional argument CONTEXT,
3939which if it is the symbol 'async', inhibits updates in the echo area 3950which if it is the symbol 'async', inhibits updates in the echo area
3940when it is busy. This is useful, for example, if you want to monitor progress 3951when it is busy. This is useful, for example, if you want to monitor progress
diff --git a/src/dbusbind.c b/src/dbusbind.c
index a2936011610..a416e6c918a 100644
--- a/src/dbusbind.c
+++ b/src/dbusbind.c
@@ -1617,6 +1617,109 @@ usage: (dbus-message-internal &rest REST) */)
1617 return result; 1617 return result;
1618} 1618}
1619 1619
1620/* Alist of registered inhibitor locks for D-Bus.
1621 An entry in this list is a list (FD WHAT WHY BLOCK).
1622 The car of the list is a file descriptor retrieved from a
1623 'dbus-make-inhibitor-lock` call. The cdr of the list represents the
1624 three arguments 'dbus-make-inhibitor-lock` was called with. */
1625static Lisp_Object xd_registered_inhibitor_locks;
1626
1627DEFUN ("dbus-make-inhibitor-lock", Fdbus_make_inhibitor_lock,
1628 Sdbus_make_inhibitor_lock,
1629 2, 3, 0,
1630 doc: /* Inhibit system shutdowns and sleep states.
1631
1632WHAT is a colon-separated string of lock types, i.e. "shutdown",
1633"sleep", "idle", "handle-power-key", "handle-suspend-key",
1634"handle-hibernate-key", "handle-lid-switch". Example: "shutdown:idle".
1635
1636WHY is a descriptive string of why the lock is taken. Example: "Package
1637Update in Progress".
1638
1639The optional BLOCK is the mode of the inhibitor lock, either "block"
1640(BLOCK is non-nil), or "delay".
1641
1642It returns a file descriptor or nil, if the lock cannot be acquired. If
1643there is already an inhibitor lock for the triple (WHAT WHY BLOCK), this
1644lock is returned.
1645
1646For details of the arguments, see Info node `(dbus)Inhibitor Locks'. */)
1647 (Lisp_Object what, Lisp_Object why, Lisp_Object block)
1648{
1649 CHECK_STRING (what);
1650 CHECK_STRING (why);
1651 if (!NILP (block))
1652 block = Qt;
1653 Lisp_Object who = build_string ("Emacs");
1654 Lisp_Object mode =
1655 (NILP (block)) ? build_string ("delay") : build_string ("block");
1656
1657 /* Check, whether it is registered already. */
1658 Lisp_Object triple = list3 (what, why, block);
1659 Lisp_Object registered = Frassoc (triple, xd_registered_inhibitor_locks);
1660 if (!NILP (registered))
1661 return CAR_SAFE (registered);
1662
1663 /* Register lock. */
1664 Lisp_Object lock =
1665 calln (Qdbus_call_method, QCsystem,
1666 build_string ("org.freedesktop.login1"),
1667 build_string ("/org/freedesktop/login1"),
1668 build_string ("org.freedesktop.login1.Manager"),
1669 build_string ("Inhibit"), what, who, why, mode);
1670
1671 xd_registered_inhibitor_locks =
1672 Fcons (Fcons (lock, triple), xd_registered_inhibitor_locks);
1673 return lock;
1674}
1675
1676DEFUN ("dbus-close-inhibitor-lock", Fdbus_close_inhibitor_lock,
1677 Sdbus_close_inhibitor_lock,
1678 1, 1, 0,
1679 doc: /* Close inhibitor lock file descriptor.
1680
1681LOCK, a file descriptor, must be the result of a `dbus-make-inhibitor-lock'
1682call. It returns t in case of success, or nil if it isn't be possible
1683to close the lock, or if the lock is closed already.
1684
1685For details, see Info node `(dbus)Inhibitor Locks'. */)
1686 (Lisp_Object lock)
1687{
1688 CHECK_FIXNUM (lock);
1689
1690 /* Check, whether it is registered. */
1691 Lisp_Object registered = assoc_no_quit (lock, xd_registered_inhibitor_locks);
1692 if (NILP (registered))
1693 return Qnil;
1694 else
1695 {
1696 xd_registered_inhibitor_locks =
1697 Fdelete (registered, xd_registered_inhibitor_locks);
1698 return (emacs_close (XFIXNAT (lock)) == 0) ? Qt : Qnil;
1699 }
1700}
1701
1702DEFUN ("dbus-registered-inhibitor-locks", Fdbus_registered_inhibitor_locks,
1703 Sdbus_registered_inhibitor_locks,
1704 0, 0, 0,
1705 doc: /* Return registered inhibitor locks, an alist.
1706This allows to check, whether other packages of the running Emacs
1707instance have acquired an inhibitor lock as well.
1708An entry in this list is a list (FD WHAT WHY BLOCK).
1709The car of the list is the file descriptor retrieved from a
1710'dbus-make-inhibitor-lock` call. The cdr of the list represents the
1711three arguments 'dbus-make-inhibitor-lock` was called with. */)
1712 ()
1713{
1714 /* We return a copy of xd_registered_inhibitor_locks, in order to
1715 protect it against malicious manipulation. */
1716 Lisp_Object registered = xd_registered_inhibitor_locks;
1717 Lisp_Object result = Qnil;
1718 for (; !NILP (registered); registered = CDR_SAFE (registered))
1719 result = Fcons (Fcopy_sequence (CAR_SAFE (registered)), result);
1720 return Fnreverse (result);
1721}
1722
1620/* Construct a D-Bus event, and store it into the input event queue. */ 1723/* Construct a D-Bus event, and store it into the input event queue. */
1621static void 1724static void
1622xd_store_event (Lisp_Object handler, Lisp_Object handler_args, 1725xd_store_event (Lisp_Object handler, Lisp_Object handler_args,
@@ -1869,6 +1972,7 @@ static void
1869syms_of_dbusbind_for_pdumper (void) 1972syms_of_dbusbind_for_pdumper (void)
1870{ 1973{
1871 xd_registered_buses = Qnil; 1974 xd_registered_buses = Qnil;
1975 xd_registered_inhibitor_locks = Qnil;
1872} 1976}
1873 1977
1874void 1978void
@@ -1876,6 +1980,9 @@ syms_of_dbusbind (void)
1876{ 1980{
1877 defsubr (&Sdbus__init_bus); 1981 defsubr (&Sdbus__init_bus);
1878 defsubr (&Sdbus_get_unique_name); 1982 defsubr (&Sdbus_get_unique_name);
1983 defsubr (&Sdbus_make_inhibitor_lock);
1984 defsubr (&Sdbus_close_inhibitor_lock);
1985 defsubr (&Sdbus_registered_inhibitor_locks);
1879 1986
1880 DEFSYM (Qdbus_message_internal, "dbus-message-internal"); 1987 DEFSYM (Qdbus_message_internal, "dbus-message-internal");
1881 defsubr (&Sdbus_message_internal); 1988 defsubr (&Sdbus_message_internal);
@@ -1930,6 +2037,7 @@ syms_of_dbusbind (void)
1930 2037
1931 /* Miscellaneous Lisp symbols. */ 2038 /* Miscellaneous Lisp symbols. */
1932 DEFSYM (Qdbus_get_name_owner, "dbus-get-name-owner"); 2039 DEFSYM (Qdbus_get_name_owner, "dbus-get-name-owner");
2040 DEFSYM (Qdbus_call_method, "dbus-call-method");
1933 2041
1934 DEFVAR_LISP ("dbus-compiled-version", 2042 DEFVAR_LISP ("dbus-compiled-version",
1935 Vdbus_compiled_version, 2043 Vdbus_compiled_version,
@@ -2035,6 +2143,7 @@ be called when the D-Bus reply message arrives. */);
2035 /* Initialize internal objects. */ 2143 /* Initialize internal objects. */
2036 pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper); 2144 pdumper_do_now_and_after_load (syms_of_dbusbind_for_pdumper);
2037 staticpro (&xd_registered_buses); 2145 staticpro (&xd_registered_buses);
2146 staticpro (&xd_registered_inhibitor_locks);
2038 2147
2039 Fprovide (intern_c_string ("dbusbind"), Qnil); 2148 Fprovide (intern_c_string ("dbusbind"), Qnil);
2040} 2149}
diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el
index e529e02ed9b..b34ce3381c7 100644
--- a/test/lisp/net/dbus-tests.el
+++ b/test/lisp/net/dbus-tests.el
@@ -48,6 +48,15 @@
48(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface" 48(defconst dbus--test-interface "org.gnu.Emacs.TestDBus.Interface"
49 "Test interface.") 49 "Test interface.")
50 50
51(defconst dbus--test-systemd-service "org.freedesktop.login1"
52 "Systemd service.")
53
54(defconst dbus--test-systemd-path "/org/freedesktop/login1"
55 "Systemd object path.")
56
57(defconst dbus--test-systemd-manager-interface "org.freedesktop.login1.Manager"
58 "Systemd Manager interface.")
59
51(defun dbus--test-availability (bus) 60(defun dbus--test-availability (bus)
52 "Test availability of D-Bus BUS." 61 "Test availability of D-Bus BUS."
53 (should (dbus-list-names bus)) 62 (should (dbus-list-names bus))
@@ -2295,6 +2304,90 @@ The argument EXPECTED-ARGS is a list of expected arguments for the method."
2295 ;; Cleanup. 2304 ;; Cleanup.
2296 (dbus-unregister-service :session dbus--test-service))) 2305 (dbus-unregister-service :session dbus--test-service)))
2297 2306
2307(ert-deftest dbus-test10-inhibitor-locks ()
2308 "Check `dbus-*-inhibitor-locks'."
2309 :tags '(:expensive-test)
2310 (skip-unless dbus--test-enabled-system-bus)
2311 (skip-unless (dbus-ping :system dbus--test-systemd-service 1000))
2312
2313 (let (lock1 lock2)
2314 ;; Create inhibitor lock.
2315 (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay"))
2316 (should (natnump lock1))
2317 ;; The lock is reported by systemd.
2318 (should
2319 (member
2320 (list "sleep" "Emacs" "Test delay" "delay" (user-uid) (emacs-pid))
2321 (dbus-call-method
2322 :system dbus--test-systemd-service dbus--test-systemd-path
2323 dbus--test-systemd-manager-interface "ListInhibitors")))
2324 ;; The lock is registered internally.
2325 (should
2326 (member
2327 (list lock1 "sleep" "Test delay" nil)
2328 (dbus-registered-inhibitor-locks)))
2329 ;; There exist a file descriptor.
2330 (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
2331 (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
2332
2333 ;; It is not possible to modify registered inhibitor locks on Lisp level.
2334 (setcar (assoc lock1 (dbus-registered-inhibitor-locks)) 'malicious)
2335 (should (assoc lock1 (dbus-registered-inhibitor-locks)))
2336 (should-not (assoc 'malicious (dbus-registered-inhibitor-locks)))
2337
2338 ;; Creating it again returns the same inhibitor lock.
2339 (should (= lock1 (dbus-make-inhibitor-lock "sleep" "Test delay")))
2340
2341 ;; Create another inhibitor lock.
2342 (setq lock2 (dbus-make-inhibitor-lock "sleep" "Test block" 'block))
2343 (should (natnump lock2))
2344 (should-not (= lock1 lock2))
2345 ;; The lock is reported by systemd.
2346 (should
2347 (member
2348 (list "sleep" "Emacs" "Test block" "block" (user-uid) (emacs-pid))
2349 (dbus-call-method
2350 :system dbus--test-systemd-service dbus--test-systemd-path
2351 dbus--test-systemd-manager-interface "ListInhibitors")))
2352 ;; The lock is registered internally.
2353 (should
2354 (member
2355 (list lock2 "sleep" "Test block" t)
2356 (dbus-registered-inhibitor-locks)))
2357 ;; There exist a file descriptor.
2358 (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
2359 (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock2))))
2360
2361 ;; Close the first inhibitor lock.
2362 (should (dbus-close-inhibitor-lock lock1))
2363 ;; The internal registration has gone.
2364 (should-not
2365 (member
2366 (list lock1 "sleep" "Test delay" nil)
2367 (dbus-registered-inhibitor-locks)))
2368 ;; The file descriptor has been deleted.
2369 (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
2370 (should-not (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
2371
2372 ;; Closing it again is a noop.
2373 (should-not (dbus-close-inhibitor-lock lock1))
2374
2375 ;; Creating it again returns (another?) inhibitor lock.
2376 (setq lock1 (dbus-make-inhibitor-lock "sleep" "Test delay"))
2377 (should (natnump lock1))
2378 ;; The lock is registered internally.
2379 (should
2380 (member
2381 (list lock1 "sleep" "Test delay" nil)
2382 (dbus-registered-inhibitor-locks)))
2383 ;; There exist a file descriptor.
2384 (when (file-directory-p (format "/proc/%d/fd" (emacs-pid)))
2385 (should (file-symlink-p (format "/proc/%d/fd/%d" (emacs-pid) lock1))))
2386
2387 ;; Close the inhibitor locks.
2388 (should (dbus-close-inhibitor-lock lock1))
2389 (should (dbus-close-inhibitor-lock lock2))))
2390
2298(defun dbus-test-all (&optional interactive) 2391(defun dbus-test-all (&optional interactive)
2299 "Run all tests for \\[dbus]." 2392 "Run all tests for \\[dbus]."
2300 (interactive "p") 2393 (interactive "p")