[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
This commit is contained in:
Dmitriy Anisimkov 2018-12-11 11:12:32 +00:00 committed by Pierre-Marie de Rodat
parent d71b0a9a04
commit 759f164802
9 changed files with 1440 additions and 370 deletions

View file

@ -1,3 +1,85 @@
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>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Deactivate

View file

@ -63,10 +63,19 @@
#include <vxWorks.h>
#include <ioLib.h>
#include <hostLib.h>
#define SHUT_RD 0
#define SHUT_WR 1
#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)
#define FD_SETSIZE 1024
@ -250,8 +259,9 @@
# define Has_Sockaddr_Len 0
#endif
#if !(defined (__vxworks) || defined (_WIN32) || defined (__hpux__) || defined (VMS))
#if !(defined (_WIN32) || defined (__hpux__) || defined (VMS))
# define HAVE_INET_PTON
# define HAVE_INET_NTOP
#endif
#endif /* defined(VTHREADS) */

File diff suppressed because it is too large Load diff

View file

@ -469,13 +469,17 @@ package GNAT.Sockets 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.
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
-- 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);
-- Stream sockets provide connection-oriented byte streams. Datagram
-- 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);
-- When a process closes a socket, the policy is to retain any data queued
@ -497,8 +501,8 @@ package GNAT.Sockets is
type Inet_Addr_Comp_Type is mod 2 ** 8;
-- Octet for Internet address
Inet_Addr_Bytes_Length : constant array (Family_Type) of Positive :=
(Family_Inet => 4, Family_Inet6 => 16);
Inet_Addr_Bytes_Length : constant array (Family_Type) of Natural :=
(Family_Inet => 4, Family_Inet6 => 16, Family_Unspec => 0);
type Inet_Addr_Bytes is array (Natural range <>) of Inet_Addr_Comp_Type;
@ -517,24 +521,61 @@ package GNAT.Sockets is
when Family_Inet6 =>
Sin_V6 : Inet_Addr_V6_Type := (others => 0);
when Family_Unspec =>
null;
end case;
end record;
-- 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
-- like a wildcard enabling all addresses. No_Inet_Addr provides a special
-- value to denote uninitialized inet addresses.
-- and IPv6 contains 16 octets).
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;
-- 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 destination address in the current network
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
Unspecified_Group_Inet_Addr : constant Inet_Addr_Type;
All_Hosts_Group_Inet_Addr : constant Inet_Addr_Type;
All_Routers_Group_Inet_Addr : constant Inet_Addr_Type;
-- Useful constants for multicast addresses
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;
-- 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;
-- 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
@ -563,18 +604,24 @@ package GNAT.Sockets is
-- for uninitialized socket addresses.
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;
-- Return an image of an Internet address. IPv4 notation consists in 4
-- octets in decimal format separated by dots. IPv6 notation consists in
-- 16 octets in hexadecimal format separated by colons (and possibly
-- dots).
-- 8 hextets in hexadecimal format separated by colons.
function Image (Value : Sock_Addr_Type) return String;
-- Return inet address image and port image separated by a colon
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.
-- Host entries provide complete information on a given host: the official
@ -723,6 +770,7 @@ package GNAT.Sockets is
type Level_Type is
(Socket_Level,
IP_Protocol_For_IP_Level,
IP_Protocol_For_IPv6_Level,
IP_Protocol_For_UDP_Level,
IP_Protocol_For_TCP_Level);
@ -740,18 +788,29 @@ package GNAT.Sockets is
Linger, -- Shutdown wait for msg to be sent or timeout occur
Error, -- Get and clear the pending socket error
No_Delay, -- Do not delay send to coalesce data (TCP_NODELAY)
Add_Membership, -- Join a multicast group
Drop_Membership, -- Leave a multicast group
Multicast_If, -- Set default out interface for multicast packets
Add_Membership_V4, -- Join a multicast group
Add_Membership_V6, -- Idem for IPv6 socket
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_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
Send_Timeout, -- Set timeout value for output
Receive_Timeout, -- Set timeout value for input
IPv6_Only, -- Restricted to IPv6 communications only
Busy_Polling); -- Set busy polling mode
subtype Specific_Option_Name is
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
case Name is
when Generic_Option =>
@ -764,7 +823,9 @@ package GNAT.Sockets is
Linger |
No_Delay |
Receive_Packet_Info |
Multicast_Loop =>
IPv6_Only |
Multicast_Loop_V4 |
Multicast_Loop_V6 =>
Enabled : Boolean;
case Name is
@ -784,17 +845,31 @@ package GNAT.Sockets is
when Error =>
Error : Error_Type;
when Add_Membership |
Drop_Membership =>
when Add_Membership_V4 |
Add_Membership_V6 |
Drop_Membership_V4 |
Drop_Membership_V6 =>
Multicast_Address : Inet_Addr_Type;
Local_Interface : Inet_Addr_Type;
case Name is
when Add_Membership_V4 |
Drop_Membership_V4 =>
Local_Interface : Inet_Addr_Type;
when others =>
Interface_Index : Natural;
end case;
when Multicast_If =>
when Multicast_If_V4 =>
Outgoing_If : Inet_Addr_Type;
when Multicast_TTL =>
when Multicast_If_V6 =>
Outgoing_If_Index : Natural;
when Multicast_TTL =>
Time_To_Live : Natural;
when Multicast_Hops =>
Hop_Limit : Integer range -1 .. 255;
when Send_Timeout |
Receive_Timeout =>
Timeout : Timeval_Duration;
@ -865,10 +940,76 @@ package GNAT.Sockets is
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
(Socket : out Socket_Type;
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
procedure Accept_Socket
@ -1265,12 +1406,19 @@ private
Any_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 0));
Any_Inet6_Addr : constant Inet_Addr_Type :=
(Family_Inet6, (others => 0));
No_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 0));
Unspecified_Addr : constant Inet_Addr_Type :=
(Family => Family_Unspec);
Broadcast_Inet_Addr : constant Inet_Addr_Type :=
(Family_Inet, (others => 255));
Loopback_Inet_Addr : constant Inet_Addr_Type :=
(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 :=
(Family_Inet, (224, 0, 0, 0));
@ -1279,6 +1427,13 @@ private
All_Routers_Group_Inet_Addr : constant Inet_Addr_Type :=
(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);
Max_Name_Length : constant := 64;
@ -1291,8 +1446,8 @@ private
end record;
-- We need fixed strings to avoid access types in host entry type
type Name_Array is array (Natural range <>) of Name_Type;
type Inet_Addr_Array is array (Natural range <>) of Inet_Addr_Type;
type Name_Array is array (Positive range <>) of Name_Type;
type Inet_Addr_Array is array (Positive range <>) of Inet_Addr_Type;
type Host_Entry_Type (Aliases_Length, Addresses_Length : Natural) is record
Official : Name_Type;

View file

@ -36,13 +36,52 @@ package body GNAT.Sockets.Thin_Common is
-----------------
procedure Set_Address
(Sin : Sockaddr_In_Access;
Address : In_Addr)
(Sin : Sockaddr_Access;
Address : Sock_Addr_Type)
is
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;
-----------------
-- 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 --
----------------
@ -62,16 +101,88 @@ package body GNAT.Sockets.Thin_Common is
end if;
end Set_Family;
--------------
-- Set_Port --
--------------
----------------
-- To_In_Addr --
----------------
procedure Set_Port
(Sin : Sockaddr_In_Access;
Port : C.unsigned_short)
is
function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is
begin
Sin.Sin_Port := Port;
end Set_Port;
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 To_Inet_Addr
(Addr : In6_Addr;
Result : out Inet_Addr_Type)
is
Sin_V6 : Inet_Addr_V6_Type;
begin
for J in Addr'Range loop
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;

View file

@ -33,13 +33,12 @@
-- This package should not be directly with'ed by an applications program.
with Ada.Unchecked_Conversion;
with Interfaces.C;
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
package GNAT.Sockets.Thin_Common is
package C renames Interfaces.C;
package CS renames C.Strings;
Success : constant C.int := 0;
Failure : constant C.int := -1;
@ -65,6 +64,9 @@ package GNAT.Sockets.Thin_Common is
type Timeval_Access is access all Timeval;
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);
-------------------------------------------
@ -72,12 +74,14 @@ package GNAT.Sockets.Thin_Common is
-------------------------------------------
Families : constant array (Family_Type) of C.int :=
(Family_Inet => SOSC.AF_INET,
Family_Inet6 => SOSC.AF_INET6);
(Family_Unspec => SOSC.AF_UNSPEC,
Family_Inet => SOSC.AF_INET,
Family_Inet6 => SOSC.AF_INET6);
Lengths : constant array (Family_Type) of C.unsigned_char :=
(Family_Inet => SOSC.SIZEOF_sockaddr_in,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6);
(Family_Unspec => 0,
Family_Inet => SOSC.SIZEOF_sockaddr_in,
Family_Inet6 => SOSC.SIZEOF_sockaddr_in6);
----------------------------
-- Generic socket address --
@ -112,22 +116,6 @@ package GNAT.Sockets.Thin_Common is
-- Set the family component to the appropriate value for Family, and also
-- 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 --
----------------------------
@ -144,55 +132,64 @@ package GNAT.Sockets.Thin_Common is
function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
function To_Int is new Ada.Unchecked_Conversion (In_Addr, C.int);
type In_Addr_Access is access all In_Addr;
pragma Convention (C, In_Addr_Access);
-- Access to internet address
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
Inaddr_Any : aliased constant In_Addr := (others => 0);
-- Any internet address (all the interfaces)
type In6_Addr is array (1 .. 16) of C.unsigned_char;
for In6_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In6_Addr);
type In_Addr_Access_Array is array (C.size_t range <>)
of aliased In_Addr_Access;
pragma Convention (C, In_Addr_Access_Array);
function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr;
procedure To_Inet_Addr
(Addr : In6_Addr;
Result : out Inet_Addr_Type);
-- Conversion functions
package In_Addr_Access_Pointers is new C.Pointers
(C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
-- Array of internet addresses
type Sockaddr_In is record
type Sockaddr (Family : Family_Type := Family_Inet) is record
Sin_Family : Sockaddr_Length_And_Family;
-- Address family (and address length on some platforms)
Sin_Port : C.unsigned_short;
-- Port in network byte order
Sin_Addr : In_Addr;
-- IPv4 address
case Family is
when Family_Inet =>
Sin_Addr : In_Addr := (others => 0);
-- IPv4 address
Sin_Zero : C.char_array (1 .. 8) := (others => C.nul);
-- Padding
--
-- Note that some platforms require that all unused (reserved) bytes
-- in addresses be initialized to 0 (e.g. VxWorks).
Sin_Zero : C.char_array (1 .. 8) := (others => C.nul);
-- Padding
--
-- Note that some platforms require that all unused (reserved) bytes
-- in addresses be initialized to 0 (e.g. VxWorks).
when Family_Inet6 =>
Sin6_FlowInfo : Interfaces.Unsigned_32 := 0;
Sin6_Addr : In6_Addr := (others => 0);
Sin6_Scope_Id : Interfaces.Unsigned_32 := 0;
when Family_Unspec =>
null;
end case;
end record;
pragma Convention (C, Sockaddr_In);
pragma Unchecked_Union (Sockaddr);
pragma Convention (C, Sockaddr);
-- Internet socket address
type Sockaddr_In_Access is access all Sockaddr_In;
pragma Convention (C, Sockaddr_In_Access);
type Sockaddr_Access is access all Sockaddr;
pragma Convention (C, Sockaddr_Access);
-- 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
(Sin : Sockaddr_In_Access;
Address : In_Addr);
pragma Inline (Set_Address);
-- Set Sin.Sin_Addr to Address
(Sin : Sockaddr_Access;
Address : Sock_Addr_Type);
-- Initialise all necessary fields in Sin from 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 --
@ -297,6 +294,51 @@ package GNAT.Sockets.Thin_Common is
Buf : System.Address;
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 --
------------------------------------
@ -375,11 +417,27 @@ package GNAT.Sockets.Thin_Common is
Cp : System.Address;
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
(Fd : C.int;
Req : SOSC.IOCTL_Req_T;
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
pragma Import (C, Get_Socket_From_Set, "__gnat_get_socket_from_set");
pragma Import (C, Is_Socket_In_Set, "__gnat_is_socket_in_set");
@ -389,12 +447,18 @@ private
pragma Import (C, Reset_Socket_Set, "__gnat_reset_socket_set");
pragma Import (C, C_Ioctl, "__gnat_socket_ioctl");
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_Gethostbyaddr, "__gnat_gethostbyaddr");
pragma Import (C, C_Getservbyname, "__gnat_getservbyname");
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_Alias, "__gnat_servent_s_alias");
pragma Import (C, Servent_S_Port, "__gnat_servent_s_port");

