Using DBus to receive signals (BluetoothLE, BLE)

[Graham1]

I'm learning how to use DBus (with a plan to then use it to access Bluez for BluetoothLE support) and was working from this page:

https://wiki.freepascal.org/FPC_and_DBus

For receiving a signal it doesn't give much detail, but a reference at the bottom of the page links to here:

http://www.matthew.ath.cx/misc/dbus

It appears the Wiki page took the first section of the C code but not the second. If I convert that C code into Pascal (i.e. using a loop combined with dbus_connection_read_write(conn, 0); to check for signals) then it works. And if I have this in a form then starting a thread to handle the loop also works.

I was wondering why the second section was not included in the Wiki? Is this because there is a better way of handling the DBus signal events in Lazarus than having a loop checking for them? On the one hand a loop seems like a sensible way to do it, but on the other hand it doesn't seem very event based.

If I look at a small Python script that does a similar thing I see it uses GLib:

Code: Bash  [Select][+][-]

1. #!/usr/bin/python3
2. import dbus
3. import dbus.mainloop.glib
4. from gi.repository import GLib
5.  
6. mainloop = None
7.  
8. def greeting_signal_received(greeting):
9.         print(greeting)
10.  
11. dbus.mainloop.glib.DBusGMainLoop(set_as_default=True)
12. bus = dbus.SystemBus()
13. bus.add_signal_receiver(greeting_signal_received,
14.                 dbus_interface = "com.example.greeting",
15.                 signal_name = "GreetingSignal")
16.  
17. mainloop = GLib.MainLoop()
18. mainloop.run()

Is there an equivalent method to this in Pascal?

Thanks!

[Thaddy]

Is there an equivalent method to this in Pascal?

Michael van Canneyt wrote some good articles on the subject.
https://www.freepascal.org/~michael/articles/#dbus1
https://www.freepascal.org/~michael/articles/#dbus2

He is also one of the core developers and wrote those great FPC manuals.....

So the answer is Yes.
And in a much cleaner way than the Python code. (That's opinion, not fact)

[Graham1]

Hi Thaddy, thank you for your reply and sorry it's taken me so long to respond. I've been trying out the DBuscomp unit and at first it was going well. My first simple program, to get the hostname was this:

Code: Pascal  [Select][+][-]

1. program p01_get_hostname;
2.  
3. uses dbus;
4.  
5. var
6.   err                      : DBusError;
7.   conn                     : PDBusConnection;
8.   msg, replymsg            : PDBusMessage;
9.   args, replyargs, subargs : DBusMessageIter;
10.   arg1, arg2               : PChar;
11.   hostname                 : PChar;
12.  
13. begin
14.  
15.   // initialise the error value
16.   dbus_error_init(@err);
17.  
18.   // connect to the DBUS system bus and check for errors
19.   conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);
20.   if dbus_error_is_set(@err) <> 0 then begin
21.     writeln('Connection Error :', err.message);
22.     dbus_error_free(@err);
23.   end;
24.   if conn = nil then exit;
25.  
26.   // create message and check for errors
27.   msg := dbus_message_new_method_call(
28.     'org.freedesktop.hostname1',
29.     '/org/freedesktop/hostname1',
30.     'org.freedesktop.DBus.Properties',
31.     'Get');
32.   if msg = nil then begin
33.     writeLn('Could not construct message: ' + err.message);
34.     dbus_error_free(@err);
35.   end;
36.  
37.   // initialise parameter list for appending
38.   arg1 := pchar('org.freedesktop.hostname1');
39.   arg2 := pchar('Hostname');
40.  
41.   // add parameter arguments
42.   dbus_message_iter_init_append(msg, @args);
43.   if dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg1) = 0 then begin
44.     writeln('Out Of Memory on arg1!');
45.     exit;
46.   end;
47.   if dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg2) = 0 then begin
48.     writeln('Out Of Memory on arg2!');
49.     exit;
50.   end;
51.  
52.   // send message and block while waiting for reply
53.   replymsg := dbus_connection_send_with_reply_and_block(conn, msg, 1000, @err);
54.  
55.   if dbus_error_is_set(@err) <> 0 then begin
56.     writeLn('Error waiting for reply: ' + err.message);
57.     dbus_error_free(@err);
58.   end;
59.  
60.   // initialise reply argument list then check type of return value
61.   // before retrieving value
62.   if dbus_message_iter_init(replymsg, @replyargs) = 0 then
63.     writeln('No return value')
64.   else
65.   if dbus_message_iter_get_arg_type(@replyargs) <> DBUS_TYPE_VARIANT then
66.     writeln('Return value is not a variant: ' + chr(dbus_message_iter_get_arg_type(@replyargs)))
67.   else begin
68.     // convert variant data
69.     dbus_message_iter_recurse(@replyargs, @subargs);
70.     if dbus_message_iter_get_arg_type(@subargs) <> DBUS_TYPE_STRING then
71.       writeln('Return value is not a string: ' + chr(dbus_message_iter_get_arg_type(@subargs)))
72.     else
73.       dbus_message_iter_get_basic(@subargs, @hostname);
74.   end;
75.  
76.   if hostname <> nil then writeln('Hostname is: ' + hostname);
77.  
78.   // free the messages and finish using the connection
79.   dbus_message_unref(replymsg);
80.   dbus_message_unref(msg);
81.   dbus_connection_unref(conn);
82.  
83. end.

