CAMLprim value get_os_thread_self_id() {
CAMLparam0();
CAMLlocal1(out_val);
#if defined(WIN32)
BOOL ret;
HANDLE dup_handle;
ret = DuplicateHandle(
GetCurrentProcess(),
GetCurrentThread(),
GetCurrentProcess(),
&dup_handle,
0,
FALSE,
DUPLICATE_SAME_ACCESS
);
if(!ret) {
caml_failwith("Can't get handle to current thread");
} else {
// printf("HANDLE IS %p\n", (int)dup_handle);
out_val = win_alloc_handle(dup_handle);
}
#else
out_val = Val_int(pthread_self());
#endif
CAMLreturn(out_val);
}
CAMLprim value win_findfirst(value name)
{
HANDLE h;
value v;
WIN32_FIND_DATA fileinfo;
value valname = Val_unit;
value valh = Val_unit;
caml_unix_check_path(name, "opendir");
Begin_roots2 (valname,valh);
h = FindFirstFile(String_val(name),&fileinfo);
if (h == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if (err == ERROR_NO_MORE_FILES)
raise_end_of_file();
else {
win32_maperr(err);
uerror("opendir", Nothing);
}
}
valname = copy_string(fileinfo.cFileName);
valh = win_alloc_handle(h);
v = alloc_small(2, 0);
Field(v,0) = valname;
Field(v,1) = valh;
End_roots();
return v;
}
CAMLprim value win_findfirstw(value name)
{
HANDLE h;
WIN32_FIND_DATAW fileinfo;
CAMLparam1(name);
CAMLlocal3(v, valname, valh);
h = FindFirstFileW((LPCWSTR) String_val(name),&fileinfo);
if (h == INVALID_HANDLE_VALUE) {
DWORD err = GetLastError();
if ((err == ERROR_NO_MORE_FILES) || (err == ERROR_FILE_NOT_FOUND))
raise_end_of_file();
else {
win32_maperr(err);
uerror("opendir", Nothing);
}
}
valname = copy_wstring(fileinfo.cFileName);
valh = win_alloc_handle(h);
v = alloc_small(2, 0);
Field(v,0) = valname;
Field(v,1) = valh;
CAMLreturn (v);
}
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;
}
value win_pipe(long readMode, long writeMode) {
CAMLparam0();
SECURITY_ATTRIBUTES attr;
HANDLE readh, writeh;
CHAR name[MAX_PATH];
CAMLlocal3(readfd, writefd, res);
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = TRUE;
sprintf(name, "\\\\.\\Pipe\\UnisonAnonPipe.%08lx.%08lx",
GetCurrentProcessId(), pipeSerial++);
readh =
CreateNamedPipeA
(name, PIPE_ACCESS_INBOUND | readMode, PIPE_TYPE_BYTE | PIPE_WAIT,
1, UNIX_BUFFER_SIZE, UNIX_BUFFER_SIZE, 0, &attr);
if (readh == INVALID_HANDLE_VALUE) {
win32_maperr(GetLastError());
uerror("CreateNamedPipe", Nothing);
return FALSE;
}
writeh =
CreateFileA
(name, GENERIC_WRITE, 0, &attr, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL | writeMode, NULL);
if (writeh == INVALID_HANDLE_VALUE) {
win32_maperr(GetLastError());
CloseHandle(readh);
uerror("CreateFile", Nothing);
return FALSE;
}
readfd = win_alloc_handle(readh);
writefd = win_alloc_handle(writeh);
res = alloc_small(2, 0);
Store_field(res, 0, readfd);
Store_field(res, 1, writefd);
CAMLreturn (res);
}
CAMLprim value win_handle_fd(value vfd)
{
int crt_fd = Int_val(vfd);
/* PR#4750: do not use the _or_socket variant as it can cause performance
degradation and this function is only used with the standard
handles 0, 1, 2, which are not sockets. */
value res = win_alloc_handle((HANDLE) _get_osfhandle(crt_fd));
CRT_fd_val(res) = crt_fd;
return res;
}
CAMLprim value unix_pipe(value unit)
{
SECURITY_ATTRIBUTES attr;
HANDLE readh, writeh;
value readfd = Val_unit, writefd = Val_unit, res;
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = TRUE;
if (! CreatePipe(&readh, &writeh, &attr, SIZEBUF)) {
win32_maperr(GetLastError());
uerror("pipe", Nothing);
}
Begin_roots2(readfd, writefd)
readfd = win_alloc_handle(readh);
writefd = win_alloc_handle(writeh);
res = caml_alloc_2(0, readfd, writefd);
End_roots();
return res;
}
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 win_open_directory (value path, value wpath) {
CAMLparam2 (path, wpath);
HANDLE h;
h = CreateFileW((LPCWSTR) String_val(wpath),
FILE_LIST_DIRECTORY,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OVERLAPPED,
NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr (GetLastError ());
uerror("open", path);
}
CAMLreturn(win_alloc_handle(h));
}
CAMLprim value win_filedescr_of_channel(value vchan)
{
CAMLparam1(vchan);
CAMLlocal1(fd);
struct channel * chan;
HANDLE h;
chan = Channel(vchan);
if (chan->fd == -1) uerror("descr_of_channel", Nothing);
h = (HANDLE) _get_osfhandle(chan->fd);
if (chan->flags & CHANNEL_FLAG_FROM_SOCKET)
fd = win_alloc_socket((SOCKET) h);
else
fd = win_alloc_handle(h);
CRT_fd_val(fd) = chan->fd;
CAMLreturn(fd);
}
CAMLprim value win_open (value path, value wpath, value flags, value perm) {
int fileaccess, createflags, fileattrib, filecreate;
SECURITY_ATTRIBUTES attr;
HANDLE h;
CAMLparam4 (path, wpath, flags, perm);
fileaccess = convert_flag_list(flags, open_access_flags);
createflags = convert_flag_list(flags, open_create_flags);
if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
filecreate = CREATE_NEW;
else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC))
filecreate = CREATE_ALWAYS;
else if (createflags & O_TRUNC)
filecreate = TRUNCATE_EXISTING;
else if (createflags & O_CREAT)
filecreate = OPEN_ALWAYS;
else
filecreate = OPEN_EXISTING;
if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0)
fileattrib = FILE_ATTRIBUTE_READONLY;
else
fileattrib = FILE_ATTRIBUTE_NORMAL;
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = TRUE;
h = CreateFileW((LPCWSTR) String_val(wpath), fileaccess,
FILE_SHARE_READ | FILE_SHARE_WRITE, &attr,
filecreate, fileattrib, NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr (GetLastError ());
uerror("open", path);
}
if (createflags & O_APPEND) SetFilePointer (h, 0, NULL, FILE_END);
CAMLreturn(win_alloc_handle(h));
}
CAMLprim value unix_open(value path, value flags, value perm)
{
int fileaccess, createflags, fileattrib, filecreate, sharemode, cloexec;
SECURITY_ATTRIBUTES attr;
HANDLE h;
fileaccess = convert_flag_list(flags, open_access_flags);
sharemode = FILE_SHARE_READ | FILE_SHARE_WRITE
| convert_flag_list(flags, open_share_flags);
createflags = convert_flag_list(flags, open_create_flags);
if ((createflags & (O_CREAT | O_EXCL)) == (O_CREAT | O_EXCL))
filecreate = CREATE_NEW;
else if ((createflags & (O_CREAT | O_TRUNC)) == (O_CREAT | O_TRUNC))
filecreate = CREATE_ALWAYS;
else if (createflags & O_TRUNC)
filecreate = TRUNCATE_EXISTING;
else if (createflags & O_CREAT)
filecreate = OPEN_ALWAYS;
else
filecreate = OPEN_EXISTING;
if ((createflags & O_CREAT) && (Int_val(perm) & 0200) == 0)
fileattrib = FILE_ATTRIBUTE_READONLY;
else
fileattrib = FILE_ATTRIBUTE_NORMAL;
cloexec = convert_flag_list(flags, open_cloexec_flags);
attr.nLength = sizeof(attr);
attr.lpSecurityDescriptor = NULL;
attr.bInheritHandle = cloexec ? FALSE : TRUE;
h = CreateFile(String_val(path), fileaccess,
sharemode, &attr,
filecreate, fileattrib, NULL);
if (h == INVALID_HANDLE_VALUE) {
win32_maperr(GetLastError());
uerror("open", path);
}
return win_alloc_handle(h);
}
