Fun (system foreign) / D-Bus / oFono hacking

[Neil Jerram]

Just in case anyone else is interested in these areas...  I had a really
fun time today using the dynamic FFI to hack up Guile code to access
oFono's D-Bus API.  It's really great to be able to do this, even if it
might be more efficient in the long run to write a proper C binding.

I've attached the extremely-thrown-together code below.  Obviously it
ought to evolve (at least) into a more generic D-Bus module, and an
oFono-specific module that uses that, but right now I'm just playing...

      Neil



(use-modules (system foreign)
             (rnrs bytevectors))


(define gobject (dynamic-link "libgobject-2.0"))
(define glib (dynamic-link "libglib-2.0"))
(define gio (dynamic-link "libgio-2.0"))

(write gobject)
(newline)
(write glib)
(newline)
(write gio)
(newline)

(dynamic-call "g_type_init" gobject)

(define FALSE 0)
(define TRUE 1)

(define g_main_loop_new
  (pointer->procedure '*
                      (dynamic-func "g_main_loop_new" glib)
                      (list '* int)))

(define loop (g_main_loop_new %null-pointer FALSE))

(write loop)
(newline)

(define g_dbus_proxy_new_for_bus_sync
  (pointer->procedure '*
                      (dynamic-func "g_dbus_proxy_new_for_bus_sync" gio)
                      (list int         ; bus type
                            int         ; flags
                            '*          ; interface info
                            '*          ; bus name
                            '*          ; object path
                            '*          ; interface name
                            '*          ; cancellable
                            '*          ; error
                            )))


;; bus type
(define G_BUS_TYPE_SYSTEM 1)
(define G_BUS_TYPE_SESSION 2)

;; flags
(define G_DBUS_PROXY_FLAGS_NONE 0)

(define manager-proxy
  (g_dbus_proxy_new_for_bus_sync G_BUS_TYPE_SYSTEM
                                 G_DBUS_PROXY_FLAGS_NONE
                                 %null-pointer
                                 (string->pointer "org.ofono")
                                 (string->pointer "/")
                                 (string->pointer "org.ofono.Manager")
                                 %null-pointer
                                 %null-pointer))

(write manager-proxy)
(newline)

(define g_dbus_proxy_call_sync
  (pointer->procedure '*
                      (dynamic-func "g_dbus_proxy_call_sync" gio)
                      (list '*          ; proxy
                            '*          ; method_name
                            '*          ; parameters
                            int         ; flags
                            int         ; timeout_msec
                            '*          ; cancellable
                            '*          ; error
                            )))

(define return-parms (g_dbus_proxy_call_sync manager-proxy
                                             (string->pointer "GetModems")
                                             %null-pointer
                                             0
                                             1000
                                             %null-pointer
                                             %null-pointer))

(define g_variant_get_child_value
  (pointer->procedure '*
                      (dynamic-func "g_variant_get_child_value" glib)
                      (list '*          ; variant
                            int         ; index
                            )))

(define g_variant_print
  (pointer->procedure '*
                      (dynamic-func "g_variant_print" glib)
                      (list '*          ; variant
                            int         ; type annotate
                            )))

(define g_variant_get_type
  (pointer->procedure '*
                      (dynamic-func "g_variant_get_type" glib)
                      (list '*          ; variant
                            )))

(define g_variant_get_string
  (pointer->procedure '*
                      (dynamic-func "g_variant_get_string" glib)
                      (list '*          ; variant
                            '*          ; length
                            )))

(define (print-variant variant)
  (if (null-pointer? variant)
      (display "(null variant pointer)")
      (begin
        (display (pointer->string (g_variant_get_type variant)))
        (display ": ")
        (display (pointer->string (g_variant_print variant FALSE)))))
  (newline))

(print-variant return-parms)

(define modems (g_variant_get_child_value return-parms 0))
(print-variant modems)

(define first-modem (g_variant_get_child_value modems 0))
(print-variant first-modem)

(define modem-name (g_variant_get_child_value first-modem 0))
(print-variant modem-name)

(define modem-name-string
  (pointer->string (g_variant_get_string modem-name %null-pointer)))
(format #t "First modem's name is ~a\n" modem-name-string)

(define modem-proxy
  (g_dbus_proxy_new_for_bus_sync G_BUS_TYPE_SYSTEM
                                 G_DBUS_PROXY_FLAGS_NONE
                                 %null-pointer
                                 (string->pointer "org.ofono")
                                 (string->pointer modem-name-string)
                                 (string->pointer "org.ofono.Modem")
                                 %null-pointer
                                 %null-pointer))

(write modem-proxy)
(newline)

(define g_variant_new_string
  (pointer->procedure '*
                      (dynamic-func "g_variant_new_string" glib)
                      (list '*          ; string
                            )))

(define g_variant_new_boolean
  (pointer->procedure '*
                      (dynamic-func "g_variant_new_boolean" glib)
                      (list int         ; boolean
                            )))

(define g_variant_new_tuple
  (pointer->procedure '*
                      (dynamic-func "g_variant_new_tuple" glib)
                      (list '*          ; GVariant **
                            int         ; num children
                            )))

(define powered (g_variant_new_string (string->pointer "Powered")))
(print-variant powered)
(define true (g_variant_new_boolean TRUE))
(print-variant true)

(define bv (uint-list->bytevector (map pointer-address
                                       (list powered true))
                                  (native-endianness)
                                  (sizeof '*)))
(write bv)
(newline)

(define parms (g_variant_new_tuple (bytevector->pointer bv) 2))
(print-variant parms)

(define return-parms
  (g_dbus_proxy_call_sync modem-proxy
                          (string->pointer "SetProperty")
                          parms
                          0
                          1000
                          %null-pointer
                          %null-pointer))

(print-variant return-parms)