+2009-04-17 Thomas Quinot <quinot@adacore.com>
+
+ PR ada/35953
+
+ * g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb,
+ g-socthi-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads,
+ g-socthi.adb, g-stsifd-sockets.adb, g-socthi.ads, g-socket.adb,
+ g-socket.ads (GNAT.Sockets.Thin.C_Send,
+ GNAT.Sockets.Thin.Syscall_Send): Remove unused subprograms.
+ Replace calls to send(2) with equivalent sendto(2) calls.
+ (GNAT.Sockets.Send_Socket): Factor common code in inlined subprogram.
+ (GNAT.Sockets.Write): Account for the case of hyper-empty arrays, do not
+ report an error in that case. Factor code common to the two versions
+ (datagram and stream) in common routine Stream_Write.
+
2009-04-17 Robert Dewar <dewar@adacore.com>
* exp_disp.adb: Minor reformatting
(Stream : in out Stream_Socket_Stream_Type;
Item : Ada.Streams.Stream_Element_Array);
+ procedure Stream_Write
+ (Socket : Socket_Type;
+ Item : Ada.Streams.Stream_Element_Array;
+ To : access Sock_Addr_Type);
+ -- Common implementation for the Write operation of Datagram_Socket_Stream_
+ -- Type and Stream_Socket_Stream_Type.
+
procedure Wait_On_Socket
(Socket : Socket_Type;
For_Read : Boolean;
Last : out Ada.Streams.Stream_Element_Offset;
Flags : Request_Flag_Type := No_Request_Flag)
is
- Res : C.int;
-
begin
- Res :=
- C_Send
- (C.int (Socket),
- Item'Address,
- Item'Length,
- Set_Forced_Flags (To_Int (Flags)));
+ Send_Socket (Socket, Item, Last, To => null, Flags => Flags);
+ end Send_Socket;
- if Res = Failure then
- Raise_Socket_Error (Socket_Errno);
- end if;
+ -----------------
+ -- Send_Socket --
+ -----------------
- Last := Item'First + Ada.Streams.Stream_Element_Offset (Res - 1);
+ procedure Send_Socket
+ (Socket : Socket_Type;
+ Item : Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset;
+ To : Sock_Addr_Type;
+ Flags : Request_Flag_Type := No_Request_Flag)
+ is
+ begin
+ Send_Socket
+ (Socket, Item, Last, To => To'Unrestricted_Access, Flags => Flags);
end Send_Socket;
-----------------
(Socket : Socket_Type;
Item : Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
- To : Sock_Addr_Type;
+ To : access Sock_Addr_Type;
Flags : Request_Flag_Type := No_Request_Flag)
is
- Res : C.int;
- Sin : aliased Sockaddr_In;
- Len : constant C.int := Sin'Size / 8;
+ Res : C.int;
+
+ Sin : aliased Sockaddr_In;
+ C_To : Sockaddr_In_Access;
+ Len : C.int;
begin
- Set_Family (Sin.Sin_Family, To.Family);
- Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
- Set_Port
- (Sin'Unchecked_Access,
- Short_To_Network (C.unsigned_short (To.Port)));
+ if To /= null then
+ Set_Family (Sin.Sin_Family, To.Family);
+ Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
+ Set_Port
+ (Sin'Unchecked_Access,
+ Short_To_Network (C.unsigned_short (To.Port)));
+ C_To := Sin'Unchecked_Access;
+ Len := Sin'Size / 8;
+
+ else
+ C_To := null;
+ Len := 0;
+ end if;
Res := C_Sendto
(C.int (Socket),
Item'Address,
Item'Length,
Set_Forced_Flags (To_Int (Flags)),
- Sin'Unchecked_Access,
+ C_To,
Len);
if Res = Failure then
return Stream_Access (S);
end Stream;
+ ------------------
+ -- Stream_Write --
+ ------------------
+
+ procedure Stream_Write
+ (Socket : Socket_Type;
+ Item : Ada.Streams.Stream_Element_Array;
+ To : access Sock_Addr_Type)
+ is
+ First : Ada.Streams.Stream_Element_Offset;
+ Index : Ada.Streams.Stream_Element_Offset;
+ Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
+
+ begin
+ First := Item'First;
+ Index := First - 1;
+ while First <= Max loop
+ Send_Socket (Socket, Item (First .. Max), Index, To);
+
+ -- Exit when all or zero data sent. Zero means that the socket has
+ -- been closed by peer.
+
+ exit when Index < First or else Index = Max;
+
+ First := Index + 1;
+ end loop;
+
+ -- For an empty array, we have First > Max, and hence Index >= Max (no
+ -- error, the loop above is never executed). After a succesful send,
+ -- Index = Max. The only remaining case, Index < Max, is therefore
+ -- always an actual send failure.
+
+ if Index < Max then
+ Raise_Socket_Error (Socket_Errno);
+ end if;
+ end Stream_Write;
+
----------
-- To_C --
----------
(Stream : in out Datagram_Socket_Stream_Type;
Item : Ada.Streams.Stream_Element_Array)
is
- pragma Warnings (Off, Stream);
-
- First : Ada.Streams.Stream_Element_Offset := Item'First;
- Index : Ada.Streams.Stream_Element_Offset := First - 1;
- Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
-
begin
- loop
- Send_Socket
- (Stream.Socket,
- Item (First .. Max),
- Index,
- Stream.To);
-
- -- Exit when all or zero data sent. Zero means that the socket has
- -- been closed by peer.
-
- exit when Index < First or else Index = Max;
-
- First := Index + 1;
- end loop;
-
- if Index /= Max then
- raise Socket_Error;
- end if;
+ Stream_Write (Stream.Socket, Item, To => Stream.To'Unrestricted_Access);
end Write;
-----------
(Stream : in out Stream_Socket_Stream_Type;
Item : Ada.Streams.Stream_Element_Array)
is
- pragma Warnings (Off, Stream);
-
- First : Ada.Streams.Stream_Element_Offset := Item'First;
- Index : Ada.Streams.Stream_Element_Offset := First - 1;
- Max : constant Ada.Streams.Stream_Element_Offset := Item'Last;
-
begin
- loop
- Send_Socket (Stream.Socket, Item (First .. Max), Index);
-
- -- Exit when all or zero data sent. Zero means that the socket has
- -- been closed by peer.
-
- exit when Index < First or else Index = Max;
-
- First := Index + 1;
- end loop;
-
- if Index /= Max then
- raise Socket_Error;
- end if;
+ Stream_Write (Stream.Socket, Item, To => null);
end Write;
Sockets_Library_Controller_Object : Sockets_Library_Controller;
(Socket : Socket_Type;
Item : Ada.Streams.Stream_Element_Array;
Last : out Ada.Streams.Stream_Element_Offset;
+ To : access Sock_Addr_Type;
Flags : Request_Flag_Type := No_Request_Flag);
- -- Transmit a message to another socket. Note that Last is set to
+ pragma Inline (Send_Socket);
+ -- Transmit a message over a socket. For a datagram socket, the address is
+ -- given by To.all. For a stream socket, To must be null. Flags
+ -- allows to control the transmission. Raises Socket_Error on error.
+ -- Note: this subprogram is inlined because it is also used to implement
+ -- the two variants below.
+
+ procedure Send_Socket
+ (Socket : Socket_Type;
+ Item : Ada.Streams.Stream_Element_Array;
+ Last : out Ada.Streams.Stream_Element_Offset;
+ Flags : Request_Flag_Type := No_Request_Flag);
+ -- Transmit a message over a socket. Note that Last is set to
-- Item'First-1 when socket has been closed by peer. This is not
-- considered an error and no exception is raised. Flags allows to control
-- the transmission. Raises Socket_Error on any other error condition.
Last : out Ada.Streams.Stream_Element_Offset;
To : Sock_Addr_Type;
Flags : Request_Flag_Type := No_Request_Flag);
- -- Transmit a message to another socket. The address is given by To. Flags
- -- allows to control the transmission. Raises Socket_Error on error.
+ -- Transmit a message over a datagram socket. The destination address is
+ -- To. Flags allows to control the transmission. Raises Socket_Error on
+ -- error.
procedure Send_Vector
(Socket : Socket_Type;
begin
for J in Iovec'Range loop
- Res := C_Send
+ Res := C_Sendto
(Fd,
Iovec (J).Base.all'Address,
C.int (Iovec (J).Length),
- 0);
+ Flags => 0,
+ To => null,
+ Tolen => 0);
if Res < 0 then
return Res;
Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int;
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
-
function C_Sendto
(S : C.int;
Msg : System.Address;
pragma Import (Stdcall, C_Listen, "listen");
pragma Import (Stdcall, C_Recv, "recv");
pragma Import (Stdcall, C_Recvfrom, "recvfrom");
- pragma Import (Stdcall, C_Send, "send");
pragma Import (Stdcall, C_Sendto, "sendto");
pragma Import (Stdcall, C_Setsockopt, "setsockopt");
pragma Import (Stdcall, C_Shutdown, "shutdown");
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
- function Syscall_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
- pragma Import (C, Syscall_Send, "send");
-
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
return Res;
end C_Recvfrom;
- ------------
- -- C_Send --
- ------------
-
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int
- is
- Res : C.int;
-
- begin
- loop
- Res := Syscall_Send (S, Msg, Len, Flags);
- exit when SOSC.Thread_Blocking_IO
- or else Res /= Failure
- or else Non_Blocking_Socket (S)
- or else Errno /= SOSC.EWOULDBLOCK;
- delay Quantum;
- end loop;
-
- return Res;
- end C_Send;
-
--------------
-- C_Sendto --
--------------
begin
for J in Iovec'Range loop
- Res := C_Send
+ Res := C_Sendto
(Fd,
Iovec (J).Base.all'Address,
Interfaces.C.int (Iovec (J).Length),
- SOSC.MSG_Forced_Flags);
+ SOSC.MSG_Forced_Flags,
+ To => null,
+ Tolen => 0);
if Res < 0 then
return Res;
Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int;
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
-
function C_Sendto
(S : C.int;
Msg : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
- function Syscall_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
- pragma Import (C, Syscall_Send, "send");
-
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
return Res;
end C_Recvfrom;
- ------------
- -- C_Send --
- ------------
-
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int
- is
- Res : C.int;
-
- begin
- loop
- Res := Syscall_Send (S, Msg, Len, Flags);
- exit when SOSC.Thread_Blocking_IO
- or else Res /= Failure
- or else Non_Blocking_Socket (S)
- or else Errno /= SOSC.EWOULDBLOCK;
- delay Quantum;
- end loop;
-
- return Res;
- end C_Send;
-
--------------
-- C_Sendto --
--------------
Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int;
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
-
function C_Sendto
(S : C.int;
Msg : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
- function Syscall_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
- pragma Import (C, Syscall_Send, "send");
-
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
return Res;
end C_Recvfrom;
- ------------
- -- C_Send --
- ------------
-
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int
- is
- Res : C.int;
-
- begin
- loop
- Res := Syscall_Send (S, Msg, Len, Flags);
- exit when SOSC.Thread_Blocking_IO
- or else Res /= Failure
- or else Non_Blocking_Socket (S)
- or else Errno /= SOSC.EWOULDBLOCK;
- delay Quantum;
- end loop;
-
- return Res;
- end C_Send;
-
--------------
-- C_Sendto --
--------------
Exceptfds : access Fd_Set;
Timeout : Timeval_Access) return C.int;
- function C_Send
- (S : C.int;
- Msg : System.Address;
- Len : C.int;
- Flags : C.int) return C.int;
-
function C_Sendto
(S : C.int;
Msg : System.Address;
function Write (Wsig : C.int) return C.int is
Buf : aliased Character := ASCII.NUL;
begin
- return C_Send (Wsig, Buf'Address, 1, SOSC.MSG_Forced_Flags);
+ return C_Sendto
+ (Wsig, Buf'Address, 1,
+ Flags => SOSC.MSG_Forced_Flags,
+ To => null,
+ Tolen => 0);
end Write;
end Signalling_Fds;