src/d_bus-messages.adb

   1 --
   2 --  D_Bus/Ada - An Ada binding to D-Bus
   3 --
   4 --  Copyright (C) 2011  Reto Buerki <reet@codelabs.ch>
   5 --
   6 --  This program is free software; you can redistribute it and/or
   7 --  modify it under the terms of the GNU General Public License
   8 --  as published by the Free Software Foundation; either version 2
   9 --  of the License, or (at your option) any later version.
  10 --
  11 --  This program is distributed in the hope that it will be useful,
  12 --  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 --  GNU General Public License for more details.
  15 --
  16 --  You should have received a copy of the GNU General Public License
  17 --  along with this program; if not, write to the Free Software
  18 --  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
  19 --  USA.
  20 --
  21 --  As a special exception, if other files instantiate generics from this
  22 --  unit,  or  you  link  this  unit  with  other  files  to  produce  an
  23 --  executable   this  unit  does  not  by  itself  cause  the  resulting
  24 --  executable to  be  covered by the  GNU General  Public License.  This
  25 --  exception does  not  however  invalidate  any  other reasons why  the
  26 --  executable file might be covered by the GNU Public License.
  27 --
  28
  29 with Interfaces.C.Strings;
  30
  31 with dbus_types_h;
  32
  33 package body D_Bus.Messages is
  34
  35    use dbus_message_h;
  36    use type Interfaces.C.Strings.chars_ptr;
  37
  38    package C renames Interfaces.C;
  39
  40    function Value_Or_Empty (Ptr : C.Strings.chars_ptr) return String;
  41    --  Returns empty string if the given pointer is a null pointer, if not the
  42    --  function returns the corresponding string value.
  43
  44    -------------------------------------------------------------------------
  45
  46    procedure Add_Arguments
  47      (Msg  : in out Message_Type;
  48       Args :        Arguments.Argument_List_Type)
  49    is
  50       D_Args : aliased DBusMessageIter;
  51    begin
  52       dbus_message_iter_init_append
  53         (message => Msg.Thin_Msg,
  54          iter    => D_Args'Access);
  55       Arguments.Serialize (Args   => Args,
  56                            D_Args => D_Args'Access);
  57    end Add_Arguments;
  58
  59    -------------------------------------------------------------------------
  60
  61    function Create
  62      (D_Msg : access dbus_message_h.DBusMessage)
  63       return Message_Type
  64    is
  65    begin
  66       return M : Message_Type do
  67          M.Thin_Msg := D_Msg;
  68       end return;
  69    end Create;
  70
  71    -------------------------------------------------------------------------
  72
  73    function Get_Arguments
  74      (Msg : Message_Type)
  75       return Arguments.Argument_List_Type
  76    is
  77       use type dbus_types_h.dbus_bool_t;
  78
  79       D_Args : aliased dbus_message_h.DBusMessageIter;
  80       Args   : Arguments.Argument_List_Type;
  81    begin
  82       if dbus_message_h.dbus_message_iter_init
  83         (message => Msg.Thin_Msg,
  84          iter    => D_Args'Access) = 1
  85       then
  86          Args := Arguments.Deserialize (D_Args'Access);
  87       end if;
  88
  89       return Args;
  90    end Get_Arguments;
  91
  92    -------------------------------------------------------------------------
  93
  94    function Get_Destination (Msg : Message_Type) return String
  95    is
  96       C_Dest : constant C.Strings.chars_ptr := dbus_message_get_destination
  97         (message => Msg.Thin_Msg);
  98    begin
  99       return Value_Or_Empty (Ptr => C_Dest);
 100    end Get_Destination;
 101
 102    -------------------------------------------------------------------------
 103
 104    function Get_Interface (Msg : Message_Type) return String
 105    is
 106       C_Iface : constant C.Strings.chars_ptr := dbus_message_get_interface
 107         (message => Msg.Thin_Msg);
 108    begin
 109       return Value_Or_Empty (Ptr => C_Iface);
 110    end Get_Interface;
 111
 112    -------------------------------------------------------------------------
 113
 114    function Get_Member (Msg : Message_Type) return String
 115    is
 116       C_Member : constant C.Strings.chars_ptr := dbus_message_get_member
 117         (message => Msg.Thin_Msg);
 118    begin
 119       return Value_Or_Empty (Ptr => C_Member);
 120    end Get_Member;
 121
 122    -------------------------------------------------------------------------
 123
 124    function Get_Path (Msg : Message_Type) return String
 125    is
 126       C_Path : constant C.Strings.chars_ptr := dbus_message_get_path
 127         (message => Msg.Thin_Msg);
 128    begin
 129       return Value_Or_Empty (Ptr => C_Path);
 130    end Get_Path;
 131
 132    -------------------------------------------------------------------------
 133
 134    function Get_Sender (Msg : Message_Type) return String
 135    is
 136       C_Sender : constant C.Strings.chars_ptr := dbus_message_get_sender
 137         (message => Msg.Thin_Msg);
 138    begin
 139       return Value_Or_Empty (Ptr => C_Sender);
 140    end Get_Sender;
 141
 142    ------------------------------------------------------------------------
 143
 144    function Get_Serial (Msg : Message_Type) return Positive
 145    is
 146    begin
 147       return Positive (dbus_message_get_serial (message => Msg.Thin_Msg));
 148
 149    exception
 150       when Constraint_Error =>
 151          raise D_Bus_Error with "Message has an invalid serial number";
 152    end Get_Serial;
 153
 154    -------------------------------------------------------------------------
 155
 156    function Get_Type (Msg : Message_Type) return Message_Variant
 157    is
 158    begin
 159       return Message_Variant'Val
 160         (dbus_message_get_type (message => Msg.Thin_Msg));
 161
 162    exception
 163       when Constraint_Error =>
 164          raise D_Bus_Error with "Message has an invalid type";
 165    end Get_Type;
 166
 167    -------------------------------------------------------------------------
 168
 169    function Is_Method_Call
 170      (Msg    : Message_Type;
 171       Iface  : String;
 172       Method : String)
 173       return Boolean
 174    is
 175       use type C.unsigned;
 176
 177       C_Iface  : C.Strings.chars_ptr := C.Strings.New_String
 178         (Str => Iface);
 179       C_Member : C.Strings.chars_ptr := C.Strings.New_String
 180         (Str => Method);
 181       Res      : C.unsigned;
 182    begin
 183       Res := dbus_message_is_method_call
 184         (message => Msg.Thin_Msg,
 185          iface   => C_Iface,
 186          method  => C_Member);
 187       C.Strings.Free (Item => C_Iface);
 188       C.Strings.Free (Item => C_Member);
 189       return Res = 1;
 190    end Is_Method_Call;
 191
 192    -------------------------------------------------------------------------
 193
 194    function New_Error
 195      (Reply_To      : Message_Type;
 196       Error_Name    : String;
 197       Error_Message : String)
 198       return Message_Type
 199    is
 200       Error  : Message_Type;
 201       C_Name : C.Strings.chars_ptr
 202         := C.Strings.New_String (Str => Error_Name);
 203       C_Msg  : C.Strings.chars_ptr
 204         := C.Strings.New_String (Str => Error_Message);
 205    begin
 206       Error.Thin_Msg := dbus_message_new_error
 207         (reply_to      => Reply_To.Thin_Msg,
 208          error_name    => C_Name,
 209          error_message => C_Msg);
 210       C.Strings.Free (Item => C_Name);
 211       C.Strings.Free (Item => C_Msg);
 212
 213       if Error.Thin_Msg = null then
 214          raise D_Bus_Error with "Could not create error reply";
 215       end if;
 216
 217       return Error;
 218    end New_Error;
 219
 220    -------------------------------------------------------------------------
 221
 222    function New_Method_Return (Method_Call : Message_Type) return Message_Type
 223    is
 224       Reply : Message_Type;
 225    begin
 226       Reply.Thin_Msg := dbus_message_new_method_return
 227         (method_call => Method_Call.Thin_Msg);
 228
 229       if Reply.Thin_Msg = null then
 230          raise D_Bus_Error with "Could not create method reply message";
 231       end if;
 232
 233       return Reply;
 234    end New_Method_Return;
 235
 236    -------------------------------------------------------------------------
 237
 238    function To_Thin
 239      (Msg : Message_Type)
 240       return access dbus_message_h.DBusMessage
 241    is
 242    begin
 243       return Msg.Thin_Msg;
 244    end To_Thin;
 245
 246    -------------------------------------------------------------------------
 247
 248    procedure Unref (Msg : in out Message_Type)
 249    is
 250    begin
 251       if Msg /= Null_Message then
 252          dbus_message_unref (message => Msg.Thin_Msg);
 253          Msg.Thin_Msg := null;
 254       end if;
 255    end Unref;
 256
 257    -------------------------------------------------------------------------
 258
 259    function Value_Or_Empty (Ptr : C.Strings.chars_ptr) return String
 260    is
 261    begin
 262       if Ptr = C.Strings.Null_Ptr then
 263          return "";
 264       end if;
 265
 266       return C.Strings.Value (Item => Ptr);
 267    end Value_Or_Empty;
 268
 269 end D_Bus.Messages;