re PR ada/6717 (Race condition in GNAT.Sockets.Create_Selector)

2005-06-14  Thomas Quinot  <quinot@adacore.com>

	PR ada/6717

	* g-socket.ads, g-socket.adb (Inet_Addr): Special case the all-ones
	broadcast address.
	(Create_Selector): Bind listening socket used to create the signalling
	socket pair to 127.0.0.1 to limit the scope for 'theft' of connection.
	Set listen backlog to 1 to ensure that we detect socket theft by a
	failure of our own connect(2) call.
	(Check_Selector): Improve documentation of the selector mechanism.
	(Broadcast_Inet_Addr): New constant.

From-SVN: r101043

2 files changed, 55 insertions, 36 deletions

diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
index ab2ed6e..0485abf 100644
--- a/gcc/ada/g-socket.adb
+++ b/gcc/ada/g-socket.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 2001-2004 Ada Core Technologies, Inc.            --
+--           Copyright (C) 2001-2005 Ada Core Technologies, Inc.            --
 --                                                                          --
 -- 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- --
@@ -37,7 +37,6 @@ with Ada.Unchecked_Conversion;
 
 with Interfaces.C.Strings;
 
-with GNAT.OS_Lib;                use GNAT.OS_Lib;
 with GNAT.Sockets.Constants;
 with GNAT.Sockets.Thin;          use GNAT.Sockets.Thin;
 with GNAT.Task_Lock;
@@ -651,11 +650,10 @@ package body GNAT.Sockets is
       Err : Integer;
 
    begin
-      --  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 communication is used to force the call
-      --  to C_Select to complete, and the waiting task to resume
-      --  its execution.
+      --  We open two signalling sockets. One of them is used to send data to
+      --  send data 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,
+      --  and the waiting task to resume its execution.
 
       --  Create a listening socket
 
@@ -664,8 +662,13 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Socket_Errno);
       end if;
 
-      --  Sin is already correctly initialized. Bind the socket to any
-      --  unused port.
+      --  Bind the socket to any unused port on localhost
+
+      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;
 
       Res := C_Bind (S0, Sin'Address, Len);
       if Res = Failure then
@@ -684,7 +687,10 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Err);
       end if;
 
-      Res := C_Listen (S0, 2);
+      --  Set backlog to 1 to guarantee that exactly one call to connect(2)
+      --  can succeed.
+
+      Res := C_Listen (S0, 1);
 
       if Res = Failure then
          Err := Socket_Errno;
@@ -700,13 +706,6 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Err);
       end if;
 
