Commit 759f1648 by Dmitriy Anisimkov Committed by Pierre-Marie de Rodat

[Ada] GNAT.Sockets: add IPv6 support

2018-12-11  Dmitriy Anisimkov  <anisimko@adacore.com>

gcc/ada/

	* libgnat/g-socket.ads (Family_Type): Add new enumerated value
	Family_Unspec to be able to use it in Get_Address_Info parameter
	and find IPv4 together with IPv6 addresses.
	(Inet_Addr_Bytes_Length): Zero length for Family_Unspec.  New
	IPv6 predefined constant addresses.
	(IPv4_To_IPv6_Prefix): IPv4 mapped to IPv6 address prefix.
	(Is_IPv4_Address): Rename from Is_IP_Address and published.
	(Is_IPv6_Address): New routine.
	(Image of Inet_Addr_Type): Fix description about IPv6 address
	text representation.
	(Level_Type): New propocol level IP_Protocol_For_IPv6_Level.
	(Add_Membership_V4): New socket option equal to Add_Membership.
	(Drop_Membership_V4): New socket option equal to
	Drop_Membership.
	(Multicast_If_V4): New socket option equal to Multicast_If.
	(Multicast_Loop_V4, Add_Membership_V6, Drop_Membership_V6,
	Multicast_If_V6, Multicast_Loop_V6, Multicast_Hops, IPv6_Only):
	New socket option for IPv6.
	(Address_Info): New record to keep address info.
	(Address_Info_Array): Array to keep address info records.
	(Get_Address_Info): Routine to get address info records by host
	and service names.
	(Host_Service): Record to keep host and service names.
	(Get_Name_Info): New routine to get host and service names by
	address.
	(Create_Socket): Add Level parameter, IP_Protocol_For_IP_Level
	default.
	(Name_Array, Inet_Addr_Array): Change array index to Positive.
	* libgnat/g-socket.adb (IPV6_Mreq): New record definition for
	IPv6.
	(Hex_To_Char): Remove.
	(Short_To_Network, Network_To_Short): Move to package
	GNAT.Sockets.Thin_Common.
	(Is_IP_Address): Remove.
	(To_In_Addr, To_Inet_Addr): Move to package
	GNAT.Sockets.Thin_Common.
	(Get_Socket_Option): Get value of Multicast_Loop option as
	integer boolean, process IPv6 options. Don't try to get
	Add_Membership_V4, Add_Membership_V6, Drop_Membership_V4, and
	Drop_Membership_V6 as not supported by the socket API.
	(Set_Socket_Option): Set value of Multicast_Loop option as
	integer boolean, process IPv6 options.
	* gsocket.h
	(IPV6_ADD_MEMBERSHIP): Define from IPV6_JOIN_GROUP if necessary
	for VxWorks.
	(IPV6_DROP_MEMBERSHIP): Define from IPV6_LEAVE_GROUP if
	necessary for VxWorks
	(HAVE_INET_NTOP): New definition.
	(HAVE_INET_PTON): Includes VxWorks now.
	* socket.c (__gnat_getaddrinfo, __gnat_getnameinfo,
	__gnat_freeaddrinfo, __gnat_gai_strerror, __gnat_inet_ntop): New
	routines.
	* libgnat/g-sothco.ads, libgnat/g-sothco.adb
	(socklen_t, In6_Addr, To_In6_Addr): New.
	(To_In_Addr, To_Inet_Addr): Move from package body GNAT.Sockets.
	(To_Inet_Addr): New overload with In6_Addr type parmeter.
	(In_Addr_Access_Array): Remove.
	(Sockaddr): Unchecked_Union instead of Sockaddr_In and old
	defined generic Sockaddr.
	(Set_Address): Use it to set family, port and address into
	Sockaddr.
	(Get_Address): New routine to get Socket_Addr_Type from
	Sockaddr.
	(Addrinfo): Structure to use with getaddrinfo.
	(C_Getaddrinfo, C_Freeaddrinfo, C_Getnameinfo, C_GAI_Strerror,
	Inet_Ntop): New routine import.
	(Short_To_Network, Network_To_Short): Move from package body
	GNAT.Sockets.
	* libgnat/g-stsifd__sockets.adb: Use Sockaddr instead of
	Sockaddr_In.
	* s-oscons-tmplt.c (AF_UNSPEC, EAI_SYSTEM, SOCK_RAW,
	IPPROTO_IPV6, IP_RECVERR, SIZEOF_socklen_t, IF_NAMESIZE): New
	constants.
	(AI_xxxx_OFFSET): Constants to consider platform differences in
	field positions and sizes for addrinfo structure.
	(AI_xxxxx): Flags for getaddrinfo.
	(NI_xxxxx): Flags for getnameinfo.
	(IPV6_xxxxx): Socket options for IPv6.
	(Inet_Ntop_Linkname): New routine.

