diff --git a/secrettabero.scm b/secrettabero.scm index 613bb3e..fe912bb 100644 --- a/secrettabero.scm +++ b/secrettabero.scm @@ -18,29 +18,43 @@ (import (prefix dbus dbus:) sxml-serializer) +;; Debugging +(dbus:default-signal-handler (lambda (ctx mber args) + ((dbus:printing-signal-handler) ctx mber args) + (dbus:dump-callback-table))) + + + +;; ————————————————————————————————————— +;; Utilities +;; ————————————————————————————————————— + ;; Generate `Introspect`-form XML for a DBUS node, given its interfaces. ;; The interfaces should be in the format: ;; (INTERFACE-NAME . ((METHOD-NAME-A . ARGUMENT-ALISTS-A) ;; (METHOD-NAME-B . ARGUMENT-ALISTS-B) ;; ...)) ;; The argument alists should have the traits 'name, 'direction, and 'type. -(define (introspect-node-xml interfaces) +(define (introspect-node-xml interfaces #!optional (subnodes '())) (string-append "\n\n" - (serialize-sxml (introspect-node-sxml interfaces) + (serialize-sxml (introspect-node-sxml interfaces subnodes) #f))) ;; Generate a node's list containing the given interfaces, for use with SXML for ;; serialization to `Introspect`-friendly XML. ;; See `introspect-node-xml` for a description of the structure. -(define (introspect-node-sxml interfaces) +(define (introspect-node-sxml interfaces #!optional (subnodes '())) (append (list 'node) (map (lambda (interface-list) (introspect-interface-sxml (car interface-list) (cdr interface-list))) - interfaces))) + interfaces) + (map (lambda (subnode) + `(node (@ (name ,subnode)))) + subnodes))) ;; Generate an interface's list of the given name and methods, @@ -89,8 +103,96 @@ -;; The callback function for org.freedesktop.DBus.Introspectable's `Introspect`. -(define (introspection-introspect) +;; ————————————————————————————————————— +;; DBUS Path: / +;; ————————————————————————————————————— + +;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`. +(define (root-introspection-introspect) + (introspect-node-xml + '(("org.freedesktop.DBus.Introspectable" + . (("Introspect" + . (((direction . "out") + (type . "s") + (name . "xml_data"))))))) + '(org))) + + +;; The DBUS context used for introspection. +(define root-introspection-context + (dbus:make-context + bus: dbus:session-bus + service: 'org.jadedctrl.secrettabero + interface: 'org.freedesktop.DBus.Introspectable + path: '/)) + +(dbus:register-method root-introspection-context "Introspect" + root-introspection-introspect) + + + +;; ————————————————————————————————————— +;; DBUS Path: /org/ +;; ————————————————————————————————————— + +;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`. +(define (root-org-introspection-introspect) + (introspect-node-xml + '(("org.freedesktop.DBus.Introspectable" + . (("Introspect" + . (((direction . "out") + (type . "s") + (name . "xml_data"))))))) + '(freedesktop))) + + +;; The DBUS context used for introspection. +(define root-org-introspection-context + (dbus:make-context + bus: dbus:session-bus + service: 'org.jadedctrl.secrettabero + interface: 'org.freedesktop.DBus.Introspectable + path: '/org)) + +(dbus:register-method root-org-introspection-context "Introspect" + root-org-introspection-introspect) + + + +;; ————————————————————————————————————— +;; DBUS Path: /org/freedesktop/ +;; ————————————————————————————————————— + +;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`. +(define (root-org-freedesktop-introspection-introspect) + (introspect-node-xml + '(("org.freedesktop.DBus.Introspectable" + . (("Introspect" + . (((direction . "out") + (type . "s") + (name . "xml_data"))))))) + '(secrets))) + + +;; The DBUS context used for introspection. +(define root-org-freedesktop-introspection-context + (dbus:make-context + bus: dbus:session-bus + service: 'org.jadedctrl.secrettabero + interface: 'org.freedesktop.DBus.Introspectable + path: '/org/freedesktop)) + +(dbus:register-method root-org-freedesktop-introspection-context "Introspect" + root-org-freedesktop-introspection-introspect) + + + +;; ————————————————————————————————————— +;; DBUS Path: /org/freedesktop/secrets +;; ————————————————————————————————————— + +;; Callback function for org.freedesktop.DBus.Introspectable's `Introspect`. +(define (root-org-freedesktop-secrets-introspection-introspect) (introspect-node-xml '(("org.freedesktop.DBus.Introspectable" . (("Introspect" @@ -100,17 +202,22 @@ ;; The DBUS context used for introspection. -(define introspection-context +(define root-org-freedesktop-secrets-introspection-context (dbus:make-context bus: dbus:session-bus service: 'org.jadedctrl.secrettabero interface: 'org.freedesktop.DBus.Introspectable - path: '/)) + path: '/org/freedesktop/secrets)) -(dbus:register-method introspection-context "Introspect" introspection-introspect) +(dbus:register-method root-org-freedesktop-secrets-introspection-context "Introspect" + root-org-freedesktop-secrets-introspection-introspect) +;; ————————————————————————————————————— +;; Invocation +;; ————————————————————————————————————— + (let loop () ; (printf "poll~%") ; (dbus:poll-for-message bus: dbus:session-bus) ;; would be the session-bus by default anyway