CAMLprim value unix_dup(value fd)
{
HANDLE newh;
value newfd;
int kind = Descr_kind_val(fd);
if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd),
GetCurrentProcess(), &newh,
0L, TRUE, DUPLICATE_SAME_ACCESS)) {
win32_maperr(GetLastError());
return -1;
}
newfd = win_alloc_handle(newh);
Descr_kind_val(newfd) = kind;
return newfd;
}
CAMLprim value lwt_unix_read(value fd, value buf, value vofs, value vlen)
{
intnat ofs, len, written;
DWORD numbytes, numwritten;
DWORD err = 0;
Begin_root (buf);
ofs = Long_val(vofs);
len = Long_val(vlen);
written = 0;
if (len > 0) {
numbytes = len;
if (Descr_kind_val(fd) == KIND_SOCKET) {
int ret;
SOCKET s = Socket_val(fd);
ret = recv(s, &Byte(buf, ofs), numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
numwritten = ret;
} else {
HANDLE h = Handle_val(fd);
if (! ReadFile(h, &Byte(buf, ofs), numbytes, &numwritten, NULL))
err = GetLastError();
}
if (err) {
win32_maperr(err);
uerror("write", Nothing);
}
written = numwritten;
}
End_roots();
return Val_long(written);
}
static HANDLE handle_of_descr(value x)
{
if(Descr_kind_val(x) != KIND_HANDLE){
failwith("mlterminal(the channel is not a file handle)");
}
return Handle_val(x);
}
CAMLprim value unix_read(value fd, value buf, value ofs, value vlen)
{
intnat len;
DWORD numbytes, numread;
char iobuf[UNIX_BUFFER_SIZE];
DWORD err = 0;
Begin_root (buf);
len = Long_val(vlen);
numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
if (Descr_kind_val(fd) == KIND_SOCKET) {
int ret;
SOCKET s = Socket_val(fd);
enter_blocking_section();
ret = recv(s, iobuf, numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
leave_blocking_section();
numread = ret;
} else {
HANDLE h = Handle_val(fd);
enter_blocking_section();
if (! ReadFile(h, iobuf, numbytes, &numread, NULL))
err = GetLastError();
leave_blocking_section();
}
if (err) {
win32_maperr(err);
uerror("read", Nothing);
}
memmove (&Byte(buf, Long_val(ofs)), iobuf, numread);
End_roots();
return Val_int(numread);
}
value win_alloc_socket(SOCKET s)
{
value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
Socket_val(res) = s;
Descr_kind_val(res) = KIND_SOCKET;
CRT_fd_val(res) = NO_CRT_FD;
return res;
}
value win_alloc_handle(HANDLE h)
{
value res = alloc_custom(&win_handle_ops, sizeof(struct filedescr), 0, 1);
Handle_val(res) = h;
Descr_kind_val(res) = KIND_HANDLE;
CRT_fd_val(res) = NO_CRT_FD;
return res;
}
static value alloc_fd(HANDLE handle)
{
value res = win_alloc_handle(handle);
int opt;
int optlen = sizeof(opt);
if (getsockopt((SOCKET)handle, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
Descr_kind_val(res) = KIND_SOCKET;
return res;
}
/* PR#4750: this function is no longer used */
value win_alloc_handle_or_socket(HANDLE h)
{
value res = win_alloc_handle(h);
int opt;
int optlen = sizeof(opt);
if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&opt, &optlen) == 0)
Descr_kind_val(res) = KIND_SOCKET;
return res;
}
CAMLprim value iocp_ml_read(value fd, value vlen)
{
CAMLparam2(fd, vlen);
CAMLlocal1(res);
intnat len = Long_val(vlen);
SOCKET s = Socket_val(fd);
assert(Descr_kind_val(fd) == KIND_SOCKET);
res = Val_int(async_read(s, len));
CAMLreturn(res);
}
CAMLprim value win_inchannel_of_filedescr(value handle)
{
CAMLparam1(handle);
CAMLlocal1(vchan);
struct channel * chan;
chan = caml_open_descriptor_in(win_CRT_fd_of_filedescr(handle));
if (Descr_kind_val(handle) == KIND_SOCKET)
chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
vchan = caml_alloc_channel(chan);
CAMLreturn(vchan);
}
CAMLprim value unix_dup2(value fd1, value fd2)
{
HANDLE oldh, newh;
oldh = Handle_val(fd2);
if (! DuplicateHandle(GetCurrentProcess(), Handle_val(fd1),
GetCurrentProcess(), &newh,
0L, TRUE, DUPLICATE_SAME_ACCESS)) {
win32_maperr(GetLastError());
return -1;
}
Handle_val(fd2) = newh;
if (Descr_kind_val(fd2) == KIND_SOCKET)
closesocket((SOCKET) oldh);
else
CloseHandle(oldh);
Descr_kind_val(fd2) = Descr_kind_val(fd1);
/* Reflect the dup2 on the CRT fds, if any */
if (CRT_fd_val(fd1) != NO_CRT_FD || CRT_fd_val(fd2) != NO_CRT_FD)
_dup2(win_CRT_fd_of_filedescr(fd1), win_CRT_fd_of_filedescr(fd2));
return Val_unit;
}
CAMLprim value netsys_int64_of_file_descr(value fd) {
#ifdef _WIN32
switch (Descr_kind_val(fd)) {
case KIND_HANDLE:
return copy_int64((intnat) (Handle_val(fd)));
case KIND_SOCKET:
return copy_int64((intnat) (Socket_val(fd)));
}
return copy_int64(0);
#else
return copy_int64(Long_val(fd));
#endif
}
CAMLprim value iocp_ml_write(value fd, value vbuf, value vlen)
{
CAMLparam3(fd, vbuf, vlen);
CAMLlocal1(res);
intnat len = Long_val(vlen);
SOCKET s = Socket_val(fd);
char *buf = String_val(vbuf);
assert(Descr_kind_val(fd) == KIND_SOCKET);
res = Val_int(async_write(s, buf, len));
CAMLreturn(res);
/* async_write(s, buf, len); */
/* return Val_unit; */
}
/* Convert fdlist to an fd_set if all the handles in fdlist are sockets and return 0.
* Returns 1 if a non-socket value is encountered.
*/
static int fdlist_to_fdset(value fdlist, fd_set *fdset)
{
value l, c;
FD_ZERO(fdset);
for (l = fdlist; l != Val_int(0); l = Field(l, 1)) {
c = Field(l, 0);
if (Descr_kind_val(c) == KIND_SOCKET) {
FD_SET(Socket_val(c), fdset);
} else {
DEBUG_PRINT("Non socket value encountered");
return 0;
}
}
return 1;
}
CAMLprim value unix_close(value fd)
{
if (Descr_kind_val(fd) == KIND_SOCKET) {
if (closesocket(Socket_val(fd)) != 0) {
win32_maperr(WSAGetLastError());
uerror("close", Nothing);
}
} else {
if (! CloseHandle(Handle_val(fd))) {
win32_maperr(GetLastError());
uerror("close", Nothing);
}
}
return Val_unit;
}
static value do_fstat(value handle, int use_64)
{
int ret;
struct _stat64 buf;
__int64 st_ino;
HANDLE h;
DWORD ft;
st_ino = 0;
memset(&buf, 0, sizeof buf);
buf.st_nlink = 1;
h = Handle_val(handle);
ft = GetFileType(h) & ~FILE_TYPE_REMOTE;
switch(ft) {
case FILE_TYPE_DISK:
if (!safe_do_stat(0, use_64, NULL, Handle_val(handle), &st_ino, &buf)) {
uerror("fstat", Nothing);
}
break;
case FILE_TYPE_CHAR:
buf.st_mode = S_IFCHR;
break;
case FILE_TYPE_PIPE:
{
DWORD n_avail;
if (Descr_kind_val(handle) == KIND_SOCKET) {
buf.st_mode = S_IFSOCK;
}
else {
buf.st_mode = S_IFIFO;
}
if (PeekNamedPipe(h, NULL, 0, NULL, &n_avail, NULL)) {
buf.st_size = n_avail;
}
}
break;
case FILE_TYPE_UNKNOWN:
unix_error(EBADF, "fstat", Nothing);
default:
win32_maperr(GetLastError());
uerror("fstat", Nothing);
}
return stat_aux(use_64, st_ino, &buf);
}
/* Guess handle type */
static SELECTHANDLETYPE get_handle_type(value fd)
{
DWORD mode;
SELECTHANDLETYPE res;
CAMLparam1(fd);
mode = 0;
res = SELECT_HANDLE_NONE;
if (Descr_kind_val(fd) == KIND_SOCKET)
{
res = SELECT_HANDLE_SOCKET;
}
else
{
switch(GetFileType(Handle_val(fd)))
{
case FILE_TYPE_DISK:
res = SELECT_HANDLE_DISK;
break;
case FILE_TYPE_CHAR: /* character file or a console */
if (GetConsoleMode(Handle_val(fd), &mode) != 0)
{
res = SELECT_HANDLE_CONSOLE;
}
else
{
res = SELECT_HANDLE_NONE;
};
break;
case FILE_TYPE_PIPE: /* a named or an anonymous pipe (socket already handled) */
res = SELECT_HANDLE_PIPE;
break;
};
};
CAMLreturnT(SELECTHANDLETYPE, res);
}
CAMLprim value unix_write(value fd, value buf, value vofs, value vlen)
{
intnat ofs, len, written;
DWORD numbytes, numwritten;
char iobuf[UNIX_BUFFER_SIZE];
DWORD err = 0;
Begin_root (buf);
ofs = Long_val(vofs);
len = Long_val(vlen);
written = 0;
while (len > 0) {
numbytes = len > UNIX_BUFFER_SIZE ? UNIX_BUFFER_SIZE : len;
memmove (iobuf, &Byte(buf, ofs), numbytes);
if (Descr_kind_val(fd) == KIND_SOCKET) {
int ret;
SOCKET s = Socket_val(fd);
enter_blocking_section();
ret = send(s, iobuf, numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
leave_blocking_section();
numwritten = ret;
} else {
HANDLE h = Handle_val(fd);
enter_blocking_section();
if (! WriteFile(h, iobuf, numbytes, &numwritten, NULL))
err = GetLastError();
leave_blocking_section();
}
if (err) {
win32_maperr(err);
uerror("write", Nothing);
}
written += numwritten;
ofs += numwritten;
len -= numwritten;
}
End_roots();
return Val_long(written);
}
CAMLprim value netsys_mem_write(value fdv, value memv, value offv, value lenv)
{
intnat numbytes;
intnat ret;
char *data;
#ifdef _WIN32
DWORD n;
DWORD err = 0;
#endif
numbytes = Long_val(lenv);
data = ((char *) (Bigarray_val(memv)->data)) + Long_val(offv);
#ifdef _WIN32
if (Descr_kind_val(fdv) == KIND_SOCKET) {
SOCKET h = Socket_val(fdv);
enter_blocking_section();
ret = send(h, data, numbytes, 0);
if (ret == SOCKET_ERROR) err = WSAGetLastError();
leave_blocking_section();
ret = n;
} else {
HANDLE h = Handle_val(fdv);
enter_blocking_section();
if (! WriteFile(h, data, numbytes, &n, NULL)) err = GetLastError();
leave_blocking_section();
ret = n;
}
if (err) {
win32_maperr(err);
ret = -1;
}
#else
enter_blocking_section();
ret = write(Int_val(fdv), data, (int) numbytes);
leave_blocking_section();
#endif
if (ret == -1) uerror("mem_write", Nothing);
return Val_long(ret);
}
CAMLprim value lwt_unix_is_socket(value fd)
{
return (Val_bool(Descr_kind_val(fd) == KIND_SOCKET));
}