Skip to content

R
riscv-gcc-1
Commit 2133b4c0 by Bob Duff Committed by Arnaud Charlet
Options

g-stsifd-sockets.adb (Create): Work around strange behavior of 'bind' on windows… 

g-stsifd-sockets.adb (Create): Work around strange behavior of 'bind' on windows that causes 'connect' to fail...

2007-06-11  Bob Duff  <duff@adacore.com>
	    Thomas Quinot  <quinot@adacore.com>

	* g-stsifd-sockets.adb (Create): Work around strange behavior of
	'bind' on windows that causes 'connect' to fail intermittently, by
	retrying the 'bind'.
	(GNAT.Sockets.Thin.Signalling_Fds): New procedure Close.

From-SVN: r125612
parent 85e053e9
Showing with 101 additions and 58 deletions
gcc/ada/g-stsifd-sockets.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2001-2006, AdaCore -- -- Copyright (C) 2001-2007, AdaCore --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -37,10 +37,23 @@ ...@@ -37,10 +37,23 @@
-- Note: this code used to be in GNAT.Sockets, but has been moved to a -- Note: this code used to be in GNAT.Sockets, but has been moved to a
-- platform-specific file. It is now used only for non-UNIX platforms. -- platform-specific file. It is now used only for non-UNIX platforms.
separate separate (GNAT.Sockets.Thin)
(GNAT.Sockets.Thin)
package body Signalling_Fds is package body Signalling_Fds is
-----------
-- Close --
-----------
procedure Close (Sig : C.int) is
Res : C.int;
pragma Unreferenced (Res);
-- Res is assigned but never read, because we purposefully ignore
-- any error returned by the C_Close system call, as per the spec
-- of this procedure.
begin
Res := C_Close (Sig);
end Close;
------------ ------------
-- Create -- -- Create --
------------ ------------
...@@ -50,83 +63,111 @@ package body Signalling_Fds is ...@@ -50,83 +63,111 @@ package body Signalling_Fds is
-- Listening socket, read socket and write socket -- Listening socket, read socket and write socket
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr_In;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int;
-- Address of listening socket -- Address of listening socket
Res : C.int; Res : C.int;
-- Return status of system calls -- Return status of system calls
Err : Integer;
-- Saved errno value
begin begin
Fds (Read_End) := Failure; Fds.all := (Read_End | Write_End => Failure);
Fds (Write_End) := Failure;
-- We open two signalling sockets. One of them is used to send data -- We open two signalling sockets. One of them is used to send data
-- to the other, which is included in a C_Select socket set. The -- to the other, which is included in a C_Select socket set. The
-- communication is used to force the call to C_Select to complete, -- communication is used to force the call to C_Select to complete,
-- and the waiting task to resume its execution. -- and the waiting task to resume its execution.
-- Create a listening socket loop
-- Retry loop, in case the C_Connect below fails
L_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); -- Create a listening socket
if L_Sock = Failure then L_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
goto Fail;
end if;
-- Bind the socket to an available port on localhost if L_Sock = Failure then
goto Fail;
end if;
Sin.Sin_Addr.S_B1 := 127; -- Bind the socket to an available port on localhost
Sin.Sin_Addr.S_B2 := 0;
Sin.Sin_Addr.S_B3 := 0;
Sin.Sin_Addr.S_B4 := 1;
Sin.Sin_Port := 0;
Res := C_Bind (L_Sock, Sin'Address, Len); Len := Sin'Size / 8;
Set_Length (Sin'Unchecked_Access, Len);
Sin.Sin_Family := Constants.AF_INET;
Sin.Sin_Addr.S_B1 := 127;
Sin.Sin_Addr.S_B2 := 0;
Sin.Sin_Addr.S_B3 := 0;
Sin.Sin_Addr.S_B4 := 1;
Sin.Sin_Port := 0;
if Res = Failure then Res := C_Bind (L_Sock, Sin'Address, Len);
goto Fail;
end if;
-- Get assigned port if Res = Failure then
goto Fail;
end if;
Res := C_Getsockname (L_Sock, Sin'Address, Len'Access); -- Get assigned port
if Res = Failure then
goto Fail;
end if;
-- Set socket to listen mode, with a backlog of 1 to guarantee that Res := C_Getsockname (L_Sock, Sin'Address, Len'Access);
-- exactly one call to connect(2) succeeds. if Res = Failure then
goto Fail;
end if;
Res := C_Listen (L_Sock, 1); -- Set socket to listen mode, with a backlog of 1 to guarantee that
-- exactly one call to connect(2) succeeds.
if Res = Failure then Res := C_Listen (L_Sock, 1);
goto Fail;
end if;
-- Create read end (client) socket if Res = Failure then
goto Fail;
end if;
R_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); -- Create read end (client) socket
if R_Sock = Failure then R_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0);
goto Fail;
end if;
-- Connect listening socket if R_Sock = Failure then
goto Fail;
end if;
Res := C_Connect (R_Sock, Sin'Address, Len); -- Connect listening socket
if Res = Failure then Res := C_Connect (R_Sock, Sin'Address, Len);
goto Fail;
end if; exit when Res /= Failure;
if Socket_Errno /= Constants.EADDRINUSE then
goto Fail;
end if;
-- In rare cases, the above C_Bind chooses a port that is still
-- marked "in use", even though it has been closed (perhaps by some
-- other process that has already exited). This causes the above
-- C_Connect to fail with EADDRINUSE. In this case, we close the
-- ports, and loop back to try again. This mysterious windows
-- behavior is documented. See, for example:
-- http://msdn2.microsoft.com/en-us/library/ms737625.aspx
-- In an experiment with 2000 calls, 21 required exactly one retry, 7
-- required two, and none required three or more. Note that no delay
-- is needed between retries; retrying C_Bind will typically produce
-- a different port.
pragma Assert (Res = Failure
and then
Socket_Errno = Constants.EADDRINUSE);
pragma Warnings (Off); -- useless assignment to "Res"
Res := C_Close (W_Sock);
pragma Warnings (On);
W_Sock := Failure;
Res := C_Close (R_Sock);
R_Sock := Failure;
end loop;
-- Since the call to connect(2) has suceeded and the backlog limit on -- Since the call to connect(2) has suceeded and the backlog limit on
-- the listening socket is 1, we know that there is now exactly one -- the listening socket is 1, we know that there is now exactly one
-- pending connection on L_Sock, which is the one from R_Sock. -- pending connection on L_Sock, which is the one from R_Sock.
W_Sock := C_Accept (L_Sock, Sin'Address, Len'Access); W_Sock := C_Accept (L_Sock, Sin'Address, Len'Access);
if W_Sock = Failure then if W_Sock = Failure then
goto Fail; goto Fail;
end if; end if;
...@@ -143,27 +184,29 @@ package body Signalling_Fds is ...@@ -143,27 +184,29 @@ package body Signalling_Fds is
Res := C_Close (L_Sock); Res := C_Close (L_Sock);
Fds (Read_End) := R_Sock; Fds.all := (Read_End => R_Sock, Write_End => W_Sock);
Fds (Write_End) := W_Sock;
return Success; return Success;
<<Fail>> <<Fail>>
Err := Socket_Errno; declare
Saved_Errno : constant Integer := Socket_Errno;
if W_Sock /= Failure then begin
Res := C_Close (W_Sock); if W_Sock /= Failure then
end if; Res := C_Close (W_Sock);
end if;
if R_Sock /= Failure then if R_Sock /= Failure then
Res := C_Close (R_Sock); Res := C_Close (R_Sock);
end if; end if;
if L_Sock /= Failure then if L_Sock /= Failure then
Res := C_Close (L_Sock); Res := C_Close (L_Sock);
end if; end if;
Set_Socket_Errno (Err); Set_Socket_Errno (Saved_Errno);
end;
return Failure; return Failure;
end Create; end Create;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment