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-2019, 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 is 42 begin 43 Set_Family (Sin.Sin_Family, Address.Family); 44 Sin.Sin_Port := Short_To_Network (C.unsigned_short (Address.Port)); 45 46 case Address.Family is 47 when Family_Inet => 48 Sin.Sin_Addr := To_In_Addr (Address.Addr); 49 when Family_Inet6 => 50 Sin.Sin6_Addr := To_In6_Addr (Address.Addr); 51 Sin.Sin6_Scope_Id := 0; 52 when Family_Unspec => 53 null; 54 end case; 55 end Set_Address; 56 57 ----------------- 58 -- Get_Address -- 59 ----------------- 60 61 function Get_Address (Sin : Sockaddr) return Sock_Addr_Type is 62 Family : constant C.unsigned_short := 63 (if SOSC.Has_Sockaddr_Len = 0 then Sin.Sin_Family.Short_Family 64 else C.unsigned_short (Sin.Sin_Family.Char_Family)); 65 Result : Sock_Addr_Type 66 (case Family is 67 when SOSC.AF_INET6 => Family_Inet6, 68 when SOSC.AF_INET => Family_Inet, 69 when others => Family_Unspec); 70 begin 71 Result.Port := Port_Type (Network_To_Short (Sin.Sin_Port)); 72 73 case Result.Family is 74 when Family_Inet => 75 To_Inet_Addr (Sin.Sin_Addr, Result.Addr); 76 when Family_Inet6 => 77 To_Inet_Addr (Sin.Sin6_Addr, Result.Addr); 78 when Family_Unspec => 79 Result.Addr := (Family => Family_Unspec); 80 end case; 81 82 return Result; 83 end Get_Address; 84 85 ---------------- 86 -- Set_Family -- 87 ---------------- 88 89 procedure Set_Family 90 (Length_And_Family : out Sockaddr_Length_And_Family; 91 Family : Family_Type) 92 is 93 C_Family : C.int renames Families (Family); 94 Has_Sockaddr_Len : constant Boolean := SOSC.Has_Sockaddr_Len /= 0; 95 begin 96 if Has_Sockaddr_Len then 97 Length_And_Family.Length := Lengths (Family); 98 Length_And_Family.Char_Family := C.unsigned_char (C_Family); 99 else 100 Length_And_Family.Short_Family := C.unsigned_short (C_Family); 101 end if; 102 end Set_Family; 103 104 ---------------- 105 -- To_In_Addr -- 106 ---------------- 107 108 function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is 109 begin 110 if Addr.Family = Family_Inet then 111 return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)), 112 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)), 113 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)), 114 S_B4 => C.unsigned_char (Addr.Sin_V4 (4))); 115 end if; 116 117 raise Socket_Error with "IPv6 not supported"; 118 end To_In_Addr; 119 120 ------------------ 121 -- To_Inet_Addr -- 122 ------------------ 123 124 procedure To_Inet_Addr 125 (Addr : In_Addr; 126 Result : out Inet_Addr_Type) is 127 begin 128 Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1); 129 Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2); 130 Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3); 131 Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4); 132 end To_Inet_Addr; 133 134 ------------------ 135 -- To_Inet_Addr -- 136 ------------------ 137 138 procedure To_Inet_Addr 139 (Addr : In6_Addr; 140 Result : out Inet_Addr_Type) 141 is 142 Sin_V6 : Inet_Addr_V6_Type; 143 begin 144 for J in Addr'Range loop 145 Sin_V6 (J) := Inet_Addr_Comp_Type (Addr (J)); 146 end loop; 147 148 Result := (Family => Family_Inet6, Sin_V6 => Sin_V6); 149 end To_Inet_Addr; 150 151 ---------------- 152 -- To_In_Addr -- 153 ---------------- 154 155 function To_In6_Addr (Addr : Inet_Addr_Type) return In6_Addr is 156 Result : In6_Addr; 157 begin 158 for J in Addr.Sin_V6'Range loop 159 Result (J) := C.unsigned_char (Addr.Sin_V6 (J)); 160 end loop; 161 162 return Result; 163 end To_In6_Addr; 164 165 ---------------------- 166 -- Short_To_Network -- 167 ---------------------- 168 169 function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is 170 use Interfaces; 171 use System; 172 173 begin 174 -- Big-endian case. No conversion needed. On these platforms, htons() 175 -- defaults to a null procedure. 176 177 if Default_Bit_Order = High_Order_First then 178 return S; 179 180 -- Little-endian case. We must swap the high and low bytes of this 181 -- short to make the port number network compliant. 182 183 else 184 return C.unsigned_short (Rotate_Left (Unsigned_16 (S), 8)); 185 end if; 186 end Short_To_Network; 187 188end GNAT.Sockets.Thin_Common; 189