1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- G N A T . S O C K E T S . T H I N . C _ S O C K E T P A I R -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2001-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 32-- Portable sockets-based implementation of the C_Socketpair used for 33-- platforms that do not support UNIX socketpair system call. 34 35-- Note: this code is only for non-UNIX platforms. 36 37separate (GNAT.Sockets.Thin) 38function C_Socketpair 39 (Domain : C.int; 40 Typ : C.int; 41 Protocol : C.int; 42 Fds : not null access Fd_Pair) return C.int 43is 44 use type C.char_array; 45 46 L_Sock, C_Sock, P_Sock : C.int := Failure; 47 -- Listening socket, client socket and peer socket 48 49 Family : constant Family_Type := 50 (case Domain is 51 when SOSC.AF_INET => Family_Inet, 52 when SOSC.AF_INET6 => Family_Inet6, 53 when others => Family_Unspec); 54 55 Len : aliased C.int := C.int (Lengths (Family)); 56 57 C_Sin : aliased Sockaddr; 58 C_Bin : aliased C.char_array (1 .. C.size_t (Len)); 59 for C_Bin'Address use C_Sin'Address; 60 -- Address of listening and client socket and it's binary representation. 61 -- We need binary representation because Ada does not allow to compare 62 -- unchecked union if either of the operands lacks inferable discriminants. 63 -- RM-B-3-3 23/2. 64 65 P_Sin : aliased Sockaddr; 66 P_Bin : aliased C.char_array (1 .. C.size_t (Len)); 67 for P_Bin'Address use P_Sin'Address; 68 -- Address of peer socket and it's binary representation 69 70 T_Sin : aliased Sockaddr; 71 T_Bin : aliased C.char_array (1 .. C.size_t (Len)); 72 for T_Bin'Address use T_Sin'Address; 73 -- Temporary address to compare and check that address and port of the 74 -- socket equal to peer address and port of the opposite connected socket. 75 76 Res : C.int with Warnings => Off; 77 78begin 79 Set_Family (C_Sin.Sin_Family, Family); 80 81 case Family is 82 when Family_Inet => 83 C_Sin.Sin_Addr.S_B1 := 127; 84 C_Sin.Sin_Addr.S_B4 := 1; 85 86 when Family_Inet6 => 87 C_Sin.Sin6_Addr (C_Sin.Sin6_Addr'Last) := 1; 88 89 when others => 90 Set_Socket_Errno (SOSC.EAFNOSUPPORT); 91 return Failure; 92 end case; 93 94 for J in 1 .. 10 loop 95 -- Retry loop, in case the C_Connect below fails 96 97 C_Sin.Sin_Port := 0; 98 99 -- Create a listening socket 100 101 L_Sock := C_Socket (Domain, Typ, Protocol); 102 exit when L_Sock = Failure; 103 104 -- Bind the socket to an available port on localhost 105 106 Res := C_Bind (L_Sock, C_Sin'Address, Len); 107 exit when Res = Failure; 108 109 -- Get assigned port 110 111 Res := C_Getsockname (L_Sock, C_Sin'Address, Len'Access); 112 exit when Res = Failure; 113 114 -- Set socket to listen mode, with a backlog of 1 to guarantee that 115 -- exactly one call to connect(2) succeeds. 116 117 Res := C_Listen (L_Sock, 1); 118 exit when Res = Failure; 119 120 -- Create read end (client) socket 121 122 C_Sock := C_Socket (Domain, Typ, Protocol); 123 exit when C_Sock = Failure; 124 125 -- Connect listening socket 126 127 Res := C_Connect (C_Sock, C_Sin'Address, Len); 128 129 if Res = Failure then 130 -- In rare cases, the above C_Bind chooses a port that is still 131 -- marked "in use", even though it has been closed (perhaps by some 132 -- other process that has already exited). This causes the above 133 -- C_Connect to fail with EADDRINUSE. In this case, we close the 134 -- ports, and loop back to try again. This mysterious Windows 135 -- behavior is documented. See, for example: 136 -- http://msdn2.microsoft.com/en-us/library/ms737625.aspx 137 -- In an experiment with 2000 calls, 21 required exactly one retry, 7 138 -- required two, and none required three or more. Note that no delay 139 -- is needed between retries; retrying C_Bind will typically produce 140 -- a different port. 141 142 exit when Socket_Errno /= SOSC.EADDRINUSE; 143 144 goto Repeat; 145 end if; 146 147 -- Since the call to connect(2) has succeeded and the backlog limit 148 -- on the listening socket is 1, we know that there is now exactly 149 -- one pending connection on L_Sock, which is the one from R_Sock. 150 151 P_Sin.Sun_Path := (others => C.nul); 152 153 P_Sock := C_Accept (L_Sock, P_Sin'Address, Len'Access); 154 exit when P_Sock = Failure; 155 156 -- Address and port of the socket equal to peer address and port of the 157 -- opposite connected socket. 158 159 Res := C_Getsockname (P_Sock, T_Sin'Address, Len'Access); 160 exit when Res = Failure; 161 162 if T_Bin /= C_Bin then 163 goto Repeat; 164 end if; 165 166 -- Address and port of the socket equal to peer address and port of the 167 -- opposite connected socket. 168 169 Res := C_Getsockname (C_Sock, T_Sin'Address, Len'Access); 170 exit when Res = Failure; 171 172 if T_Bin /= P_Bin then 173 goto Repeat; 174 end if; 175 176 -- Close listening socket (ignore exit status) 177 178 Res := C_Close (L_Sock); 179 180 Fds.all := (Read_End => C_Sock, Write_End => P_Sock); 181 182 return Thin_Common.Success; 183 184 <<Repeat>> 185 Res := C_Close (C_Sock); 186 C_Sock := Failure; 187 Res := C_Close (P_Sock); 188 P_Sock := Failure; 189 Res := C_Close (L_Sock); 190 L_Sock := Failure; 191 end loop; 192 193 declare 194 Saved_Errno : constant Integer := Socket_Errno; 195 196 begin 197 if P_Sock /= Failure then 198 Res := C_Close (P_Sock); 199 end if; 200 201 if C_Sock /= Failure then 202 Res := C_Close (C_Sock); 203 end if; 204 205 if L_Sock /= Failure then 206 Res := C_Close (L_Sock); 207 end if; 208 209 Set_Socket_Errno (Saved_Errno); 210 end; 211 212 return Failure; 213end C_Socketpair; 214