diff mbox

[Ada] Support for new socket options

Message ID 20170106102824.GA97614@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Jan. 6, 2017, 10:28 a.m. UTC
Make Linux specific option SO_BUSY_POLL accessable as Busy_Polling
option. Also offer a generic API to set options that were not available
at compiler build time.

Tested on x86_64-pc-linux-gnu, committed on trunk

2017-01-06  Thomas Quinot  <quinot@adacore.com>

	* s-oscons-tmplt.c, g-socket.adb, g-socket.ads, g-sothco.ads:
	(GNAT.Socket): Add support for Busy_Polling and Generic_Option
diff mbox

Patch

Index: s-oscons-tmplt.c
===================================================================
--- s-oscons-tmplt.c	(revision 244124)
+++ s-oscons-tmplt.c	(working copy)
@@ -7,7 +7,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2016, Free Software Foundation, 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- --
@@ -1264,6 +1264,11 @@ 
 #endif
 CND(SO_ERROR, "Get/clear error status")
 
+#ifndef SO_BUSY_POLL
+# define SO_BUSY_POLL -1
+#endif
+CND(SO_BUSY_POLL, "Busy polling")
+
 #ifndef IP_MULTICAST_IF
 # define IP_MULTICAST_IF -1
 #endif
Index: g-socket.adb
===================================================================
--- g-socket.adb	(revision 244124)
+++ g-socket.adb	(working copy)
@@ -50,8 +50,6 @@ 
 
    package C renames Interfaces.C;
 
-   use type C.int;
-
    ENOERROR : constant := 0;
 
    Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
@@ -82,7 +80,7 @@ 
                 (Non_Blocking_IO => SOSC.FIONBIO,
                  N_Bytes_To_Read => SOSC.FIONREAD);
 
-   Options : constant array (Option_Name) of C.int :=
+   Options : constant array (Specific_Option_Name) of C.int :=
                (Keep_Alive          => SOSC.SO_KEEPALIVE,
                 Reuse_Address       => SOSC.SO_REUSEADDR,
                 Broadcast           => SOSC.SO_BROADCAST,
@@ -98,7 +96,8 @@ 
                 Multicast_Loop      => SOSC.IP_MULTICAST_LOOP,
                 Receive_Packet_Info => SOSC.IP_PKTINFO,
                 Send_Timeout        => SOSC.SO_SNDTIMEO,
-                Receive_Timeout     => SOSC.SO_RCVTIMEO);
+                Receive_Timeout     => SOSC.SO_RCVTIMEO,
+                Busy_Polling        => SOSC.SO_BUSY_POLL);
    --  ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
    --  but for Linux compatibility this constant is the same as IP_PKTINFO.
 
@@ -1140,9 +1139,10 @@ 
    -----------------------
 
    function Get_Socket_Option
-     (Socket : Socket_Type;
-      Level  : Level_Type := Socket_Level;
-      Name   : Option_Name) return Option_Type
+     (Socket  : Socket_Type;
+      Level   : Level_Type := Socket_Level;
+      Name    : Option_Name;
+      Optname : Interfaces.C.int := -1) return Option_Type
    is
       use SOSC;
       use type C.unsigned_char;
@@ -1155,8 +1155,19 @@ 
       Add : System.Address;
       Res : C.int;
       Opt : Option_Type (Name);
+      Onm : Interfaces.C.int;
 
    begin
+      if Name in Specific_Option_Name then
+         Onm := Options (Name);
+
+      elsif Optname = -1 then
+         raise Socket_Error with "optname must be specified";
+
+      else
+         Onm := Optname;
+      end if;
+
       case Name is
          when Multicast_Loop      |
               Multicast_TTL       |
@@ -1164,14 +1175,16 @@ 
             Len := V1'Size / 8;
             Add := V1'Address;
 
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        |
-              Send_Buffer     |
-              Receive_Buffer  |
-              Multicast_If    |
-              Error           =>
+         when Generic_Option |
+              Keep_Alive     |
+              Reuse_Address  |
+              Broadcast      |
+              No_Delay       |
+              Send_Buffer    |
+              Receive_Buffer |
+              Multicast_If   |
+              Error          |
+              Busy_Polling   =>
             Len := V4'Size / 8;
             Add := V4'Address;
 
