+;; This newlisp "module" sets up a dbus API adapter
+;;
+;; dbus is an object oriented interprocess commmunications framework
+;; based on utual object proxying. This end holds some objects that
+;; remote ends can access and invoke methods on, and remote ends hold
+;; objects that this pocess can access and invoke methods on.
+;;
+;; https://dbus.freedesktop.org/doc/dbus-specification.html
+;; https://dbus.freedesktop.org/doc/dbus-api-design.html
+;; [C API] https://dbus.freedesktop.org/doc/api/html/
+;;
+
+; Require the FOOP context
+(unless (context? MAIN:FOOP) (load "foop.lsp"))
+
+#################################################################
+;; This newlisp module implements dbus socket connection
+;;
+
+(context 'MAIN:DbusConnection)
+(FOOP path socket name serial)
+
+(define (DbusConnection:DbusConnection PATH)
+ (list (context) PATH -1 nil 0))
+
+;; Increment the serial and return it.
+(define (serial++)
+ (!serial (+ 1 (%serial))))
+
+;; (open-socket)
+; Internal utility method to re-open the %path socket and set the
+; %socket field.
+(define (open-socket)
+ (when (>= (%socket))
+ (close (%socket))
+ (!socket -1))
+ (!socket (net-connect (%path))))
+
+;** Commands from client to server
+; AUTH [mechanism] [initial-response]
+; CANCEL
+; BEGIN
+; DATA <data in hex encoding>
+; ERROR [human-readable error explanation]
+; NEGOTIATE_UNIX_FD
+
+;** Commands from server to client
+; REJECTED <space-separated list of mechanism names>
+; OK <GUID in hex>
+; DATA <data in hex encoding>
+; ERROR [human-readable error explanation]
+; AGREE_UNIX_FD
+
+(define (read-message)
+ (let ((BUFFER "") (RESULT ""))
+ (while (and RESULT (net-select (%socket) "r" 1000))
+ (if (net-receive (%socket) BUFFER 8192)
+ (extend RESULT BUFFER)
+ (begin
+ (setf RESULT nil)
+ (die 1 "dbus socket closed"))
+ ))
+ RESULT))
+
+;; (handshake MSG PAT)
+; Perform a socket handshake sending MSG and return the result, or if
+; PAT not nil, then return (regex PAT RESULT 0),
+(define (handshake MSG PAT)
+ (let ((RESULT ""))
+ (net-send (%socket) MSG)
+ (setf RESULT (read-message))
+ (if PAT (regex PAT RESULT 0) RESULT)))
+
+(constant
+ 'AUTHFMT "AUTH EXTERNAL %s\r\n"
+ 'AUTHACK "OK (\\S+)\r\n"
+ 'KEEPFMT "NEGOTIATE_UNIX_FD\r\n"
+ 'KEEPACK "AGREE_UNIX_FD\r\n"
+ )
+
+;; (initialize USER)
+; Perform socket initialization sequence and return the name, or nil.
+(define (initialize (USER (env "USER")))
+ (when (and (>= (open-socket))
+ (net-send (%socket) (char 0))
+ (handshake (format AUTHFMT (char2hex USER)) AUTHACK)
+ (!name $1)
+ (handshake KEEPFMT KEEPACK))
+ (handshake "BEGIN\r\n")
+ (%name)))
+
+(define (cancel)
+ (handshake "CANCEL\r\n" "(.*)"))
+
+#################################################################
+;; The DbusInterface context is used for modelling DBus interfaces.
+;;
+;; It includes in particular the :use method for installing a
+;; DbusInterface FOOP object as a constant named by the interface.
+;; E.g. (:use (DbusInterface "org.freedesktop.DBus.ObjectManager")
+;; installes the constant ObjectManager with a DbusInterface FOOP
+;; object modelling that interface.
+;;
+;; The :m method is used to construct a fullly qualified method name.
+;; E.g. (:m ObjectManager "GetManagedObjects()") assuming the prior
+;; :use installation of ObjectManager results in the fully qualified
+;; name string
+;; "org.freedesktop.DBus.ObjectManager.GetManagedObjects()"
+;;
+(context 'MAIN:DbusInterface)
+(FOOP name members)
+
+;; FOOP constructor; remember the interface name
+(define (DbusInterface:DbusInterface NAME (MEMBERS '()))
+ (list (context) NAME MEMBERS))
+
+;; Utility method to expand a member with the interface prefix. When
+;; the MEMBER is given without "(", then it is duly looked up in the
+;; MEMBERS list of the DbusInterface, and it thus gets expanded with
+;; parameter signature.
+(define (m MEMBER)
+ (unless (find "(" MEMBER)
+ (if (ref (string MEMBER "(") (%members) (fn (x y) (starts-with y x)) true)
+ (setf MEMBER ((parse $it ":") 0))))
+ (string (%name) "." MEMBER))
+
+;; Install this interface into the context of the caller
+(define (use)
+ (let ((IF (when (regex "([^.]+)$" (%name) 0) $1))
+ (CC (prefix (first (or (1 (history)) '(MAIN))))))
+ (letex ((S (sym $1 CC)) (V (self)))
+ (begin (context CC) (constant 'S 'V)))))
+
+;; Declare additional members for this interface
+(define (has)
+ (dolist (MEMBER (args))
+ (unless (member MEMBER (%members))
+ (!members (push MEMBER (%members) -1)))))
+
+#################################################################
+(context 'MAIN:Dbus)
+
+;; Declaring the FOOP object
+(FOOP path name bus)
+
+;; "The FOOP Constructor". Creates an object for a given path.
+(define (Dbus:Dbus PATH (NAME (replace "/" (1 PATH) ".")) (BUS 'SYSTEM-BUS))
+ (list (context) PATH NAME BUS))
+
+;; Method to clone a proxy for a given path/object.
+(define (new-path PATH)
+ (list (context) PATH (%name) (%bus)))
+
+;; Update the connection serial and return it
+(define (connection++)
+ (case (%bus)
+ (SYSTEM-BUS (:serial++ SYSTEM-BUS))
+ (true 0)))
+
+; marshalling functions and signal handling framework
+;; This newlisp "module" implements dbus marshalling
+;
+; The newlisp representation is a simplified form using lists for
+; structs and arrays.
+
+;; (expand-signature S)
+; Expland a signature string into a nested list to correspond to the
+; newlisp list representation.
+;; Basic dbus types are basic newlisp types, including strings. Arrays
+;; and structs are sublists; the expanded signature marks array
+;; sublists with an initial "a", otherwise it's a struct sublist.
+;
+; Ex: "yi" = ("y" "i")
+; Ex: "y(ai)" = ("y" (("a" "i")))
+; Ex: "a(yi)" = (("a" ("y" "i")))
+; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v")))
+(define (expand-signature S)
+ (setf S (replace "{" (replace "}" (copy S) ")") "("))
+ (let ((STACK '()) (CUR '()) (A 0))
+ (dolist (X (explode S))
+ (case X
+ (")" (setf X CUR) (setf CUR (pop STACK)))
+ ("(" (push CUR STACK) (setf CUR '()))
+ (true true))
+ (when (and (!= X "a") (!= X "("))
+ (while (and CUR (= "a" (last CUR)))
+ (setf X (list (last CUR) X))
+ (setf CUR (chop CUR))))
+ (when (!= "(" X)
+ (push X CUR -1)))
+ (if (null? CUR) '() CUR)))
+
+;; Align AT to an I multiple and pad DATA with as many NUL bytes at
+;; front, then increment AT past it all.
+(define (pack-align DATA (I (length DATA)))
+ (let ((PAD (dup "\000" (% (- I (% AT I)) I))))
+ (setf DATA (extend PAD DATA))
+ (inc AT (length DATA))
+ DATA))
+
+;; Pack data from DATA according to signature. The DATA is a nested
+;; list where container types are sub lists. Variant types also appear
+;; as pairs of signature and value.
+(define (pack-data SIGN DATA)
+ (let ((AT 0)) (pack-data-struct (expand-signature SIGN) DATA)))
+
+;; Pack a newlisp data element according to marshalling type The
+;; newlisp data is integer, double, string or list (for container and
+;; variant elements).
+(constant
+ 'FMTMAP ; mapping dbus type code to byte size and newlisp code
+ '( ("y" 1 "b") ; BYTE (unsigned 8-bit integer)
+ ("b" 4 "lu") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid)
+ ("n" 2 "d") ; INT16 (signed 16-bit integer)
+ ("q" 2 "u") ; UINT16 (unsigned 16-bit integer)
+ ("i" 4 "ld") ; INT32 (signed 32-bit integer)
+ ("u" 4 "lu") ; UINT32 (unsigned 32-bit integer)
+ ("x" 8 "Ld") ; INT64 (signed 64-bit integer)
+ ("t" 8 "Lu") ; UINT64 (unsigned 64-bit integer)
+ ("d" 8 "lf") ; DOUBLE (64-bit float)
+ ("h" 4 "lu") ; UINT32 (unix file descriptor)
+ ("a" ? ?) ; ARRAY = UINT32 byte-length, items
+ ("s" ? ?) ; STRING = length + data + NUL
+ ("o" ? ?) ; OBJECT_PATH = BYTE length + data + NUL
+ ("g" ? ?) ; SIGNATURE = BYTE length + data + NUL
+ ("(" ? ?) ; STRUCT begin in signature = (8-align) + data
+ (")" 0 ?) ; STRUCT end in signature
+ ("v" ? ?) ; VARIANT = signature + data
+ ("{" ? ?) ; DICT_ENTRY begin
+ ("}" ? ?) ; DICT_ENTRY end
+ ("r" ? ?) ; reserved STRUCT in bindings?
+ ("e" ? ?) ; reserved DICT_ENTRY in bindings ?
+ ("m" ? ?) ; reserved 'maybe'
+ ("*" ? ?) ; reserved 'single complete type'
+ ("?" ? ?) ; reserved 'basic type'
+ ("@" ? ?) ; reserved
+ ("&" ? ?) ; reserved
+ ("^" ? ?) ; reserved
+ )
+ )
+
+(define (pack-data-item ES DATA)
+ (if (list? ES) (pack-data-struct ES DATA)
+ (= ES "s") (pack-data-string ES DATA)
+ (= ES "o") (pack-data-string ES DATA)
+ (= ES "g") (pack-data-signature ES DATA)
+ (= ES "v") (apply pack-data-variant DATA)
+ (if (lookup ES FMTMAP) (pack-align (pack $it DATA)))))
+
+(define (pack-data-variant ES DATA)
+ (extend (pack-align (pack "bbb" 1 (char ES) 0) 1)
+ (pack-data-item ES DATA)))
+
+;; pack types "s" and "o"
+(define (pack-data-string ES DATA)
+ (pack-align (pack (format "lus%db" (length DATA)) (length DATA) DATA 0) 4))
+
+;; pack type "g"
+(define (pack-data-signature ES DATA)
+ (pack-align (pack (format "bs%db" (length DATA)) (length DATA) DATA 0) 1))
+
+;; Pack an array. DATA elements marshalled by repeating ES, preceded
+;; by the array length in bytes as aligned UINT32.
+(define (pack-data-array ES DATA)
+ (let ((PAD (pack-align "" 4))
+ (X (inc AT 4)) ; start index of array bytes
+ (DATA (apply extend (map (curry pack-data-item ES) DATA))))
+ (extend PAD (pack "lu" (- AT X)) DATA)))
+
+;; Pack a struct. ES and DATA elements marshalled pairwise in order
+;; following an initial8-byte alignment.
+(define (pack-data-struct ES DATA)
+ (if (= "a" (ES 0)) (pack-data-array (ES 1) DATA)
+ (apply extend (cons (pack-align "" 8)
+ (map pack-data-item ES DATA)))))
+
+;;########## unpacking
+
+;; Advance AT to an I multiple.
+(define (align-AT I)
+ (inc AT (% (- I (% AT I)) I)))
+
+;; Advance AT to an I multiple and unpack (by newlisp format) at that
+;; position in DATA. Then advance AT further past that unpacking but
+;; return the unpacked value.
+(define (unpack-align I FMT)
+ ##(println (list 'unpack-align I FMT AT (length DATA)))
+ (align-AT I)
+ ((fn (X) X) ((unpack FMT (AT DATA)) 0) (inc AT I)))
+
+;; Unpack a string or object path. The format is "lu" (UINT32) with
+;; the string length, then "s%db" with that string length and followed
+;; by a NUL byte.
+(define (unpack-data-string ES (N (unpack-align 4 "lu")))
+ ((fn (X) X) ((unpack (string "s" N) (AT DATA)) 0) (inc AT (+ 1 N))))
+
+;; Unpack a signature string. The format is "b" (BYTE) with the string
+;; length, then "s%db" with that string length and followed by a NUL
+;; byte. I.e. the same as unpack-data-string but with the string
+;; length in a BYTE rather than an UINT32.
+(define (unpack-data-signature ES)
+ (unpack-data-string ES (unpack-align 1 "b")))
+
+;; Unpack a variant item. This consists of "bbb" where the middle
+;; character is the type character for the data, preceded by a 1 byte
+;; and followed by a NUL byte. The subsequent data is unpacked
+;; according to that type character.
+(define (unpack-data-variant)
+ (unpack-data-item ((expand-signature (unpack-data-signature "g")) 0)))
+
+;; Unpack the ES type item from (AT DATA), optionally with
+;; pre-alignment, and increment AT past the padding and item.
+(define (unpack-data-item ES)
+ ##(println (list 'unpack-data-item ES AT (length DATA)))
+ (if (list? ES) (unpack-data-struct ES)
+ (= ES "s") (unpack-data-string ES)
+ (= ES "o") (unpack-data-string ES)
+ (= ES "g") (unpack-data-signature ES)
+ (= ES "v") (unpack-data-variant)
+ (if (assoc ES FMTMAP) (unpack-align ($it -2) ($it -1)))))
+
+;; Unpack array with ES elements. The array begins with an UINT32
+;; field telling how many bytes to unpack, followed by the array
+;; elements.
+(define (unpack-data-array ES)
+ (let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '()))
+ (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8))
+ (while (< AT N)
+ ##(println "---next " (list AT N))
+ (push (unpack-data-item ES) OUT -1))
+ OUT))
+
+;; Unpack a structure or array with ES fields.
+(define (unpack-data-struct ES)
+ ##(println (list 'unpack-data-struct ES AT))
+ (if (= "a" (ES 0)) (unpack-data-array (ES 1))
+ (begin (align-AT 8) (map unpack-data-item ES))))
+
+;; Unpack from a DATA string according to signature SIGN This returns
+;; a pair (unpacked pos) of unpacked data and how much data is
+;; consumed.
+(define (unpack-data SIGN DATA (AT 0))
+ ##(println (format "*** unpack-data %s %d %d" SIGN (length DATA) AT))
+ (list (unpack-data-item (expand-signature SIGN)) AT))
+
+;; Unpack all dbus messages in the given DATA block. Each message
+;; consists of head and body. The head has signature "yyyyuua(yv)"
+;; where the array is an alist of key-value pairs, optionally
+;; including the 'SIGNATURE key with the signature for the body; if
+;; omitted, then the body is empty.
+;;
+;; The function returns the header list of key-value pairs optionally
+;; extended with the pair ("" body).
+(define (unpack-messages DATA)
+ (let ((AT 0) (OUT '()) (M nil) (D nil) (S nil))
+ (while (and (< (+ AT 7) (length DATA))
+ (setf M (unpack-data "yyyyuua(yv)" DATA AT)))
+ (setf AT (M 1))
+ ##(println "message head " (M 0))
+ ##(println (list 'remains AT (length DATA)))
+ (setf M (M 0 -1)) ; Drop all but the headers then map to symbol keys
+ (dotimes (i (length M))
+ (setf (M i 0) (MESSAGE-HEADERS (M i 0) 0)))
+ ##(println "mapped headers " M)
+ ;; Add the body, if any, keyed by "".
+ (setf S (if (lookup 'SIGNATURE M) $it ""))
+ ##(println (list 'sign S))
+ (when (and (!= S "") (setf D (unpack-data S DATA AT)))
+ (setf AT (D 1))
+ (extend M (list (list "" (D 0)))))
+ ;; Collate message and move to the next portion in DATA
+ (push M OUT -1)
+ ##(println (list 'ending AT (length DATA)))
+ ;;(align-AT 4)
+ ##(println (list 'aligned AT (length DATA)))
+ (setf DATA (AT DATA))
+ (setf AT 0)
+ )
+ OUT ))
+
+#################################################################
+;; This newlisp module implements dbus socket send-receive together
+;; with signal receive. (This file should be loaded into the Dbus
+;; context)
+;;
+;; The REPL loop is re-mastered by means of a prompt-event function
+;; that firstly handles any pending dbus messages, and secondly
+;; net-select on both the dbus socket and stdin.
+;;
+;; Stdin is handled with priority.
+;;
+;; Dbus messages are read and added to the pending list.
+;;
+;; Handlers are set up as functions (fn (data msg) ..) identified by
+;; "dbus callback key" consisting of path, interface, method and
+;; signature separated by ":". For example:
+;;
+;; "/org/freedesktop/DBus:org.freedesktop.DBus.NameAcquired(s)"
+;;
+;; would identify the handler for the NameAcquired(string) method of
+;; the interface "org.freedesktop.DBus" of the path
+;; "/org/freedesktop/DBus" of the client. That particular callback is
+;; a s.c. signal sent by the dbus framework implementation in reaction
+;; to the initial Hello call, i.e. the s.c. invocation of
+;;
+;; "/org/freedesktop/DBus:org.freedesktop.DBus.Hello()"
+;;
+
+;; Return the callback key for a message MSG
+(define (message-key MSG)
+ (string (lookup 'PATH MSG) ":" (lookup 'INTERFACE MSG) "."
+ (lookup 'MEMBER MSG) "(" (lookup 'SIGNATURE MSG) ")" ))
+
+;; This is the table of handlers, keyed by path:interface:method:signature
+(define RECV:RECV nil)
+
+;; Utility function to install a handler for a given key,
+(define (handler KEY HANDLER)
+ (RECV (string (%path) ":" KEY) HANDLER))
+
+;; This is the list of Dbus messages still to handle.
+(setf pending '())
+
+(define (no-handler KEY MSG)
+ (write-line 2 (format "** No handler %s for:\n%s" KEY (string MSG))))
+
+(define (process-message MSG)
+ (let ((KEY (message-key MSG)))
+ (if (RECV KEY) ($it (lookup "" MSG))
+ (no-handler KEY MSG))))
+
+;; Process all messages currently pending
+(define (process-all-pending)
+ (while (if (pop pending) (process-message $it))))
+
+;; The main-loop is intended as a prompt-handler so as to deal with
+;; asyncronous events
+(define (main-loop S)
+ (let ((FDS (list 0 (:%socket SYSTEM-BUS))) (FD nil))
+ (write 2 (string "> "))
+ (while (or pending (not (member 0 (net-select FDS "r" -1))))
+ (if (pop pending) (process-message $it)
+ (if (unpack-messages (or (:read-message SYSTEM-BUS) ""))
+ (extend pending $it))
+ ))
+ "main-loop: "))
+
+(define (human-msg MSG)
+ (human-bytes (unpack (dup "b" (length MSG)) MSG)))
+
+;; Send message, then keep reading messages until there is a reply
+(define (send-recv-message MSG)
+ ;;(die nil (list 'send-recv-message (human-msg MSG)))
+ (net-send (:%socket SYSTEM-BUS) MSG)
+ (let ((REPLY nil))
+ (while (nil? REPLY)
+ (dolist (M (unpack-messages (:read-message SYSTEM-BUS)))
+ (if (lookup 'REPLY_SERIAL M) (setf REPLY M)
+ (push M pending -1))))
+ REPLY))
+
+
+;; ====================
+;; Dbus symbols
+
+(constant
+ 'PROTOCOL-VERSION '(1 1)
+ 'MESSAGE-TYPES '(INVALID METHOD_CALL METHOD_RETURN ERROR SIGNAL)
+ 'MESSAGE-FLAGS '(NO_REPLY_EXPECTED
+ NO_AUTO_START
+ ALLOW_INTERACTIVE_AUTHORIZATION)
+ ;; Message headers: [code] => (name type)
+ 'MESSAGE-HEADERS '((INVALID )
+ (PATH "o")
+ (INTERFACE "s")
+ (MEMBER "s")
+ (ERROR_NAME "s")
+ (REPLY_SERIAL "i")
+ (DESTINATION "s")
+ (SENDER "s")
+ (SIGNATURE "g")
+ (UNIX_FDS "i")
+ )
+ )
+
+;; Map message type symbol to dbus type code (i.e. the list index)
+(define (message-type-code TYPE)
+ (or (find TYPE MESSAGE-TYPES =) 0))
+
+;; Map flag symbol F to its dbus "bit code"
+(define (flag F)
+ (if (find F MESSAGE-FLAGS) (pow 2 $it) 0))
+
+;; Return the dbus flags code from FLAGS; if it is a number thent tha
+;; is returned as is; if FLAGS is a list of message flag symbols then
+;; combine their codes by bit-OR. Anything else yields 0.
+(define (message-flags FLAGS)
+ (if (number? FLAGS) FLAGS
+ (list? FLAGS)
+ (apply | (map flag FLAGS))
+ 0))
+
+;; (message-header (NAME VALUE))
+; Translate header into its marshalling data. The name is mapped to
+; its header code and associated value type. This gets translated into
+; the marshalling data form of (code (type value))
+(define (message-header HDR)
+ (when (list? HDR)
+ (if (find (list (HDR 0) '*) MESSAGE-HEADERS match)
+ (list $it (list (MESSAGE-HEADERS $it -1) (HDR 1))))))
+
+;; Join the excess string arguments N-byte alignment successively
+(define (pad-join N)
+ (let ((OUT ""))
+ (dolist (S (args))
+ (let ((PAD (dup "\000" (% (- N (% (length OUT) N)) N))))
+ (extend OUT PAD S)))
+ OUT))
+
+;; Return a marshalled message string appended by the marshalled body
+(define (message TYPE FLAGS HDRS BODY)
+ (pad-join 8
+ (pack-data "yyyyuua(yv)"
+ (list (char "l")
+ (message-type-code TYPE)
+ (message-flags FLAGS)
+ (PROTOCOL-VERSION 0) ; Major version code
+ (length BODY)
+ (connection++)
+ (clean null? (map message-header HDRS))))
+ BODY ))
+
+;; (:invoke OBJ METHOD ARGS FLAGS)
+; Perform a METHOD_CALL on the (self) object
+;; The given METHOD has format "INTERFACE.NAME(SIGNATURE)" with the
+;; "INTERFACE." bit optional. The function returns the list of headers
+;; of the reply message extended with reply value as a faked header
+;; named "".
+;;
+;; This function calls send-recv-message which also polls for signals
+;; until a reply is given, but any such signals are stocked up as
+;; pending for later processing on demand.
+(define (invoke METHOD ARGS (FLAGS 0))
+ (when (regex "((.+):)?((.+)\\.)?([^(]+)\\((.*)\\)$" METHOD 0)
+ (let ((PATH $2) (INTERFACE $4) (MEMBER $5) (SIGNATURE $6))
+ ;;(println (list 'invoke (%name) INTERFACE MEMBER SIGNATURE))
+ (if (message 'METHOD_CALL FLAGS
+ (list nil ; (if SELF-NAME (list 'SENDER SELF-NAME))
+ (list 'DESTINATION (%name))
+ (list 'PATH (if (empty? PATH) (%path) PATH))
+ (if (empty? INTERFACE) nil
+ (list 'INTERFACE INTERFACE))
+ (list 'MEMBER MEMBER)
+ (if (empty? SIGNATURE) nil
+ (list 'SIGNATURE SIGNATURE))
+ )
+ (if (empty? SIGNATURE) ""
+ (pack-data SIGNATURE ARGS)))
+ (send-recv-message $it)
+ nil
+ ))))
+
+;; Context variables and framework registration
+(setf
+ SYSTEM-BUS (MAIN:DbusConnection "/run/dbus/system_bus_socket")
+ APPID (:initialize SYSTEM-BUS)
+ ROOT (Dbus "/org/freedesktop/DBus")
+ DBus (DbusInterface "org.freedesktop.DBus")
+ APPNAME (if (:invoke ROOT (:m DBus "Hello()"))
+ ($it -1 -1 -1))
+ )
+
+;; Installation of some framework notification handlers
+
+;; Helper method to notify
+(define (signal-trace ARGS)
+ (die nil "** Got:" KEY ARGS ))
+
+(:handler ROOT (:m DBus "NameAcquired(s)") signal-trace)
+(:handler ROOT (:m DBus "NameLost(s)") signal-trace)
+(:handler ROOT (:m DBus "NameOwnerChanged(sss)") signal-trace)
+
+ ; Process notifications that came with the registration handshake
+(process-all-pending)
+
+;; Set up the Dbus event loop as prompt-event handler
+(prompt-event Dbus:main-loop)
+
+;;######################################################################
+;;
+;; Standard interfaces
+
+(context MAIN)
+
+(:use (DbusInterface "org.freedesktop.DBus.Peer"
+ '( "Ping():"
+ "GetMachineId():s"
+ )))
+
+(:use (DbusInterface "org.freedesktop.DBus.ObjectManager"
+ '( "GetManagedObjects():a(oa(sa(sv)))"
+ )))
+
+(:use (DbusInterface "org.freedesktop.DBus.Introspectable"
+ ' Introspectable "Introspect():s" ; (xml data)
+ ))
+; https://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format
+
+(:use (DbusInterface "org.freedesktop.DBus.Properties"
+ '( "Get(ss):v"
+ "Set(ssv):"
+ "GetAll(s):a(sv)"
+ "PropertiesChanged(sa(sv)as):" ; signal ?
+ )))
+
+(:use (DbusInterface "org.freedesktop.DBus"
+ '( "Hello():s"
+ "RequestName(su):u"
+ "ReleaseName(s):u"
+ "ListQueuedOwners (s):as"
+ "ListNames():as"
+ "ListActivatableNames():as"
+ "NameHasOwner(s):b"
+ "NameOwnerChanged(sss):" ; -- signal
+ "NameLost(s):" ; -- signal
+ "NameAcquired(s):" ; -- signal
+ "ActivatableServicesChanged():" ; -- signal
+ "StartServiceByName(s,u):u"
+ "UpdateActivationEnvironment(a(ss)):"
+ "GetNameOwner(s):s"
+ "GetConnectionUnixUser(s):u"
+ "GetConnectionUnixProcessID(s):u"
+ "GetConnectionCredentials(s):a(sv)"
+ "GetAdtAuditSessionData(s):ay"
+ "GetConnectionSELinuxSecurityContext(s):ay"
+ "AddMatch(s):"
+ "RemoveMatch(s):"
+ "GetId():s"
+ "Monitoring.BecomeMonitor(asu):"
+ )))
+
+;eg AddMatch argument:
+;"type='signal',sender='org.example.App2',path_namespace='/org/example/App2'"
+
+"lsp-dbus.lsp"