blob: ebbe8413feb556024e5109cee208c4d78bc9a848 [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- G N A T . S O C K E T S . T H I N --
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $
-- --
-- Copyright (C) 2001 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- --
-- 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, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, 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 is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This version is for NT.
package body GNAT.Sockets.Thin is
use type C.unsigned;
WSAData_Dummy : array (1 .. 512) of C.int;
WS_Version : constant := 16#0101#;
Initialized : Boolean := False;
-----------
-- Clear --
-----------
procedure Clear
(Item : in out Fd_Set;
Socket : C.int)
is
begin
for J in 1 .. Item.fd_count loop
if Item.fd_array (J) = Socket then
Item.fd_array (J .. Item.fd_count - 1) :=
Item.fd_array (J + 1 .. Item.fd_count);
Item.fd_count := Item.fd_count - 1;
exit;
end if;
end loop;
end Clear;
-----------
-- Empty --
-----------
procedure Empty (Item : in out Fd_Set) is
begin
Item := Null_Fd_Set;
end Empty;
--------------
-- Finalize --
--------------
procedure Finalize is
begin
if Initialized then
WSACleanup;
Initialized := False;
end if;
end Finalize;
--------------
-- Is_Empty --
--------------
function Is_Empty (Item : Fd_Set) return Boolean is
begin
return Item.fd_count = 0;
end Is_Empty;
------------
-- Is_Set --
------------
function Is_Set (Item : Fd_Set; Socket : C.int) return Boolean is
begin
for J in 1 .. Item.fd_count loop
if Item.fd_array (J) = Socket then
return True;
end if;
end loop;
return False;
end Is_Set;
----------------
-- Initialize --
----------------
procedure Initialize (Process_Blocking_IO : Boolean := False) is
Return_Value : Interfaces.C.int;
begin
if not Initialized then
Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
pragma Assert (Interfaces.C."=" (Return_Value, 0));
Initialized := True;
end if;
end Initialize;
---------
-- Max --
---------
function Max (Item : Fd_Set) return C.int is
L : C.int := 0;
begin
for J in 1 .. Item.fd_count loop
if Item.fd_array (J) > L then
L := Item.fd_array (J);
end if;
end loop;
return L;
end Max;
---------
-- Set --
---------
procedure Set (Item : in out Fd_Set; Socket : in C.int) is
begin
Item.fd_count := Item.fd_count + 1;
Item.fd_array (Item.fd_count) := Socket;
end Set;
--------------------------
-- Socket_Error_Message --
--------------------------
function Socket_Error_Message (Errno : Integer) return String is
use GNAT.Sockets.Constants;
begin
case Errno is
when EINTR =>
return "Interrupted system call";
when EBADF =>
return "Bad file number";
when EACCES =>
return "Permission denied";
when EFAULT =>
return "Bad address";
when EINVAL =>
return "Invalid argument";
when EMFILE =>
return "Too many open files";
when EWOULDBLOCK =>
return "Operation would block";
when EINPROGRESS =>
return "Operation now in progress. This error is "
& "returned if any Windows Sockets API "
& "function is called while a blocking "
& "function is in progress";
when EALREADY =>
return "Operation already in progress";
when ENOTSOCK =>
return "Socket operation on nonsocket";
when EDESTADDRREQ =>
return "Destination address required";
when EMSGSIZE =>
return "Message too long";
when EPROTOTYPE =>
return "Protocol wrong type for socket";
when ENOPROTOOPT =>
return "Protocol not available";
when EPROTONOSUPPORT =>
return "Protocol not supported";
when ESOCKTNOSUPPORT =>
return "Socket type not supported";
when EOPNOTSUPP =>
return "Operation not supported on socket";
when EPFNOSUPPORT =>
return "Protocol family not supported";
when EAFNOSUPPORT =>
return "Address family not supported by protocol family";
when EADDRINUSE =>
return "Address already in use";
when EADDRNOTAVAIL =>
return "Cannot assign requested address";
when ENETDOWN =>
return "Network is down. This error may be "
& "reported at any time if the Windows "
& "Sockets implementation detects an "
& "underlying failure";
when ENETUNREACH =>
return "Network is unreachable";
when ENETRESET =>
return "Network dropped connection on reset";
when ECONNABORTED =>
return "Software caused connection abort";
when ECONNRESET =>
return "Connection reset by peer";
when ENOBUFS =>
return "No buffer space available";
when EISCONN =>
return "Socket is already connected";
when ENOTCONN =>
return "Socket is not connected";
when ESHUTDOWN =>
return "Cannot send after socket shutdown";
when ETOOMANYREFS =>
return "Too many references: cannot splice";
when ETIMEDOUT =>
return "Connection timed out";
when ECONNREFUSED =>
return "Connection refused";
when ELOOP =>
return "Too many levels of symbolic links";
when ENAMETOOLONG =>
return "File name too long";
when EHOSTDOWN =>
return "Host is down";
when EHOSTUNREACH =>
return "No route to host";
when SYSNOTREADY =>
return "Returned by WSAStartup(), indicating that "
& "the network subsystem is unusable";
when VERNOTSUPPORTED =>
return "Returned by WSAStartup(), indicating that "
& "the Windows Sockets DLL cannot support this application";
when NOTINITIALISED =>
return "Winsock not initialized. This message is "
& "returned by any function except WSAStartup(), "
& "indicating that a successful WSAStartup() has "
& "not yet been performed";
when EDISCON =>
return "Disconnect";
when HOST_NOT_FOUND =>
return "Host not found. This message indicates "
& "that the key (name, address, and so on) was not found";
when TRY_AGAIN =>
return "Nonauthoritative host not found. This error may "
& "suggest that the name service itself is not functioning";
when NO_RECOVERY =>
return "Nonrecoverable error. This error may suggest that the "
& "name service itself is not functioning";
when NO_DATA =>
return "Valid name, no data record of requested type. "
& "This error indicates that the key (name, address, "
& "and so on) was not found.";
when others =>
return "Unknown system error";
end case;
end Socket_Error_Message;
end GNAT.Sockets.Thin;