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 <qui...@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
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;
