libdbus mainloop

[Matt Wette]

So just goofing around with libdbus. I did write a mainloop on top of libdbus
and epoll (w/ Guile API provided by the FFI Helper). I can spawn off a thread
for the loop, fire off a message and poll for the return. One is supposed to
take care about thread safety with libdbus, and there does not seem to be a lot
of documentation (at least I could not find much). However, I have generated
thread-safe timeout handlers. I think it is safe in the way I use it.


mwette$ guile dbus05.scm
there-yet? => #f
there-yet? => #t
result:
(("Serial" . 59)
("ListMemPoolUsedBytes" . 75168)
("ListMemPoolCachedBytes" . 7320)
("ListMemPoolAllocatedBytes" . 97920)
("ActiveConnections" . 75)
("IncompleteConnections" . 0)
("MatchRules" . 930)
("PeakMatchRules" . 1087)
("PeakMatchRulesPerConnection" . 188)
("BusNames" . 142)
("PeakBusNames" . 146)
("PeakBusNamesPerConnection" . 7))

mwette$ cat dbus05.scm
;; dbus05.scm - mainloop example

(use-modules (dbus00))
(use-modules (dbusML))
(use-modules (ffi dbus))
(use-modules (system ffi-help-rt))
(use-modules ((system foreign) #:prefix ffi:))
(use-modules (ice-9 pretty-print))

(define (sf fmt . args) (apply simple-format #t fmt args))
(define pp pretty-print)

(define (send-msg conn msg)
(let ((pending (make-DBusPendingCall*)))
(if (eqv? FALSE
(dbus_connection_send_with_reply conn msg (pointer-to pending) -1))
(error "*** send_with_reply FAILED\n"))
(dbus_message_unref msg)
pending))

(define (there-yet? pending)
(eqv? TRUE (dbus_pending_call_get_completed pending)))

(define (handle-it pending)
(let ((msg (dbus_pending_call_steal_reply pending))
(msg-iter (make-DBusMessageIter)))
(if (zero? (fh-object-ref msg)) (error "*** reply message NULL\n"))
(dbus_pending_call_unref pending)
(dbus_message_iter_init msg (pointer-to msg-iter))
(sf "result:\n")
(pretty-print (read-dbus-val (pointer-to msg-iter)) #:per-line-prefix " ")
(dbus_message_unref msg)))

(define (block-and-handle-it pending)
(dbus_pending_call_block pending)
(handle-it pending))

;; ==========================================================================

(define conn (spawn-dbus-mainloop 'session))

(define msg (dbus_message_new_method_call
"org.freedesktop.DBus" ; bus name
"/org/freedesktop/DBus" ; object path
"org.freedesktop.DBus.Debug.Stats" ; interface name
"GetStats")) ; method

(define pending (send-msg conn msg))

(let iter ((got-it? (there-yet? pending)))
(sf "there-yet? => ~S\n" got-it?)
(cond
(got-it? (handle-it pending))
(else
(sleep 1)
(iter (there-yet? pending)))))

;; --- last line ---

TO TRY IT:
$ git clone -b c99dev git://git.savannah.nongnu.org/nyacc.git
$ cd nyacc/examples
$ . env.sh
$ guild compile-ffi ffi/epoll.ffi
$ guild compile-ffi ffi/dbus.ffi
$ cd nyacc/lang/c99/ffi-exam
$ guile dbus05.scm [will take some time to compile everything]

[caveat: you may need `.' in your GUILD_LOAD_PATH]