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) */
...@@ -31,6 +31,7 @@ ...@@ -31,6 +31,7 @@
with Ada.Streams; use Ada.Streams; with Ada.Streams; use Ada.Streams;
with Ada.Exceptions; use Ada.Exceptions; with Ada.Exceptions; use Ada.Exceptions;
with Ada.Containers.Generic_Array_Sort;
with Ada.Finalization; with Ada.Finalization;
with Ada.Unchecked_Conversion; with Ada.Unchecked_Conversion;
...@@ -50,6 +51,12 @@ package body GNAT.Sockets is ...@@ -50,6 +51,12 @@ package body GNAT.Sockets is
package C renames Interfaces.C; package C renames Interfaces.C;
type IPV6_Mreq is record
ipv6mr_multiaddr : In6_Addr;
ipv6mr_interface : C.unsigned;
end record with Convention => C;
-- Record to Add/Drop_Membership for multicast in IPv6
ENOERROR : constant := 0; ENOERROR : constant := 0;
Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024; Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
...@@ -64,6 +71,7 @@ package body GNAT.Sockets is ...@@ -64,6 +71,7 @@ package body GNAT.Sockets is
Levels : constant array (Level_Type) of C.int := Levels : constant array (Level_Type) of C.int :=
(Socket_Level => SOSC.SOL_SOCKET, (Socket_Level => SOSC.SOL_SOCKET,
IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP, IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP,
IP_Protocol_For_IPv6_Level => SOSC.IPPROTO_IPV6,
IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP, IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP); IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP);
...@@ -89,12 +97,18 @@ package body GNAT.Sockets is ...@@ -89,12 +97,18 @@ package body GNAT.Sockets is
Linger => SOSC.SO_LINGER, Linger => SOSC.SO_LINGER,
Error => SOSC.SO_ERROR, Error => SOSC.SO_ERROR,
No_Delay => SOSC.TCP_NODELAY, No_Delay => SOSC.TCP_NODELAY,
Add_Membership => SOSC.IP_ADD_MEMBERSHIP, Add_Membership_V4 => SOSC.IP_ADD_MEMBERSHIP,
Drop_Membership => SOSC.IP_DROP_MEMBERSHIP, Drop_Membership_V4 => SOSC.IP_DROP_MEMBERSHIP,
Multicast_If => SOSC.IP_MULTICAST_IF, Multicast_If_V4 => SOSC.IP_MULTICAST_IF,
Multicast_TTL => SOSC.IP_MULTICAST_TTL, Multicast_Loop_V4 => SOSC.IP_MULTICAST_LOOP,
Multicast_Loop => SOSC.IP_MULTICAST_LOOP,
Receive_Packet_Info => SOSC.IP_PKTINFO, Receive_Packet_Info => SOSC.IP_PKTINFO,
Multicast_TTL => SOSC.IP_MULTICAST_TTL,
Add_Membership_V6 => SOSC.IPV6_ADD_MEMBERSHIP,
Drop_Membership_V6 => SOSC.IPV6_DROP_MEMBERSHIP,
Multicast_If_V6 => SOSC.IPV6_MULTICAST_IF,
Multicast_Loop_V6 => SOSC.IPV6_MULTICAST_LOOP,
Multicast_Hops => SOSC.IPV6_MULTICAST_HOPS,
IPv6_Only => SOSC.IPV6_V6ONLY,
Send_Timeout => SOSC.SO_SNDTIMEO, Send_Timeout => SOSC.SO_SNDTIMEO,
Receive_Timeout => SOSC.SO_RCVTIMEO, Receive_Timeout => SOSC.SO_RCVTIMEO,
Busy_Polling => SOSC.SO_BUSY_POLL); Busy_Polling => SOSC.SO_BUSY_POLL);
...@@ -110,8 +124,16 @@ package body GNAT.Sockets is ...@@ -110,8 +124,16 @@ package body GNAT.Sockets is
Socket_Error_Id : constant Exception_Id := Socket_Error'Identity; Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
Host_Error_Id : constant Exception_Id := Host_Error'Identity; Host_Error_Id : constant Exception_Id := Host_Error'Identity;
Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF"; type In_Addr_Union (Family : Family_Type) is record
-- Use to print in hexadecimal format case Family is
when Family_Inet =>
In4 : In_Addr;
when Family_Inet6 =>
In6 : In6_Addr;
when Family_Unspec =>
null;
end case;
end record with Unchecked_Union;
----------------------- -----------------------
-- Local subprograms -- -- Local subprograms --
...@@ -133,24 +155,6 @@ package body GNAT.Sockets is ...@@ -133,24 +155,6 @@ package body GNAT.Sockets is
function Set_Forced_Flags (F : C.int) return C.int; function Set_Forced_Flags (F : C.int) return C.int;
-- Return F with the bits from SOSC.MSG_Forced_Flags forced set -- Return F with the bits from SOSC.MSG_Forced_Flags forced set
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
function Image
(Val : Inet_Addr_Bytes;
Hex : Boolean := False) return String;
-- Output an array of inet address components in hex or decimal mode
function Is_IP_Address (Name : String) return Boolean;
-- Return true when Name is an IPv4 address in dotted quad notation
procedure Netdb_Lock; procedure Netdb_Lock;
pragma Inline (Netdb_Lock); pragma Inline (Netdb_Lock);
procedure Netdb_Unlock; procedure Netdb_Unlock;
...@@ -158,12 +162,6 @@ package body GNAT.Sockets is ...@@ -158,12 +162,6 @@ package body GNAT.Sockets is
-- Lock/unlock operation used to protect netdb access for platforms that -- Lock/unlock operation used to protect netdb access for platforms that
-- require such protection. -- 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_Access) return Host_Entry_Type; function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type;
-- Conversion function -- Conversion function
...@@ -180,6 +178,12 @@ package body GNAT.Sockets is ...@@ -180,6 +178,12 @@ package body GNAT.Sockets is
-- Reconstruct a Duration value from a Timeval record (seconds and -- Reconstruct a Duration value from a Timeval record (seconds and
-- microseconds). -- microseconds).
function Dedot (Value : String) return String
is (if Value /= "" and then Value (Value'Last) = '.'
then Value (Value'First .. Value'Last - 1)
else Value);
-- Removes dot at the end of error message
procedure Raise_Socket_Error (Error : Integer); procedure Raise_Socket_Error (Error : Integer);
-- Raise Socket_Error with an exception message describing the error code -- Raise Socket_Error with an exception message describing the error code
-- from errno. -- from errno.
...@@ -189,6 +193,13 @@ package body GNAT.Sockets is ...@@ -189,6 +193,13 @@ package body GNAT.Sockets is
-- hstrerror seems to be obsolete) from h_errno. Name is the name -- hstrerror seems to be obsolete) from h_errno. Name is the name
-- or address that was being looked up. -- or address that was being looked up.
procedure Raise_GAI_Error (RC : C.int; Name : String);
-- Raise Host_Error with exception message in case of errors in
-- getaddrinfo and getnameinfo.
function Is_Windows return Boolean with Inline;
-- Returns True on Windows platform
procedure Narrow (Item : in out Socket_Set_Type); procedure Narrow (Item : in out Socket_Set_Type);
-- Update Last as it may be greater than the real last socket -- Update Last as it may be greater than the real last socket
...@@ -328,7 +339,7 @@ package body GNAT.Sockets is ...@@ -328,7 +339,7 @@ package body GNAT.Sockets is
Address : out Sock_Addr_Type) Address : out Sock_Addr_Type)
is is
Res : C.int; Res : C.int;
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
begin begin
...@@ -339,9 +350,7 @@ package body GNAT.Sockets is ...@@ -339,9 +350,7 @@ package body GNAT.Sockets is
end if; end if;
Socket := Socket_Type (Res); Socket := Socket_Type (Res);
Address := Get_Address (Sin);
To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
end Accept_Socket; end Accept_Socket;
------------------- -------------------
...@@ -451,20 +460,11 @@ package body GNAT.Sockets is ...@@ -451,20 +460,11 @@ package body GNAT.Sockets is
Address : Sock_Addr_Type) Address : Sock_Addr_Type)
is is
Res : C.int; Res : C.int;
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : constant C.int := Sin'Size / 8; Len : constant C.int := Sin'Size / 8;
-- This assumes that Address.Family = Family_Inet???
begin begin
if Address.Family = Family_Inet6 then Set_Address (Sin'Unchecked_Access, Address);
raise Socket_Error with "IPv6 not supported";
end if;
Set_Family (Sin.Sin_Family, Address.Family);
Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr));
Set_Port
(Sin'Unchecked_Access,
Short_To_Network (C.unsigned_short (Address.Port)));
Res := C_Bind (C.int (Socket), Sin'Address, Len); Res := C_Bind (C.int (Socket), Sin'Address, Len);
...@@ -478,14 +478,12 @@ package body GNAT.Sockets is ...@@ -478,14 +478,12 @@ package body GNAT.Sockets is
---------------------- ----------------------
procedure Check_For_Fd_Set (Fd : Socket_Type) is procedure Check_For_Fd_Set (Fd : Socket_Type) is
use SOSC;
begin begin
-- On Windows, fd_set is a FD_SETSIZE array of socket ids: -- On Windows, fd_set is a FD_SETSIZE array of socket ids:
-- no check required. Warnings suppressed because condition -- no check required. Warnings suppressed because condition
-- is known at compile time. -- is known at compile time.
if Target_OS = Windows then if Is_Windows then
return; return;
...@@ -667,19 +665,11 @@ package body GNAT.Sockets is ...@@ -667,19 +665,11 @@ package body GNAT.Sockets is
(Socket : Socket_Type; (Socket : Socket_Type;
Server : Sock_Addr_Type) return C.int Server : Sock_Addr_Type) return C.int
is is
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : constant C.int := Sin'Size / 8; Len : constant C.int := Sin'Size / 8;
begin begin
if Server.Family = Family_Inet6 then Set_Address (Sin'Unchecked_Access, Server);
raise Socket_Error with "IPv6 not supported";
end if;
Set_Family (Sin.Sin_Family, Server.Family);
Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr));
Set_Port
(Sin'Unchecked_Access,
Short_To_Network (C.unsigned_short (Server.Port)));
return C_Connect (C.int (Socket), Sin'Address, Len); return C_Connect (C.int (Socket), Sin'Address, Len);
end Connect_Socket; end Connect_Socket;
...@@ -861,12 +851,13 @@ package body GNAT.Sockets is ...@@ -861,12 +851,13 @@ package body GNAT.Sockets is
procedure Create_Socket procedure Create_Socket
(Socket : out Socket_Type; (Socket : out Socket_Type;
Family : Family_Type := Family_Inet; Family : Family_Type := Family_Inet;
Mode : Mode_Type := Socket_Stream) Mode : Mode_Type := Socket_Stream;
Level : Level_Type := IP_Protocol_For_IP_Level)
is is
Res : C.int; Res : C.int;
begin begin
Res := C_Socket (Families (Family), Modes (Mode), 0); Res := C_Socket (Families (Family), Modes (Mode), Levels (Level));
if Res = Failure then if Res = Failure then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
...@@ -959,6 +950,228 @@ package body GNAT.Sockets is ...@@ -959,6 +950,228 @@ package body GNAT.Sockets is
end if; end if;
end Get_Address; end Get_Address;
---------------------
-- Raise_GAI_Error --
---------------------
procedure Raise_GAI_Error (RC : C.int; Name : String) is
begin
if RC = SOSC.EAI_SYSTEM then
declare
Errcode : constant Integer := Socket_Errno;
begin
raise Host_Error with Err_Code_Image (Errcode)
& Dedot (Socket_Error_Message (Errcode)) & ": " & Name;
end;
else
raise Host_Error with Err_Code_Image (Integer (RC))
& Dedot (CS.Value (C_GAI_Strerror (RC))) & ": " & Name;
end if;
end Raise_GAI_Error;
----------------------
-- Get_Address_Info --
----------------------
function Get_Address_Info
(Host : String;
Service : String;
Family : Family_Type := Family_Unspec;
Mode : Mode_Type := Socket_Stream;
Level : Level_Type := IP_Protocol_For_IP_Level;
Numeric_Host : Boolean := False;
Passive : Boolean := False;
Unknown : access procedure
(Family, Mode, Level, Length : Integer) := null)
return Address_Info_Array
is
A : aliased Addrinfo_Access;
N : aliased C.char_array := C.To_C (Host);
S : aliased C.char_array := C.To_C (if Service = "" then "0"
else Service);
Hints : aliased constant Addrinfo :=
(ai_family => Families (Family),
ai_socktype => Modes (Mode),
ai_protocol => Levels (Level),
ai_flags => (if Numeric_Host then SOSC.AI_NUMERICHOST else 0) +
(if Passive then SOSC.AI_PASSIVE else 0),
ai_addrlen => 0,
others => <>);
R : C.int;
Iter : Addrinfo_Access;
Found : Boolean;
function To_Array return Address_Info_Array;
-- Convert taken from OS addrinfo list A into Address_Info_Array
--------------
-- To_Array --
--------------
function To_Array return Address_Info_Array is
Result : Address_Info_Array (1 .. 8);
procedure Unsupported;
-- Calls Unknown callback if defiend
-----------------
-- Unsupported --
-----------------
procedure Unsupported is
begin
if Unknown /= null then
Unknown
(Integer (Iter.ai_family),
Integer (Iter.ai_socktype),
Integer (Iter.ai_protocol),
Integer (Iter.ai_addrlen));
end if;
end Unsupported;
-- Start of processing for To_Array
begin
for J in Result'Range loop
Look_For_Supported : loop
if Iter = null then
return Result (1 .. J - 1);
end if;
Result (J).Addr := Get_Address (Iter.ai_addr.all);
if Result (J).Addr.Family = Family_Unspec then
Unsupported;
else
for M in Modes'Range loop
Found := False;
if Modes (M) = Iter.ai_socktype then
Result (J).Mode := M;
Found := True;
exit;
end if;
end loop;
if Found then
for L in Levels'Range loop
if Levels (L) = Iter.ai_protocol then
Result (J).Level := L;
exit;
end if;
end loop;
exit Look_For_Supported;
else
Unsupported;
end if;
end if;
Iter := Iter.ai_next;
if Iter = null then
return Result (1 .. J - 1);
end if;
end loop Look_For_Supported;
Iter := Iter.ai_next;
end loop;
return Result & To_Array;
end To_Array;
-- Start of processing for Get_Address_Info
begin
R := C_Getaddrinfo
(Node => (if Host = "" then null else N'Unchecked_Access),
Service => S'Unchecked_Access,
Hints => Hints'Unchecked_Access,
Res => A'Access);
if R /= 0 then
Raise_GAI_Error
(R, Host & (if Service = "" then "" else ':' & Service));
end if;
Iter := A;
return Result : constant Address_Info_Array := To_Array do
C_Freeaddrinfo (A);
end return;
end Get_Address_Info;
----------
-- Sort --
----------
procedure Sort
(Addr_Info : in out Address_Info_Array;
Compare : access function (Left, Right : Address_Info) return Boolean)
is
function Comp (Left, Right : Address_Info) return Boolean is
(Compare (Left, Right));
procedure Sorter is new Ada.Containers.Generic_Array_Sort
(Positive, Address_Info, Address_Info_Array, Comp);
begin
Sorter (Addr_Info);
end Sort;
------------------------
-- IPv6_TCP_Preferred --
------------------------
function IPv6_TCP_Preferred (Left, Right : Address_Info) return Boolean is
begin
pragma Assert (Family_Inet < Family_Inet6);
-- To be sure that Family_Type enumeration has appropriate elements
-- order
if Left.Addr.Family /= Right.Addr.Family then
return Left.Addr.Family > Right.Addr.Family;
end if;
pragma Assert (Socket_Stream < Socket_Datagram);
-- To be sure that Mode_Type enumeration has appropriate elements order
return Left.Mode < Right.Mode;
end IPv6_TCP_Preferred;
-------------------
-- Get_Name_Info --
-------------------
function Get_Name_Info
(Addr : Sock_Addr_Type;
Numeric_Host : Boolean := False;
Numeric_Serv : Boolean := False) return Host_Service
is
SA : aliased Sockaddr;
H : aliased C.char_array := (1 .. SOSC.NI_MAXHOST => C.nul);
S : aliased C.char_array := (1 .. SOSC.NI_MAXSERV => C.nul);
RC : C.int;
begin
Set_Address (SA'Unchecked_Access, Addr);
RC := C_Getnameinfo
(SA'Unchecked_Access, socklen_t (Lengths (Addr.Family)),
H'Unchecked_Access, H'Length,
S'Unchecked_Access, S'Length,
(if Numeric_Host then SOSC.NI_NUMERICHOST else 0) +
(if Numeric_Serv then SOSC.NI_NUMERICSERV else 0));
if RC /= 0 then
Raise_GAI_Error (RC, Image (Addr));
end if;
declare
HR : constant String := C.To_Ada (H);
SR : constant String := C.To_Ada (S);
begin
return (HR'Length, SR'Length, HR, SR);
end;
end Get_Name_Info;
------------------------- -------------------------
-- Get_Host_By_Address -- -- Get_Host_By_Address --
------------------------- -------------------------
...@@ -969,16 +1182,32 @@ package body GNAT.Sockets is ...@@ -969,16 +1182,32 @@ package body GNAT.Sockets is
is is
pragma Unreferenced (Family); pragma Unreferenced (Family);
HA : aliased In_Addr := To_In_Addr (Address); HA : aliased In_Addr_Union (Address.Family);
Buflen : constant C.int := Netdb_Buffer_Size; Buflen : constant C.int := Netdb_Buffer_Size;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size); Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Hostent; Res : aliased Hostent;
Err : aliased C.int; Err : aliased C.int;
begin begin
case Address.Family is
when Family_Inet =>
HA.In4 := To_In_Addr (Address);
when Family_Inet6 =>
HA.In6 := To_In6_Addr (Address);
when Family_Unspec =>
return (0, 0, (1, " "), (1 .. 0 => (1, " ")),
(1 .. 0 => No_Inet_Addr));
end case;
Netdb_Lock; Netdb_Lock;
if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET, if C_Gethostbyaddr
(HA'Address,
(case Address.Family is
when Family_Inet => HA.In4'Size,
when Family_Inet6 => HA.In6'Size,
when Family_Unspec => 0) / 8,
Families (Address.Family),
Res'Access, Buf'Address, Buflen, Err'Access) /= 0 Res'Access, Buf'Address, Buflen, Err'Access) /= 0
then then
Netdb_Unlock; Netdb_Unlock;
...@@ -1007,7 +1236,7 @@ package body GNAT.Sockets is ...@@ -1007,7 +1236,7 @@ package body GNAT.Sockets is
-- If the given name actually is the string representation of -- If the given name actually is the string representation of
-- an IP address, use Get_Host_By_Address instead. -- an IP address, use Get_Host_By_Address instead.
if Is_IP_Address (Name) then if Is_IPv4_Address (Name) or else Is_IPv6_Address (Name) then
return Get_Host_By_Address (Inet_Addr (Name)); return Get_Host_By_Address (Inet_Addr (Name));
end if; end if;
...@@ -1041,19 +1270,14 @@ package body GNAT.Sockets is ...@@ -1041,19 +1270,14 @@ package body GNAT.Sockets is
------------------- -------------------
function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
Res : Sock_Addr_Type (Family_Inet);
begin begin
if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
end if; end if;
To_Inet_Addr (Sin.Sin_Addr, Res.Addr); return Get_Address (Sin);
Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
return Res;
end Get_Peer_Name; end Get_Peer_Name;
------------------------- -------------------------
...@@ -1127,20 +1351,17 @@ package body GNAT.Sockets is ...@@ -1127,20 +1351,17 @@ package body GNAT.Sockets is
function Get_Socket_Name function Get_Socket_Name
(Socket : Socket_Type) return Sock_Addr_Type (Socket : Socket_Type) return Sock_Addr_Type
is is
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
Res : C.int; Res : C.int;
Addr : Sock_Addr_Type := No_Sock_Addr;
begin begin
Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access); Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
if Res /= Failure then if Res = Failure then
To_Inet_Addr (Sin.Sin_Addr, Addr.Addr); return No_Sock_Addr;
Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
end if; end if;
return Addr; return Get_Address (Sin);
end Get_Socket_Name; end Get_Socket_Name;
----------------------- -----------------------
...@@ -1153,7 +1374,6 @@ package body GNAT.Sockets is ...@@ -1153,7 +1374,6 @@ package body GNAT.Sockets is
Name : Option_Name; Name : Option_Name;
Optname : Interfaces.C.int := -1) return Option_Type Optname : Interfaces.C.int := -1) return Option_Type
is is
use SOSC;
use type C.unsigned; use type C.unsigned;
use type C.unsigned_char; use type C.unsigned_char;
...@@ -1180,8 +1400,7 @@ package body GNAT.Sockets is ...@@ -1180,8 +1400,7 @@ package body GNAT.Sockets is
end if; end if;
case Name is case Name is
when Multicast_Loop when Multicast_TTL
| Multicast_TTL
| Receive_Packet_Info | Receive_Packet_Info
=> =>
Len := V1'Size / 8; Len := V1'Size / 8;
...@@ -1192,11 +1411,16 @@ package body GNAT.Sockets is ...@@ -1192,11 +1411,16 @@ package body GNAT.Sockets is
| Error | Error
| Generic_Option | Generic_Option
| Keep_Alive | Keep_Alive
| Multicast_If | Multicast_If_V4
| Multicast_If_V6
| Multicast_Loop_V4
| Multicast_Loop_V6
| Multicast_Hops
| No_Delay | No_Delay
| Receive_Buffer | Receive_Buffer
| Reuse_Address | Reuse_Address
| Send_Buffer | Send_Buffer
| IPv6_Only
=> =>
Len := V4'Size / 8; Len := V4'Size / 8;
Add := V4'Address; Add := V4'Address;
...@@ -1208,18 +1432,23 @@ package body GNAT.Sockets is ...@@ -1208,18 +1432,23 @@ package body GNAT.Sockets is
-- struct timeval, but on Windows it is a milliseconds count in -- struct timeval, but on Windows it is a milliseconds count in
-- a DWORD. -- a DWORD.
if Target_OS = Windows then if Is_Windows then
Len := U4'Size / 8; Len := U4'Size / 8;
Add := U4'Address; Add := U4'Address;
else else
Len := VT'Size / 8; Len := VT'Size / 8;
Add := VT'Address; Add := VT'Address;
end if; end if;
when Add_Membership when Add_Membership_V4
| Drop_Membership | Add_Membership_V6
| Linger | Drop_Membership_V4
| Drop_Membership_V6
=>
raise Socket_Error with
"Add/Drop membership valid only for Set_Socket_Option";
when Linger
=> =>
Len := V8'Size / 8; Len := V8'Size / 8;
Add := V8'Address; Add := V8'Address;
...@@ -1245,6 +1474,9 @@ package body GNAT.Sockets is ...@@ -1245,6 +1474,9 @@ package body GNAT.Sockets is
| Keep_Alive | Keep_Alive
| No_Delay | No_Delay
| Reuse_Address | Reuse_Address
| Multicast_Loop_V4
| Multicast_Loop_V6
| IPv6_Only
=> =>
Opt.Enabled := (V4 /= 0); Opt.Enabled := (V4 /= 0);
...@@ -1263,27 +1495,35 @@ package body GNAT.Sockets is ...@@ -1263,27 +1495,35 @@ package body GNAT.Sockets is
when Error => when Error =>
Opt.Error := Resolve_Error (Integer (V4)); Opt.Error := Resolve_Error (Integer (V4));
when Add_Membership when Add_Membership_V4
| Drop_Membership | Add_Membership_V6
| Drop_Membership_V4
| Drop_Membership_V6
=> =>
To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address); -- No way to be here. Exception raised in the first case Name
To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface); -- expression.
null;
when Multicast_If => when Multicast_If_V4 =>
To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If); To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
when Multicast_If_V6 =>
Opt.Outgoing_If_Index := Natural (V4);
when Multicast_TTL => when Multicast_TTL =>
Opt.Time_To_Live := Integer (V1); Opt.Time_To_Live := Integer (V1);
when Multicast_Loop when Multicast_Hops =>
| Receive_Packet_Info Opt.Hop_Limit := Integer (V4);
when Receive_Packet_Info
=> =>
Opt.Enabled := (V1 /= 0); Opt.Enabled := (V1 /= 0);
when Receive_Timeout when Receive_Timeout
| Send_Timeout | Send_Timeout
=> =>
if Target_OS = Windows then if Is_Windows then
-- Timeout is in milliseconds, actual value is 500 ms + -- Timeout is in milliseconds, actual value is 500 ms +
-- returned value (unless it is 0). -- returned value (unless it is 0).
...@@ -1324,78 +1564,34 @@ package body GNAT.Sockets is ...@@ -1324,78 +1564,34 @@ package body GNAT.Sockets is
-- Image -- -- Image --
----------- -----------
function Image function Image (Value : Inet_Addr_Type) return String is
(Val : Inet_Addr_Bytes; use type CS.char_array_access;
Hex : Boolean := False) return String Size : constant socklen_t :=
is (case Value.Family is
-- The largest Inet_Addr_Comp_Type image occurs with IPv4. It when Family_Inet => 4 * Value.Sin_V4'Length,
-- has at most a length of 3 plus one '.' character. when Family_Inet6 => 6 * 5 + 4 * 4,
-- 1234:1234:1234:1234:1234:1234:123.123.123.123
Buffer : String (1 .. 4 * Val'Length); when Family_Unspec => 0);
Length : Natural := 1; Dst : aliased C.char_array := (1 .. C.size_t (Size) => C.nul);
Separator : Character; Ia : aliased In_Addr_Union (Value.Family);
begin
procedure Img10 (V : Inet_Addr_Comp_Type); case Value.Family is
-- Append to Buffer image of V in decimal format when Family_Inet6 =>
Ia.In6 := To_In6_Addr (Value);
procedure Img16 (V : Inet_Addr_Comp_Type); when Family_Inet =>
-- Append to Buffer image of V in hexadecimal format Ia.In4 := To_In_Addr (Value);
when Family_Unspec =>
----------- return "";
-- Img10 -- end case;
-----------
procedure Img10 (V : Inet_Addr_Comp_Type) is
Img : constant String := V'Img;
Len : constant Natural := Img'Length - 1;
begin
Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
Length := Length + Len;
end Img10;
-----------
-- Img16 --
-----------
procedure Img16 (V : Inet_Addr_Comp_Type) is
begin
Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1);
Length := Length + 2;
end Img16;
-- Start of processing for Image
begin
Separator := (if Hex then ':' else '.');
for J in Val'Range loop
if Hex then
Img16 (Val (J));
else
Img10 (Val (J));
end if;
if J /= Val'Last then if Inet_Ntop
Buffer (Length) := Separator; (Families (Value.Family), Ia'Address,
Length := Length + 1; Dst'Unchecked_Access, Size) = null
then
Raise_Socket_Error (Socket_Errno);
end if; end if;
end loop;
return Buffer (1 .. Length - 1); return C.To_Ada (Dst);
end Image;
-----------
-- Image --
-----------
function Image (Value : Inet_Addr_Type) return String is
begin
if Value.Family = Family_Inet then
return Image (Inet_Addr_Bytes (Value.Sin_V4), Hex => False);
else
return Image (Inet_Addr_Bytes (Value.Sin_V6), Hex => True);
end if;
end Image; end Image;
----------- -----------
...@@ -1404,8 +1600,10 @@ package body GNAT.Sockets is ...@@ -1404,8 +1600,10 @@ package body GNAT.Sockets is
function Image (Value : Sock_Addr_Type) return String is function Image (Value : Sock_Addr_Type) return String is
Port : constant String := Value.Port'Img; Port : constant String := Value.Port'Img;
function Ipv6_Brackets (S : String) return String is
(if Value.Family = Family_Inet6 then "[" & S & "]" else S);
begin begin
return Image (Value.Addr) & ':' & Port (2 .. Port'Last); return Ipv6_Brackets (Image (Value.Addr)) & ':' & Port (2 .. Port'Last);
end Image; end Image;
----------- -----------
...@@ -1456,10 +1654,11 @@ package body GNAT.Sockets is ...@@ -1456,10 +1654,11 @@ package body GNAT.Sockets is
use Interfaces.C; use Interfaces.C;
Img : aliased char_array := To_C (Image); Img : aliased char_array := To_C (Image);
Addr : aliased C.int;
Res : C.int; Res : C.int;
Result : Inet_Addr_Type; Result : Inet_Addr_Type;
IPv6 : constant Boolean := Is_IPv6_Address (Image);
Ia : aliased In_Addr_Union
(if IPv6 then Family_Inet6 else Family_Inet);
begin begin
-- Special case for an empty Image as on some platforms (e.g. Windows) -- Special case for an empty Image as on some platforms (e.g. Windows)
-- calling Inet_Addr("") will not return an error. -- calling Inet_Addr("") will not return an error.
...@@ -1468,7 +1667,9 @@ package body GNAT.Sockets is ...@@ -1468,7 +1667,9 @@ package body GNAT.Sockets is
Raise_Socket_Error (SOSC.EINVAL); Raise_Socket_Error (SOSC.EINVAL);
end if; end if;
Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address); Res := Inet_Pton
((if IPv6 then SOSC.AF_INET6 else SOSC.AF_INET), Img'Address,
Ia'Address);
if Res < 0 then if Res < 0 then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
...@@ -1477,7 +1678,12 @@ package body GNAT.Sockets is ...@@ -1477,7 +1678,12 @@ package body GNAT.Sockets is
Raise_Socket_Error (SOSC.EINVAL); Raise_Socket_Error (SOSC.EINVAL);
end if; end if;
To_Inet_Addr (To_In_Addr (Addr), Result); if IPv6 then
To_Inet_Addr (Ia.In6, Result);
else
To_Inet_Addr (Ia.In4, Result);
end if;
return Result; return Result;
end Inet_Addr; end Inet_Addr;
...@@ -1527,6 +1733,16 @@ package body GNAT.Sockets is ...@@ -1527,6 +1733,16 @@ package body GNAT.Sockets is
null; null;
end Initialize; end Initialize;
----------------
-- Is_Windows --
----------------
function Is_Windows return Boolean is
use SOSC;
begin
return Target_OS = Windows;
end Is_Windows;
-------------- --------------
-- Is_Empty -- -- Is_Empty --
-------------- --------------
...@@ -1536,11 +1752,56 @@ package body GNAT.Sockets is ...@@ -1536,11 +1752,56 @@ package body GNAT.Sockets is
return Item.Last = No_Socket; return Item.Last = No_Socket;
end Is_Empty; end Is_Empty;
------------------- ---------------------
-- Is_IP_Address -- -- Is_IPv6_Address --
------------------- ---------------------
function Is_IPv6_Address (Name : String) return Boolean is
Prev_Colon : Natural := 0;
Double_Colon : Boolean := False;
Colons : Natural := 0;
begin
for J in Name'Range loop
if Name (J) = ':' then
Colons := Colons + 1;
if Prev_Colon > 0 and then J = Prev_Colon + 1 then
if Double_Colon then
-- Only one double colon allowed
return False;
end if;
Double_Colon := True;
elsif J = Name'Last then
-- Single colon at the end is not allowed
return False;
end if;
Prev_Colon := J;
elsif Prev_Colon = Name'First then
-- Single colon at start is not allowed
return False;
elsif Name (J) = '.' then
return Prev_Colon > 0
and then Is_IPv4_Address (Name (Prev_Colon + 1 .. Name'Last));
elsif Name (J) not in '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' then
return False;
end if;
end loop;
function Is_IP_Address (Name : String) return Boolean is return Colons <= 7;
end Is_IPv6_Address;
---------------------
-- Is_IPv4_Address --
---------------------
function Is_IPv4_Address (Name : String) return Boolean is
Dots : Natural := 0; Dots : Natural := 0;
begin begin
...@@ -1571,7 +1832,7 @@ package body GNAT.Sockets is ...@@ -1571,7 +1832,7 @@ package body GNAT.Sockets is
end loop; end loop;
return Dots in 1 .. 3; return Dots in 1 .. 3;
end Is_IP_Address; end Is_IPv4_Address;
------------- -------------
-- Is_Open -- -- Is_Open --
...@@ -1760,13 +2021,6 @@ package body GNAT.Sockets is ...@@ -1760,13 +2021,6 @@ package body GNAT.Sockets is
---------------------- ----------------------
procedure Raise_Host_Error (H_Error : Integer; Name : String) is procedure Raise_Host_Error (H_Error : Integer; Name : String) is
function Dedot (Value : String) return String is
(if Value /= "" and then Value (Value'Last) = '.' then
Value (Value'First .. Value'Last - 1)
else
Value);
-- Removes dot at the end of error message
begin begin
raise Host_Error with raise Host_Error with
Err_Code_Image (H_Error) Err_Code_Image (H_Error)
...@@ -1863,7 +2117,7 @@ package body GNAT.Sockets is ...@@ -1863,7 +2117,7 @@ package body GNAT.Sockets is
Flags : Request_Flag_Type := No_Request_Flag) Flags : Request_Flag_Type := No_Request_Flag)
is is
Res : C.int; Res : C.int;
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
begin begin
...@@ -1882,8 +2136,7 @@ package body GNAT.Sockets is ...@@ -1882,8 +2136,7 @@ package body GNAT.Sockets is
Last := Last_Index (First => Item'First, Count => size_t (Res)); Last := Last_Index (First => Item'First, Count => size_t (Res));
To_Inet_Addr (Sin.Sin_Addr, From.Addr); From := Get_Address (Sin);
From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
end Receive_Socket; end Receive_Socket;
-------------------- --------------------
...@@ -2142,17 +2395,13 @@ package body GNAT.Sockets is ...@@ -2142,17 +2395,13 @@ package body GNAT.Sockets is
is is
Res : C.int; Res : C.int;
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr;
C_To : System.Address; C_To : System.Address;
Len : C.int; Len : C.int;
begin begin
if To /= null then if To /= null then
Set_Family (Sin.Sin_Family, To.Family); Set_Address (Sin'Unchecked_Access, To.all);
Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
Set_Port
(Sin'Unchecked_Access,
Short_To_Network (C.unsigned_short (To.Port)));
C_To := Sin'Address; C_To := Sin'Address;
Len := Sin'Size / 8; Len := Sin'Size / 8;
...@@ -2294,9 +2543,9 @@ package body GNAT.Sockets is ...@@ -2294,9 +2543,9 @@ package body GNAT.Sockets is
Level : Level_Type := Socket_Level; Level : Level_Type := Socket_Level;
Option : Option_Type) Option : Option_Type)
is is
use SOSC;
use type C.unsigned; use type C.unsigned;
MR : aliased IPV6_Mreq;
V8 : aliased Two_Ints; V8 : aliased Two_Ints;
V4 : aliased C.int; V4 : aliased C.int;
U4 : aliased C.unsigned; U4 : aliased C.unsigned;
...@@ -2318,6 +2567,9 @@ package body GNAT.Sockets is ...@@ -2318,6 +2567,9 @@ package body GNAT.Sockets is
| Keep_Alive | Keep_Alive
| No_Delay | No_Delay
| Reuse_Address | Reuse_Address
| Multicast_Loop_V4
| Multicast_Loop_V6
| IPv6_Only
=> =>
V4 := C.int (Boolean'Pos (Option.Enabled)); V4 := C.int (Boolean'Pos (Option.Enabled));
Len := V4'Size / 8; Len := V4'Size / 8;
...@@ -2346,26 +2598,42 @@ package body GNAT.Sockets is ...@@ -2346,26 +2598,42 @@ package body GNAT.Sockets is
Len := V4'Size / 8; Len := V4'Size / 8;
Add := V4'Address; Add := V4'Address;
when Add_Membership when Add_Membership_V4
| Drop_Membership | Drop_Membership_V4
=> =>
V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address)); V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface)); V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
Len := V8'Size / 8; Len := V8'Size / 8;
Add := V8'Address; Add := V8'Address;
when Multicast_If => when Add_Membership_V6
| Drop_Membership_V6 =>
MR.ipv6mr_multiaddr := To_In6_Addr (Option.Multicast_Address);
MR.ipv6mr_interface := C.unsigned (Option.Interface_Index);
Len := MR'Size / 8;
Add := MR'Address;
when Multicast_If_V4 =>
V4 := To_Int (To_In_Addr (Option.Outgoing_If)); V4 := To_Int (To_In_Addr (Option.Outgoing_If));
Len := V4'Size / 8; Len := V4'Size / 8;
Add := V4'Address; Add := V4'Address;
when Multicast_If_V6 =>
V4 := C.int (Option.Outgoing_If_Index);
Len := V4'Size / 8;
Add := V4'Address;
when Multicast_TTL => when Multicast_TTL =>
V1 := C.unsigned_char (Option.Time_To_Live); V1 := C.unsigned_char (Option.Time_To_Live);
Len := V1'Size / 8; Len := V1'Size / 8;
Add := V1'Address; Add := V1'Address;
when Multicast_Loop when Multicast_Hops =>
| Receive_Packet_Info V4 := C.int (Option.Hop_Limit);
Len := V4'Size / 8;
Add := V4'Address;
when Receive_Packet_Info
=> =>
V1 := C.unsigned_char (Boolean'Pos (Option.Enabled)); V1 := C.unsigned_char (Boolean'Pos (Option.Enabled));
Len := V1'Size / 8; Len := V1'Size / 8;
...@@ -2374,7 +2642,7 @@ package body GNAT.Sockets is ...@@ -2374,7 +2642,7 @@ package body GNAT.Sockets is
when Receive_Timeout when Receive_Timeout
| Send_Timeout | Send_Timeout
=> =>
if Target_OS = Windows then if Is_Windows then
-- On Windows, the timeout is a DWORD in milliseconds, and -- On Windows, the timeout is a DWORD in milliseconds, and
-- the actual timeout is 500 ms + the given value (unless it -- the actual timeout is 500 ms + the given value (unless it
...@@ -2420,28 +2688,6 @@ package body GNAT.Sockets is ...@@ -2420,28 +2688,6 @@ package body GNAT.Sockets is
end if; end if;
end Set_Socket_Option; end Set_Socket_Option;
----------------------
-- Short_To_Network --
----------------------
function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
use type C.unsigned_short;
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 (S / 256) + (S mod 256) * 256;
end if;
end Short_To_Network;
--------------------- ---------------------
-- Shutdown_Socket -- -- Shutdown_Socket --
--------------------- ---------------------
...@@ -2538,15 +2784,18 @@ package body GNAT.Sockets is ...@@ -2538,15 +2784,18 @@ package body GNAT.Sockets is
------------------- -------------------
function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is
use type C.size_t;
Aliases_Count, Addresses_Count : Natural; Aliases_Count, Addresses_Count : Natural;
-- H_Length is not used because it is currently only ever set to 4, as Family : constant Family_Type :=
-- we only handle the case of H_Addrtype being AF_INET. (case Hostent_H_Addrtype (E) is
when SOSC.AF_INET => Family_Inet,
when SOSC.AF_INET6 => Family_Inet6,
when others => Family_Unspec);
Addr_Len : constant C.size_t := C.size_t (Hostent_H_Length (E));
begin begin
if Hostent_H_Addrtype (E) /= SOSC.AF_INET then if Family = Family_Unspec then
Raise_Socket_Error (SOSC.EPFNOSUPPORT); Raise_Socket_Error (SOSC.EPFNOSUPPORT);
end if; end if;
...@@ -2574,61 +2823,35 @@ package body GNAT.Sockets is ...@@ -2574,61 +2823,35 @@ package body GNAT.Sockets is
for J in Result.Addresses'Range loop for J in Result.Addresses'Range loop
declare declare
Addr : In_Addr; Ia : In_Addr_Union (Family);
-- Hostent_H_Addr (E, <index>) may return an address that is -- Hostent_H_Addr (E, <index>) may return an address that is
-- not correctly aligned for In_Addr, so we need to use -- not correctly aligned for In_Addr, so we need to use
-- an intermediate copy operation on a type with an alignment -- an intermediate copy operation on a type with an alignment
-- of 1 to recover the value. -- of 1 to recover the value.
subtype Addr_Buf_T is C.char_array (1 .. Addr'Size / 8); subtype Addr_Buf_T is C.char_array (1 .. Addr_Len);
Unaligned_Addr : Addr_Buf_T; Unaligned_Addr : Addr_Buf_T;
for Unaligned_Addr'Address for Unaligned_Addr'Address
use Hostent_H_Addr (E, C.int (J - Result.Addresses'First)); use Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
pragma Import (Ada, Unaligned_Addr); pragma Import (Ada, Unaligned_Addr);
Aligned_Addr : Addr_Buf_T; Aligned_Addr : Addr_Buf_T;
for Aligned_Addr'Address use Addr'Address; for Aligned_Addr'Address use Ia'Address;
pragma Import (Ada, Aligned_Addr); pragma Import (Ada, Aligned_Addr);
begin begin
Aligned_Addr := Unaligned_Addr; Aligned_Addr := Unaligned_Addr;
To_Inet_Addr (Addr, Result.Addresses (J)); if Family = Family_Inet6 then
To_Inet_Addr (Ia.In6, Result.Addresses (J));
else
To_Inet_Addr (Ia.In4, Result.Addresses (J));
end if;
end; end;
end loop; end loop;
end return; end return;
end To_Host_Entry; end To_Host_Entry;
----------------
-- 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_Int -- -- To_Int --
------------ ------------
...@@ -2825,7 +3048,8 @@ package body GNAT.Sockets is ...@@ -2825,7 +3048,8 @@ package body GNAT.Sockets is
is is
(case Family is (case Family is
when Family_Inet => (Family_Inet, Bytes), when Family_Inet => (Family_Inet, Bytes),
when Family_Inet6 => (Family_Inet6, Bytes)); when Family_Inet6 => (Family_Inet6, Bytes),
when Family_Unspec => (Family => Family_Unspec));
--------------- ---------------
-- Get_Bytes -- -- Get_Bytes --
...@@ -2834,7 +3058,8 @@ package body GNAT.Sockets is ...@@ -2834,7 +3058,8 @@ package body GNAT.Sockets is
function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes is function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes is
(case Addr.Family is (case Addr.Family is
when Family_Inet => Addr.Sin_V4, when Family_Inet => Addr.Sin_V4,
when Family_Inet6 => Addr.Sin_V6); when Family_Inet6 => Addr.Sin_V6,
when Family_Unspec => (1 .. 0 => 0));
---------- ----------
-- Mask -- -- Mask --
......
...@@ -469,13 +469,17 @@ package GNAT.Sockets is ...@@ -469,13 +469,17 @@ package GNAT.Sockets is
-- Return a file descriptor to be used by external subprograms. This is -- Return a file descriptor to be used by external subprograms. This is
-- useful for C functions that are not yet interfaced in this package. -- useful for C functions that are not yet interfaced in this package.
type Family_Type is (Family_Inet, Family_Inet6); type Family_Type is (Family_Inet, Family_Inet6, Family_Unspec);
-- Address family (or protocol family) identifies the communication domain -- Address family (or protocol family) identifies the communication domain
-- and groups protocols with similar address formats. -- and groups protocols with similar address formats.
-- The order of the enumeration elements should not be changed unilaterally
-- because the IPv6_TCP_Preferred routine rely on it.
type Mode_Type is (Socket_Stream, Socket_Datagram); type Mode_Type is (Socket_Stream, Socket_Datagram);
-- Stream sockets provide connection-oriented byte streams. Datagram -- Stream sockets provide connection-oriented byte streams. Datagram
-- sockets support unreliable connectionless message based communication. -- sockets support unreliable connectionless message based communication.
-- The order of the enumeration elements should not be changed unilaterally
-- because the IPv6_TCP_Preferred routine rely on it.
type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write); type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write);
-- When a process closes a socket, the policy is to retain any data queued -- When a process closes a socket, the policy is to retain any data queued
...@@ -497,8 +501,8 @@ package GNAT.Sockets is ...@@ -497,8 +501,8 @@ package GNAT.Sockets is
type Inet_Addr_Comp_Type is mod 2 ** 8; type Inet_Addr_Comp_Type is mod 2 ** 8;
-- Octet for Internet address -- Octet for Internet address
Inet_Addr_Bytes_Length : constant array (Family_Type) of Positive := Inet_Addr_Bytes_Length : constant array (Family_Type) of Natural :=
(Family_Inet => 4, Family_Inet6 => 16); (Family_Inet => 4, Family_Inet6 => 16, Family_Unspec => 0);
type Inet_Addr_Bytes is array (Natural range <>) of Inet_Addr_Comp_Type; type Inet_Addr_Bytes is array (Natural range <>) of Inet_Addr_Comp_Type;
...@@ -517,24 +521,61 @@ package GNAT.Sockets is ...@@ -517,24 +521,61 @@ package GNAT.Sockets is
when Family_Inet6 => when Family_Inet6 =>
Sin_V6 : Inet_Addr_V6_Type := (others => 0); Sin_V6 : Inet_Addr_V6_Type := (others => 0);
when Family_Unspec =>
null;
end case; end case;
end record; end record;
-- An Internet address depends on an address family (IPv4 contains 4 octets -- An Internet address depends on an address family (IPv4 contains 4 octets
-- and IPv6 contains 16 octets). Any_Inet_Addr is a special value treated -- and IPv6 contains 16 octets).
-- like a wildcard enabling all addresses. No_Inet_Addr provides a special
-- value to denote uninitialized inet addresses.
Any_Inet_Addr : constant Inet_Addr_Type; Any_Inet_Addr : constant Inet_Addr_Type;
-- Wildcard enabling all addresses to use with bind
Any_Inet6_Addr : constant Inet_Addr_Type;
-- Idem for IPV6 socket
No_Inet_Addr : constant Inet_Addr_Type; No_Inet_Addr : constant Inet_Addr_Type;
-- Uninitialized inet address
Unspecified_Addr : constant Inet_Addr_Type;
-- Unspecified address. Unlike of No_Inet_Addr the constraint is
-- Family_Unspec for this constant.
Broadcast_Inet_Addr : constant Inet_Addr_Type; Broadcast_Inet_Addr : constant Inet_Addr_Type;
-- Broadcast destination address in the current network
Loopback_Inet_Addr : constant Inet_Addr_Type; Loopback_Inet_Addr : constant Inet_Addr_Type;
-- Loopback address to the local host
-- Useful constants for IPv4 multicast addresses Loopback_Inet6_Addr : constant Inet_Addr_Type;
-- IPv6 Loopback address to the local host
-- Useful constants for multicast addresses
Unspecified_Group_Inet_Addr : constant Inet_Addr_Type; Unspecified_Group_Inet_Addr : constant Inet_Addr_Type;
-- IPv4 multicast mask with prefix length 4
Unspecified_Group_Inet6_Addr : constant Inet_Addr_Type;
-- IPv6 multicast mask with prefix length 16
All_Hosts_Group_Inet_Addr : constant Inet_Addr_Type; All_Hosts_Group_Inet_Addr : constant Inet_Addr_Type;
-- Multicast group addresses all hosts on the same network segment
All_Hosts_Group_Inet6_Addr : constant Inet_Addr_Type;
-- Idem for IPv6 protocol
All_Routers_Group_Inet_Addr : constant Inet_Addr_Type; All_Routers_Group_Inet_Addr : constant Inet_Addr_Type;
-- Multicast group addresses all routers on the same network segment
All_Routers_Group_Inet6_Addr : constant Inet_Addr_Type;
-- Idem for IPv6 protocol
IPv4_To_IPv6_Prefix : constant Inet_Addr_Bytes :=
(1 .. 10 => 0, 11 .. 12 => 255);
-- Prefix for IPv4 mapped to IPv6 addresses
-- Functions to handle masks and prefixes -- Functions to handle masks and prefixes
...@@ -563,18 +604,24 @@ package GNAT.Sockets is ...@@ -563,18 +604,24 @@ package GNAT.Sockets is
-- for uninitialized socket addresses. -- for uninitialized socket addresses.
No_Sock_Addr : constant Sock_Addr_Type; No_Sock_Addr : constant Sock_Addr_Type;
-- Uninitialized socket address
function Is_IPv4_Address (Name : String) return Boolean;
-- Return true when Name is an IPv4 address in dotted quad notation
function Is_IPv6_Address (Name : String) return Boolean;
-- Return true when Name is an IPv6 address in numeric format
function Image (Value : Inet_Addr_Type) return String; function Image (Value : Inet_Addr_Type) return String;
-- Return an image of an Internet address. IPv4 notation consists in 4 -- Return an image of an Internet address. IPv4 notation consists in 4
-- octets in decimal format separated by dots. IPv6 notation consists in -- octets in decimal format separated by dots. IPv6 notation consists in
-- 16 octets in hexadecimal format separated by colons (and possibly -- 8 hextets in hexadecimal format separated by colons.
-- dots).
function Image (Value : Sock_Addr_Type) return String; function Image (Value : Sock_Addr_Type) return String;
-- Return inet address image and port image separated by a colon -- Return inet address image and port image separated by a colon
function Inet_Addr (Image : String) return Inet_Addr_Type; function Inet_Addr (Image : String) return Inet_Addr_Type;
-- Convert address image from numbers-and-dots notation into an -- Convert address image from numbers-dots-and-colons notation into an
-- inet address. -- inet address.
-- Host entries provide complete information on a given host: the official -- Host entries provide complete information on a given host: the official
...@@ -723,6 +770,7 @@ package GNAT.Sockets is ...@@ -723,6 +770,7 @@ package GNAT.Sockets is
type Level_Type is type Level_Type is
(Socket_Level, (Socket_Level,
IP_Protocol_For_IP_Level, IP_Protocol_For_IP_Level,
IP_Protocol_For_IPv6_Level,
IP_Protocol_For_UDP_Level, IP_Protocol_For_UDP_Level,
IP_Protocol_For_TCP_Level); IP_Protocol_For_TCP_Level);
...@@ -740,18 +788,29 @@ package GNAT.Sockets is ...@@ -740,18 +788,29 @@ package GNAT.Sockets is
Linger, -- Shutdown wait for msg to be sent or timeout occur Linger, -- Shutdown wait for msg to be sent or timeout occur
Error, -- Get and clear the pending socket error Error, -- Get and clear the pending socket error
No_Delay, -- Do not delay send to coalesce data (TCP_NODELAY) No_Delay, -- Do not delay send to coalesce data (TCP_NODELAY)
Add_Membership, -- Join a multicast group Add_Membership_V4, -- Join a multicast group
Drop_Membership, -- Leave a multicast group Add_Membership_V6, -- Idem for IPv6 socket
Multicast_If, -- Set default out interface for multicast packets Drop_Membership_V4, -- Leave a multicast group
Drop_Membership_V6, -- Idem for IPv6 socket
Multicast_If_V4, -- Set default out interface for multicast packets
Multicast_If_V6, -- Idem for IPv6 socket
Multicast_Loop_V4, -- Sent multicast packets are looped to local socket
Multicast_Loop_V6, -- Idem for IPv6 socket
Multicast_TTL, -- Set the time-to-live of sent multicast packets Multicast_TTL, -- Set the time-to-live of sent multicast packets
Multicast_Loop, -- Sent multicast packets are looped to local socket Multicast_Hops, -- Set the multicast hop limit for the IPv6 socket
Receive_Packet_Info, -- Receive low level packet info as ancillary data Receive_Packet_Info, -- Receive low level packet info as ancillary data
Send_Timeout, -- Set timeout value for output Send_Timeout, -- Set timeout value for output
Receive_Timeout, -- Set timeout value for input Receive_Timeout, -- Set timeout value for input
IPv6_Only, -- Restricted to IPv6 communications only
Busy_Polling); -- Set busy polling mode Busy_Polling); -- Set busy polling mode
subtype Specific_Option_Name is subtype Specific_Option_Name is
Option_Name range Keep_Alive .. Option_Name'Last; Option_Name range Keep_Alive .. Option_Name'Last;
Add_Membership : Option_Name renames Add_Membership_V4;
Drop_Membership : Option_Name renames Drop_Membership_V4;
Multicast_If : Option_Name renames Multicast_If_V4;
Multicast_Loop : Option_Name renames Multicast_Loop_V4;
type Option_Type (Name : Option_Name := Keep_Alive) is record type Option_Type (Name : Option_Name := Keep_Alive) is record
case Name is case Name is
when Generic_Option => when Generic_Option =>
...@@ -764,7 +823,9 @@ package GNAT.Sockets is ...@@ -764,7 +823,9 @@ package GNAT.Sockets is
Linger | Linger |
No_Delay | No_Delay |
Receive_Packet_Info | Receive_Packet_Info |
Multicast_Loop => IPv6_Only |
Multicast_Loop_V4 |
Multicast_Loop_V6 =>
Enabled : Boolean; Enabled : Boolean;
case Name is case Name is
...@@ -784,17 +845,31 @@ package GNAT.Sockets is ...@@ -784,17 +845,31 @@ package GNAT.Sockets is
when Error => when Error =>
Error : Error_Type; Error : Error_Type;
when Add_Membership | when Add_Membership_V4 |
Drop_Membership => Add_Membership_V6 |
Drop_Membership_V4 |
Drop_Membership_V6 =>
Multicast_Address : Inet_Addr_Type; Multicast_Address : Inet_Addr_Type;
case Name is
when Add_Membership_V4 |
Drop_Membership_V4 =>
Local_Interface : Inet_Addr_Type; Local_Interface : Inet_Addr_Type;
when others =>
Interface_Index : Natural;
end case;
when Multicast_If => when Multicast_If_V4 =>
Outgoing_If : Inet_Addr_Type; Outgoing_If : Inet_Addr_Type;
when Multicast_If_V6 =>
Outgoing_If_Index : Natural;
when Multicast_TTL => when Multicast_TTL =>
Time_To_Live : Natural; Time_To_Live : Natural;
when Multicast_Hops =>
Hop_Limit : Integer range -1 .. 255;
when Send_Timeout | when Send_Timeout |
Receive_Timeout => Receive_Timeout =>
Timeout : Timeval_Duration; Timeout : Timeval_Duration;
...@@ -865,10 +940,76 @@ package GNAT.Sockets is ...@@ -865,10 +940,76 @@ package GNAT.Sockets is
type Vector_Type is array (Integer range <>) of Vector_Element; type Vector_Type is array (Integer range <>) of Vector_Element;
type Address_Info is record
Addr : Sock_Addr_Type;
Mode : Mode_Type := Socket_Stream;
Level : Level_Type := IP_Protocol_For_IP_Level;
end record;
type Address_Info_Array is array (Positive range <>) of Address_Info;
function Get_Address_Info
(Host : String;
Service : String;
Family : Family_Type := Family_Unspec;
Mode : Mode_Type := Socket_Stream;
Level : Level_Type := IP_Protocol_For_IP_Level;
Numeric_Host : Boolean := False;
Passive : Boolean := False;
Unknown : access procedure
(Family, Mode, Level, Length : Integer) := null)
return Address_Info_Array;
-- Returns available addresses for the Host and Service names.
-- If Family is Family_Unspec, all available protocol families returned.
-- Service is the name of service as defined in /etc/services or port
-- number in string representation.
-- If Unknown procedure access specified it will be called in case of
-- unknown family found.
-- Numeric_Host flag suppresses any potentially lengthy network host
-- address lookups, and Host have to represent numerical network address in
-- this case.
-- If Passive is True and Host is empty then the returned socket addresses
-- will be suitable for binding a socket that will accept connections.
-- The returned socket address will contain the "wildcard address".
-- The wildcard address is used by applications (typically servers) that
-- intend to accept connections on any of the hosts's network addresses.
-- If Host is not empty, then the Passive flag is ignored.
-- If Passive is False, then the returned socket addresses will be suitable
-- for use with connect, sendto, or sendmsg. If Host is empty, then the
-- network address will be set to the loopback interface address;
-- this is used by applications that intend to communicate with peers
-- running on the same host.
procedure Sort
(Addr_Info : in out Address_Info_Array;
Compare : access function (Left, Right : Address_Info) return Boolean);
-- Sort address info array in order defined by compare function
function IPv6_TCP_Preferred (Left, Right : Address_Info) return Boolean;
-- To use with Sort to order where IPv6 and TCP addresses first
type Host_Service (Host_Length, Service_Length : Natural) is record
Host : String (1 .. Host_Length);
Service : String (1 .. Service_Length);
end record;
function Get_Name_Info
(Addr : Sock_Addr_Type;
Numeric_Host : Boolean := False;
Numeric_Serv : Boolean := False) return Host_Service;
-- Returns host and service names by the address and port.
-- If Numeric_Host is True, then the numeric form of the hostname is
-- returned. When Numeric_Host is False, this will still happen in case the
-- host name cannot be determined.
-- If Numenric_Serv is True, then the numeric form of the service address
-- (port number) is returned. When Numenric_Serv is False, this will still
-- happen in case the service's name cannot be determined.
procedure Create_Socket procedure Create_Socket
(Socket : out Socket_Type; (Socket : out Socket_Type;
Family : Family_Type := Family_Inet; Family : Family_Type := Family_Inet;
Mode : Mode_Type := Socket_Stream); Mode : Mode_Type := Socket_Stream;
Level : Level_Type := IP_Protocol_For_IP_Level);
-- Create an endpoint for communication. Raises Socket_Error on error -- Create an endpoint for communication. Raises Socket_Error on error
procedure Accept_Socket procedure Accept_Socket
...@@ -1265,12 +1406,19 @@ private ...@@ -1265,12 +1406,19 @@ private
Any_Inet_Addr : constant Inet_Addr_Type := Any_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 0)); (Family_Inet, (others => 0));
Any_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6, (others => 0));
No_Inet_Addr : constant Inet_Addr_Type := No_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 0)); (Family_Inet, (others => 0));
Unspecified_Addr : constant Inet_Addr_Type :=
(Family => Family_Unspec);
Broadcast_Inet_Addr : constant Inet_Addr_Type := Broadcast_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 255)); (Family_Inet, (others => 255));
Loopback_Inet_Addr : constant Inet_Addr_Type := Loopback_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (127, 0, 0, 1)); (Family_Inet, (127, 0, 0, 1));
Loopback_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6,
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1));
Unspecified_Group_Inet_Addr : constant Inet_Addr_Type := Unspecified_Group_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (224, 0, 0, 0)); (Family_Inet, (224, 0, 0, 0));
...@@ -1279,6 +1427,13 @@ private ...@@ -1279,6 +1427,13 @@ private
All_Routers_Group_Inet_Addr : constant Inet_Addr_Type := All_Routers_Group_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (224, 0, 0, 2)); (Family_Inet, (224, 0, 0, 2));
Unspecified_Group_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6, (255, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
All_Hosts_Group_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6, (255, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1));
All_Routers_Group_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6, (255, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2));
No_Sock_Addr : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0); No_Sock_Addr : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0);
Max_Name_Length : constant := 64; Max_Name_Length : constant := 64;
...@@ -1291,8 +1446,8 @@ private ...@@ -1291,8 +1446,8 @@ private
end record; end record;
-- We need fixed strings to avoid access types in host entry type -- We need fixed strings to avoid access types in host entry type
type Name_Array is array (Natural range <>) of Name_Type; type Name_Array is array (Positive range <>) of Name_Type;
type Inet_Addr_Array is array (Natural range <>) of Inet_Addr_Type; type Inet_Addr_Array is array (Positive range <>) of Inet_Addr_Type;
type Host_Entry_Type (Aliases_Length, Addresses_Length : Natural) is record type Host_Entry_Type (Aliases_Length, Addresses_Length : Natural) is record
Official : Name_Type; Official : Name_Type;
......
...@@ -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,11 +74,13 @@ package GNAT.Sockets.Thin_Common is ...@@ -72,11 +74,13 @@ 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_Inet => SOSC.AF_INET,
Family_Inet6 => SOSC.AF_INET6); 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_Inet => SOSC.SIZEOF_sockaddr_in,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6); Family_Inet6 => SOSC.SIZEOF_sockaddr_in6);
---------------------------- ----------------------------
...@@ -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,29 +132,32 @@ package GNAT.Sockets.Thin_Common is ...@@ -144,29 +132,32 @@ 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);
-- Conversion functions
Inaddr_Any : aliased constant In_Addr := (others => 0); type In6_Addr is array (1 .. 16) of C.unsigned_char;
-- Any internet address (all the interfaces) for In6_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In6_Addr);
type In_Addr_Access_Array is array (C.size_t range <>) function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr;
of aliased In_Addr_Access; procedure To_Inet_Addr
pragma Convention (C, In_Addr_Access_Array); (Addr : In6_Addr;
Result : out Inet_Addr_Type);
-- Conversion functions
package In_Addr_Access_Pointers is new C.Pointers type Sockaddr (Family : Family_Type := Family_Inet) is record
(C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
-- Array of internet addresses
type Sockaddr_In 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
when Family_Inet =>
Sin_Addr : In_Addr := (others => 0);
-- IPv4 address -- IPv4 address
Sin_Zero : C.char_array (1 .. 8) := (others => C.nul); Sin_Zero : C.char_array (1 .. 8) := (others => C.nul);
...@@ -174,25 +165,31 @@ package GNAT.Sockets.Thin_Common is ...@@ -174,25 +165,31 @@ package GNAT.Sockets.Thin_Common is
-- --
-- Note that some platforms require that all unused (reserved) bytes -- Note that some platforms require that all unused (reserved) bytes
-- in addresses be initialized to 0 (e.g. VxWorks). -- 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
...@@ -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