------------------------------------------------------------------------------ -- -- -- GNAT COMPILER COMPONENTS -- -- -- -- G N A T . S O C K E T S . T H I N _ C O M M O N -- -- -- -- B o d y -- -- -- -- Copyright (C) 2008-2022, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 3, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- -- or FITNESS FOR A PARTICULAR PURPOSE. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are granted -- -- additional permissions described in the GCC Runtime Library Exception, -- -- version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- GNAT was originally developed by the GNAT team at New York University. -- -- Extensive contributions were provided by Ada Core Technologies Inc. -- -- -- ------------------------------------------------------------------------------ package body GNAT.Sockets.Thin_Common is ----------------- -- Set_Address -- ----------------- procedure Set_Address (Sin : Sockaddr_Access; Address : Sock_Addr_Type; Length : out C.int) is use type C.char; function Network_Port return C.unsigned_short is (Short_To_Network (C.unsigned_short (Address.Port))) with Inline; begin Set_Family (Sin.Sin_Family, Address.Family); Length := C.int (Lengths (Address.Family)); case Address.Family is when Family_Inet => Sin.Sin_Port := Network_Port; Sin.Sin_Addr := To_In_Addr (Address.Addr); when Family_Inet6 => Sin.Sin6_Port := Network_Port; Sin.Sin6_Addr := To_In6_Addr (Address.Addr); Sin.Sin6_Scope_Id := 0; when Family_Unix => declare use type C.size_t; Name_Len : constant C.size_t := C.size_t (ASU.Length (Address.Name)); begin Length := Sockaddr_Length_And_Family'Size / System.Storage_Unit + C.int (Name_Len); if Name_Len > Sin.Sun_Path'Length then raise Constraint_Error with "Too big address length for UNIX local communication"; end if; if Name_Len = 0 then Sin.Sun_Path (1) := C.nul; else Sin.Sun_Path (1 .. Name_Len) := C.To_C (ASU.To_String (Address.Name), Append_Nul => False); if Sin.Sun_Path (1) /= C.nul and then Name_Len < Sin.Sun_Path'Length then Sin.Sun_Path (Name_Len + 1) := C.nul; Length := Length + 1; end if; end if; end; when Family_Unspec => null; end case; end Set_Address; ----------------- -- Get_Address -- ----------------- function Get_Address (Sin : Sockaddr; Length : C.int) return Sock_Addr_Type is use type C.unsigned_short, C.size_t, C.char, SOSC.OS_Type; 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 (if SOSC.AF_INET6 > 0 and then SOSC.AF_INET6 = Family then Family_Inet6 elsif SOSC.AF_UNIX > 0 and then SOSC.AF_UNIX = Family then Family_Unix elsif SOSC.AF_INET = Family then Family_Inet else Family_Unspec); begin case Result.Family is when Family_Inet => Result.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); To_Inet_Addr (Sin.Sin_Addr, Result.Addr); when Family_Inet6 => Result.Port := Port_Type (Network_To_Short (Sin.Sin6_Port)); To_Inet_Addr (Sin.Sin6_Addr, Result.Addr); when Family_Unix => if Length > Sin.Sin_Family'Size / System.Storage_Unit then Result.Name := ASU.To_Unbounded_String (C.To_Ada (Sin.Sun_Path (1 .. C.size_t (Length) - Sin.Sin_Family'Size / System.Storage_Unit), Trim_Nul => Sin.Sun_Path (1) /= C.nul or else SOSC.Target_OS = SOSC.Windows)); end if; when Family_Unspec => null; end case; return Result; end Get_Address; ---------------- -- Set_Family -- ---------------- procedure Set_Family (Length_And_Family : out Sockaddr_Length_And_Family; Family : Family_Type) is C_Family : C.int renames Families (Family); Has_Sockaddr_Len : constant Boolean := SOSC.Has_Sockaddr_Len /= 0; begin if Has_Sockaddr_Len then Length_And_Family.Length := Lengths (Family); Length_And_Family.Char_Family := C.unsigned_char (C_Family); else Length_And_Family.Short_Family := C.unsigned_short (C_Family); end if; end Set_Family; ---------------- -- 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 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;