1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S . T H I N --
9 -- Copyright (C) 2001 Ada Core Technologies, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). --
31 ------------------------------------------------------------------------------
33 -- This version is for NT.
35 package body GNAT
.Sockets
.Thin
is
39 WSAData_Dummy
: array (1 .. 512) of C
.int
;
41 WS_Version
: constant := 16#
0101#
;
42 Initialized
: Boolean := False;
49 (Item
: in out Fd_Set
;
53 for J
in 1 .. Item
.fd_count
loop
54 if Item
.fd_array
(J
) = Socket
then
55 Item
.fd_array
(J
.. Item
.fd_count
- 1) :=
56 Item
.fd_array
(J
+ 1 .. Item
.fd_count
);
57 Item
.fd_count
:= Item
.fd_count
- 1;
67 procedure Empty
(Item
: in out Fd_Set
) is
88 function Is_Empty
(Item
: Fd_Set
) return Boolean is
90 return Item
.fd_count
= 0;
97 function Is_Set
(Item
: Fd_Set
; Socket
: C
.int
) return Boolean is
99 for J
in 1 .. Item
.fd_count
loop
100 if Item
.fd_array
(J
) = Socket
then
112 procedure Initialize
(Process_Blocking_IO
: Boolean := False) is
113 Return_Value
: Interfaces
.C
.int
;
116 if not Initialized
then
117 Return_Value
:= WSAStartup
(WS_Version
, WSAData_Dummy
'Address);
118 pragma Assert
(Interfaces
.C
."=" (Return_Value
, 0));
127 function Max
(Item
: Fd_Set
) return C
.int
is
131 for J
in 1 .. Item
.fd_count
loop
132 if Item
.fd_array
(J
) > L
then
133 L
:= Item
.fd_array
(J
);
144 procedure Set
(Item
: in out Fd_Set
; Socket
: in C
.int
) is
146 Item
.fd_count
:= Item
.fd_count
+ 1;
147 Item
.fd_array
(Item
.fd_count
) := Socket
;
150 --------------------------
151 -- Socket_Error_Message --
152 --------------------------
154 function Socket_Error_Message
(Errno
: Integer) return String is
155 use GNAT
.Sockets
.Constants
;
160 return "Interrupted system call";
163 return "Bad file number";
166 return "Permission denied";
169 return "Bad address";
172 return "Invalid argument";
175 return "Too many open files";
178 return "Operation would block";
181 return "Operation now in progress. This error is "
182 & "returned if any Windows Sockets API "
183 & "function is called while a blocking "
184 & "function is in progress";
187 return "Operation already in progress";
190 return "Socket operation on nonsocket";
193 return "Destination address required";
196 return "Message too long";
199 return "Protocol wrong type for socket";
202 return "Protocol not available";
204 when EPROTONOSUPPORT
=>
205 return "Protocol not supported";
207 when ESOCKTNOSUPPORT
=>
208 return "Socket type not supported";
211 return "Operation not supported on socket";
214 return "Protocol family not supported";
217 return "Address family not supported by protocol family";
220 return "Address already in use";
222 when EADDRNOTAVAIL
=>
223 return "Cannot assign requested address";
226 return "Network is down. This error may be "
227 & "reported at any time if the Windows "
228 & "Sockets implementation detects an "
229 & "underlying failure";
232 return "Network is unreachable";
235 return "Network dropped connection on reset";
238 return "Software caused connection abort";
241 return "Connection reset by peer";
244 return "No buffer space available";
247 return "Socket is already connected";
250 return "Socket is not connected";
253 return "Cannot send after socket shutdown";
256 return "Too many references: cannot splice";
259 return "Connection timed out";
262 return "Connection refused";
265 return "Too many levels of symbolic links";
268 return "File name too long";
271 return "Host is down";
274 return "No route to host";
277 return "Returned by WSAStartup(), indicating that "
278 & "the network subsystem is unusable";
280 when VERNOTSUPPORTED
=>
281 return "Returned by WSAStartup(), indicating that "
282 & "the Windows Sockets DLL cannot support this application";
284 when NOTINITIALISED
=>
285 return "Winsock not initialized. This message is "
286 & "returned by any function except WSAStartup(), "
287 & "indicating that a successful WSAStartup() has "
288 & "not yet been performed";
293 when HOST_NOT_FOUND
=>
294 return "Host not found. This message indicates "
295 & "that the key (name, address, and so on) was not found";
298 return "Nonauthoritative host not found. This error may "
299 & "suggest that the name service itself is not functioning";
302 return "Nonrecoverable error. This error may suggest that the "
303 & "name service itself is not functioning";
306 return "Valid name, no data record of requested type. "
307 & "This error indicates that the key (name, address, "
308 & "and so on) was not found.";
311 return "Unknown system error";
314 end Socket_Error_Message
;
316 end GNAT
.Sockets
.Thin
;