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)); }