1 /**************************************************************************/
2 /* */
3 /* OCaml */
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. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #define CAML_INTERNALS
17
18 #include <caml/mlvalues.h>
19 #include <caml/memory.h>
20 #include "unixsupport.h"
21 #include <windows.h>
22 #include <caml/osdeps.h>
23 #include <errno.h>
24
25 static int win_has_console(void);
26
win_create_process_native(value cmd,value cmdline,value env,value fd1,value fd2,value fd3)27 value win_create_process_native(value cmd, value cmdline, value env,
28 value fd1, value fd2, value fd3)
29 {
30 PROCESS_INFORMATION pi;
31 STARTUPINFO si;
32 char * exefile, * envp;
33 DWORD flags, err;
34 HANDLE hp;
35
36 caml_unix_check_path(cmd, "create_process");
37 if (! caml_string_is_c_safe(cmdline))
38 unix_error(EINVAL, "create_process", cmdline);
39 /* [env] is checked for null bytes at construction time, see unix.ml */
40
41 err = ERROR_SUCCESS;
42 exefile = caml_search_exe_in_path(String_val(cmd));
43 if (env != Val_int(0)) {
44 envp = String_val(Field(env, 0));
45 } else {
46 envp = NULL;
47 }
48 /* Prepare stdin/stdout/stderr redirection */
49 ZeroMemory(&si, sizeof(STARTUPINFO));
50 si.cb = sizeof(STARTUPINFO);
51 si.dwFlags = STARTF_USESTDHANDLES;
52 /* Duplicate the handles fd1, fd2, fd3 to make sure they are inheritable */
53 hp = GetCurrentProcess();
54 if (! DuplicateHandle(hp, Handle_val(fd1), hp, &(si.hStdInput),
55 0, TRUE, DUPLICATE_SAME_ACCESS)) {
56 err = GetLastError(); goto ret1;
57 }
58 if (! DuplicateHandle(hp, Handle_val(fd2), hp, &(si.hStdOutput),
59 0, TRUE, DUPLICATE_SAME_ACCESS)) {
60 err = GetLastError(); goto ret2;
61 }
62 if (! DuplicateHandle(hp, Handle_val(fd3), hp, &(si.hStdError),
63 0, TRUE, DUPLICATE_SAME_ACCESS)) {
64 err = GetLastError(); goto ret3;
65 }
66 /* If we do not have a console window, then we must create one
67 before running the process (keep it hidden for apparence).
68 If we are starting a GUI application, the newly created
69 console should not matter. */
70 if (win_has_console())
71 flags = 0;
72 else {
73 flags = CREATE_NEW_CONSOLE;
74 si.dwFlags = (STARTF_USESHOWWINDOW | STARTF_USESTDHANDLES);
75 si.wShowWindow = SW_HIDE;
76 }
77 /* Create the process */
78 if (! CreateProcess(exefile, String_val(cmdline), NULL, NULL,
79 TRUE, flags, envp, NULL, &si, &pi)) {
80 err = GetLastError(); goto ret4;
81 }
82 CloseHandle(pi.hThread);
83 ret4:
84 CloseHandle(si.hStdError);
85 ret3:
86 CloseHandle(si.hStdOutput);
87 ret2:
88 CloseHandle(si.hStdInput);
89 ret1:
90 caml_stat_free(exefile);
91 if (err != ERROR_SUCCESS) {
92 win32_maperr(err);
93 uerror("create_process", cmd);
94 }
95 /* Return the process handle as pseudo-PID
96 (this is consistent with the wait() emulation in the MSVC C library */
97 return Val_long(pi.hProcess);
98 }
99
win_create_process(value * argv,int argn)100 CAMLprim value win_create_process(value * argv, int argn)
101 {
102 return win_create_process_native(argv[0], argv[1], argv[2],
103 argv[3], argv[4], argv[5]);
104 }
105
win_has_console(void)106 static int win_has_console(void)
107 {
108 HANDLE h, log;
109 int i;
110
111 h = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL,
112 OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
113 if (h == INVALID_HANDLE_VALUE) {
114 return 0;
115 } else {
116 CloseHandle(h);
117 return 1;
118 }
119 }
120
win_terminate_process(value v_pid)121 CAMLprim value win_terminate_process(value v_pid)
122 {
123 return (Val_bool(TerminateProcess((HANDLE) Long_val(v_pid), 0)));
124 }
125