which converted neatly into:

Code: Pascal  [Select][+][-]

1. program c01_get_hostname;
2.  
3. {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
4.  
5. uses variants, dbuscomp;
6.  
7. var
8.   Conn     : TDBUSConnection;
9.   M        : TDBUSMethodCallMessage;
10.   R        : TDBUSMessage;
11.   V        : Variant;
12.   Hostname : string;
13.  
14. begin
15.  
16.   Conn:=TDBUSConnection.Create(Nil);
17.  
18.   try
19.     Conn.kind:=ckSystem;
20.     Conn.Connect;
21.  
22.     M:=TDBUSMethodCallMessage.Create(
23.       'org.freedesktop.hostname1',
24.       '/org/freedesktop/hostname1',
25.       'org.freedesktop.DBus.Properties',
26.       'Get');
27.  
28.     M.AppendArgument('org.freedesktop.hostname1');
29.     M.AppendArgument('Hostname');
30.  
31.     R:=Conn.SendWithReplyAndBlock(M,1000);
32.  
33.     V:='';
34.     R.GetArgument(V);
35.     Hostname:=V;
36.  
37.     Writeln(Hostname);
38.  
39.   finally
40.     R.Free;
41.     M.Free;
42.     Conn.Free;
43.   end;
44.  
45. end.

So I moved on to my next program which uses a GetAll rather than a Get:

Code: Pascal  [Select][+][-]

1. program p02_get_all;
2.  
3. uses dbus;
4.  
5. var
6.   err                      : DBusError;
7.   conn                     : PDBusConnection;
8.   msg, replymsg            : PDBusMessage;
9.   args, replyargs, subargs : DBusMessageIter;
10.   arg1                     : PChar;
11.   argType                  : Integer;
12.   arry, dict               : DBusMessageIter;
13.   dictKey, dictVal         : PChar;
14.  
15. begin
16.  
17.   // initialise the error value
18.   dbus_error_init(@err);
19.  
20.   // connect to the DBUS system bus and check for errors
21.   conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);
22.   if dbus_error_is_set(@err) <> 0 then begin
23.     writeln('Connection Error :', err.message);
24.     dbus_error_free(@err);
25.   end;
26.   if conn = nil then exit;
27.  
28.   // create message and check for errors
29.   msg := dbus_message_new_method_call(
30.     'org.freedesktop.hostname1',
31.     '/org/freedesktop/hostname1',
32.     'org.freedesktop.DBus.Properties',
33.     'GetAll');
34.   if msg = nil then begin
35.     writeLn('Could not construct message: ' + err.message);
36.     dbus_error_free(@err);
37.   end;
38.  
39.   // initialise parameter list for appending
40.   arg1 := pchar('org.freedesktop.hostname1');
41.  
42.   // add parameter arguments
43.   dbus_message_iter_init_append(msg, @args);
44.   if dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg1) = 0 then begin
45.     writeln('Out Of Memory on arg1!');
46.     exit;
47.   end;
48.  
49.   // send message and block while waiting for reply
50.   replymsg := dbus_connection_send_with_reply_and_block(conn, msg, 1000, @err);
51.  
52.   if dbus_error_is_set(@err) <> 0 then begin
53.     writeLn('Error waiting for reply: ' + err.message);
54.     dbus_error_free(@err);
55.   end;
56.  
57.   // initialise reply argument list then check type of return value
58.   // before retrieving value
59.   repeat
60.  
61.     if dbus_message_iter_init(replymsg, @replyargs) = 0 then begin
62.       writeln('No return value');
63.       break;
64.     end;
65.     if dbus_message_iter_get_arg_type(@replyargs) <> DBUS_TYPE_ARRAY then begin
66.       writeln('Return value is not an array: ' + chr(dbus_message_iter_get_arg_type(@replyargs)));
67.       break;
68.     end;
69.  
70.     // check first item is a dictionary entry
71.     dbus_message_iter_recurse(@replyargs, @arry);
72.     argType := dbus_message_iter_get_arg_type(@arry);
73.  
74.     if argType <> DBUS_TYPE_DICT_ENTRY then begin
75.       writeln('Array is not a dictionary: ' + chr(argType));
76.       break;
77.     end;
78.  
79.     // loop through all array entries getting the key name
80.     // and the assiciated value
81.     while argType <> DBUS_TYPE_INVALID do begin
82.  
83.       dbus_message_iter_recurse(@arry, @dict);
84.       if dbus_message_iter_get_arg_type(@dict) <> DBUS_TYPE_STRING then begin
85.         writeln('Entry1 is not a string: ' + chr(dbus_message_iter_get_arg_type(@dict)));
86.         break;
87.       end;
88.       dbus_message_iter_get_basic(@dict, @dictKey);
89.  
90.       dbus_message_iter_next(@dict);
91.       if dbus_message_iter_get_arg_type(@dict) <> DBUS_TYPE_VARIANT then begin
92.         writeln('Entry2 is not a variant: ' + chr(dbus_message_iter_get_arg_type(@dict)));
93.         break;
94.       end;
95.       dbus_message_iter_recurse(@dict, @subargs);
96.       if dbus_message_iter_get_arg_type(@subargs) <> DBUS_TYPE_STRING then begin
97.         writeln('Entry2 value is not a string: ' + chr(dbus_message_iter_get_arg_type(@subargs)));
98.         break;
99.       end;
100.       dbus_message_iter_get_basic(@subargs, @dictVal);
101.  
102.       writeln(dictkey + ': ' + dictVal);
103.  
104.       dbus_message_iter_next(@arry);
105.       argType := dbus_message_iter_get_arg_type(@arry);
106.  
107.     end;
108.  
109.   until true;
110.  
111.   // free the messages and finish using the connection
112.   dbus_message_unref(replymsg);
113.   dbus_message_unref(msg);
114.   dbus_connection_unref(conn);
115.  
116. end.

