9d2dca7472b04ff9ff459148839cf69b732ad4fb
[dbus-ada.git] / 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;