From 39a37b8ee724e81ba6f6b34b4b658aa962c62121 Mon Sep 17 00:00:00 2001
From: Jaidyn Ann <10477760+JadedCtrl@users.noreply.github.com>
Date: Sun, 16 Apr 2023 13:02:36 -0500
Subject: [PATCH] Support for org.freedesktop.DBus.Introspectable interface

---
 secrettabero.scm | 125 +++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 116 insertions(+), 9 deletions(-)

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
    "<!DOCTYPE node PUBLIC \"-//freedesktop//DTD D-BUS Object Introspection 1.0//EN\"
 \"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd\">\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