l4/pkg/ocaml/ocaml/contrib/otherlibs/win32unix/close_on.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*  Xavier Leroy and Pascal Cuoq, projet Cristal, INRIA Rocquencourt   */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../../LICENSE.  */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: close_on.c 4144 2001-12-07 13:41:02Z xleroy $ */
  15
  16 #include <mlvalues.h>
  17 #include <windows.h>
  18 #include "unixsupport.h"
  19
  20 int win_set_inherit(value fd, BOOL inherit)
  21 {
  22   HANDLE oldh, newh;
  23
  24   oldh = Handle_val(fd);
  25   if (! DuplicateHandle(GetCurrentProcess(), oldh,
  26                         GetCurrentProcess(), &newh,
  27                         0L, inherit, DUPLICATE_SAME_ACCESS)) {
  28     win32_maperr(GetLastError());
  29     return -1;
  30   }
  31   Handle_val(fd) = newh;
  32   CloseHandle(oldh);
  33   return 0;
  34 }
  35
  36 CAMLprim value win_set_close_on_exec(value fd)
  37 {
  38   if (win_set_inherit(fd, FALSE) == -1) uerror("set_close_on_exec", Nothing);
  39   return Val_unit;
  40 }
  41
  42 CAMLprim value win_clear_close_on_exec(value fd)
  43 {
  44   if (win_set_inherit(fd, TRUE) == -1) uerror("clear_close_on_exec", Nothing);
  45   return Val_unit;
  46 }