DBus interface needs an update

classic Classic list List threaded Threaded
6 messages Options
Reply | Threaded
Open this post in threaded view
|

DBus interface needs an update

Matthias Klumpp
Hello!
I've spent hours to get the Pascal DBus interface working for me, but even
the example code does not work.
The DBus package is very old, as it was created, DBus has not reached
version 1.0 yet, I think because of that DBus Pascal is not working today.
It would be great if someone could update the DBus files. DBus is an
elementary technology for interprocess-communication that is used in every
Linux distribution that has a graphical user interface.
Maybe the new DBus package could be based on DBus-GLib? I've not much
experience in translating the C headers to Pascal, but if someone starts
working on this, I would help if I can.
Best regards
    Matthias Klumpp
_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: DBus interface needs an update

ik-6
Since you are all into it already, you are welcome to give patches to solve the problems :)

Ido


On Mon, May 18, 2009 at 2:38 PM, Matthias Klumpp <[hidden email]> wrote:
Hello!
I've spent hours to get the Pascal DBus interface working for me, but even
the example code does not work.
The DBus package is very old, as it was created, DBus has not reached
version 1.0 yet, I think because of that DBus Pascal is not working today.
It would be great if someone could update the DBus files. DBus is an
elementary technology for interprocess-communication that is used in every
Linux distribution that has a graphical user interface.
Maybe the new DBus package could be based on DBus-GLib? I've not much
experience in translating the C headers to Pascal, but if someone starts
working on this, I would help if I can.
Best regards
   Matthias Klumpp
_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: DBus interface needs an update

Jonathan-181
In reply to this post by Matthias Klumpp
On Mon, 18 May 2009 13:38:55 +0200
Matthias Klumpp <[hidden email]> wrote:

> I've spent hours to get the Pascal DBus interface working for me, but even
> the example code does not work.

I need to use DBus to but I can not make it work.
Has anyone made DBus and HAL work with fpc?
_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: DBus interface needs an update

princeriley
In reply to this post by Matthias Klumpp
Matthias,

You might want to take a look at the thread (see below) on this I found ....

On 10/15/06, Marco van de Voort <[EMAIL PROTECTED]> wrote:
Florian, afaik Sebastian already had DBus stuff. He demonstrated it in
Muenchen?
Arg, duplicated work?

Well ... he should have written somewhere that he did it.

Anyway dbus is very new, and the API changed a lot in it's short life.
It's only getting to 1.0 now, so it's not that bad. My bindings will
also have to be updated to 1.0. Currently they are for 0.62

--
Felipe Monteiro de Carvalho



On Mon, May 18, 2009 at 11:38 AM, Matthias Klumpp <[hidden email]> wrote:
Hello!
I've spent hours to get the Pascal DBus interface working for me, but even
the example code does not work.
The DBus package is very old, as it was created, DBus has not reached
version 1.0 yet, I think because of that DBus Pascal is not working today.
It would be great if someone could update the DBus files. DBus is an
elementary technology for interprocess-communication that is used in every
Linux distribution that has a graphical user interface.
Maybe the new DBus package could be based on DBus-GLib? I've not much
experience in translating the C headers to Pascal, but if someone starts
working on this, I would help if I can.
Best regards
   Matthias Klumpp
_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal


_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: DBus interface needs an update

Matthias Klumpp
In reply to this post by Matthias Klumpp
Well, okay. Because I changed the code frequently, I dont't know if this is
the right solution to do the task, but it does not work like all other
trials.
I use the following function: (Include unit "dbus"):

function CallDBus: Boolean;
var
  err: DBusError;
  conn: PDBusConnection;
  ret: cint;

  msg: PDBusMessage;
  args: DBusMessageIter;
  pending: PDBusPendingCall;
  stat: Boolean;
  level: dbus_uint32_t;
  a: Boolean;
