Skip to content

R
riscv-gcc-1
Commit d6c7ed50 by Thomas Quinot Committed by Arnaud Charlet
Options

g-socket.ads, [...]: Add new sockets constant MSG_NOSIGNAL (Linux-specific). 

2004-10-04  Thomas Quinot  <quinot@act-europe.fr>

	* g-socket.ads, g-socket.adb, g-socthi.adb, socket.c,
	g-soccon-aix.ads, g-soccon-irix.ads, g-soccon-hpux.ads,
	g-soccon-interix.ads, g-soccon-solaris.ads, g-soccon-vms.adb,
	g-soccon-mingw.ads, g-soccon-vxworks.ads, g-soccon-freebsd.ads,
	g-soccon.ads, g-soccon-unixware.ads, g-soccon-tru64.ads:  Add new
	sockets constant MSG_NOSIGNAL (Linux-specific).
	Add new sockets constant MSG_Forced_Flags, list of flags to be set on
	all Send operations.
	For Linux, set MSG_NOSIGNAL on all send operations to prevent them
	from trigerring SIGPIPE.
	Rename components to avoid clash with Ada 2005 possible reserved
	word 'interface'.
	(Check_Selector): When the select system call returns with an error
	condition, propagate Socket_Error to the caller.

From-SVN: r88485
parent fded8de7
Showing with 207 additions and 145 deletions
gcc/ada/ChangeLog
2004-10-04 Thomas Quinot <quinot@act-europe.fr>
* g-socket.ads, g-socket.adb, g-socthi.adb, socket.c,
g-soccon-aix.ads, g-soccon-irix.ads, g-soccon-hpux.ads,
g-soccon-interix.ads, g-soccon-solaris.ads, g-soccon-vms.adb,
g-soccon-mingw.ads, g-soccon-vxworks.ads, g-soccon-freebsd.ads,
g-soccon.ads, g-soccon-unixware.ads, g-soccon-tru64.ads: Add new
sockets constant MSG_NOSIGNAL (Linux-specific).
Add new sockets constant MSG_Forced_Flags, list of flags to be set on
all Send operations.
For Linux, set MSG_NOSIGNAL on all send operations to prevent them
from trigerring SIGPIPE.
Rename components to avoid clash with Ada 2005 possible reserved
word 'interface'.
(Check_Selector): When the select system call returns with an error
condition, propagate Socket_Error to the caller.
2004-10-01 Jan Hubicka <jh@suse.cz> 2004-10-01 Jan Hubicka <jh@suse.cz>
* misc.c (gnat_expand_body): Update call of tree_rest_of_compilation. * misc.c (gnat_expand_body): Update call of tree_rest_of_compilation.
......
gcc/ada/g-soccon-aix.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-freebsd.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-hpux.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-interix.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-irix.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-mingw.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := -1; -- Send end of record MSG_EOR : constant := -1; -- Send end of record
MSG_WAITALL : constant := -1; -- Wait for full reception MSG_WAITALL : constant := -1; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-solaris.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-tru64.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-unixware.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-vms.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon-vxworks.ads
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception MSG_WAITALL : constant := 64; -- Wait for full reception
MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-soccon.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2000-2003 Free Software Foundation, Inc. -- -- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
-- -- -- --
-- 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- --
...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is ...@@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is
MSG_PEEK : constant := 2; -- Peek at incoming data MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 128; -- Send end of record MSG_EOR : constant := 128; -- Send end of record
MSG_WAITALL : constant := 256; -- Wait for full reception MSG_WAITALL : constant := 256; -- Wait for full reception
MSG_NOSIGNAL : constant := 16384; -- No SIGPIPE on send
MSG_Forced_Flags : constant := MSG_NOSIGNAL;
-------------------- --------------------
-- Socket options -- -- Socket options --
......
gcc/ada/g-socket.adb
...@@ -117,8 +117,7 @@ package body GNAT.Sockets is ...@@ -117,8 +117,7 @@ package body GNAT.Sockets is
function Resolve_Error function Resolve_Error
(Error_Value : Integer; (Error_Value : Integer;
From_Errno : Boolean := True) From_Errno : Boolean := True) return Error_Type;
return Error_Type;
-- Associate an enumeration value (error_type) to en error value -- Associate an enumeration value (error_type) to en error value
-- (errno). From_Errno prevents from mixing h_errno with errno. -- (errno). From_Errno prevents from mixing h_errno with errno.
...@@ -127,23 +126,24 @@ package body GNAT.Sockets is ...@@ -127,23 +126,24 @@ package body GNAT.Sockets is
-- Conversion functions -- Conversion functions
function To_Int (F : Request_Flag_Type) return C.int; function To_Int (F : Request_Flag_Type) return C.int;
-- Return the int value corresponding to the specified flags combination
function Set_Forced_Flags (F : C.int) return C.int;
-- Return F with the bits from Constants.MSG_Forced_Flags forced set
function Short_To_Network function Short_To_Network
(S : C.unsigned_short) (S : C.unsigned_short) return C.unsigned_short;
return C.unsigned_short;
pragma Inline (Short_To_Network); pragma Inline (Short_To_Network);
-- Convert a port number into a network port number -- Convert a port number into a network port number
function Network_To_Short function Network_To_Short
(S : C.unsigned_short) (S : C.unsigned_short) return C.unsigned_short
return C.unsigned_short
renames Short_To_Network; renames Short_To_Network;
-- Symetric operation -- Symetric operation
function Image function Image
(Val : Inet_Addr_VN_Type; (Val : Inet_Addr_VN_Type;
Hex : Boolean := False) Hex : Boolean := False) return String;
return String;
-- Output an array of inet address components either in -- Output an array of inet address components either in
-- hexadecimal or in decimal mode. -- hexadecimal or in decimal mode.
...@@ -172,7 +172,7 @@ package body GNAT.Sockets is ...@@ -172,7 +172,7 @@ package body GNAT.Sockets is
-- (note hstrerror seems to be obsolete). -- (note hstrerror seems to be obsolete).
procedure Narrow (Item : in out Socket_Set_Type); procedure Narrow (Item : in out Socket_Set_Type);
-- Update Last as it may be greater than the real last socket. -- Update Last as it may be greater than the real last socket
-- Types needed for Datagram_Socket_Stream_Type -- Types needed for Datagram_Socket_Stream_Type
...@@ -267,9 +267,8 @@ package body GNAT.Sockets is ...@@ -267,9 +267,8 @@ package body GNAT.Sockets is
--------------- ---------------
function Addresses function Addresses
(E : Host_Entry_Type; (E : Host_Entry_Type;
N : Positive := 1) N : Positive := 1) return Inet_Addr_Type
return Inet_Addr_Type
is is
begin begin
return E.Addresses (N); return E.Addresses (N);
...@@ -289,9 +288,8 @@ package body GNAT.Sockets is ...@@ -289,9 +288,8 @@ package body GNAT.Sockets is
------------- -------------
function Aliases function Aliases
(E : Host_Entry_Type; (E : Host_Entry_Type;
N : Positive := 1) N : Positive := 1) return String
return String
is is
begin begin
return To_String (E.Aliases (N)); return To_String (E.Aliases (N));
...@@ -302,9 +300,8 @@ package body GNAT.Sockets is ...@@ -302,9 +300,8 @@ package body GNAT.Sockets is
------------- -------------
function Aliases function Aliases
(S : Service_Entry_Type; (S : Service_Entry_Type;
N : Positive := 1) N : Positive := 1) return String
return String
is is
begin begin
return To_String (S.Aliases (N)); return To_String (S.Aliases (N));
...@@ -431,6 +428,10 @@ package body GNAT.Sockets is ...@@ -431,6 +428,10 @@ package body GNAT.Sockets is
ESet.Set, ESet.Set,
TPtr); TPtr);
if Res = Failure then
Raise_Socket_Error (Socket_Errno);
end if;
-- If Select was resumed because of read signalling socket, -- If Select was resumed because of read signalling socket,
-- read this data and remove socket from set. -- read this data and remove socket from set.
...@@ -456,7 +457,7 @@ package body GNAT.Sockets is ...@@ -456,7 +457,7 @@ package body GNAT.Sockets is
Narrow (WSet); Narrow (WSet);
Narrow (ESet); Narrow (ESet);
-- Reset RSet as it should be if R_Sig_Socket was not added. -- Reset RSet as it should be if R_Sig_Socket was not added
if Is_Empty (RSet) then if Is_Empty (RSet) then
Empty (RSet); Empty (RSet);
...@@ -470,7 +471,7 @@ package body GNAT.Sockets is ...@@ -470,7 +471,7 @@ package body GNAT.Sockets is
Empty (ESet); Empty (ESet);
end if; end if;
-- Deliver RSet, WSet and ESet. -- Deliver RSet, WSet and ESet
Empty (R_Socket_Set); Empty (R_Socket_Set);
R_Socket_Set := RSet; R_Socket_Set := RSet;
...@@ -822,8 +823,7 @@ package body GNAT.Sockets is ...@@ -822,8 +823,7 @@ package body GNAT.Sockets is
function Get_Host_By_Address function Get_Host_By_Address
(Address : Inet_Addr_Type; (Address : Inet_Addr_Type;
Family : Family_Type := Family_Inet) Family : Family_Type := Family_Inet) return Host_Entry_Type
return Host_Entry_Type
is is
pragma Unreferenced (Family); pragma Unreferenced (Family);
...@@ -865,7 +865,7 @@ package body GNAT.Sockets is ...@@ -865,7 +865,7 @@ package body GNAT.Sockets is
Err : Integer; Err : Integer;
begin begin
-- Detect IP address name and redirect to Inet_Addr. -- Detect IP address name and redirect to Inet_Addr
if Is_IP_Address (Name) then if Is_IP_Address (Name) then
return Get_Host_By_Address (Inet_Addr (Name)); return Get_Host_By_Address (Inet_Addr (Name));
...@@ -920,8 +920,7 @@ package body GNAT.Sockets is ...@@ -920,8 +920,7 @@ package body GNAT.Sockets is
function Get_Service_By_Name function Get_Service_By_Name
(Name : String; (Name : String;
Protocol : String) Protocol : String) return Service_Entry_Type
return Service_Entry_Type
is is
SN : constant C.char_array := C.To_C (Name); SN : constant C.char_array := C.To_C (Name);
SP : constant C.char_array := C.To_C (Protocol); SP : constant C.char_array := C.To_C (Protocol);
...@@ -957,8 +956,7 @@ package body GNAT.Sockets is ...@@ -957,8 +956,7 @@ package body GNAT.Sockets is
function Get_Service_By_Port function Get_Service_By_Port
(Port : Port_Type; (Port : Port_Type;
Protocol : String) Protocol : String) return Service_Entry_Type
return Service_Entry_Type
is is
SP : constant C.char_array := C.To_C (Protocol); SP : constant C.char_array := C.To_C (Protocol);
Res : Servent_Access; Res : Servent_Access;
...@@ -993,8 +991,7 @@ package body GNAT.Sockets is ...@@ -993,8 +991,7 @@ package body GNAT.Sockets is
--------------------- ---------------------
function Get_Socket_Name function Get_Socket_Name
(Socket : Socket_Type) (Socket : Socket_Type) return Sock_Addr_Type
return Sock_Addr_Type
is is
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr_In;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
...@@ -1018,8 +1015,7 @@ package body GNAT.Sockets is ...@@ -1018,8 +1015,7 @@ package body GNAT.Sockets is
function Get_Socket_Option function Get_Socket_Option
(Socket : Socket_Type; (Socket : Socket_Type;
Level : Level_Type := Socket_Level; Level : Level_Type := Socket_Level;
Name : Option_Name) Name : Option_Name) return Option_Type
return Option_Type
is is
use type C.unsigned_char; use type C.unsigned_char;
...@@ -1087,8 +1083,8 @@ package body GNAT.Sockets is ...@@ -1087,8 +1083,8 @@ package body GNAT.Sockets is
when Add_Membership | when Add_Membership |
Drop_Membership => Drop_Membership =>
Opt.Multiaddr := To_Inet_Addr (To_In_Addr (V8 (V8'First))); Opt.Multicast_Address := To_Inet_Addr (To_In_Addr (V8 (V8'First)));
Opt.Interface := To_Inet_Addr (To_In_Addr (V8 (V8'Last))); Opt.Local_Interface := To_Inet_Addr (To_In_Addr (V8 (V8'Last)));
when Multicast_TTL => when Multicast_TTL =>
Opt.Time_To_Live := Integer (V1); Opt.Time_To_Live := Integer (V1);
...@@ -1124,9 +1120,8 @@ package body GNAT.Sockets is ...@@ -1124,9 +1120,8 @@ package body GNAT.Sockets is
----------- -----------
function Image function Image
(Val : Inet_Addr_VN_Type; (Val : Inet_Addr_VN_Type;
Hex : Boolean := False) Hex : Boolean := False) return String
return String
is is
-- The largest Inet_Addr_Comp_Type image occurs with IPv4. It -- The largest Inet_Addr_Comp_Type image occurs with IPv4. It
-- has at most a length of 3 plus one '.' character. -- has at most a length of 3 plus one '.' character.
...@@ -1141,6 +1136,10 @@ package body GNAT.Sockets is ...@@ -1141,6 +1136,10 @@ package body GNAT.Sockets is
procedure Img16 (V : Inet_Addr_Comp_Type); procedure Img16 (V : Inet_Addr_Comp_Type);
-- Append to Buffer image of V in hexadecimal format -- Append to Buffer image of V in hexadecimal format
-----------
-- Img10 --
-----------
procedure Img10 (V : Inet_Addr_Comp_Type) is procedure Img10 (V : Inet_Addr_Comp_Type) is
Img : constant String := V'Img; Img : constant String := V'Img;
Len : constant Natural := Img'Length - 1; Len : constant Natural := Img'Length - 1;
...@@ -1150,6 +1149,10 @@ package body GNAT.Sockets is ...@@ -1150,6 +1149,10 @@ package body GNAT.Sockets is
Length := Length + Len; Length := Length + Len;
end Img10; end Img10;
-----------
-- Img16 --
-----------
procedure Img16 (V : Inet_Addr_Comp_Type) is procedure Img16 (V : Inet_Addr_Comp_Type) is
begin begin
Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1); Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
...@@ -1201,7 +1204,6 @@ package body GNAT.Sockets is ...@@ -1201,7 +1204,6 @@ package body GNAT.Sockets is
function Image (Value : Sock_Addr_Type) return String is function Image (Value : Sock_Addr_Type) return String is
Port : constant String := Value.Port'Img; Port : constant String := Value.Port'Img;
begin begin
return Image (Value.Addr) & ':' & Port (2 .. Port'Last); return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
end Image; end Image;
...@@ -1282,8 +1284,7 @@ package body GNAT.Sockets is ...@@ -1282,8 +1284,7 @@ package body GNAT.Sockets is
function Is_Set function Is_Set
(Item : Socket_Set_Type; (Item : Socket_Set_Type;
Socket : Socket_Type) Socket : Socket_Type) return Boolean
return Boolean
is is
begin begin
return Item.Last /= No_Socket return Item.Last /= No_Socket
...@@ -1299,10 +1300,8 @@ package body GNAT.Sockets is ...@@ -1299,10 +1300,8 @@ package body GNAT.Sockets is
(Socket : Socket_Type; (Socket : Socket_Type;
Length : Positive := 15) Length : Positive := 15)
is is
Res : C.int; Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
begin begin
Res := C_Listen (C.int (Socket), C.int (Length));
if Res = Failure then if Res = Failure then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
end if; end if;
...@@ -1314,7 +1313,6 @@ package body GNAT.Sockets is ...@@ -1314,7 +1313,6 @@ package body GNAT.Sockets is
procedure Narrow (Item : in out Socket_Set_Type) is procedure Narrow (Item : in out Socket_Set_Type) is
Last : aliased C.int := C.int (Item.Last); Last : aliased C.int := C.int (Item.Last);
begin begin
if Item.Set /= No_Socket_Set then if Item.Set /= No_Socket_Set then
Last_Socket_In_Set (Item.Set, Last'Unchecked_Access); Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
...@@ -1364,12 +1362,16 @@ package body GNAT.Sockets is ...@@ -1364,12 +1362,16 @@ package body GNAT.Sockets is
procedure Raise_Host_Error (Error : Integer) is procedure Raise_Host_Error (Error : Integer) is
function Error_Message return String; function Host_Error_Message return String;
-- We do not use a C function like strerror because hstrerror -- We do not use a C function like strerror because hstrerror
-- that would correspond seems to be obsolete. Return -- that would correspond seems to be obsolete. Return
-- appropriate string for error value. -- appropriate string for error value.
function Error_Message return String is ------------------------
-- Host_Error_Message --
------------------------
function Host_Error_Message return String is
begin begin
case Error is case Error is
when Constants.HOST_NOT_FOUND => return "Host not found"; when Constants.HOST_NOT_FOUND => return "Host not found";
...@@ -1378,12 +1380,12 @@ package body GNAT.Sockets is ...@@ -1378,12 +1380,12 @@ package body GNAT.Sockets is
when Constants.NO_DATA => return "No address"; when Constants.NO_DATA => return "No address";
when others => return "Unknown error"; when others => return "Unknown error";
end case; end case;
end Error_Message; end Host_Error_Message;
-- Start of processing for Raise_Host_Error -- Start of processing for Raise_Host_Error
begin begin
Ada.Exceptions.Raise_Exception (Host_Error'Identity, Error_Message); Ada.Exceptions.Raise_Exception (Host_Error'Identity, Host_Error_Message);
end Raise_Host_Error; end Raise_Host_Error;
------------------------ ------------------------
...@@ -1394,6 +1396,11 @@ package body GNAT.Sockets is ...@@ -1394,6 +1396,11 @@ package body GNAT.Sockets is
use type C.Strings.chars_ptr; use type C.Strings.chars_ptr;
function Image (E : Integer) return String; function Image (E : Integer) return String;
-----------
-- Image --
-----------
function Image (E : Integer) return String is function Image (E : Integer) return String is
Msg : String := E'Img & "] "; Msg : String := E'Img & "] ";
begin begin
...@@ -1401,6 +1408,8 @@ package body GNAT.Sockets is ...@@ -1401,6 +1408,8 @@ package body GNAT.Sockets is
return Msg; return Msg;
end Image; end Image;
-- Start of processing for Raise_Socket_Error
begin begin
Ada.Exceptions.Raise_Exception Ada.Exceptions.Raise_Exception
(Socket_Error'Identity, (Socket_Error'Identity,
...@@ -1507,9 +1516,9 @@ package body GNAT.Sockets is ...@@ -1507,9 +1516,9 @@ package body GNAT.Sockets is
is is
use type Ada.Streams.Stream_Element_Offset; use type Ada.Streams.Stream_Element_Offset;
Res : C.int; Res : C.int;
Sin : aliased Sockaddr_In; Sin : aliased Sockaddr_In;
Len : aliased C.int := Sin'Size / 8; Len : aliased C.int := Sin'Size / 8;
begin begin
Res := Res :=
...@@ -1537,8 +1546,7 @@ package body GNAT.Sockets is ...@@ -1537,8 +1546,7 @@ package body GNAT.Sockets is
function Resolve_Error function Resolve_Error
(Error_Value : Integer; (Error_Value : Integer;
From_Errno : Boolean := True) From_Errno : Boolean := True) return Error_Type
return Error_Type
is is
use GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
...@@ -1608,8 +1616,7 @@ package body GNAT.Sockets is ...@@ -1608,8 +1616,7 @@ package body GNAT.Sockets is
----------------------- -----------------------
function Resolve_Exception function Resolve_Exception
(Occurrence : Exception_Occurrence) (Occurrence : Exception_Occurrence) return Error_Type
return Error_Type
is is
Id : constant Exception_Id := Exception_Identity (Occurrence); Id : constant Exception_Id := Exception_Identity (Occurrence);
Msg : constant String := Exception_Message (Occurrence); Msg : constant String := Exception_Message (Occurrence);
...@@ -1640,10 +1647,8 @@ package body GNAT.Sockets is ...@@ -1640,10 +1647,8 @@ package body GNAT.Sockets is
if Id = Socket_Error_Id then if Id = Socket_Error_Id then
return Resolve_Error (Val); return Resolve_Error (Val);
elsif Id = Host_Error_Id then elsif Id = Host_Error_Id then
return Resolve_Error (Val, False); return Resolve_Error (Val, False);
else else
return Cannot_Resolve_Error; return Cannot_Resolve_Error;
end if; end if;
...@@ -1694,7 +1699,7 @@ package body GNAT.Sockets is ...@@ -1694,7 +1699,7 @@ package body GNAT.Sockets is
(C.int (Socket), (C.int (Socket),
Item (Item'First)'Address, Item (Item'First)'Address,
Item'Length, Item'Length,
To_Int (Flags)); Set_Forced_Flags (To_Int (Flags)));
if Res = Failure then if Res = Failure then
Raise_Socket_Error (Socket_Errno); Raise_Socket_Error (Socket_Errno);
...@@ -1732,7 +1737,7 @@ package body GNAT.Sockets is ...@@ -1732,7 +1737,7 @@ package body GNAT.Sockets is
(C.int (Socket), (C.int (Socket),
Item (Item'First)'Address, Item (Item'First)'Address,
Item'Length, Item'Length,
To_Int (Flags), Set_Forced_Flags (To_Int (Flags)),
Sin'Unchecked_Access, Sin'Unchecked_Access,
Len); Len);
...@@ -1753,6 +1758,7 @@ package body GNAT.Sockets is ...@@ -1753,6 +1758,7 @@ package body GNAT.Sockets is
Count : out Ada.Streams.Stream_Element_Count) Count : out Ada.Streams.Stream_Element_Count)
is is
Res : C.int; Res : C.int;
begin begin
Res := Res :=
C_Writev C_Writev
...@@ -1784,6 +1790,20 @@ package body GNAT.Sockets is ...@@ -1784,6 +1790,20 @@ package body GNAT.Sockets is
Insert_Socket_In_Set (Item.Set, C.int (Socket)); Insert_Socket_In_Set (Item.Set, C.int (Socket));
end Set; end Set;
----------------------
-- Set_Forced_Flags --
----------------------
function Set_Forced_Flags (F : C.int) return C.int is
use type C.unsigned;
function To_unsigned is
new Ada.Unchecked_Conversion (C.int, C.unsigned);
function To_int is
new Ada.Unchecked_Conversion (C.unsigned, C.int);
begin
return To_int (To_unsigned (F) or Constants.MSG_Forced_Flags);
end Set_Forced_Flags;
----------------------- -----------------------
-- Set_Socket_Option -- -- Set_Socket_Option --
----------------------- -----------------------
...@@ -1829,8 +1849,8 @@ package body GNAT.Sockets is ...@@ -1829,8 +1849,8 @@ package body GNAT.Sockets is
when Add_Membership | when Add_Membership |
Drop_Membership => Drop_Membership =>
V8 (V8'First) := To_Int (To_In_Addr (Option.Multiaddr)); V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
V8 (V8'Last) := To_Int (To_In_Addr (Option.Interface)); V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
Len := V8'Size / 8; Len := V8'Size / 8;
Add := V8'Address; Add := V8'Address;
...@@ -1908,8 +1928,7 @@ package body GNAT.Sockets is ...@@ -1908,8 +1928,7 @@ package body GNAT.Sockets is
function Stream function Stream
(Socket : Socket_Type; (Socket : Socket_Type;
Send_To : Sock_Addr_Type) Send_To : Sock_Addr_Type) return Stream_Access
return Stream_Access
is is
S : Datagram_Socket_Stream_Access; S : Datagram_Socket_Stream_Access;
...@@ -1966,10 +1985,10 @@ package body GNAT.Sockets is ...@@ -1966,10 +1985,10 @@ package body GNAT.Sockets is
-- H_Length is not used because it is currently only set to 4. -- H_Length is not used because it is currently only set to 4.
-- H_Addrtype is always AF_INET -- H_Addrtype is always AF_INET
Result : Host_Entry_Type Result : Host_Entry_Type
(Aliases_Length => Aliases'Length - 1, (Aliases_Length => Aliases'Length - 1,
Addresses_Length => Addresses'Length - 1); Addresses_Length => Addresses'Length - 1);
-- The last element is a null pointer. -- The last element is a null pointer
Source : C.size_t; Source : C.size_t;
Target : Natural; Target : Natural;
...@@ -2019,17 +2038,14 @@ package body GNAT.Sockets is ...@@ -2019,17 +2038,14 @@ package body GNAT.Sockets is
------------------ ------------------
function To_Inet_Addr function To_Inet_Addr
(Addr : In_Addr) (Addr : In_Addr) return Inet_Addr_Type
return Inet_Addr_Type
is is
Result : Inet_Addr_Type; Result : Inet_Addr_Type;
begin begin
Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1); Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2); Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3); Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4); Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
return Result; return Result;
end To_Inet_Addr; end To_Inet_Addr;
...@@ -2088,7 +2104,7 @@ package body GNAT.Sockets is ...@@ -2088,7 +2104,7 @@ package body GNAT.Sockets is
Result : Service_Entry_Type Result : Service_Entry_Type
(Aliases_Length => Aliases'Length - 1); (Aliases_Length => Aliases'Length - 1);
-- The last element is a null pointer. -- The last element is a null pointer
Source : C.size_t; Source : C.size_t;
Target : Natural; Target : Natural;
...@@ -2138,6 +2154,7 @@ package body GNAT.Sockets is ...@@ -2138,6 +2154,7 @@ package body GNAT.Sockets is
MS := 0; MS := 0;
-- Normal case where we do round down -- Normal case where we do round down
else else
S := Timeval_Unit (Val - 0.5); S := Timeval_Unit (Val - 0.5);
MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S))); MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S)));
......
gcc/ada/g-socket.ads
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2001-2003 Ada Core Technologies, Inc. -- -- Copyright (C) 2001-2004 Ada Core Technologies, Inc. --
-- -- -- --
-- 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- --
...@@ -399,35 +399,32 @@ package GNAT.Sockets is ...@@ -399,35 +399,32 @@ package GNAT.Sockets is
No_Socket : constant Socket_Type; No_Socket : constant Socket_Type;
Socket_Error : exception; Socket_Error : exception;
-- There is only one exception in this package to deal with an -- There is only one exception in this package to deal with an error during
-- error during a socket routine. Once raised, its message -- a socket routine. Once raised, its message contains a string describing
-- contains a string describing the error code. -- the error code.
function Image (Socket : Socket_Type) return String; function Image (Socket : Socket_Type) return String;
-- Return a printable string for Socket -- Return a printable string for Socket
function To_C (Socket : Socket_Type) return Integer; function To_C (Socket : Socket_Type) return Integer;
-- Return a file descriptor to be used by external subprograms -- Return a file descriptor to be used by external subprograms. This is
-- especially the C functions that are not yet interfaced in this -- useful for C functions that are not yet interfaced in this package.
-- package.
type Family_Type is (Family_Inet, Family_Inet6); type Family_Type is (Family_Inet, Family_Inet6);
-- Address family (or protocol family) identifies the -- Address family (or protocol family) identifies the communication domain
-- communication domain and groups protocols with similar address -- and groups protocols with similar address formats. IPv6 will soon be
-- formats. IPv6 will soon be supported. -- supported.
type Mode_Type is (Socket_Stream, Socket_Datagram); type Mode_Type is (Socket_Stream, Socket_Datagram);
-- Stream sockets provide connection-oriented byte -- Stream sockets provide connection-oriented byte streams. Datagram
-- streams. Datagram sockets support unreliable connectionless -- sockets support unreliable connectionless message based communication.
-- message based communication.
type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write); type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write);
-- When a process closes a socket, the policy is to retain any -- When a process closes a socket, the policy is to retain any data queued
-- data queued until either a delivery or a timeout expiration (in -- until either a delivery or a timeout expiration (in this case, the data
-- this case, the data are discarded). A finer control is -- are discarded). A finer control is available through shutdown. With
-- available through shutdown. With Shut_Read, no more data can be -- Shut_Read, no more data can be received from the socket. With_Write, no
-- received from the socket. With_Write, no more data can be -- more data can be transmitted. Neither transmission nor reception can be
-- transmitted. Neither transmission nor reception can be
-- performed with Shut_Read_Write. -- performed with Shut_Read_Write.
type Port_Type is new Natural; type Port_Type is new Natural;
...@@ -440,8 +437,8 @@ package GNAT.Sockets is ...@@ -440,8 +437,8 @@ package GNAT.Sockets is
type Inet_Addr_Type (Family : Family_Type := Family_Inet) is private; type Inet_Addr_Type (Family : Family_Type := Family_Inet) is private;
-- An Internet address depends on an address family (IPv4 contains -- An Internet address depends on an address family (IPv4 contains
-- 4 octets and Ipv6 contains 16 octets). Any_Inet_Address is a -- 4 octets and Ipv6 contains 16 octets). Any_Inet_Addr is a special
-- special value treated like a wildcard enabling all addresses. -- value treated like a wildcard enabling all addresses.
-- No_Inet_Addr provides a special value to denote uninitialized -- No_Inet_Addr provides a special value to denote uninitialized
-- inet addresses. -- inet addresses.
...@@ -488,15 +485,13 @@ package GNAT.Sockets is ...@@ -488,15 +485,13 @@ package GNAT.Sockets is
-- Return number of addresses in host entry -- Return number of addresses in host entry
function Aliases function Aliases
(E : Host_Entry_Type; (E : Host_Entry_Type;
N : Positive := 1) N : Positive := 1) return String;
return String;
-- Return N'th aliases in host entry. The first index is 1. -- Return N'th aliases in host entry. The first index is 1.
function Addresses function Addresses
(E : Host_Entry_Type; (E : Host_Entry_Type;
N : Positive := 1) N : Positive := 1) return Inet_Addr_Type;
return Inet_Addr_Type;
-- Return N'th addresses in host entry. The first index is 1. -- Return N'th addresses in host entry. The first index is 1.
Host_Error : exception; Host_Error : exception;
...@@ -506,25 +501,22 @@ package GNAT.Sockets is ...@@ -506,25 +501,22 @@ package GNAT.Sockets is
function Get_Host_By_Address function Get_Host_By_Address
(Address : Inet_Addr_Type; (Address : Inet_Addr_Type;
Family : Family_Type := Family_Inet) Family : Family_Type := Family_Inet) return Host_Entry_Type;
return Host_Entry_Type;
-- Return host entry structure for the given inet address -- Return host entry structure for the given inet address
function Get_Host_By_Name function Get_Host_By_Name
(Name : String) (Name : String) return Host_Entry_Type;
return Host_Entry_Type;
-- Return host entry structure for the given host name. Here name -- Return host entry structure for the given host name. Here name
-- is either a host name, or an IP address. -- is either a host name, or an IP address.
function Host_Name return String; function Host_Name return String;
-- Return the name of the current host -- Return the name of the current host
type Service_Entry_Type (Aliases_Length : Natural) is private;
-- Service entries provide complete information on a given -- Service entries provide complete information on a given
-- service: the official name, an array of alternative names or -- service: the official name, an array of alternative names or
-- aliases and the port number. -- aliases and the port number.
type Service_Entry_Type (Aliases_Length : Natural) is private;
function Official_Name (S : Service_Entry_Type) return String; function Official_Name (S : Service_Entry_Type) return String;
-- Return official name in service entry -- Return official name in service entry
...@@ -538,31 +530,29 @@ package GNAT.Sockets is ...@@ -538,31 +530,29 @@ package GNAT.Sockets is
-- Return number of aliases in service entry -- Return number of aliases in service entry
function Aliases function Aliases
(S : Service_Entry_Type; (S : Service_Entry_Type;
N : Positive := 1) N : Positive := 1) return String;
return String;
-- Return N'th aliases in service entry. The first index is 1. -- Return N'th aliases in service entry. The first index is 1.
function Get_Service_By_Name function Get_Service_By_Name
(Name : String; (Name : String;
Protocol : String) Protocol : String) return Service_Entry_Type;
return Service_Entry_Type;
-- Return service entry structure for the given service name -- Return service entry structure for the given service name
function Get_Service_By_Port function Get_Service_By_Port
(Port : Port_Type; (Port : Port_Type;
Protocol : String) Protocol : String) return Service_Entry_Type;
return Service_Entry_Type;
-- Return service entry structure for the given service port number -- Return service entry structure for the given service port number
Service_Error : exception; Service_Error : exception;
-- Comment required ???
-- Errors are described by an enumeration type. There is only one -- Errors are described by an enumeration type. There is only one
-- exception Socket_Error in this package to deal with an error -- exception Socket_Error in this package to deal with an error
-- during a socket routine. Once raised, its message contains the -- during a socket routine. Once raised, its message contains the
-- error code between brackets and a string describing the error code. -- error code between brackets and a string describing the error code.
-- The name of the enumeration constant documents the error condition. -- The name of the enumeration constant documents the error condition
type Error_Type is type Error_Type is
(Success, (Success,
...@@ -665,8 +655,8 @@ package GNAT.Sockets is ...@@ -665,8 +655,8 @@ package GNAT.Sockets is
when Add_Membership | when Add_Membership |
Drop_Membership => Drop_Membership =>
Multiaddr : Inet_Addr_Type; Multicast_Address : Inet_Addr_Type;
Interface : Inet_Addr_Type; Local_Interface : Inet_Addr_Type;
when Multicast_TTL => when Multicast_TTL =>
Time_To_Live : Natural; Time_To_Live : Natural;
...@@ -786,8 +776,7 @@ package GNAT.Sockets is ...@@ -786,8 +776,7 @@ package GNAT.Sockets is
function Get_Socket_Option function Get_Socket_Option
(Socket : Socket_Type; (Socket : Socket_Type;
Level : Level_Type := Socket_Level; Level : Level_Type := Socket_Level;
Name : Option_Name) Name : Option_Name) return Option_Type;
return Option_Type;
-- Get the options associated with a socket. Raises Socket_Error -- Get the options associated with a socket. Raises Socket_Error
-- on error. -- on error.
...@@ -830,8 +819,7 @@ package GNAT.Sockets is ...@@ -830,8 +819,7 @@ package GNAT.Sockets is
-- elements Vector. Count is set to the count of received stream elements. -- elements Vector. Count is set to the count of received stream elements.
function Resolve_Exception function Resolve_Exception
(Occurrence : Ada.Exceptions.Exception_Occurrence) (Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type;
return Error_Type;
-- When Socket_Error or Host_Error are raised, the exception -- When Socket_Error or Host_Error are raised, the exception
-- message contains the error code between brackets and a string -- message contains the error code between brackets and a string
-- describing the error code. Resolve_Error extracts the error -- describing the error code. Resolve_Error extracts the error
...@@ -884,24 +872,20 @@ package GNAT.Sockets is ...@@ -884,24 +872,20 @@ package GNAT.Sockets is
-- Same interface as Ada.Streams.Stream_IO -- Same interface as Ada.Streams.Stream_IO
function Stream function Stream
(Socket : Socket_Type) (Socket : Socket_Type) return Stream_Access;
return Stream_Access;
-- Create a stream associated with a stream-based socket that is -- Create a stream associated with a stream-based socket that is
-- already connected. -- already connected.
function Stream function Stream
(Socket : Socket_Type; (Socket : Socket_Type;
Send_To : Sock_Addr_Type) Send_To : Sock_Addr_Type) return Stream_Access;
return Stream_Access;
-- Create a stream associated with a datagram-based socket that is -- Create a stream associated with a datagram-based socket that is
-- already bound. Send_To is the socket address to which messages are -- already bound. Send_To is the socket address to which messages are
-- being sent. -- being sent.
function Get_Address function Get_Address
(Stream : Stream_Access) (Stream : Stream_Access) return Sock_Addr_Type;
return Sock_Addr_Type; -- Return the socket address from which the last message was received.
-- Return the socket address from which the last message was
-- received.
procedure Free is new Ada.Unchecked_Deallocation procedure Free is new Ada.Unchecked_Deallocation
(Ada.Streams.Root_Stream_Type'Class, Stream_Access); (Ada.Streams.Root_Stream_Type'Class, Stream_Access);
...@@ -930,17 +914,15 @@ package GNAT.Sockets is ...@@ -930,17 +914,15 @@ package GNAT.Sockets is
-- No_Socket when the set is empty. -- No_Socket when the set is empty.
function Is_Empty function Is_Empty
(Item : Socket_Set_Type) (Item : Socket_Set_Type) return Boolean;
return Boolean; -- Return True iff Item is empty
-- Return True if Item is empty
function Is_Set function Is_Set
(Item : Socket_Set_Type; (Item : Socket_Set_Type;
Socket : Socket_Type) Socket : Socket_Type) return Boolean;
return Boolean; -- Return True iff Socket is present in Item
-- Return True if Socket is present in Item
procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type); procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type);
-- Insert Socket into Item -- Insert Socket into Item
-- C select() waits for a number of file descriptors to change -- C select() waits for a number of file descriptors to change
......
gcc/ada/g-socthi.adb
...@@ -61,10 +61,13 @@ package body GNAT.Sockets.Thin is ...@@ -61,10 +61,13 @@ package body GNAT.Sockets.Thin is
-- two attempts on a blocking operation. -- two attempts on a blocking operation.
Thread_Blocking_IO : Boolean := True; Thread_Blocking_IO : Boolean := True;
-- Comment required for this ???
Unknown_System_Error : constant C.Strings.chars_ptr := Unknown_System_Error : constant C.Strings.chars_ptr :=
C.Strings.New_String ("Unknown system error"); C.Strings.New_String ("Unknown system error");
-- Comments required for following functions ???
function Syscall_Accept function Syscall_Accept
(S : C.int; (S : C.int;
Addr : System.Address; Addr : System.Address;
...@@ -121,6 +124,9 @@ package body GNAT.Sockets.Thin is ...@@ -121,6 +124,9 @@ package body GNAT.Sockets.Thin is
Protocol : C.int) return C.int; Protocol : C.int) return C.int;
pragma Import (C, Syscall_Socket, "socket"); pragma Import (C, Syscall_Socket, "socket");
procedure Disable_SIGPIPE (S : C.int);
pragma Import (C, Disable_SIGPIPE, "__gnat_disable_sigpipe");
function Non_Blocking_Socket (S : C.int) return Boolean; function Non_Blocking_Socket (S : C.int) return Boolean;
procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean); procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
...@@ -160,6 +166,7 @@ package body GNAT.Sockets.Thin is ...@@ -160,6 +166,7 @@ package body GNAT.Sockets.Thin is
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access); Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
end if; end if;
Disable_SIGPIPE (R);
return R; return R;
end C_Accept; end C_Accept;
...@@ -377,7 +384,7 @@ package body GNAT.Sockets.Thin is ...@@ -377,7 +384,7 @@ package body GNAT.Sockets.Thin is
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access); Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Set_Non_Blocking_Socket (R, False); Set_Non_Blocking_Socket (R, False);
end if; end if;
Disable_SIGPIPE (R);
return R; return R;
end C_Socket; end C_Socket;
......
gcc/ada/socket.c
...@@ -64,8 +64,13 @@ ...@@ -64,8 +64,13 @@
#include "system.h" #include "system.h"
#endif #endif
#if !(defined (VMS) || defined (__MINGW32__))
# include <sys/socket.h>
#endif
#include "raise.h" #include "raise.h"
extern void __gnat_disable_sigpipe (int fd);
extern void __gnat_free_socket_set (fd_set *); extern void __gnat_free_socket_set (fd_set *);
extern void __gnat_last_socket_in_set (fd_set *, int *); extern void __gnat_last_socket_in_set (fd_set *, int *);
extern void __gnat_get_socket_from_set (fd_set *, int *, int *); extern void __gnat_get_socket_from_set (fd_set *, int *, int *);
...@@ -74,6 +79,16 @@ extern int __gnat_is_socket_in_set (fd_set *, int); ...@@ -74,6 +79,16 @@ extern int __gnat_is_socket_in_set (fd_set *, int);
extern fd_set *__gnat_new_socket_set (fd_set *); extern fd_set *__gnat_new_socket_set (fd_set *);
extern void __gnat_remove_socket_from_set (fd_set *, int); extern void __gnat_remove_socket_from_set (fd_set *, int);
/* Disable the sending of SIGPIPE for writes on a broken stream */
void
__gnat_disable_sigpipe (int fd)
{
#ifdef SO_NOSIGPIPE
int val = 1;
(void) setsockopt (fd, SOL_SOCKET, SO_NOSIGPIPE, &val, sizeof val);
#endif
}
/* Free socket set. */ /* Free socket set. */
void void
......
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