I had no luck with this. The closest I got was:

Code: Pascal  [Select][+][-]

1. program c02_get_all;
2.  
3. {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
4.  
5. uses variants, dbuscomp;
6.  
7. var
8.   Conn     : TDBUSConnection;
9.   M        : TDBUSMethodCallMessage;
10.   R        : TDBUSMessage;
11.   D        : TDBUSDictionary;
12.  
13. begin
14.  
15.   Conn:=TDBUSConnection.Create(Nil);
16.  
17.   try
18.     Conn.kind:=ckSystem;
19.     Conn.Connect;
20.  
21.     M:=TDBUSMethodCallMessage.Create(
22.       'org.freedesktop.hostname1',
23.       '/org/freedesktop/hostname1',
24.       'org.freedesktop.DBus.Properties',
25.       'GetAll');
26.  
27.     M.AppendArgument('org.freedesktop.hostname1');
28.  
29.     R:=Conn.SendWithReplyAndBlock(M,1000);
30.  
31.     D:=TDBUSDictionary.Create(TDBUSDictItem);
32.     R.GetArgument(D);
33.  
34.     // some code to print out D
35.  
36.   finally
37.     D.free;
38.     R.Free;
39.     M.Free;
40.     Conn.Free;
41.   end;
42.  
43. end.

The problem is that all the GetArgument functions use a Var for the parameter except for the dictionary one which uses a Const and I couldn't work out how to get it to send back a dictionary. This version fails with:

Code: Text  [Select][+][-]

1. An unhandled exception occurred at $0000000000438B74:
2. EAbstractError: Abstract method called
3.   $0000000000438B74  GETARGUMENT,  line 2530 of dbuscomp.pp
4.   $00000000004358E0  GETARGUMENT,  line 1607 of dbuscomp.pp
5.   $00000000004026A1  main,  line 32 of c02_get_all.lpr

So I gave up and moved on to a simple signal receiving program:

Code: Pascal  [Select][+][-]

1. program p03_receive_signal;
2.  
3. uses sysutils, dbus;
4.  
5. var
6.   err                      : DBusError;
7.   conn                     : PDBusConnection;
8.   msg                      : PDBusMessage;
9.   args                     : DBusMessageIter;
10.   msgValue                 : PChar;
11.  
12. begin
13.  
14.   // initialise the error value
15.   dbus_error_init(@err);
16.  
17.   // connect to the DBUS system bus and check for errors
18.   conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);
19.   if dbus_error_is_set(@err) <> 0 then begin
20.     writeln('Connection Error :', err.message);
21.     dbus_error_free(@err);
22.   end;
23.   if conn = nil then exit;
24.  
25.   // receive signals from interface "com.example.greeting"
26.   dbus_bus_add_match(conn, 'type=''signal'',interface=''com.example.greeting''', @err);
27.   dbus_connection_flush(conn);
28.   if dbus_error_is_set(@err) <> 0 then begin
29.     writeln('Match error: ', err.message);
30.     exit;
31.   end;
32.  
33.   writeln('In a second Terminal window enter the command:');
34.   writeln('  dbus-send --system --type=signal / com.example.greeting.GreetingSignal string:"hello"');
35.   writeln;
36.  
37.   // loop listening for signals being emmitted
38.   while true do begin
39.  
40.     // non blocking read of the next available message
41.     dbus_connection_read_write(conn, 0);
42.     msg := dbus_connection_pop_message(conn);
43.  
44.     // loop again if we haven't read a message
45.     if msg = nil then begin
46.       sleep(1000);
47.       continue;
48.     end;
49.  
50.     // check if the message is a signal from the correct interface and with the correct name
51.     if dbus_message_is_signal(msg, 'com.example.greeting', 'GreetingSignal') <> 0 then begin
52.  
53.       // read the message
54.       if dbus_message_iter_init(msg, @args) = 0 then
55.         writeln('No message text')
56.       else
57.       if dbus_message_iter_get_arg_type(@args) <> DBUS_TYPE_STRING then
58.         writeln('Message is not a string: ' + chr(dbus_message_iter_get_arg_type(@args)))
59.       else begin
60.         dbus_message_iter_get_basic(@args, @msgValue);
61.         writeln('Received: ' + msgValue);
62.       end;
63.  
64.       // free the message
65.       dbus_message_unref(msg);
66.  
67.     end;
68.  
69.   end;
70.  
71.   // finish using the connection
72.   dbus_connection_unref(conn);
73.  
74. end.

This one I couldn't convert at all. None of the DBusComp code uses dbus_bus_add_match, and while there is a PopMessage function it's not clear how I'm supposed to validate that the message is a signal.

So I'd say Michael has clearly put a lot of effort and done a brilliant job in writing wrapper code for the DBus functions but it's all totally let down by the lack of documentation, code comments or simple examples.

[JoeJoeTV]

Hey, I'm currently also interested in using DBus in freepascal and I tried to get your example with GetAll working, but got to the same conclusion, that it fails with "Abstract method called" and even after trying to find out what specifically raised this exception by using Breakpoints I couldn't find it. It just crashes directly after the function call.

So if anyone has any pointers of tips to get this working, I would also really appreciate the help in getting this to work.

Thanks in advance!

P.S. And if I should make a new topic, because this post is a few months old, please tell me!

[Graham1]

My interest in DBus was to get BluetoothLE working, but I've now found this project:

https://forum.lazarus.freepascal.org/index.php/topic,61140.0.html

It works well in Win64 and Linux but there currently seems to be an issue with Win32, possibly due to the DLLs being built in MSVS? But it's close enough now that I'm going to stop trying to get DBus working.

The SimpleBLE project also seems to have a DBus version although you'd have to write your own Pascal bindings for that I suppose.