Using DBus to receive signals (BluetoothLE, BLE)
lazarus / 32-Linux

----------------------------------------------------------------------
Graham1 · 2022-02-03 00:12

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i
#!/usr/bin/python3import dbusimport dbus.mainloop.glibfrom
gi.repository import GLib mainloop = None def
greeting_signal_received(greeting):        print(greeting) dbus.mainlo
op.glib.DBusGMainLoop(set_as_default=True)bus =
dbus.SystemBus()bus.add_signal_receiver(greeting_signal_received,    
          dbus_interface = "com.example.greeting",               
signal_name = "GreetingSignal") mainloop =
GLib.MainLoop()mainloop.run()
Is there an equivalent method to this in Pascal?

Thanks!

----------------------------------------------------------------------
Thaddy · 2022-02-03 06:40

Quote from: Graham1 on February 03, 2022, 01:12:15 amIs 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 · 2022-02-06 23:37

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
p01_get_hostname; uses dbus; var  err                      :
DBusError;  conn                     : PDBusConnection;  msg, replymsg
           : PDBusMessage;  args, replyargs, subargs :
DBusMessageIter;  arg1, arg2               : PChar;  hostname        
       : PChar; begin   // initialise the error value 
dbus_error_init(@err);   // connect to the DBUS system bus and check
for errors  conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);  if
dbus_error_is_set(@err) <> 0 then begin    writeln('Connection Error
:', err.message);    dbus_error_free(@err);  end;  if conn = nil then
exit;   // create message and check for errors  msg :=
dbus_message_new_method_call(    'org.freedesktop.hostname1',   
'/org/freedesktop/hostname1',    'org.freedesktop.DBus.Properties',  
'Get');  if msg = nil then begin    writeLn('Could not construct
message: ' + err.message);    dbus_error_free(@err);  end;   //
initialise parameter list for appending  arg1 :=
pchar('org.freedesktop.hostname1');  arg2 := pchar('Hostname');   //
add parameter arguments  dbus_message_iter_init_append(msg, @args); 
if dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg1) = 0
then begin    writeln('Out Of Memory on arg1!');    exit;  end;  if
dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg2) = 0
then begin    writeln('Out Of Memory on arg2!');    exit;  end;   //
send message and block while waiting for reply  replymsg :=
dbus_connection_send_with_reply_and_block(conn, msg, 1000, @err);   if
dbus_error_is_set(@err) <> 0 then begin    writeLn('Error waiting for
reply: ' + err.message);    dbus_error_free(@err);  end;   //
initialise reply argument list then check type of return value  //
before retrieving value  if dbus_message_iter_init(replymsg,
@replyargs) = 0 then    writeln('No return value')  else  if
dbus_message_iter_get_arg_type(@replyargs) <> DBUS_TYPE_VARIANT then 
 writeln('Return value is not a variant: ' +
chr(dbus_message_iter_get_arg_type(@replyargs)))  else begin    //
convert variant data    dbus_message_iter_recurse(@replyargs,
@subargs);    if dbus_message_iter_get_arg_type(@subargs) <>
DBUS_TYPE_STRING then      writeln('Return value is not a string: ' +
chr(dbus_message_iter_get_arg_type(@subargs)))    else     
dbus_message_iter_get_basic(@subargs, @hostname);  end;   if hostname
<> nil then writeln('Hostname is: ' + hostname);   // free the
messages and finish using the connection 
dbus_message_unref(replymsg);  dbus_message_unref(msg); 
dbus_connection_unref(conn); end.
which converted neatly into:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
c01_get_hostname; {$WARN 6058 off : Call to subroutine "$1" marked as
inline is not inlined} uses variants, dbuscomp; var  Conn     :
TDBUSConnection;  M        : TDBUSMethodCallMessage;  R        :
TDBUSMessage;  V        : Variant;  Hostname : string; begin  
Conn:=TDBUSConnection.Create(Nil);   try    Conn.kind:=ckSystem;   
Conn.Connect;     M:=TDBUSMethodCallMessage.Create(     
'org.freedesktop.hostname1',      '/org/freedesktop/hostname1',     
'org.freedesktop.DBus.Properties',      'Get');    
M.AppendArgument('org.freedesktop.hostname1');   
M.AppendArgument('Hostname');    
R:=Conn.SendWithReplyAndBlock(M,1000);     V:='';   
R.GetArgument(V);    Hostname:=V;     Writeln(Hostname);   finally   
R.Free;    M.Free;    Conn.Free;  end; end.
So I moved on to my next program which uses a GetAll rather than a
Get:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
p02_get_all; uses dbus; var  err                      : DBusError; 
conn                     : PDBusConnection;  msg, replymsg          
 : PDBusMessage;  args, replyargs, subargs : DBusMessageIter;  arg1  
                 : PChar;  argType                  : Integer;  arry,
dict               : DBusMessageIter;  dictKey, dictVal         :
PChar; begin   // initialise the error value  dbus_error_init(@err);  
// connect to the DBUS system bus and check for errors  conn :=
dbus_bus_get(DBUS_BUS_SYSTEM, @err);  if dbus_error_is_set(@err) <> 0
then begin    writeln('Connection Error :', err.message);   
dbus_error_free(@err);  end;  if conn = nil then exit;   // create
message and check for errors  msg := dbus_message_new_method_call(   
'org.freedesktop.hostname1',    '/org/freedesktop/hostname1',   
'org.freedesktop.DBus.Properties',    'GetAll');  if msg = nil then
begin    writeLn('Could not construct message: ' + err.message);   
dbus_error_free(@err);  end;   // initialise parameter list for
appending  arg1 := pchar('org.freedesktop.hostname1');   // add
parameter arguments  dbus_message_iter_init_append(msg, @args);  if
dbus_message_iter_append_basic(@args, DBUS_TYPE_STRING, @arg1) = 0
then begin    writeln('Out Of Memory on arg1!');    exit;  end;   //
send message and block while waiting for reply  replymsg :=
dbus_connection_send_with_reply_and_block(conn, msg, 1000, @err);   if
dbus_error_is_set(@err) <> 0 then begin    writeLn('Error waiting for
reply: ' + err.message);    dbus_error_free(@err);  end;   //
initialise reply argument list then check type of return value  //
before retrieving value  repeat     if
dbus_message_iter_init(replymsg, @replyargs) = 0 then begin     
writeln('No return value');      break;    end;    if
dbus_message_iter_get_arg_type(@replyargs) <> DBUS_TYPE_ARRAY then
begin      writeln('Return value is not an array: ' +
chr(dbus_message_iter_get_arg_type(@replyargs)));      break;   
end;     // check first item is a dictionary entry   
dbus_message_iter_recurse(@replyargs, @arry);    argType :=
dbus_message_iter_get_arg_type(@arry);     if argType <>
DBUS_TYPE_DICT_ENTRY then begin      writeln('Array is not a
dictionary: ' + chr(argType));      break;    end;     // loop through
all array entries getting the key name    // and the assiciated value 
  while argType <> DBUS_TYPE_INVALID do begin      
dbus_message_iter_recurse(@arry, @dict);      if
dbus_message_iter_get_arg_type(@dict) <> DBUS_TYPE_STRING then begin 
     writeln('Entry1 is not a string: ' +
chr(dbus_message_iter_get_arg_type(@dict)));        break;      end; 
   dbus_message_iter_get_basic(@dict, @dictKey);      
dbus_message_iter_next(@dict);      if
dbus_message_iter_get_arg_type(@dict) <> DBUS_TYPE_VARIANT then begin 
      writeln('Entry2 is not a variant: ' +
chr(dbus_message_iter_get_arg_type(@dict)));        break;      end; 
   dbus_message_iter_recurse(@dict, @subargs);      if
dbus_message_iter_get_arg_type(@subargs) <> DBUS_TYPE_STRING then
begin        writeln('Entry2 value is not a string: ' +
chr(dbus_message_iter_get_arg_type(@subargs)));        break;     
end;      dbus_message_iter_get_basic(@subargs, @dictVal);      
writeln(dictkey + ': ' + dictVal);      
dbus_message_iter_next(@arry);      argType :=
dbus_message_iter_get_arg_type(@arry);     end;   until true;   //
free the messages and finish using the connection 
dbus_message_unref(replymsg);  dbus_message_unref(msg); 
dbus_connection_unref(conn); end.
I had no luck with this. The closest I got was:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
c02_get_all; {$WARN 6058 off : Call to subroutine "$1" marked as
inline is not inlined} uses variants, dbuscomp; var  Conn     :
TDBUSConnection;  M        : TDBUSMethodCallMessage;  R        :
TDBUSMessage;  D        : TDBUSDictionary; begin  
Conn:=TDBUSConnection.Create(Nil);   try    Conn.kind:=ckSystem;   
Conn.Connect;     M:=TDBUSMethodCallMessage.Create(     
'org.freedesktop.hostname1',      '/org/freedesktop/hostname1',     
'org.freedesktop.DBus.Properties',      'GetAll');    
M.AppendArgument('org.freedesktop.hostname1');    
R:=Conn.SendWithReplyAndBlock(M,1000);    
D:=TDBUSDictionary.Create(TDBUSDictItem);    R.GetArgument(D);     //
some code to print out D   finally    D.free;    R.Free;    M.Free;  
Conn.Free;  end; 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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i An
unhandled exception occurred at $0000000000438B74:EAbstractError:
Abstract method called  $0000000000438B74  GETARGUMENT,  line 2530 of
dbuscomp.pp  $00000000004358E0  GETARGUMENT,  line 1607 of
dbuscomp.pp  $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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i program
p03_receive_signal; uses sysutils, dbus; var  err                    
 : DBusError;  conn                     : PDBusConnection;  msg      
              : PDBusMessage;  args                     :
DBusMessageIter;  msgValue                 : PChar; begin   //
initialise the error value  dbus_error_init(@err);   // connect to the
DBUS system bus and check for errors  conn :=
dbus_bus_get(DBUS_BUS_SYSTEM, @err);  if dbus_error_is_set(@err) <> 0
then begin    writeln('Connection Error :', err.message);   
dbus_error_free(@err);  end;  if conn = nil then exit;   // receive
signals from interface "com.example.greeting" 
dbus_bus_add_match(conn,
'type=''signal'',interface=''com.example.greeting''', @err); 
dbus_connection_flush(conn);  if dbus_error_is_set(@err) <> 0 then
begin    writeln('Match error: ', err.message);    exit;  end;  
writeln('In a second Terminal window enter the command:');  writeln('
 dbus-send --system --type=signal /
com.example.greeting.GreetingSignal string:"hello"');  writeln;   //
loop listening for signals being emmitted  while true do begin     //
non blocking read of the next available message   
dbus_connection_read_write(conn, 0);    msg :=
dbus_connection_pop_message(conn);     // loop again if we haven't
read a message    if msg = nil then begin      sleep(1000);     
continue;    end;     // check if the message is a signal from the
correct interface and with the correct name    if
dbus_message_is_signal(msg, 'com.example.greeting', 'GreetingSignal')
<> 0 then begin       // read the message      if
dbus_message_iter_init(msg, @args) = 0 then        writeln('No message
text')      else      if dbus_message_iter_get_arg_type(@args) <>
DBUS_TYPE_STRING then        writeln('Message is not a string: ' +
chr(dbus_message_iter_get_arg_type(@args)))      else begin       
dbus_message_iter_get_basic(@args, @msgValue);       
writeln('Received: ' + msgValue);      end;       // free the message 
    dbus_message_unref(msg);     end;   end;   // finish using the
connection  dbus_connection_unref(conn); 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 · 2022-09-08 15:43

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 · 2023-01-30 23:38

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.