Proof of concept: Shepherd + DBus = ♥

[Liliana Marie Prikler <liliana.prikler@gmail.com>]

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:

--8<---------------cut here---------------start------------->8---
(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))
--8<---------------cut here---------------end--------------->8---

Okay, but how does this solve our aforementioned problem?
Well...

--8<---------------cut here---------------start------------->8---
(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)))))))))
--8<---------------cut here---------------end--------------->8---

Once you set the unsafe flag in Looking Glass and promise to be a very
good girl, you can now extract environment variables.

--8<---------------cut here---------------start------------->8---
$ herd getenv gnome PATH              

;;; (reply #t "\"/gnu/store/s43dhx83c3a2g79vs5anf3wdmv9lwpi3-glib-
2.70.2-bin/bin:/run/setuid-
programs:/home/yuri/.config/guix/current/bin:$HOME/.guix-
profile/bin:$HOME/.guix-profile/sbin:/run/current-
system/profile/bin:/run/current-system/profile/sbin\"")
--8<---------------cut here---------------end--------------->8---

If you were naughty and didn't do the magic dance, you get a rather
unhelpful result instead.

--8<---------------cut here---------------start------------->8---
$ herd getenv gnome PATH              

;;; (reply #f "")
--8<---------------cut here---------------end--------------->8---

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?)

Cheers

¹ How dare they?  Don't they know that this breaks my spacebar heating
workflow?