@@ -1203,7 +1216,7 @@ 
         C_Getsockopt
           (C.int (Socket),
            Levels (Level),
-           Options (Name),
+           Onm,
            Add, Len'Access);
 
       if Res = Failure then
@@ -1211,12 +1224,19 @@ 
       end if;
 
       case Name is
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        =>
+         when Generic_Option =>
+            Opt.Optname := Onm;
+            Opt.Optval  := V4;
+
+         when Keep_Alive    |
+              Reuse_Address |
+              Broadcast     |
+              No_Delay      =>
             Opt.Enabled := (V4 /= 0);
 
+         when Busy_Polling =>
+            Opt.Microseconds := Natural (V4);
+
          when Linger          =>
             Opt.Enabled := (V8 (V8'First) /= 0);
             Opt.Seconds := Natural (V8 (V8'Last));
@@ -2267,17 +2287,28 @@ 
       Len : C.int;
       Add : System.Address := Null_Address;
       Res : C.int;
+      Onm : C.int;
 
    begin
       case Option.Name is
-         when Keep_Alive      |
-              Reuse_Address   |
-              Broadcast       |
-              No_Delay        =>
+         when Generic_Option =>
+            V4  := Option.Optval;
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Keep_Alive    |
+              Reuse_Address |
+              Broadcast     |
+              No_Delay      =>
             V4  := C.int (Boolean'Pos (Option.Enabled));
             Len := V4'Size / 8;
             Add := V4'Address;
 
+         when Busy_Polling =>
+            V4  := C.int (Option.Microseconds);
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
          when Linger          =>
             V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
             V8 (V8'Last)  := C.int (Option.Seconds);
@@ -2347,10 +2378,20 @@ 
 
       end case;
 
+      if Option.Name in Specific_Option_Name then
+         Onm := Options (Option.Name);
+
+      elsif Option.Optname = -1 then
+         raise Socket_Error with "optname must be specified";
+
+      else
+         Onm := Option.Optname;
+      end if;
+
       Res := C_Setsockopt
         (C.int (Socket),
          Levels (Level),
-         Options (Option.Name),
+         Onm,
          Add, Len);
 
       if Res = Failure then
Index: g-socket.ads
===================================================================
--- g-socket.ads	(revision 244124)
+++ g-socket.ads	(working copy)
@@ -373,6 +373,9 @@ 
    --  entities declared therein are not meant for direct access by users,
    --  including through this renaming.
 
+   use type Interfaces.C.int;
+   --  Need visibility on "-" operator so that we can write -1
+
    procedure Initialize;
    pragma Obsolescent
      (Entity  => Initialize,
@@ -676,7 +679,8 @@ 
    --  a boolean to enable or disable this option.
 
    type Option_Name is
-     (Keep_Alive,          -- Enable sending of keep-alive messages
+     (Generic_Option,
+      Keep_Alive,          -- Enable sending of keep-alive messages
       Reuse_Address,       -- Allow bind to reuse local address
       Broadcast,           -- Enable datagram sockets to recv/send broadcasts
       Send_Buffer,         -- Set/get the maximum socket send buffer in bytes
@@ -691,10 +695,17 @@ 
       Multicast_Loop,      -- Sent multicast packets are looped to local socket
       Receive_Packet_Info, -- Receive low level packet info as ancillary data
       Send_Timeout,        -- Set timeout value for output
-      Receive_Timeout);    -- Set timeout value for input
+      Receive_Timeout,     -- Set timeout value for input
+      Busy_Polling);       -- Set busy polling mode
+   subtype Specific_Option_Name is
+     Option_Name range Keep_Alive .. Option_Name'Last;
 
    type Option_Type (Name : Option_Name := Keep_Alive) is record
       case Name is
+         when Generic_Option =>
+            Optname : Interfaces.C.int := -1;
+            Optval  : Interfaces.C.int;
+
          when Keep_Alive          |
               Reuse_Address       |
               Broadcast           |
@@ -711,6 +722,9 @@ 
                   null;
             end case;
 
+         when Busy_Polling    =>
+            Microseconds : Natural;
+
          when Send_Buffer     |
               Receive_Buffer  =>
             Size : Natural;
@@ -876,10 +890,12 @@ 
    --  No_Sock_Addr on error (e.g. socket closed or not locally bound).
 
    function Get_Socket_Option
-     (Socket : Socket_Type;
-      Level  : Level_Type := Socket_Level;
-      Name   : Option_Name) return Option_Type;
-   --  Get the options associated with a socket. Raises Socket_Error on error
+     (Socket  : Socket_Type;
+      Level   : Level_Type := Socket_Level;
+      Name    : Option_Name;
+      Optname : Interfaces.C.int := -1) return Option_Type;
+   --  Get the options associated with a socket. Raises Socket_Error on error.
+   --  Optname identifies specific option when Name is Generic_Option.
 
    procedure Listen_Socket
      (Socket : Socket_Type;
Index: g-sothco.ads
===================================================================
--- g-sothco.ads	(revision 244124)
+++ g-sothco.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2008-2014, AdaCore                     --
+--                     Copyright (C) 2008-2016, AdaCore                     --
 --                                                                          --
 -- 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- --
@@ -41,9 +41,6 @@ 
 
    package C renames Interfaces.C;
 
-   use type C.int;
-   --  This is so we can declare the Failure constant below
-
    Success : constant C.int :=  0;
    Failure : constant C.int := -1;