------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- 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 --
-- --
-- B o d y --
-- --
-- Copyright (C) 2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 2, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING. If not, write --
-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This version is used on VMS and LynxOS
with GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
package body GNAT.Sockets.Thin.Task_Safe_NetDB is
-- The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
-- task lock, and copy the relevant data structures (under the lock) into
-- the result. The Nonreentrant_ versions are expected to be in the parent
-- package GNAT.Sockets.Thin (on platforms that use this version of
-- Task_Safe_NetDB).
procedure Copy_Host_Entry
(Source_Hostent : Hostent;
Target_Hostent : out Hostent;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int);
-- Copy all the information from Source_Hostent into Target_Hostent,
-- using Target_Buffer to store associated data.
-- 0 is returned on success, -1 on failure (in case the provided buffer
-- is too small for the associated data).
procedure Copy_Service_Entry
(Source_Servent : Servent;
Target_Servent : out Servent;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int);
-- Copy all the information from Source_Servent into Target_Servent,
-- using Target_Buffer to store associated data.
-- 0 is returned on success, -1 on failure (in case the provided buffer
-- is too small for the associated data).
procedure Store_Name
(Name : char_array;
Storage : in out char_array;
Storage_Index : in out size_t;
Stored_Name : out C.Strings.chars_ptr);
-- Store the given Name at the first available location in Storage
-- (indicated by Storage_Index, which is updated afterwards), and return
-- the address of that location in Stored_Name.
-- (Supporting routine for the two below).
---------------------
-- Copy_Host_Entry --
---------------------
procedure Copy_Host_Entry
(Source_Hostent : Hostent;
Target_Hostent : out Hostent;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int)
is
use type C.Strings.chars_ptr;
Names_Length : size_t;
Source_Aliases : Chars_Ptr_Array
renames Chars_Ptr_Pointers.Value
(Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
-- Null-terminated list of aliases (last element of this array is
-- Null_Ptr).
Source_Addresses : In_Addr_Access_Array
renames In_Addr_Access_Pointers.Value
(Source_Hostent.H_Addr_List, Terminator => null);
begin
Result := -1;
Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
for J in Source_Aliases'Range loop
if Source_Aliases (J) /= C.Strings.Null_Ptr then
Names_Length :=
Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
end if;
end loop;
declare
type In_Addr_Array is array (Source_Addresses'Range)
of aliased In_Addr;
type Netdb_Host_Data is record
Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
Names : aliased char_array (1 .. Names_Length);
Addresses_List : aliased In_Addr_Access_Array
(In_Addr_Array'Range);
Addresses : In_Addr_Array;
-- ??? This assumes support only for Inet family
end record;
Netdb_Data : Netdb_Host_Data;
pragma Import (Ada, Netdb_Data);
for Netdb_Data'Address use Target_Buffer;
Names_Index : size_t := Netdb_Data.Names'First;
-- Index of first available location in Netdb_Data.Names
begin
if Netdb_Data'Size / 8 > Target_Buffer_Length then
return;
end if;
-- Copy host name
Store_Name
(C.Strings.Value (Source_Hostent.H_Name),
Netdb_Data.Names, Names_Index,
Target_Hostent.H_Name);
-- Copy aliases (null-terminated string pointer array)
Target_Hostent.H_Aliases :=
Netdb_Data.Aliases_List
(Netdb_Data.Aliases_List'First)'Unchecked_Access;
for J in Netdb_Data.Aliases_List'Range loop
if J = Netdb_Data.Aliases_List'Last then
Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
else
Store_Name
(C.Strings.Value (Source_Aliases (J)),
Netdb_Data.Names, Names_Index,
Netdb_Data.Aliases_List (J));
end if;
end loop;
-- Copy address type and length
Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
Target_Hostent.H_Length := Source_Hostent.H_Length;
-- Copy addresses
Target_Hostent.H_Addr_List :=
Netdb_Data.Addresses_List
(Netdb_Data.Addresses_List'First)'Unchecked_Access;
for J in Netdb_Data.Addresses'Range loop
if J = Netdb_Data.Addresses'Last then
Netdb_Data.Addresses_List (J) := null;
else
Netdb_Data.Addresses_List (J) :=
Netdb_Data.Addresses (J)'Unchecked_Access;
Netdb_Data.Addresses (J) := Source_Addresses (J).all;
end if;
end loop;
end;
Result := 0;
end Copy_Host_Entry;
------------------------
-- Copy_Service_Entry --
------------------------
procedure Copy_Service_Entry
(Source_Servent : Servent;
Target_Servent : out Servent;
Target_Buffer : System.Address;
Target_Buffer_Length : C.int;
Result : out C.int)
is
use type C.Strings.chars_ptr;
Names_Length : size_t;
Source_Aliases : Chars_Ptr_Array
renames Chars_Ptr_Pointers.Value
(Source_Servent.S_Aliases, Terminator => C.Strings.Null_Ptr);
-- Null-terminated list of aliases (last element of this array is
-- Null_Ptr).
begin
Result := -1;
Names_Length := C.Strings.Strlen (Source_Servent.S_Name) + 1
+ C.Strings.Strlen (Source_Servent.S_Proto) + 1;
for J in Source_Aliases'Range loop
if Source_Aliases (J) /= C.Strings.Null_Ptr then
Names_Length :=
Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
end if;
end loop;
declare
type Netdb_Service_Data is record
Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
Names : aliased char_array (1 .. Names_Length);
end record;
Netdb_Data : Netdb_Service_Data;
pragma Import (Ada, Netdb_Data);
for Netdb_Data'Address use Target_Buffer;
Names_Index : size_t := Netdb_Data.Names'First;
-- Index of first available location in Netdb_Data.Names
begin
if Netdb_Data'Size / 8 > Target_Buffer_Length then
return;
end if;
-- Copy service name
Store_Name
(C.Strings.Value (Source_Servent.S_Name),
Netdb_Data.Names, Names_Index,
Target_Servent.S_Name);
-- Copy aliases (null-terminated string pointer array)
Target_Servent.S_Aliases :=
Netdb_Data.Aliases_List
(Netdb_Data.Aliases_List'First)'Unchecked_Access;
-- Copy port number
Target_Servent.S_Port := Source_Servent.S_Port;
-- Copy protocol name
Store_Name
(C.Strings.Value (Source_Servent.S_Proto),
Netdb_Data.Names, Names_Index,
Target_Servent.S_Proto);
for J in Netdb_Data.Aliases_List'Range loop
if J = Netdb_Data.Aliases_List'Last then
Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
else
Store_Name
(C.Strings.Value (Source_Aliases (J)),
Netdb_Data.Names, Names_Index,
Netdb_Data.Aliases_List (J));
end if;
end loop;
end;
Result := 0;
end Copy_Service_Entry;
------------------------
-- Safe_Gethostbyaddr --
------------------------
function Safe_Gethostbyaddr
(Addr : System.Address;
Addr_Len : C.int;
Addr_Type : C.int;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int
is
HE : Hostent_Access;
Result : C.int;
begin
Result := -1;
GNAT.Task_Lock.Lock;
HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
if HE = null then
H_Errnop.all := C.int (Host_Errno);
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
Copy_Host_Entry
(Source_Hostent => HE.all,
Target_Hostent => Ret.all,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
<<Unlock_Return>>
GNAT.Task_Lock.Unlock;
return Result;
end Safe_Gethostbyaddr;
------------------------
-- Safe_Gethostbyname --
------------------------
function Safe_Gethostbyname
(Name : C.char_array;
Ret : not null access Hostent;
Buf : System.Address;
Buflen : C.int;
H_Errnop : not null access C.int) return C.int
is
HE : Hostent_Access;
Result : C.int;
begin
Result := -1;
GNAT.Task_Lock.Lock;
HE := Nonreentrant_Gethostbyname (Name);
if HE = null then
H_Errnop.all := C.int (Host_Errno);
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
Copy_Host_Entry
(Source_Hostent => HE.all,
Target_Hostent => Ret.all,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
<<Unlock_Return>>
GNAT.Task_Lock.Unlock;
return Result;
end Safe_Gethostbyname;
------------------------
-- Safe_Getservbyname --
------------------------
function Safe_Getservbyname
(Name : C.char_array;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int
is
SE : Servent_Access;
Result : C.int;
begin
Result := -1;
GNAT.Task_Lock.Lock;
SE := Nonreentrant_Getservbyname (Name, Proto);
if SE = null then
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
Copy_Service_Entry
(Source_Servent => SE.all,
Target_Servent => Ret.all,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
<<Unlock_Return>>
GNAT.Task_Lock.Unlock;
return Result;
end Safe_Getservbyname;
------------------------
-- Safe_Getservbyport --
------------------------
function Safe_Getservbyport
(Port : C.int;
Proto : C.char_array;
Ret : not null access Servent;
Buf : System.Address;
Buflen : C.int) return C.int
is
SE : Servent_Access;
Result : C.int;
begin
Result := -1;
GNAT.Task_Lock.Lock;
SE := Nonreentrant_Getservbyport (Port, Proto);
if SE = null then
goto Unlock_Return;
end if;
-- Now copy the data to the user-provided buffer
Copy_Service_Entry
(Source_Servent => SE.all,
Target_Servent => Ret.all,
Target_Buffer => Buf,
Target_Buffer_Length => Buflen,
Result => Result);
<<Unlock_Return>>
GNAT.Task_Lock.Unlock;
return Result;
end Safe_Getservbyport;
----------------
-- Store_Name --
----------------
procedure Store_Name
(Name : char_array;
Storage : in out char_array;
Storage_Index : in out size_t;
Stored_Name : out C.Strings.chars_ptr)
is
First : constant C.size_t := Storage_Index;
Last : constant C.size_t := Storage_Index + Name'Length - 1;
begin
Storage (First .. Last) := Name;
Stored_Name := C.Strings.To_Chars_Ptr
(Storage (First .. Last)'Unrestricted_Access);
Storage_Index := Last + 1;
end Store_Name;
end GNAT.Sockets.Thin.Task_Safe_NetDB;