+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>
* misc.c (gnat_expand_body): Update call of tree_rest_of_compilation.
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := -1; -- Send end of record
MSG_WAITALL : constant := -1; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 8; -- Send end of record
MSG_WAITALL : constant := 64; -- Wait for full reception
+ MSG_NOSIGNAL : constant := -1; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := 0;
--------------------
-- Socket options --
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
MSG_PEEK : constant := 2; -- Peek at incoming data
MSG_EOR : constant := 128; -- Send end of record
MSG_WAITALL : constant := 256; -- Wait for full reception
+ MSG_NOSIGNAL : constant := 16384; -- No SIGPIPE on send
+ MSG_Forced_Flags : constant := MSG_NOSIGNAL;
--------------------
-- Socket options --
function Resolve_Error
(Error_Value : Integer;
- From_Errno : Boolean := True)
- return Error_Type;
+ From_Errno : Boolean := True) return Error_Type;
-- Associate an enumeration value (error_type) to en error value
-- (errno). From_Errno prevents from mixing h_errno with errno.
-- Conversion functions
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
- (S : C.unsigned_short)
- return C.unsigned_short;
+ (S : C.unsigned_short) return C.unsigned_short;
pragma Inline (Short_To_Network);
-- Convert a port number into a network port number
function Network_To_Short
- (S : C.unsigned_short)
- return C.unsigned_short
+ (S : C.unsigned_short) return C.unsigned_short
renames Short_To_Network;
-- Symetric operation
function Image
(Val : Inet_Addr_VN_Type;
- Hex : Boolean := False)
- return String;
+ Hex : Boolean := False) return String;
-- Output an array of inet address components either in
-- hexadecimal or in decimal mode.
-- (note hstrerror seems to be obsolete).
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
---------------
function Addresses
- (E : Host_Entry_Type;
- N : Positive := 1)
- return Inet_Addr_Type
+ (E : Host_Entry_Type;
+ N : Positive := 1) return Inet_Addr_Type
is
begin
return E.Addresses (N);
-------------
function Aliases
- (E : Host_Entry_Type;
- N : Positive := 1)
- return String
+ (E : Host_Entry_Type;
+ N : Positive := 1) return String
is
begin
return To_String (E.Aliases (N));
-------------
function Aliases
- (S : Service_Entry_Type;
- N : Positive := 1)
- return String
+ (S : Service_Entry_Type;
+ N : Positive := 1) return String
is
begin
return To_String (S.Aliases (N));
ESet.Set,
TPtr);
+ if Res = Failure then
+ Raise_Socket_Error (Socket_Errno);
+ end if;
+
-- If Select was resumed because of read signalling socket,
-- read this data and remove socket from set.
Narrow (WSet);
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
Empty (RSet);
Empty (ESet);
end if;
- -- Deliver RSet, WSet and ESet.
+ -- Deliver RSet, WSet and ESet
Empty (R_Socket_Set);
R_Socket_Set := RSet;
function Get_Host_By_Address
(Address : Inet_Addr_Type;
- Family : Family_Type := Family_Inet)
- return Host_Entry_Type
+ Family : Family_Type := Family_Inet) return Host_Entry_Type
is
pragma Unreferenced (Family);
Err : Integer;
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
return Get_Host_By_Address (Inet_Addr (Name));
function Get_Service_By_Name
(Name : String;
- Protocol : String)
- return Service_Entry_Type
+ Protocol : String) return Service_Entry_Type
is
SN : constant C.char_array := C.To_C (Name);
SP : constant C.char_array := C.To_C (Protocol);
function Get_Service_By_Port
(Port : Port_Type;
- Protocol : String)
- return Service_Entry_Type
+ Protocol : String) return Service_Entry_Type
is
SP : constant C.char_array := C.To_C (Protocol);
Res : Servent_Access;
---------------------
function Get_Socket_Name
- (Socket : Socket_Type)
- return Sock_Addr_Type
+ (Socket : Socket_Type) return Sock_Addr_Type
is
Sin : aliased Sockaddr_In;
Len : aliased C.int := Sin'Size / 8;
function Get_Socket_Option
(Socket : Socket_Type;
Level : Level_Type := Socket_Level;
- Name : Option_Name)
- return Option_Type
+ Name : Option_Name) return Option_Type
is
use type C.unsigned_char;
when Add_Membership |
Drop_Membership =>
- Opt.Multiaddr := To_Inet_Addr (To_In_Addr (V8 (V8'First)));
- Opt.Interface := To_Inet_Addr (To_In_Addr (V8 (V8'Last)));
+ Opt.Multicast_Address := To_Inet_Addr (To_In_Addr (V8 (V8'First)));
+ Opt.Local_Interface := To_Inet_Addr (To_In_Addr (V8 (V8'Last)));
when Multicast_TTL =>
Opt.Time_To_Live := Integer (V1);
-----------
function Image
- (Val : Inet_Addr_VN_Type;
- Hex : Boolean := False)
- return String
+ (Val : Inet_Addr_VN_Type;
+ Hex : Boolean := False) return String
is
-- The largest Inet_Addr_Comp_Type image occurs with IPv4. It
-- has at most a length of 3 plus one '.' character.
procedure Img16 (V : Inet_Addr_Comp_Type);
-- Append to Buffer image of V in hexadecimal format
+ -----------
+ -- Img10 --
+ -----------
+
procedure Img10 (V : Inet_Addr_Comp_Type) is
Img : constant String := V'Img;
Len : constant Natural := Img'Length - 1;
Length := Length + Len;
end Img10;
+ -----------
+ -- Img16 --
+ -----------
+
procedure Img16 (V : Inet_Addr_Comp_Type) is
begin
Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1);
function Image (Value : Sock_Addr_Type) return String is
Port : constant String := Value.Port'Img;
-
begin
return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
end Image;
function Is_Set
(Item : Socket_Set_Type;
- Socket : Socket_Type)
- return Boolean
+ Socket : Socket_Type) return Boolean
is
begin
return Item.Last /= No_Socket
(Socket : Socket_Type;
Length : Positive := 15)
is
- Res : C.int;
-
+ Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
begin
- Res := C_Listen (C.int (Socket), C.int (Length));
if Res = Failure then
Raise_Socket_Error (Socket_Errno);
end if;
procedure Narrow (Item : in out Socket_Set_Type) is
Last : aliased C.int := C.int (Item.Last);
-
begin
if Item.Set /= No_Socket_Set then
Last_Socket_In_Set (Item.Set, Last'Unchecked_Access);
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
-- that would correspond seems to be obsolete. Return
-- appropriate string for error value.
- function Error_Message return String is
+ ------------------------
+ -- Host_Error_Message --
+ ------------------------
+
+ function Host_Error_Message return String is
begin
case Error is
when Constants.HOST_NOT_FOUND => return "Host not found";
when Constants.NO_DATA => return "No address";
when others => return "Unknown error";
end case;
- end Error_Message;
+ end Host_Error_Message;
-- Start of processing for Raise_Host_Error
begin
- Ada.Exceptions.Raise_Exception (Host_Error'Identity, Error_Message);
+ Ada.Exceptions.Raise_Exception (Host_Error'Identity, Host_Error_Message);
end Raise_Host_Error;
------------------------
use type C.Strings.chars_ptr;
function Image (E : Integer) return String;
+
+ -----------
+ -- Image --
+ -----------
+
function Image (E : Integer) return String is
Msg : String := E'Img & "] ";
begin
return Msg;
end Image;
+ -- Start of processing for Raise_Socket_Error
+
begin
Ada.Exceptions.Raise_Exception
(Socket_Error'Identity,
is
use type Ada.Streams.Stream_Element_Offset;
- Res : C.int;
- Sin : aliased Sockaddr_In;
- Len : aliased C.int := Sin'Size / 8;
+ Res : C.int;
+ Sin : aliased Sockaddr_In;
+ Len : aliased C.int := Sin'Size / 8;
begin
Res :=
function Resolve_Error
(Error_Value : Integer;
- From_Errno : Boolean := True)
- return Error_Type
+ From_Errno : Boolean := True) return Error_Type
is
use GNAT.Sockets.Constants;
-----------------------
function Resolve_Exception
- (Occurrence : Exception_Occurrence)
- return Error_Type
+ (Occurrence : Exception_Occurrence) return Error_Type
is
Id : constant Exception_Id := Exception_Identity (Occurrence);
Msg : constant String := Exception_Message (Occurrence);
if Id = Socket_Error_Id then
return Resolve_Error (Val);
-
elsif Id = Host_Error_Id then
return Resolve_Error (Val, False);
-
else
return Cannot_Resolve_Error;
end if;
(C.int (Socket),
Item (Item'First)'Address,
Item'Length,
- To_Int (Flags));
+ Set_Forced_Flags (To_Int (Flags)));
if Res = Failure then
Raise_Socket_Error (Socket_Errno);
(C.int (Socket),
Item (Item'First)'Address,
Item'Length,
- To_Int (Flags),
+ Set_Forced_Flags (To_Int (Flags)),
Sin'Unchecked_Access,
Len);
Count : out Ada.Streams.Stream_Element_Count)
is
Res : C.int;
+
begin
Res :=
C_Writev
Insert_Socket_In_Set (Item.Set, C.int (Socket));
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 --
-----------------------
when Add_Membership |
Drop_Membership =>
- V8 (V8'First) := To_Int (To_In_Addr (Option.Multiaddr));
- V8 (V8'Last) := To_Int (To_In_Addr (Option.Interface));
+ V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
+ V8 (V8'Last) := To_Int (To_In_Addr (Option.Local_Interface));
Len := V8'Size / 8;
Add := V8'Address;
function Stream
(Socket : Socket_Type;
- Send_To : Sock_Addr_Type)
- return Stream_Access
+ Send_To : Sock_Addr_Type) return Stream_Access
is
S : Datagram_Socket_Stream_Access;
-- H_Length is not used because it is currently only set to 4.
-- H_Addrtype is always AF_INET
- Result : Host_Entry_Type
- (Aliases_Length => Aliases'Length - 1,
- Addresses_Length => Addresses'Length - 1);
- -- The last element is a null pointer.
+ Result : Host_Entry_Type
+ (Aliases_Length => Aliases'Length - 1,
+ Addresses_Length => Addresses'Length - 1);
+ -- The last element is a null pointer
Source : C.size_t;
Target : Natural;
------------------
function To_Inet_Addr
- (Addr : In_Addr)
- return Inet_Addr_Type
+ (Addr : In_Addr) return Inet_Addr_Type
is
Result : Inet_Addr_Type;
-
begin
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 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
-
return Result;
end To_Inet_Addr;
Result : Service_Entry_Type
(Aliases_Length => Aliases'Length - 1);
- -- The last element is a null pointer.
+ -- The last element is a null pointer
Source : C.size_t;
Target : Natural;
MS := 0;
-- Normal case where we do round down
+
else
S := Timeval_Unit (Val - 0.5);
MS := Timeval_Unit (1_000_000 * (Val - Selector_Duration (S)));
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
No_Socket : constant Socket_Type;
Socket_Error : exception;
- -- There is only one exception in this package to deal with an
- -- error during a socket routine. Once raised, its message
- -- contains a string describing the error code.
+ -- There is only one exception in this package to deal with an error during
+ -- a socket routine. Once raised, its message contains a string describing
+ -- the error code.
function Image (Socket : Socket_Type) return String;
-- Return a printable string for Socket
function To_C (Socket : Socket_Type) return Integer;
- -- Return a file descriptor to be used by external subprograms
- -- especially the C functions that are not yet interfaced in this
- -- package.
+ -- Return a file descriptor to be used by external subprograms. This is
+ -- useful for C functions that are not yet interfaced in this package.
type Family_Type is (Family_Inet, Family_Inet6);
- -- Address family (or protocol family) identifies the
- -- communication domain and groups protocols with similar address
- -- formats. IPv6 will soon be supported.
+ -- Address family (or protocol family) identifies the communication domain
+ -- and groups protocols with similar address formats. IPv6 will soon be
+ -- supported.
type Mode_Type is (Socket_Stream, Socket_Datagram);
- -- Stream sockets provide connection-oriented byte
- -- streams. Datagram sockets support unreliable connectionless
- -- message based communication.
+ -- Stream sockets provide connection-oriented byte streams. Datagram
+ -- sockets support unreliable connectionless message based communication.
type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write);
- -- When a process closes a socket, the policy is to retain any
- -- data queued until either a delivery or a timeout expiration (in
- -- this case, the data are discarded). A finer control is
- -- available through shutdown. With Shut_Read, no more data can be
- -- received from the socket. With_Write, no more data can be
- -- transmitted. Neither transmission nor reception can be
+ -- When a process closes a socket, the policy is to retain any data queued
+ -- until either a delivery or a timeout expiration (in this case, the data
+ -- are discarded). A finer control is available through shutdown. With
+ -- Shut_Read, no more data can be received from the socket. With_Write, no
+ -- more data can be transmitted. Neither transmission nor reception can be
-- performed with Shut_Read_Write.
type Port_Type is new Natural;
type Inet_Addr_Type (Family : Family_Type := Family_Inet) is private;
-- An Internet address depends on an address family (IPv4 contains
- -- 4 octets and Ipv6 contains 16 octets). Any_Inet_Address is a
- -- special value treated like a wildcard enabling all addresses.
+ -- 4 octets and Ipv6 contains 16 octets). Any_Inet_Addr is a special
+ -- value treated like a wildcard enabling all addresses.
-- No_Inet_Addr provides a special value to denote uninitialized
-- inet addresses.
-- Return number of addresses in host entry
function Aliases
- (E : Host_Entry_Type;
- N : Positive := 1)
- return String;
+ (E : Host_Entry_Type;
+ N : Positive := 1) return String;
-- Return N'th aliases in host entry. The first index is 1.
function Addresses
- (E : Host_Entry_Type;
- N : Positive := 1)
- return Inet_Addr_Type;
+ (E : Host_Entry_Type;
+ N : Positive := 1) return Inet_Addr_Type;
-- Return N'th addresses in host entry. The first index is 1.
Host_Error : exception;
function Get_Host_By_Address
(Address : Inet_Addr_Type;
- Family : Family_Type := Family_Inet)
- return Host_Entry_Type;
+ Family : Family_Type := Family_Inet) return Host_Entry_Type;
-- Return host entry structure for the given inet address
function Get_Host_By_Name
- (Name : String)
- return Host_Entry_Type;
+ (Name : String) return Host_Entry_Type;
-- Return host entry structure for the given host name. Here name
-- is either a host name, or an IP address.
function Host_Name return String;
-- 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: the official name, an array of alternative names or
-- aliases and the port number.
- type Service_Entry_Type (Aliases_Length : Natural) is private;
-
function Official_Name (S : Service_Entry_Type) return String;
-- Return official name in service entry
-- Return number of aliases in service entry
function Aliases
- (S : Service_Entry_Type;
- N : Positive := 1)
- return String;
+ (S : Service_Entry_Type;
+ N : Positive := 1) return String;
-- Return N'th aliases in service entry. The first index is 1.
function Get_Service_By_Name
(Name : String;
- Protocol : String)
- return Service_Entry_Type;
+ Protocol : String) return Service_Entry_Type;
-- Return service entry structure for the given service name
function Get_Service_By_Port
(Port : Port_Type;
- Protocol : String)
- return Service_Entry_Type;
+ Protocol : String) return Service_Entry_Type;
-- Return service entry structure for the given service port number
Service_Error : exception;
+ -- Comment required ???
-- Errors are described by an enumeration type. There is only one
-- exception Socket_Error in this package to deal with an error
-- during a socket routine. Once raised, its message contains the
-- 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
(Success,
when Add_Membership |
Drop_Membership =>
- Multiaddr : Inet_Addr_Type;
- Interface : Inet_Addr_Type;
+ Multicast_Address : Inet_Addr_Type;
+ Local_Interface : Inet_Addr_Type;
when Multicast_TTL =>
Time_To_Live : Natural;
function Get_Socket_Option
(Socket : Socket_Type;
Level : Level_Type := Socket_Level;
- Name : Option_Name)
- return Option_Type;
+ Name : Option_Name) return Option_Type;
-- Get the options associated with a socket. Raises Socket_Error
-- on error.
-- elements Vector. Count is set to the count of received stream elements.
function Resolve_Exception
- (Occurrence : Ada.Exceptions.Exception_Occurrence)
- return Error_Type;
+ (Occurrence : Ada.Exceptions.Exception_Occurrence) return Error_Type;
-- When Socket_Error or Host_Error are raised, the exception
-- message contains the error code between brackets and a string
-- describing the error code. Resolve_Error extracts the error
-- Same interface as Ada.Streams.Stream_IO
function Stream
- (Socket : Socket_Type)
- return Stream_Access;
+ (Socket : Socket_Type) return Stream_Access;
-- Create a stream associated with a stream-based socket that is
-- already connected.
function Stream
(Socket : Socket_Type;
- Send_To : Sock_Addr_Type)
- return Stream_Access;
+ Send_To : Sock_Addr_Type) return Stream_Access;
-- Create a stream associated with a datagram-based socket that is
-- already bound. Send_To is the socket address to which messages are
-- being sent.
function Get_Address
- (Stream : Stream_Access)
- return Sock_Addr_Type;
- -- Return the socket address from which the last message was
- -- received.
+ (Stream : Stream_Access) return Sock_Addr_Type;
+ -- Return the socket address from which the last message was received.
procedure Free is new Ada.Unchecked_Deallocation
(Ada.Streams.Root_Stream_Type'Class, Stream_Access);
-- No_Socket when the set is empty.
function Is_Empty
- (Item : Socket_Set_Type)
- return Boolean;
- -- Return True if Item is empty
+ (Item : Socket_Set_Type) return Boolean;
+ -- Return True iff Item is empty
function Is_Set
(Item : Socket_Set_Type;
- Socket : Socket_Type)
- return Boolean;
- -- Return True if Socket is present in Item
+ Socket : Socket_Type) return Boolean;
+ -- Return True iff 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
-- C select() waits for a number of file descriptors to change
-- two attempts on a blocking operation.
Thread_Blocking_IO : Boolean := True;
+ -- Comment required for this ???
Unknown_System_Error : constant C.Strings.chars_ptr :=
C.Strings.New_String ("Unknown system error");
+ -- Comments required for following functions ???
+
function Syscall_Accept
(S : C.int;
Addr : System.Address;
Protocol : C.int) return C.int;
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;
procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
end if;
+ Disable_SIGPIPE (R);
return R;
end C_Accept;
Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
Set_Non_Blocking_Socket (R, False);
end if;
-
+ Disable_SIGPIPE (R);
return R;
end C_Socket;
#include "system.h"
#endif
+#if !(defined (VMS) || defined (__MINGW32__))
+# include <sys/socket.h>
+#endif
+
#include "raise.h"
+extern void __gnat_disable_sigpipe (int fd);
extern void __gnat_free_socket_set (fd_set *);
extern void __gnat_last_socket_in_set (fd_set *, int *);
extern void __gnat_get_socket_from_set (fd_set *, int *, int *);
extern fd_set *__gnat_new_socket_set (fd_set *);
extern void __gnat_remove_socket_from_set (fd_set *, int);
\f
+/* 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. */
void
projects / gcc.git / commitdiff