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 -- Temporary version for Alpha/VMS.
36 with GNAT.OS_Lib; use GNAT.OS_Lib;
39 with Interfaces.C; use Interfaces.C;
41 package body GNAT.Sockets.Thin is
43 Non_Blocking_Sockets : constant Fd_Set_Access
44 := New_Socket_Set (No_Socket_Set);
45 -- When this package is initialized with Process_Blocking_IO set
46 -- to True, sockets are set in non-blocking mode to avoid blocking
47 -- the whole process when a thread wants to perform a blocking IO
48 -- operation. But the user can also set a socket in non-blocking
49 -- mode by purpose. In order to make a difference between these
50 -- two situations, we track the origin of non-blocking mode in
51 -- Non_Blocking_Sockets. If S is in Non_Blocking_Sockets, it has
52 -- been set in non-blocking mode by the user.
54 Quantum : constant Duration := 0.2;
55 -- When Thread_Blocking_IO is False, we set sockets in
56 -- non-blocking mode and we spend a period of time Quantum between
57 -- two attempts on a blocking operation.
59 Thread_Blocking_IO : Boolean := True;
61 function Syscall_Accept
63 Addr : System.Address;
64 Addrlen : access C.int)
66 pragma Import (C, Syscall_Accept, "accept");
68 function Syscall_Connect
70 Name : System.Address;
73 pragma Import (C, Syscall_Connect, "connect");
75 function Syscall_Ioctl
80 pragma Import (C, Syscall_Ioctl, "ioctl");
88 pragma Import (C, Syscall_Recv, "recv");
90 function Syscall_Recvfrom
95 From : Sockaddr_In_Access;
96 Fromlen : access C.int)
98 pragma Import (C, Syscall_Recvfrom, "recvfrom");
100 function Syscall_Send
102 Msg : System.Address;
106 pragma Import (C, Syscall_Send, "send");
108 function Syscall_Sendto
110 Msg : System.Address;
113 To : Sockaddr_In_Access;
116 pragma Import (C, Syscall_Sendto, "sendto");
118 function Syscall_Socket
119 (Domain, Typ, Protocol : C.int)
121 pragma Import (C, Syscall_Socket, "socket");
123 function Non_Blocking_Socket (S : C.int) return Boolean;
124 procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean);
132 Addr : System.Address;
133 Addrlen : access C.int)
137 Val : aliased C.int := 1;
140 pragma Warnings (Off, Discard);
144 R := Syscall_Accept (S, Addr, Addrlen);
145 exit when Thread_Blocking_IO
147 or else Non_Blocking_Socket (S)
148 or else Errno /= Constants.EWOULDBLOCK;
152 if not Thread_Blocking_IO
153 and then R /= Failure
155 -- A socket inherits the properties ot its server especially
156 -- the FIONBIO flag. Do not use C_Ioctl as this subprogram
157 -- tracks sockets set in non-blocking mode by user.
159 Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
160 Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
172 Name : System.Address;
179 Res := Syscall_Connect (S, Name, Namelen);
181 if Thread_Blocking_IO
182 or else Res /= Failure
183 or else Non_Blocking_Socket (S)
184 or else Errno /= Constants.EINPROGRESS
190 WSet : Fd_Set_Access;
191 Now : aliased Timeval;
194 WSet := New_Socket_Set (No_Socket_Set);
196 Insert_Socket_In_Set (WSet, S);
203 Now'Unchecked_Access);
207 if Res = Failure then
208 Free_Socket_Set (WSet);
215 Free_Socket_Set (WSet);
218 Res := Syscall_Connect (S, Name, Namelen);
221 and then Errno = Constants.EISCONN
240 if not Thread_Blocking_IO
241 and then Req = Constants.FIONBIO
244 Set_Non_Blocking_Socket (S, True);
248 return Syscall_Ioctl (S, Req, Arg);
257 Msg : System.Address;
266 Res := Syscall_Recv (S, Msg, Len, Flags);
267 exit when Thread_Blocking_IO
268 or else Res /= Failure
269 or else Non_Blocking_Socket (S)
270 or else Errno /= Constants.EWOULDBLOCK;
283 Msg : System.Address;
286 From : Sockaddr_In_Access;
287 Fromlen : access C.int)
294 Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
295 exit when Thread_Blocking_IO
296 or else Res /= Failure
297 or else Non_Blocking_Socket (S)
298 or else Errno /= Constants.EWOULDBLOCK;
311 Msg : System.Address;
320 Res := Syscall_Send (S, Msg, Len, Flags);
321 exit when Thread_Blocking_IO
322 or else Res /= Failure
323 or else Non_Blocking_Socket (S)
324 or else Errno /= Constants.EWOULDBLOCK;
337 Msg : System.Address;
340 To : Sockaddr_In_Access;
348 Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
349 exit when Thread_Blocking_IO
350 or else Res /= Failure
351 or else Non_Blocking_Socket (S)
352 or else Errno /= Constants.EWOULDBLOCK;
370 Val : aliased C.int := 1;
373 pragma Unreferenced (Discard);
376 R := Syscall_Socket (Domain, Typ, Protocol);
378 if not Thread_Blocking_IO
379 and then R /= Failure
381 -- Do not use C_Ioctl as this subprogram tracks sockets set
382 -- in non-blocking mode by user.
384 Discard := Syscall_Ioctl (R, Constants.FIONBIO, Val'Unchecked_Access);
385 Set_Non_Blocking_Socket (R, False);
395 procedure Finalize is
404 procedure Initialize (Process_Blocking_IO : Boolean) is
406 Thread_Blocking_IO := not Process_Blocking_IO;
409 -------------------------
410 -- Non_Blocking_Socket --
411 -------------------------
413 function Non_Blocking_Socket (S : C.int) return Boolean is
418 R := Is_Socket_In_Set (Non_Blocking_Sockets, S);
421 end Non_Blocking_Socket;
427 procedure Set_Address
428 (Sin : Sockaddr_In_Access;
432 Sin.Sin_Addr := Address;
440 (Sin : Sockaddr_In_Access;
444 Sin.Sin_Family := C.unsigned_short (Family);
452 (Sin : Sockaddr_In_Access;
455 pragma Unreferenced (Sin);
456 pragma Unreferenced (Len);
462 -----------------------------
463 -- Set_Non_Blocking_Socket --
464 -----------------------------
466 procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean) is
471 Insert_Socket_In_Set (Non_Blocking_Sockets, S);
473 Remove_Socket_From_Set (Non_Blocking_Sockets, S);
477 end Set_Non_Blocking_Socket;
484 (Sin : Sockaddr_In_Access;
485 Port : C.unsigned_short)
488 Sin.Sin_Port := Port;
491 --------------------------
492 -- Socket_Error_Message --
493 --------------------------
495 function Socket_Error_Message (Errno : Integer) return String is
496 use type Interfaces.C.Strings.chars_ptr;
498 C_Msg : C.Strings.chars_ptr;
501 C_Msg := C_Strerror (C.int (Errno));
503 if C_Msg = C.Strings.Null_Ptr then
504 return "Unknown system error";
507 return C.Strings.Value (C_Msg);
509 end Socket_Error_Message;
517 Iov : System.Address;
524 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
525 for Iovec'Address use Iov;
526 pragma Import (Ada, Iovec);
529 for J in Iovec'Range loop
532 Iovec (J).Base.all'Address,
533 Interfaces.C.int (Iovec (J).Length));
538 Count := Count + Res;
550 Iov : System.Address;
557 Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
558 for Iovec'Address use Iov;
559 pragma Import (Ada, Iovec);
562 for J in Iovec'Range loop
565 Iovec (J).Base.all'Address,
566 Interfaces.C.int (Iovec (J).Length));
571 Count := Count + Res;
577 end GNAT.Sockets.Thin;