1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
5 -- G N A T . S O C K E T S . T H I N --
9 -- Copyright (C) 2002-2013, 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 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. --
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. --
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/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
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.
36 -- This version is for VxWorks
38 with GNAT.OS_Lib; use GNAT.OS_Lib;
41 with Interfaces.C; use Interfaces.C;
43 package body GNAT.Sockets.Thin is
45 Non_Blocking_Sockets : aliased Fd_Set;
46 -- When this package is initialized with Process_Blocking_IO set
47 -- to True, sockets are set in non-blocking mode to avoid blocking
48 -- the whole process when a thread wants to perform a blocking IO
49 -- operation. But the user can also set a socket in non-blocking
50 -- mode by purpose. In order to make a difference between these
51 -- two situations, we track the origin of non-blocking mode in
52 -- Non_Blocking_Sockets. If S is in Non_Blocking_Sockets, it has
53 -- been set in non-blocking mode by the user.
55 Quantum : constant Duration := 0.2;
56 -- When SOSC.Thread_Blocking_IO is False, we set sockets in
57 -- non-blocking mode and we spend a period of time Quantum between
58 -- two attempts on a blocking operation.
60 -----------------------
61 -- Local Subprograms --
62 -----------------------
64 -- All these require comments ???
66 function Syscall_Accept
68 Addr : System.Address;
69 Addrlen : not null access C.int) return C.int;
70 pragma Import (C, Syscall_Accept, "accept");
72 function Syscall_Connect
74 Name : System.Address;
75 Namelen : C.int) return C.int;
76 pragma Import (C, Syscall_Connect, "connect");
82 Flags : C.int) return C.int;
83 pragma Import (C, Syscall_Recv, "recv");
85 function Syscall_Recvfrom
90 From : System.Address;
91 Fromlen : not null access C.int) return C.int;
92 pragma Import (C, Syscall_Recvfrom, "recvfrom");
94 function Syscall_Recvmsg
97 Flags : C.int) return C.int;
98 pragma Import (C, Syscall_Recvmsg, "recvmsg");
100 function Syscall_Sendmsg
102 Msg : System.Address;
103 Flags : C.int) return C.int;
104 pragma Import (C, Syscall_Sendmsg, "sendmsg");
106 function Syscall_Send
108 Msg : System.Address;
110 Flags : C.int) return C.int;
111 pragma Import (C, Syscall_Send, "send");
113 function Syscall_Sendto
115 Msg : System.Address;
119 Tolen : C.int) return C.int;
120 pragma Import (C, Syscall_Sendto, "sendto");
122 function Syscall_Socket
125 Protocol : C.int) return C.int;
126 pragma Import (C, Syscall_Socket, "socket");
128 function Non_Blocking_Socket (S : C.int) return Boolean;
129 procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
137 Addr : System.Address;
138 Addrlen : not null access C.int) return C.int
141 Val : aliased C.int := 1;
144 pragma Unreferenced (Res);
148 R := Syscall_Accept (S, Addr, Addrlen);
149 exit when SOSC.Thread_Blocking_IO
151 or else Non_Blocking_Socket (S)
152 or else Errno /= SOSC.EWOULDBLOCK;
156 if not SOSC.Thread_Blocking_IO
157 and then R /= Failure
159 -- A socket inherits the properties of its server especially
160 -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
161 -- tracks sockets set in non-blocking mode by user.
163 Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
164 Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
165 -- Is it OK to ignore result ???
177 Name : System.Address;
178 Namelen : C.int) return C.int
183 Res := Syscall_Connect (S, Name, Namelen);
185 if SOSC.Thread_Blocking_IO
186 or else Res /= Failure
187 or else Non_Blocking_Socket (S)
188 or else Errno /= SOSC.EINPROGRESS
194 WSet : aliased Fd_Set;
195 Now : aliased Timeval;
197 Reset_Socket_Set (WSet'Access);
199 Insert_Socket_In_Set (WSet'Access, S);
206 Now'Unchecked_Access);
210 if Res = Failure then
218 Res := Syscall_Connect (S, Name, Namelen);
221 and then Errno = SOSC.EISCONN
223 return Thin_Common.Success;
233 function Socket_Ioctl
235 Req : SOSC.IOCTL_Req_T;
236 Arg : access C.int) return C.int
239 if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
241 Set_Non_Blocking_Socket (S, True);
245 return C_Ioctl (S, Req, Arg);
254 Msg : System.Address;
256 Flags : C.int) return C.int
262 Res := Syscall_Recv (S, Msg, Len, Flags);
263 exit when SOSC.Thread_Blocking_IO
264 or else Res /= Failure
265 or else Non_Blocking_Socket (S)
266 or else Errno /= SOSC.EWOULDBLOCK;
279 Msg : System.Address;
282 From : System.Address;
283 Fromlen : not null access C.int) return C.int
289 Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
290 exit when SOSC.Thread_Blocking_IO
291 or else Res /= Failure
292 or else Non_Blocking_Socket (S)
293 or else Errno /= SOSC.EWOULDBLOCK;
306 Msg : System.Address;
307 Flags : C.int) return System.CRTL.ssize_t
313 Res := Syscall_Recvmsg (S, Msg, Flags);
314 exit when SOSC.Thread_Blocking_IO
315 or else Res /= Failure
316 or else Non_Blocking_Socket (S)
317 or else Errno /= SOSC.EWOULDBLOCK;
321 return System.CRTL.ssize_t (Res);
330 Msg : System.Address;
331 Flags : C.int) return System.CRTL.ssize_t
337 Res := Syscall_Sendmsg (S, Msg, Flags);
338 exit when SOSC.Thread_Blocking_IO
339 or else Res /= Failure
340 or else Non_Blocking_Socket (S)
341 or else Errno /= SOSC.EWOULDBLOCK;
345 return System.CRTL.ssize_t (Res);
354 Msg : System.Address;
358 Tolen : C.int) return C.int
366 if To = Null_Address then
368 -- In violation of the standard sockets API, VxWorks does not
369 -- support sendto(2) calls on connected sockets with a null
370 -- destination address, so use send(2) instead in that case.
372 Res := Syscall_Send (S, Msg, Len, Flags);
374 -- Normal case where destination address is non-null
377 Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
380 exit when SOSC.Thread_Blocking_IO
381 or else Res /= Failure
382 or else Non_Blocking_Socket (S)
383 or else Errno /= SOSC.EWOULDBLOCK;
397 Protocol : C.int) return C.int
400 Val : aliased C.int := 1;
403 pragma Unreferenced (Res);
406 R := Syscall_Socket (Domain, Typ, Protocol);
408 if not SOSC.Thread_Blocking_IO
409 and then R /= Failure
411 -- Do not use Socket_Ioctl as this subprogram tracks sockets set
412 -- in non-blocking mode by user.
414 Res := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
415 -- Is it OK to ignore result ???
416 Set_Non_Blocking_Socket (R, False);
426 procedure Finalize is
431 -------------------------
432 -- Host_Error_Messages --
433 -------------------------
435 package body Host_Error_Messages is separate;
441 procedure Initialize is
443 Reset_Socket_Set (Non_Blocking_Sockets'Access);
446 -------------------------
447 -- Non_Blocking_Socket --
448 -------------------------
450 function Non_Blocking_Socket (S : C.int) return Boolean is
454 R := (Is_Socket_In_Set (Non_Blocking_Sockets'Access, S) /= 0);
457 end Non_Blocking_Socket;
459 -----------------------------
460 -- Set_Non_Blocking_Socket --
461 -----------------------------
463 procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean) is
467 Insert_Socket_In_Set (Non_Blocking_Sockets'Access, S);
469 Remove_Socket_From_Set (Non_Blocking_Sockets'Access, S);
473 end Set_Non_Blocking_Socket;
479 package body Signalling_Fds is separate;
481 --------------------------
482 -- Socket_Error_Message --
483 --------------------------
485 function Socket_Error_Message (Errno : Integer) return String is separate;
487 end GNAT.Sockets.Thin;