X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-dbus%2Flsp-dbus.lsp;h=a8109981268bc9e61fdc1dfb03c602ee529a78f3;hb=7d4f5a7a25ad188cc8f60ed47cb7fc7818be00e3;hp=6b50235e99472744b16f2c8177ceede0e883d4bc;hpb=daab5a6aed7f5823ad847b32e1f28caafa4a9685;p=rrq%2Flsp-utils.git diff --git a/lsp-dbus/lsp-dbus.lsp b/lsp-dbus/lsp-dbus.lsp index 6b50235..a810998 100644 --- a/lsp-dbus/lsp-dbus.lsp +++ b/lsp-dbus/lsp-dbus.lsp @@ -14,6 +14,51 @@ (unless (context? MAIN:prog1) (load "misc.lsp")) (unless (context? MAIN:DbusConnection) (load "lsp-dbus-connection.lsp")) +################################################################# +;; 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 '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) @@ -24,6 +69,10 @@ (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) @@ -135,13 +184,13 @@ )))) ;; Context variables and framework registration - (setf SYSTEM-BUS (MAIN:DbusConnection "/run/dbus/system_bus_socket") APPID (:initialize SYSTEM-BUS) ROOT (Dbus "/org/freedesktop/DBus") - APPNAME (if (lookup "" (:invoke ROOT "org.freedesktop.DBus.Hello()")) - ($it 0)) + DBus (DbusInterface "org.freedesktop.DBus") + APPNAME (if (:invoke ROOT (:m DBus "Hello()")) + ($it -1 -1 -1)) ) ;; Installation of some framework notification handlers @@ -150,9 +199,9 @@ (define (signal-trace ARGS) (die nil "** Got:" KEY ARGS )) -(:handler ROOT "org.freedesktop.DBus.NameAcquired(s)" signal-trace) -(:handler ROOT "org.freedesktop.DBus.NameLost(s)" signal-trace) -(:handler ROOT "org.freedesktop.DBus.NameOwnerChanged(sss)" signal-trace) +(: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) @@ -162,66 +211,58 @@ ;;###################################################################### ;; -;; Some tidbits - -;;org.freedesktop.DBus.Peer.Ping () -;;org.freedesktop.DBus.Peer.GetMachineId (out STRING machine_uuid) -;;org.freedesktop.DBus.Introspectable.Introspect (out STRING xml_data) -;;org.freedesktop.DBus.Properties.Get ( -;; in STRING interface_name, -;; in STRING property_name, -;; out VARIANT value); -;;org.freedesktop.DBus.Properties.Set ( -;; in STRING interface_name, -;; in STRING property_name, -;; in VARIANT value); -;;org.freedesktop.DBus.Properties.GetAll ( -;; in STRING interface_name, -;; out ARRAY of DICT_ENTRY props); -;;org.freedesktop.DBus.Properties.PropertiesChanged ( -;; STRING interface_name, -;; ARRAY of DICT_ENTRY changed_properties, -;; ARRAY invalidated_properties); -;;org.freedesktop.DBus.ObjectManager.GetManagedObjects ( -;; out ARRAY of -;; DICT_ENTRY>> -;; objpath_interfaces_and_properties); -;;org.freedesktop.DBus.ObjectManager.GetManagedObjects():a(oa(sa(sv))) -; -;;org.freedesktop.DBus.Hello():s -;;org.freedesktop.DBus.RequestName(su):u -;;org.freedesktop.DBus.ReleaseName(s):u -;;org.freedesktop.DBus.ListQueuedOwners (s):as -;;org.freedesktop.DBus.ListNames():as -;;org.freedesktop.DBus.ListActivatableNames():as -;;org.freedesktop.DBus.NameHasOwner(s):b -;;org.freedesktop.DBus.NameOwnerChanged(sss) -- signal -;;org.freedesktop.DBus.NameLost(s) -- signal -;;org.freedesktop.DBus.NameAcquired(s) -- signal -;;org.freedesktop.DBus.ActivatableServicesChanged() -- signal -;;org.freedesktop.DBus.StartServiceByName(s,u):u -;;org.freedesktop.DBus.UpdateActivationEnvironment(a(ss)):? -;;org.freedesktop.DBus.GetNameOwner(s):s -;;org.freedesktop.DBus.GetConnectionUnixUser(s):u -;;org.freedesktop.DBus.GetConnectionUnixProcessID(s):u -;;org.freedesktop.DBus.GetConnectionCredentials(s):a(sv) -;;org.freedesktop.DBus.GetAdtAuditSessionData(s):ay -;;org.freedesktop.DBus.GetConnectionSELinuxSecurityContext(s):ay -;;org.freedesktop.DBus.AddMatch(s):? (org.freedesktop.DBus.Error.OOM) -;;org.freedesktop.DBus.RemoveMatch(s):? -;;org.freedesktop.DBus.GetId():s -;;org.freedesktop.DBus.Monitoring.BecomeMonitor(asu):? - -;;org.freedesktop.DBus.AddMatch(s) -;eg -;"type='signal',sender='org.example.App2',path_namespace='/org/example/App2'" +;; Standard interfaces + +(context MAIN) + +(:use (DbusInterface "org.freedesktop.DBus.Peer" + '( "Ping():" + "GetMachineId():s" + ))) -;;org.freedesktop.DBus.StartServiceByName(?) -;;org.freedesktop.DBus.NameOwnerChanged(?) +(:use (DbusInterface "org.freedesktop.DBus.ObjectManager" + '( "GetManagedObjects():a(oa(sa(sv)))" + ))) -;; org.freedesktop.DBus.Introspectable.Introspect():s (xml data) -;; https://dbus.freedesktop.org/doc/dbus-specification.html#introspection-format +(: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"