378 lines
16 KiB
Common Lisp
378 lines
16 KiB
Common Lisp
;; for the sly to use dynamibly decided sbcl impl, to pick up wrappers
|
|
;; with packages?
|
|
;; (setq inferior-lisp-program "/bin/env sbcl")
|
|
|
|
;; so. what? load dbus library and try out examples?
|
|
;; maybe i want to try some of the simpler function calls
|
|
;; and then get to screen sharing dialog, and print some info on frames?
|
|
|
|
;; https://nixos.org/manual/nixpkgs/stable/#lisp-building-wrappers
|
|
(load (sb-ext:posix-getenv "ASDF"))
|
|
(asdf:load-system 'alexandria)
|
|
(asdf:load-system 'dbus)
|
|
|
|
;; https://blog.macrolet.net/posts/DBus-and-PolicyKit-from-Common-Lisp.html
|
|
(defpackage #:example
|
|
(:use #:cl #:dbus))
|
|
|
|
(in-package #:example)
|
|
|
|
(with-open-bus (bus (system-server-addresses))
|
|
(with-introspected-object (authority bus
|
|
"/org/freedesktop/PolicyKit1/Authority"
|
|
"org.freedesktop.PolicyKit1")
|
|
(let* ((subject `("system-bus-name" (("name" ((:string) ,(bus-name bus))))))
|
|
(action-id "org.freedesktop.policykit.exec")
|
|
(details ())
|
|
(flags 1)
|
|
(cancellation-id "")
|
|
(result
|
|
(authority "org.freedesktop.PolicyKit1.Authority" "CheckAuthorization"
|
|
subject action-id details flags cancellation-id)))
|
|
(format T "~A~%" result))))
|
|
|
|
(dbus/server-addresses:system-server-addresses)
|
|
(system-server-addresses)
|
|
|
|
;; C-c is sly-prefix-map
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
|
|
(notification "org.freedesktop.Notifications" "Notify"
|
|
"Test" 0 "" "Test" "This is a test; I repeat, this is a test." '() '() -1)
|
|
))
|
|
|
|
;; ok, but how do i introspect which parameters i need to pass to the call?
|
|
;; i could use
|
|
;;$ qdbus org.freedesktop.Notifications /org/freedesktop/Notifications
|
|
;; from kdePackages.qttools
|
|
;; but i'd prefer from cl
|
|
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(list-names bus))
|
|
|
|
(with-open-connection (bus (make-instance 'iomux:event-base) (session-server-addresses))
|
|
(let ((obj (make-object-from-introspection bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")))
|
|
(format T "hello")
|
|
(format T "~A" obj)))
|
|
|
|
;; sly-macroexpand-1
|
|
;; (let ((bus
|
|
;; (open-connection (make-instance 'iolib/multiplex:event-base)
|
|
;; (session-server-addresses) :if-failed :error)))
|
|
;; (unwind-protect
|
|
;; (progn
|
|
;; (make-object-from-introspection bus "/org/freedesktop/Notifications"
|
|
;; "org.freedesktop.Notifications"))
|
|
;; (when bus (close-connection bus))))
|
|
|
|
;; oh, ok. make-object-from-introspection can be subsctituted with convenience
|
|
;; ' with-introspected-object' and that's already in examples
|
|
;; so convenience does hide the multiplexers and connecitons
|
|
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(list-names bus ))
|
|
|
|
;; "org.freedesktop.Notifications"
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(get-managed-objects bus "org.freedesktop.Notifications" ))
|
|
|
|
;; wait, what if i just use 'object in the forms passed to 'with-introspected-object'?
|
|
;; and gensyms pick it up? :shrug:
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(get-managed-objects bus "org.freedesktop.Notifications" "/org/freedesktop/Notifications" ))
|
|
;; nope
|
|
|
|
;; ok, found another example maybe
|
|
;; https://github.com/lucashpandolfo/udisks
|
|
;; well, maybe it should work?
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(get-managed-objects bus "org.gtk.vfs.AfcVolumeMonitor" "/org/gtk/Private/RemoteVolumeMonitor" ))
|
|
|
|
;; ok, maybe these servcies don't have managed objects?
|
|
;; otherwise they would have ObjectManager interface or something
|
|
;; so let's try to figure out which interface I need to add for
|
|
;; get-all-properties to work
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(get-all-properties bus "org.freedesktop.Notifications"
|
|
"/org/freedesktop/Notifications"
|
|
"org.freedesktop.Notifications"))
|
|
|
|
;; nil, but maybe because it has methods, not properties?
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(get-all-properties bus "org.freedesktop.portal.Desktop" "/org/freedesktop/portal/desktop" "org.freedesktop.portal.ScreenCast"))
|
|
|
|
;; (("AvailableSourceTypes" 0) ("AvailableCursorModes" 0) ("version" 4))
|
|
;; ok, so this is getting properties. cool
|
|
;; next - figuring out how to check method signatures?
|
|
;; should be possible no?
|
|
|
|
;; oh, maybe i should use 'make-object-from-introspection directly
|
|
;; but where do i get "connection?"
|
|
|
|
(format T "well")
|
|
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(format T "yoyo")
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(format T "in connection ~A" connection)
|
|
(let ((introspection (dbus/introspect:fetch-introspection-document connection "/org/freedesktop/Notifications" "org.freedesktop.Notifications")))
|
|
(format T "Introspection: ~A" introspection))
|
|
|
|
(let ((obj (make-object-from-introspection connection "/org/freedesktop/Notifications" "org.freedesktop.Notifications")))
|
|
(format T "hello")
|
|
(format T "~A" obj))))
|
|
|
|
(with-open-bus (my-bus (session-server-addresses))
|
|
(handler-case
|
|
(let ((props (dbus:get-all-properties my-bus "org.freedesktop.Notifications" "/org/freedesktop/Notifications" "org.freedesktop.Notifications")))
|
|
(format T "Notification properties: ~A~%" props))
|
|
(error (e)
|
|
(format T "Error getting properties: ~pA~%" e))))
|
|
|
|
;; well, strange
|
|
|
|
;; https://old.reddit.com/r/lisp/comments/179zl1/has_anyone_else_used_the_dbus_package_much/
|
|
(progn
|
|
(setf upower_conn
|
|
(open-connection
|
|
(make-instance 'iolib.multiplex:event-base) (system-server-addresses)))
|
|
(authenticate (supported-authentication-mechanisms upower_conn) upower_conn)
|
|
(hello upower_conn)
|
|
(invoke-method upower_conn "Introspect"
|
|
:path "/org/freedesktop/UPower"
|
|
:destination "org.freedesktop.UPower"
|
|
:interface "org.freedesktop.DBus.Introspectable"))
|
|
|
|
|
|
(progn
|
|
(setf upower_conn
|
|
(open-connection
|
|
(make-instance 'iolib.multiplex:event-base) (system-server-addresses)))
|
|
(authenticate (supported-authentication-mechanisms upower_conn) upower_conn)
|
|
(hello upower_conn)
|
|
(setf bat0_obj
|
|
(make-object-from-introspection
|
|
upower_conn
|
|
"/org/freedesktop/UPower/devices/battery_BAT0"
|
|
"org.freedesktop.UPower"))
|
|
(object-invoke bat0_obj "org.freedesktop.DBus.Properties" "GetAll" "org.freedesktop.UPower.Device"))
|
|
|
|
;; ok, so this works.
|
|
;; from 11 years ago, cool
|
|
;; creating object from introspection
|
|
;; doing invoke, but similar to with-object
|
|
|
|
;; let's try get object for Notification
|
|
;; and then try to print object and stuff
|
|
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(authenticate (supported-authentication-mechanisms connection) connection)
|
|
(hello connection)
|
|
(let ((obj (make-object-from-introspection connection "/org/freedesktop/Notifications" "org.freedesktop.Notifications")))
|
|
(print-object obj nil)
|
|
(list-object-interfaces obj))))
|
|
|
|
;; ok, so this works?
|
|
;; i needed both authenticate and hello, cool
|
|
;; thank you https://old.reddit.com/r/lisp/comments/179zl1/has_anyone_else_used_the_dbus_package_much/
|
|
|
|
;; (#<DBUS/INTROSPECT::INTERFACE "org.freedesktop.Notifications">
|
|
;; #<DBUS/INTROSPECT::INTERFACE "org.dunstproject.cmd0">
|
|
;; #<DBUS/INTROSPECT::INTERFACE "org.freedesktop.DBus.Peer">
|
|
;; #<DBUS/INTROSPECT::INTERFACE "org.freedesktop.DBus.Introspectable">
|
|
;; #<DBUS/INTROSPECT::INTERFACE "org.freedesktop.DBus.Properties">)
|
|
|
|
;; wowy, yeay!
|
|
;; i guess maybe now let's try to list interface on Desktop, which will have ScreenCast
|
|
|
|
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(authenticate (supported-authentication-mechanisms connection) connection)
|
|
(hello connection)
|
|
(let ((obj (make-object-from-introspection connection "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")))
|
|
(print-object obj nil)
|
|
(list-object-interfaces obj))))
|
|
|
|
;; nice!
|
|
|
|
;; so, what to try next though?
|
|
;; i wanted a way to check the funciton signatures
|
|
;; maybe for this one?
|
|
;; #<DBUS/INTROSPECT::INTERFACE "org.freedesktop.portal.Screenshot">
|
|
;; how do i get methods of an interface?
|
|
;; oh, so 'list-object-interfaces only returns values from hashmap that obj
|
|
;; already contains
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(authenticate (supported-authentication-mechanisms connection) connection)
|
|
(hello connection)
|
|
(let ((obj (make-object-from-introspection connection "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")))
|
|
(list-interface-methods (object-interface "org.freedesktop.portal.Screenshot" obj)))))
|
|
|
|
;; (#<DBUS/INTROSPECT::METHOD "PickColor" sa{sv}>
|
|
;; #<DBUS/INTROSPECT::METHOD "Screenshot" sa{sv}>)
|
|
;; ok, here are sa{sv} types of parameters, maybe this is it
|
|
;; i suppose next is figuring out how to call
|
|
|
|
;; let's read more general stuff about dbus then?
|
|
;; https://develop.kde.org/docs/features/d-bus/accessing_dbus_interfaces/
|
|
;; i think this is in C with qt library, but ok
|
|
|
|
;; here's about Variants https://doc.qt.io/qt-5/qvariant.html
|
|
;; what's that?
|
|
|
|
;; ok, now examples should be more understandable
|
|
;; https://github.com/death/dbus/blob/8bba6a0942232e9d7fa915b33bbe32dfedc5abb9/examples/notify.lisp
|
|
;; https://github.com/death/dbus/blob/8bba6a0942232e9d7fa915b33bbe32dfedc5abb9/examples/publish.lisp
|
|
|
|
;; maybe. let's try to call something with screenshots, let's go
|
|
|
|
;; https://flatpak.github.io/xdg-desktop-portal/docs/doc-org.freedesktop.portal.Screenshot.html
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(authenticate (supported-authentication-mechanisms connection) connection)
|
|
(hello connection)
|
|
(let ((obj (make-object-from-introspection connection "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")))
|
|
(list-interface-methods (object-interface "org.freedesktop.portal.Screenshot" obj)))))
|
|
|
|
;; for the sa{sv} looking into documentation
|
|
;; https://dbus.freedesktop.org/doc/dbus-specification.html#type-system
|
|
;; so for screenshot it's string, then array of dict entry string->variant
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(with-introspected-object (desktop bus "/org/freedesktop/portal/desktop" "org.freedesktop.portal.Desktop")
|
|
(desktop "org.freedesktop.portal.Screenshot" "Screenshot" "" '())))
|
|
|
|
;; dbus-send --session --dest=org.freedesktop.portal.Screenshot --type=method_call --print-reply /org/freedesktop/portal/desktop org.freedesktop.portal.Screenshot
|
|
|
|
;; well, calling Screenshot from the qdbusviewer doesn't work
|
|
;; maybe it can work from code,
|
|
;; not quite found an easy answer, but here's code for flameshot
|
|
;; https://github.com/flameshot-org/flameshot/blob/c1dac52231024174faa68a29577129ebca125dff/src/utils/screengrabber.cpp#L59
|
|
|
|
(iolib/multiplex:with-event-base (event-base)
|
|
(with-open-connection (connection event-base (session-server-addresses))
|
|
(authenticate (supported-authentication-mechanisms connection) connection)
|
|
(hello connection)
|
|
(let ((obj (make-object-from-introspection connection "/org/adeht/MyService" "org.adeht.MyService")))
|
|
(list-interface-methods (object-interface "org.adeht.MyService" obj))
|
|
))) ; missing Introspecable on the service defined through death/dbus
|
|
;; that's because 8 months ago introspection publishing was changed to be done by default
|
|
;; and my version is older, i could try to set up separate action from removed example?
|
|
;; but better to try to update
|
|
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(with-introspected-object (desktop bus "/org/adeht/MyService" "org.adeht.MyService")
|
|
(desktop "org.adeht.MyService" "my-method" "hello")))
|
|
|
|
;; trying from another discussion
|
|
;; still trying to receive a signal
|
|
(define-dbus-object root
|
|
(:path "/"))
|
|
|
|
(dbus:define-dbus-object my-notifications-service
|
|
(:path "/org/freedesktop/Notifications")
|
|
(:parent root))
|
|
|
|
;; (dbus:define-dbus-signal-handler (my-notifications-service notification-closed) ()
|
|
;; (:interface "org.freedesktop.Notifications")
|
|
;; (format t "Got notification closed without parameters" )
|
|
;; (force-output))
|
|
|
|
(dbus:define-dbus-signal-handler (my-notifications-service notification-closed) ((id :uint32) (reason :uint32))
|
|
(:interface "org.freedesktop.Notifications")
|
|
(format t "Got notification closed with parameters ~A ~A" id reason)
|
|
(force-output))
|
|
|
|
(define-dbus-signal-handler (my-notifications-service on-non-notification-end-signal) ((s :string))
|
|
(:interface "org.adeht.MyService")
|
|
(format t "Got signal with arg ~S~%" s)
|
|
(force-output))
|
|
|
|
(defun example-listen-to-notification ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (session-server-addresses))
|
|
; (dbus:add-match bus :type :signal :interface "org.freedesktop.Notifications" :member "NotificationClosed")
|
|
; (dbus:add-match bus :type :signal :interface "org.adeht.MyService")
|
|
(dbus:add-match bus :type :signal :path "/org/freedesktop/Notifications")
|
|
(format t "Bus connection name: ~A~%" (dbus:bus-name bus))
|
|
(dbus:publish-objects bus))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|
|
|
|
|
|
|
|
|
|
;; signal time=1719758221.505386 sender=:1.64 -> destination=:1.162 serial=83 path=/org/freedesktop/Notifications; interface=org.freedesktop.Notifications; member=NotificationClosed
|
|
;; uint32 15
|
|
;; uint32 2
|
|
(with-open-bus (bus (session-server-addresses))
|
|
(with-introspected-object (notification bus "/org/freedesktop/Notifications" "org.freedesktop.Notifications")
|
|
(notification "org.freedesktop.Notifications" "Notify"
|
|
"Test" 0 "" "Test" "This is a test; I repeat, this is a test." '() '() -1)
|
|
))
|
|
|
|
;; yes, i re-declared signal handler without parameters and now it catches
|
|
;; the
|
|
;; goood!
|
|
|
|
;; but it doesn't catch when i actually close the notification
|
|
;; maybe because of parameters?
|
|
;; oh, maybe uint32 are not the ones i had before in the signature
|
|
|
|
;; this works for my extra interface handler:
|
|
;; $ dbus-send --session --type=signal /org/freedesktop/Notifications org.adeht.MyService.OnNonNotificationEndSignal string:"Hello yayyaline"
|
|
|
|
;; huh. so manual with uint32 works
|
|
;; dbus-send --session --type=signal /org/freedesktop/Notifications org.freedesktop.Notifications.NotificationClosed uint32:4 uint32:8
|
|
|
|
;; and if i only define without params, then manual without params works
|
|
;; dbus-send --session --type=signal /org/freedesktop/Notifications org.freedesktop.Notifications.NotificationClosed
|
|
|
|
;; but the one from actually closed notification doesn't work?
|
|
;; in dbus-monitor one from actually closing:
|
|
;; signal time=1719765073.249989 sender=:1.45 -> destination=:1.112 serial=51 path=/org/freedesktop/Notifications; interface=org.freedesktop.Notifications; member=NotificationClosed
|
|
;; uint32 11
|
|
;; uint32 2
|
|
|
|
;; and from manual invocation:
|
|
;; signal time=1719765156.257421 sender=:1.115 -> destination=(null destination) serial=2 path=/org/freedesktop/Notifications; interface=org.freedesktop.Notifications; member=NotificationClosed
|
|
;; uint32 2222
|
|
;; uint32 11111
|
|
|
|
;; is there any visible difference?
|
|
;; aaand, yeah, i get with manual and dont get with actual
|
|
|
|
;; aaand, yes.
|
|
;; when signal has "destination" set - it's not broadcasted,
|
|
;; so, not everyone gets it. when i do actual closing of notification
|
|
;; the resulting NotificationClosed is likely sent to caller
|
|
;; and my code doesn't receive it, coool
|
|
;; $ dbus-send --session --type=signal --dest=:1.108 /org/freedesktop/Notifications org.freedesktop.Notifications.NotificationClosed uint32:777 uint32:333
|
|
;; this works - when i match with a name from "Bus connection name"
|
|
|
|
;; yay. i suppose
|
|
;; now what would be an example of broadcasted signal that i could listen to
|
|
;; in my example
|
|
|
|
;; let's do safeeyes icon change:
|
|
;; signal time=1719766048.367111 sender=:1.34 -> destination=(null destination) serial=101 path=/org/ayatana/NotificationItem/safeeyes_2; interface=org.kde.StatusNotifierItem; member=NewIcon
|
|
|
|
(dbus:define-dbus-object my-safeeyes-listener
|
|
(:path "/org/ayatana/NotificationItem/safeeyes_2"))
|
|
|
|
(dbus:define-dbus-signal-handler (my-safeeyes-listener new-icon) ()
|
|
(:interface "org.kde.StatusNotifierItem")
|
|
(format t "Got notification on the safeeyes icon change~%" )
|
|
(force-output))
|
|
|
|
(defun example-listen-to-safeeys ()
|
|
(handler-case
|
|
(dbus:with-open-bus (bus (session-server-addresses))
|
|
(dbus:add-match bus :type :signal :interface "org.kde.StatusNotifierItem")
|
|
(format t "Bus connection name: ~A~%" (dbus:bus-name bus))
|
|
(dbus:publish-objects bus))
|
|
(end-of-file ()
|
|
:disconnected-by-bus)))
|