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)
