Re: Proof of concept: Shepherd + DBus = ♥

[Maxim Cournoyer]

Hi Liliana,

Liliana Marie Prikler <liliana.prikler@gmail.com> writes:

> Hi Guix,
>
> this comes a little late, as Gnome folks have decided that evaluating
> arbitrary Javascript over DBus is perhaps not always the wisest idea¹,
> but I want to share with you a cool nifty tool regardless.
>
> For starters, recall that Guix can only really set up its profile
> environment variables during login – that is if all processes are to
> respect them.  This brings us into a weird chimera state after running
> `guix package': Any new variable introduced in our profile will be lost
> until we restart our shell.  Or will it?
>
> Enter guile-ac-d-bus.  With the newest version of Guile (3.0.9 at time
> of writing), we can actually connect to the session bus and do cool
> stuff with it.  Watch me:
>
> (define (d-bus-send/wait-for-reply bus message)
>   (let ((serial (d-bus-write-message bus message)))
>     (d-bus-conn-flush bus)
>     (let loop ((msg (d-bus-read-message bus)))
>       (if (equal? (d-bus-headers-ref (d-bus-message-headers msg)
>                                      'REPLY_SERIAL)
>                   serial)
>           msg
>           (loop (d-bus-read-message bus))))))
>
> (let ((bus (d-bus-connect))
>       (message (make-d-bus-message
>                 MESSAGE_TYPE_METHOD_CALL 0 #f '()
>                 (vector
>                  (header-PATH "/org/freedesktop/DBus")
>                  (header-DESTINATION "org.freedesktop.DBus")
>                  (header-INTERFACE "org.freedesktop.DBus")
>                  (header-MEMBER "Hello"))
>                 #f)))
>   (write (d-bus-send/wait-for-reply bus message))
>   (d-bus-disconnect bus))
>
>
> Okay, but how does this solve our aforementioned problem?
> Well...
>
> (define shell
>   (make <service>
>     #:docstring "Communicate with the GNOME Shell"
>     #:provides '(gnome shell)
>     #:start
>     (lambda ()
>       (let ((bus (d-bus-connect))
>             (message (make-d-bus-message
>                       MESSAGE_TYPE_METHOD_CALL 0 #f '()
>                       (vector
>                        (header-PATH "/org/freedesktop/DBus")
>                        (header-DESTINATION "org.freedesktop.DBus")
>                        (header-INTERFACE "org.freedesktop.DBus")
>                        (header-MEMBER "Hello"))
>                       #f)))
>         (d-bus-send/wait-for-reply bus message)
>         bus))
>     #:stop
>     (lambda (conn)
>       (when conn (d-bus-disconnect conn))
>       #f)
>     #:actions
>     (let ((action->js
>            (lambda (action . args)
>              (format #f "imports.gi.GLib.~a(~{~s~^,~})" action args)))
>           (shell-exec
>            (lambda (conn js)
>              (let ((method-call
>                     (make-d-bus-message
>                      MESSAGE_TYPE_METHOD_CALL 0 #f '()
>                      (vector
>                       (header-PATH        "/org/gnome/Shell")
>                       (header-DESTINATION "org.gnome.Shell")
>                       (header-INTERFACE   "org.gnome.Shell")
>                       (header-SIGNATURE   "s")
>                       (header-MEMBER      "Eval"))
>                      (list js))))
>                (let ((reply (d-bus-send/wait-for-reply conn 
>                                                        method-call)))
>                  (apply peek 'reply (d-bus-message-body reply)))))))
>       (make-actions
>        (getenv
>         (lambda (conn var)
>           (and=> conn (cut shell-exec <>
>                            (action->js 'getenv var)))))
>        (setenv
>         (lambda (conn var val)
>           (and=> conn (cut shell-exec <>
>                            (action->js 'setenv var val)))))
>        (unsetenv
>         (lambda (conn var)
>           (and=> conn (cut shell-exec <>
>                            (action->js 'unsetenv var)))))))))
>

Interesting!

[...]

> Anyway, we can now talk to DBus services from Shepherd, although doing
> so is currently a bit of a pain in the buttocks.  Much of this is due
> to guile-ac-d-bus being somewhat obtuse and not having enough fibers in
> it.  That being said, I'm sure there's some other use-case out there
> that is a good fit for this (wanna talk to loginctl for hibernation
> perhaps?)

One use case I saw while working on jami-service-type, where I used
guile-ac-d-bus (you may want to take a peek at (guix build
dbus-service)) to talk to its daemon via its D-Bus interface, was to
wait until a D-Bus service is truly 'activated'.

We've had problems in the past for example where services would start
before a critical D-Bus service was truly up (activated), and this could
be used to poll for the D-Bus service.  The 'dbus-available-services'
procedure from (guix build dbus-services) could be used to poll and
delay a service to start until its D-Bus requirement is running.

-- 
Thanks,
Maxim