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-2003 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 was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This package provides a target dependent thin interface to the sockets
35 -- layer for use by the GNAT.Sockets package (g-socket.ads). This package
36 -- should not be directly with'ed by an applications program.
38 -- This version is for NT.
40 with GNAT.Sockets.Constants; use GNAT.Sockets.Constants;
42 with System; use System;
44 package body GNAT.Sockets.Thin is
48 WSAData_Dummy : array (1 .. 512) of C.int;
50 WS_Version : constant := 16#0101#;
51 Initialized : Boolean := False;
53 SYSNOTREADY : constant := 10091;
54 VERNOTSUPPORTED : constant := 10092;
55 NOTINITIALISED : constant := 10093;
56 EDISCON : constant := 10101;
58 function Standard_Connect
60 Name : System.Address;
63 pragma Import (Stdcall, Standard_Connect, "connect");
65 function Standard_Select
67 Readfds : Fd_Set_Access;
68 Writefds : Fd_Set_Access;
69 Exceptfds : Fd_Set_Access;
70 Timeout : Timeval_Access)
72 pragma Import (Stdcall, Standard_Select, "select");
80 Name : System.Address;
87 Res := Standard_Connect (S, Name, Namelen);
90 if Socket_Errno = EWOULDBLOCK then
91 Set_Socket_Errno (EINPROGRESS);
104 Iov : System.Address;
111 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
112 for Iovec'Address use Iov;
113 pragma Import (Ada, Iovec);
116 for J in Iovec'Range loop
119 Iovec (J).Base.all'Address,
120 C.int (Iovec (J).Length),
126 Count := Count + Res;
138 Readfds : Fd_Set_Access;
139 Writefds : Fd_Set_Access;
140 Exceptfds : Fd_Set_Access;
141 Timeout : Timeval_Access)
144 pragma Warnings (Off, Exceptfds);
146 RFS : Fd_Set_Access := Readfds;
147 WFS : Fd_Set_Access := Writefds;
148 WFSC : Fd_Set_Access := No_Fd_Set;
149 EFS : Fd_Set_Access := Exceptfds;
152 Last : aliased C.int;
155 -- Asynchronous connection failures are notified in the
156 -- exception fd set instead of the write fd set. To ensure
157 -- POSIX compatitibility, copy write fd set into exception fd
158 -- set. Once select() returns, check any socket present in the
159 -- exception fd set and peek at incoming out-of-band data. If
160 -- the test is not successfull and if the socket is present in
161 -- the initial write fd set, then move the socket from the
162 -- exception fd set to the write fd set.
164 if WFS /= No_Fd_Set then
165 -- Add any socket present in write fd set into exception fd set
167 if EFS = No_Fd_Set then
168 EFS := New_Socket_Set (WFS);
171 WFSC := New_Socket_Set (WFS);
176 (WFSC, S'Unchecked_Access, Last'Unchecked_Access);
178 Insert_Socket_In_Set (EFS, S);
181 Free_Socket_Set (WFSC);
184 -- Keep a copy of write fd set
186 WFSC := New_Socket_Set (WFS);
189 Res := Standard_Select (Nfds, RFS, WFS, EFS, Timeout);
191 if EFS /= No_Fd_Set then
193 EFSC : Fd_Set_Access := New_Socket_Set (EFS);
196 Flag : C.int := MSG_PEEK + MSG_OOB;
197 Fromlen : aliased C.int;
203 (EFSC, S'Unchecked_Access, Last'Unchecked_Access);
205 -- No more sockets in EFSC
209 -- Check out-of-band data
212 (S, Buffer'Address, 1, Flag,
213 null, Fromlen'Unchecked_Access);
215 -- If the signal is not an out-of-band data, then it
216 -- is a connection failure notification.
219 Remove_Socket_From_Set (EFS, S);
221 -- If S is present in the initial write fd set,
222 -- move it from exception fd set back to write fd
223 -- set. Otherwise, ignore this event since the user
224 -- is not watching for it.
227 and then Is_Socket_In_Set (WFSC, S)
229 Insert_Socket_In_Set (WFS, S);
234 Free_Socket_Set (EFSC);
237 if Exceptfds = No_Fd_Set then
238 Free_Socket_Set (EFS);
242 -- Free any copy of write fd set
244 if WFSC /= No_Fd_Set then
245 Free_Socket_Set (WFSC);
257 Iov : System.Address;
264 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
265 for Iovec'Address use Iov;
266 pragma Import (Ada, Iovec);
269 for J in Iovec'Range loop
272 Iovec (J).Base.all'Address,
273 C.int (Iovec (J).Length),
279 Count := Count + Res;
289 procedure Finalize is
293 Initialized := False;
301 procedure Initialize (Process_Blocking_IO : Boolean := False) is
302 pragma Unreferenced (Process_Blocking_IO);
304 Return_Value : Interfaces.C.int;
307 if not Initialized then
308 Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
309 pragma Assert (Interfaces.C."=" (Return_Value, 0));
318 procedure Set_Address
319 (Sin : Sockaddr_In_Access;
323 Sin.Sin_Addr := Address;
331 (Sin : Sockaddr_In_Access;
335 Sin.Sin_Family := C.unsigned_short (Family);
343 (Sin : Sockaddr_In_Access;
346 pragma Unreferenced (Sin);
347 pragma Unreferenced (Len);
358 (Sin : Sockaddr_In_Access;
359 Port : C.unsigned_short)
362 Sin.Sin_Port := Port;
365 --------------------------
366 -- Socket_Error_Message --
367 --------------------------
369 function Socket_Error_Message (Errno : Integer) return String is
370 use GNAT.Sockets.Constants;
375 return "Interrupted system call";
378 return "Bad file number";
381 return "Permission denied";
384 return "Bad address";
387 return "Invalid argument";
390 return "Too many open files";
393 return "Operation would block";
396 return "Operation now in progress. This error is "
397 & "returned if any Windows Sockets API "
398 & "function is called while a blocking "
399 & "function is in progress";
402 return "Operation already in progress";
405 return "Socket operation on nonsocket";
408 return "Destination address required";
411 return "Message too long";
414 return "Protocol wrong type for socket";
417 return "Protocol not available";
419 when EPROTONOSUPPORT =>
420 return "Protocol not supported";
422 when ESOCKTNOSUPPORT =>
423 return "Socket type not supported";
426 return "Operation not supported on socket";
429 return "Protocol family not supported";
432 return "Address family not supported by protocol family";
435 return "Address already in use";
437 when EADDRNOTAVAIL =>
438 return "Cannot assign requested address";
441 return "Network is down. This error may be "
442 & "reported at any time if the Windows "
443 & "Sockets implementation detects an "
444 & "underlying failure";
447 return "Network is unreachable";
450 return "Network dropped connection on reset";
453 return "Software caused connection abort";
456 return "Connection reset by peer";
459 return "No buffer space available";
462 return "Socket is already connected";
465 return "Socket is not connected";
468 return "Cannot send after socket shutdown";
471 return "Too many references: cannot splice";
474 return "Connection timed out";
477 return "Connection refused";
480 return "Too many levels of symbolic links";
483 return "File name too long";
486 return "Host is down";
489 return "No route to host";
492 return "Returned by WSAStartup(), indicating that "
493 & "the network subsystem is unusable";
495 when VERNOTSUPPORTED =>
496 return "Returned by WSAStartup(), indicating that "
497 & "the Windows Sockets DLL cannot support this application";
499 when NOTINITIALISED =>
500 return "Winsock not initialized. This message is "
501 & "returned by any function except WSAStartup(), "
502 & "indicating that a successful WSAStartup() has "
503 & "not yet been performed";
508 when HOST_NOT_FOUND =>
509 return "Host not found. This message indicates "
510 & "that the key (name, address, and so on) was not found";
513 return "Nonauthoritative host not found. This error may "
514 & "suggest that the name service itself is not functioning";
517 return "Nonrecoverable error. This error may suggest that the "
518 & "name service itself is not functioning";
521 return "Valid name, no data record of requested type. "
522 & "This error indicates that the key (name, address, "
523 & "and so on) was not found.";
526 return "Unknown system error";
529 end Socket_Error_Message;
531 end GNAT.Sockets.Thin;