From d47c8ef90093a92e7f6ad34365dd107a37697309 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Tue, 17 Jul 2018 08:07:26 +0000 Subject: [PATCH] [Ada] GNAT.Sockets: reorganize and make public components of Inet_Addr_Type 2018-07-17 Dmitriy Anisimkov gcc/ada/ * libgnat/g-socket.adb, libgnat/g-socket.ads: Reorganize and make public components of Inet_Addr_Type. Introduce public binary operations. From-SVN: r262780 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/libgnat/g-socket.adb | 136 +++++++++++++++++++++++++++++++++-- gcc/ada/libgnat/g-socket.ads | 62 +++++++++++----- 3 files changed, 180 insertions(+), 24 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index af38e50fa5f..9b9bdca6489 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-07-17 Dmitriy Anisimkov + + * libgnat/g-socket.adb, libgnat/g-socket.ads: Reorganize and make + public components of Inet_Addr_Type. Introduce public binary + operations. + 2018-07-17 Javier Miranda * exp_ch7.adb (Make_Transient_Block): When determining whether an diff --git a/gcc/ada/libgnat/g-socket.adb b/gcc/ada/libgnat/g-socket.adb index e1b311e24bb..721571fb8b9 100644 --- a/gcc/ada/libgnat/g-socket.adb +++ b/gcc/ada/libgnat/g-socket.adb @@ -144,8 +144,8 @@ package body GNAT.Sockets is -- Symmetric operation function Image - (Val : Inet_Addr_VN_Type; - Hex : Boolean := False) return String; + (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; @@ -275,6 +275,15 @@ package body GNAT.Sockets is -- Create_Selector has been called and Close_Selector has not been called, -- or the null selector. + function Create_Address + (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type + with Inline; + -- Creates address from family and Inet_Addr_Bytes array. + + function Get_Bytes (Addr : Inet_Addr_Type) return Inet_Addr_Bytes + with Inline; + -- Extract bytes from address + --------- -- "+" -- --------- @@ -1314,7 +1323,7 @@ package body GNAT.Sockets is ----------- function Image - (Val : Inet_Addr_VN_Type; + (Val : Inet_Addr_Bytes; Hex : Boolean := False) return String is -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It @@ -1381,9 +1390,9 @@ package body GNAT.Sockets is function Image (Value : Inet_Addr_Type) return String is begin if Value.Family = Family_Inet then - return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False); + return Image (Inet_Addr_Bytes (Value.Sin_V4), Hex => False); else - return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True); + return Image (Inet_Addr_Bytes (Value.Sin_V6), Hex => True); end if; end Image; @@ -2782,4 +2791,121 @@ package body GNAT.Sockets is -- The elaboration and finalization of this object perform the required -- initialization and cleanup actions for the sockets library. + -------------------- + -- Create_Address -- + -------------------- + + function Create_Address + (Family : Family_Type; Bytes : Inet_Addr_Bytes) return Inet_Addr_Type + is + (case Family is + when Family_Inet => (Family_Inet, Bytes), + when Family_Inet6 => (Family_Inet6, Bytes)); + + --------------- + -- 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); + + ---------- + -- Mask -- + ---------- + + function Mask + (Family : Family_Type; + Length : Natural; + Host : Boolean := False) return Inet_Addr_Type + is + Addr_Len : constant Natural := Inet_Addr_Bytes_Length (Family); + begin + if Length > 8 * Addr_Len then + raise Constraint_Error with + "invalid mask length for address family " & Family'Img; + end if; + + declare + B : Inet_Addr_Bytes (1 .. Addr_Len); + Part : Inet_Addr_Comp_Type; + begin + for J in 1 .. Length / 8 loop + B (J) := (if Host then 0 else 255); + end loop; + + if Length < 8 * Addr_Len then + Part := 2 ** (8 - Length mod 8) - 1; + B (Length / 8 + 1) := (if Host then Part else not Part); + + for J in Length / 8 + 2 .. B'Last loop + B (J) := (if Host then 255 else 0); + end loop; + end if; + + return Create_Address (Family, B); + end; + end Mask; + + ----------- + -- "and" -- + ----------- + + function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type is + begin + if Addr.Family /= Mask.Family then + raise Constraint_Error with "incompatible address families"; + end if; + + declare + A : constant Inet_Addr_Bytes := Get_Bytes (Addr); + M : constant Inet_Addr_Bytes := Get_Bytes (Mask); + R : Inet_Addr_Bytes (A'Range); + + begin + for J in A'Range loop + R (J) := A (J) and M (J); + end loop; + return Create_Address (Addr.Family, R); + end; + end "and"; + + ---------- + -- "or" -- + ---------- + + function "or" (Net, Host : Inet_Addr_Type) return Inet_Addr_Type is + begin + if Net.Family /= Host.Family then + raise Constraint_Error with "incompatible address families"; + end if; + + declare + N : constant Inet_Addr_Bytes := Get_Bytes (Net); + H : constant Inet_Addr_Bytes := Get_Bytes (Host); + R : Inet_Addr_Bytes (N'Range); + + begin + for J in N'Range loop + R (J) := N (J) or H (J); + end loop; + return Create_Address (Net.Family, R); + end; + end "or"; + + ----------- + -- "not" -- + ----------- + + function "not" (Mask : Inet_Addr_Type) return Inet_Addr_Type is + M : constant Inet_Addr_Bytes := Get_Bytes (Mask); + R : Inet_Addr_Bytes (M'Range); + begin + for J in R'Range loop + R (J) := not M (J); + end loop; + return Create_Address (Mask.Family, R); + end "not"; + end GNAT.Sockets; diff --git a/gcc/ada/libgnat/g-socket.ads b/gcc/ada/libgnat/g-socket.ads index 731e8374100..03b3f9548cf 100644 --- a/gcc/ada/libgnat/g-socket.ads +++ b/gcc/ada/libgnat/g-socket.ads @@ -489,7 +489,32 @@ package GNAT.Sockets is No_Port : constant Port_Type; -- Uninitialized port number - type Inet_Addr_Type (Family : Family_Type := Family_Inet) is private; + 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); + + type Inet_Addr_Bytes is array (Natural range <>) of Inet_Addr_Comp_Type; + + subtype Inet_Addr_V4_Type is + Inet_Addr_Bytes (1 .. Inet_Addr_Bytes_Length (Family_Inet)); + subtype Inet_Addr_V6_Type is + Inet_Addr_Bytes (1 .. Inet_Addr_Bytes_Length (Family_Inet6)); + + subtype Inet_Addr_VN_Type is Inet_Addr_Bytes; + -- For backwards compatibility + + type Inet_Addr_Type (Family : Family_Type := Family_Inet) is record + case Family is + when Family_Inet => + Sin_V4 : Inet_Addr_V4_Type := (others => 0); + + when Family_Inet6 => + Sin_V6 : Inet_Addr_V6_Type := (others => 0); + 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 @@ -506,6 +531,23 @@ package GNAT.Sockets is All_Hosts_Group_Inet_Addr : constant Inet_Addr_Type; All_Routers_Group_Inet_Addr : constant Inet_Addr_Type; + -- Functions to handle masks and prefixes + + function Mask + (Family : Family_Type; + Length : Natural; + Host : Boolean := False) return Inet_Addr_Type; + -- Return an address mask of the given family with the given prefix length. + -- If Host is False, this is a network mask (i.e. network bits are 1, + -- and host bits are 0); if Host is True, this is a host mask (i.e. + -- network bits are 0, and host bits are 1). + + function "and" (Addr, Mask : Inet_Addr_Type) return Inet_Addr_Type; + function "or" (Net, Host : Inet_Addr_Type) return Inet_Addr_Type; + function "not" (Mask : Inet_Addr_Type) return Inet_Addr_Type; + -- Bit-wise operations on inet addresses (both operands must have the + -- same address family). + type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record Addr : Inet_Addr_Type (Family); Port : Port_Type; @@ -1213,24 +1255,6 @@ private -- undefined if Last = No_Socket. end record; - subtype Inet_Addr_Comp_Type is Natural range 0 .. 255; - -- Octet for Internet address - - type Inet_Addr_VN_Type is array (Natural range <>) of Inet_Addr_Comp_Type; - - subtype Inet_Addr_V4_Type is Inet_Addr_VN_Type (1 .. 4); - subtype Inet_Addr_V6_Type is Inet_Addr_VN_Type (1 .. 16); - - type Inet_Addr_Type (Family : Family_Type := Family_Inet) is record - case Family is - when Family_Inet => - Sin_V4 : Inet_Addr_V4_Type := (others => 0); - - when Family_Inet6 => - Sin_V6 : Inet_Addr_V6_Type := (others => 0); - end case; - end record; - Any_Port : constant Port_Type := 0; No_Port : constant Port_Type := 0; -- 2.30.2