From-SVN: r267016
parent d71b0a9a
2018-12-11 Dmitriy Anisimkov <anisimko@adacore.com>
* libgnat/g-socket.ads (Family_Type): Add new enumerated value
Family_Unspec to be able to use it in Get_Address_Info parameter
and find IPv4 together with IPv6 addresses.
(Inet_Addr_Bytes_Length): Zero length for Family_Unspec. New
IPv6 predefined constant addresses.
(IPv4_To_IPv6_Prefix): IPv4 mapped to IPv6 address prefix.
(Is_IPv4_Address): Rename from Is_IP_Address and published.
(Is_IPv6_Address): New routine.
(Image of Inet_Addr_Type): Fix description about IPv6 address
text representation.
(Level_Type): New propocol level IP_Protocol_For_IPv6_Level.
(Add_Membership_V4): New socket option equal to Add_Membership.
(Drop_Membership_V4): New socket option equal to
Drop_Membership.
(Multicast_If_V4): New socket option equal to Multicast_If.
(Multicast_Loop_V4, Add_Membership_V6, Drop_Membership_V6,
Multicast_If_V6, Multicast_Loop_V6, Multicast_Hops, IPv6_Only):
New socket option for IPv6.
(Address_Info): New record to keep address info.
(Address_Info_Array): Array to keep address info records.
(Get_Address_Info): Routine to get address info records by host
and service names.
(Host_Service): Record to keep host and service names.
(Get_Name_Info): New routine to get host and service names by
address.
(Create_Socket): Add Level parameter, IP_Protocol_For_IP_Level
default.
(Name_Array, Inet_Addr_Array): Change array index to Positive.
* libgnat/g-socket.adb (IPV6_Mreq): New record definition for
IPv6.
(Hex_To_Char): Remove.
(Short_To_Network, Network_To_Short): Move to package
GNAT.Sockets.Thin_Common.
(Is_IP_Address): Remove.
(To_In_Addr, To_Inet_Addr): Move to package
GNAT.Sockets.Thin_Common.
(Get_Socket_Option): Get value of Multicast_Loop option as
integer boolean, process IPv6 options. Don't try to get
Add_Membership_V4, Add_Membership_V6, Drop_Membership_V4, and
Drop_Membership_V6 as not supported by the socket API.
(Set_Socket_Option): Set value of Multicast_Loop option as
integer boolean, process IPv6 options.
* gsocket.h
(IPV6_ADD_MEMBERSHIP): Define from IPV6_JOIN_GROUP if necessary
for VxWorks.
(IPV6_DROP_MEMBERSHIP): Define from IPV6_LEAVE_GROUP if
necessary for VxWorks
(HAVE_INET_NTOP): New definition.
(HAVE_INET_PTON): Includes VxWorks now.
* socket.c (__gnat_getaddrinfo, __gnat_getnameinfo,
__gnat_freeaddrinfo, __gnat_gai_strerror, __gnat_inet_ntop): New
routines.
* libgnat/g-sothco.ads, libgnat/g-sothco.adb
(socklen_t, In6_Addr, To_In6_Addr): New.
(To_In_Addr, To_Inet_Addr): Move from package body GNAT.Sockets.
(To_Inet_Addr): New overload with In6_Addr type parmeter.
(In_Addr_Access_Array): Remove.
(Sockaddr): Unchecked_Union instead of Sockaddr_In and old
defined generic Sockaddr.
(Set_Address): Use it to set family, port and address into
Sockaddr.
(Get_Address): New routine to get Socket_Addr_Type from
Sockaddr.
(Addrinfo): Structure to use with getaddrinfo.
(C_Getaddrinfo, C_Freeaddrinfo, C_Getnameinfo, C_GAI_Strerror,
Inet_Ntop): New routine import.
(Short_To_Network, Network_To_Short): Move from package body
GNAT.Sockets.
* libgnat/g-stsifd__sockets.adb: Use Sockaddr instead of
Sockaddr_In.
* s-oscons-tmplt.c (AF_UNSPEC, EAI_SYSTEM, SOCK_RAW,
IPPROTO_IPV6, IP_RECVERR, SIZEOF_socklen_t, IF_NAMESIZE): New
constants.
(AI_xxxx_OFFSET): Constants to consider platform differences in
field positions and sizes for addrinfo structure.
(AI_xxxxx): Flags for getaddrinfo.
(NI_xxxxx): Flags for getnameinfo.
(IPV6_xxxxx): Socket options for IPv6.
(Inet_Ntop_Linkname): New routine.
2018-12-11 Yannick Moy <moy@adacore.com> 2018-12-11 Yannick Moy <moy@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Deactivate * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Deactivate
......
...@@ -63,10 +63,19 @@ ...@@ -63,10 +63,19 @@
#include <vxWorks.h> #include <vxWorks.h>
#include <ioLib.h> #include <ioLib.h>
#include <hostLib.h> #include <hostLib.h>
#define SHUT_RD 0 #define SHUT_RD 0
#define SHUT_WR 1 #define SHUT_WR 1
#define SHUT_RDWR 2 #define SHUT_RDWR 2
#ifndef IPV6_ADD_MEMBERSHIP
#define IPV6_ADD_MEMBERSHIP IPV6_JOIN_GROUP
#endif
#ifndef IPV6_DROP_MEMBERSHIP
#define IPV6_DROP_MEMBERSHIP IPV6_LEAVE_GROUP
#endif
#elif defined (WINNT) #elif defined (WINNT)
#define FD_SETSIZE 1024 #define FD_SETSIZE 1024
...@@ -250,8 +259,9 @@ ...@@ -250,8 +259,9 @@
# define Has_Sockaddr_Len 0 # define Has_Sockaddr_Len 0
#endif #endif
#if !(defined (__vxworks) || defined (_WIN32) || defined (__hpux__) || defined (VMS)) #if !(defined (_WIN32) || defined (__hpux__) || defined (VMS))
# define HAVE_INET_PTON # define HAVE_INET_PTON
# define HAVE_INET_NTOP
#endif #endif
#endif /* defined(VTHREADS) */ #endif /* defined(VTHREADS) */
...@@ -36,13 +36,52 @@ package body GNAT.Sockets.Thin_Common is ...@@ -36,13 +36,52 @@ package body GNAT.Sockets.Thin_Common is
----------------- -----------------
procedure Set_Address procedure Set_Address
(Sin : Sockaddr_In_Access; (Sin : Sockaddr_Access;
Address : In_Addr) Address : Sock_Addr_Type)
is is
begin begin
Sin.Sin_Addr := Address; Set_Family (Sin.Sin_Family, Address.Family);
Sin.Sin_Port := Short_To_Network (C.unsigned_short (Address.Port));
case Address.Family is
when Family_Inet =>
Sin.Sin_Addr := To_In_Addr (Address.Addr);
when Family_Inet6 =>
Sin.Sin6_Addr := To_In6_Addr (Address.Addr);
Sin.Sin6_Scope_Id := 0;
when Family_Unspec =>
null;
end case;
end Set_Address; end Set_Address;
-----------------
-- Get_Address --
-----------------
function Get_Address (Sin : Sockaddr) return Sock_Addr_Type is
Family : constant C.unsigned_short :=
(if SOSC.Has_Sockaddr_Len = 0 then Sin.Sin_Family.Short_Family
else C.unsigned_short (Sin.Sin_Family.Char_Family));
Result : Sock_Addr_Type
(case Family is
when SOSC.AF_INET6 => Family_Inet6,
when SOSC.AF_INET => Family_Inet,
when others => Family_Unspec);
begin
Result.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
case Result.Family is
when Family_Inet =>
To_Inet_Addr (Sin.Sin_Addr, Result.Addr);
when Family_Inet6 =>
To_Inet_Addr (Sin.Sin6_Addr, Result.Addr);
when Family_Unspec =>
Result.Addr := (Family => Family_Unspec);
end case;
return Result;
end Get_Address;
---------------- ----------------
-- Set_Family -- -- Set_Family --
---------------- ----------------
...@@ -62,16 +101,88 @@ package body GNAT.Sockets.Thin_Common is ...@@ -62,16 +101,88 @@ package body GNAT.Sockets.Thin_Common is
end if; end if;
end Set_Family; end Set_Family;
-------------- ----------------
-- Set_Port -- -- To_In_Addr --
-------------- ----------------
function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is
begin
if Addr.Family = Family_Inet then
return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)),
S_B2 => C.unsigned_char (Addr.Sin_V4 (2)),
S_B3 => C.unsigned_char (Addr.Sin_V4 (3)),
S_B4 => C.unsigned_char (Addr.Sin_V4 (4)));
end if;
raise Socket_Error with "IPv6 not supported";
end To_In_Addr;
------------------
-- To_Inet_Addr --
------------------
procedure To_Inet_Addr
(Addr : In_Addr;
Result : out Inet_Addr_Type) is
begin
Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
end To_Inet_Addr;
------------------
-- To_Inet_Addr --
------------------
procedure Set_Port procedure To_Inet_Addr
(Sin : Sockaddr_In_Access; (Addr : In6_Addr;
Port : C.unsigned_short) Result : out Inet_Addr_Type)
is is
Sin_V6 : Inet_Addr_V6_Type;
begin begin
Sin.Sin_Port := Port; for J in Addr'Range loop
end Set_Port; Sin_V6 (J) := Inet_Addr_Comp_Type (Addr (J));
end loop;
Result := (Family => Family_Inet6, Sin_V6 => Sin_V6);
end To_Inet_Addr;
----------------
-- To_In_Addr --
----------------
function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr is
Result : In6_Addr;
begin
for J in Addr.Sin_V6'Range loop
Result (J) := C.unsigned_char (Addr.Sin_V6 (J));
end loop;
return Result;
end To_In6_Addr;
----------------------
-- Short_To_Network --
----------------------
function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
use Interfaces;
use System;
begin
-- Big-endian case. No conversion needed. On these platforms, htons()
-- defaults to a null procedure.
if Default_Bit_Order = High_Order_First then
return S;
-- Little-endian case. We must swap the high and low bytes of this
-- short to make the port number network compliant.
else
return C.unsigned_short (Rotate_Left (Unsigned_16 (S), 8));
end if;
end Short_To_Network;
end GNAT.Sockets.Thin_Common; end GNAT.Sockets.Thin_Common;
...@@ -33,13 +33,12 @@ ...@@ -33,13 +33,12 @@
-- This package should not be directly with'ed by an applications program. -- This package should not be directly with'ed by an applications program.
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
with Interfaces.C.Strings;
with Interfaces.C;
with Interfaces.C.Pointers;
package GNAT.Sockets.Thin_Common is package GNAT.Sockets.Thin_Common is
package C renames Interfaces.C; package C renames Interfaces.C;
package CS renames C.Strings;
Success : constant C.int := 0; Success : constant C.int := 0;
Failure : constant C.int := -1; Failure : constant C.int := -1;
...@@ -65,6 +64,9 @@ package GNAT.Sockets.Thin_Common is ...@@ -65,6 +64,9 @@ package GNAT.Sockets.Thin_Common is
type Timeval_Access is access all Timeval; type Timeval_Access is access all Timeval;
pragma Convention (C, Timeval_Access); pragma Convention (C, Timeval_Access);
type socklen_t is mod 2 ** (8 * SOSC.SIZEOF_socklen_t);
for socklen_t'Size use (8 * SOSC.SIZEOF_socklen_t);
Immediat : constant Timeval := (0, 0); Immediat : constant Timeval := (0, 0);
------------------------------------------- -------------------------------------------
...@@ -72,12 +74,14 @@ package GNAT.Sockets.Thin_Common is ...@@ -72,12 +74,14 @@ package GNAT.Sockets.Thin_Common is
------------------------------------------- -------------------------------------------
Families : constant array (Family_Type) of C.int := Families : constant array (Family_Type) of C.int :=
(Family_Inet => SOSC.AF_INET, (Family_Unspec => SOSC.AF_UNSPEC,
Family_Inet6 => SOSC.AF_INET6); Family_Inet => SOSC.AF_INET,
Family_Inet6 => SOSC.AF_INET6);
Lengths : constant array (Family_Type) of C.unsigned_char := Lengths : constant array (Family_Type) of C.unsigned_char :=
(Family_Inet => SOSC.SIZEOF_sockaddr_in, (Family_Unspec => 0,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6); Family_Inet => SOSC.SIZEOF_sockaddr_in,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6);
---------------------------- ----------------------------
-- Generic socket address -- -- Generic socket address --
...@@ -112,22 +116,6 @@ package GNAT.Sockets.Thin_Common is ...@@ -112,22 +116,6 @@ package GNAT.Sockets.Thin_Common is
-- Set the family component to the appropriate value for Family, and also -- Set the family component to the appropriate value for Family, and also
-- set Length accordingly if applicable on this platform. -- set Length accordingly if applicable on this platform.
type Sockaddr is record
Sa_Family : Sockaddr_Length_And_Family;
-- Address family (and address length on some platforms)
Sa_Data : C.char_array (1 .. 14) := (others => C.nul);
-- Family-specific data
-- Note that some platforms require that all unused (reserved) bytes
-- in addresses be initialized to 0 (e.g. VxWorks).
end record;
pragma Convention (C, Sockaddr);
-- Generic socket address
type Sockaddr_Access is access all Sockaddr;
pragma Convention (C, Sockaddr_Access);
-- Access to socket address
---------------------------- ----------------------------
-- AF_INET socket address -- -- AF_INET socket address --
---------------------------- ----------------------------
...@@ -144,55 +132,64 @@ package GNAT.Sockets.Thin_Common is ...@@ -144,55 +132,64 @@ package GNAT.Sockets.Thin_Common is
function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr); function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int); function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int);
type In_Addr_Access is access all In_Addr; function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr;
pragma Convention (C, In_Addr_Access); procedure To_Inet_Addr
-- Access to internet address (Addr : In_Addr;
Result : out Inet_Addr_Type);
Inaddr_Any : aliased constant In_Addr := (others => 0); -- Conversion functions
-- Any internet address (all the interfaces)
type In_Addr_Access_Array is array (C.size_t range <>) type In6_Addr is array (1 .. 16) of C.unsigned_char;
of aliased In_Addr_Access; for In6_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In_Addr_Access_Array); pragma Convention (C, In6_Addr);
package In_Addr_Access_Pointers is new C.Pointers function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr;
(C.size_t, In_Addr_Access, In_Addr_Access_Array, null); procedure To_Inet_Addr
-- Array of internet addresses (Addr : In6_Addr;
Result : out Inet_Addr_Type);
-- Conversion functions
type Sockaddr_In is record type Sockaddr (Family : Family_Type := Family_Inet) is record
Sin_Family : Sockaddr_Length_And_Family; Sin_Family : Sockaddr_Length_And_Family;
-- Address family (and address length on some platforms) -- Address family (and address length on some platforms)
Sin_Port : C.unsigned_short; Sin_Port : C.unsigned_short;
-- Port in network byte order -- Port in network byte order
Sin_Addr : In_Addr; case Family is
-- IPv4 address when Family_Inet =>
Sin_Addr : In_Addr := (others => 0);
Sin_Zero : C.char_array (1 .. 8) := (others => C.nul); -- IPv4 address
-- Padding
-- Sin_Zero : C.char_array (1 .. 8) := (others => C.nul);
-- Note that some platforms require that all unused (reserved) bytes -- Padding
-- in addresses be initialized to 0 (e.g. VxWorks). --
-- Note that some platforms require that all unused (reserved) bytes
-- in addresses be initialized to 0 (e.g. VxWorks).
when Family_Inet6 =>
Sin6_FlowInfo : Interfaces.Unsigned_32 := 0;
Sin6_Addr : In6_Addr := (others => 0);
Sin6_Scope_Id : Interfaces.Unsigned_32 := 0;
when Family_Unspec =>
null;
end case;
end record; end record;
pragma Convention (C, Sockaddr_In); pragma Unchecked_Union (Sockaddr);
pragma Convention (C, Sockaddr);
-- Internet socket address -- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In; type Sockaddr_Access is access all Sockaddr;
pragma Convention (C, Sockaddr_In_Access); pragma Convention (C, Sockaddr_Access);
-- Access to internet socket address -- Access to internet socket address
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short);
pragma Inline (Set_Port);
-- Set Sin.Sin_Port to Port
procedure Set_Address procedure Set_Address
(Sin : Sockaddr_In_Access; (Sin : Sockaddr_Access;
Address : In_Addr); Address : Sock_Addr_Type);
pragma Inline (Set_Address); -- Initialise all necessary fields in Sin from Address.
-- Set Sin.Sin_Addr to Address -- Set appropriate Family, Port, and either Sin.Sin_Addr or Sin.Sin6_Addr
-- depend on family.
function Get_Address (Sin : Sockaddr) return Sock_Addr_Type;
-- Get Sock_Addr_Type from Sockaddr
------------------ ------------------
-- Host entries -- -- Host entries --
...@@ -297,6 +294,51 @@ package GNAT.Sockets.Thin_Common is ...@@ -297,6 +294,51 @@ package GNAT.Sockets.Thin_Common is
Buf : System.Address; Buf : System.Address;
Buflen : C.int) return C.int; Buflen : C.int) return C.int;
Address_Size : constant := Standard'Address_Size;
type Addrinfo;
type Addrinfo_Access is access all Addrinfo;
type Addrinfo is record
ai_flags : C.int;
ai_family : C.int;
ai_socktype : C.int;
ai_protocol : C.int;
ai_addrlen : socklen_t;
ai_addr : Sockaddr_Access;
ai_canonname : CS.char_array_access;
ai_next : Addrinfo_Access;
end record with Convention => C;
for Addrinfo use record
ai_flags at SOSC.AI_FLAGS_OFFSET range 0 .. C.int'Size - 1;
ai_family at SOSC.AI_FAMILY_OFFSET range 0 .. C.int'Size - 1;
ai_socktype at SOSC.AI_SOCKTYPE_OFFSET range 0 .. C.int'Size - 1;
ai_protocol at SOSC.AI_PROTOCOL_OFFSET range 0 .. C.int'Size - 1;
ai_addrlen at SOSC.AI_ADDRLEN_OFFSET range 0 .. socklen_t'Size - 1;
ai_canonname at SOSC.AI_CANONNAME_OFFSET range 0 .. Address_Size - 1;
ai_addr at SOSC.AI_ADDR_OFFSET range 0 .. Address_Size - 1;
ai_next at SOSC.AI_NEXT_OFFSET range 0 .. Address_Size - 1;
end record;
function C_Getaddrinfo
(Node : CS.char_array_access;
Service : CS.char_array_access;
Hints : access constant Addrinfo;
Res : not null access Addrinfo_Access) return C.int;
procedure C_Freeaddrinfo (res : Addrinfo_Access);
function C_Getnameinfo
(sa : Sockaddr_Access;
salen : socklen_t;
host : CS.char_array_access;
hostlen : C.size_t;
serv : CS.char_array_access;
servlen : C.size_t;
flags : C.int) return C.int;
function C_GAI_Strerror (ecode : C.int) return CS.chars_ptr;
------------------------------------ ------------------------------------
-- Scatter/gather vector handling -- -- Scatter/gather vector handling --
------------------------------------ ------------------------------------
...@@ -375,11 +417,27 @@ package GNAT.Sockets.Thin_Common is ...@@ -375,11 +417,27 @@ package GNAT.Sockets.Thin_Common is
Cp : System.Address; Cp : System.Address;
Inp : System.Address) return C.int; Inp : System.Address) return C.int;
function Inet_Ntop
(Af : C.int;
Src : System.Address;
Dst : CS.char_array_access;
Size : socklen_t) return CS.char_array_access;
function C_Ioctl function C_Ioctl
(Fd : C.int; (Fd : C.int;
Req : SOSC.IOCTL_Req_T; Req : SOSC.IOCTL_Req_T;
Arg : access C.int) return C.int; Arg : access C.int) return C.int;
function Short_To_Network
(S : C.unsigned_short) return C.unsigned_short;
pragma Inline (Short_To_Network);
-- Convert a port number into a network port number
function Network_To_Short
(S : C.unsigned_short) return C.unsigned_short
renames Short_To_Network;
-- Symmetric operation
private private
pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set"); pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set");
pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set"); pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set");
...@@ -389,12 +447,18 @@ private ...@@ -389,12 +447,18 @@ private
pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set"); pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set");
pragma Import (C, C_Ioctl, "__gnat_socket_ioctl"); pragma Import (C, C_Ioctl, "__gnat_socket_ioctl");
pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname); pragma Import (C, Inet_Pton, SOSC.Inet_Pton_Linkname);
pragma Import (C, Inet_Ntop, SOSC.Inet_Ntop_Linkname);
pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname"); pragma Import (C, C_Gethostbyname, "__gnat_gethostbyname");
pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr"); pragma Import (C, C_Gethostbyaddr, "__gnat_gethostbyaddr");
pragma Import (C, C_Getservbyname, "__gnat_getservbyname"); pragma Import (C, C_Getservbyname, "__gnat_getservbyname");
pragma Import (C, C_Getservbyport, "__gnat_getservbyport"); pragma Import (C, C_Getservbyport, "__gnat_getservbyport");
pragma Import (C, C_Getaddrinfo, "__gnat_getaddrinfo");
pragma Import (C, C_Freeaddrinfo, "__gnat_freeaddrinfo");
pragma Import (C, C_Getnameinfo, "__gnat_getnameinfo");
pragma Import (C, C_GAI_Strerror, "__gnat_gai_strerror");
pragma Import (C, Servent_S_Name, "__gnat_servent_s_name"); 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_Alias, "__gnat_servent_s_alias");
pragma Import (C, Servent_S_Port, "__gnat_servent_s_port"); pragma Import (C, Servent_S_Port, "__gnat_servent_s_port");
......
...@@ -60,7 +60,7 @@ package body Signalling_Fds is ...@@ -60,7 +60,7 @@ package body Signalling_Fds is
L_Sock, R_Sock, W_Sock : C.int := Failure; L_Sock, R_Sock, W_Sock : C.int := Failure;
-- Listening socket, read socket and write socket -- Listening socket, read socket and write socket
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : aliased C.int; Len : aliased C.int;
-- Address of listening socket -- Address of listening socket
......
...@@ -1056,6 +1056,138 @@ CND(AF_INET, "IPv4 address family") ...@@ -1056,6 +1056,138 @@ CND(AF_INET, "IPv4 address family")
#endif #endif
CND(AF_INET6, "IPv6 address family") CND(AF_INET6, "IPv6 address family")
#ifndef AF_UNSPEC
# define AF_UNSPEC -1
#else
# define HAVE_AF_UNSPEC 1
#endif
CND(AF_UNSPEC, "Unspecified address family")
/*
-----------------------------
-- addrinfo fields offsets --
-----------------------------
*/
#ifdef AI_CANONNAME
const struct addrinfo ai;
#define AI_FLAGS_OFFSET ((void *)&ai.ai_flags - (void *)&ai)
#define AI_FAMILY_OFFSET ((void *)&ai.ai_family - (void *)&ai)
#define AI_SOCKTYPE_OFFSET ((void *)&ai.ai_socktype - (void *)&ai)
#define AI_PROTOCOL_OFFSET ((void *)&ai.ai_protocol - (void *)&ai)
#define AI_ADDRLEN_OFFSET ((void *)&ai.ai_addrlen - (void *)&ai)
#define AI_ADDR_OFFSET ((void *)&ai.ai_addr - (void *)&ai)
#define AI_CANONNAME_OFFSET ((void *)&ai.ai_canonname - (void *)&ai)
#define AI_NEXT_OFFSET ((void *)&ai.ai_next - (void *)&ai)
#else
#define AI_FLAGS_OFFSET 0
#define AI_FAMILY_OFFSET 4
#define AI_SOCKTYPE_OFFSET 8
#define AI_PROTOCOL_OFFSET 12
#define AI_ADDRLEN_OFFSET 16
#define AI_CANONNAME_OFFSET 24
#define AI_ADDR_OFFSET 32
#define AI_NEXT_OFFSET 40
#endif
CND(AI_FLAGS_OFFSET, "Offset of ai_flags in addrinfo");
CND(AI_FAMILY_OFFSET, "Offset of ai_family in addrinfo");
CND(AI_SOCKTYPE_OFFSET, "Offset of ai_socktype in addrinfo");
CND(AI_PROTOCOL_OFFSET, "Offset of ai_protocol in addrinfo");
CND(AI_ADDRLEN_OFFSET, "Offset of ai_addrlen in addrinfo");
CND(AI_ADDR_OFFSET, "Offset of ai_addr in addrinfo");
CND(AI_CANONNAME_OFFSET, "Offset of ai_canonname in addrinfo");
CND(AI_NEXT_OFFSET, "Offset of ai_next in addrinfo");
/*
---------------------------------------
-- getaddrinfo getnameinfo constants --
---------------------------------------
*/
#ifndef AI_PASSIVE
# define AI_PASSIVE -1
#endif
CND(AI_PASSIVE, "NULL nodename for accepting")
#ifndef AI_CANONNAME
# define AI_CANONNAME -1
#endif
CND(AI_CANONNAME, "Get the host official name")
#ifndef AI_NUMERICSERV
# define AI_NUMERICSERV -1
#endif
CND(AI_NUMERICSERV, "Service is a numeric string")
#ifndef AI_NUMERICHOST
# define AI_NUMERICHOST -1
#endif
CND(AI_NUMERICHOST, "Node is a numeric IP address")
#ifndef AI_ADDRCONFIG
# define AI_ADDRCONFIG -1
#endif
CND(AI_ADDRCONFIG, "Returns addresses for only locally configured families")
#ifndef AI_V4MAPPED
# define AI_V4MAPPED -1
#endif
CND(AI_V4MAPPED, "Returns IPv4 mapped to IPv6")
#ifndef AI_ALL
# define AI_ALL -1
#endif
CND(AI_ALL, "Change AI_V4MAPPED behavior for unavailavle IPv6 addresses")
#ifndef NI_NAMEREQD
# define NI_NAMEREQD -1
#endif
CND(NI_NAMEREQD, "Error if the hostname cannot be determined")
#ifndef NI_DGRAM
# define NI_DGRAM -1
#endif
CND(NI_DGRAM, "Service is datagram")
#ifndef NI_NOFQDN
# define NI_NOFQDN -1
#endif
CND(NI_NOFQDN, "Return only the hostname part for local hosts")
#ifndef NI_NUMERICSERV
# define NI_NUMERICSERV -1
#endif
CND(NI_NUMERICSERV, "Numeric form of the service")
#ifndef NI_NUMERICHOST
# define NI_NUMERICHOST -1
#endif
CND(NI_NUMERICHOST, "Numeric form of the hostname")
#ifndef NI_MAXHOST
# define NI_MAXHOST -1
#endif
CND(NI_MAXHOST, "Maximum size of hostname")
#ifndef NI_MAXSERV
# define NI_MAXSERV -1
#endif
CND(NI_MAXSERV, "Maximum size of service name")
#ifndef EAI_SYSTEM
# define EAI_SYSTEM -1
#endif
CND(EAI_SYSTEM, "Check errno for details")
/* /*
------------------ ------------------
...@@ -1074,6 +1206,11 @@ CND(SOCK_STREAM, "Stream socket") ...@@ -1074,6 +1206,11 @@ CND(SOCK_STREAM, "Stream socket")
#endif #endif
CND(SOCK_DGRAM, "Datagram socket") CND(SOCK_DGRAM, "Datagram socket")
#ifndef SOCK_RAW
# define SOCK_RAW -1
#endif
CND(SOCK_RAW, "Raw socket")
/* /*
----------------- -----------------
...@@ -1143,6 +1280,11 @@ CND(SOL_SOCKET, "Options for socket level") ...@@ -1143,6 +1280,11 @@ CND(SOL_SOCKET, "Options for socket level")
#endif #endif
CND(IPPROTO_IP, "Dummy protocol for IP") CND(IPPROTO_IP, "Dummy protocol for IP")
#ifndef IPPROTO_IPV6
# define IPPROTO_IPV6 -1
#endif
CND(IPPROTO_IPV6, "IPv6 socket option level")
#ifndef IPPROTO_UDP #ifndef IPPROTO_UDP
# define IPPROTO_UDP -1 # define IPPROTO_UDP -1
#endif #endif
...@@ -1300,6 +1442,111 @@ CND(IP_DROP_MEMBERSHIP, "Leave a multicast group") ...@@ -1300,6 +1442,111 @@ CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
#endif #endif
CND(IP_PKTINFO, "Get datagram info") CND(IP_PKTINFO, "Get datagram info")
#ifndef IP_RECVERR
# define IP_RECVERR -1
#endif
CND(IP_RECVERR, "Extended reliable error message passing")
#ifndef IPV6_ADDRFORM
# define IPV6_ADDRFORM -1
#endif
CND(IPV6_ADDRFORM, "Turn IPv6 socket into different address family")
#ifndef IPV6_ADD_MEMBERSHIP
# define IPV6_ADD_MEMBERSHIP -1
#endif
CND(IPV6_ADD_MEMBERSHIP, "Join IPv6 multicast group")
#ifndef IPV6_DROP_MEMBERSHIP
# define IPV6_DROP_MEMBERSHIP -1
#endif
CND(IPV6_DROP_MEMBERSHIP, "Leave IPv6 multicast group")
#ifndef IPV6_MTU
# define IPV6_MTU -1
#endif
CND(IPV6_MTU, "Set/get MTU used for the socket")
#ifndef IPV6_MTU_DISCOVER
# define IPV6_MTU_DISCOVER -1
#endif
CND(IPV6_MTU_DISCOVER, "Control path-MTU discovery on the socket")
#ifndef IPV6_MULTICAST_HOPS
# define IPV6_MULTICAST_HOPS -1
#endif
CND(IPV6_MULTICAST_HOPS, "Set the multicast hop limit for the socket")
#ifndef IPV6_MULTICAST_IF
# define IPV6_MULTICAST_IF -1
#endif
CND(IPV6_MULTICAST_IF, "Set/get IPv6 mcast interface")
#ifndef IPV6_MULTICAST_LOOP
# define IPV6_MULTICAST_LOOP -1
#endif
CND(IPV6_MULTICAST_LOOP, "Set/get mcast loopback")
#ifndef IPV6_RECVPKTINFO
# define IPV6_RECVPKTINFO -1
#endif
CND(IPV6_RECVPKTINFO, "Set delivery of the IPV6_PKTINFO")
#ifndef IPV6_PKTINFO
# define IPV6_PKTINFO -1
#endif
CND(IPV6_PKTINFO, "Get IPv6datagram info")
#ifndef IPV6_RTHDR
# define IPV6_RTHDR -1
#endif
CND(IPV6_RTHDR, "Set the routing header delivery")
#ifndef IPV6_AUTHHDR
# define IPV6_AUTHHDR -1
#endif
CND(IPV6_AUTHHDR, "Set the authentication header delivery")
#ifndef IPV6_DSTOPTS
# define IPV6_DSTOPTS -1
#endif
CND(IPV6_DSTOPTS, "Set the destination options delivery")
#ifndef IPV6_HOPOPTS
# define IPV6_HOPOPTS -1
#endif
CND(IPV6_HOPOPTS, "Set the hop options delivery")
#ifndef IPV6_FLOWINFO
# define IPV6_FLOWINFO -1
#endif
CND(IPV6_FLOWINFO, "Set the flow ID delivery")
#ifndef IPV6_HOPLIMIT
# define IPV6_HOPLIMIT -1
#endif
CND(IPV6_HOPLIMIT, "Set the hop count of the packet delivery")
#ifndef IPV6_RECVERR
# define IPV6_RECVERR -1
#endif
CND(IPV6_RECVERR, "Extended reliable error message passing")
#ifndef IPV6_ROUTER_ALERT
# define IPV6_ROUTER_ALERT -1
#endif
CND(IPV6_ROUTER_ALERT, "Pass forwarded router alert hop-by-hop option")
#ifndef IPV6_UNICAST_HOPS
# define IPV6_UNICAST_HOPS -1
#endif
CND(IPV6_UNICAST_HOPS, "Set the unicast hop limit")
#ifndef IPV6_V6ONLY
# define IPV6_V6ONLY -1
#endif
CND(IPV6_V6ONLY, "Restricted to IPv6 communications only")
/* /*
---------------------- ----------------------
...@@ -1367,6 +1614,22 @@ CND(SIZEOF_struct_servent, "struct servent") ...@@ -1367,6 +1614,22 @@ CND(SIZEOF_struct_servent, "struct servent")
CND(SIZEOF_sigset, "sigset") CND(SIZEOF_sigset, "sigset")
#endif #endif
#if defined(_WIN32) || defined(__vxworks)
#define SIZEOF_socklen_t sizeof (size_t)
#else
#define SIZEOF_socklen_t sizeof (socklen_t)
#endif
CND(SIZEOF_socklen_t, "Size of socklen_t");
#ifndef IF_NAMESIZE
#ifdef IF_MAX_STRING_SIZE
#define IF_NAMESIZE IF_MAX_STRING_SIZE
#else
#define IF_NAMESIZE -1
#endif
#endif
CND(IF_NAMESIZE, "Max size of interface name with 0 terminator");
/* /*
-- Fields of struct msghdr -- Fields of struct msghdr
...@@ -1409,6 +1672,13 @@ C("Thread_Blocking_IO", Boolean, "True", "") ...@@ -1409,6 +1672,13 @@ C("Thread_Blocking_IO", Boolean, "True", "")
#endif #endif
CST(Inet_Pton_Linkname, "") CST(Inet_Pton_Linkname, "")
#ifdef HAVE_INET_NTOP
# define Inet_Ntop_Linkname "inet_ntop"
#else
# define Inet_Ntop_Linkname "__gnat_inet_ntop"
#endif
CST(Inet_Ntop_Linkname, "")
#endif /* HAVE_SOCKETS */ #endif /* HAVE_SOCKETS */
/* /*
......
...@@ -90,10 +90,27 @@ extern int __gnat_hostent_h_addrtype (struct hostent *); ...@@ -90,10 +90,27 @@ extern int __gnat_hostent_h_addrtype (struct hostent *);
extern int __gnat_hostent_h_length (struct hostent *); extern int __gnat_hostent_h_length (struct hostent *);
extern char * __gnat_hostent_h_addr (struct hostent *, int); extern char * __gnat_hostent_h_addr (struct hostent *, int);
extern int __gnat_getaddrinfo(
const char *node,
const char *service,
const struct addrinfo *hints,
struct addrinfo **res);
int __gnat_getnameinfo(
const struct sockaddr *sa, socklen_t salen,
char *host, size_t hostlen,
char *serv, size_t servlen, int flags);
extern void __gnat_freeaddrinfo(struct addrinfo *res);
extern const char * __gnat_gai_strerror(int errcode);
#ifndef HAVE_INET_PTON #ifndef HAVE_INET_PTON
extern int __gnat_inet_pton (int, const char *, void *); extern int __gnat_inet_pton (int, const char *, void *);
#endif #endif
#ifndef HAVE_INET_NTOP
extern const char *
__gnat_inet_ntop(int, const void *, char *, socklen_t);
#endif
/* Disable the sending of SIGPIPE for writes on a broken stream */ /* Disable the sending of SIGPIPE for writes on a broken stream */
void void
...@@ -112,7 +129,7 @@ __gnat_disable_all_sigpipes (void) ...@@ -112,7 +129,7 @@ __gnat_disable_all_sigpipes (void)
(void) signal (SIGPIPE, SIG_IGN); (void) signal (SIGPIPE, SIG_IGN);
#endif #endif
} }
#if defined (_WIN32) || defined (__vxworks) #if defined (_WIN32) || defined (__vxworks)
/* /*
* Signalling FDs operations are implemented in Ada for these platforms * Signalling FDs operations are implemented in Ada for these platforms
...@@ -128,7 +145,7 @@ int ...@@ -128,7 +145,7 @@ int
__gnat_create_signalling_fds (int *fds) { __gnat_create_signalling_fds (int *fds) {
return pipe (fds); return pipe (fds);
} }
/* /*
* Read one byte of data from rsig, the read end of a pair of signalling fds * Read one byte of data from rsig, the read end of a pair of signalling fds
* created by __gnat_create_signalling_fds. * created by __gnat_create_signalling_fds.
...@@ -138,7 +155,7 @@ __gnat_read_signalling_fd (int rsig) { ...@@ -138,7 +155,7 @@ __gnat_read_signalling_fd (int rsig) {
char c; char c;
return read (rsig, &c, 1); return read (rsig, &c, 1);
} }
/* /*
* Write one byte of data to wsig, the write end of a pair of signalling fds * Write one byte of data to wsig, the write end of a pair of signalling fds
* created by __gnat_create_signalling_fds. * created by __gnat_create_signalling_fds.
...@@ -148,7 +165,7 @@ __gnat_write_signalling_fd (int wsig) { ...@@ -148,7 +165,7 @@ __gnat_write_signalling_fd (int wsig) {
char c = 0; char c = 0;
return write (wsig, &c, 1); return write (wsig, &c, 1);
} }
/* /*
* Close one end of a pair of signalling fds * Close one end of a pair of signalling fds
*/ */
...@@ -157,7 +174,7 @@ __gnat_close_signalling_fd (int sig) { ...@@ -157,7 +174,7 @@ __gnat_close_signalling_fd (int sig) {
(void) close (sig); (void) close (sig);
} }
#endif #endif
/* /*
* Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport * Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport
* ========================================================================= * =========================================================================
...@@ -369,7 +386,7 @@ __gnat_getservbyport (int port, const char *proto, ...@@ -369,7 +386,7 @@ __gnat_getservbyport (int port, const char *proto,
return 0; return 0;
} }
#endif #endif
/* Find the largest socket in the socket set SET. This is needed for /* Find the largest socket in the socket set SET. This is needed for
`select'. LAST is the maximum value for the largest socket. This hint is `select'. LAST is the maximum value for the largest socket. This hint is
used to avoid scanning very large socket sets. On return, LAST is the used to avoid scanning very large socket sets. On return, LAST is the
...@@ -572,6 +589,41 @@ __gnat_inet_pton (int af, const char *src, void *dst) { ...@@ -572,6 +589,41 @@ __gnat_inet_pton (int af, const char *src, void *dst) {
} }
#endif #endif
#ifndef HAVE_INET_NTOP
const char *
__gnat_inet_ntop(int af, const void *src, char *dst, socklen_t size)
{
#ifdef _WIN32
struct sockaddr_storage ss;
int sslen = sizeof ss;
memset(&ss, 0, sslen);
ss.ss_family = af;
switch (af) {
case AF_INET6:
((struct sockaddr_in6 *)&ss)->sin6_addr = *(struct in6_addr *)src;
break;
case AF_INET:
((struct sockaddr_in *)&ss)->sin_addr = *(struct in_addr *)src;
break;
default:
errno = EAFNOSUPPORT;
return NULL;
}
DWORD sz = size;
if (WSAAddressToStringA((struct sockaddr*)&ss, sslen, 0, dst, &sz) != 0) {
return NULL;
}
return dst;
#else
return NULL;
#endif
}
#endif
/* /*
* Accessor functions for struct hostent. * Accessor functions for struct hostent.
*/ */
...@@ -650,4 +702,105 @@ __gnat_servent_s_proto (struct servent * s) ...@@ -650,4 +702,105 @@ __gnat_servent_s_proto (struct servent * s)
return s->s_proto; return s->s_proto;
} }
#if defined(AF_INET6) && !defined(__rtems__)
#if defined (__vxworks)
#define getaddrinfo ipcom_getaddrinfo
#define getnameinfo ipcom_getnameinfo
#define freeaddrinfo ipcom_freeaddrinfo
#endif
int __gnat_getaddrinfo(
const char *node,
const char *service,
const struct addrinfo *hints,
struct addrinfo **res)
{
return getaddrinfo(node, service, hints, res);
}
int __gnat_getnameinfo(
const struct sockaddr *sa, socklen_t salen,
char *host, size_t hostlen,
char *serv, size_t servlen, int flags)
{
return getnameinfo(sa, salen, host, hostlen, serv, servlen, flags);
}
void __gnat_freeaddrinfo(struct addrinfo *res) {
freeaddrinfo(res);
}
const char * __gnat_gai_strerror(int errcode) {
#if defined(_WIN32) || defined(__vxworks)
// gai_strerror thread usafe on Windows and is not available on some vxWorks
// versions
switch (errcode) {
case EAI_AGAIN:
return "Temporary failure in name resolution.";
case EAI_BADFLAGS:
return "Invalid value for ai_flags.";
case EAI_FAIL:
return "Nonrecoverable failure in name resolution.";
case EAI_FAMILY:
return "The ai_family member is not supported.";
case EAI_MEMORY:
return "Memory allocation failure.";
#ifdef EAI_NODATA
// Could be not defined under the vxWorks
case EAI_NODATA:
return "No address associated with nodename.";
#endif
#if EAI_NODATA != EAI_NONAME
/* with mingw64 runtime EAI_NODATA and EAI_NONAME have the same value.
This applies to both win32 and win64 */
case EAI_NONAME:
return "Neither nodename nor servname provided, or not known.";
#endif
case EAI_SERVICE:
return "The servname parameter is not supported for ai_socktype.";
case EAI_SOCKTYPE:
return "The ai_socktype member is not supported.";
#ifdef EAI_SYSTEM
// Could be not defined, at least on Windows
case EAI_SYSTEM:
return "System error returned in errno";
#endif
default:
return "Unknown error.";
}
#else
return gai_strerror(errcode);
#endif
}
#else
int __gnat_getaddrinfo(
const char *node,
const char *service,
const struct addrinfo *hints,
struct addrinfo **res)
{
return -1;
}
int __gnat_getnameinfo(
const struct sockaddr *sa, socklen_t salen,
char *host, size_t hostlen,
char *serv, size_t servlen, int flags)
{
return -1;
}
void __gnat_freeaddrinfo(struct addrinfo *res) {
}
const char * __gnat_gai_strerror(int errcode) {
return "getaddinfo functions family is not supported";
}
#endif
#endif /* defined(HAVE_SOCKETS) */ #endif /* defined(HAVE_SOCKETS) */
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment