1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T . S O C K E T S . T H I N _ C O M M O N -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2008-2020, AdaCore -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. -- 17-- -- 18-- As a special exception under Section 7 of GPL version 3, you are granted -- 19-- additional permissions described in the GCC Runtime Library Exception, -- 20-- version 3.1, as published by the Free Software Foundation. -- 21-- -- 22-- You should have received a copy of the GNU General Public License and -- 23-- a copy of the GCC Runtime Library Exception along with this program; -- 24-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 25-- <http://www.gnu.org/licenses/>. -- 26-- -- 27-- GNAT was originally developed by the GNAT team at New York University. -- 28-- Extensive contributions were provided by Ada Core Technologies Inc. -- 29-- -- 30------------------------------------------------------------------------------ 31 32package body GNAT.Sockets.Thin_Common is 33 34 ----------------- 35 -- Set_Address -- 36 ----------------- 37 38 procedure Set_Address 39 (Sin : Sockaddr_Access; 40 Address : Sock_Addr_Type; 41 Length : out C.int) 42 is 43 use type C.char; 44 45 function Network_Port return C.unsigned_short is 46 (Short_To_Network (C.unsigned_short (Address.Port))) with Inline; 47 48 begin 49 Set_Family (Sin.Sin_Family, Address.Family); 50 51 Length := C.int (Lengths (Address.Family)); 52 53 case Address.Family is 54 when Family_Inet => 55 Sin.Sin_Port := Network_Port; 56 Sin.Sin_Addr := To_In_Addr (Address.Addr); 57 58 when Family_Inet6 => 59 Sin.Sin6_Port := Network_Port; 60 Sin.Sin6_Addr := To_In6_Addr (Address.Addr); 61 Sin.Sin6_Scope_Id := 0; 62 63 when Family_Unix => 64 declare 65 use type C.size_t; 66 Name_Len : constant C.size_t := 67 C.size_t (ASU.Length (Address.Name)); 68 begin 69 Length := Sockaddr_Length_And_Family'Size / System.Storage_Unit 70 + C.int (Name_Len); 71 72 if Name_Len > Sin.Sun_Path'Length then 73 raise Constraint_Error with 74 "Too big address length for UNIX local communication"; 75 end if; 76 77 if Name_Len = 0 then 78 Sin.Sun_Path (1) := C.nul; 79 80 else 81 Sin.Sun_Path (1 .. Name_Len) := 82 C.To_C (ASU.To_String (Address.Name), Append_Nul => False); 83 84 if Sin.Sun_Path (1) /= C.nul 85 and then Name_Len < Sin.Sun_Path'Length 86 then 87 Sin.Sun_Path (Name_Len + 1) := C.nul; 88 Length := Length + 1; 89 end if; 90 end if; 91 end; 92 93 when Family_Unspec => 94 null; 95 end case; 96 end Set_Address; 97 98 ----------------- 99 -- Get_Address -- 100 ----------------- 101 102 function Get_Address 103 (Sin : Sockaddr; Length : C.int) return Sock_Addr_Type 104 is 105 use type C.unsigned_short, C.size_t, C.char, SOSC.OS_Type; 106 Family : constant C.unsigned_short := 107 (if SOSC.Has_Sockaddr_Len = 0 then Sin.Sin_Family.Short_Family 108 else C.unsigned_short (Sin.Sin_Family.Char_Family)); 109 Result : Sock_Addr_Type 110 (if SOSC.AF_INET6 > 0 and then SOSC.AF_INET6 = Family then Family_Inet6 111 elsif SOSC.AF_UNIX > 0 and then SOSC.AF_UNIX = Family then Family_Unix 112 elsif SOSC.AF_INET = Family then Family_Inet 113 else Family_Unspec); 114 begin 115 case Result.Family is 116 when Family_Inet => 117 Result.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); 118 To_Inet_Addr (Sin.Sin_Addr, Result.Addr); 119 when Family_Inet6 => 120 Result.Port := Port_Type (Network_To_Short (Sin.Sin6_Port)); 121 To_Inet_Addr (Sin.Sin6_Addr, Result.Addr); 122 when Family_Unix => 123 if Length > Sin.Sin_Family'Size / System.Storage_Unit then 124 Result.Name := ASU.To_Unbounded_String 125 (C.To_Ada 126 (Sin.Sun_Path 127 (1 .. C.size_t (Length) 128 - Sin.Sin_Family'Size / System.Storage_Unit), 129 Trim_Nul => Sin.Sun_Path (1) /= C.nul 130 or else SOSC.Target_OS = SOSC.Windows)); 131 end if; 132 133 when Family_Unspec => 134 null; 135 end case; 136 137 return Result; 138 end Get_Address; 139 140 ---------------- 141 -- Set_Family -- 142 ---------------- 143 144 procedure Set_Family 145 (Length_And_Family : out Sockaddr_Length_And_Family; 146 Family : Family_Type) 147 is 148 C_Family : C.int renames Families (Family); 149 Has_Sockaddr_Len : constant Boolean := SOSC.Has_Sockaddr_Len /= 0; 150 begin 151 if Has_Sockaddr_Len then 152 Length_And_Family.Length := Lengths (Family); 153 Length_And_Family.Char_Family := C.unsigned_char (C_Family); 154 else 155 Length_And_Family.Short_Family := C.unsigned_short (C_Family); 156 end if; 157 end Set_Family; 158 159 ---------------- 160 -- To_In_Addr -- 161 ---------------- 162 163 function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is 164 begin 165 if Addr.Family = Family_Inet then 166 return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)), 167 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)), 168 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)), 169 S_B4 => C.unsigned_char (Addr.Sin_V4 (4))); 170 end if; 171 172 raise Socket_Error with "IPv6 not supported"; 173 end To_In_Addr; 174 175 ------------------ 176 -- To_Inet_Addr -- 177 ------------------ 178 179 procedure To_Inet_Addr 180 (Addr : In_Addr; 181 Result : out Inet_Addr_Type) is 182 begin 183 Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1); 184 Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2); 185 Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3); 186 Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4); 187 end To_Inet_Addr; 188 189 ------------------ 190 -- To_Inet_Addr -- 191 ------------------ 192 193 procedure To_Inet_Addr 194 (Addr : In6_Addr; 195 Result : out Inet_Addr_Type) 196 is 197 Sin_V6 : Inet_Addr_V6_Type; 198 begin 199 for J in Addr'Range loop 200 Sin_V6 (J) := Inet_Addr_Comp_Type (Addr (J)); 201 end loop; 202 203 Result := (Family => Family_Inet6, Sin_V6 => Sin_V6); 204 end To_Inet_Addr; 205 206 ---------------- 207 -- To_In_Addr -- 208 ---------------- 209 210 function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr is 211 Result : In6_Addr; 212 begin 213 for J in Addr.Sin_V6'Range loop 214 Result (J) := C.unsigned_char (Addr.Sin_V6 (J)); 215 end loop; 216 217 return Result; 218 end To_In6_Addr; 219 220 ---------------------- 221 -- Short_To_Network -- 222 ---------------------- 223 224 function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is 225 use Interfaces; 226 use System; 227 228 begin 229 -- Big-endian case. No conversion needed. On these platforms, htons() 230 -- defaults to a null procedure. 231 232 if Default_Bit_Order = High_Order_First then 233 return S; 234 235 -- Little-endian case. We must swap the high and low bytes of this 236 -- short to make the port number network compliant. 237 238 else 239 return C.unsigned_short (Rotate_Left (Unsigned_16 (S), 8)); 240 end if; 241 end Short_To_Network; 242 243end GNAT.Sockets.Thin_Common; 244