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-2009, 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
48 WSAData_Dummy : array (1 .. 512) of C.int;
50 WS_Version : constant := 16#0202#;
53 Initialized : Boolean := False;
55 function Standard_Connect
57 Name : System.Address;
58 Namelen : C.int) return C.int;
59 pragma Import (Stdcall, Standard_Connect, "connect");
61 function Standard_Select
63 Readfds : access Fd_Set;
64 Writefds : access Fd_Set;
65 Exceptfds : access Fd_Set;
66 Timeout : Timeval_Access) return C.int;
67 pragma Import (Stdcall, Standard_Select, "select");
108 N_WSAVERNOTSUPPORTED,
117 Error_Messages : constant array (Error_Type) of chars_ptr :=
119 New_String ("Interrupted system call"),
121 New_String ("Bad file number"),
123 New_String ("Permission denied"),
125 New_String ("Bad address"),
127 New_String ("Invalid argument"),
129 New_String ("Too many open files"),
131 New_String ("Operation would block"),
133 New_String ("Operation now in progress. This error is "
134 & "returned if any Windows Sockets API "
135 & "function is called while a blocking "
136 & "function is in progress"),
138 New_String ("Operation already in progress"),
140 New_String ("Socket operation on nonsocket"),
142 New_String ("Destination address required"),
144 New_String ("Message too long"),
146 New_String ("Protocol wrong type for socket"),
148 New_String ("Protocol not available"),
150 New_String ("Protocol not supported"),
152 New_String ("Socket type not supported"),
154 New_String ("Operation not supported on socket"),
156 New_String ("Protocol family not supported"),
158 New_String ("Address family not supported by protocol family"),
160 New_String ("Address already in use"),
162 New_String ("Cannot assign requested address"),
164 New_String ("Network is down. This error may be "
165 & "reported at any time if the Windows "
166 & "Sockets implementation detects an "
167 & "underlying failure"),
169 New_String ("Network is unreachable"),
171 New_String ("Network dropped connection on reset"),
173 New_String ("Software caused connection abort"),
175 New_String ("Connection reset by peer"),
177 New_String ("No buffer space available"),
179 New_String ("Socket is already connected"),
181 New_String ("Socket is not connected"),
183 New_String ("Cannot send after socket shutdown"),
185 New_String ("Too many references: cannot splice"),
187 New_String ("Connection timed out"),
189 New_String ("Connection refused"),
191 New_String ("Too many levels of symbolic links"),
193 New_String ("File name too long"),
195 New_String ("Host is down"),
197 New_String ("No route to host"),
199 New_String ("Returned by WSAStartup(), indicating that "
200 & "the network subsystem is unusable"),
201 N_WSAVERNOTSUPPORTED =>
202 New_String ("Returned by WSAStartup(), indicating that "
203 & "the Windows Sockets DLL cannot support "
204 & "this application"),
205 N_WSANOTINITIALISED =>
206 New_String ("Winsock not initialized. This message is "
207 & "returned by any function except WSAStartup(), "
208 & "indicating that a successful WSAStartup() has "
209 & "not yet been performed"),
211 New_String ("Disconnected"),
213 New_String ("Host not found. This message indicates "
214 & "that the key (name, address, and so on) was not found"),
216 New_String ("Nonauthoritative host not found. This error may "
217 & "suggest that the name service itself is not "
220 New_String ("Nonrecoverable error. This error may suggest that the "
221 & "name service itself is not functioning"),
223 New_String ("Valid name, no data record of requested type. "
224 & "This error indicates that the key (name, address, "
225 & "and so on) was not found."),
227 New_String ("Unknown system error"));
235 Name : System.Address;
236 Namelen : C.int) return C.int
241 Res := Standard_Connect (S, Name, Namelen);
244 if Socket_Errno = SOSC.EWOULDBLOCK then
245 Set_Socket_Errno (SOSC.EINPROGRESS);
256 function Socket_Ioctl
259 Arg : access C.int) return C.int
262 return C_Ioctl (S, Req, Arg);
271 Msg : System.Address;
272 Flags : C.int) return ssize_t
278 for MH'Address use Msg;
280 Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
281 for Iovec'Address use MH.Msg_Iov;
282 pragma Import (Ada, Iovec);
285 -- Windows does not provide an implementation of recvmsg(). The spec for
286 -- WSARecvMsg() is incompatible with the data types we define, and is
287 -- not available in all versions of Windows. So, we use C_Recv instead.
289 for J in Iovec'Range loop
292 Iovec (J).Base.all'Address,
293 C.int (Iovec (J).Length),
297 return ssize_t (Res);
299 Count := Count + Res;
302 return ssize_t (Count);
311 Readfds : access Fd_Set;
312 Writefds : access Fd_Set;
313 Exceptfds : access Fd_Set;
314 Timeout : Timeval_Access) return C.int
316 pragma Warnings (Off, Exceptfds);
318 Original_WFS : aliased constant Fd_Set := Writefds.all;
322 Last : aliased C.int;
325 -- Asynchronous connection failures are notified in the exception fd set
326 -- instead of the write fd set. To ensure POSIX compatibility, copy
327 -- write fd set into exception fd set. Once select() returns, check any
328 -- socket present in the exception fd set and peek at incoming
329 -- out-of-band data. If the test is not successful, and the socket is
330 -- present in the initial write fd set, then move the socket from the
331 -- exception fd set to the write fd set.
333 if Writefds /= No_Fd_Set_Access then
335 -- Add any socket present in write fd set into exception fd set
338 WFS : aliased Fd_Set := Writefds.all;
343 (WFS'Access, S'Unchecked_Access, Last'Unchecked_Access);
345 Insert_Socket_In_Set (Exceptfds, S);
350 Res := Standard_Select (Nfds, Readfds, Writefds, Exceptfds, Timeout);
352 if Exceptfds /= No_Fd_Set_Access then
354 EFSC : aliased Fd_Set := Exceptfds.all;
355 Flag : constant C.int := SOSC.MSG_PEEK + SOSC.MSG_OOB;
358 Fromlen : aliased C.int;
364 (EFSC'Access, S'Unchecked_Access, Last'Unchecked_Access);
366 -- No more sockets in EFSC
370 -- Check out-of-band data
373 (S, Buffer'Address, 1, Flag,
374 From => System.Null_Address,
375 Fromlen => Fromlen'Unchecked_Access);
376 -- Is Fromlen necessary if From is Null_Address???
378 -- If the signal is not an out-of-band data, then it
379 -- is a connection failure notification.
382 Remove_Socket_From_Set (Exceptfds, S);
384 -- If S is present in the initial write fd set, move it from
385 -- exception fd set back to write fd set. Otherwise, ignore
386 -- this event since the user is not watching for it.
388 if Writefds /= No_Fd_Set_Access
389 and then (Is_Socket_In_Set (Original_WFS'Access, S) /= 0)
391 Insert_Socket_In_Set (Writefds, S);
406 Msg : System.Address;
407 Flags : C.int) return ssize_t
413 for MH'Address use Msg;
415 Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
416 for Iovec'Address use MH.Msg_Iov;
417 pragma Import (Ada, Iovec);
420 -- Windows does not provide an implementation of sendmsg(). The spec for
421 -- WSASendMsg() is incompatible with the data types we define, and is
422 -- not available in all versions of Windows. So, we'll use C_Sendto
425 for J in Iovec'Range loop
428 Iovec (J).Base.all'Address,
429 C.int (Iovec (J).Length),
432 Tolen => C.int (MH.Msg_Namelen));
435 return ssize_t (Res);
437 Count := Count + Res;
440 return ssize_t (Count);
447 procedure Finalize is
451 Initialized := False;
455 -------------------------
456 -- Host_Error_Messages --
457 -------------------------
459 package body Host_Error_Messages is
461 -- On Windows, socket and host errors share the same code space, and
462 -- error messages are provided by Socket_Error_Message. The default
463 -- separate body for Host_Error_Messages is therefore not used in
466 function Host_Error_Message
467 (H_Errno : Integer) return C.Strings.chars_ptr
468 renames Socket_Error_Message;
470 end Host_Error_Messages;
476 procedure Initialize is
477 Return_Value : Interfaces.C.int;
479 if not Initialized then
480 Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
481 pragma Assert (Return_Value = 0);
490 package body Signalling_Fds is separate;
492 --------------------------
493 -- Socket_Error_Message --
494 --------------------------
496 function Socket_Error_Message
497 (Errno : Integer) return C.Strings.chars_ptr
499 use GNAT.Sockets.SOSC;
503 when EINTR => return Error_Messages (N_EINTR);
504 when EBADF => return Error_Messages (N_EBADF);
505 when EACCES => return Error_Messages (N_EACCES);
506 when EFAULT => return Error_Messages (N_EFAULT);
507 when EINVAL => return Error_Messages (N_EINVAL);
508 when EMFILE => return Error_Messages (N_EMFILE);
509 when EWOULDBLOCK => return Error_Messages (N_EWOULDBLOCK);
510 when EINPROGRESS => return Error_Messages (N_EINPROGRESS);
511 when EALREADY => return Error_Messages (N_EALREADY);
512 when ENOTSOCK => return Error_Messages (N_ENOTSOCK);
513 when EDESTADDRREQ => return Error_Messages (N_EDESTADDRREQ);
514 when EMSGSIZE => return Error_Messages (N_EMSGSIZE);
515 when EPROTOTYPE => return Error_Messages (N_EPROTOTYPE);
516 when ENOPROTOOPT => return Error_Messages (N_ENOPROTOOPT);
517 when EPROTONOSUPPORT => return Error_Messages (N_EPROTONOSUPPORT);
518 when ESOCKTNOSUPPORT => return Error_Messages (N_ESOCKTNOSUPPORT);
519 when EOPNOTSUPP => return Error_Messages (N_EOPNOTSUPP);
520 when EPFNOSUPPORT => return Error_Messages (N_EPFNOSUPPORT);
521 when EAFNOSUPPORT => return Error_Messages (N_EAFNOSUPPORT);
522 when EADDRINUSE => return Error_Messages (N_EADDRINUSE);
523 when EADDRNOTAVAIL => return Error_Messages (N_EADDRNOTAVAIL);
524 when ENETDOWN => return Error_Messages (N_ENETDOWN);
525 when ENETUNREACH => return Error_Messages (N_ENETUNREACH);
526 when ENETRESET => return Error_Messages (N_ENETRESET);
527 when ECONNABORTED => return Error_Messages (N_ECONNABORTED);
528 when ECONNRESET => return Error_Messages (N_ECONNRESET);
529 when ENOBUFS => return Error_Messages (N_ENOBUFS);
530 when EISCONN => return Error_Messages (N_EISCONN);
531 when ENOTCONN => return Error_Messages (N_ENOTCONN);
532 when ESHUTDOWN => return Error_Messages (N_ESHUTDOWN);
533 when ETOOMANYREFS => return Error_Messages (N_ETOOMANYREFS);
534 when ETIMEDOUT => return Error_Messages (N_ETIMEDOUT);
535 when ECONNREFUSED => return Error_Messages (N_ECONNREFUSED);
536 when ELOOP => return Error_Messages (N_ELOOP);
537 when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG);
538 when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN);
539 when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH);
541 -- Windows-specific error codes
543 when WSASYSNOTREADY => return Error_Messages (N_WSASYSNOTREADY);
544 when WSAVERNOTSUPPORTED =>
545 return Error_Messages (N_WSAVERNOTSUPPORTED);
546 when WSANOTINITIALISED =>
547 return Error_Messages (N_WSANOTINITIALISED);
548 when WSAEDISCON => return Error_Messages (N_WSAEDISCON);
552 when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND);
553 when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN);
554 when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY);
555 when NO_DATA => return Error_Messages (N_NO_DATA);
557 when others => return Error_Messages (N_OTHERS);
559 end Socket_Error_Message;
561 end GNAT.Sockets.Thin;