Recent

Author Topic: Using DBus to receive signals  (Read 1810 times)

Graham1

  • New Member
  • *
  • Posts: 43
Using DBus to receive signals
« on: February 03, 2022, 01:12:15 am »
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!
Windows 10 Home 64-bit
Lazarus 2.0.12 / FPC 3.2.0

Thaddy

  • Hero Member
  • *****
  • Posts: 12207
Re: Using DBus to receive signals
« Reply #1 on: February 03, 2022, 07:40:09 am »
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)
« Last Edit: February 03, 2022, 07:47:30 am by Thaddy »
Manuals, manuals, manuals first.
You have incompetence and sheer incompetence.

Graham1

  • New Member
  • *
  • Posts: 43
Re: Using DBus to receive signals
« Reply #2 on: February 07, 2022, 12:37:17 am »
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.
Windows 10 Home 64-bit
Lazarus 2.0.12 / FPC 3.2.0

JoeJoeTV

  • Jr. Member
  • **
  • Posts: 51
  • Hobbyist Programmer
    • Click for fun :)
Re: Using DBus to receive signals
« Reply #3 on: September 08, 2022, 05:43:27 pm »
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!
Lazarus 2.2.0 / FPC 3.2.2 / 64bit / Linux Mint 20.3 Cinnamon
https://github.com/JoeJoeTV

 

TinyPortal © 2005-2018