-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
-- by the GNAT.Sockets package (g-socket.ads). This package should not be
-- directly with'ed by an applications program.
--- This is the version for i386-unknown-freebsd5.2.1
+-- This is the version for i386-unknown-freebsd6.1
-- This file is generated automatically, do not modify it by hand! Instead,
-- make changes to gen-soccon.c and re-run it on each target.
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_NOSIGNAL : constant := 131072; -- No SIGPIPE on send
MSG_Forced_Flags : constant := 0;
-- Flags set on all send(2) calls
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
+ ------------------------------
+ -- MinGW-specific constants --
+ ------------------------------
+
+ -- These constants may be used only within the MinGW version of
+ -- GNAT.Sockets.Thin.
+
+ WSASYSNOTREADY : constant := 10091; -- System not ready
+ WSAVERNOTSUPPORTED : constant := 10092; -- Version not supported
+ WSANOTINITIALISED : constant := 10093; -- Winsock not intialized
+ WSAEDISCON : constant := 10101; -- Disconnected
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 0; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
end GNAT.Sockets.Constants;
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2005, Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2007, 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- --
SIZEOF_tv_sec : constant := 4; -- tv_sec
SIZEOF_tv_usec : constant := 4; -- tv_usec
+ ----------------------------------------
+ -- Properties of supported interfaces --
+ ----------------------------------------
+
+ Need_Netdb_Buffer : constant := 1; -- Need buffer for Netdb ops
+
+ ----------------------
+ -- Additional flags --
+ ----------------------
+
+ Thread_Blocking_IO : constant Boolean := True;
+ -- Set False for contexts where socket i/o are process blocking
+
--------------------------------
-- VxWorks-specific constants --
--------------------------------
-- --
-- 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;
-
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;
+ null;
end Initialize;
-------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2002-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 --
+ -------------------------------------------
+
+ 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, "DECC$BIND");
pragma Import (C, C_Close, "DECC$CLOSE");
- pragma Import (C, C_Gethostbyaddr, "DECC$GETHOSTBYADDR");
- pragma Import (C, C_Gethostbyname, "DECC$GETHOSTBYNAME");
pragma Import (C, C_Gethostname, "DECC$GETHOSTNAME");
pragma Import (C, C_Getpeername, "DECC$GETPEERNAME");
- pragma Import (C, C_Getservbyname, "DECC$GETSERVBYNAME");
- pragma Import (C, C_Getservbyport, "DECC$GETSERVBYPORT");
pragma Import (C, C_Getsockname, "DECC$GETSOCKNAME");
pragma Import (C, C_Getsockopt, "DECC$GETSOCKOPT");
pragma Import (C, C_Inet_Addr, "DECC$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, "DECC$GETHOSTBYNAME");
+ pragma Import (C, Nonreentrant_Gethostbyaddr, "DECC$GETHOSTBYADDR");
+ pragma Import (C, Nonreentrant_Getservbyname, "DECC$GETSERVBYNAME");
+ pragma Import (C, Nonreentrant_Getservbyport, "DECC$GETSERVBYPORT");
+
end GNAT.Sockets.Thin;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2002-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 GNAT.Task_Lock;
with Interfaces.C; use Interfaces.C;
-with Unchecked_Conversion;
package body GNAT.Sockets.Thin is
-- 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;
-
Unknown_System_Error : constant C.Strings.chars_ptr :=
C.Strings.New_String ("Unknown system error");
- -- The following types and variables are required to create a Hostent
- -- record "by hand".
-
- type In_Addr_Access_Array_Access is access In_Addr_Access_Array;
-
- Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
- new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
-
- In_Addr_Access_Array_A : constant In_Addr_Access_Array_Access :=
- new In_Addr_Access_Array'(new In_Addr, null);
-
- In_Addr_Access_Ptr : constant In_Addr_Access_Pointers.Pointer :=
- In_Addr_Access_Array_A
- (In_Addr_Access_Array_A'First)'Access;
-
- Local_Hostent : constant Hostent_Access := new Hostent;
-
-----------------------
-- Local Subprograms --
-----------------------
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
end if;
end C_Connect;
- ---------------------
- -- C_Gethostbyaddr --
- ---------------------
-
- function C_Gethostbyaddr
- (Addr : System.Address;
- Len : C.int;
- Typ : C.int) return Hostent_Access
- is
- pragma Warnings (Off, Len);
- pragma Warnings (Off, Typ);
-
- type int_Access is access int;
- function To_Pointer is
- new Unchecked_Conversion (System.Address, int_Access);
-
- function VxWorks_hostGetByAddr
- (Addr : C.int; Buf : System.Address) return C.int;
- pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
-
- Host_Name : aliased C.char_array (1 .. Max_Name_Length);
-
- begin
- if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
- Host_Name (Host_Name'First)'Address)
- /= Constants.OK
- then
- return null;
- end if;
-
- In_Addr_Access_Ptr.all.all := To_In_Addr (To_Pointer (Addr).all);
- Local_Hostent.all.H_Name := C.Strings.New_Char_Array (Host_Name);
-
- return Local_Hostent;
- end C_Gethostbyaddr;
-
- ---------------------
- -- C_Gethostbyname --
- ---------------------
-
- function C_Gethostbyname
- (Name : C.char_array) return Hostent_Access
- is
- function VxWorks_hostGetByName
- (Name : C.char_array) return C.int;
- pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
-
- Addr : C.int;
-
- begin
- Addr := VxWorks_hostGetByName (Name);
- if Addr = Constants.ERROR then
- return null;
- end if;
-
- In_Addr_Access_Ptr.all.all := To_In_Addr (Addr);
- Local_Hostent.all.H_Name := C.Strings.New_Char_Array (To_C (Host_Name));
-
- return Local_Hostent;
- end C_Gethostbyname;
-
- ---------------------
- -- C_Getservbyname --
- ---------------------
-
- function C_Getservbyname
- (Name : C.char_array;
- Proto : C.char_array) return Servent_Access
- is
- pragma Warnings (Off, Name);
- pragma Warnings (Off, Proto);
-
- begin
- return null;
- end C_Getservbyname;
-
- ---------------------
- -- C_Getservbyport --
- ---------------------
-
- function C_Getservbyport
- (Port : C.int;
- Proto : C.char_array) return Servent_Access
- is
- pragma Warnings (Off, Port);
- pragma Warnings (Off, Proto);
-
- begin
- return null;
- end C_Getservbyport;
-
-------------
-- C_Ioctl --
-------------
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;
+ null;
end Initialize;
-------------------------
Address : In_Addr)
is
begin
- Sin.Sin_Addr := Address;
+ Sin.Sin_Addr := Address;
end Set_Address;
----------------
end if;
end Socket_Error_Message;
--- Package elaboration
-
-begin
- Local_Hostent.all.H_Aliases := Alias_Access;
-
- -- VxWorks currently only supports AF_INET
-
- Local_Hostent.all.H_Addrtype := Constants.AF_INET;
-
- Local_Hostent.all.H_Length := 1;
- Local_Hostent.all.H_Addr_List := In_Addr_Access_Ptr;
-
end GNAT.Sockets.Thin;
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2006, AdaCore --
+-- Copyright (C) 2002-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.Unchecked_Conversion;
-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.
function To_In_Addr is new Ada.Unchecked_Conversion (C.int, In_Addr);
-- 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
+ procedure Initialize;
procedure Finalize;
- procedure Initialize (Process_Blocking_IO : Boolean);
private
pragma Import (C, C_Bind, "bind");
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- GNAT.SOCKETS.THIN.HOST_ERROR_MESSAGES --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the default implementation of this unit, providing explicit
+-- literal messages (we do not use hstrerror from the standard C library,
+-- as this function is obsolete).
+
+separate (GNAT.Sockets.Thin)
+package body Host_Error_Messages is
+
+ package Messages is
+ HOST_NOT_FOUND : aliased char_array := "Host not found" & nul;
+ TRY_AGAIN : aliased char_array := "Try again" & nul;
+ NO_RECOVERY : aliased char_array := "No recovery" & nul;
+ NO_DATA : aliased char_array := "No address" & nul;
+ Unknown_Error : aliased char_array := "Unknown error" & nul;
+ end Messages;
+
+ function Host_Error_Message (H_Errno : Integer) return C.Strings.chars_ptr
+ is
+ use Interfaces.C.Strings;
+ function TCP
+ (P : char_array_access; Nul_Check : Boolean := False) return chars_ptr
+ renames To_Chars_Ptr;
+ begin
+ case H_Errno is
+ when Constants.HOST_NOT_FOUND =>
+ return TCP (Messages.HOST_NOT_FOUND'Access);
+
+ when Constants.TRY_AGAIN =>
+ return TCP (Messages.TRY_AGAIN'Access);
+
+ when Constants.NO_RECOVERY =>
+ return TCP (Messages.NO_RECOVERY'Access);
+
+ when Constants.NO_DATA =>
+ return TCP (Messages.NO_DATA'Access);
+
+ when others =>
+ return TCP (Messages.Unknown_Error'Access);
+
+ end case;
+ end Host_Error_Message;
+
+end Host_Error_Messages;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with GNAT.Task_Lock;
+
+with Interfaces.C; use Interfaces.C;
+
+package body GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ procedure Copy_Host_Entry
+ (Source_Hostent : Hostent;
+ Target_Hostent : out Hostent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int);
+ -- Copy all the information from Source_Hostent into Target_Hostent,
+ -- using Target_Buffer to store associated data.
+ -- 0 is returned on success, -1 on failure (in case the provided buffer
+ -- is too small for the associated data).
+
+ procedure Copy_Service_Entry
+ (Source_Servent : Servent;
+ Target_Servent : out Servent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int);
+ -- Copy all the information from Source_Servent into Target_Servent,
+ -- using Target_Buffer to store associated data.
+ -- 0 is returned on success, -1 on failure (in case the provided buffer
+ -- is too small for the associated data).
+
+ procedure Store_Name
+ (Name : char_array;
+ Storage : in out char_array;
+ Storage_Index : in out size_t;
+ Stored_Name : out C.Strings.chars_ptr);
+ -- Store the given Name at the first available location in Storage
+ -- (indicated by Storage_Index, which is updated afterwards), and return
+ -- the address of that location in Stored_Name.
+ -- (Supporting routine for the two below).
+
+ ---------------------
+ -- Copy_Host_Entry --
+ ---------------------
+
+ procedure Copy_Host_Entry
+ (Source_Hostent : Hostent;
+ Target_Hostent : out Hostent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int)
+ is
+ use type C.Strings.chars_ptr;
+
+ Names_Length : size_t;
+
+ Source_Aliases : Chars_Ptr_Array
+ renames Chars_Ptr_Pointers.Value
+ (Source_Hostent.H_Aliases, Terminator => C.Strings.Null_Ptr);
+ -- Null-terminated list of aliases (last element of this array is
+ -- Null_Ptr).
+
+ Source_Addresses : In_Addr_Access_Array
+ renames In_Addr_Access_Pointers.Value
+ (Source_Hostent.H_Addr_List, Terminator => null);
+
+ begin
+ Result := -1;
+ Names_Length := C.Strings.Strlen (Source_Hostent.H_Name) + 1;
+
+ for J in Source_Aliases'Range loop
+ if Source_Aliases (J) /= C.Strings.Null_Ptr then
+ Names_Length :=
+ Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
+ end if;
+ end loop;
+
+ declare
+ type In_Addr_Array is array (Source_Addresses'Range)
+ of aliased In_Addr;
+
+ type Netdb_Host_Data is record
+ Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
+ Names : aliased char_array (1 .. Names_Length);
+
+ Addresses_List : aliased In_Addr_Access_Array
+ (In_Addr_Array'Range);
+ Addresses : In_Addr_Array;
+ -- ??? This assumes support only for Inet family
+
+ end record;
+
+ Netdb_Data : Netdb_Host_Data;
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Target_Buffer;
+
+ Names_Index : size_t := Netdb_Data.Names'First;
+ -- Index of first available location in Netdb_Data.Names
+
+ begin
+ if Netdb_Data'Size / 8 > Target_Buffer_Length then
+ return;
+ end if;
+
+ -- Copy host name
+
+ Store_Name
+ (C.Strings.Value (Source_Hostent.H_Name),
+ Netdb_Data.Names, Names_Index,
+ Target_Hostent.H_Name);
+
+ -- Copy aliases (null-terminated string pointer array)
+
+ Target_Hostent.H_Aliases :=
+ Netdb_Data.Aliases_List
+ (Netdb_Data.Aliases_List'First)'Unchecked_Access;
+ for J in Netdb_Data.Aliases_List'Range loop
+ if J = Netdb_Data.Aliases_List'Last then
+ Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
+ else
+ Store_Name
+ (C.Strings.Value (Source_Aliases (J)),
+ Netdb_Data.Names, Names_Index,
+ Netdb_Data.Aliases_List (J));
+ end if;
+ end loop;
+
+ -- Copy address type and length
+
+ Target_Hostent.H_Addrtype := Source_Hostent.H_Addrtype;
+ Target_Hostent.H_Length := Source_Hostent.H_Length;
+
+ -- Copy addresses
+
+ Target_Hostent.H_Addr_List :=
+ Netdb_Data.Addresses_List
+ (Netdb_Data.Addresses_List'First)'Unchecked_Access;
+
+ for J in Netdb_Data.Addresses'Range loop
+ if J = Netdb_Data.Addresses'Last then
+ Netdb_Data.Addresses_List (J) := null;
+ else
+ Netdb_Data.Addresses_List (J) :=
+ Netdb_Data.Addresses (J)'Unchecked_Access;
+
+ Netdb_Data.Addresses (J) := Source_Addresses (J).all;
+ end if;
+ end loop;
+ end;
+
+ Result := 0;
+ end Copy_Host_Entry;
+
+ ------------------------
+ -- Copy_Service_Entry --
+ ------------------------
+
+ procedure Copy_Service_Entry
+ (Source_Servent : Servent;
+ Target_Servent : out Servent;
+ Target_Buffer : System.Address;
+ Target_Buffer_Length : C.int;
+ Result : out C.int)
+ is
+ use type C.Strings.chars_ptr;
+
+ Names_Length : size_t;
+
+ Source_Aliases : Chars_Ptr_Array
+ renames Chars_Ptr_Pointers.Value
+ (Source_Servent.S_Aliases, Terminator => C.Strings.Null_Ptr);
+ -- Null-terminated list of aliases (last element of this array is
+ -- Null_Ptr).
+
+ begin
+ Result := -1;
+ Names_Length := C.Strings.Strlen (Source_Servent.S_Name) + 1
+ + C.Strings.Strlen (Source_Servent.S_Proto) + 1;
+
+ for J in Source_Aliases'Range loop
+ if Source_Aliases (J) /= C.Strings.Null_Ptr then
+ Names_Length :=
+ Names_Length + C.Strings.Strlen (Source_Aliases (J)) + 1;
+ end if;
+ end loop;
+
+ declare
+ type Netdb_Service_Data is record
+ Aliases_List : aliased Chars_Ptr_Array (Source_Aliases'Range);
+ Names : aliased char_array (1 .. Names_Length);
+ end record;
+
+ Netdb_Data : Netdb_Service_Data;
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Target_Buffer;
+
+ Names_Index : size_t := Netdb_Data.Names'First;
+ -- Index of first available location in Netdb_Data.Names
+
+ begin
+ if Netdb_Data'Size / 8 > Target_Buffer_Length then
+ return;
+ end if;
+
+ -- Copy service name
+
+ Store_Name
+ (C.Strings.Value (Source_Servent.S_Name),
+ Netdb_Data.Names, Names_Index,
+ Target_Servent.S_Name);
+
+ -- Copy aliases (null-terminated string pointer array)
+
+ Target_Servent.S_Aliases :=
+ Netdb_Data.Aliases_List
+ (Netdb_Data.Aliases_List'First)'Unchecked_Access;
+
+ -- Copy port number
+
+ Target_Servent.S_Port := Source_Servent.S_Port;
+
+ -- Copy protocol name
+
+ Store_Name
+ (C.Strings.Value (Source_Servent.S_Proto),
+ Netdb_Data.Names, Names_Index,
+ Target_Servent.S_Proto);
+
+ for J in Netdb_Data.Aliases_List'Range loop
+ if J = Netdb_Data.Aliases_List'Last then
+ Netdb_Data.Aliases_List (J) := C.Strings.Null_Ptr;
+ else
+ Store_Name
+ (C.Strings.Value (Source_Aliases (J)),
+ Netdb_Data.Names, Names_Index,
+ Netdb_Data.Aliases_List (J));
+ end if;
+ end loop;
+ end;
+
+ Result := 0;
+ end Copy_Service_Entry;
+
+ ------------------------
+ -- Safe_Gethostbyaddr --
+ ------------------------
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ HE : Hostent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ HE := Nonreentrant_Gethostbyaddr (Addr, Addr_Len, Addr_Type);
+
+ if HE = null then
+ H_Errnop.all := C.int (Host_Errno);
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Host_Entry
+ (Source_Hostent => HE.all,
+ Target_Hostent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Gethostbyaddr;
+
+ ------------------------
+ -- Safe_Gethostbyname --
+ ------------------------
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ HE : Hostent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ HE := Nonreentrant_Gethostbyname (Name);
+
+ if HE = null then
+ H_Errnop.all := C.int (Host_Errno);
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Host_Entry
+ (Source_Hostent => HE.all,
+ Target_Hostent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Gethostbyname;
+
+ ------------------------
+ -- Safe_Getservbyname --
+ ------------------------
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ SE : Servent_Access;
+ Result : C.int;
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ SE := Nonreentrant_Getservbyname (Name, Proto);
+
+ if SE = null then
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Service_Entry
+ (Source_Servent => SE.all,
+ Target_Servent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Getservbyname;
+
+ ------------------------
+ -- Safe_Getservbyport --
+ ------------------------
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ SE : Servent_Access;
+ Result : C.int;
+
+ begin
+ Result := -1;
+ GNAT.Task_Lock.Lock;
+ SE := Nonreentrant_Getservbyport (Port, Proto);
+
+ if SE = null then
+ goto Unlock_Return;
+ end if;
+
+ -- Now copy the data to the user-provided buffer
+
+ Copy_Service_Entry
+ (Source_Servent => SE.all,
+ Target_Servent => Ret.all,
+ Target_Buffer => Buf,
+ Target_Buffer_Length => Buflen,
+ Result => Result);
+
+ <<Unlock_Return>>
+ GNAT.Task_Lock.Unlock;
+ return Result;
+ end Safe_Getservbyport;
+
+ ----------------
+ -- Store_Name --
+ ----------------
+
+ procedure Store_Name
+ (Name : char_array;
+ Storage : in out char_array;
+ Storage_Index : in out size_t;
+ Stored_Name : out C.Strings.chars_ptr)
+ is
+ First : constant C.size_t := Storage_Index;
+ Last : constant C.size_t := Storage_Index + Name'Length - 1;
+ begin
+ Storage (First .. Last) := Name;
+ Stored_Name := C.Strings.To_Chars_Ptr
+ (Storage (First .. Last)'Unrestricted_Access);
+ Storage_Index := Last + 1;
+ end Store_Name;
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This version is used on VMS and LynxOS
+
+package GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ ----------------------------------------
+ -- Reentrant network databases access --
+ ----------------------------------------
+
+ -- The following routines wrap the Nonreentrant_ versions using the task
+ -- lock, and copy the relevant data structures (under the lock) into the
+ -- result. The Nonreentrant_ versions are expected to be in the parent
+ -- package GNAT.Sockets.Thin (on platforms that use this version of
+ -- Task_Safe_NetDB).
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+with Interfaces.C; use Interfaces.C;
+
+package body GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ -- The following additional data is returned by Safe_Gethostbyname
+ -- and Safe_Getostbyaddr in the user provided buffer.
+
+ type Netdb_Host_Data (Name_Length : C.size_t) is record
+ Address : aliased In_Addr;
+ Addr_List : aliased In_Addr_Access_Array (0 .. 1);
+ Name : aliased C.char_array (0 .. Name_Length);
+ end record;
+
+ Alias_Access : constant Chars_Ptr_Pointers.Pointer :=
+ new C.Strings.chars_ptr'(C.Strings.Null_Ptr);
+ -- Constant used to create a Hostent record manually
+
+ ------------------------
+ -- Safe_Gethostbyaddr --
+ ------------------------
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ type int_Access is access int;
+ function To_Pointer is
+ new Ada.Unchecked_Conversion (System.Address, int_Access);
+
+ function VxWorks_hostGetByAddr
+ (Addr : C.int; Buf : System.Address) return C.int;
+ pragma Import (C, VxWorks_hostGetByAddr, "hostGetByAddr");
+
+ Netdb_Data : Netdb_Host_Data (Name_Length => Max_Name_Length);
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Buf;
+
+ pragma Unreferenced (H_Errnop);
+ -- VxWorks does not provide h_errno
+
+ begin
+ pragma Assert (Addr_Type = Constants.AF_INET);
+ pragma Assert (Addr_Len = In_Addr'Size / 8);
+
+ -- Check that provided buffer is sufficiently large to hold the
+ -- data we want to return.
+
+ if Netdb_Data'Size / 8 > Buflen then
+ return -1;
+ end if;
+
+ if VxWorks_hostGetByAddr (To_Pointer (Addr).all,
+ Netdb_Data.Name'Address)
+ /= Constants.OK
+ then
+ return -1;
+ end if;
+
+ Netdb_Data.Address := To_In_Addr (To_Pointer (Addr).all);
+ Netdb_Data.Addr_List :=
+ (0 => Netdb_Data.Address'Unchecked_Access,
+ 1 => null);
+
+ Ret.H_Name := C.Strings.To_Chars_Ptr
+ (Netdb_Data.Name'Unrestricted_Access);
+ Ret.H_Aliases := Alias_Access;
+ Ret.H_Addrtype := Constants.AF_INET;
+ Ret.H_Length := 4;
+ Ret.H_Addr_List :=
+ Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
+ return 0;
+ end Safe_Gethostbyaddr;
+
+ ------------------------
+ -- Safe_Gethostbyname --
+ ------------------------
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int
+ is
+ function VxWorks_hostGetByName
+ (Name : C.char_array) return C.int;
+ pragma Import (C, VxWorks_hostGetByName, "hostGetByName");
+
+ Addr : C.int;
+
+ pragma Unreferenced (H_Errnop);
+ -- VxWorks does not provide h_errno
+
+ begin
+ Addr := VxWorks_hostGetByName (Name);
+ if Addr = Constants.ERROR then
+ return -1;
+ end if;
+
+ declare
+ Netdb_Data : Netdb_Host_Data (Name_Length => Name'Length);
+ pragma Import (Ada, Netdb_Data);
+ for Netdb_Data'Address use Buf;
+
+ begin
+ -- Check that provided buffer is sufficiently large to hold the
+ -- data we want to return.
+
+ if Netdb_Data'Size / 8 > Buflen then
+ return -1;
+ end if;
+
+ Netdb_Data.Address := To_In_Addr (Addr);
+ Netdb_Data.Addr_List :=
+ (0 => Netdb_Data.Address'Unchecked_Access,
+ 1 => null);
+ Netdb_Data.Name (Netdb_Data.Name'First .. Name'Length - 1) := Name;
+
+ Ret.H_Name := C.Strings.To_Chars_Ptr
+ (Netdb_Data.Name'Unrestricted_Access);
+ Ret.H_Aliases := Alias_Access;
+ Ret.H_Addrtype := Constants.AF_INET;
+ Ret.H_Length := 4;
+ Ret.H_Addr_List :=
+ Netdb_Data.Addr_List (Netdb_Data.Addr_List'First)'Unchecked_Access;
+ end;
+ return 0;
+ end Safe_Gethostbyname;
+
+ ------------------------
+ -- Safe_Getservbyname --
+ ------------------------
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ pragma Unreferenced (Name, Proto, Ret, Buf, Buflen);
+ begin
+ -- Not available under VxWorks
+ return -1;
+ end Safe_Getservbyname;
+
+ ------------------------
+ -- Safe_Getservbyport --
+ ------------------------
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int
+ is
+ pragma Unreferenced (Port, Proto, Ret, Buf, Buflen);
+ begin
+ -- Not available under VxWorks
+ return -1;
+ end Safe_Getservbyport;
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This version is used on VxWorks
+
+package GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ ----------------------------------------
+ -- Reentrant network databases access --
+ ----------------------------------------
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT COMPILER COMPONENTS --
+-- --
+-- G N A T . S O C K E T S . T H I N . T A S K _ S A F E _ N E T D B --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 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- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNAT; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package exports reentrant NetDB subprograms. This is the default
+-- version, used on most platforms. The routines are implemented by importing
+-- from C; see gsocket.h for details. Different versions are provided on
+-- platforms where this functionality is implemented in Ada.
+
+package GNAT.Sockets.Thin.Task_Safe_NetDB is
+
+ ----------------------------------------
+ -- Reentrant network databases access --
+ ----------------------------------------
+
+ function Safe_Gethostbyname
+ (Name : C.char_array;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Gethostbyaddr
+ (Addr : System.Address;
+ Addr_Len : C.int;
+ Addr_Type : C.int;
+ Ret : not null access Hostent;
+ Buf : System.Address;
+ Buflen : C.int;
+ H_Errnop : not null access C.int) return C.int;
+
+ function Safe_Getservbyname
+ (Name : C.char_array;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+ function Safe_Getservbyport
+ (Port : C.int;
+ Proto : C.char_array;
+ Ret : not null access Servent;
+ Buf : System.Address;
+ Buflen : C.int) return C.int;
+
+private
+ pragma Import (C, Safe_Gethostbyname, "__gnat_safe_gethostbyname");
+ pragma Import (C, Safe_Gethostbyaddr, "__gnat_safe_gethostbyaddr");
+ pragma Import (C, Safe_Getservbyname, "__gnat_safe_getservbyname");
+ pragma Import (C, Safe_Getservbyport, "__gnat_safe_getservbyport");
+
+end GNAT.Sockets.Thin.Task_Safe_NetDB;
projects / platform / upstream / gcc.git / commitdiff