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-2007, AdaCore --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, 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 Interfaces.C.Strings; use Interfaces.C.Strings;
41 with System; use System;
43 package body GNAT.Sockets.Thin is
47 WSAData_Dummy : array (1 .. 512) of C.int;
49 WS_Version : constant := 16#0202#;
50 Initialized : Boolean := False;
52 function Standard_Connect
54 Name : System.Address;
55 Namelen : C.int) return C.int;
56 pragma Import (Stdcall, Standard_Connect, "connect");
58 function Standard_Select
60 Readfds : Fd_Set_Access;
61 Writefds : Fd_Set_Access;
62 Exceptfds : Fd_Set_Access;
63 Timeout : Timeval_Access) return C.int;
64 pragma Import (Stdcall, Standard_Select, "select");
105 N_WSAVERNOTSUPPORTED,
114 Error_Messages : constant array (Error_Type) of chars_ptr :=
116 New_String ("Interrupted system call"),
118 New_String ("Bad file number"),
120 New_String ("Permission denied"),
122 New_String ("Bad address"),
124 New_String ("Invalid argument"),
126 New_String ("Too many open files"),
128 New_String ("Operation would block"),
130 New_String ("Operation now in progress. This error is "
131 & "returned if any Windows Sockets API "
132 & "function is called while a blocking "
133 & "function is in progress"),
135 New_String ("Operation already in progress"),
137 New_String ("Socket operation on nonsocket"),
139 New_String ("Destination address required"),
141 New_String ("Message too long"),
143 New_String ("Protocol wrong type for socket"),
145 New_String ("Protocol not available"),
147 New_String ("Protocol not supported"),
149 New_String ("Socket type not supported"),
151 New_String ("Operation not supported on socket"),
153 New_String ("Protocol family not supported"),
155 New_String ("Address family not supported by protocol family"),
157 New_String ("Address already in use"),
159 New_String ("Cannot assign requested address"),
161 New_String ("Network is down. This error may be "
162 & "reported at any time if the Windows "
163 & "Sockets implementation detects an "
164 & "underlying failure"),
166 New_String ("Network is unreachable"),
168 New_String ("Network dropped connection on reset"),
170 New_String ("Software caused connection abort"),
172 New_String ("Connection reset by peer"),
174 New_String ("No buffer space available"),
176 New_String ("Socket is already connected"),
178 New_String ("Socket is not connected"),
180 New_String ("Cannot send after socket shutdown"),
182 New_String ("Too many references: cannot splice"),
184 New_String ("Connection timed out"),
186 New_String ("Connection refused"),
188 New_String ("Too many levels of symbolic links"),
190 New_String ("File name too long"),
192 New_String ("Host is down"),
194 New_String ("No route to host"),
196 New_String ("Returned by WSAStartup(), indicating that "
197 & "the network subsystem is unusable"),
198 N_WSAVERNOTSUPPORTED =>
199 New_String ("Returned by WSAStartup(), indicating that "
200 & "the Windows Sockets DLL cannot support "
201 & "this application"),
202 N_WSANOTINITIALISED =>
203 New_String ("Winsock not initialized. This message is "
204 & "returned by any function except WSAStartup(), "
205 & "indicating that a successful WSAStartup() has "
206 & "not yet been performed"),
208 New_String ("Disconnected"),
210 New_String ("Host not found. This message indicates "
211 & "that the key (name, address, and so on) was not found"),
213 New_String ("Nonauthoritative host not found. This error may "
214 & "suggest that the name service itself is not "
217 New_String ("Nonrecoverable error. This error may suggest that the "
218 & "name service itself is not functioning"),
220 New_String ("Valid name, no data record of requested type. "
221 & "This error indicates that the key (name, address, "
222 & "and so on) was not found."),
224 New_String ("Unknown system error"));
232 Name : System.Address;
233 Namelen : C.int) return C.int
238 Res := Standard_Connect (S, Name, Namelen);
241 if Socket_Errno = Constants.EWOULDBLOCK then
242 Set_Socket_Errno (Constants.EINPROGRESS);
255 Iov : System.Address;
256 Iovcnt : C.int) return C.int
261 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
262 for Iovec'Address use Iov;
263 pragma Import (Ada, Iovec);
266 for J in Iovec'Range loop
269 Iovec (J).Base.all'Address,
270 C.int (Iovec (J).Length),
276 Count := Count + Res;
288 Readfds : Fd_Set_Access;
289 Writefds : Fd_Set_Access;
290 Exceptfds : Fd_Set_Access;
291 Timeout : Timeval_Access) return C.int
293 pragma Warnings (Off, Exceptfds);
295 RFS : constant Fd_Set_Access := Readfds;
296 WFS : constant Fd_Set_Access := Writefds;
297 WFSC : Fd_Set_Access := No_Fd_Set;
298 EFS : Fd_Set_Access := Exceptfds;
301 Last : aliased C.int;
304 -- Asynchronous connection failures are notified in the
305 -- exception fd set instead of the write fd set. To ensure
306 -- POSIX compatitibility, copy write fd set into exception fd
307 -- set. Once select() returns, check any socket present in the
308 -- exception fd set and peek at incoming out-of-band data. If
309 -- the test is not successful, and the socket is present in
310 -- the initial write fd set, then move the socket from the
311 -- exception fd set to the write fd set.
313 if WFS /= No_Fd_Set then
314 -- Add any socket present in write fd set into exception fd set
316 if EFS = No_Fd_Set then
317 EFS := New_Socket_Set (WFS);
320 WFSC := New_Socket_Set (WFS);
325 (WFSC, S'Unchecked_Access, Last'Unchecked_Access);
327 Insert_Socket_In_Set (EFS, S);
330 Free_Socket_Set (WFSC);
333 -- Keep a copy of write fd set
335 WFSC := New_Socket_Set (WFS);
338 Res := Standard_Select (Nfds, RFS, WFS, EFS, Timeout);
340 if EFS /= No_Fd_Set then
342 EFSC : constant Fd_Set_Access := New_Socket_Set (EFS);
343 Flag : constant C.int := Constants.MSG_PEEK + Constants.MSG_OOB;
346 Fromlen : aliased C.int;
352 (EFSC, S'Unchecked_Access, Last'Unchecked_Access);
354 -- No more sockets in EFSC
358 -- Check out-of-band data
361 (S, Buffer'Address, 1, Flag,
362 null, Fromlen'Unchecked_Access);
364 -- If the signal is not an out-of-band data, then it
365 -- is a connection failure notification.
368 Remove_Socket_From_Set (EFS, S);
370 -- If S is present in the initial write fd set,
371 -- move it from exception fd set back to write fd
372 -- set. Otherwise, ignore this event since the user
373 -- is not watching for it.
376 and then (Is_Socket_In_Set (WFSC, S) /= 0)
378 Insert_Socket_In_Set (WFS, S);
383 Free_Socket_Set (EFSC);
386 if Exceptfds = No_Fd_Set then
387 Free_Socket_Set (EFS);
391 -- Free any copy of write fd set
393 if WFSC /= No_Fd_Set then
394 Free_Socket_Set (WFSC);
406 Iov : System.Address;
407 Iovcnt : C.int) return C.int
412 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
413 for Iovec'Address use Iov;
414 pragma Import (Ada, Iovec);
417 for J in Iovec'Range loop
420 Iovec (J).Base.all'Address,
421 C.int (Iovec (J).Length),
427 Count := Count + Res;
437 procedure Finalize is
441 Initialized := False;
445 -------------------------
446 -- Host_Error_Messages --
447 -------------------------
449 package body Host_Error_Messages is
451 -- On Windows, socket and host errors share the same code space, and
452 -- error messages are provided by Socket_Error_Message. The default
453 -- separate body for Host_Error_Messages is therefore not used in
456 function Host_Error_Message
457 (H_Errno : Integer) return C.Strings.chars_ptr
458 renames Socket_Error_Message;
460 end Host_Error_Messages;
466 procedure Initialize is
467 Return_Value : Interfaces.C.int;
469 if not Initialized then
470 Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
471 pragma Assert (Return_Value = 0);
480 procedure Set_Address
481 (Sin : Sockaddr_In_Access;
485 Sin.Sin_Addr := Address;
493 (Sin : Sockaddr_In_Access;
497 Sin.Sin_Family := C.unsigned_short (Family);
505 (Sin : Sockaddr_In_Access;
508 pragma Unreferenced (Sin);
509 pragma Unreferenced (Len);
520 (Sin : Sockaddr_In_Access;
521 Port : C.unsigned_short)
524 Sin.Sin_Port := Port;
531 package body Signalling_Fds is separate;
533 --------------------------
534 -- Socket_Error_Message --
535 --------------------------
537 function Socket_Error_Message
538 (Errno : Integer) return C.Strings.chars_ptr
540 use GNAT.Sockets.Constants;
543 when EINTR => return Error_Messages (N_EINTR);
544 when EBADF => return Error_Messages (N_EBADF);
545 when EACCES => return Error_Messages (N_EACCES);
546 when EFAULT => return Error_Messages (N_EFAULT);
547 when EINVAL => return Error_Messages (N_EINVAL);
548 when EMFILE => return Error_Messages (N_EMFILE);
549 when EWOULDBLOCK => return Error_Messages (N_EWOULDBLOCK);
550 when EINPROGRESS => return Error_Messages (N_EINPROGRESS);
551 when EALREADY => return Error_Messages (N_EALREADY);
552 when ENOTSOCK => return Error_Messages (N_ENOTSOCK);
553 when EDESTADDRREQ => return Error_Messages (N_EDESTADDRREQ);
554 when EMSGSIZE => return Error_Messages (N_EMSGSIZE);
555 when EPROTOTYPE => return Error_Messages (N_EPROTOTYPE);
556 when ENOPROTOOPT => return Error_Messages (N_ENOPROTOOPT);
557 when EPROTONOSUPPORT => return Error_Messages (N_EPROTONOSUPPORT);
558 when ESOCKTNOSUPPORT => return Error_Messages (N_ESOCKTNOSUPPORT);
559 when EOPNOTSUPP => return Error_Messages (N_EOPNOTSUPP);
560 when EPFNOSUPPORT => return Error_Messages (N_EPFNOSUPPORT);
561 when EAFNOSUPPORT => return Error_Messages (N_EAFNOSUPPORT);
562 when EADDRINUSE => return Error_Messages (N_EADDRINUSE);
563 when EADDRNOTAVAIL => return Error_Messages (N_EADDRNOTAVAIL);
564 when ENETDOWN => return Error_Messages (N_ENETDOWN);
565 when ENETUNREACH => return Error_Messages (N_ENETUNREACH);
566 when ENETRESET => return Error_Messages (N_ENETRESET);
567 when ECONNABORTED => return Error_Messages (N_ECONNABORTED);
568 when ECONNRESET => return Error_Messages (N_ECONNRESET);
569 when ENOBUFS => return Error_Messages (N_ENOBUFS);
570 when EISCONN => return Error_Messages (N_EISCONN);
571 when ENOTCONN => return Error_Messages (N_ENOTCONN);
572 when ESHUTDOWN => return Error_Messages (N_ESHUTDOWN);
573 when ETOOMANYREFS => return Error_Messages (N_ETOOMANYREFS);
574 when ETIMEDOUT => return Error_Messages (N_ETIMEDOUT);
575 when ECONNREFUSED => return Error_Messages (N_ECONNREFUSED);
576 when ELOOP => return Error_Messages (N_ELOOP);
577 when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG);
578 when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN);
579 when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH);
581 -- Windows-specific error codes
583 when WSASYSNOTREADY => return Error_Messages (N_WSASYSNOTREADY);
584 when WSAVERNOTSUPPORTED =>
585 return Error_Messages (N_WSAVERNOTSUPPORTED);
586 when WSANOTINITIALISED =>
587 return Error_Messages (N_WSANOTINITIALISED);
588 when WSAEDISCON => return Error_Messages (N_WSAEDISCON);
592 when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND);
593 when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN);
594 when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY);
595 when NO_DATA => return Error_Messages (N_NO_DATA);
597 when others => return Error_Messages (N_OTHERS);
599 end Socket_Error_Message;
601 end GNAT.Sockets.Thin;