// Copy file times CAMLprim value copy_file_times(value in_h_val, value out_h_val) { CAMLparam2(in_h_val, out_h_val); int good; #if defined(WIN32) HANDLE in_h = Handle_val(in_h_val); HANDLE out_h = Handle_val(out_h_val); FILETIME create; FILETIME access; FILETIME modify; good = GetFileTime(in_h, &create, &access, &modify); if(good) { good = SetFileTime(out_h, &create, &access, &modify); } #else int in_h = Int_val(in_h_val); int out_h = Int_val(out_h_val); struct stat s; struct timeval set[2]; good = !fstat(in_h, &s); if(good) { set[0].tv_sec = s.st_atime; set[0].tv_usec = 0; set[1].tv_sec = s.st_mtime; set[1].tv_usec = 0; good = !futimes(out_h, set); } #endif CAMLreturn(Val_bool(good)); }
/*#include <stdio.h>*/ CAMLprim value caml_dynlink_lookup_symbol(value handle, value symbolname) { void * symb; value result; symb = caml_dlsym(Handle_val(handle), String_val(symbolname)); /* printf("%s = 0x%lx\n", String_val(symbolname), symb); fflush(stdout); */ if (symb == NULL) return Val_unit /*caml_failwith(caml_dlerror())*/; result = caml_alloc_small(1, Abstract_tag); Handle_val(result) = symb; return result; }
CAMLprim value w_create_process_native (value prog, value wprog, value wargs, value fd1, value fd2, value fd3) { int res, flags; PROCESS_INFORMATION pi; STARTUPINFOW si; wchar_t fullname [MAX_PATH]; HANDLE h; CAMLparam5(wprog, wargs, fd1, fd2, fd3); res = SearchPathW (NULL, (LPCWSTR) String_val(wprog), L".exe", MAX_PATH, fullname, NULL); if (res == 0) { win32_maperr (GetLastError ()); uerror("create_process", prog); } ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = Handle_val(fd1); si.hStdOutput = Handle_val(fd2); si.hStdError = Handle_val(fd3); flags = GetPriorityClass (GetCurrentProcess ()); /* h = CreateFile ("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); if (h != INVALID_HANDLE_VALUE) CloseHandle (h); else { flags |= CREATE_NEW_CONSOLE; // si.dwFlags |= STARTF_USESHOWWINDOW; // si.wShowWindow = SW_MINIMIZE; } */ res = CreateProcessW (fullname, (LPWSTR) String_val(wargs), NULL, NULL, TRUE, flags, NULL, NULL, &si, &pi); if (res == 0) { win32_maperr (GetLastError ()); uerror("create_process", prog); } CloseHandle (pi.hThread); CAMLreturn (Val_long (pi.hProcess)); }
int win_set_inherit(value fd, BOOL inherit) { HANDLE oldh, newh; oldh = Handle_val(fd); if (! DuplicateHandle(GetCurrentProcess(), oldh, GetCurrentProcess(), &newh, 0L, inherit, DUPLICATE_SAME_ACCESS)) { win32_maperr(GetLastError()); return -1; } Handle_val(fd) = newh; CloseHandle(oldh); return 0; }
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 onlyWin32_create_process_chdir_native(value cmd, value cmdline, value env, value fd1, value fd2, value fd3, value maybe_chdir) { PROCESS_INFORMATION pi; STARTUPINFO si; char * exefile, * envp; int flags; LPCTSTR lpCurrentDirectory = NULL; exefile = search_exe_in_path(String_val(cmd)); if (env != Val_int(0)) { envp = String_val(Field(env, 0)); } else { envp = NULL; } /* Prepare stdin/stdout/stderr redirection */ ZeroMemory(&si, sizeof(STARTUPINFO)); si.cb = sizeof(STARTUPINFO); si.dwFlags = STARTF_USESTDHANDLES; si.hStdInput = Handle_val(fd1); si.hStdOutput = Handle_val(fd2); si.hStdError = Handle_val(fd3); /* If we do not have a console window, then we must create one before running the process (keep it hidden for apparence). If we are starting a GUI application, the newly created console should not matter. */ if (onlyWin32_has_console()) flags = 0; else { flags = CREATE_NEW_CONSOLE; si.dwFlags = (STARTF_USESHOWWINDOW | STARTF_USESTDHANDLES); si.wShowWindow = SW_HIDE; } if( maybe_chdir != Val_int(0) ){ lpCurrentDirectory = String_val(Field(maybe_chdir,0)); } /* Create the process */ if (! CreateProcess(NULL, String_val(cmdline), NULL, NULL, TRUE, flags, envp, lpCurrentDirectory, &si, &pi)) { win32_maperr(GetLastError()); uerror("create_process", cmd); } CloseHandle(pi.hThread); /* Return the process handle as pseudo-PID (this is consistent with the wait() emulation in the MSVC C library */ return Val_long(pi.hProcess); }
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; }
CAMLprim value win_findclose(value valh) { if (! FindClose(Handle_val(valh))) { win32_maperr(GetLastError()); uerror("closedir", Nothing); } return Val_unit; }
CAMLprim value unix_lseek_64(value fd, value ofs, value cmd) { __int64 ret; ret = caml_set_file_pointer(Handle_val(fd), Int64_val(ofs), seek_command_table[Int_val(cmd)]); return copy_int64(ret); }
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); }
CAMLprim value win_findclosew(value valh) { CAMLparam1(valh); if (! FindClose(Handle_val(valh))) { win32_maperr(GetLastError()); uerror("closedir", Nothing); } CAMLreturn (Val_unit); }
int win_CRT_fd_of_filedescr(value handle) { if (CRT_fd_val(handle) != NO_CRT_FD) { return CRT_fd_val(handle); } else { int fd = _open_osfhandle((long) Handle_val(handle), O_BINARY); if (fd == -1) uerror("channel_of_descr", Nothing); return fd; } }
CAMLprim value unix_fstat_64(value handle) { int ret; struct _stat64 buf; __int64 st_ino; if (!do_stat(0, 1, NULL, 0, Handle_val(handle), &st_ino, &buf)) { uerror("fstat", Nothing); } return stat_aux(1, 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); }
static Tcl_Channel tcl_channel(value fd, int flags) { HANDLE h = Handle_val(fd); int optval, optsize; optsize = sizeof(optval); if (getsockopt((SOCKET) h, SOL_SOCKET, SO_TYPE, (char *)&optval, &optsize) == 0) return Tcl_MakeTcpClientChannel((ClientData) h); else return Tcl_MakeFileChannel((ClientData) h, flags); }
CAMLprim value unix_lseek(value fd, value ofs, value cmd) { __int64 ret; ret = caml_set_file_pointer(Handle_val(fd), Long_val(ofs), seek_command_table[Int_val(cmd)]); if (ret > Max_long) { win32_maperr(ERROR_ARITHMETIC_OVERFLOW); uerror("lseek", Nothing); } return Val_long(ret); }
int win_set_inherit(value fd, BOOL inherit) { /* According to the MSDN, SetHandleInformation may not work for console handles on WinNT4 and earlier versions. */ if (! SetHandleInformation(Handle_val(fd), HANDLE_FLAG_INHERIT, inherit ? HANDLE_FLAG_INHERIT : 0)) { win32_maperr(GetLastError()); return -1; } return 0; }
CAMLprim value caml_dynlink_open_lib(value mode, value filename) { void * handle; value result; caml_gc_message(0x100, "Opening shared library %s\n", (uintnat) String_val(filename)); handle = caml_dlopen(String_val(filename), Int_val(mode), 1); if (handle == NULL) caml_failwith(caml_dlerror()); result = caml_alloc_small(1, Abstract_tag); Handle_val(result) = handle; return result; }
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 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 caml_dynlink_get_current_libs(value unit) { CAMLparam0(); CAMLlocal1(res); int i; res = caml_alloc_tuple(shared_libs.size); for (i = 0; i < shared_libs.size; i++) { value v = caml_alloc_small(1, Abstract_tag); Handle_val(v) = shared_libs.contents[i]; Store_field(res, i, v); } CAMLreturn(res); }
CAMLprim value uwt_udp_send_queue_count_na(value o_udp) { value ret; struct handle * h = Handle_val(o_udp); if ( HANDLE_IS_INVALID_UNINIT(h) ){ ret = Val_long(0); } else { uv_udp_t* u = (uv_udp_t*)h->handle; ret = Val_long((intnat)u->send_queue_count); } return ret; }
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; }
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_text_term_size(value fd) { HANDLE handle; CONSOLE_SCREEN_BUFFER_INFO info; if (!GetConsoleScreenBufferInfo(Handle_val(fd), &info)) { win32_maperr(GetLastError()); uerror("GetConsoleScreenBufferInfo", Nothing); } value result = caml_alloc_tuple(2); Field(result, 0) = Val_int(info.dwSize.X); Field(result, 1) = Val_int(info.dwSize.Y); return result; }
// Make a function to see if a thread is still alive // *nix uses pthread_kill(pthread_t thread, 0), Windows uses GetExitCodeThread(HANDLE hThread, &exit_code) CAMLprim value thread_is_alive(value thread_id_val) { CAMLparam1(thread_id_val); int still_alive; #if defined(WIN32) HANDLE thread_id = Handle_val(thread_id_val); DWORD exit_code; if(GetExitCodeThread(thread_id, &exit_code)) { still_alive = (exit_code == STILL_ACTIVE); } else { caml_failwith("Can't get status of thread"); } #else int thread_id = Int_val(thread_id_val); #endif CAMLreturn(Val_bool(still_alive)); }
CAMLprim value win_findnext(value valh) { WIN32_FIND_DATA fileinfo; BOOL retcode; retcode = FindNextFile(Handle_val(valh), &fileinfo); if (!retcode) { DWORD err = GetLastError(); if (err == ERROR_NO_MORE_FILES) raise_end_of_file(); else { win32_maperr(err); uerror("readdir", Nothing); } } return copy_string(fileinfo.cFileName); }
CAMLprim value caml_dynlink_open_lib(value mode, value filename) { void * handle; value result; char * p; caml_gc_log("Opening shared library %s", String_val(filename)); p = caml_strdup(String_val(filename)); caml_enter_blocking_section(); handle = caml_dlopen(p, Int_val(mode), 1); caml_leave_blocking_section(); caml_stat_free(p); if (handle == NULL) caml_failwith(caml_dlerror()); result = caml_alloc_small(1, Abstract_tag); Handle_val(result) = handle; return result; }