1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
9 -- Copyright (C) 2007, AdaCore --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This version is used on VMS and LynxOS
38 with Interfaces.C; use Interfaces.C;
40 package body GNAT.Sockets.Thin.Task_Safe_NetDB is
42 -- The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
43 -- task lock, and copy the relevant data structures (under the lock) into
44 -- the result. The Nonreentrant_ versions are expected to be in the parent
45 -- package GNAT.Sockets.Thin (on platforms that use this version of
48 procedure Copy_Host_Entry
49 (Source_Hostent : Hostent;
50 Target_Hostent : out Hostent;
51 Target_Buffer : System.Address;
52 Target_Buffer_Length : C.int;
54 -- Copy all the information from Source_Hostent into Target_Hostent,
55 -- using Target_Buffer to store associated data.
56 -- 0 is returned on success, -1 on failure (in case the provided buffer
57 -- is too small for the associated data).
59 procedure Copy_Service_Entry
60 (Source_Servent : Servent;
61 Target_Servent : out Servent;
62 Target_Buffer : System.Address;
63 Target_Buffer_Length : C.int;
65 -- Copy all the information from Source_Servent into Target_Servent,
66 -- using Target_Buffer to store associated data.
67 -- 0 is returned on success, -1 on failure (in case the provided buffer
68 -- is too small for the associated data).
72 Storage : in out char_array;
73 Storage_Index : in out size_t;
74 Stored_Name : out C.Strings.chars_ptr);
75 -- Store the given Name at the first available location in Storage
76 -- (indicated by Storage_Index, which is updated afterwards), and return
77 -- the address of that location in Stored_Name.
78 -- (Supporting routine for the two below).
84 procedure Copy_Host_Entry
85 (Source_Hostent : Hostent;
86 Target_Hostent : out Hostent;
87 Target_Buffer : System.Address;
88 Target_Buffer_Length : C.int;
91 use type C.Strings.chars_ptr;
93 Names_Length : size_t;
95 Source_Aliases : Chars_Ptr_Array
96 renames Chars_Ptr_Pointers.Value
97 (Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
98 -- Null-terminated list of aliases (last element of this array is
101 Source_Addresses : In_Addr_Access_Array
102 renames In_Addr_Access_Pointers.Value
103 (Source_Hostent.H_Addr_List, Terminator => null);
107 Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
109 for J in Source_Aliases'Range loop
110 if Source_Aliases (J) /= C.Strings.Null_Ptr then
112 Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
117 type In_Addr_Array is array (Source_Addresses'Range)
120 type Netdb_Host_Data is record
121 Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
122 Names : aliased char_array (1 .. Names_Length);
124 Addresses_List : aliased In_Addr_Access_Array
125 (In_Addr_Array'Range);
126 Addresses : In_Addr_Array;
127 -- ??? This assumes support only for Inet family
131 Netdb_Data : Netdb_Host_Data;
132 pragma Import (Ada, Netdb_Data);
133 for Netdb_Data'Address use Target_Buffer;
135 Names_Index : size_t := Netdb_Data.Names'First;
136 -- Index of first available location in Netdb_Data.Names
139 if Netdb_Data'Size / 8 > Target_Buffer_Length then
146 (C.Strings.Value (Source_Hostent.H_Name),
147 Netdb_Data.Names, Names_Index,
148 Target_Hostent.H_Name);
150 -- Copy aliases (null-terminated string pointer array)
152 Target_Hostent.H_Aliases :=
153 Netdb_Data.Aliases_List
154 (Netdb_Data.Aliases_List'First)'Unchecked_Access;
155 for J in Netdb_Data.Aliases_List'Range loop
156 if J = Netdb_Data.Aliases_List'Last then
157 Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
160 (C.Strings.Value (Source_Aliases (J)),
161 Netdb_Data.Names, Names_Index,
162 Netdb_Data.Aliases_List (J));
166 -- Copy address type and length
168 Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
169 Target_Hostent.H_Length := Source_Hostent.H_Length;
173 Target_Hostent.H_Addr_List :=
174 Netdb_Data.Addresses_List
175 (Netdb_Data.Addresses_List'First)'Unchecked_Access;
177 for J in Netdb_Data.Addresses'Range loop
178 if J = Netdb_Data.Addresses'Last then
179 Netdb_Data.Addresses_List (J) := null;
181 Netdb_Data.Addresses_List (J) :=
182 Netdb_Data.Addresses (J)'Unchecked_Access;
184 Netdb_Data.Addresses (J) := Source_Addresses (J).all;
192 ------------------------
193 -- Copy_Service_Entry --
194 ------------------------
196 procedure Copy_Service_Entry
197 (Source_Servent : Servent;
198 Target_Servent : out Servent;
199 Target_Buffer : System.Address;
200 Target_Buffer_Length : C.int;
203 use type C.Strings.chars_ptr;
205 Names_Length : size_t;
207 Source_Aliases : Chars_Ptr_Array
208 renames Chars_Ptr_Pointers.Value
209 (Source_Servent.S_Aliases, Terminator => C.Strings.Null_Ptr);
210 -- Null-terminated list of aliases (last element of this array is
215 Names_Length := C.Strings.Strlen (Source_Servent.S_Name) + 1
216 + C.Strings.Strlen (Source_Servent.S_Proto) + 1;
218 for J in Source_Aliases'Range loop
219 if Source_Aliases (J) /= C.Strings.Null_Ptr then
221 Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
226 type Netdb_Service_Data is record
227 Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
228 Names : aliased char_array (1 .. Names_Length);
231 Netdb_Data : Netdb_Service_Data;
232 pragma Import (Ada, Netdb_Data);
233 for Netdb_Data'Address use Target_Buffer;
235 Names_Index : size_t := Netdb_Data.Names'First;
236 -- Index of first available location in Netdb_Data.Names
239 if Netdb_Data'Size / 8 > Target_Buffer_Length then
246 (C.Strings.Value (Source_Servent.S_Name),
247 Netdb_Data.Names, Names_Index,
248 Target_Servent.S_Name);
250 -- Copy aliases (null-terminated string pointer array)
252 Target_Servent.S_Aliases :=
253 Netdb_Data.Aliases_List
254 (Netdb_Data.Aliases_List'First)'Unchecked_Access;
258 Target_Servent.S_Port := Source_Servent.S_Port;
260 -- Copy protocol name
263 (C.Strings.Value (Source_Servent.S_Proto),
264 Netdb_Data.Names, Names_Index,
265 Target_Servent.S_Proto);
267 for J in Netdb_Data.Aliases_List'Range loop
268 if J = Netdb_Data.Aliases_List'Last then
269 Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
272 (C.Strings.Value (Source_Aliases (J)),
273 Netdb_Data.Names, Names_Index,
274 Netdb_Data.Aliases_List (J));
280 end Copy_Service_Entry;
282 ------------------------
283 -- Safe_Gethostbyaddr --
284 ------------------------
286 function Safe_Gethostbyaddr
287 (Addr : System.Address;
290 Ret : not null access Hostent;
291 Buf : System.Address;
293 H_Errnop : not null access C.int) return C.int
300 HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
303 H_Errnop.all := C.int (Host_Errno);
307 -- Now copy the data to the user-provided buffer
310 (Source_Hostent => HE.all,
311 Target_Hostent => Ret.all,
312 Target_Buffer => Buf,
313 Target_Buffer_Length => Buflen,
317 GNAT.Task_Lock.Unlock;
319 end Safe_Gethostbyaddr;
321 ------------------------
322 -- Safe_Gethostbyname --
323 ------------------------
325 function Safe_Gethostbyname
326 (Name : C.char_array;
327 Ret : not null access Hostent;
328 Buf : System.Address;
330 H_Errnop : not null access C.int) return C.int
337 HE := Nonreentrant_Gethostbyname (Name);
340 H_Errnop.all := C.int (Host_Errno);
344 -- Now copy the data to the user-provided buffer
347 (Source_Hostent => HE.all,
348 Target_Hostent => Ret.all,
349 Target_Buffer => Buf,
350 Target_Buffer_Length => Buflen,
354 GNAT.Task_Lock.Unlock;
356 end Safe_Gethostbyname;
358 ------------------------
359 -- Safe_Getservbyname --
360 ------------------------
362 function Safe_Getservbyname
363 (Name : C.char_array;
364 Proto : C.char_array;
365 Ret : not null access Servent;
366 Buf : System.Address;
367 Buflen : C.int) return C.int
374 SE := Nonreentrant_Getservbyname (Name, Proto);
380 -- Now copy the data to the user-provided buffer
383 (Source_Servent => SE.all,
384 Target_Servent => Ret.all,
385 Target_Buffer => Buf,
386 Target_Buffer_Length => Buflen,
390 GNAT.Task_Lock.Unlock;
392 end Safe_Getservbyname;
394 ------------------------
395 -- Safe_Getservbyport --
396 ------------------------
398 function Safe_Getservbyport
400 Proto : C.char_array;
401 Ret : not null access Servent;
402 Buf : System.Address;
403 Buflen : C.int) return C.int
411 SE := Nonreentrant_Getservbyport (Port, Proto);
417 -- Now copy the data to the user-provided buffer
420 (Source_Servent => SE.all,
421 Target_Servent => Ret.all,
422 Target_Buffer => Buf,
423 Target_Buffer_Length => Buflen,
427 GNAT.Task_Lock.Unlock;
429 end Safe_Getservbyport;
437 Storage : in out char_array;
438 Storage_Index : in out size_t;
439 Stored_Name : out C.Strings.chars_ptr)
441 First : constant C.size_t := Storage_Index;
442 Last : constant C.size_t := Storage_Index + Name'Length - 1;
444 Storage (First .. Last) := Name;
445 Stored_Name := C.Strings.To_Chars_Ptr
446 (Storage (First .. Last)'Unrestricted_Access);
447 Storage_Index := Last + 1;
450 end GNAT.Sockets.Thin.Task_Safe_NetDB;