From patchwork Mon Jun 14 12:40:31 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55524 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 0C4A91007D1 for ; Mon, 14 Jun 2010 22:41:15 +1000 (EST) Received: (qmail 7041 invoked by alias); 14 Jun 2010 12:41:12 -0000 Received: (qmail 6974 invoked by uid 22791); 14 Jun 2010 12:40:53 -0000 X-SWARE-Spam-Status: No, hits=-0.3 required=5.0 tests=AWL, BAYES_50, TW_DR, TW_RV, TW_TD, TW_VB, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 14 Jun 2010 12:40:22 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id B1590290001; Mon, 14 Jun 2010 14:40:24 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id 0VZm3+kPewEN; Mon, 14 Jun 2010 14:40:24 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 94824CB0219; Mon, 14 Jun 2010 14:40:24 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id B8D48D9B31; Mon, 14 Jun 2010 14:40:31 +0200 (CEST) Date: Mon, 14 Jun 2010 14:40:31 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Reorganization of NetDB binding Message-ID: <20100614124031.GA10554@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org This change reorganizes the binding to the network database operations (getXXXbyYYY) to improve its portability, in particular for the VMS platform, where the data structures used by the system's netdb implementation use 32-bit pointers instead of the default 64 bits. Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Thomas Quinot * g-sttsne-locking.adb, g-sttsne-locking.ads, g-sttsne.ads, g-sttsne-vxworks.adb, g-sttsne-dummy.ads: Removed. Mutual exclusion is now done in GNAT.Sockets if necessary. * gsocket.h, g-socket.adb, g-sothco.ads (GNAT.Sockets.Get_XXX_By_YYY): Ensure mutual exclusion for netdb operations if the target platform requires it. (GNAT.Sockets.Thin_Common): New binding for getXXXbyYYY, treating struct hostent as an opaque type to improve portability. * s-oscons-tmplt.c, socket.c: For the case of Vxworks, emulate gethostbyYYY using proprietary VxWorks API so that a uniform interface is available for the Ada side. * gcc-interface/Makefile.in: Remove g-sttsne-* * gcc-interface/Make-lang.in: Update dependencies. 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