|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT COMPILER COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- G N A T . S O C K E T S . T H I N --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
|
9 -- Copyright (C) 2001-2017, AdaCore --
|
|
|
10 -- --
|
|
|
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 3, 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. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 -- This package provides a target dependent thin interface to the sockets
|
|
|
33 -- layer for use by the GNAT.Sockets package (g-socket.ads). This package
|
|
|
34 -- should not be directly with'ed by an applications program.
|
|
|
35
|
|
|
36 -- This version is for NT
|
|
|
37
|
|
|
38 with Ada.Unchecked_Conversion;
|
|
|
39 with Interfaces.C.Strings; use Interfaces.C.Strings;
|
|
|
40 with System; use System;
|
|
|
41 with System.Storage_Elements; use System.Storage_Elements;
|
|
|
42
|
|
|
43 package body GNAT.Sockets.Thin is
|
|
|
44
|
|
|
45 use type C.unsigned;
|
|
|
46
|
|
|
47 WSAData_Dummy : array (1 .. 512) of C.int;
|
|
|
48
|
|
|
49 WS_Version : constant := 16#0202#;
|
|
|
50 -- Winsock 2.2
|
|
|
51
|
|
|
52 Initialized : Boolean := False;
|
|
|
53
|
|
|
54 function Standard_Connect
|
|
|
55 (S : C.int;
|
|
|
56 Name : System.Address;
|
|
|
57 Namelen : C.int) return C.int;
|
|
|
58 pragma Import (Stdcall, Standard_Connect, "connect");
|
|
|
59
|
|
|
60 function Standard_Select
|
|
|
61 (Nfds : C.int;
|
|
|
62 Readfds : access Fd_Set;
|
|
|
63 Writefds : access Fd_Set;
|
|
|
64 Exceptfds : access Fd_Set;
|
|
|
65 Timeout : Timeval_Access) return C.int;
|
|
|
66 pragma Import (Stdcall, Standard_Select, "select");
|
|
|
67
|
|
|
68 type Error_Type is
|
|
|
69 (N_EINTR,
|
|
|
70 N_EBADF,
|
|
|
71 N_EACCES,
|
|
|
72 N_EFAULT,
|
|
|
73 N_EINVAL,
|
|
|
74 N_EMFILE,
|
|
|
75 N_EWOULDBLOCK,
|
|
|
76 N_EINPROGRESS,
|
|
|
77 N_EALREADY,
|
|
|
78 N_ENOTSOCK,
|
|
|
79 N_EDESTADDRREQ,
|
|
|
80 N_EMSGSIZE,
|
|
|
81 N_EPROTOTYPE,
|
|
|
82 N_ENOPROTOOPT,
|
|
|
83 N_EPROTONOSUPPORT,
|
|
|
84 N_ESOCKTNOSUPPORT,
|
|
|
85 N_EOPNOTSUPP,
|
|
|
86 N_EPFNOSUPPORT,
|
|
|
87 N_EAFNOSUPPORT,
|
|
|
88 N_EADDRINUSE,
|
|
|
89 N_EADDRNOTAVAIL,
|
|
|
90 N_ENETDOWN,
|
|
|
91 N_ENETUNREACH,
|
|
|
92 N_ENETRESET,
|
|
|
93 N_ECONNABORTED,
|
|
|
94 N_ECONNRESET,
|
|
|
95 N_ENOBUFS,
|
|
|
96 N_EISCONN,
|
|
|
97 N_ENOTCONN,
|
|
|
98 N_ESHUTDOWN,
|
|
|
99 N_ETOOMANYREFS,
|
|
|
100 N_ETIMEDOUT,
|
|
|
101 N_ECONNREFUSED,
|
|
|
102 N_ELOOP,
|
|
|
103 N_ENAMETOOLONG,
|
|
|
104 N_EHOSTDOWN,
|
|
|
105 N_EHOSTUNREACH,
|
|
|
106 N_WSASYSNOTREADY,
|
|
|
107 N_WSAVERNOTSUPPORTED,
|
|
|
108 N_WSANOTINITIALISED,
|
|
|
109 N_WSAEDISCON,
|
|
|
110 N_HOST_NOT_FOUND,
|
|
|
111 N_TRY_AGAIN,
|
|
|
112 N_NO_RECOVERY,
|
|
|
113 N_NO_DATA,
|
|
|
114 N_OTHERS);
|
|
|
115
|
|
|
116 Error_Messages : constant array (Error_Type) of chars_ptr :=
|
|
|
117 (N_EINTR =>
|
|
|
118 New_String ("Interrupted system call"),
|
|
|
119 N_EBADF =>
|
|
|
120 New_String ("Bad file number"),
|
|
|
121 N_EACCES =>
|
|
|
122 New_String ("Permission denied"),
|
|
|
123 N_EFAULT =>
|
|
|
124 New_String ("Bad address"),
|
|
|
125 N_EINVAL =>
|
|
|
126 New_String ("Invalid argument"),
|
|
|
127 N_EMFILE =>
|
|
|
128 New_String ("Too many open files"),
|
|
|
129 N_EWOULDBLOCK =>
|
|
|
130 New_String ("Operation would block"),
|
|
|
131 N_EINPROGRESS =>
|
|
|
132 New_String ("Operation now in progress. This error is "
|
|
|
133 & "returned if any Windows Sockets API "
|
|
|
134 & "function is called while a blocking "
|
|
|
135 & "function is in progress"),
|
|
|
136 N_EALREADY =>
|
|
|
137 New_String ("Operation already in progress"),
|
|
|
138 N_ENOTSOCK =>
|
|
|
139 New_String ("Socket operation on nonsocket"),
|
|
|
140 N_EDESTADDRREQ =>
|
|
|
141 New_String ("Destination address required"),
|
|
|
142 N_EMSGSIZE =>
|
|
|
143 New_String ("Message too long"),
|
|
|
144 N_EPROTOTYPE =>
|
|
|
145 New_String ("Protocol wrong type for socket"),
|
|
|
146 N_ENOPROTOOPT =>
|
|
|
147 New_String ("Protocol not available"),
|
|
|
148 N_EPROTONOSUPPORT =>
|
|
|
149 New_String ("Protocol not supported"),
|
|
|
150 N_ESOCKTNOSUPPORT =>
|
|
|
151 New_String ("Socket type not supported"),
|
|
|
152 N_EOPNOTSUPP =>
|
|
|
153 New_String ("Operation not supported on socket"),
|
|
|
154 N_EPFNOSUPPORT =>
|
|
|
155 New_String ("Protocol family not supported"),
|
|
|
156 N_EAFNOSUPPORT =>
|
|
|
157 New_String ("Address family not supported by protocol family"),
|
|
|
158 N_EADDRINUSE =>
|
|
|
159 New_String ("Address already in use"),
|
|
|
160 N_EADDRNOTAVAIL =>
|
|
|
161 New_String ("Cannot assign requested address"),
|
|
|
162 N_ENETDOWN =>
|
|
|
163 New_String ("Network is down. This error may be "
|
|
|
164 & "reported at any time if the Windows "
|
|
|
165 & "Sockets implementation detects an "
|
|
|
166 & "underlying failure"),
|
|
|
167 N_ENETUNREACH =>
|
|
|
168 New_String ("Network is unreachable"),
|
|
|
169 N_ENETRESET =>
|
|
|
170 New_String ("Network dropped connection on reset"),
|
|
|
171 N_ECONNABORTED =>
|
|
|
172 New_String ("Software caused connection abort"),
|
|
|
173 N_ECONNRESET =>
|
|
|
174 New_String ("Connection reset by peer"),
|
|
|
175 N_ENOBUFS =>
|
|
|
176 New_String ("No buffer space available"),
|
|
|
177 N_EISCONN =>
|
|
|
178 New_String ("Socket is already connected"),
|
|
|
179 N_ENOTCONN =>
|
|
|
180 New_String ("Socket is not connected"),
|
|
|
181 N_ESHUTDOWN =>
|
|
|
182 New_String ("Cannot send after socket shutdown"),
|
|
|
183 N_ETOOMANYREFS =>
|
|
|
184 New_String ("Too many references: cannot splice"),
|
|
|
185 N_ETIMEDOUT =>
|
|
|
186 New_String ("Connection timed out"),
|
|
|
187 N_ECONNREFUSED =>
|
|
|
188 New_String ("Connection refused"),
|
|
|
189 N_ELOOP =>
|
|
|
190 New_String ("Too many levels of symbolic links"),
|
|
|
191 N_ENAMETOOLONG =>
|
|
|
192 New_String ("File name too long"),
|
|
|
193 N_EHOSTDOWN =>
|
|
|
194 New_String ("Host is down"),
|
|
|
195 N_EHOSTUNREACH =>
|
|
|
196 New_String ("No route to host"),
|
|
|
197 N_WSASYSNOTREADY =>
|
|
|
198 New_String ("Returned by WSAStartup(), indicating that "
|
|
|
199 & "the network subsystem is unusable"),
|
|
|
200 N_WSAVERNOTSUPPORTED =>
|
|
|
201 New_String ("Returned by WSAStartup(), indicating that "
|
|
|
202 & "the Windows Sockets DLL cannot support "
|
|
|
203 & "this application"),
|
|
|
204 N_WSANOTINITIALISED =>
|
|
|
205 New_String ("Winsock not initialized. This message is "
|
|
|
206 & "returned by any function except WSAStartup(), "
|
|
|
207 & "indicating that a successful WSAStartup() has "
|
|
|
208 & "not yet been performed"),
|
|
|
209 N_WSAEDISCON =>
|
|
|
210 New_String ("Disconnected"),
|
|
|
211 N_HOST_NOT_FOUND =>
|
|
|
212 New_String ("Host not found. This message indicates "
|
|
|
213 & "that the key (name, address, and so on) was not found"),
|
|
|
214 N_TRY_AGAIN =>
|
|
|
215 New_String ("Nonauthoritative host not found. This error may "
|
|
|
216 & "suggest that the name service itself is not "
|
|
|
217 & "functioning"),
|
|
|
218 N_NO_RECOVERY =>
|
|
|
219 New_String ("Nonrecoverable error. This error may suggest that the "
|
|
|
220 & "name service itself is not functioning"),
|
|
|
221 N_NO_DATA =>
|
|
|
222 New_String ("Valid name, no data record of requested type. "
|
|
|
223 & "This error indicates that the key (name, address, "
|
|
|
224 & "and so on) was not found."),
|
|
|
225 N_OTHERS =>
|
|
|
226 New_String ("Unknown system error"));
|
|
|
227
|
|
|
228 ---------------
|
|
|
229 -- C_Connect --
|
|
|
230 ---------------
|
|
|
231
|
|
|
232 function C_Connect
|
|
|
233 (S : C.int;
|
|
|
234 Name : System.Address;
|
|
|
235 Namelen : C.int) return C.int
|
|
|
236 is
|
|
|
237 Res : C.int;
|
|
|
238
|
|
|
239 begin
|
|
|
240 Res := Standard_Connect (S, Name, Namelen);
|
|
|
241
|
|
|
242 if Res = -1 then
|
|
|
243 if Socket_Errno = SOSC.EWOULDBLOCK then
|
|
|
244 Set_Socket_Errno (SOSC.EINPROGRESS);
|
|
|
245 end if;
|
|
|
246 end if;
|
|
|
247
|
|
|
248 return Res;
|
|
|
249 end C_Connect;
|
|
|
250
|
|
|
251 ------------------
|
|
|
252 -- Socket_Ioctl --
|
|
|
253 ------------------
|
|
|
254
|
|
|
255 function Socket_Ioctl
|
|
|
256 (S : C.int;
|
|
|
257 Req : SOSC.IOCTL_Req_T;
|
|
|
258 Arg : access C.int) return C.int
|
|
|
259 is
|
|
|
260 begin
|
|
|
261 return C_Ioctl (S, Req, Arg);
|
|
|
262 end Socket_Ioctl;
|
|
|
263
|
|
|
264 ---------------
|
|
|
265 -- C_Recvmsg --
|
|
|
266 ---------------
|
|
|
267
|
|
|
268 function C_Recvmsg
|
|
|
269 (S : C.int;
|
|
|
270 Msg : System.Address;
|
|
|
271 Flags : C.int) return System.CRTL.ssize_t
|
|
|
272 is
|
|
|
273 use type C.size_t;
|
|
|
274
|
|
|
275 Fill : constant Boolean :=
|
|
|
276 SOSC.MSG_WAITALL /= -1
|
|
|
277 and then (C.unsigned (Flags) and SOSC.MSG_WAITALL) /= 0;
|
|
|
278 -- Is the MSG_WAITALL flag set? If so we need to fully fill all vectors
|
|
|
279
|
|
|
280 Res : C.int;
|
|
|
281 Count : C.int := 0;
|
|
|
282
|
|
|
283 MH : Msghdr;
|
|
|
284 for MH'Address use Msg;
|
|
|
285
|
|
|
286 Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
|
|
|
287 for Iovec'Address use MH.Msg_Iov;
|
|
|
288 pragma Import (Ada, Iovec);
|
|
|
289
|
|
|
290 Iov_Index : Integer;
|
|
|
291 Current_Iovec : Vector_Element;
|
|
|
292
|
|
|
293 function To_Access is new Ada.Unchecked_Conversion
|
|
|
294 (System.Address, Stream_Element_Reference);
|
|
|
295 pragma Warnings (Off, Stream_Element_Reference);
|
|
|
296
|
|
|
297 Req : Request_Type (Name => N_Bytes_To_Read);
|
|
|
298
|
|
|
299 begin
|
|
|
300 -- Windows does not provide an implementation of recvmsg(). The spec for
|
|
|
301 -- WSARecvMsg() is incompatible with the data types we define, and is
|
|
|
302 -- available starting with Windows Vista and Server 2008 only. So,
|
|
|
303 -- we use C_Recv instead.
|
|
|
304
|
|
|
305 -- Check how much data are available
|
|
|
306
|
|
|
307 Control_Socket (Socket_Type (S), Req);
|
|
|
308
|
|
|
309 -- Fill the vectors
|
|
|
310
|
|
|
311 Iov_Index := -1;
|
|
|
312 Current_Iovec := (Base => null, Length => 0);
|
|
|
313
|
|
|
314 loop
|
|
|
315 if Current_Iovec.Length = 0 then
|
|
|
316 Iov_Index := Iov_Index + 1;
|
|
|
317 exit when Iov_Index > Integer (Iovec'Last);
|
|
|
318 Current_Iovec := Iovec (SOSC.Msg_Iovlen_T (Iov_Index));
|
|
|
319 end if;
|
|
|
320
|
|
|
321 Res :=
|
|
|
322 C_Recv
|
|
|
323 (S,
|
|
|
324 Current_Iovec.Base.all'Address,
|
|
|
325 C.int (Current_Iovec.Length),
|
|
|
326 Flags);
|
|
|
327
|
|
|
328 if Res < 0 then
|
|
|
329 return System.CRTL.ssize_t (Res);
|
|
|
330
|
|
|
331 elsif Res = 0 and then not Fill then
|
|
|
332 exit;
|
|
|
333
|
|
|
334 else
|
|
|
335 pragma Assert (Interfaces.C.size_t (Res) <= Current_Iovec.Length);
|
|
|
336
|
|
|
337 Count := Count + Res;
|
|
|
338 Current_Iovec.Length :=
|
|
|
339 Current_Iovec.Length - Interfaces.C.size_t (Res);
|
|
|
340 Current_Iovec.Base :=
|
|
|
341 To_Access (Current_Iovec.Base.all'Address
|
|
|
342 + Storage_Offset (Res));
|
|
|
343
|
|
|
344 -- If all the data that was initially available read, do not
|
|
|
345 -- attempt to receive more, since this might block, or merge data
|
|
|
346 -- from successive datagrams for a datagram-oriented socket. We
|
|
|
347 -- still try to receive more if we need to fill all vectors
|
|
|
348 -- (MSG_WAITALL flag is set).
|
|
|
349
|
|
|
350 exit when Natural (Count) >= Req.Size
|
|
|
351 and then
|
|
|
352
|
|
|
353 -- Either we are not in fill mode
|
|
|
354
|
|
|
355 (not Fill
|
|
|
356
|
|
|
357 -- Or else last vector filled
|
|
|
358
|
|
|
359 or else (Interfaces.C.size_t (Iov_Index) = Iovec'Last
|
|
|
360 and then Current_Iovec.Length = 0));
|
|
|
361 end if;
|
|
|
362 end loop;
|
|
|
363
|
|
|
364 return System.CRTL.ssize_t (Count);
|
|
|
365 end C_Recvmsg;
|
|
|
366
|
|
|
367 --------------
|
|
|
368 -- C_Select --
|
|
|
369 --------------
|
|
|
370
|
|
|
371 function C_Select
|
|
|
372 (Nfds : C.int;
|
|
|
373 Readfds : access Fd_Set;
|
|
|
374 Writefds : access Fd_Set;
|
|
|
375 Exceptfds : access Fd_Set;
|
|
|
376 Timeout : Timeval_Access) return C.int
|
|
|
377 is
|
|
|
378 pragma Warnings (Off, Exceptfds);
|
|
|
379
|
|
|
380 Original_WFS : aliased constant Fd_Set := Writefds.all;
|
|
|
381
|
|
|
382 Res : C.int;
|
|
|
383 S : aliased C.int;
|
|
|
384 Last : aliased C.int;
|
|
|
385
|
|
|
386 begin
|
|
|
387 -- Asynchronous connection failures are notified in the exception fd
|
|
|
388 -- set instead of the write fd set. To ensure POSIX compatibility, copy
|
|
|
389 -- write fd set into exception fd set. Once select() returns, check any
|
|
|
390 -- socket present in the exception fd set and peek at incoming
|
|
|
391 -- out-of-band data. If the test is not successful, and the socket is
|
|
|
392 -- present in the initial write fd set, then move the socket from the
|
|
|
393 -- exception fd set to the write fd set.
|
|
|
394
|
|
|
395 if Writefds /= No_Fd_Set_Access then
|
|
|
396
|
|
|
397 -- Add any socket present in write fd set into exception fd set
|
|
|
398
|
|
|
399 declare
|
|
|
400 WFS : aliased Fd_Set := Writefds.all;
|
|
|
401 begin
|
|
|
402 Last := Nfds - 1;
|
|
|
403 loop
|
|
|
404 Get_Socket_From_Set
|
|
|
405 (WFS'Access, S'Unchecked_Access, Last'Unchecked_Access);
|
|
|
406 exit when S = -1;
|
|
|
407 Insert_Socket_In_Set (Exceptfds, S);
|
|
|
408 end loop;
|
|
|
409 end;
|
|
|
410 end if;
|
|
|
411
|
|
|
412 Res := Standard_Select (Nfds, Readfds, Writefds, Exceptfds, Timeout);
|
|
|
413
|
|
|
414 if Exceptfds /= No_Fd_Set_Access then
|
|
|
415 declare
|
|
|
416 EFSC : aliased Fd_Set := Exceptfds.all;
|
|
|
417 Flag : constant C.int := SOSC.MSG_PEEK + SOSC.MSG_OOB;
|
|
|
418 Buffer : Character;
|
|
|
419 Length : C.int;
|
|
|
420 Fromlen : aliased C.int;
|
|
|
421
|
|
|
422 begin
|
|
|
423 Last := Nfds - 1;
|
|
|
424 loop
|
|
|
425 Get_Socket_From_Set
|
|
|
426 (EFSC'Access, S'Unchecked_Access, Last'Unchecked_Access);
|
|
|
427
|
|
|
428 -- No more sockets in EFSC
|
|
|
429
|
|
|
430 exit when S = -1;
|
|
|
431
|
|
|
432 -- Check out-of-band data
|
|
|
433
|
|
|
434 Length :=
|
|
|
435 C_Recvfrom
|
|
|
436 (S, Buffer'Address, 1, Flag,
|
|
|
437 From => System.Null_Address,
|
|
|
438 Fromlen => Fromlen'Unchecked_Access);
|
|
|
439 -- Is Fromlen necessary if From is Null_Address???
|
|
|
440
|
|
|
441 -- If the signal is not an out-of-band data, then it
|
|
|
442 -- is a connection failure notification.
|
|
|
443
|
|
|
444 if Length = -1 then
|
|
|
445 Remove_Socket_From_Set (Exceptfds, S);
|
|
|
446
|
|
|
447 -- If S is present in the initial write fd set, move it from
|
|
|
448 -- exception fd set back to write fd set. Otherwise, ignore
|
|
|
449 -- this event since the user is not watching for it.
|
|
|
450
|
|
|
451 if Writefds /= No_Fd_Set_Access
|
|
|
452 and then (Is_Socket_In_Set (Original_WFS'Access, S) /= 0)
|
|
|
453 then
|
|
|
454 Insert_Socket_In_Set (Writefds, S);
|
|
|
455 end if;
|
|
|
456 end if;
|
|
|
457 end loop;
|
|
|
458 end;
|
|
|
459 end if;
|
|
|
460 return Res;
|
|
|
461 end C_Select;
|
|
|
462
|
|
|
463 ---------------
|
|
|
464 -- C_Sendmsg --
|
|
|
465 ---------------
|
|
|
466
|
|
|
467 function C_Sendmsg
|
|
|
468 (S : C.int;
|
|
|
469 Msg : System.Address;
|
|
|
470 Flags : C.int) return System.CRTL.ssize_t
|
|
|
471 is
|
|
|
472 use type C.size_t;
|
|
|
473
|
|
|
474 Res : C.int;
|
|
|
475 Count : C.int := 0;
|
|
|
476
|
|
|
477 MH : Msghdr;
|
|
|
478 for MH'Address use Msg;
|
|
|
479
|
|
|
480 Iovec : array (0 .. MH.Msg_Iovlen - 1) of Vector_Element;
|
|
|
481 for Iovec'Address use MH.Msg_Iov;
|
|
|
482 pragma Import (Ada, Iovec);
|
|
|
483
|
|
|
484 begin
|
|
|
485 -- Windows does not provide an implementation of sendmsg(). The spec for
|
|
|
486 -- WSASendMsg() is incompatible with the data types we define, and is
|
|
|
487 -- available starting with Windows Vista and Server 2008 only. So
|
|
|
488 -- use C_Sendto instead.
|
|
|
489
|
|
|
490 for J in Iovec'Range loop
|
|
|
491 Res :=
|
|
|
492 C_Sendto
|
|
|
493 (S,
|
|
|
494 Iovec (J).Base.all'Address,
|
|
|
495 C.int (Iovec (J).Length),
|
|
|
496 Flags => Flags,
|
|
|
497 To => MH.Msg_Name,
|
|
|
498 Tolen => C.int (MH.Msg_Namelen));
|
|
|
499
|
|
|
500 if Res < 0 then
|
|
|
501 return System.CRTL.ssize_t (Res);
|
|
|
502 else
|
|
|
503 Count := Count + Res;
|
|
|
504 end if;
|
|
|
505
|
|
|
506 -- Exit now if the buffer is not fully transmitted
|
|
|
507
|
|
|
508 exit when Interfaces.C.size_t (Res) < Iovec (J).Length;
|
|
|
509 end loop;
|
|
|
510
|
|
|
511 return System.CRTL.ssize_t (Count);
|
|
|
512 end C_Sendmsg;
|
|
|
513
|
|
|
514 --------------
|
|
|
515 -- Finalize --
|
|
|
516 --------------
|
|
|
517
|
|
|
518 procedure Finalize is
|
|
|
519 begin
|
|
|
520 if Initialized then
|
|
|
521 WSACleanup;
|
|
|
522 Initialized := False;
|
|
|
523 end if;
|
|
|
524 end Finalize;
|
|
|
525
|
|
|
526 -------------------------
|
|
|
527 -- Host_Error_Messages --
|
|
|
528 -------------------------
|
|
|
529
|
|
|
530 package body Host_Error_Messages is
|
|
|
531
|
|
|
532 -- On Windows, socket and host errors share the same code space, and
|
|
|
533 -- error messages are provided by Socket_Error_Message, so the default
|
|
|
534 -- separate body for Host_Error_Messages is not used in this case.
|
|
|
535
|
|
|
536 function Host_Error_Message (H_Errno : Integer) return String
|
|
|
537 renames Socket_Error_Message;
|
|
|
538
|
|
|
539 end Host_Error_Messages;
|
|
|
540
|
|
|
541 ----------------
|
|
|
542 -- Initialize --
|
|
|
543 ----------------
|
|
|
544
|
|
|
545 procedure Initialize is
|
|
|
546 Return_Value : Interfaces.C.int;
|
|
|
547 begin
|
|
|
548 if not Initialized then
|
|
|
549 Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
|
|
|
550 pragma Assert (Return_Value = 0);
|
|
|
551 Initialized := True;
|
|
|
552 end if;
|
|
|
553 end Initialize;
|
|
|
554
|
|
|
555 --------------------
|
|
|
556 -- Signalling_Fds --
|
|
|
557 --------------------
|
|
|
558
|
|
|
559 package body Signalling_Fds is separate;
|
|
|
560
|
|
|
561 --------------------------
|
|
|
562 -- Socket_Error_Message --
|
|
|
563 --------------------------
|
|
|
564
|
|
|
565 function Socket_Error_Message (Errno : Integer) return String is
|
|
|
566 use GNAT.Sockets.SOSC;
|
|
|
567
|
|
|
568 Errm : C.Strings.chars_ptr;
|
|
|
569
|
|
|
570 begin
|
|
|
571 case Errno is
|
|
|
572 when EINTR => Errm := Error_Messages (N_EINTR);
|
|
|
573 when EBADF => Errm := Error_Messages (N_EBADF);
|
|
|
574 when EACCES => Errm := Error_Messages (N_EACCES);
|
|
|
575 when EFAULT => Errm := Error_Messages (N_EFAULT);
|
|
|
576 when EINVAL => Errm := Error_Messages (N_EINVAL);
|
|
|
577 when EMFILE => Errm := Error_Messages (N_EMFILE);
|
|
|
578 when EWOULDBLOCK => Errm := Error_Messages (N_EWOULDBLOCK);
|
|
|
579 when EINPROGRESS => Errm := Error_Messages (N_EINPROGRESS);
|
|
|
580 when EALREADY => Errm := Error_Messages (N_EALREADY);
|
|
|
581 when ENOTSOCK => Errm := Error_Messages (N_ENOTSOCK);
|
|
|
582 when EDESTADDRREQ => Errm := Error_Messages (N_EDESTADDRREQ);
|
|
|
583 when EMSGSIZE => Errm := Error_Messages (N_EMSGSIZE);
|
|
|
584 when EPROTOTYPE => Errm := Error_Messages (N_EPROTOTYPE);
|
|
|
585 when ENOPROTOOPT => Errm := Error_Messages (N_ENOPROTOOPT);
|
|
|
586 when EPROTONOSUPPORT => Errm := Error_Messages (N_EPROTONOSUPPORT);
|
|
|
587 when ESOCKTNOSUPPORT => Errm := Error_Messages (N_ESOCKTNOSUPPORT);
|
|
|
588 when EOPNOTSUPP => Errm := Error_Messages (N_EOPNOTSUPP);
|
|
|
589 when EPFNOSUPPORT => Errm := Error_Messages (N_EPFNOSUPPORT);
|
|
|
590 when EAFNOSUPPORT => Errm := Error_Messages (N_EAFNOSUPPORT);
|
|
|
591 when EADDRINUSE => Errm := Error_Messages (N_EADDRINUSE);
|
|
|
592 when EADDRNOTAVAIL => Errm := Error_Messages (N_EADDRNOTAVAIL);
|
|
|
593 when ENETDOWN => Errm := Error_Messages (N_ENETDOWN);
|
|
|
594 when ENETUNREACH => Errm := Error_Messages (N_ENETUNREACH);
|
|
|
595 when ENETRESET => Errm := Error_Messages (N_ENETRESET);
|
|
|
596 when ECONNABORTED => Errm := Error_Messages (N_ECONNABORTED);
|
|
|
597 when ECONNRESET => Errm := Error_Messages (N_ECONNRESET);
|
|
|
598 when ENOBUFS => Errm := Error_Messages (N_ENOBUFS);
|
|
|
599 when EISCONN => Errm := Error_Messages (N_EISCONN);
|
|
|
600 when ENOTCONN => Errm := Error_Messages (N_ENOTCONN);
|
|
|
601 when ESHUTDOWN => Errm := Error_Messages (N_ESHUTDOWN);
|
|
|
602 when ETOOMANYREFS => Errm := Error_Messages (N_ETOOMANYREFS);
|
|
|
603 when ETIMEDOUT => Errm := Error_Messages (N_ETIMEDOUT);
|
|
|
604 when ECONNREFUSED => Errm := Error_Messages (N_ECONNREFUSED);
|
|
|
605 when ELOOP => Errm := Error_Messages (N_ELOOP);
|
|
|
606 when ENAMETOOLONG => Errm := Error_Messages (N_ENAMETOOLONG);
|
|
|
607 when EHOSTDOWN => Errm := Error_Messages (N_EHOSTDOWN);
|
|
|
608 when EHOSTUNREACH => Errm := Error_Messages (N_EHOSTUNREACH);
|
|
|
609
|
|
|
610 -- Windows-specific error codes
|
|
|
611
|
|
|
612 when WSASYSNOTREADY => Errm := Error_Messages (N_WSASYSNOTREADY);
|
|
|
613 when WSAVERNOTSUPPORTED =>
|
|
|
614 Errm := Error_Messages (N_WSAVERNOTSUPPORTED);
|
|
|
615 when WSANOTINITIALISED =>
|
|
|
616 Errm := Error_Messages (N_WSANOTINITIALISED);
|
|
|
617 when WSAEDISCON => Errm := Error_Messages (N_WSAEDISCON);
|
|
|
618
|
|
|
619 -- h_errno values
|
|
|
620
|
|
|
621 when HOST_NOT_FOUND => Errm := Error_Messages (N_HOST_NOT_FOUND);
|
|
|
622 when TRY_AGAIN => Errm := Error_Messages (N_TRY_AGAIN);
|
|
|
623 when NO_RECOVERY => Errm := Error_Messages (N_NO_RECOVERY);
|
|
|
624 when NO_DATA => Errm := Error_Messages (N_NO_DATA);
|
|
|
625 when others => Errm := Error_Messages (N_OTHERS);
|
|
|
626 end case;
|
|
|
627
|
|
|
628 return Value (Errm);
|
|
|
629 end Socket_Error_Message;
|
|
|
630
|
|
|
631 end GNAT.Sockets.Thin;
|
