Index: g-sttsne-locking.adb =================================================================== --- g-sttsne-locking.adb (revision 160705) +++ g-sttsne-locking.adb (working copy) @@ -1,460 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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); - - <> - 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); - - <> - 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); - - <> - 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); - - <> - 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; Index: g-sttsne-locking.ads =================================================================== --- g-sttsne-locking.ads (revision 160705) +++ g-sttsne-locking.ads (working copy) @@ -1,75 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- 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, LynxOS, and VxWorks. There are two versions of --- the body: one for VMS and LynxOS, the other for VxWorks. - --- This package should not be directly with'ed by an application - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - - ---------------------------------------- - -- Reentrant network databases access -- - ---------------------------------------- - - 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; - - 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; - - 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; - - function Safe_Getservbyport - (Port : C.int; - Proto : C.char_array; - Ret : not null access Servent; - Buf : System.Address; - Buflen : C.int) return C.int; - -end GNAT.Sockets.Thin.Task_Safe_NetDB; Index: g-sttsne.ads =================================================================== --- g-sttsne.ads (revision 160705) +++ g-sttsne.ads (working copy) @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- 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 package exports reentrant NetDB subprograms. This is the default --- version, used on most platforms. The routines are implemented by importing --- from C; see gsocket.h for details. Different versions are provided on --- platforms where this functionality is implemented in Ada. - --- This package should not be directly with'ed by an application - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - - ---------------------------------------- - -- Reentrant network databases access -- - ---------------------------------------- - - 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; - - 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; - - 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; - - function Safe_Getservbyport - (Port : C.int; - Proto : C.char_array; - Ret : not null access Servent; - Buf : System.Address; - Buflen : C.int) return C.int; - -private - pragma Import (C, Safe_Gethostbyname, "__gnat_safe_gethostbyname"); - pragma Import (C, Safe_Gethostbyaddr, "__gnat_safe_gethostbyaddr"); - pragma Import (C, Safe_Getservbyname, "__gnat_safe_getservbyname"); - pragma Import (C, Safe_Getservbyport, "__gnat_safe_getservbyport"); - -end GNAT.Sockets.Thin.Task_Safe_NetDB; Index: g-sttsne-vxworks.adb =================================================================== --- g-sttsne-vxworks.adb (revision 160705) +++ g-sttsne-vxworks.adb (working copy) @@ -1,204 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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-2008, 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 VxWorks. Note that the corresponding spec is in --- g-sttsne-locking.ads. - -with Ada.Unchecked_Conversion; -with Interfaces.C; use Interfaces.C; - -package body GNAT.Sockets.Thin.Task_Safe_NetDB is - - -- The following additional data is returned by Safe_Gethostbyname - -- and Safe_Getostbyaddr in the user provided buffer. - - type Netdb_Host_Data (Name_Length : C.size_t) is record - Address : aliased In_Addr; - Addr_List : aliased In_Addr_Access_Array (0 .. 1); - Name : aliased C.char_array (0 .. Name_Length); - end record; - - Alias_Access : constant Chars_Ptr_Pointers.Pointer := - new C.Strings.chars_ptr'(C.Strings.Null_Ptr); - -- Constant used to create a Hostent record manually - - ------------------------ - -- 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 - type int_Access is access int; - function To_Pointer is - new Ada.Unchecked_Conversion (System.Address, int_Access); - - function VxWorks_hostGetByAddr - (Addr : C.int; Buf : System.Address) return C.int; - pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr"); - - Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length); - pragma Import (Ada, Netdb_Data); - for Netdb_Data'Address use Buf; - - begin - pragma Assert (Addr_Type = SOSC.AF_INET); - pragma Assert (Addr_Len = In_Addr'Size / 8); - - -- Check that provided buffer is sufficiently large to hold the - -- data we want to return. - - if Netdb_Data'Size / 8 > Buflen then - H_Errnop.all := SOSC.ERANGE; - return -1; - end if; - - if VxWorks_hostGetByAddr (To_Pointer (Addr).all, - Netdb_Data.Name'Address) - /= SOSC.OK - then - H_Errnop.all := C.int (Host_Errno); - return -1; - end if; - - Netdb_Data.Address := To_In_Addr (To_Pointer (Addr).all); - Netdb_Data.Addr_List := - (0 => Netdb_Data.Address'Unchecked_Access, - 1 => null); - - Ret.H_Name := C.Strings.To_Chars_Ptr - (Netdb_Data.Name'Unrestricted_Access); - Ret.H_Aliases := Alias_Access; - Ret.H_Addrtype := SOSC.AF_INET; - Ret.H_Length := 4; - Ret.H_Addr_List := - Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access; - return 0; - 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 - function VxWorks_hostGetByName - (Name : C.char_array) return C.int; - pragma Import (C, VxWorks_hostGetByName, "hostGetByName"); - - Addr : C.int; - - begin - Addr := VxWorks_hostGetByName (Name); - if Addr = SOSC.ERROR then - H_Errnop.all := C.int (Host_Errno); - return -1; - end if; - - declare - Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length); - pragma Import (Ada, Netdb_Data); - for Netdb_Data'Address use Buf; - - begin - -- Check that provided buffer is sufficiently large to hold the - -- data we want to return. - - if Netdb_Data'Size / 8 > Buflen then - H_Errnop.all := SOSC.ERANGE; - return -1; - end if; - - Netdb_Data.Address := To_In_Addr (Addr); - Netdb_Data.Addr_List := - (0 => Netdb_Data.Address'Unchecked_Access, - 1 => null); - Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name; - - Ret.H_Name := C.Strings.To_Chars_Ptr - (Netdb_Data.Name'Unrestricted_Access); - Ret.H_Aliases := Alias_Access; - Ret.H_Addrtype := SOSC.AF_INET; - Ret.H_Length := 4; - Ret.H_Addr_List := - Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access; - end; - return 0; - 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 - pragma Unreferenced (Name, Proto, Ret, Buf, Buflen); - begin - -- Not available under VxWorks - return -1; - 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 - pragma Unreferenced (Port, Proto, Ret, Buf, Buflen); - begin - -- Not available under VxWorks - return -1; - end Safe_Getservbyport; - -end GNAT.Sockets.Thin.Task_Safe_NetDB; Index: g-sttsne-dummy.ads =================================================================== --- g-sttsne-dummy.ads (revision 160705) +++ g-sttsne-dummy.ads (working copy) @@ -1,39 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- 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 -- --- -- --- S p e c -- --- -- --- Copyright (C) 2007-2008, 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 package is a placeholder for the sockets binding for platforms where --- it is not implemented. - -package GNAT.Sockets.Thin.Task_Safe_NetDB is - pragma Unimplemented_Unit; -end GNAT.Sockets.Thin.Task_Safe_NetDB; Index: socket.c =================================================================== --- socket.c (revision 160705) +++ socket.c (working copy) @@ -32,6 +32,7 @@ /* This file provides a portable binding to the sockets API */ #include "gsocket.h" + #ifdef VMS /* * For VMS, gsocket.h can't include sockets-related DEC C header files @@ -42,16 +43,41 @@ # include "s-oscons.h" /* - * We also need the declaration of struct servent, which s-oscons can't - * provide, so we copy it manually here. This needs to be kept in synch + * We also need the declaration of struct hostent/servent, which s-oscons + * can't provide, so we copy it manually here. This needs to be kept in synch * with the definition of that structure in the DEC C headers, which * hopefully won't change frequently. */ +typedef char *__netdb_char_ptr __attribute__ (( mode (SI) )); +typedef __netdb_char_ptr *__netdb_char_ptr_ptr __attribute__ (( mode (SI) )); +# define NEED_STRUCT_xxxENT + +#elif defined (__vxworks) +/* + * For VxWorks we emulate getXXXbyYYY using the proprietary VxWorks API. + */ +typedef char *__netdb_char_ptr; +typedef __netdb_char_ptr *__netdb_char_ptr_ptr; +# define NEED_STRUCT_xxxENT + +#else +# undef NEED_STRUCT_xxxENT +#endif + +#ifdef NEED_STRUCT_xxxENT +struct hostent { + __netdb_char_ptr h_name; + __netdb_char_ptr_ptr h_aliases; + int h_addrtype; + int h_length; + __netdb_char_ptr_ptr h_addr_list; +}; + struct servent { - char *s_name; /* official service name */ - char **s_aliases; /* alias list */ - int s_port; /* port # */ - char *s_proto; /* protocol to use */ + __netdb_char_ptr s_name; + __netdb_char_ptr_ptr s_aliases; + int s_port; + __netdb_char_ptr s_proto; }; #endif @@ -87,14 +113,18 @@ extern void __gnat_remove_socket_from_se extern void __gnat_reset_socket_set (fd_set *); extern int __gnat_get_h_errno (void); extern int __gnat_socket_ioctl (int, int, int *); + extern char * __gnat_servent_s_name (struct servent *); -extern char ** __gnat_servent_s_aliases (struct servent *); -extern int __gnat_servent_s_port (struct servent *); +extern char * __gnat_servent_s_alias (struct servent *, int index); +extern unsigned short __gnat_servent_s_port (struct servent *); extern char * __gnat_servent_s_proto (struct servent *); -extern void __gnat_servent_set_s_name (struct servent *, char *); -extern void __gnat_servent_set_s_aliases (struct servent *, char **); -extern void __gnat_servent_set_s_port (struct servent *, int); -extern void __gnat_servent_set_s_proto (struct servent *, char *); + +extern char * __gnat_hostent_h_name (struct hostent *); +extern char * __gnat_hostent_h_alias (struct hostent *, int); +extern int __gnat_hostent_h_addrtype (struct hostent *); +extern int __gnat_hostent_h_length (struct hostent *); +extern char * __gnat_hostent_h_addr (struct hostent *, int); + #if defined (__vxworks) || defined (_WIN32) extern int __gnat_inet_pton (int, const char *, void *); #endif @@ -164,76 +194,28 @@ __gnat_close_signalling_fd (int sig) { #endif /* - * GetXXXbyYYY wrappers - * These functions are used by the default implementation of g-socthi, - * and also by the Windows version. + * Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport + * ========================================================================= + * + * This module exposes __gnat_getXXXbyYYY operations with the same signature + * as the reentrant variant getXXXbyYYY_r. + * + * On platforms where getXXXbyYYY is intrinsically reentrant, the provided user + * buffer argument is ignored. * - * They can be used for any platform that either provides an intrinsically - * task safe implementation of getXXXbyYYY, or a reentrant variant - * getXXXbyYYY_r. Otherwise, a task safe wrapper, including proper mutual - * exclusion if appropriate, must be implemented in the target specific - * version of g-socthi. + * When getXXXbyYYY is not reentrant but getXXXbyYYY_r exists, the latter is + * used, and the provided buffer argument must point to a valid, thread-local + * buffer (usually on the caller's stack). + * + * When getXXXbyYYY is not reentrant and no reentrant getXXXbyYYY_r variant + * is available, the non-reentrant getXXXbyYYY is called, the provided user + * buffer is ignored, and the caller is expected to take care of mutual + * exclusion. */ -#ifdef HAVE_THREAD_SAFE_GETxxxBYyyy -int -__gnat_safe_gethostbyname (const char *name, - struct hostent *ret, char *buf, size_t buflen, - int *h_errnop) -{ - struct hostent *rh; - rh = gethostbyname (name); - if (rh == NULL) { - *h_errnop = h_errno; - return -1; - } - *ret = *rh; - *h_errnop = 0; - return 0; -} - -int -__gnat_safe_gethostbyaddr (const char *addr, int len, int type, - struct hostent *ret, char *buf, size_t buflen, - int *h_errnop) -{ - struct hostent *rh; - rh = gethostbyaddr (addr, len, type); - if (rh == NULL) { - *h_errnop = h_errno; - return -1; - } - *ret = *rh; - *h_errnop = 0; - return 0; -} - -int -__gnat_safe_getservbyname (const char *name, const char *proto, - struct servent *ret, char *buf, size_t buflen) -{ - struct servent *rh; - rh = getservbyname (name, proto); - if (rh == NULL) - return -1; - *ret = *rh; - return 0; -} - +#ifdef HAVE_GETxxxBYyyy_R int -__gnat_safe_getservbyport (int port, const char *proto, - struct servent *ret, char *buf, size_t buflen) -{ - struct servent *rh; - rh = getservbyport (port, proto); - if (rh == NULL) - return -1; - *ret = *rh; - return 0; -} -#elif HAVE_GETxxxBYyyy_R -int -__gnat_safe_gethostbyname (const char *name, +__gnat_gethostbyname (const char *name, struct hostent *ret, char *buf, size_t buflen, int *h_errnop) { @@ -250,7 +232,7 @@ __gnat_safe_gethostbyname (const char *n } int -__gnat_safe_gethostbyaddr (const char *addr, int len, int type, +__gnat_gethostbyaddr (const char *addr, int len, int type, struct hostent *ret, char *buf, size_t buflen, int *h_errnop) { @@ -267,7 +249,7 @@ __gnat_safe_gethostbyaddr (const char *a } int -__gnat_safe_getservbyname (const char *name, const char *proto, +__gnat_getservbyname (const char *name, const char *proto, struct servent *ret, char *buf, size_t buflen) { struct servent *rh; @@ -283,7 +265,7 @@ __gnat_safe_getservbyname (const char *n } int -__gnat_safe_getservbyport (int port, const char *proto, +__gnat_getservbyport (int port, const char *proto, struct servent *ret, char *buf, size_t buflen) { struct servent *rh; @@ -297,6 +279,130 @@ __gnat_safe_getservbyport (int port, con ri = (rh == NULL) ? -1 : 0; return ri; } +#elif defined (__vxworks) +static char vxw_h_name[MAXHOSTNAMELEN + 1]; +static char *vxw_h_aliases[1] = { NULL }; +static int vxw_h_addr; +static char *vxw_h_addr_list[2] = { (char*) &vxw_h_addr, NULL }; + +int +__gnat_gethostbyname (const char *name, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + vxw_h_addr = hostGetByName (name); + if (vxw_h_addr == ERROR) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + ret->h_name = name; + ret->h_aliases = &vxw_h_aliases; + ret->h_addrtype = AF_INET; + ret->h_length = 4; + ret->h_addr_list = &vxw_h_addr_list; + return 0; +} + +int +__gnat_gethostbyaddr (const char *addr, int len, int type, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + if (type != AF_INET) { + *h_errnop = EAFNOSUPPORT; + return -1; + } + + if (addr == NULL || len != 4) { + *h_errnop = EINVAL; + return -1; + } + + if (hostGetByAddr (*(int*)addr, &vxw_h_name) != OK) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + + vxw_h_addr = addr; + + ret->h_name = &vxw_h_name; + ret->h_aliases = &vxw_h_aliases; + ret->h_addrtype = AF_INET; + ret->h_length = 4; + ret->h_addr_list = &vxw_h_addr_list; +} + +int +__gnat_getservbyname (const char *name, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + /* Not available under VxWorks */ + return -1; +} + +int +__gnat_getservbyport (int port, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + /* Not available under VxWorks */ + return -1; +} +#else +int +__gnat_gethostbyname (const char *name, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + struct hostent *rh; + rh = gethostbyname (name); + if (rh == NULL) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + *ret = *rh; + *h_errnop = 0; + return 0; +} + +int +__gnat_gethostbyaddr (const char *addr, int len, int type, + struct hostent *ret, char *buf, size_t buflen, + int *h_errnop) +{ + struct hostent *rh; + rh = gethostbyaddr (addr, len, type); + if (rh == NULL) { + *h_errnop = __gnat_get_h_errno (); + return -1; + } + *ret = *rh; + *h_errnop = 0; + return 0; +} + +int +__gnat_getservbyname (const char *name, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + struct servent *rh; + rh = getservbyname (name, proto); + if (rh == NULL) + return -1; + *ret = *rh; + return 0; +} + +int +__gnat_getservbyport (int port, const char *proto, + struct servent *ret, char *buf, size_t buflen) +{ + struct servent *rh; + rh = getservbyport (port, proto); + if (rh == NULL) + return -1; + *ret = *rh; + return 0; +} #endif /* Find the largest socket in the socket set SET. This is needed for @@ -510,6 +616,30 @@ __gnat_inet_pton (int af, const char *sr #endif /* + * Accessor functions for struct hostent. + */ + +char * __gnat_hostent_h_name (struct hostent * h) { + return h->h_name; +} + +char * __gnat_hostent_h_alias (struct hostent * h, int index) { + return h->h_aliases[index]; +} + +int __gnat_hostent_h_addrtype (struct hostent * h) { + return h->h_addrtype; +} + +int __gnat_hostent_h_length (struct hostent * h) { + return h->h_length; +} + +char * __gnat_hostent_h_addr (struct hostent * h, int index) { + return h->h_addr_list[index]; +} + +/* * Accessor functions for struct servent. * * These are needed because servent has different representations on different @@ -539,21 +669,19 @@ __gnat_inet_pton (int af, const char *sr * }; */ -/* Getters */ - char * __gnat_servent_s_name (struct servent * s) { return s->s_name; } -char ** -__gnat_servent_s_aliases (struct servent * s) +char * +__gnat_servent_s_alias (struct servent * s, int index) { - return s->s_aliases; + return s->s_aliases[index]; } -int +unsigned short __gnat_servent_s_port (struct servent * s) { return s->s_port; @@ -565,32 +693,6 @@ __gnat_servent_s_proto (struct servent * return s->s_proto; } -/* Setters */ - -void -__gnat_servent_set_s_name (struct servent * s, char * s_name) -{ - s->s_name = s_name; -} - -void -__gnat_servent_set_s_aliases (struct servent * s, char ** s_aliases) -{ - s->s_aliases = s_aliases; -} - -void -__gnat_servent_set_s_port (struct servent * s, int s_port) -{ - s->s_port = s_port; -} - -void -__gnat_servent_set_s_proto (struct servent * s, char * s_proto) -{ - s->s_proto = s_proto; -} - #else # warning Sockets are not supported on this platform #endif /* defined(HAVE_SOCKETS) */ Index: s-oscons-tmplt.c =================================================================== --- s-oscons-tmplt.c (revision 160714) +++ s-oscons-tmplt.c (working copy) @@ -1231,26 +1231,13 @@ CND(SIZEOF_sockaddr_in6, "struct sockadd #define SIZEOF_fd_set (sizeof (fd_set)) CND(SIZEOF_fd_set, "fd_set"); +#define SIZEOF_struct_hostent (sizeof (struct hostent)) +CND(SIZEOF_struct_hostent, "struct hostent"); + #define SIZEOF_struct_servent (sizeof (struct servent)) CND(SIZEOF_struct_servent, "struct servent"); /* - -- Fields of struct hostent -*/ - -#ifdef __MINGW32__ -# define h_addrtype_t "short" -# define h_length_t "short" -#else -# define h_addrtype_t "int" -# define h_length_t "int" -#endif - -TXT(" subtype H_Addrtype_T is Interfaces.C." h_addrtype_t ";") -TXT(" subtype H_Length_T is Interfaces.C." h_length_t ";") - -/* - -- Fields of struct msghdr */ @@ -1271,6 +1258,7 @@ TXT(" subtype Msg_Iovlen_T is Interfac */ CND(Need_Netdb_Buffer, "Need buffer for Netdb ops") +CND(Need_Netdb_Lock, "Need lock for Netdb ops") CND(Has_Sockaddr_Len, "Sockaddr has sa_len field") /** Index: gsocket.h =================================================================== --- gsocket.h (revision 160705) +++ gsocket.h (working copy) @@ -194,34 +194,37 @@ #include #endif -/* - * Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport - * ========================================================================= - * - * The default implementation of GNAT.Sockets.Thin requires that these - * operations be either thread safe, or that a reentrant version getXXXbyYYY_r - * be provided. In both cases, socket.c provides a __gnat_safe_getXXXbyYYY - * function with the same signature as getXXXbyYYY_r. If the operating - * system version of getXXXbyYYY is thread safe, the provided auxiliary - * buffer argument is unused and ignored. - * - * Target specific versions of GNAT.Sockets.Thin for platforms that can't - * fulfill these requirements must provide their own protection mechanism - * in Safe_GetXXXbyYYY, and if they require GNAT.Sockets to provide a buffer - * to this effect, then we need to set Need_Netdb_Buffer here (case of - * VxWorks and VMS). - */ - -#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || defined (__osf__) || defined (_WIN32) || defined (__APPLE__) +#if defined (_AIX) || defined (__FreeBSD__) || defined (__hpux__) || \ + defined (__osf__) || defined (_WIN32) || defined (__APPLE__) # define HAVE_THREAD_SAFE_GETxxxBYyyy 1 -#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || defined(__rtems__) + +#elif defined (sgi) || defined (linux) || defined (__GLIBC__) || \ + (defined (sun) && defined (__SVR4) && !defined (__vxworks)) || \ + defined(__rtems__) # define HAVE_GETxxxBYyyy_R 1 #endif -#if defined (HAVE_GETxxxBYyyy_R) || !defined (HAVE_THREAD_SAFE_GETxxxBYyyy) +/* + * Properties of the unerlying NetDB library: + * Need_Netdb_Buffer __gnat_getXXXbyYYY expects a caller-supplied buffer + * Need_Netdb_Lock __gnat_getXXXbyYYY expects the caller to ensure + * mutual exclusion + * + * See "Handling of gethostbyname, gethostbyaddr, getservbyname and + * getservbyport" in socket.c for details. + */ + +#if defined (HAVE_GETxxxBYyyy_R) # define Need_Netdb_Buffer 1 +# define Need_Netdb_Lock 0 + #else # define Need_Netdb_Buffer 0 +# if !defined (HAVE_THREAD_SAFE_GETxxxBYyyy) +# define Need_Netdb_Lock 1 +# else +# define Need_Netdb_Lock 0 +# endif #endif #if defined (__FreeBSD__) || defined (__vxworks) || defined(__rtems__) Index: g-socket.adb =================================================================== --- g-socket.adb (revision 160705) +++ g-socket.adb (working copy) @@ -40,7 +40,6 @@ with Interfaces.C.Strings; with GNAT.Sockets.Thin_Common; use GNAT.Sockets.Thin_Common; with GNAT.Sockets.Thin; use GNAT.Sockets.Thin; -with GNAT.Sockets.Thin.Task_Safe_NetDB; use GNAT.Sockets.Thin.Task_Safe_NetDB; with GNAT.Sockets.Linker_Options; pragma Warnings (Off, GNAT.Sockets.Linker_Options); @@ -49,6 +48,7 @@ pragma Warnings (Off, GNAT.Sockets.Linke with System; use System; with System.Communication; use System.Communication; with System.CRTL; use System.CRTL; +with System.Task_Lock; package body GNAT.Sockets is @@ -59,6 +59,7 @@ package body GNAT.Sockets is ENOERROR : constant := 0; Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; + Need_Netdb_Lock : constant Boolean := SOSC.Need_Netdb_Lock /= 0; -- The network database functions gethostbyname, gethostbyaddr, -- getservbyname and getservbyport can either be guaranteed task safe by -- the operating system, or else return data through a user-provided buffer @@ -155,13 +156,20 @@ package body GNAT.Sockets is function Is_IP_Address (Name : String) return Boolean; -- Return true when Name is an IP address in standard dot notation + procedure Netdb_Lock; + pragma Inline (Netdb_Lock); + procedure Netdb_Unlock; + pragma Inline (Netdb_Unlock); + -- Lock/unlock operation used to protect netdb access for platforms that + -- require such protection. + function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr; procedure To_Inet_Addr (Addr : In_Addr; Result : out Inet_Addr_Type); -- Conversion functions - function To_Host_Entry (E : Hostent) return Host_Entry_Type; + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type; -- Conversion function function To_Service_Entry (E : Servent_Access) return Service_Entry_Type; @@ -891,13 +899,19 @@ package body GNAT.Sockets is Err : aliased C.int; begin - if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, + Netdb_Lock; + if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, Res'Access, Buf'Address, Buflen, Err'Access) /= 0 then + Netdb_Unlock; Raise_Host_Error (Integer (Err)); end if; - return To_Host_Entry (Res); + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Host_By_Address; ---------------------- @@ -920,13 +934,19 @@ package body GNAT.Sockets is Err : aliased C.int; begin - if Safe_Gethostbyname + Netdb_Lock; + if C_Gethostbyname (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0 then + Netdb_Unlock; Raise_Host_Error (Integer (Err)); end if; - return To_Host_Entry (Res); + return H : constant Host_Entry_Type := + To_Host_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end; end Get_Host_By_Name; @@ -965,13 +985,19 @@ package body GNAT.Sockets is Res : aliased Servent; begin - if Safe_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Lock; + if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Unlock; raise Service_Error with "Service not found"; end if; -- Translate from the C format to the API format - return To_Service_Entry (Res'Unchecked_Access); + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Service_By_Name; ------------------------- @@ -988,16 +1014,22 @@ package body GNAT.Sockets is Res : aliased Servent; begin - if Safe_Getservbyport + Netdb_Lock; + if C_Getservbyport (C.int (Short_To_Network (C.unsigned_short (Port))), SP, Res'Access, Buf'Address, Buflen) /= 0 then + Netdb_Unlock; raise Service_Error with "Service not found"; end if; -- Translate from the C format to the API format - return To_Service_Entry (Res'Unchecked_Access); + return S : constant Service_Entry_Type := + To_Service_Entry (Res'Unchecked_Access) + do + Netdb_Unlock; + end return; end Get_Service_By_Port; --------------------- @@ -1438,6 +1470,28 @@ package body GNAT.Sockets is end if; end Narrow; + ---------------- + -- Netdb_Lock -- + ---------------- + + procedure Netdb_Lock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Lock; + end if; + end Netdb_Lock; + + ------------------ + -- Netdb_Unlock -- + ------------------ + + procedure Netdb_Unlock is + begin + if Need_Netdb_Lock then + System.Task_Lock.Unlock; + end if; + end Netdb_Unlock; + -------------------------------- -- Normalize_Empty_Socket_Set -- -------------------------------- @@ -2273,54 +2327,52 @@ package body GNAT.Sockets is -- To_Host_Entry -- ------------------- - function To_Host_Entry (E : Hostent) return Host_Entry_Type is + function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is use type C.size_t; + use C.Strings; - Official : constant String := - C.Strings.Value (E.H_Name); + Aliases_Count, Addresses_Count : Natural; - Aliases : constant Chars_Ptr_Array := - Chars_Ptr_Pointers.Value (E.H_Aliases); - -- H_Aliases points to a list of name aliases. The list is terminated by - -- a NULL pointer. - - Addresses : constant In_Addr_Access_Array := - In_Addr_Access_Pointers.Value (E.H_Addr_List); - -- H_Addr_List points to a list of binary addresses (in network byte - -- order). The list is terminated by a NULL pointer. - -- - -- H_Length is not used because it is currently only set to 4. + -- H_Length is not used because it is currently only set to 4 -- H_Addrtype is always AF_INET - Result : Host_Entry_Type - (Aliases_Length => Aliases'Length - 1, - Addresses_Length => Addresses'Length - 1); - -- The last element is a null pointer - - Source : C.size_t; - Target : Natural; - - begin - Result.Official := To_Name (Official); - - Source := Aliases'First; - Target := Result.Aliases'First; - while Target <= Result.Aliases_Length loop - Result.Aliases (Target) := - To_Name (C.Strings.Value (Aliases (Source))); - Source := Source + 1; - Target := Target + 1; + begin + Aliases_Count := 0; + while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop + Aliases_Count := Aliases_Count + 1; end loop; - Source := Addresses'First; - Target := Result.Addresses'First; - while Target <= Result.Addresses_Length loop - To_Inet_Addr (Addresses (Source).all, Result.Addresses (Target)); - Source := Source + 1; - Target := Target + 1; + Addresses_Count := 0; + while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Ptr loop + Addresses_Count := Addresses_Count + 1; end loop; - return Result; + return Result : Host_Entry_Type + (Aliases_Length => Aliases_Count, + Addresses_Length => Addresses_Count) + do + Result.Official := To_Name (Value (Hostent_H_Name (E))); + + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Hostent_H_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + for J in Result.Addresses'Range loop + declare + Addr : In_Addr; + function To_Address is + new Ada.Unchecked_Conversion (chars_ptr, System.Address); + for Addr'Address use + To_Address (Hostent_H_Addr + (E, C.int (J - Result.Addresses'First))); + pragma Import (Ada, Addr); + begin + To_Inet_Addr (Addr, Result.Addresses (J)); + end; + end loop; + end return; end To_Host_Entry; ---------------- @@ -2394,40 +2446,30 @@ package body GNAT.Sockets is ---------------------- function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is + use C.Strings; use type C.size_t; - Official : constant String := C.Strings.Value (Servent_S_Name (E)); - - Aliases : constant Chars_Ptr_Array := - Chars_Ptr_Pointers.Value (Servent_S_Aliases (E)); - -- S_Aliases points to a list of name aliases. The list is - -- terminated by a NULL pointer. - - Protocol : constant String := C.Strings.Value (Servent_S_Proto (E)); - - Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1); - -- The last element is a null pointer - - Source : C.size_t; - Target : Natural; + Aliases_Count : Natural; begin - Result.Official := To_Name (Official); - - Source := Aliases'First; - Target := Result.Aliases'First; - while Target <= Result.Aliases_Length loop - Result.Aliases (Target) := - To_Name (C.Strings.Value (Aliases (Source))); - Source := Source + 1; - Target := Target + 1; + Aliases_Count := 0; + while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Ptr loop + Aliases_Count := Aliases_Count + 1; end loop; - Result.Port := - Port_Type (Network_To_Short (C.unsigned_short (Servent_S_Port (E)))); + return Result : Service_Entry_Type (Aliases_Length => Aliases_Count) do + Result.Official := To_Name (Value (Servent_S_Name (E))); - Result.Protocol := To_Name (Protocol); - return Result; + for J in Result.Aliases'Range loop + Result.Aliases (J) := + To_Name (Value (Servent_S_Alias + (E, C.int (J - Result.Aliases'First)))); + end loop; + + Result.Protocol := To_Name (Value (Servent_S_Proto (E))); + Result.Port := + Port_Type (Network_To_Short (Servent_S_Port (E))); + end return; end To_Service_Entry; --------------- Index: g-sothco.ads =================================================================== --- g-sothco.ads (revision 160705) +++ g-sothco.ads (working copy) @@ -200,18 +200,40 @@ package GNAT.Sockets.Thin_Common is pragma Inline (Set_Address); -- Set Sin.Sin_Addr to Address + ------------------ + -- Host entries -- + ------------------ + + type Hostent is new + System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_hostent); + for Hostent'Alignment use 8; + -- Host entry. This is an opaque type used only via the following + -- accessor functions, because 'struct hostent' has different layouts on + -- different platforms. + + type Hostent_Access is access all Hostent; + pragma Convention (C, Hostent_Access); + -- Access to host entry + + function Hostent_H_Name + (E : Hostent_Access) return C.Strings.chars_ptr; + + function Hostent_H_Alias + (E : Hostent_Access; I : C.int) return C.Strings.chars_ptr; + + function Hostent_H_Addrtype + (E : Hostent_Access) return C.int; + + function Hostent_H_Length + (E : Hostent_Access) return C.int; + + function Hostent_H_Addr + (E : Hostent_Access; Index : C.int) return C.Strings.chars_ptr; + --------------------- -- Service entries -- --------------------- - type Chars_Ptr_Array is array (C.size_t range <>) of - aliased C.Strings.chars_ptr; - - package Chars_Ptr_Pointers is - new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array, - C.Strings.Null_Ptr); - -- Arrays of C (char *) - type Servent is new System.Storage_Elements.Storage_Array (1 .. SOSC.SIZEOF_struct_servent); for Servent'Alignment use 8; @@ -226,48 +248,60 @@ package GNAT.Sockets.Thin_Common is function Servent_S_Name (E : Servent_Access) return C.Strings.chars_ptr; - function Servent_S_Aliases - (E : Servent_Access) return Chars_Ptr_Pointers.Pointer; + function Servent_S_Alias + (E : Servent_Access; Index : C.int) return C.Strings.chars_ptr; function Servent_S_Port - (E : Servent_Access) return C.int; + (E : Servent_Access) return C.unsigned_short; function Servent_S_Proto (E : Servent_Access) return C.Strings.chars_ptr; - procedure Servent_Set_S_Name - (E : Servent_Access; - S_Name : C.Strings.chars_ptr); - - procedure Servent_Set_S_Aliases - (E : Servent_Access; - S_Aliases : Chars_Ptr_Pointers.Pointer); - - procedure Servent_Set_S_Port - (E : Servent_Access; - S_Port : C.int); - - procedure Servent_Set_S_Proto - (E : Servent_Access; - S_Proto : C.Strings.chars_ptr); - ------------------ - -- Host entries -- + -- NetDB access -- ------------------ - type Hostent is record - H_Name : C.Strings.chars_ptr; - H_Aliases : Chars_Ptr_Pointers.Pointer; - H_Addrtype : SOSC.H_Addrtype_T; - H_Length : SOSC.H_Length_T; - H_Addr_List : In_Addr_Access_Pointers.Pointer; - end record; - pragma Convention (C, Hostent); - -- Host entry - - type Hostent_Access is access all Hostent; - pragma Convention (C, Hostent_Access); - -- Access to host entry + -- There are three possible situations for the following NetDB access + -- functions: + -- - inherently thread safe (case of data returned in a thread specific + -- buffer); + -- - thread safe using user-provided buffer; + -- - thread unsafe. + -- + -- In the first and third cases, the Buf and Buflen are ignored. In the + -- second case, the caller must provide a buffer large enough to accomodate + -- the returned data. In the third case, the caller must ensure that these + -- functions are called within a critical section. + + function C_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; + + function C_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; + + function C_Getservbyname + (Name : C.char_array; + Proto : C.char_array; + Ret : not null access Servent; + Buf : System.Address; + Buflen : C.int) return C.int; + + function C_Getservbyport + (Port : C.int; + Proto : C.char_array; + Ret : not null access Servent; + Buf : System.Address; + Buflen : C.int) return C.int; ------------------------------------ -- Scatter/gather vector handling -- @@ -362,12 +396,20 @@ private pragma Import (C, C_Ioctl, "__gnat_socket_ioctl"); pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); - pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); - pragma Import (C, Servent_S_Aliases, "__gnat_servent_s_aliases"); - pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); + pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname"); + pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr"); + pragma Import (C, C_Getservbyname, "__gnat_getservbyname"); + pragma Import (C, C_Getservbyport, "__gnat_getservbyport"); + + pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); + pragma Import (C, Servent_S_Alias, "__gnat_servent_s_alias"); + pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); pragma Import (C, Servent_S_Proto, "__gnat_servent_s_proto"); - pragma Import (C, Servent_Set_S_Name, "__gnat_servent_set_s_name"); - pragma Import (C, Servent_Set_S_Aliases, "__gnat_servent_set_s_aliases"); - pragma Import (C, Servent_Set_S_Port, "__gnat_servent_set_s_port"); - pragma Import (C, Servent_Set_S_Proto, "__gnat_servent_set_s_proto"); + + pragma Import (C, Hostent_H_Name, "__gnat_hostent_h_name"); + pragma Import (C, Hostent_H_Alias, "__gnat_hostent_h_alias"); + pragma Import (C, Hostent_H_Addrtype, "__gnat_hostent_h_addrtype"); + pragma Import (C, Hostent_H_Length, "__gnat_hostent_h_length"); + pragma Import (C, Hostent_H_Addr, "__gnat_hostent_h_addr"); + end GNAT.Sockets.Thin_Common; Index: gcc-interface/Makefile.in =================================================================== --- gcc-interface/Makefile.in (revision 160713) +++ gcc-interface/Makefile.in (working copy) @@ -380,7 +380,7 @@ MLIB_TGT = mlib-tgt # to LIBGNAT_TARGET_PAIRS. GNATRTL_SOCKETS_OBJS = g-soccon$(objext) g-socket$(objext) g-socthi$(objext) \ - g-soliop$(objext) g-sothco$(objext) g-sttsne$(objext) + g-soliop$(objext) g-sothco$(objext) DUMMY_SOCKETS_TARGET_PAIRS = \ g-socket.adb