View file

@ -60,7 +60,7 @@ package body Signalling_Fds is
L_Sock, R_Sock, W_Sock : C.int := Failure;
-- Listening socket, read socket and write socket
Sin : aliased Sockaddr_In;
Sin : aliased Sockaddr;
Len : aliased C.int;
-- Address of listening socket

View file

@ -1056,6 +1056,138 @@ CND(AF_INET, "IPv4 address family")
#endif
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")
#endif
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")
#endif
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
# define IPPROTO_UDP -1
#endif
@ -1300,6 +1442,111 @@ CND(IP_DROP_MEMBERSHIP, "Leave a multicast group")
#endif
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")
CND(SIZEOF_sigset, "sigset")
#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
@ -1409,6 +1672,13 @@ C("Thread_Blocking_IO", Boolean, "True", "")
#endif
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 */
/*

View file

@ -90,10 +90,27 @@ extern int __gnat_hostent_h_addrtype (struct hostent *);
extern int __gnat_hostent_h_length (struct hostent *);
extern char * __gnat_hostent_h_addr (struct hostent *, int);
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
extern int __gnat_inet_pton (int, const char *, void *);
#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 */
void
@ -112,7 +129,7 @@ __gnat_disable_all_sigpipes (void)
(void) signal (SIGPIPE, SIG_IGN);
#endif
}
#if defined (_WIN32) || defined (__vxworks)
/*
* Signalling FDs operations are implemented in Ada for these platforms
@ -128,7 +145,7 @@ int
__gnat_create_signalling_fds (int *fds) {
return pipe (fds);
}
/*
* Read one byte of data from rsig, the read end of a pair of signalling fds
* created by __gnat_create_signalling_fds.
@ -138,7 +155,7 @@ __gnat_read_signalling_fd (int rsig) {
char c;
return read (rsig, &c, 1);
}
/*
* Write one byte of data to wsig, the write end of a pair of signalling fds
* created by __gnat_create_signalling_fds.
@ -148,7 +165,7 @@ __gnat_write_signalling_fd (int wsig) {
char c = 0;
return write (wsig, &c, 1);
}
/*
* Close one end of a pair of signalling fds
*/
@ -157,7 +174,7 @@ __gnat_close_signalling_fd (int sig) {
(void) close (sig);
}
#endif
/*
* Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport
* =========================================================================
@ -369,7 +386,7 @@ __gnat_getservbyport (int port, const char *proto,
return 0;
}
#endif
/* Find the largest socket in the socket set SET. This is needed for
`select'. LAST is the maximum value for the largest socket. This hint is
used to avoid scanning very large socket sets. On return, LAST is the
@ -572,6 +589,41 @@ __gnat_inet_pton (int af, const char *src, void *dst) {
}
#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.
*/
@ -650,4 +702,105 @@ __gnat_servent_s_proto (struct servent * s)
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) */