125 lines
3.4 KiB
C
125 lines
3.4 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
#include <mlvalues.h>
|
|
#include <windows.h>
|
|
#include "unixsupport.h"
|
|
|
|
#if 0
|
|
|
|
/* This works only under Windows NT, but not 95 */
|
|
|
|
value win_set_close_on_exec(fd) /* ML */
|
|
value fd;
|
|
{
|
|
HANDLE h;
|
|
|
|
h = (HANDLE) _get_osfhandle(Int_val(fd)) ;
|
|
if (h == (HANDLE) -1 ||
|
|
! SetHandleInformation(h, HANDLE_FLAG_INHERIT, 0)) {
|
|
_dosmaperr(GetLastError());
|
|
uerror("set_close_on_exec", Nothing);
|
|
}
|
|
return Val_unit;
|
|
}
|
|
|
|
value win_clear_close_on_exec(fd) /* ML */
|
|
value fd;
|
|
{
|
|
HANDLE h;
|
|
h = (HANDLE) _get_osfhandle(Int_val(fd)) ;
|
|
if (h == (HANDLE) -1 ||
|
|
! SetHandleInformation(h, HANDLE_FLAG_INHERIT, HANDLE_FLAG_INHERIT)) {
|
|
_dosmaperr(GetLastError());
|
|
uerror("clear_close_on_exec", Nothing);
|
|
}
|
|
return Val_unit;
|
|
}
|
|
|
|
#else
|
|
|
|
/* This works on Win 95, but is a terrible hack.
|
|
Bug: the opening flags of the file descriptor (O_APPEND, O_TEXT) are lost. */
|
|
|
|
static int win_open_osfhandle2(handle, flags, reqd_fd)
|
|
HANDLE handle;
|
|
int flags;
|
|
int reqd_fd;
|
|
{
|
|
int fd, retcode;
|
|
HANDLE new_handle;
|
|
|
|
fd = _open_osfhandle((long)handle, flags);
|
|
if (fd == -1)
|
|
return -1;
|
|
if (fd == reqd_fd)
|
|
return 0; /* Got it! */
|
|
/* Make a copy of the handle, since we're going to close "handle" when
|
|
we close "fd". */
|
|
if (! DuplicateHandle(GetCurrentProcess(), handle,
|
|
GetCurrentProcess(), &new_handle,
|
|
0L, FALSE, DUPLICATE_SAME_ACCESS)) {
|
|
_dosmaperr(GetLastError());
|
|
return -1;
|
|
}
|
|
/* Keep fd open during the recursive call, thus forcing _open_osfhandle
|
|
to return reqd_fd eventually. */
|
|
retcode = win_open_osfhandle2(new_handle, flags, reqd_fd);
|
|
close(fd); /* Also closes "handle" */
|
|
return retcode;
|
|
}
|
|
|
|
static int win_set_noninherit(fd)
|
|
int fd;
|
|
{
|
|
HANDLE oldh, newh;
|
|
oldh = (HANDLE) _get_osfhandle(fd);
|
|
if (oldh == (HANDLE) -1) return -1;
|
|
if (! DuplicateHandle(GetCurrentProcess(), oldh,
|
|
GetCurrentProcess(), &newh,
|
|
0L, FALSE, DUPLICATE_SAME_ACCESS)) {
|
|
_dosmaperr(GetLastError());
|
|
return -1;
|
|
}
|
|
if (close(fd) == -1) return -1;
|
|
return win_open_osfhandle2(newh, 0, fd);
|
|
}
|
|
|
|
value win_set_close_on_exec(vfd) /* ML */
|
|
value vfd;
|
|
{
|
|
if (win_set_noninherit(Int_val(vfd)) == -1)
|
|
uerror("set_close_on_exec", Nothing);
|
|
return Val_unit;
|
|
}
|
|
|
|
value win_clear_close_on_exec(vfd) /* ML */
|
|
value vfd;
|
|
{
|
|
int fd, newfd;
|
|
|
|
fd = Int_val(vfd);
|
|
newfd = dup(fd);
|
|
if (newfd == -1) {
|
|
uerror("clear_close_on_exec", Nothing);
|
|
}
|
|
if (dup2(newfd, fd) == -1) {
|
|
close(newfd);
|
|
uerror("clear_close_on_exec", Nothing);
|
|
}
|
|
close(newfd);
|
|
return Val_unit;
|
|
}
|
|
|
|
#endif
|