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;
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;
procedure Empty (Item : in out Fd_Set) is
begin
Item := Null_Fd_Set;
end Empty;
procedure Finalize is
begin
if Initialized then
WSACleanup;
Initialized := False;
end if;
end Finalize;
function Is_Empty (Item : Fd_Set) return Boolean is
begin
return Item.fd_count = 0;
end Is_Empty;
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;
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;
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;
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;
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;