| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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; |