diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-aix.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-freebsd.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-hpux.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-interix.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-irix.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-mingw.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-solaris.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-tru64.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-unixware.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-vms.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/g-soccon-vxworks.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/g-soccon.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-socket.adb | 159 | ||||
| -rw-r--r-- | gcc/ada/g-socket.ads | 106 | ||||
| -rw-r--r-- | gcc/ada/g-socthi.adb | 9 | ||||
| -rw-r--r-- | gcc/ada/socket.c | 15 |
17 files changed, 207 insertions, 145 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c03adf8204c..6620e371c47 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +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. diff --git a/gcc/ada/g-soccon-aix.ads b/gcc/ada/g-soccon-aix.ads index 0f5fe9d4c6b..4361f0940e6 100644 --- a/gcc/ada/g-soccon-aix.ads +++ b/gcc/ada/g-soccon-aix.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-freebsd.ads b/gcc/ada/g-soccon-freebsd.ads index cd19222e1a7..ca1da41bbd5 100644 --- a/gcc/ada/g-soccon-freebsd.ads +++ b/gcc/ada/g-soccon-freebsd.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-hpux.ads b/gcc/ada/g-soccon-hpux.ads index cbca2bee7a5..56e0d5f594e 100644 --- a/gcc/ada/g-soccon-hpux.ads +++ b/gcc/ada/g-soccon-hpux.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-interix.ads b/gcc/ada/g-soccon-interix.ads index 61903079b82..aa6ab5b0556 100644 --- a/gcc/ada/g-soccon-interix.ads +++ b/gcc/ada/g-soccon-interix.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-irix.ads b/gcc/ada/g-soccon-irix.ads index f19f3cde5f6..b1201f69aa7 100644 --- a/gcc/ada/g-soccon-irix.ads +++ b/gcc/ada/g-soccon-irix.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-mingw.ads b/gcc/ada/g-soccon-mingw.ads index b4bb31564dc..b963ca6474a 100644 --- a/gcc/ada/g-soccon-mingw.ads +++ b/gcc/ada/g-soccon-mingw.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-solaris.ads b/gcc/ada/g-soccon-solaris.ads index 1ad58838ca9..21dbac5d29a 100644 --- a/gcc/ada/g-soccon-solaris.ads +++ b/gcc/ada/g-soccon-solaris.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-tru64.ads b/gcc/ada/g-soccon-tru64.ads index ef3536e4bbc..a0927e2bcfe 100644 --- a/gcc/ada/g-soccon-tru64.ads +++ b/gcc/ada/g-soccon-tru64.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-unixware.ads b/gcc/ada/g-soccon-unixware.ads index 9f7065f6ffe..d53931116d9 100644 --- a/gcc/ada/g-soccon-unixware.ads +++ b/gcc/ada/g-soccon-unixware.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-vms.adb b/gcc/ada/g-soccon-vms.adb index 76b2051e07c..ebd394c54a3 100644 --- a/gcc/ada/g-soccon-vms.adb +++ b/gcc/ada/g-soccon-vms.adb @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon-vxworks.ads b/gcc/ada/g-soccon-vxworks.ads index 27dcb0c7a9e..0e4004f4481 100644 --- a/gcc/ada/g-soccon-vxworks.ads +++ b/gcc/ada/g-soccon-vxworks.ads @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-soccon.ads b/gcc/ada/g-soccon.ads index abe651de512..54c931a04b3 100644 --- a/gcc/ada/g-soccon.ads +++ b/gcc/ada/g-soccon.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -137,6 +137,8 @@ package GNAT.Sockets.Constants is 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 -- diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index b2d4f259cc3..01f9d19bb93 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -117,8 +117,7 @@ package body GNAT.Sockets is 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. @@ -127,23 +126,24 @@ package body GNAT.Sockets is -- 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. @@ -172,7 +172,7 @@ package body GNAT.Sockets is -- (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 @@ -267,9 +267,8 @@ package body GNAT.Sockets is --------------- 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); @@ -289,9 +288,8 @@ package body GNAT.Sockets is ------------- 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)); @@ -302,9 +300,8 @@ package body GNAT.Sockets is ------------- 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)); @@ -431,6 +428,10 @@ package body GNAT.Sockets is 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. @@ -456,7 +457,7 @@ package body GNAT.Sockets is 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); @@ -470,7 +471,7 @@ package body GNAT.Sockets is Empty (ESet); end if; - -- Deliver RSet, WSet and ESet. + -- Deliver RSet, WSet and ESet Empty (R_Socket_Set); R_Socket_Set := RSet; @@ -822,8 +823,7 @@ package body GNAT.Sockets is 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); @@ -865,7 +865,7 @@ package body GNAT.Sockets is 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)); @@ -920,8 +920,7 @@ package body GNAT.Sockets is 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); @@ -957,8 +956,7 @@ package body GNAT.Sockets is 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; @@ -993,8 +991,7 @@ package body GNAT.Sockets is --------------------- 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; @@ -1018,8 +1015,7 @@ package body GNAT.Sockets is 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; @@ -1087,8 +1083,8 @@ package body GNAT.Sockets is 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); @@ -1124,9 +1120,8 @@ package body GNAT.Sockets is ----------- 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. @@ -1141,6 +1136,10 @@ package body GNAT.Sockets is 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; @@ -1150,6 +1149,10 @@ package body GNAT.Sockets is Length := Length + Len; end Img10; + ----------- + -- Img16 -- + ----------- + procedure Img16 (V : Inet_Addr_Comp_Type) is begin Buffer (Length) := Hex_To_Char (Natural (V / 16) + 1); @@ -1201,7 +1204,6 @@ package body GNAT.Sockets is 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; @@ -1282,8 +1284,7 @@ package body GNAT.Sockets is function Is_Set (Item : Socket_Set_Type; - Socket : Socket_Type) - return Boolean + Socket : Socket_Type) return Boolean is begin return Item.Last /= No_Socket @@ -1299,10 +1300,8 @@ package body GNAT.Sockets is (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; @@ -1314,7 +1313,6 @@ package body GNAT.Sockets is 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); @@ -1364,12 +1362,16 @@ package body GNAT.Sockets 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 -- 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"; @@ -1378,12 +1380,12 @@ package body GNAT.Sockets is 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; ------------------------ @@ -1394,6 +1396,11 @@ package body GNAT.Sockets is 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 @@ -1401,6 +1408,8 @@ package body GNAT.Sockets is return Msg; end Image; + -- Start of processing for Raise_Socket_Error + begin Ada.Exceptions.Raise_Exception (Socket_Error'Identity, @@ -1507,9 +1516,9 @@ package body GNAT.Sockets is 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 := @@ -1537,8 +1546,7 @@ package body GNAT.Sockets is 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; @@ -1608,8 +1616,7 @@ package body GNAT.Sockets is ----------------------- 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); @@ -1640,10 +1647,8 @@ package body GNAT.Sockets is 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; @@ -1694,7 +1699,7 @@ package body GNAT.Sockets is (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); @@ -1732,7 +1737,7 @@ package body GNAT.Sockets is (C.int (Socket), Item (Item'First)'Address, Item'Length, - To_Int (Flags), + Set_Forced_Flags (To_Int (Flags)), Sin'Unchecked_Access, Len); @@ -1753,6 +1758,7 @@ package body GNAT.Sockets is Count : out Ada.Streams.Stream_Element_Count) is Res : C.int; + begin Res := C_Writev @@ -1784,6 +1790,20 @@ package body GNAT.Sockets is 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 -- ----------------------- @@ -1829,8 +1849,8 @@ package body GNAT.Sockets is 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; @@ -1908,8 +1928,7 @@ package body GNAT.Sockets is 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; @@ -1966,10 +1985,10 @@ package body GNAT.Sockets is -- 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; @@ -2019,17 +2038,14 @@ package body GNAT.Sockets is ------------------ 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; @@ -2088,7 +2104,7 @@ package body GNAT.Sockets is 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; @@ -2138,6 +2154,7 @@ package body GNAT.Sockets is 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))); diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads index 27841d8c9d2..c2c447992ac 100644 --- a/gcc/ada/g-socket.ads +++ b/gcc/ada/g-socket.ads @@ -6,7 +6,7 @@ -- -- -- 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- -- @@ -399,35 +399,32 @@ package GNAT.Sockets is 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; @@ -440,8 +437,8 @@ package GNAT.Sockets is 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. @@ -488,15 +485,13 @@ package GNAT.Sockets is -- 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; @@ -506,25 +501,22 @@ package GNAT.Sockets is 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 @@ -538,31 +530,29 @@ package GNAT.Sockets is -- 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, @@ -665,8 +655,8 @@ package GNAT.Sockets is 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; @@ -786,8 +776,7 @@ package GNAT.Sockets is 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. @@ -830,8 +819,7 @@ package GNAT.Sockets is -- 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 @@ -884,24 +872,20 @@ package GNAT.Sockets is -- 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); @@ -930,17 +914,15 @@ package GNAT.Sockets is -- 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 diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 9600cda6428..26c5e627491 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -61,10 +61,13 @@ package body GNAT.Sockets.Thin is -- 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; @@ -121,6 +124,9 @@ package body GNAT.Sockets.Thin is 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); @@ -160,6 +166,7 @@ package body GNAT.Sockets.Thin is Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access); end if; + Disable_SIGPIPE (R); return R; end C_Accept; @@ -377,7 +384,7 @@ package body GNAT.Sockets.Thin is 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; diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 89b8163fada..6f5067fcabe 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -64,8 +64,13 @@ #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 *); @@ -74,6 +79,16 @@ extern int __gnat_is_socket_in_set (fd_set *, int); extern fd_set *__gnat_new_socket_set (fd_set *); 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. */ void |