461 lines
16 KiB
Ada
461 lines
16 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2009, 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_Access;
|
|
Target_Servent : Servent_Access;
|
|
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_Access;
|
|
Target_Servent : Servent_Access;
|
|
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
|
|
(Servent_S_Aliases (Source_Servent),
|
|
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 (Servent_S_Name (Source_Servent)) + 1 +
|
|
C.Strings.Strlen (Servent_S_Proto (Source_Servent)) + 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
|
|
|
|
Stored_Name : C.Strings.chars_ptr;
|
|
|
|
begin
|
|
if Netdb_Data'Size / 8 > Target_Buffer_Length then
|
|
return;
|
|
end if;
|
|
|
|
-- Copy service name
|
|
|
|
Store_Name
|
|
(C.Strings.Value (Servent_S_Name (Source_Servent)),
|
|
Netdb_Data.Names, Names_Index,
|
|
Stored_Name);
|
|
Servent_Set_S_Name (Target_Servent, Stored_Name);
|
|
|
|
-- Copy aliases (null-terminated string pointer array)
|
|
|
|
Servent_Set_S_Aliases
|
|
(Target_Servent,
|
|
Netdb_Data.Aliases_List
|
|
(Netdb_Data.Aliases_List'First)'Unchecked_Access);
|
|
|
|
-- Copy port number
|
|
|
|
Servent_Set_S_Port (Target_Servent, Servent_S_Port (Source_Servent));
|
|
|
|
-- Copy protocol name
|
|
|
|
Store_Name
|
|
(C.Strings.Value (Servent_S_Proto (Source_Servent)),
|
|
Netdb_Data.Names, Names_Index,
|
|
Stored_Name);
|
|
Servent_Set_S_Proto (Target_Servent, Stored_Name);
|
|
|
|
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. We convert Ret to
|
|
-- type Servent_Access using the .all'Unchecked_Access trick to avoid
|
|
-- an accessibility check. Ret could be pointing to a nested variable,
|
|
-- and we don't want to raise an exception in that case.
|
|
|
|
Copy_Service_Entry
|
|
(Source_Servent => SE,
|
|
Target_Servent => Ret.all'Unchecked_Access,
|
|
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. See Safe_Getservbyname
|
|
-- for comment regarding .all'Unchecked_Access.
|
|
|
|
Copy_Service_Entry
|
|
(Source_Servent => SE,
|
|
Target_Servent => Ret.all'Unchecked_Access,
|
|
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;
|