+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
#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
# 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) */
with Ada.Streams; use Ada.Streams;
with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Containers.Generic_Array_Sort;
with Ada.Finalization;
with Ada.Unchecked_Conversion;
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;
Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
-- Correspondence tables
Levels : constant array (Level_Type) of C.int :=
- (Socket_Level => SOSC.SOL_SOCKET,
- IP_Protocol_For_IP_Level => SOSC.IPPROTO_IP,
- IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
- IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP);
+ (Socket_Level => SOSC.SOL_SOCKET,
+ 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_TCP_Level => SOSC.IPPROTO_TCP);
Modes : constant array (Mode_Type) of C.int :=
(Socket_Stream => SOSC.SOCK_STREAM,
Linger => SOSC.SO_LINGER,
Error => SOSC.SO_ERROR,
No_Delay => SOSC.TCP_NODELAY,
- Add_Membership => SOSC.IP_ADD_MEMBERSHIP,
- Drop_Membership => SOSC.IP_DROP_MEMBERSHIP,
- Multicast_If => SOSC.IP_MULTICAST_IF,
- Multicast_TTL => SOSC.IP_MULTICAST_TTL,
- Multicast_Loop => SOSC.IP_MULTICAST_LOOP,
+ Add_Membership_V4 => SOSC.IP_ADD_MEMBERSHIP,
+ Drop_Membership_V4 => SOSC.IP_DROP_MEMBERSHIP,
+ Multicast_If_V4 => SOSC.IP_MULTICAST_IF,
+ Multicast_Loop_V4 => SOSC.IP_MULTICAST_LOOP,
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,
Receive_Timeout => SOSC.SO_RCVTIMEO,
Busy_Polling => SOSC.SO_BUSY_POLL);
Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
Host_Error_Id : constant Exception_Id := Host_Error'Identity;
- Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF";
- -- Use to print in hexadecimal format
+ type In_Addr_Union (Family : Family_Type) is record
+ 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 --
function Set_Forced_Flags (F : C.int) return C.int;
-- 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;
pragma Inline (Netdb_Lock);
procedure Netdb_Unlock;
-- Lock/unlock operation used to protect netdb access for platforms that
-- require such protection.
- function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr;
- procedure To_Inet_Addr
- (Addr : In_Addr;
- Result : out Inet_Addr_Type);
- -- Conversion functions
-
function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type;
-- Conversion function
-- Reconstruct a Duration value from a Timeval record (seconds and
-- 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);
-- Raise Socket_Error with an exception message describing the error code
-- from errno.
-- hstrerror seems to be obsolete) from h_errno. Name is the name
-- 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);
-- Update Last as it may be greater than the real last socket
Address : out Sock_Addr_Type)
is
Res : C.int;
- Sin : aliased Sockaddr_In;
+ Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8;
begin
end if;
Socket := Socket_Type (Res);
-
- To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
- Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+ Address := Get_Address (Sin);
end Accept_Socket;
-------------------
Address : Sock_Addr_Type)
is
Res : C.int;
- Sin : aliased Sockaddr_In;
+ Sin : aliased Sockaddr;
Len : constant C.int := Sin'Size / 8;
- -- This assumes that Address.Family = Family_Inet???
begin
- if Address.Family = Family_Inet6 then
- 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)));
+ Set_Address (Sin'Unchecked_Access, Address);
Res := C_Bind (C.int (Socket), Sin'Address, Len);
----------------------
procedure Check_For_Fd_Set (Fd : Socket_Type) is
- use SOSC;
-
begin
-- On Windows, fd_set is a FD_SETSIZE array of socket ids:
-- no check required. Warnings suppressed because condition
-- is known at compile time.
- if Target_OS = Windows then
+ if Is_Windows then
return;
(Socket : Socket_Type;
Server : Sock_Addr_Type) return C.int
is
- Sin : aliased Sockaddr_In;
+ Sin : aliased Sockaddr;
Len : constant C.int := Sin'Size / 8;
begin
- if Server.Family = Family_Inet6 then
- 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)));
+ Set_Address (Sin'Unchecked_Access, Server);
return C_Connect (C.int (Socket), Sin'Address, Len);
end Connect_Socket;
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)
is
Res : C.int;
begin
- Res := C_Socket (Families (Family), Modes (Mode), 0);
+ Res := C_Socket (Families (Family), Modes (Mode), Levels (Level));
if Res = Failure then
Raise_Socket_Error (Socket_Errno);
end if;
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 --
-------------------------
is
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;
Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
Res : aliased Hostent;
Err : aliased C.int;
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;
- if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET,
- Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+ 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
then
Netdb_Unlock;
Raise_Host_Error (Integer (Err), Image (Address));
-- If the given name actually is the string representation of
-- 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));
end if;
-------------------
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;
- Res : Sock_Addr_Type (Family_Inet);
-
begin
if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
Raise_Socket_Error (Socket_Errno);
end if;
- To_Inet_Addr (Sin.Sin_Addr, Res.Addr);
- Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
-
- return Res;
+ return Get_Address (Sin);
end Get_Peer_Name;
-------------------------
function Get_Socket_Name
(Socket : Socket_Type) return Sock_Addr_Type
is
- Sin : aliased Sockaddr_In;
- Len : aliased C.int := Sin'Size / 8;
- Res : C.int;
- Addr : Sock_Addr_Type := No_Sock_Addr;
-
+ Sin : aliased Sockaddr;
+ Len : aliased C.int := Sin'Size / 8;
+ Res : C.int;
begin
Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
- if Res /= Failure then
- To_Inet_Addr (Sin.Sin_Addr, Addr.Addr);
- Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+ if Res = Failure then
+ return No_Sock_Addr;
end if;
- return Addr;
+ return Get_Address (Sin);
end Get_Socket_Name;
-----------------------
Name : Option_Name;
Optname : Interfaces.C.int := -1) return Option_Type
is
- use SOSC;
use type C.unsigned;
use type C.unsigned_char;
end if;
case Name is
- when Multicast_Loop
- | Multicast_TTL
+ when Multicast_TTL
| Receive_Packet_Info
=>
Len := V1'Size / 8;
| Error
| Generic_Option
| Keep_Alive
- | Multicast_If
+ | Multicast_If_V4
+ | Multicast_If_V6
+ | Multicast_Loop_V4
+ | Multicast_Loop_V6
+ | Multicast_Hops
| No_Delay
| Receive_Buffer
| Reuse_Address
| Send_Buffer
+ | IPv6_Only
=>
Len := V4'Size / 8;
Add := V4'Address;
-- struct timeval, but on Windows it is a milliseconds count in
-- a DWORD.
- if Target_OS = Windows then
+ if Is_Windows then
Len := U4'Size / 8;
Add := U4'Address;
-
else
Len := VT'Size / 8;
Add := VT'Address;
end if;
- when Add_Membership
- | Drop_Membership
- | Linger
+ when Add_Membership_V4
+ | Add_Membership_V6
+ | 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;
Add := V8'Address;
| Keep_Alive
| No_Delay
| Reuse_Address
+ | Multicast_Loop_V4
+ | Multicast_Loop_V6
+ | IPv6_Only
=>
Opt.Enabled := (V4 /= 0);
when Error =>
Opt.Error := Resolve_Error (Integer (V4));
- when Add_Membership
- | Drop_Membership
+ when Add_Membership_V4
+ | Add_Membership_V6
+ | Drop_Membership_V4
+ | Drop_Membership_V6
=>
- To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address);
- To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface);
+ -- No way to be here. Exception raised in the first case Name
+ -- expression.
+ null;
- when Multicast_If =>
+ when Multicast_If_V4 =>
To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
+ when Multicast_If_V6 =>
+ Opt.Outgoing_If_Index := Natural (V4);
+
when Multicast_TTL =>
Opt.Time_To_Live := Integer (V1);
- when Multicast_Loop
- | Receive_Packet_Info
+ when Multicast_Hops =>
+ Opt.Hop_Limit := Integer (V4);
+
+ when Receive_Packet_Info
=>
Opt.Enabled := (V1 /= 0);
when Receive_Timeout
| Send_Timeout
=>
- if Target_OS = Windows then
+ if Is_Windows then
-- Timeout is in milliseconds, actual value is 500 ms +
-- returned value (unless it is 0).
-- Image --
-----------
- function Image
- (Val : Inet_Addr_Bytes;
- Hex : Boolean := False) return String
- is
- -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It
- -- has at most a length of 3 plus one '.' character.
-
- Buffer : String (1 .. 4 * Val'Length);
- Length : Natural := 1;
- Separator : Character;
-
- procedure Img10 (V : Inet_Addr_Comp_Type);
- -- Append to Buffer image of V in decimal format
-
- procedure Img16 (V : Inet_Addr_Comp_Type);
- -- Append to Buffer image of V in hexadecimal format
-
- -----------
- -- Img10 --
- -----------
-
- 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
- Buffer (Length) := Separator;
- Length := Length + 1;
- end if;
- end loop;
-
- return Buffer (1 .. Length - 1);
- 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);
+ use type CS.char_array_access;
+ Size : constant socklen_t :=
+ (case Value.Family is
+ when Family_Inet => 4 * Value.Sin_V4'Length,
+ when Family_Inet6 => 6 * 5 + 4 * 4,
+ -- 1234:1234:1234:1234:1234:1234:123.123.123.123
+ when Family_Unspec => 0);
+ Dst : aliased C.char_array := (1 .. C.size_t (Size) => C.nul);
+ Ia : aliased In_Addr_Union (Value.Family);
+ begin
+ case Value.Family is
+ when Family_Inet6 =>
+ Ia.In6 := To_In6_Addr (Value);
+ when Family_Inet =>
+ Ia.In4 := To_In_Addr (Value);
+ when Family_Unspec =>
+ return "";
+ end case;
+
+ if Inet_Ntop
+ (Families (Value.Family), Ia'Address,
+ Dst'Unchecked_Access, Size) = null
+ then
+ Raise_Socket_Error (Socket_Errno);
end if;
+
+ return C.To_Ada (Dst);
end Image;
-----------
function Image (Value : Sock_Addr_Type) return String is
Port : constant String := Value.Port'Img;
+ function Ipv6_Brackets (S : String) return String is
+ (if Value.Family = Family_Inet6 then "[" & S & "]" else S);
begin
- return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
+ return Ipv6_Brackets (Image (Value.Addr)) & ':' & Port (2 .. Port'Last);
end Image;
-----------
use Interfaces.C;
Img : aliased char_array := To_C (Image);
- Addr : aliased C.int;
Res : C.int;
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
-- Special case for an empty Image as on some platforms (e.g. Windows)
-- calling Inet_Addr("") will not return an error.
Raise_Socket_Error (SOSC.EINVAL);
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
Raise_Socket_Error (Socket_Errno);
Raise_Socket_Error (SOSC.EINVAL);
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;
end Inet_Addr;
null;
end Initialize;
+ ----------------
+ -- Is_Windows --
+ ----------------
+
+ function Is_Windows return Boolean is
+ use SOSC;
+ begin
+ return Target_OS = Windows;
+ end Is_Windows;
+
--------------
-- Is_Empty --
--------------
return Item.Last = No_Socket;
end Is_Empty;
- -------------------
- -- Is_IP_Address --
- -------------------
+ ---------------------
+ -- Is_IPv6_Address --
+ ---------------------
- function Is_IP_Address (Name : String) return Boolean is
+ 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;
+
+ return Colons <= 7;
+ end Is_IPv6_Address;
+
+ ---------------------
+ -- Is_IPv4_Address --
+ ---------------------
+
+ function Is_IPv4_Address (Name : String) return Boolean is
Dots : Natural := 0;
begin
end loop;
return Dots in 1 .. 3;
- end Is_IP_Address;
+ end Is_IPv4_Address;
-------------
-- Is_Open --
----------------------
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
raise Host_Error with
Err_Code_Image (H_Error)
Flags : Request_Flag_Type := No_Request_Flag)
is
Res : C.int;
- Sin : aliased Sockaddr_In;
+ Sin : aliased Sockaddr;
Len : aliased C.int := Sin'Size / 8;
begin
Last := Last_Index (First => Item'First, Count => size_t (Res));
- To_Inet_Addr (Sin.Sin_Addr, From.Addr);
- From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+ From := Get_Address (Sin);
end Receive_Socket;
--------------------
is
Res : C.int;
- Sin : aliased Sockaddr_In;
+ Sin : aliased Sockaddr;
C_To : System.Address;
Len : C.int;
begin
if To /= null then
- Set_Family (Sin.Sin_Family, To.Family);
- Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
- Set_Port
- (Sin'Unchecked_Access,
- Short_To_Network (C.unsigned_short (To.Port)));
+ Set_Address (Sin'Unchecked_Access, To.all);
C_To := Sin'Address;
Len := Sin'Size / 8;
Level : Level_Type := Socket_Level;
Option : Option_Type)
is
- use SOSC;
use type C.unsigned;
+ MR : aliased IPV6_Mreq;
V8 : aliased Two_Ints;
V4 : aliased C.int;
U4 : aliased C.unsigned;
| Keep_Alive
| No_Delay
| Reuse_Address
+ | Multicast_Loop_V4
+ | Multicast_Loop_V6
+ | IPv6_Only
=>
V4 := C.int (Boolean'Pos (Option.Enabled));
Len := V4'Size / 8;
Len := V4'Size / 8;
Add := V4'Address;
- when Add_Membership
- | Drop_Membership
+ when Add_Membership_V4
+ | Drop_Membership_V4
=>
V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
Len := V8'Size / 8;
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));
Len := V4'Size / 8;
Add := V4'Address;
+ when Multicast_If_V6 =>
+ V4 := C.int (Option.Outgoing_If_Index);
+ Len := V4'Size / 8;
+ Add := V4'Address;
+
when Multicast_TTL =>
V1 := C.unsigned_char (Option.Time_To_Live);
Len := V1'Size / 8;
Add := V1'Address;
- when Multicast_Loop
- | Receive_Packet_Info
+ when Multicast_Hops =>
+ 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));
Len := V1'Size / 8;
when Receive_Timeout
| Send_Timeout
=>
- if Target_OS = Windows then
+ if Is_Windows then
-- On Windows, the timeout is a DWORD in milliseconds, and
-- the actual timeout is 500 ms + the given value (unless it
end if;
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 --
---------------------
-------------------
function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is
- use type C.size_t;
-
Aliases_Count, Addresses_Count : Natural;
- -- H_Length is not used because it is currently only ever set to 4, as
- -- we only handle the case of H_Addrtype being AF_INET.
+ Family : constant Family_Type :=
+ (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
- if Hostent_H_Addrtype (E) /= SOSC.AF_INET then
+ if Family = Family_Unspec then
Raise_Socket_Error (SOSC.EPFNOSUPPORT);
end if;
for J in Result.Addresses'Range loop
declare
- Addr : In_Addr;
+ Ia : In_Addr_Union (Family);
-- Hostent_H_Addr (E, <index>) may return an address that is
-- not correctly aligned for In_Addr, so we need to use
-- an intermediate copy operation on a type with an alignment
-- 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;
for Unaligned_Addr'Address
use Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
pragma Import (Ada, Unaligned_Addr);
Aligned_Addr : Addr_Buf_T;
- for Aligned_Addr'Address use Addr'Address;
+ for Aligned_Addr'Address use Ia'Address;
pragma Import (Ada, Aligned_Addr);
begin
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 loop;
end return;
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 --
------------
is
(case Family is
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 --
function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes is
(case Addr.Family is
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 --
-- 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
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;
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
+
+ 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;
+ -- 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
- -- Useful constants for IPv4 multicast addresses
+ All_Routers_Group_Inet_Addr : constant Inet_Addr_Type;
+ -- Multicast group addresses all routers on the same network segment
- 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;
+ 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
-- 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
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);
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 =>
Linger |
No_Delay |
Receive_Packet_Info |
- Multicast_Loop =>
+ IPv6_Only |
+ Multicast_Loop_V4 |
+ Multicast_Loop_V6 =>
Enabled : Boolean;
case Name 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;
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
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));
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;
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;
-----------------
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 --
----------------
end if;
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
- (Sin : Sockaddr_In_Access;
- Port : C.unsigned_short)
+ procedure To_Inet_Addr
+ (Addr : In6_Addr;
+ Result : out Inet_Addr_Type)
is
+ Sin_V6 : Inet_Addr_V6_Type;
begin
- Sin.Sin_Port := Port;
- end Set_Port;
+ 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;
-- 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;
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);
-------------------------------------------
-------------------------------------------
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 --
-- 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 --
----------------------------
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
-
- Inaddr_Any : aliased constant In_Addr := (others => 0);
- -- Any internet address (all the interfaces)
+ 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
- type In_Addr_Access_Array is array (C.size_t range <>)
- of aliased In_Addr_Access;
- pragma Convention (C, In_Addr_Access_Array);
+ type In6_Addr is array (1 .. 16) of C.unsigned_char;
+ for In6_Addr'Alignment use C.int'Alignment;
+ pragma Convention (C, In6_Addr);
- package In_Addr_Access_Pointers is new C.Pointers
- (C.size_t, In_Addr_Access, In_Addr_Access_Array, null);
- -- Array of internet addresses
+ 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
- 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
-
- 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).
+ 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).
+ 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 --
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 --
------------------------------------
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");
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");
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
#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")
+
/*
------------------
#endif
CND(SOCK_DGRAM, "Datagram socket")
+#ifndef SOCK_RAW
+# define SOCK_RAW -1
+#endif
+CND(SOCK_RAW, "Raw socket")
+
/*
-----------------
#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
#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")
+
/*
----------------------
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
#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 */
/*
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
-\f
+
+#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
(void) signal (SIGPIPE, SIG_IGN);
#endif
}
-\f
+
#if defined (_WIN32) || defined (__vxworks)
/*
* Signalling FDs operations are implemented in Ada for these platforms
__gnat_create_signalling_fds (int *fds) {
return pipe (fds);
}
-\f
+
/*
* Read one byte of data from rsig, the read end of a pair of signalling fds
* created by __gnat_create_signalling_fds.
char c;
return read (rsig, &c, 1);
}
-\f
+
/*
* Write one byte of data to wsig, the write end of a pair of signalling fds
* created by __gnat_create_signalling_fds.
char c = 0;
return write (wsig, &c, 1);
}
-\f
+
/*
* Close one end of a pair of signalling fds
*/
(void) close (sig);
}
#endif
-\f
+
/*
* Handling of gethostbyname, gethostbyaddr, getservbyname and getservbyport
* =========================================================================
return 0;
}
#endif
-\f
+
/* 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
}
#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.
*/
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) */
projects / gcc.git / commitdiff