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]