-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2008, AdaCore --
+-- Copyright (C) 2001-2009, AdaCore --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
package body GNAT.Sockets.Thin is
+ type VMS_Msghdr is new Msghdr;
+ pragma Pack (VMS_Msghdr);
+ -- On VMS (unlike other platforms), struct msghdr is packed, so a specific
+ -- derived type is required.
+
Non_Blocking_Sockets : aliased Fd_Set;
-- When this package is initialized with Process_Blocking_IO set to True,
-- sockets are set in non-blocking mode to avoid blocking the whole process
-- when a thread wants to perform a blocking IO operation. But the user can
-- also set a socket in non-blocking mode by purpose. In order to make a
-- difference between these two situations, we track the origin of
- -- non-blocking mode in Non_Blocking_Sockets. If S is in
+ -- non-blocking mode in Non_Blocking_Sockets. Note that if S is in
-- Non_Blocking_Sockets, it has been set in non-blocking mode by the user.
Quantum : constant Duration := 0.2;
Namelen : C.int) return C.int;
pragma Import (C, Syscall_Connect, "connect");
- function Syscall_Ioctl
- (S : C.int;
- Req : C.int;
- Arg : access C.int) return C.int;
- pragma Import (C, Syscall_Ioctl, "ioctl");
-
function Syscall_Recv
(S : C.int;
Msg : System.Address;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int;
pragma Import (C, Syscall_Recvfrom, "recvfrom");
+ function Syscall_Recvmsg
+ (S : C.int;
+ Msg : System.Address;
+ Flags : C.int) return C.int;
+ pragma Import (C, Syscall_Recvmsg, "recvmsg");
+
+ function Syscall_Sendmsg
+ (S : C.int;
+ Msg : System.Address;
+ Flags : C.int) return C.int;
+ pragma Import (C, Syscall_Sendmsg, "sendmsg");
+
function Syscall_Sendto
(S : C.int;
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int;
pragma Import (C, Syscall_Sendto, "sendto");
and then R /= Failure
then
-- A socket inherits the properties of its server, especially
- -- the FIONBIO flag. Do not use C_Ioctl as this subprogram
+ -- the FIONBIO flag. Do not use Socket_Ioctl as this subprogram
-- tracks sockets set in non-blocking mode by user.
Set_Non_Blocking_Socket (R, Non_Blocking_Socket (S));
- Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
+ Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
end if;
return R;
if Res = Failure and then Errno = SOSC.EISCONN then
return Thin_Common.Success;
-
else
return Res;
end if;
end C_Connect;
- -------------
- -- C_Ioctl --
- -------------
+ ------------------
+ -- Socket_Ioctl --
+ ------------------
- function C_Ioctl
+ function Socket_Ioctl
(S : C.int;
Req : C.int;
Arg : access C.int) return C.int
is
begin
- if not SOSC.Thread_Blocking_IO
- and then Req = SOSC.FIONBIO
- then
+ if not SOSC.Thread_Blocking_IO and then Req = SOSC.FIONBIO then
if Arg.all /= 0 then
Set_Non_Blocking_Socket (S, True);
end if;
end if;
- return Syscall_Ioctl (S, Req, Arg);
- end C_Ioctl;
+ return C_Ioctl (S, Req, Arg);
+ end Socket_Ioctl;
------------
-- C_Recv --
Msg : System.Address;
Len : C.int;
Flags : C.int;
- From : Sockaddr_In_Access;
+ From : System.Address;
Fromlen : not null access C.int) return C.int
is
Res : C.int;
return Res;
end C_Recvfrom;
+ ---------------
+ -- C_Recvmsg --
+ ---------------
+
+ function C_Recvmsg
+ (S : C.int;
+ Msg : System.Address;
+ Flags : C.int) return ssize_t
+ is
+ Res : C.int;
+
+ GNAT_Msg : Msghdr;
+ for GNAT_Msg'Address use Msg;
+ pragma Import (Ada, GNAT_Msg);
+
+ VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
+
+ begin
+ loop
+ Res := Syscall_Recvmsg (S, VMS_Msg'Address, Flags);
+ exit when SOSC.Thread_Blocking_IO
+ or else Res /= Failure
+ or else Non_Blocking_Socket (S)
+ or else Errno /= SOSC.EWOULDBLOCK;
+ delay Quantum;
+ end loop;
+
+ GNAT_Msg := Msghdr (VMS_Msg);
+
+ return ssize_t (Res);
+ end C_Recvmsg;
+
+ ---------------
+ -- C_Sendmsg --
+ ---------------
+
+ function C_Sendmsg
+ (S : C.int;
+ Msg : System.Address;
+ Flags : C.int) return ssize_t
+ is
+ Res : C.int;
+
+ GNAT_Msg : Msghdr;
+ for GNAT_Msg'Address use Msg;
+ pragma Import (Ada, GNAT_Msg);
+
+ VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
+
+ begin
+ loop
+ Res := Syscall_Sendmsg (S, VMS_Msg'Address, Flags);
+ exit when SOSC.Thread_Blocking_IO
+ or else Res /= Failure
+ or else Non_Blocking_Socket (S)
+ or else Errno /= SOSC.EWOULDBLOCK;
+ delay Quantum;
+ end loop;
+
+ GNAT_Msg := Msghdr (VMS_Msg);
+
+ return ssize_t (Res);
+ end C_Sendmsg;
+
--------------
-- C_Sendto --
--------------
Msg : System.Address;
Len : C.int;
Flags : C.int;
- To : Sockaddr_In_Access;
+ To : System.Address;
Tolen : C.int) return C.int
is
Res : C.int;
if not SOSC.Thread_Blocking_IO
and then R /= Failure
then
- -- Do not use C_Ioctl as this subprogram tracks sockets set
+ -- Do not use Socket_Ioctl as this subprogram tracks sockets set
-- in non-blocking mode by user.
- Discard := Syscall_Ioctl (R, SOSC.FIONBIO, Val'Access);
+ Discard := C_Ioctl (R, SOSC.FIONBIO, Val'Access);
Set_Non_Blocking_Socket (R, False);
end if;
end if;
end Socket_Error_Message;
- -------------
- -- C_Readv --
- -------------
-
- function C_Readv
- (Fd : C.int;
- Iov : System.Address;
- Iovcnt : C.int) return C.int
- is
- Res : C.int;
- Count : C.int := 0;
-
- Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
- for Iovec'Address use Iov;
- pragma Import (Ada, Iovec);
-
- begin
- for J in Iovec'Range loop
- Res := C_Recv
- (Fd,
- Iovec (J).Base.all'Address,
- Interfaces.C.int (Iovec (J).Length),
- 0);
-
- if Res < 0 then
- return Res;
- else
- Count := Count + Res;
- end if;
- end loop;
- return Count;
- end C_Readv;
-
- --------------
- -- C_Writev --
- --------------
-
- function C_Writev
- (Fd : C.int;
- Iov : System.Address;
- Iovcnt : C.int) return C.int
- is
- Res : C.int;
- Count : C.int := 0;
-
- Iovec : array (0 .. Iovcnt - 1) of Vector_Element;
- for Iovec'Address use Iov;
- pragma Import (Ada, Iovec);
-
- begin
- for J in Iovec'Range loop
- Res := C_Sendto
- (Fd,
- Iovec (J).Base.all'Address,
- Interfaces.C.int (Iovec (J).Length),
- SOSC.MSG_Forced_Flags,
- To => null,
- Tolen => 0);
-
- if Res < 0 then
- return Res;
- else
- Count := Count + Res;
- end if;
- end loop;
- return Count;
- end C_Writev;
-
end GNAT.Sockets.Thin;
OSDN Git Service
