-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, AdaCore --
+-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with Ada.Streams; use Ada.Streams;
-with Ada.Exceptions; use Ada.Exceptions;
+with Ada.Streams; use Ada.Streams;
+with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with Interfaces.C.Strings;
-
with GNAT.Sockets.Constants;
-with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
-with GNAT.Task_Lock;
+with GNAT.Sockets.Thin; use GNAT.Sockets.Thin;
+with GNAT.Sockets.Thin.Task_Safe_NetDB; use GNAT.Sockets.Thin.Task_Safe_NetDB;
with GNAT.Sockets.Linker_Options;
pragma Warnings (Off, GNAT.Sockets.Linker_Options);
ENOERROR : constant := 0;
+ Netdb_Buffer_Size : constant := Constants.Need_Netdb_Buffer * 1024;
+ -- The network database functions gethostbyname, gethostbyaddr,
+ -- getservbyname and getservbyport can either be guaranteed task safe by
+ -- the operating system, or else return data through a user-provided buffer
+ -- to ensure concurrent uses do not interfere.
+
-- Correspondance tables
Families : constant array (Family_Type) of C.int :=
- (Family_Inet => Constants.AF_INET,
- Family_Inet6 => Constants.AF_INET6);
+ (Family_Inet => Constants.AF_INET,
+ Family_Inet6 => Constants.AF_INET6);
Levels : constant array (Level_Type) of C.int :=
- (Socket_Level => Constants.SOL_SOCKET,
- IP_Protocol_For_IP_Level => Constants.IPPROTO_IP,
- IP_Protocol_For_UDP_Level => Constants.IPPROTO_UDP,
- IP_Protocol_For_TCP_Level => Constants.IPPROTO_TCP);
+ (Socket_Level => Constants.SOL_SOCKET,
+ IP_Protocol_For_IP_Level => Constants.IPPROTO_IP,
+ IP_Protocol_For_UDP_Level => Constants.IPPROTO_UDP,
+ IP_Protocol_For_TCP_Level => Constants.IPPROTO_TCP);
Modes : constant array (Mode_Type) of C.int :=
- (Socket_Stream => Constants.SOCK_STREAM,
- Socket_Datagram => Constants.SOCK_DGRAM);
+ (Socket_Stream => Constants.SOCK_STREAM,
+ Socket_Datagram => Constants.SOCK_DGRAM);
Shutmodes : constant array (Shutmode_Type) of C.int :=
- (Shut_Read => Constants.SHUT_RD,
- Shut_Write => Constants.SHUT_WR,
- Shut_Read_Write => Constants.SHUT_RDWR);
+ (Shut_Read => Constants.SHUT_RD,
+ Shut_Write => Constants.SHUT_WR,
+ Shut_Read_Write => Constants.SHUT_RDWR);
Requests : constant array (Request_Name) of C.int :=
- (Non_Blocking_IO => Constants.FIONBIO,
- N_Bytes_To_Read => Constants.FIONREAD);
+ (Non_Blocking_IO => Constants.FIONBIO,
+ N_Bytes_To_Read => Constants.FIONREAD);
Options : constant array (Option_Name) of C.int :=
- (Keep_Alive => Constants.SO_KEEPALIVE,
- Reuse_Address => Constants.SO_REUSEADDR,
- Broadcast => Constants.SO_BROADCAST,
- Send_Buffer => Constants.SO_SNDBUF,
- Receive_Buffer => Constants.SO_RCVBUF,
- Linger => Constants.SO_LINGER,
- Error => Constants.SO_ERROR,
- No_Delay => Constants.TCP_NODELAY,
- Add_Membership => Constants.IP_ADD_MEMBERSHIP,
- Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
- Multicast_If => Constants.IP_MULTICAST_IF,
- Multicast_TTL => Constants.IP_MULTICAST_TTL,
- Multicast_Loop => Constants.IP_MULTICAST_LOOP,
- Send_Timeout => Constants.SO_SNDTIMEO,
- Receive_Timeout => Constants.SO_RCVTIMEO);
+ (Keep_Alive => Constants.SO_KEEPALIVE,
+ Reuse_Address => Constants.SO_REUSEADDR,
+ Broadcast => Constants.SO_BROADCAST,
+ Send_Buffer => Constants.SO_SNDBUF,
+ Receive_Buffer => Constants.SO_RCVBUF,
+ Linger => Constants.SO_LINGER,
+ Error => Constants.SO_ERROR,
+ No_Delay => Constants.TCP_NODELAY,
+ Add_Membership => Constants.IP_ADD_MEMBERSHIP,
+ Drop_Membership => Constants.IP_DROP_MEMBERSHIP,
+ Multicast_If => Constants.IP_MULTICAST_IF,
+ Multicast_TTL => Constants.IP_MULTICAST_TTL,
+ Multicast_Loop => Constants.IP_MULTICAST_LOOP,
+ Send_Timeout => Constants.SO_SNDTIMEO,
+ Receive_Timeout => Constants.SO_RCVTIMEO);
Flags : constant array (0 .. 3) of C.int :=
- (0 => Constants.MSG_OOB, -- Process_Out_Of_Band_Data
- 1 => Constants.MSG_PEEK, -- Peek_At_Incoming_Data
- 2 => Constants.MSG_WAITALL, -- Wait_For_A_Full_Reception
- 3 => Constants.MSG_EOR); -- Send_End_Of_Record
+ (0 => Constants.MSG_OOB, -- Process_Out_Of_Band_Data
+ 1 => Constants.MSG_PEEK, -- Peek_At_Incoming_Data
+ 2 => Constants.MSG_WAITALL, -- Wait_For_A_Full_Reception
+ 3 => Constants.MSG_EOR); -- Send_End_Of_Record
Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
Host_Error_Id : constant Exception_Id := Host_Error'Identity;
raise Socket_Error;
end if;
- Set_Length (Sin'Unchecked_Access, Len);
- Set_Family (Sin'Unchecked_Access, Families (Address.Family));
+ Set_Length (Sin'Unchecked_Access, Len);
+ Set_Family (Sin'Unchecked_Access, Families (Address.Family));
Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr));
Set_Port
(Sin'Unchecked_Access,
E_Socket_Set := ESet;
exception
-
when Socket_Error =>
-- The local socket sets must be emptied before propagating
procedure Close_Selector (Selector : in out Selector_Type) is
begin
+ -- Close the signalling file descriptors used internally for the
+ -- implementation of Abort_Selector.
- -- Close the signalling sockets used internally for the implementation
- -- of Abort_Selector. Exceptions are ignored because these sockets
- -- are implementation artefacts of no interest to the user, and
- -- there is little that can be done if either Close_Socket call fails
- -- (which theoretically should not happen anyway). We also want to try
- -- to perform the second Close_Socket even if the first one failed.
-
- begin
- Close_Socket (Selector.R_Sig_Socket);
- exception
- when Socket_Error =>
- null;
- end;
-
- begin
- Close_Socket (Selector.W_Sig_Socket);
- exception
- when Socket_Error =>
- null;
- end;
+ Signalling_Fds.Close (C.int (Selector.R_Sig_Socket));
+ Signalling_Fds.Close (C.int (Selector.W_Sig_Socket));
-- Reset R_Sig_Socket and W_Sig_Socket to No_Socket to ensure that any
-- (errneous) subsequent attempt to use this selector properly fails.
when N_Bytes_To_Read =>
null;
-
end case;
Res := C_Ioctl
is
pragma Unreferenced (Family);
- HA : aliased In_Addr := To_In_Addr (Address);
- Res : Hostent_Access;
- Err : Integer;
+ HA : aliased In_Addr := To_In_Addr (Address);
+ Buflen : constant C.int := Netdb_Buffer_Size;
+ Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
+ Res : aliased Hostent;
+ Err : aliased C.int;
begin
- -- This C function is not always thread-safe. Protect against
- -- concurrent access.
-
- Task_Lock.Lock;
- Res := C_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET);
-
- if Res = null then
- Err := Host_Errno;
- Task_Lock.Unlock;
- Raise_Host_Error (Err);
+ if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET,
+ Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+ then
+ Raise_Host_Error (Integer (Err));
end if;
- -- Translate from the C format to the API format
-
- declare
- HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
-
- begin
- Task_Lock.Unlock;
- return HE;
- end;
+ return To_Host_Entry (Res);
end Get_Host_By_Address;
----------------------
----------------------
function Get_Host_By_Name (Name : String) return Host_Entry_Type is
- HN : constant C.char_array := C.To_C (Name);
- Res : Hostent_Access;
- Err : Integer;
-
begin
-- Detect IP address name and redirect to Inet_Addr
return Get_Host_By_Address (Inet_Addr (Name));
end if;
- -- This C function is not always thread-safe. Protect against
- -- concurrent access.
-
- Task_Lock.Lock;
- Res := C_Gethostbyname (HN);
-
- if Res = null then
- Err := Host_Errno;
- Task_Lock.Unlock;
- Raise_Host_Error (Err);
- end if;
-
- -- Translate from the C format to the API format
-
declare
- HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
+ HN : constant C.char_array := C.To_C (Name);
+ Buflen : constant C.int := Netdb_Buffer_Size;
+ Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
+ Res : aliased Hostent;
+ Err : aliased C.int;
+
begin
- Task_Lock.Unlock;
- return HE;
+ if Safe_Gethostbyname
+ (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+ then
+ Raise_Host_Error (Integer (Err));
+ end if;
+
+ return To_Host_Entry (Res);
end;
end Get_Host_By_Name;
(Name : String;
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);
- Res : Servent_Access;
+ SN : constant C.char_array := C.To_C (Name);
+ SP : constant C.char_array := C.To_C (Protocol);
+ Buflen : constant C.int := Netdb_Buffer_Size;
+ Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
+ Res : aliased Servent;
begin
- -- This C function is not always thread-safe. Protect against
- -- concurrent access.
-
- Task_Lock.Lock;
- Res := C_Getservbyname (SN, SP);
-
- if Res = null then
- Task_Lock.Unlock;
+ if Safe_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
Ada.Exceptions.Raise_Exception
(Service_Error'Identity, "Service not found");
end if;
-- Translate from the C format to the API format
- declare
- SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
-
- begin
- Task_Lock.Unlock;
- return SE;
- end;
+ return To_Service_Entry (Res);
end Get_Service_By_Name;
-------------------------
(Port : Port_Type;
Protocol : String) return Service_Entry_Type
is
- SP : constant C.char_array := C.To_C (Protocol);
- Res : Servent_Access;
+ SP : constant C.char_array := C.To_C (Protocol);
+ Buflen : constant C.int := Netdb_Buffer_Size;
+ Buf : aliased C.char_array (1 .. Netdb_Buffer_Size);
+ Res : aliased Servent;
begin
- -- This C function is not always thread-safe. Protect against
- -- concurrent access.
-
- Task_Lock.Lock;
- Res := C_Getservbyport
- (C.int (Short_To_Network (C.unsigned_short (Port))), SP);
-
- if Res = null then
- Task_Lock.Unlock;
+ if Safe_Getservbyport
+ (C.int (Short_To_Network (C.unsigned_short (Port))), SP,
+ Res'Access, Buf'Address, Buflen) /= 0
+ then
Ada.Exceptions.Raise_Exception
(Service_Error'Identity, "Service not found");
end if;
-- Translate from the C format to the API format
- declare
- SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
-
- begin
- Task_Lock.Unlock;
- return SE;
- end;
+ return To_Service_Entry (Res);
end Get_Service_By_Port;
---------------------
begin
Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
+
if Res /= Failure then
To_Inet_Addr (Sin.Sin_Addr, Addr.Addr);
Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
when Send_Timeout |
Receive_Timeout =>
Opt.Timeout := To_Duration (VT);
-
end case;
return Opt;
Result : Inet_Addr_Type;
begin
- -- Special case for the all-ones broadcast address: this address
- -- has the same in_addr_t value as Failure, and thus cannot be
- -- properly returned by inet_addr(3).
+ -- Special case for the all-ones broadcast address: this address has the
+ -- same in_addr_t value as Failure, and thus cannot be properly returned
+ -- by inet_addr(3).
if Image = "255.255.255.255" then
return Broadcast_Inet_Addr;
-- Initialize --
----------------
- procedure Initialize (Process_Blocking_IO : Boolean := False) is
+ procedure Initialize (Process_Blocking_IO : Boolean) is
+ Expected : constant Boolean := not Constants.Thread_Blocking_IO;
+ begin
+ if Process_Blocking_IO /= Expected then
+ raise Socket_Error with
+ "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
+ end if;
+
+ Initialize;
+ end Initialize;
+
+ ----------------
+ -- Initialize --
+ ----------------
+
+ procedure Initialize is
begin
if not Initialized then
Initialized := True;
- Thin.Initialize (Process_Blocking_IO);
+ Thin.Initialize;
end if;
end Initialize;
----------------------
procedure Raise_Host_Error (H_Error : Integer) is
-
- function Host_Error_Message return String;
- -- We do not use a C function like strerror because hstrerror that would
- -- correspond is obsolete. Return appropriate string for error value.
-
- ------------------------
- -- Host_Error_Message --
- ------------------------
-
- function Host_Error_Message return String is
- begin
- case H_Error is
- when Constants.HOST_NOT_FOUND => return "Host not found";
- when Constants.TRY_AGAIN => return "Try again";
- when Constants.NO_RECOVERY => return "No recovery";
- when Constants.NO_DATA => return "No address";
- when others => return "Unknown error";
- end case;
- end Host_Error_Message;
-
- -- Start of processing for Raise_Host_Error
-
begin
Ada.Exceptions.Raise_Exception (Host_Error'Identity,
Err_Code_Image (H_Error)
- & Host_Error_Message);
+ & C.Strings.Value (Host_Error_Messages.Host_Error_Message (H_Error)));
end Raise_Host_Error;
------------------------
Index,
Stream.From);
- Last := Index;
+ Last := Index;
-- Exit when all or zero data received. Zero means that the socket
-- peer is closed.
Res : C.int;
begin
- Res := C_Recv
- (C.int (Socket),
- Item (Item'First)'Address,
- Item'Length,
- To_Int (Flags));
+ Res :=
+ C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags));
if Res = Failure then
Raise_Socket_Error (Socket_Errno);
Res :=
C_Recvfrom
(C.int (Socket),
- Item (Item'First)'Address,
+ Item'Address,
Item'Length,
To_Int (Flags),
Sin'Unchecked_Access,
case Error_Value is
when Constants.HOST_NOT_FOUND => return Unknown_Host;
when Constants.TRY_AGAIN => return Host_Name_Lookup_Failure;
- when Constants.NO_RECOVERY =>
- return Non_Recoverable_Error;
+ when Constants.NO_RECOVERY => return Non_Recoverable_Error;
when Constants.NO_DATA => return Unknown_Server_Error;
when others => return Cannot_Resolve_Error;
end case;
when EACCES => return Permission_Denied;
when EADDRINUSE => return Address_Already_In_Use;
when EADDRNOTAVAIL => return Cannot_Assign_Requested_Address;
- when EAFNOSUPPORT =>
- return Address_Family_Not_Supported_By_Protocol;
+ when EAFNOSUPPORT => return
+ Address_Family_Not_Supported_By_Protocol;
when EALREADY => return Operation_Already_In_Progress;
when EBADF => return Bad_File_Descriptor;
when ECONNABORTED => return Software_Caused_Connection_Abort;
when EMSGSIZE => return Message_Too_Long;
when ENAMETOOLONG => return File_Name_Too_Long;
when ENETDOWN => return Network_Is_Down;
- when ENETRESET =>
- return Network_Dropped_Connection_Because_Of_Reset;
+ when ENETRESET => return
+ Network_Dropped_Connection_Because_Of_Reset;
when ENETUNREACH => return Network_Is_Unreachable;
when ENOBUFS => return No_Buffer_Space_Available;
when ENOPROTOOPT => return Protocol_Not_Available;
when EPFNOSUPPORT => return Protocol_Family_Not_Supported;
when EPROTONOSUPPORT => return Protocol_Not_Supported;
when EPROTOTYPE => return Protocol_Wrong_Type_For_Socket;
- when ESHUTDOWN =>
- return Cannot_Send_After_Transport_Endpoint_Shutdown;
+ when ESHUTDOWN => return
+ Cannot_Send_After_Transport_Endpoint_Shutdown;
when ESOCKTNOSUPPORT => return Socket_Type_Not_Supported;
when ETIMEDOUT => return Connection_Timed_Out;
when ETOOMANYREFS => return Too_Many_References;
Res :=
C_Readv
(C.int (Socket),
- Vector (Vector'First)'Address,
+ Vector'Address,
Vector'Length);
if Res = Failure then
Res :=
C_Send
(C.int (Socket),
- Item (Item'First)'Address,
+ Item'Address,
Item'Length,
Set_Forced_Flags (To_Int (Flags)));
Res := C_Sendto
(C.int (Socket),
- Item (Item'First)'Address,
+ Item'Address,
Item'Length,
Set_Forced_Flags (To_Int (Flags)),
Sin'Unchecked_Access,
function To_Service_Entry (E : Servent) return Service_Entry_Type is
use type C.size_t;
- Official : constant String :=
- C.Strings.Value (E.S_Name);
+ Official : constant String := C.Strings.Value (E.S_Name);
Aliases : constant Chars_Ptr_Array :=
Chars_Ptr_Pointers.Value (E.S_Aliases);
-- S_Aliases points to a list of name aliases. The list is
-- terminated by a NULL pointer.
- Protocol : constant String :=
- C.Strings.Value (E.S_Proto);
+ Protocol : constant String := C.Strings.Value (E.S_Proto);
- Result : Service_Entry_Type
- (Aliases_Length => Aliases'Length - 1);
+ Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1);
-- The last element is a null pointer
Source : C.size_t;
Port_Type (Network_To_Short (C.unsigned_short (E.S_Port)));
Result.Protocol := To_Name (Protocol);
-
return Result;
end To_Service_Entry;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2006, AdaCore --
+-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- installed. In particular Multicast is not available with the Windows
-- version.
--- The VMS implementation has implemented using the DECC RTL Socket API,
+-- The VMS implementation was implemented using the DECC RTL Socket API,
-- and is thus subject to limitations in the implementation of this API.
-- VxWorks cross ports fully implement this package
-- end Ping;
-- begin
- -- -- Indicate whether the thread library provides process
- -- -- blocking IO. Basically, if you are not using FSU threads
- -- -- the default is ok.
-
- -- Initialize (Process_Blocking_IO => False);
+ -- Initialize;
-- Ping.Start;
-- Pong.Start;
-- Ping.Stop;
-- Finalize;
-- end PingPong;
- procedure Initialize (Process_Blocking_IO : Boolean := False);
- -- Initialize must be called before using any other socket routines. The
- -- Process_Blocking_IO parameter indicates whether the thread library
- -- provides process-blocking or thread-blocking input/output operations.
- -- In the former case (typically with FSU threads) GNAT.Sockets should be
- -- initialized with a value of True to provide task-blocking IO through an
- -- emulation mechanism. Only the first call to Initialize is taken into
- -- account (further calls will be ignored). Note that with the default
- -- value of Process_Blocking_IO, this operation is a no-op on UNIX
- -- platforms, but applications should make sure to call it if portability
- -- is expected: some platforms (such as Windows) require initialization
- -- before any other socket operations.
+ procedure Initialize;
+ -- Initialize must be called before using any other socket routines.
+ -- Note that this operation is a no-op on UNIX platforms, but applications
+ -- should make sure to call it if portability is expected: some platforms
+ -- (such as Windows) require initialization before any socket operation.
+
+ procedure Initialize (Process_Blocking_IO : Boolean);
+ pragma Obsolescent
+ (Entity => Initialize,
+ "passing a parameter to Initialize is not supported anymore");
+ -- Previous versions of GNAT.Sockets used to require the user to indicate
+ -- whether socket I/O was process- or thread-blocking on the platform.
+ -- This property is now determined automatically when the run-time library
+ -- is built. The old version of Initialize, taking a parameter, is kept
+ -- for compatibility reasons, but this interface is obsolete (and if the
+ -- value given is wrong, an exception will be raised at run time).
procedure Finalize;
-- After Finalize is called it is not possible to use any routines
-- cases Status is set to Completed and sockets that are ready are set in
-- R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was
-- ready after a Timeout expiration. Status is set to Aborted if an abort
- -- signal has been received while checking socket status. As this
- -- procedure returns when Timeout occurs, it is a design choice to keep
- -- this procedure process blocking. Note that a Timeout of 0.0 returns
- -- immediately. Also note that two different Socket_Set_Type objects must
- -- be passed as R_Socket_Set and W_Socket_Set (even if they denote the
- -- same set of Sockets), or some event may be lost.
+ -- signal has been received while checking socket status.
+ -- Note that two different Socket_Set_Type objects must be passed as
+ -- R_Socket_Set and W_Socket_Set (even if they denote the same set of
+ -- Sockets), or some event may be lost.
-- Socket_Error is raised when the select(2) system call returns an
-- error condition, or when a read error occurs on the signalling socket
-- used for the implementation of Abort_Selector.
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2006, AdaCore --
+-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- been set in non-blocking mode by the user.
Quantum : constant Duration := 0.2;
- -- When Thread_Blocking_IO is False, we set sockets in
+ -- When Constants.Thread_Blocking_IO is False, we set sockets in
-- non-blocking mode and we spend a period of time Quantum between
-- 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");
begin
loop
R := Syscall_Accept (S, Addr, Addrlen);
- exit when Thread_Blocking_IO
+ exit when Constants.Thread_Blocking_IO
or else R /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
delay Quantum;
end loop;
- if not Thread_Blocking_IO
+ if not Constants.Thread_Blocking_IO
and then R /= Failure
then
-- A socket inherits the properties ot its server especially
begin
Res := Syscall_Connect (S, Name, Namelen);
- if Thread_Blocking_IO
+ if Constants.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EINPROGRESS
Arg : Int_Access) return C.int
is
begin
- if not Thread_Blocking_IO
+ if not Constants.Thread_Blocking_IO
and then Req = Constants.FIONBIO
then
if Arg.all /= 0 then
begin
loop
Res := Syscall_Recv (S, Msg, Len, Flags);
- exit when Thread_Blocking_IO
+ exit when Constants.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
begin
loop
Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
- exit when Thread_Blocking_IO
+ exit when Constants.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
begin
loop
Res := Syscall_Send (S, Msg, Len, Flags);
- exit when Thread_Blocking_IO
+ exit when Constants.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
begin
loop
Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
- exit when Thread_Blocking_IO
+ exit when Constants.Thread_Blocking_IO
or else Res /= Failure
or else Non_Blocking_Socket (S)
or else Errno /= Constants.EWOULDBLOCK;
begin
R := Syscall_Socket (Domain, Typ, Protocol);
- if not Thread_Blocking_IO
+ if not Constants.Thread_Blocking_IO
and then R /= Failure
then
-- Do not use C_Ioctl as this subprogram tracks sockets set
null;
end Finalize;
+ -------------------------
+ -- Host_Error_Messages --
+ -------------------------
+
+ package body Host_Error_Messages is separate;
+
----------------
-- Initialize --
----------------
- procedure Initialize (Process_Blocking_IO : Boolean) is
+ procedure Initialize is
begin
- Thread_Blocking_IO := not Process_Blocking_IO;
Disable_All_SIGPIPEs;
end Initialize;
function C_Create (Fds : not null access Fd_Pair) return C.int;
function C_Read (Rsig : C.int) return C.int;
function C_Write (Wsig : C.int) return C.int;
+ procedure C_Close (Sig : C.int);
pragma Import (C, C_Create, "__gnat_create_signalling_fds");
pragma Import (C, C_Read, "__gnat_read_signalling_fd");
pragma Import (C, C_Write, "__gnat_write_signalling_fd");
+ pragma Import (C, C_Close, "__gnat_close_signalling_fd");
- function Create (Fds : not null access Fd_Pair) return C.int
- renames C_Create;
-
+ function Create
+ (Fds : not null access Fd_Pair) return C.int renames C_Create;
function Read (Rsig : C.int) return C.int renames C_Read;
-
function Write (Wsig : C.int) return C.int renames C_Write;
+ procedure Close (Sig : C.int) renames C_Close;
end Signalling_Fds;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2006, AdaCore --
+-- Copyright (C) 2001-2007, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Interfaces.C.Pointers;
with Interfaces.C.Strings;
-with GNAT.Sockets.Constants;
with GNAT.OS_Lib;
+with GNAT.Sockets.Constants;
with System;
function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr;
-- Returns the error message string for the error number Errno. If Errno is
- -- not known it returns "Unknown system error".
+ -- not known, returns "Unknown system error".
function Host_Errno return Integer;
pragma Import (C, Host_Errno, "__gnat_get_h_errno");
-- Returns last host error number
+ package Host_Error_Messages is
+
+ function Host_Error_Message
+ (H_Errno : Integer) return C.Strings.chars_ptr;
+ -- Returns the error message string for the host error number H_Errno.
+ -- If H_Errno is not known, returns "Unknown system error".
+
+ end Host_Error_Messages;
+
subtype Fd_Set_Access is System.Address;
No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
type In_Addr is record
S_B1, S_B2, S_B3, S_B4 : C.unsigned_char;
end record;
+ for In_Addr'Alignment use C.int'Alignment;
pragma Convention (C, In_Addr);
- -- Internet address
+ -- IPv4 address, represented as a network-order C.int. Note that the
+ -- underlying operating system may assume that values of this type have
+ -- C.int alignment, so we need to provide a suitable alignment clause here.
type In_Addr_Access is access all In_Addr;
pragma Convention (C, In_Addr_Access);
-- Indices into an Fd_Pair value providing access to each of the connected
-- file descriptors.
+ --------------------------------
+ -- Standard library functions --
+ --------------------------------
+
function C_Accept
(S : C.int;
Addr : System.Address;
Name : System.Address;
Namelen : C.int) return C.int;
- function C_Gethostbyaddr
- (Addr : System.Address;
- Len : C.int;
- Typ : C.int) return Hostent_Access;
-
- function C_Gethostbyname
- (Name : C.char_array) return Hostent_Access;
-
function C_Gethostname
(Name : System.Address;
Namelen : C.int) return C.int;
Name : System.Address;
Namelen : not null access C.int) return C.int;
- function C_Getservbyname
- (Name : C.char_array;
- Proto : C.char_array) return Servent_Access;
-
- function C_Getservbyport
- (Port : C.int;
- Proto : C.char_array) return Servent_Access;
-
function C_Getsockname
(S : C.int;
Name : System.Address;
Iov : System.Address;
Iovcnt : C.int) return C.int;
+ -------------------------------------------------------
+ -- Signalling file descriptors for selector abortion --
+ -------------------------------------------------------
+
package Signalling_Fds is
function Create (Fds : not null access Fd_Pair) return C.int;
-- Write one byte of data to wsig, the write end of a pair of signalling
-- fds created by Create_Signalling_Fds.
+ procedure Close (Sig : C.int);
+ pragma Convention (C, Close);
+ -- Close one end of a pair of signalling fds (ignoring any error)
+
end Signalling_Fds;
+ ----------------------------
+ -- Socket sets management --
+ ----------------------------
+
procedure Free_Socket_Set
(Set : Fd_Set_Access);
-- Free system-dependent socket set
(Set : Fd_Set_Access;
Socket : Int_Access;
Last : Int_Access);
- -- Get last socket in Socket and remove it from the socket
- -- set. The parameter Last is a maximum value of the largest
- -- socket. This hint is used to avoid scanning very large socket
- -- sets. After a call to Get_Socket_From_Set, Last is set back to
- -- the real largest socket in the socket set.
+ -- Get last socket in Socket and remove it from the socket set. The
+ -- parameter Last is a maximum value of the largest socket. This hint is
+ -- used to avoid scanning very large socket sets. After a call to
+ -- Get_Socket_From_Set, Last is set back to the real largest socket in the
+ -- socket set.
procedure Insert_Socket_In_Set
(Set : Fd_Set_Access;
Socket : C.int);
-- Remove socket from the socket set
+ -------------------------------------------
+ -- Nonreentrant network databases access --
+ -------------------------------------------
+
+ -- The following are used only on systems that have nonreentrant
+ -- getXXXbyYYY functions, and do NOT have corresponding getXXXbyYYY_
+ -- functions. Currently, LynxOS is the only such system.
+
+ function Nonreentrant_Gethostbyname
+ (Name : C.char_array) return Hostent_Access;
+
+ function Nonreentrant_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int) return Hostent_Access;
+
+ function Nonreentrant_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array) return Servent_Access;
+
+ function Nonreentrant_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array) return Servent_Access;
+
+ procedure Initialize;
procedure Finalize;
- procedure Initialize (Process_Blocking_IO : Boolean);
private
pragma Import (C, C_Bind, "bind");
pragma Import (C, C_Close, "close");
- pragma Import (C, C_Gethostbyaddr, "gethostbyaddr");
- pragma Import (C, C_Gethostbyname, "gethostbyname");
pragma Import (C, C_Gethostname, "gethostname");
pragma Import (C, C_Getpeername, "getpeername");
- pragma Import (C, C_Getservbyname, "getservbyname");
- pragma Import (C, C_Getservbyport, "getservbyport");
pragma Import (C, C_Getsockname, "getsockname");
pragma Import (C, C_Getsockopt, "getsockopt");
pragma Import (C, C_Inet_Addr, "inet_addr");
pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set");
pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set");
+ pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname");
+ pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr");
+ pragma Import (C, Nonreentrant_Getservbyname, "getservbyname");
+ pragma Import (C, Nonreentrant_Getservbyport, "getservbyport");
+
end GNAT.Sockets.Thin;
projects / gcc.git / commitdiff