-      --  Use INADDR_LOOPBACK
-
-      Sin.Sin_Addr.S_B1 := 127;
-      Sin.Sin_Addr.S_B2 := 0;
-      Sin.Sin_Addr.S_B3 := 0;
-      Sin.Sin_Addr.S_B4 := 1;
-
       --  Do a connect and accept the connection
 
       Res := C_Connect (S1, Sin'Address, Len);
@@ -718,6 +717,10 @@ package body GNAT.Sockets is
          Raise_Socket_Error (Err);
       end if;
 
+      --  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
+      --  pending connection on S0, which is the one from S1.
+
       S2 := C_Accept (S0, Sin'Address, Len'Access);
 
       if S2 = Failure then
@@ -1232,17 +1235,24 @@ package body GNAT.Sockets is
    function Inet_Addr (Image : String) return Inet_Addr_Type is
       use Interfaces.C.Strings;
 
-      Img : chars_ptr := New_String (Image);
+      Img : chars_ptr;
       Res : C.int;
-      Err : Integer;
 
    begin
+      --  Special case for the all-ones broadcast address: this address
+      --  has the same in_addr_t value as Failure, and thus cannot be
+      --  properly returned by inet_addr(3).
+
+      if Image (Image'Range) = "255.255.255.255" then
+         return Broadcast_Inet_Addr;
+      end if;
+
+      Img := New_String (Image);
       Res := C_Inet_Addr (Img);
-      Err := Errno;
       Free (Img);
 
       if Res = Failure then
-         Raise_Socket_Error (Err);
+         Raise_Socket_Error (Constants.EINVAL);
       end if;
 
       return To_Inet_Addr (To_In_Addr (Res));
diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index c613d20..9945b2f 100644
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -433,8 +433,9 @@ package GNAT.Sockets is
    --  treated like a wildcard enabling all addresses. No_Inet_Addr provides a
    --  special value to denote uninitialized inet addresses.
 
-   Any_Inet_Addr : constant Inet_Addr_Type;
-   No_Inet_Addr  : constant Inet_Addr_Type;
+   Any_Inet_Addr       : constant Inet_Addr_Type;
+   No_Inet_Addr        : constant Inet_Addr_Type;
+   Broadcast_Inet_Addr : constant Inet_Addr_Type;
 
    type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record
       Addr : Inet_Addr_Type (Family);
@@ -912,15 +913,16 @@ package GNAT.Sockets is
    procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type);
    --  Insert Socket into Item
 
-   --  C select() waits for a number of file descriptors to change status.
-   --  Usually, three independent sets of descriptors are watched (read, write
-   --  and exception). A timeout gives an upper bound on the amount of time
-   --  elapsed before select returns. This function blocks until an event
-   --  occurs. On some platforms, C select can block the full process.
+   --  The select(2) system call waits for events to occur on any of a set of
+   --  file descriptors. Usually, three independent sets of descriptors are
+   --  watched (read, write  and exception). A timeout gives an upper bound
+   --  on the amount of time elapsed before select returns. This function
+   --  blocks until an event occurs. On some platforms, the select(2) system
+   --  can block the full process (not just the calling thread).
    --
    --  Check_Selector provides the very same behaviour. The only difference is
    --  that it does not watch for exception events. Note that on some
-   --  platforms it is kept process blocking in purpose. The timeout parameter
+   --  platforms it is kept process blocking on purpose. The timeout parameter
    --  allows the user to have the behaviour he wants. Abort_Selector allows
    --  to abort safely a Check_Selector that is blocked forever. A special
    --  file descriptor is opened by Create_Selector and included in each call
@@ -958,16 +960,19 @@ package GNAT.Sockets is
       Status       : out Selector_Status;
       Timeout      : Selector_Duration := Forever);
    --  Return when one Socket in R_Socket_Set has some data to be read or if
-   --  one Socket in W_Socket_Set is ready to receive some data. In these
+   --  one Socket in W_Socket_Set is ready to transmit some data. In these
    --  cases Status is set to Completed and sockets that are ready are set in
    --  R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was
    --  ready after a Timeout expiration. Status is set to Aborted if an abort
    --  signal has been received while checking socket status. As this
    --  procedure returns when Timeout occurs, it is a design choice to keep
    --  this procedure process blocking. Note that a Timeout of 0.0 returns
-   --  immediately. Also note that two different objects must be passed as
-   --  R_Socket_Set and W_Socket_Set (even if they contain the same set of
-   --  Sockets), or some event will be lost.
+   --  immediately. Also note that two different Socket_Set_Type objects must
+   --  be passed as R_Socket_Set and W_Socket_Set (even if they denote the
+   --  same set of Sockets), or some event will be lost.
+   --  Socket_Error is raised when the select(2) system call returns an
+   --  error condition, or when a read error occurs on the signalling socket
+   --  used for the implementation of Abort_Selector.
 
    procedure Check_Selector
      (Selector     : in out Selector_Type;
@@ -1027,10 +1032,14 @@ private
    Any_Port : constant Port_Type := 0;
    No_Port  : constant Port_Type := 0;
 
-   Any_Inet_Addr : constant Inet_Addr_Type := (Family_Inet, (others => 0));
-   No_Inet_Addr  : constant Inet_Addr_Type := (Family_Inet, (others => 0));
+   Any_Inet_Addr       : constant Inet_Addr_Type :=
+                           (Family_Inet, (others => 0));
+   No_Inet_Addr        : constant Inet_Addr_Type :=
+                           (Family_Inet, (others => 0));
+   Broadcast_Inet_Addr : constant Inet_Addr_Type :=
+                           (Family_Inet, (others => 255));
 
-   No_Sock_Addr  : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0);
+   No_Sock_Addr : constant Sock_Addr_Type := (Family_Inet, No_Inet_Addr, 0);
 
    Max_Name_Length : constant := 64;
    --  The constant MAXHOSTNAMELEN is usually set to 64