===================================================================
@@ -1,460 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-
-with GNAT.Task_Lock;
-
-with Interfaces.C; use Interfaces.C;
-
-package body GNAT.Sockets.Thin.Task_Safe_NetDB is
-
- -- The Safe_GetXXXbyYYY routines wrap the Nonreentrant_ versions using the
- -- task lock, and copy the relevant data structures (under the lock) into
- -- the result. The Nonreentrant_ versions are expected to be in the parent
- -- package GNAT.Sockets.Thin (on platforms that use this version of
- -- Task_Safe_NetDB).
-
- procedure Copy_Host_Entry
- (Source_Hostent : Hostent;
- Target_Hostent : out Hostent;
- Target_Buffer : System.Address;
- Target_Buffer_Length : C.int;
- Result : out C.int);
- -- Copy all the information from Source_Hostent into Target_Hostent,
- -- using Target_Buffer to store associated data.
- -- 0 is returned on success, -1 on failure (in case the provided buffer
- -- is too small for the associated data).
-
- procedure Copy_Service_Entry
- (Source_Servent : Servent_Access;
- Target_Servent : Servent_Access;
- Target_Buffer : System.Address;
- Target_Buffer_Length : C.int;
- Result : out C.int);
- -- Copy all the information from Source_Servent into Target_Servent,
- -- using Target_Buffer to store associated data.
- -- 0 is returned on success, -1 on failure (in case the provided buffer
- -- is too small for the associated data).
-
- procedure Store_Name
- (Name : char_array;
- Storage : in out char_array;
- Storage_Index : in out size_t;
- Stored_Name : out C.Strings.chars_ptr);
- -- Store the given Name at the first available location in Storage
- -- (indicated by Storage_Index, which is updated afterwards), and return
- -- the address of that location in Stored_Name.
- -- (Supporting routine for the two below).
-
- ---------------------
- -- Copy_Host_Entry --
- ---------------------
-
- procedure Copy_Host_Entry
- (Source_Hostent : Hostent;
- Target_Hostent : out Hostent;
- Target_Buffer : System.Address;
- Target_Buffer_Length : C.int;
- Result : out C.int)
- is
- use type C.Strings.chars_ptr;
-
- Names_Length : size_t;
-
- Source_Aliases : Chars_Ptr_Array
- renames Chars_Ptr_Pointers.Value
- (Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
- -- Null-terminated list of aliases (last element of this array is
- -- Null_Ptr).
-
- Source_Addresses : In_Addr_Access_Array
- renames In_Addr_Access_Pointers.Value
- (Source_Hostent.H_Addr_List, Terminator => null);
-
- begin
- Result := -1;
- Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
-
- for J in Source_Aliases'Range loop
- if Source_Aliases (J) /= C.Strings.Null_Ptr then
- Names_Length :=
- Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
- end if;
- end loop;
-
- declare
- type In_Addr_Array is array (Source_Addresses'Range)
- of aliased In_Addr;
-
- type Netdb_Host_Data is record
- Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
- Names : aliased char_array (1 .. Names_Length);
-
- Addresses_List : aliased In_Addr_Access_Array
- (In_Addr_Array'Range);
- Addresses : In_Addr_Array;
- -- ??? This assumes support only for Inet family
-
- end record;
-
- Netdb_Data : Netdb_Host_Data;
- pragma Import (Ada, Netdb_Data);
- for Netdb_Data'Address use Target_Buffer;
-
- Names_Index : size_t := Netdb_Data.Names'First;
- -- Index of first available location in Netdb_Data.Names
-
- begin
- if Netdb_Data'Size / 8 > Target_Buffer_Length then
- return;
- end if;
-
- -- Copy host name
-
- Store_Name
- (C.Strings.Value (Source_Hostent.H_Name),
- Netdb_Data.Names, Names_Index,
- Target_Hostent.H_Name);
-
- -- Copy aliases (null-terminated string pointer array)
-
- Target_Hostent.H_Aliases :=
- Netdb_Data.Aliases_List
- (Netdb_Data.Aliases_List'First)'Unchecked_Access;
- for J in Netdb_Data.Aliases_List'Range loop
- if J = Netdb_Data.Aliases_List'Last then
- Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
- else
- Store_Name
- (C.Strings.Value (Source_Aliases (J)),
- Netdb_Data.Names, Names_Index,
- Netdb_Data.Aliases_List (J));
- end if;
- end loop;
-
- -- Copy address type and length
-
- Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
- Target_Hostent.H_Length := Source_Hostent.H_Length;
-
- -- Copy addresses
-
- Target_Hostent.H_Addr_List :=
- Netdb_Data.Addresses_List
- (Netdb_Data.Addresses_List'First)'Unchecked_Access;
-
- for J in Netdb_Data.Addresses'Range loop
- if J = Netdb_Data.Addresses'Last then
- Netdb_Data.Addresses_List (J) := null;
- else
- Netdb_Data.Addresses_List (J) :=
- Netdb_Data.Addresses (J)'Unchecked_Access;
-
- Netdb_Data.Addresses (J) := Source_Addresses (J).all;
- end if;
- end loop;
- end;
-
- Result := 0;
- end Copy_Host_Entry;
-
- ------------------------
- -- Copy_Service_Entry --
- ------------------------
-
- procedure Copy_Service_Entry
- (Source_Servent : Servent_Access;
- Target_Servent : Servent_Access;
- Target_Buffer : System.Address;
- Target_Buffer_Length : C.int;
- Result : out C.int)
- is
- use type C.Strings.chars_ptr;
-
- Names_Length : size_t;
-
- Source_Aliases : Chars_Ptr_Array
- renames Chars_Ptr_Pointers.Value
- (Servent_S_Aliases (Source_Servent),
- Terminator => C.Strings.Null_Ptr);
- -- Null-terminated list of aliases (last element of this array is
- -- Null_Ptr).
-
- begin
- Result := -1;
- Names_Length := C.Strings.Strlen (Servent_S_Name (Source_Servent)) + 1 +
- C.Strings.Strlen (Servent_S_Proto (Source_Servent)) + 1;
-
- for J in Source_Aliases'Range loop
- if Source_Aliases (J) /= C.Strings.Null_Ptr then
- Names_Length :=
- Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
- end if;
- end loop;
-
- declare
- type Netdb_Service_Data is record
- Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
- Names : aliased char_array (1 .. Names_Length);
- end record;
-
- Netdb_Data : Netdb_Service_Data;
- pragma Import (Ada, Netdb_Data);
- for Netdb_Data'Address use Target_Buffer;
-
- Names_Index : size_t := Netdb_Data.Names'First;
- -- Index of first available location in Netdb_Data.Names
-
- Stored_Name : C.Strings.chars_ptr;
-
- begin
- if Netdb_Data'Size / 8 > Target_Buffer_Length then
- return;
- end if;
-
- -- Copy service name
-
- Store_Name
- (C.Strings.Value (Servent_S_Name (Source_Servent)),
- Netdb_Data.Names, Names_Index,
- Stored_Name);
- Servent_Set_S_Name (Target_Servent, Stored_Name);
-
- -- Copy aliases (null-terminated string pointer array)
-
- Servent_Set_S_Aliases
- (Target_Servent,
- Netdb_Data.Aliases_List
- (Netdb_Data.Aliases_List'First)'Unchecked_Access);
-
- -- Copy port number
-
- Servent_Set_S_Port (Target_Servent, Servent_S_Port (Source_Servent));
-
- -- Copy protocol name
-
- Store_Name
- (C.Strings.Value (Servent_S_Proto (Source_Servent)),
- Netdb_Data.Names, Names_Index,
- Stored_Name);
- Servent_Set_S_Proto (Target_Servent, Stored_Name);
-
- for J in Netdb_Data.Aliases_List'Range loop
- if J = Netdb_Data.Aliases_List'Last then
- Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
- else
- Store_Name
- (C.Strings.Value (Source_Aliases (J)),
- Netdb_Data.Names, Names_Index,
- Netdb_Data.Aliases_List (J));
- end if;
- end loop;
- end;
-
- Result := 0;
- end Copy_Service_Entry;
-
- ------------------------
- -- Safe_Gethostbyaddr --
- ------------------------
-
- function Safe_Gethostbyaddr
- (Addr : System.Address;
- Addr_Len : C.int;
- Addr_Type : C.int;
- Ret : not null access Hostent;
- Buf : System.Address;
- Buflen : C.int;
- H_Errnop : not null access C.int) return C.int
- is
- HE : Hostent_Access;
- Result : C.int;
- begin
- Result := -1;
- GNAT.Task_Lock.Lock;
- HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
-
- if HE = null then
- H_Errnop.all := C.int (Host_Errno);
- goto Unlock_Return;
- end if;
-
- -- Now copy the data to the user-provided buffer
-
- Copy_Host_Entry
- (Source_Hostent => HE.all,
- Target_Hostent => Ret.all,
- Target_Buffer => Buf,
- Target_Buffer_Length => Buflen,
- Result => Result);
-
- <<Unlock_Return>>
- GNAT.Task_Lock.Unlock;
- return Result;
- end Safe_Gethostbyaddr;
-
- ------------------------
- -- Safe_Gethostbyname --
- ------------------------
-
- function Safe_Gethostbyname
- (Name : C.char_array;
- Ret : not null access Hostent;
- Buf : System.Address;
- Buflen : C.int;
- H_Errnop : not null access C.int) return C.int
- is
- HE : Hostent_Access;
- Result : C.int;
- begin
- Result := -1;
- GNAT.Task_Lock.Lock;
- HE := Nonreentrant_Gethostbyname (Name);
-
- if HE = null then
- H_Errnop.all := C.int (Host_Errno);
- goto Unlock_Return;
- end if;
-
- -- Now copy the data to the user-provided buffer
-
- Copy_Host_Entry
- (Source_Hostent => HE.all,
- Target_Hostent => Ret.all,
- Target_Buffer => Buf,
- Target_Buffer_Length => Buflen,
- Result => Result);
-
- <<Unlock_Return>>
- GNAT.Task_Lock.Unlock;
- return Result;
- end Safe_Gethostbyname;
-
- ------------------------
- -- Safe_Getservbyname --
- ------------------------
-
- function Safe_Getservbyname
- (Name : C.char_array;
- Proto : C.char_array;
- Ret : not null access Servent;
- Buf : System.Address;
- Buflen : C.int) return C.int
- is
- SE : Servent_Access;
- Result : C.int;
- begin
- Result := -1;
- GNAT.Task_Lock.Lock;
- SE := Nonreentrant_Getservbyname (Name, Proto);
-
- if SE = null then
- goto Unlock_Return;
- end if;
-
- -- Now copy the data to the user-provided buffer. We convert Ret to
- -- type Servent_Access using the .all'Unchecked_Access trick to avoid
- -- an accessibility check. Ret could be pointing to a nested variable,
- -- and we don't want to raise an exception in that case.
-
- Copy_Service_Entry
- (Source_Servent => SE,
- Target_Servent => Ret.all'Unchecked_Access,
- Target_Buffer => Buf,
- Target_Buffer_Length => Buflen,
- Result => Result);
-
- <<Unlock_Return>>
- GNAT.Task_Lock.Unlock;
- return Result;
- end Safe_Getservbyname;
-
- ------------------------
- -- Safe_Getservbyport --
- ------------------------
-
- function Safe_Getservbyport
- (Port : C.int;
- Proto : C.char_array;
- Ret : not null access Servent;
- Buf : System.Address;
- Buflen : C.int) return C.int
- is
- SE : Servent_Access;
- Result : C.int;
-
- begin
- Result := -1;
- GNAT.Task_Lock.Lock;
- SE := Nonreentrant_Getservbyport (Port, Proto);
-
- if SE = null then
- goto Unlock_Return;
- end if;
-
- -- Now copy the data to the user-provided buffer. See Safe_Getservbyname
- -- for comment regarding .all'Unchecked_Access.
-
- Copy_Service_Entry
- (Source_Servent => SE,
- Target_Servent => Ret.all'Unchecked_Access,
- Target_Buffer => Buf,
- Target_Buffer_Length => Buflen,
- Result => Result);
-
- <<Unlock_Return>>
- GNAT.Task_Lock.Unlock;
- return Result;
- end Safe_Getservbyport;
-
- ----------------
- -- Store_Name --
- ----------------
-
- procedure Store_Name
- (Name : char_array;
- Storage : in out char_array;
- Storage_Index : in out size_t;
- Stored_Name : out C.Strings.chars_ptr)
- is
- First : constant C.size_t := Storage_Index;
- Last : constant C.size_t := Storage_Index + Name'Length - 1;
- begin
- Storage (First .. Last) := Name;
- Stored_Name := C.Strings.To_Chars_Ptr
- (Storage (First .. Last)'Unrestricted_Access);
- Storage_Index := Last + 1;
- end Store_Name;
-
-end GNAT.Sockets.Thin.Task_Safe_NetDB;
===================================================================
@@ -1,75 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-
-
-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;
===================================================================
@@ -1,83 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-
-
-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;
===================================================================
@@ -1,204 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-
-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;
===================================================================
@@ -1,39 +0,0 @@
-------------------------------------------------------------------------------
-------------------------------------------------------------------------------
-
-
-package GNAT.Sockets.Thin.Task_Safe_NetDB is
- pragma Unimplemented_Unit;
-end GNAT.Sockets.Thin.Task_Safe_NetDB;
===================================================================
@@ -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) */
===================================================================
@@ -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")
/**
===================================================================
@@ -194,34 +194,37 @@
#include <netdb.h>
#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__)
===================================================================
@@ -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;
---------------
===================================================================
@@ -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;
===================================================================
@@ -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<g-socket-dummy.adb \
@@ -388,8 +388,7 @@ DUMMY_SOCKETS_TARGET_PAIRS = \
g-socthi.adb<g-socthi-dummy.adb \
g-socthi.ads<g-socthi-dummy.ads \
g-sothco.adb<g-sothco-dummy.adb \
- g-sothco.ads<g-sothco-dummy.ads \
- g-sttsne.ads<g-sttsne-dummy.ads
+ g-sothco.ads<g-sothco-dummy.ads
# On platform where atomic increment/decrement operations are supported
# special version of Ada.Strings.Unbounded package can be used.
@@ -440,8 +439,6 @@ ifeq ($(strip $(filter-out m68k% wrs vx%
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-m68k.ads
@@ -485,8 +482,6 @@ ifeq ($(strip $(filter-out powerpc% wrs
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
$(ATOMICS_TARGET_PAIRS)
@@ -606,9 +601,7 @@ ifeq ($(strip $(filter-out powerpc% wrs
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
- g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads
+ g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
@@ -724,9 +717,7 @@ ifeq ($(strip $(filter-out %86 wrs vxwor
LIBGNAT_TARGET_PAIRS += \
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
- g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads
+ g-stsifd.adb<g-stsifd-sockets.adb
endif
ifeq ($(strip $(filter-out yes,$(TRACE))),)
@@ -762,8 +753,6 @@ ifeq ($(strip $(filter-out sparc% wrs vx
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-sparcv9.ads \
@@ -803,8 +792,6 @@ ifeq ($(strip $(filter-out %86 wrs vxwor
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb
@@ -896,8 +883,6 @@ ifeq ($(strip $(filter-out arm% coff wrs
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-arm.ads
@@ -936,8 +921,6 @@ ifeq ($(strip $(filter-out mips% wrs vx%
g-socthi.ads<g-socthi-vxworks.ads \
g-socthi.adb<g-socthi-vxworks.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-vxworks.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
g-trasym.ads<g-trasym-unimplemented.ads \
g-trasym.adb<g-trasym-unimplemented.adb \
system.ads<system-vxworks-mips.ads
@@ -1398,8 +1381,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys
a-numaux.ads<a-numaux-x86.ads \
a-intnam.ads<a-intnam-lynxos.ads \
g-bytswa.adb<g-bytswa-x86.adb \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
@@ -1416,8 +1397,6 @@ ifeq ($(strip $(filter-out lynxos,$(osys
else
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-lynxos.ads \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
s-inmaop.adb<s-inmaop-posix.adb \
s-intman.adb<s-intman-posix.adb \
s-osinte.adb<s-osinte-lynxos.adb \
@@ -1543,8 +1522,6 @@ ifeq ($(strip $(filter-out alpha64 ia64
g-socthi.ads<g-socthi-vms.ads \
g-socthi.adb<g-socthi-vms.adb \
g-stsifd.adb<g-stsifd-sockets.adb \
- g-sttsne.adb<g-sttsne-locking.adb \
- g-sttsne.ads<g-sttsne-locking.ads \
i-c.ads<i-c-vms_64.ads \
i-cstrin.ads<i-cstrin-vms_64.ads \
i-cstrin.adb<i-cstrin-vms_64.adb \
===================================================================
@@ -3385,18 +3385,19 @@ ada/sem_ch12.o : ada/ada.ads ada/a-excep
ada/sem_elab.ads ada/sem_elim.ads ada/sem_eval.ads ada/sem_res.ads \
ada/sem_scil.ads ada/sem_type.ads ada/sem_util.ads ada/sem_util.adb \
ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb ada/sinfo-cn.ads \
- ada/sinput.ads ada/sinput-l.ads ada/snames.ads ada/stand.ads \
- ada/stringt.ads ada/style.ads ada/styleg.ads ada/styleg.adb \
- ada/stylesw.ads ada/system.ads ada/s-crc32.ads ada/s-exctab.ads \
- ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb ada/s-imenne.ads \
- ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
- ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
- ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads ada/s-string.ads \
- ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads ada/s-wchcon.ads \
- ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
- ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
- ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
- ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/widechar.ads
+ ada/sinput.ads ada/sinput.adb ada/sinput-l.ads ada/snames.ads \
+ ada/stand.ads ada/stringt.ads ada/style.ads ada/styleg.ads \
+ ada/styleg.adb ada/stylesw.ads ada/system.ads ada/s-crc32.ads \
+ ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-htable.adb \
+ ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
+ ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
+ ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-strhas.ads \
+ ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-utf_32.ads \
+ ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
+ ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
+ ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
+ ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
+ ada/widechar.ads
ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \