diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fd56c3aae97..aab6ceb5c25 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,85 @@ +2018-12-11 Dmitriy Anisimkov + + * 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 * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Deactivate diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h index 8b85854be8a..ab441487fe5 100644 --- a/gcc/ada/gsocket.h +++ b/gcc/ada/gsocket.h @@ -63,10 +63,19 @@ #include #include #include + #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) */ diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index 2a5047d399c..8a7783aeb19 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -31,6 +31,7 @@ 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; @@ -50,6 +51,12 @@ package body GNAT.Sockets is 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; @@ -62,10 +69,11 @@ package body GNAT.Sockets is -- 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, @@ -89,12 +97,18 @@ package body GNAT.Sockets is 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); @@ -110,8 +124,16 @@ package body GNAT.Sockets is 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 -- @@ -133,24 +155,6 @@ package body GNAT.Sockets is 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; @@ -158,12 +162,6 @@ package body GNAT.Sockets is -- 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 @@ -180,6 +178,12 @@ package body GNAT.Sockets is -- 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. @@ -189,6 +193,13 @@ package body GNAT.Sockets is -- 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 @@ -328,7 +339,7 @@ package body GNAT.Sockets is Address : out Sock_Addr_Type) is Res : C.int; - Sin : aliased Sockaddr_In; + Sin : aliased Sockaddr; Len : aliased C.int := Sin'Size / 8; begin @@ -339,9 +350,7 @@ package body GNAT.Sockets is 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; ------------------- @@ -451,20 +460,11 @@ package body GNAT.Sockets is 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); @@ -478,14 +478,12 @@ package body GNAT.Sockets is ---------------------- 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; @@ -667,19 +665,11 @@ package body GNAT.Sockets is (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; @@ -861,12 +851,13 @@ package body GNAT.Sockets is 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); @@ -959,6 +950,228 @@ package body GNAT.Sockets is 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 -- ------------------------- @@ -969,17 +1182,33 @@ package body GNAT.Sockets is 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)); @@ -1007,7 +1236,7 @@ package body GNAT.Sockets is -- 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; @@ -1041,19 +1270,14 @@ package body GNAT.Sockets is ------------------- function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is - Sin : aliased Sockaddr_In; + Sin : aliased Sockaddr; Len : aliased C.int := Sin'Size / 8; - 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; ------------------------- @@ -1127,20 +1351,17 @@ package body GNAT.Sockets is 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; ----------------------- @@ -1153,7 +1374,6 @@ package body GNAT.Sockets is Name : Option_Name; Optname : Interfaces.C.int := -1) return Option_Type is - use SOSC; use type C.unsigned; use type C.unsigned_char; @@ -1180,8 +1400,7 @@ package body GNAT.Sockets is end if; case Name is - when Multicast_Loop - | Multicast_TTL + when Multicast_TTL | Receive_Packet_Info => Len := V1'Size / 8; @@ -1192,11 +1411,16 @@ package body GNAT.Sockets is | 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; @@ -1208,18 +1432,23 @@ package body GNAT.Sockets is -- 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; @@ -1245,6 +1474,9 @@ package body GNAT.Sockets is | Keep_Alive | No_Delay | Reuse_Address + | Multicast_Loop_V4 + | Multicast_Loop_V6 + | IPv6_Only => Opt.Enabled := (V4 /= 0); @@ -1263,27 +1495,35 @@ package body GNAT.Sockets is 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). @@ -1324,78 +1564,34 @@ package body GNAT.Sockets is -- 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 + 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 - 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); + 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; ----------- @@ -1404,8 +1600,10 @@ package body GNAT.Sockets is 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; ----------- @@ -1456,10 +1654,11 @@ package body GNAT.Sockets is 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. @@ -1468,7 +1667,9 @@ package body GNAT.Sockets is 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); @@ -1477,7 +1678,12 @@ package body GNAT.Sockets is 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; @@ -1527,6 +1733,16 @@ package body GNAT.Sockets is null; end Initialize; + ---------------- + -- Is_Windows -- + ---------------- + + function Is_Windows return Boolean is + use SOSC; + begin + return Target_OS = Windows; + end Is_Windows; + -------------- -- Is_Empty -- -------------- @@ -1536,11 +1752,56 @@ package body GNAT.Sockets is 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 @@ -1571,7 +1832,7 @@ package body GNAT.Sockets is end loop; return Dots in 1 .. 3; - end Is_IP_Address; + end Is_IPv4_Address; ------------- -- Is_Open -- @@ -1760,13 +2021,6 @@ package body GNAT.Sockets is ---------------------- procedure Raise_Host_Error (H_Error : Integer; Name : String) is - function Dedot (Value : String) return String is - (if Value /= "" and then Value (Value'Last) = '.' then - Value (Value'First .. Value'Last - 1) - else - Value); - -- Removes dot at the end of error message - begin raise Host_Error with Err_Code_Image (H_Error) @@ -1863,7 +2117,7 @@ package body GNAT.Sockets is 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 @@ -1882,8 +2136,7 @@ package body GNAT.Sockets is 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; -------------------- @@ -2142,17 +2395,13 @@ package body GNAT.Sockets is 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; @@ -2294,9 +2543,9 @@ package body GNAT.Sockets is 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; @@ -2318,6 +2567,9 @@ package body GNAT.Sockets is | 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; @@ -2346,26 +2598,42 @@ package body GNAT.Sockets is 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; @@ -2374,7 +2642,7 @@ package body GNAT.Sockets is 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 @@ -2420,28 +2688,6 @@ package body GNAT.Sockets is 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 -- --------------------- @@ -2538,15 +2784,18 @@ package body GNAT.Sockets is ------------------- 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; @@ -2574,61 +2823,35 @@ package body GNAT.Sockets is for J in Result.Addresses'Range loop declare - Addr : In_Addr; + Ia : In_Addr_Union (Family); -- Hostent_H_Addr (E, ) 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 -- ------------ @@ -2825,7 +3048,8 @@ package body GNAT.Sockets is 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 -- @@ -2834,7 +3058,8 @@ package body GNAT.Sockets is 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 -- diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads index 964a180d981..9ba12878f4c 100644 --- a/gcc/ada/libgnat/g-socket.ads +++ b/gcc/ada/libgnat/g-socket.ads @@ -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; diff --git a/gcc/ada/libgnat/g-sothco.adb b/gcc/ada/libgnat/g-sothco.adb index 7c0abc6f0fd..1dced107dee 100644 --- a/gcc/ada/libgnat/g-sothco.adb +++ b/gcc/ada/libgnat/g-sothco.adb @@ -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; diff --git a/gcc/ada/libgnat/g-sothco.ads b/gcc/ada/libgnat/g-sothco.ads index 2befdbe0f8a..03d20b579a7 100644 --- a/gcc/ada/libgnat/g-sothco.ads +++ b/gcc/ada/libgnat/g-sothco.ads @@ -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"); diff --git a/gcc/ada/libgnat/g-stsifd__sockets.adb b/gcc/ada/libgnat/g-stsifd__sockets.adb index b4e1abee37b..cd5dce4fa03 100644 --- a/gcc/ada/libgnat/g-stsifd__sockets.adb +++ b/gcc/ada/libgnat/g-stsifd__sockets.adb @@ -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 diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index 4d224509caa..448155b2ed3 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -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 */ /* diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index ed5b8dff04b..7f2b5ff8424 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -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) */