begin

  { Initializes the errors }
  dbus_error_init(@err);
 
  { Connection }
  conn := dbus_bus_get(DBUS_BUS_SESSION, @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;

  { Request the name of the bus }
  ret := dbus_bus_request_name(conn, 'dbus.test.call',
DBUS_NAME_FLAG_REPLACE_EXISTING, @err);

  if dbus_error_is_set(@err) <> 0 then
  begin
    WriteLn('Name Error: ' + err.message);
    dbus_error_free(@err);
  end;

  if ret <> DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER then Exit;

  // create a new method call and check for errors
  msg := dbus_message_new_method_call('org.freedesktop.PackageKit', //
target for the method call
                                      '/org/freedesktop/PackageKit', //
object to call on
                                      'org.freedesktop.PackageKit', //
interface to call on
                                      'RefreshCache'); // method name
  if (msg = nil) then
  begin
    WriteLn('Message Null');
    Exit;
  end;

  // append arguments
  a:=true;
  dbus_message_iter_init_append(msg, @args);
  if (dbus_message_iter_append_basic(@args, DBUS_TYPE_BOOLEAN, @a) = 0)
then
  begin
    WriteLn('Out Of Memory!');
    Exit;
  end;

  // send message and get a handle for a reply
  if (dbus_connection_send_with_reply(conn, msg, @pending, -1) = 0) then //
-1 is default timeout
  begin
    WriteLn('Out Of Memory!');
    Exit;
  end;
  if (pending = nil) then
  begin
    WriteLn('Pending Call Null');
    Exit;
  end;
  dbus_connection_flush(conn);

  WriteLn('Request Sent');

  // free message
  dbus_message_unref(msg);

  // block until we recieve a reply
  dbus_pending_call_block(pending);

  // get the reply message
  msg := dbus_pending_call_steal_reply(pending);
  if (msg = nil) then
  begin
    WriteLn('Reply Null');
    Exit;
  end;
  // free the pending message handle
  dbus_pending_call_unref(pending);

  // read the parameters
  if (dbus_message_iter_init(msg, @args) = 0) then
     WriteLn('Message has no arguments!')
  else if (DBUS_TYPE_BOOLEAN <> dbus_message_iter_get_arg_type(@args)) then
     WriteLn('Argument is not boolean!')
  else
     dbus_message_iter_get_basic(@args, @stat);

  if (dbus_message_iter_next(@args) = 0) then
     WriteLn('Message has too few arguments!')
  else if (DBUS_TYPE_UINT32 <> dbus_message_iter_get_arg_type(@args)) then
     WriteLn('Argument is not int!')
  else
     dbus_message_iter_get_basic(@args, @level);

  WriteLn('Got Reply: ', stat, ', ', level);

  // free reply
  dbus_message_unref(msg);

  { Finalization }
 //Uncommented because I got the advice NOT to free the dbus connection
 // dbus_connection_close(conn);
end;

If I execute this, I get the following messages:
Request Sent
Argument is not boolean!
Message has too few arguments!
Got Reply: FALSE, 6708224
process 7121: Applications must not close shared connections - see
dbus_connection_close() docs. This is a bug in the application.

I really dont't know why it does not work. I call a method from the
PackageKit DBus service, which works great with all my C++-Programs. (But
there I use a DBus Proxy over GLib)
Maybe I'm too stupid to get this working? I already looked at the new
DBus-Headers and saw that there are a large amount of new methods, also
older ones are missing.
I hope this is enough information.
Regards
    Matthias

P.S: I use Linux 2.6.30-5 (but the problem appears on my Linux 2.6.28-11
machine too) on Ubuntu 9.10 (but I also tried Fedora 10)


On Mon, 18 May 2009 10:06:52 -0500, Prince Riley <[hidden email]>
wrote:
> Matthias,
>
> No doubt if even the example code will not work for you (won't compile?),
> then the DBus package code needs to be you taken in hand and fixed.
>
> I'm not sure how helpful I can be to you on this but I agree with you
about
> how important, if not essential, DBus is. So I 'm willing to assist your
> effort to update the Dbus support in FPC, if in fact that's what need to
be
> done.
>
> Can you post back any specifics on the trouble with the DBus headers
you've
> had and a few more details of the kernel version and distro you are
using.
>
> Prince
>

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
Reply | Threaded
Open this post in threaded view
|

Re: DBus interface needs an update

Luca Olivetti-2
In reply to this post by Jonathan-181
En/na Jonathan ha escrit:
> On Mon, 18 May 2009 13:38:55 +0200
> Matthias Klumpp <[hidden email]> wrote:
>
>> I've spent hours to get the Pascal DBus interface working for me, but even
>> the example code does not work.
>
> I need to use DBus to but I can not make it work.
> Has anyone made DBus and HAL work with fpc?

About a year and a half ago I had DBus working, but I used it only to
communicate between my apps (so I have both a server and a client part).
Sorry, I cannot help too much, I just hope that whatever change is made
it doesn't break backwards compatibility.

Below is the client part (the usage of the reply parameters is specific
to my application, but the method should be general) inside a form.
ErrorDbus is a method that displays and logs the error message.

some private fields of the form:

     //Dbus
     err: DBusError;
     conn: PDBusConnection;

in formCreate:

    { Initializes the errors }
    dbus_error_init(@err);

    { Connection }
    conn := dbus_bus_get(DBUS_BUS_SYSTEM, @err);

    if dbus_error_is_set(@err) <> 0 then
    begin
      ErrorDbus('Connection Error: ' + err.message);
      dbus_error_free(@err);
    end;

cyclic bus call (called from a 200ms timer), note that I expect 14
parameters in the reply.


procedure TEstadoForm.BusCall;
const MAXPARAM=14;
var
   msg: PDBusMessage;
   args: DBusMessageIter;
   pending: PDBusPendingCall;
   param: PChar;
   i:integer;
   numparams:integer;
   LocByte:byte;
   LocString:string;
   LocInteger:integer;
   NoMoreParams:boolean;

   procedure NextParam;
   begin
      if NoMoreParams then exit;
      numparams:=numparams+1;
      if dbus_message_iter_next(@args)=0 then
      begin
        if numparams<=MAXPARAM then ErrorDbus('Not enough parameters');
        NoMoreParams:=true;
      end;
   end;

   function GetStringParam:boolean;
   begin
     if NoMoreParams then
     begin
       result:=false;
       exit;
     end;
     result:=dbus_message_iter_get_arg_type(@args)=DBUS_TYPE_STRING;
     if not result then
     begin
       ErrorDbus(format('Parameter %d is not a string',[numparams]));
       exit;
     end;
     dbus_message_iter_get_basic(@args, @param);
     LocString:=strpas(param);
   end;

   function GetByteParam:boolean;
   var partype:cint;
   begin
     if NoMoreParams then
     begin
       result:=false;
       exit;
     end;
     partype:=dbus_message_iter_get_arg_type(@args);
     result:=partype=DBUS_TYPE_BYTE;
     if not result then
     begin
        //dirty trick: since the first response parameter should be
        //a byte, here I check if it is a string
        //in such case it is a dbus error message
        if (numparams=1) and (partype=DBUS_TYPE_STRING) then
        begin
          dbus_message_iter_get_basic(@args, @param);
          ErrorDbus(param);
          numparams:=MAXPARAM;
          exit;
        end;
        ErrorDbus(format('Parameter %d is not a byte',[numparams]));
        exit;
     end;
     dbus_message_iter_get_basic(@args, @LocByte);
   end;

   function GetIntegerParam:boolean;
   begin
     result:=false;
     if NoMoreParams then exit;
     if dbus_message_iter_get_arg_type(@args)<>DBUS_TYPE_INT32 then
     begin
       ErrorDbus(format('Parameter %d is not int32',[numparams]));
       exit;
     end;
     result:=true;
     dbus_message_iter_get_basic(@args, @LocInteger);
   end;

begin
   ErrorDbus('ok');
   // create a new method call and check for errors
   msg := dbus_message_new_method_call('es.wetron.almacen_tapas.server',
// target for the method call
                                       '/almacen_tapas/method/Object',
// object to call on
 
'es.wetron.almacen_tapas.method.Status', // interface to call on
                                       'GetStatus'); // method name
   if (msg = nil) then
   begin
     ErrorDbus('Message Null');
     Exit;
   end;

   // send message and get a handle for a reply
   if (dbus_connection_send_with_reply(conn, msg, @pending, -1) = 0)
then // -1 is default timeout
   begin
     ErrorDbus('Out Of Memory!');
     Exit;
   end;
   if (pending = nil) then
   begin
     ErrorDbus('Pending Call Null');
     Exit;
   end;
   dbus_connection_flush(conn);

   //WriteLn('Request Sent');

   // free message
   dbus_message_unref(msg);

   // block until we recieve a reply
   dbus_pending_call_block(pending);

   // get the reply message
   msg := dbus_pending_call_steal_reply(pending);
   if (msg = nil) then
   begin
     ErrorDbus('Reply Null');
     Exit;
   end;
   // free the pending message handle
   dbus_pending_call_unref(pending);

   // read the parameters
   if dbus_message_iter_init(msg, @args)=0 then
   begin
      ErrorDbus('No parameters in reply')
   end else
   begin
     numparams:=1;
     NoMoreParams:=false;

     if GetByteParam then VisualizaBits(FEntradas,locbyte);
     NextParam;

     if GetByteParam then VisualizaBits(FSalidas, locbyte);
     NextParam;

     if GetStringParam then LabelEstadoLectura.caption:=LocString;
     NextParam;

     if GetStringParam then LabelEstadoSalida.caption:=LocString;
     NextParam;

     for i:=1 to 4 do
     begin
       if GetStringParam then PantallaDescarga[i].caption:=LocString;
       NextParam;
     end;

     if GetIntegerParam then
DescargaBandejaPidiendo.caption:=IntToStr(LocInteger);
     NextParam;

     if GetIntegerParam then
DescargaBandejaBoca.caption:=IntToStr(LocInteger);
     NextParam;

     if GetStringParam then LabelEstadoEntrada.caption:=LocString;
     NextParam;

     for i:=1 to 4 do
     begin
       if GetStringParam then PantallaCarga[i].caption:=LocString;
       NextParam;
     end;

     if GetIntegerParam then
CargaBandejaPidiendo.caption:=IntToStr(LocInteger);
     NextParam;

     if GetIntegerParam then CargaBandejaBoca.caption:=IntToStr(LocInteger);
     NextParam;

     if GetStringParam then for i:=1 to 7 do
DescargaGrid.Cells[i,1]:=ExtractWord(i,LocString,[',']);
     NextParam;

     if GetIntegerParam then if Initfifo or (LocInteger<>FifoSerial)
then GetFifo(LocInteger);
   end;
   // free reply
   dbus_message_unref(msg);
end;

Bye

--
Luca

_______________________________________________
fpc-pascal maillist  -  [hidden email]
http://lists.freepascal.org/mailman/listinfo/fpc-pascal