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