1 /* Asynchronous subprocess implementation for Win32
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996, 2000 Ben Wing.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */
30 #include "console-msw.h"
45 /* Bound by win32-native.el */
46 Lisp_Object Qmswindows_construct_process_command_line;
48 /* Arbitrary size limit for code fragments passed to run_in_other_process */
49 #define FRAGMENT_CODE_SIZE 32
51 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
52 struct nt_process_data
56 HWND hwnd; /* console window */
59 /* Control how args are quoted to ensure correct parsing by child
61 Lisp_Object Vmswindows_quote_process_args;
63 /* Control whether create_child causes the process to inherit Emacs'
64 console window, or be given a new one of its own. The default is
65 nil, to allow multiple DOS programs to run on Win95. Having separate
66 consoles also allows Emacs to cleanly terminate process groups. */
67 Lisp_Object Vmswindows_start_process_share_console;
69 /* Control whether create_child cause the process to inherit Emacs'
70 error mode setting. The default is t, to minimize the possibility of
71 subprocesses blocking when accessing unmounted drives. */
72 Lisp_Object Vmswindows_start_process_inherit_error_mode;
74 #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data))
76 /*-----------------------------------------------------------------------*/
78 /*-----------------------------------------------------------------------*/
80 /* This one breaks process abstraction. Prototype is in console-msw.h,
81 used by select_process method in event-msw.c */
83 get_nt_process_handle (Lisp_Process *p)
85 return (NT_DATA (p)->h_process);
88 static struct Lisp_Process *
89 find_process_from_pid (DWORD pid)
91 Lisp_Object tail, proc;
93 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
96 if (NT_DATA (XPROCESS (proc))->dwProcessId == pid)
97 return XPROCESS (proc);
103 /*-----------------------------------------------------------------------*/
104 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */
105 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
106 /*-----------------------------------------------------------------------*/
116 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
117 * further by other routines. Return nonzero if successful.
119 * The memory in other process is allocated by creating a suspended
120 * thread. Initial stack of that thread is used as the memory
121 * block. The thread entry point is the routine ExitThread in
122 * kernel32.dll, so the allocated memory is freed just by resuming the
123 * thread, which immediately terminates after that.
127 alloc_process_memory (HANDLE h_process, size_t size,
130 LPTHREAD_START_ROUTINE adr_ExitThread =
131 (LPTHREAD_START_ROUTINE)
132 GetProcAddress (GetModuleHandle ("kernel32"), "ExitThread");
135 MEMORY_BASIC_INFORMATION mbi;
137 pmc->h_process = h_process;
138 pmc->h_thread = CreateRemoteThread (h_process, NULL, size,
139 adr_ExitThread, NULL,
140 CREATE_SUSPENDED, &dw_unused);
141 if (pmc->h_thread == NULL)
144 /* Get context, for thread's stack pointer */
145 context.ContextFlags = CONTEXT_CONTROL;
146 if (!GetThreadContext (pmc->h_thread, &context))
149 /* Determine base address of the committed range */
150 if (sizeof(mbi) != VirtualQueryEx (h_process,
152 (LPDWORD)context.Esp - 1,
153 #elif defined (_ALPHA_)
154 (LPDWORD)context.IntSp - 1,
156 #error Unknown processor architecture
161 /* Change the page protection of the allocated memory to executable,
163 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
164 PAGE_EXECUTE_READWRITE, &dw_unused))
167 pmc->address = mbi.BaseAddress;
171 ResumeThread (pmc->h_thread);
177 free_process_memory (process_memory* pmc)
179 ResumeThread (pmc->h_thread);
183 * Run ROUTINE in the context of process determined by H_PROCESS. The
184 * routine is passed the address of DATA as parameter. The ROUTINE must
185 * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of
188 * Note that the code must be positionally independent, and compiled
189 * without stack checks (they cause implicit calls into CRT so will
190 * fail). DATA should not refer any data in calling process, as both
191 * routine and its data are copied into remote process. Size of data
192 * and code together should not exceed one page (4K on x86 systems).
194 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
197 run_in_other_process (HANDLE h_process,
198 LPTHREAD_START_ROUTINE routine,
199 LPVOID data, size_t data_size)
202 const size_t code_size = FRAGMENT_CODE_SIZE;
203 /* Need at most 3 extra bytes of memory, for data alignment */
204 size_t total_size = code_size + data_size + 3;
209 /* Allocate memory */
210 if (!alloc_process_memory (h_process, total_size, &pm))
214 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
221 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
222 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
228 /* Execute the remote copy of code, passing it remote data */
229 h_thread = CreateRemoteThread (h_process, NULL, 0,
230 (LPTHREAD_START_ROUTINE) pm.address,
231 remote_data, 0, &dw_unused);
232 if (h_thread == NULL)
235 /* Wait till thread finishes */
236 WaitForSingleObject (h_thread, INFINITE);
238 /* Free remote memory */
239 free_process_memory (&pm);
241 /* Return thread's exit code */
244 GetExitCodeThread (h_thread, &exit_code);
245 CloseHandle (h_thread);
250 free_process_memory (&pm);
254 /*-----------------------------------------------------------------------*/
255 /* Sending signals */
256 /*-----------------------------------------------------------------------*/
258 /* ---------------------------- the NT way ------------------------------- */
261 * We handle the following signals:
263 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
264 * executed by the remote process
265 * SIGINT - The remote process is sent CTRL_BREAK_EVENT
267 * The MSVC5.0 compiler feels free to re-order functions within a
268 * compilation unit, so we have no way of finding out the size of the
269 * following functions. Therefore these functions must not be larger than
270 * FRAGMENT_CODE_SIZE.
278 void (WINAPI *adr_ExitProcess) (UINT);
282 sigkill_proc (sigkill_data* data)
284 (*data->adr_ExitProcess)(255);
289 * Sending break or control c
293 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
298 sigint_proc (sigint_data* data)
300 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
308 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
312 sig_enable_proc (sig_enable_data* data)
314 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
319 * Send signal SIGNO to process H_PROCESS.
320 * Return nonzero if successful.
324 send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo)
327 HMODULE h_kernel = GetModuleHandle ("kernel32");
328 int close_process = 0;
331 assert (h_kernel != NULL);
335 pid = cp->dwProcessId;
336 h_process = cp->h_process;
341 /* Try to open the process with required privileges */
342 h_process = OpenProcess (PROCESS_CREATE_THREAD
343 | PROCESS_QUERY_INFORMATION
344 | PROCESS_VM_OPERATION
361 (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess");
362 assert (d.adr_ExitProcess);
363 retval = run_in_other_process (h_process,
364 (LPTHREAD_START_ROUTINE)sigkill_proc,
371 d.adr_GenerateConsoleCtrlEvent =
372 (BOOL (WINAPI *) (DWORD, DWORD))
373 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
374 assert (d.adr_GenerateConsoleCtrlEvent);
375 d.event = CTRL_C_EVENT;
376 retval = run_in_other_process (h_process,
377 (LPTHREAD_START_ROUTINE)sigint_proc,
386 CloseHandle (h_process);
387 return (int)retval > 0 ? 1 : 0;
391 * Enable CTRL_C_EVENT handling in a new child process
394 enable_child_signals (HANDLE h_process)
396 HMODULE h_kernel = GetModuleHandle ("kernel32");
399 assert (h_kernel != NULL);
400 d.adr_SetConsoleCtrlHandler =
401 (BOOL (WINAPI *) (LPVOID, BOOL))
402 GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
403 assert (d.adr_SetConsoleCtrlHandler);
404 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
408 #pragma warning (default : 4113)
410 /* ---------------------------- the 95 way ------------------------------- */
413 find_child_console (HWND hwnd, long putada)
417 struct nt_process_data *cp = (struct nt_process_data *) putada;
419 thread_id = GetWindowThreadProcessId (hwnd, &process_id);
420 if (process_id == cp->dwProcessId)
422 char window_class[32];
424 GetClassName (hwnd, window_class, sizeof (window_class));
425 if (strcmp (window_class,
426 mswindows_windows9x_p ()
428 : "ConsoleWindowClass") == 0)
439 send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo)
442 int close_process = 0;
447 pid = cp->dwProcessId;
448 h_process = cp->h_process;
450 /* Try to locate console window for process. */
451 EnumWindows (find_child_console, (LPARAM) cp);
456 /* Try to open the process with required privileges */
457 h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid);
464 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
466 BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
467 BYTE vk_break_code = VK_CANCEL;
468 BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
469 HWND foreground_window;
471 if (break_scan_code == 0)
473 /* Fake Ctrl-C if we can't manage Ctrl-Break. */
475 break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
478 foreground_window = GetForegroundWindow ();
479 if (foreground_window)
481 /* NT 5.0, and apparently also Windows 98, will not allow
482 a Window to be set to foreground directly without the
483 user's involvement. The workaround is to attach
484 ourselves to the thread that owns the foreground
485 window, since that is the only thread that can set the
486 foreground window. */
487 DWORD foreground_thread, child_thread;
489 GetWindowThreadProcessId (foreground_window, NULL);
490 if (foreground_thread == GetCurrentThreadId ()
491 || !AttachThreadInput (GetCurrentThreadId (),
492 foreground_thread, TRUE))
493 foreground_thread = 0;
495 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
496 if (child_thread == GetCurrentThreadId ()
497 || !AttachThreadInput (GetCurrentThreadId (),
501 /* Set the foreground window to the child. */
502 if (SetForegroundWindow (cp->hwnd))
504 /* Generate keystrokes as if user had typed Ctrl-Break or
506 keybd_event (VK_CONTROL, control_scan_code, 0, 0);
507 keybd_event (vk_break_code, break_scan_code,
508 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
509 keybd_event (vk_break_code, break_scan_code,
510 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
511 | KEYEVENTF_KEYUP, 0);
512 keybd_event (VK_CONTROL, control_scan_code,
515 /* Sleep for a bit to give time for Emacs frame to respond
516 to focus change events (if Emacs was active app). */
519 SetForegroundWindow (foreground_window);
521 /* Detach from the foreground and child threads now that
522 the foreground switching is over. */
523 if (foreground_thread)
524 AttachThreadInput (GetCurrentThreadId (),
525 foreground_thread, FALSE);
527 AttachThreadInput (GetCurrentThreadId (),
528 child_thread, FALSE);
531 /* Ctrl-Break is NT equivalent of SIGINT. */
532 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
534 #if 0 /* FSF Emacs */
535 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
536 "for pid %lu\n", GetLastError (), pid));
544 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
547 if (mswindows_windows9x_p ())
550 Another possibility is to try terminating the VDM out-right by
551 calling the Shell VxD (id 0x17) V86 interface, function #4
552 "SHELL_Destroy_VM", ie.
558 First need to determine the current VM handle, and then arrange for
559 the shellapi call to be made from the system vm (by using
560 Switch_VM_and_callback).
562 Could try to invoke DestroyVM through CallVxD.
566 /* On Win95, posting WM_QUIT causes the 16-bit subsystem
567 to hang when cmdproxy is used in conjunction with
568 command.com for an interactive shell. Posting
569 WM_CLOSE pops up a dialog that, when Yes is selected,
570 does the same thing. TerminateProcess is also less
571 than ideal in that subprocesses tend to stick around
572 until the machine is shutdown, but at least it
573 doesn't freeze the 16-bit subsystem. */
574 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
576 if (!TerminateProcess (h_process, 0xff))
578 #if 0 /* FSF Emacs */
579 DebPrint (("sys_kill.TerminateProcess returned %d "
580 "for pid %lu\n", GetLastError (), pid));
588 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
590 /* Kill the process. On W32 this doesn't kill child processes
591 so it doesn't work very well for shells which is why it's not
592 used in every case. */
593 else if (!TerminateProcess (h_process, 0xff))
595 #if 0 /* FSF Emacs */
596 DebPrint (("sys_kill.TerminateProcess returned %d "
597 "for pid %lu\n", GetLastError (), pid));
605 CloseHandle (h_process);
610 /* -------------------------- all-OS functions ---------------------------- */
613 send_signal (struct nt_process_data *cp, int pid, int signo)
615 return (!mswindows_windows9x_p () && send_signal_the_nt_way (cp, pid, signo))
616 || send_signal_the_95_way (cp, pid, signo);
620 * Signal error if SIGNO is not supported
623 validate_signal_number (int signo)
625 if (signo != SIGKILL && signo != SIGTERM
626 && signo != SIGQUIT && signo != SIGINT
628 invalid_argument ("Signal number not supported", make_int (signo));
631 /*-----------------------------------------------------------------------*/
632 /* Process methods */
633 /*-----------------------------------------------------------------------*/
636 * Allocate and initialize Lisp_Process->process_data
640 nt_alloc_process_data (Lisp_Process *p)
642 p->process_data = xnew_and_zero (struct nt_process_data);
646 nt_finalize_process_data (Lisp_Process *p, int for_disksave)
648 assert (!for_disksave);
649 if (NT_DATA (p)->h_process)
650 CloseHandle (NT_DATA (p)->h_process);
654 * Initialize XEmacs process implementation once
657 nt_init_process (void)
659 /* Initialize winsock */
661 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
662 WSAStartup (MAKEWORD (1,1), &wsa_data);
666 * Fork off a subprocess. P is a pointer to newly created subprocess
667 * object. If this function signals, the caller is responsible for
668 * deleting (and finalizing) the process object.
670 * The method must return PID of the new process, a (positive??? ####) number
671 * which fits into Lisp_Int. No return value indicates an error, the method
672 * must signal an error instead.
676 signal_cannot_launch (Lisp_Object image_file, DWORD err)
678 mswindows_set_errno (err);
679 report_file_error ("Error starting", image_file);
683 ensure_console_window_exists (void)
685 if (mswindows_windows9x_p ())
686 mswindows_hide_console ();
690 compare_env (const void *strp1, const void *strp2)
692 const char *str1 = *(const char**)strp1, *str2 = *(const char**)strp2;
694 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
696 if ((*str1) > (*str2))
698 else if ((*str1) < (*str2))
703 if (*str1 == '=' && *str2 == '=')
705 else if (*str1 == '=')
712 nt_create_process (Lisp_Process *p,
713 Lisp_Object *argv, int nargv,
714 Lisp_Object program, Lisp_Object cur_dir)
716 /* Synched up with sys_spawnve in FSF 20.6. Significantly different
717 but still synchable. */
718 HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
719 Extbyte *command_line;
720 BOOL do_io, windowed;
723 /* No need to DOS-ize the filename; expand-file-name (called prior)
724 already does this. */
726 /* Find out whether the application is windowed or not */
729 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
730 errors. This leads to bogus error message. */
732 char *p = strrchr ((char *)XSTRING_DATA (program), '.');
734 (stricmp (p, ".exe") == 0 ||
735 stricmp (p, ".com") == 0 ||
736 stricmp (p, ".bat") == 0 ||
737 stricmp (p, ".cmd") == 0))
739 image_type = xSHGetFileInfoA ((char *)XSTRING_DATA (program), 0,NULL,
744 char progname[MAX_PATH];
745 sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program));
746 image_type = xSHGetFileInfoA (progname, 0, NULL, 0, SHGFI_EXETYPE);
749 signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
750 ? ERROR_BAD_FORMAT : GetLastError ()));
751 windowed = HIWORD (image_type) != 0;
753 else /* NT 3.5; we have no idea so just guess. */
756 /* Decide whether to do I/O on process handles, or just mark the
757 process exited immediately upon successful launching. We do I/O if the
758 process is a console one, or if it is windowed but windowed_process_io
760 do_io = !windowed || windowed_process_io ;
764 /* Create two unidirectional named pipes */
766 SECURITY_ATTRIBUTES sa;
768 sa.nLength = sizeof(sa);
769 sa.bInheritHandle = TRUE;
770 sa.lpSecurityDescriptor = NULL;
772 CreatePipe (&hprocin, &hmyshove, &sa, 0);
773 CreatePipe (&hmyslurp, &hprocout, &sa, 0);
775 /* Duplicate the stdout handle for use as stderr */
776 DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(),
777 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
779 /* Stupid Win32 allows to create a pipe with *both* ends either
780 inheritable or not. We need process ends inheritable, and local
781 ends not inheritable. */
782 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
784 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
786 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
788 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
792 /* Convert an argv vector into Win32 style command line by a call to
793 lisp function `mswindows-construct-process-command-line'
794 (in win32-native.el) */
797 Lisp_Object args_or_ret = Qnil;
800 GCPRO1 (args_or_ret);
802 for (i = 0; i < nargv; ++i)
803 args_or_ret = Fcons (*argv++, args_or_ret);
804 args_or_ret = Fnreverse (args_or_ret);
805 args_or_ret = Fcons (program, args_or_ret);
807 args_or_ret = call1 (Qmswindows_construct_process_command_line,
810 if (!STRINGP (args_or_ret))
811 /* Luser wrote his/her own clever version */
813 ("Bogus return value from `mswindows-construct-process-command-line'",
816 LISP_STRING_TO_EXTERNAL (args_or_ret, command_line, Qmswindows_tstr);
818 UNGCPRO; /* args_or_ret */
821 /* Set `proc_env' to a nul-separated array of the strings in
822 Vprocess_environment terminated by 2 nuls. */
826 REGISTER Lisp_Object tem;
827 REGISTER char **new_env;
828 REGISTER int new_length = 0, i, new_space;
831 for (tem = Vprocess_environment;
833 && STRINGP (XCAR (tem)));
837 /* FSF adds an extra env var to hold the current process ID of the
838 Emacs process. Apparently this is used only by emacsserver.c,
839 which we have superseded to gnuserv.c. (#### Does it work under
842 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
843 GetCurrentProcessId ());
844 arglen += strlen (ppid_env_var_buffer) + 1;
848 /* new_length + 1 to include terminating 0. */
849 env = new_env = alloca_array (char *, new_length + 1);
851 /* Copy the Vprocess_environment strings into new_env. */
852 for (tem = Vprocess_environment;
854 && STRINGP (XCAR (tem)));
858 char *string = (char *) XSTRING_DATA (XCAR (tem));
859 /* See if this string duplicates any string already in the env.
860 If so, don't put it in.
861 When an env var has multiple definitions,
862 we keep the definition that comes first in process-environment. */
863 for (; ep != new_env; ep++)
865 char *p = *ep, *q = string;
869 /* The string is malformed; might as well drop it. */
883 /* Sort the environment variables */
884 new_length = new_env - env;
885 qsort (env, new_length, sizeof (char *), compare_env);
887 /* Work out how much space to allocate */
889 for (i = 0; i < new_length; i++)
891 new_space += strlen(env[i]) + 1;
895 /* Allocate space and copy variables into it */
896 penv = proc_env = (char*) alloca(new_space);
897 for (i = 0; i < new_length; i++)
899 strcpy(penv, env[i]);
900 penv += strlen(env[i]) + 1;
906 /* #### we need to port this. */
907 /* On Windows 95, if cmdname is a DOS app, we invoke a helper
908 application to start it by specifying the helper app as cmdname,
909 while leaving the real app name as argv[0]. */
912 cmdname = (char*) alloca (MAXPATHLEN);
913 if (egetenv ("CMDPROXY"))
914 strcpy ((char*)cmdname, egetenv ("CMDPROXY"));
917 strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory));
918 strcat ((char*)cmdname, "cmdproxy.exe");
926 PROCESS_INFORMATION pi;
931 si.dwFlags = STARTF_USESHOWWINDOW;
932 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
935 si.hStdInput = hprocin;
936 si.hStdOutput = hprocout;
937 si.hStdError = hprocerr;
938 si.dwFlags |= STARTF_USESTDHANDLES;
941 flags = CREATE_SUSPENDED;
942 if (mswindows_windows9x_p ())
943 flags |= (!NILP (Vmswindows_start_process_share_console)
944 ? CREATE_NEW_PROCESS_GROUP
945 : CREATE_NEW_CONSOLE);
947 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
948 if (NILP (Vmswindows_start_process_inherit_error_mode))
949 flags |= CREATE_DEFAULT_ERROR_MODE;
951 ensure_console_window_exists ();
953 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, flags,
954 proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
955 ? 0 : GetLastError ());
959 /* These just have been inherited; we do not need a copy */
960 CloseHandle (hprocin);
961 CloseHandle (hprocout);
962 CloseHandle (hprocerr);
965 /* Handle process creation failure */
970 CloseHandle (hmyshove);
971 CloseHandle (hmyslurp);
973 signal_cannot_launch (program, GetLastError ());
976 /* The process started successfully */
979 NT_DATA(p)->h_process = pi.hProcess;
980 NT_DATA(p)->dwProcessId = pi.dwProcessId;
981 init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
985 /* Indicate as if the process has exited immediately. */
986 p->status_symbol = Qexit;
987 CloseHandle (pi.hProcess);
991 enable_child_signals (pi.hProcess);
993 ResumeThread (pi.hThread);
994 CloseHandle (pi.hThread);
996 return ((int)pi.dwProcessId);
1001 * This method is called to update status fields of the process
1002 * structure. If the process has not existed, this method is expected
1005 * The method is called only for real child processes.
1009 nt_update_status_if_terminated (Lisp_Process* p)
1012 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
1013 && exit_code != STILL_ACTIVE)
1017 /* The exit code can be a code returned by process, or an
1018 NTSTATUS value. We cannot accurately handle the latter since
1019 it is a full 32 bit integer */
1020 if (exit_code & 0xC0000000)
1022 p->status_symbol = Qsignal;
1023 p->exit_code = exit_code & 0x1FFFFFFF;
1027 p->status_symbol = Qexit;
1028 p->exit_code = exit_code;
1034 * Stuff the entire contents of LSTREAM to the process output pipe
1037 /* #### If only this function could be somehow merged with
1038 unix_send_process... */
1041 nt_send_process (Lisp_Object proc, struct lstream* lstream)
1043 volatile Lisp_Object vol_proc = proc;
1044 Lisp_Process *volatile p = XPROCESS (proc);
1046 /* use a reasonable-sized buffer (somewhere around the size of the
1047 stream buffer) so as to avoid inundating the stream with blocked
1049 Bufbyte chunkbuf[512];
1054 Lstream_data_count writeret;
1056 chunklen = Lstream_read (lstream, chunkbuf, 512);
1058 break; /* perhaps should abort() if < 0?
1059 This should never happen. */
1061 /* Lstream_write() will never successfully write less than the
1062 amount sent in. In the worst case, it just buffers the
1064 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
1066 Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
1069 p->status_symbol = Qexit;
1070 p->exit_code = ERROR_BROKEN_PIPE;
1074 deactivate_process (*((Lisp_Object *) (&vol_proc)));
1075 invalid_operation ("Broken pipe error sending to process; closed it",
1081 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
1083 /* Buffer is full. Wait, accepting input; that may allow
1084 the program to finish doing output and read more. */
1085 Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
1086 Lstream_flush (XLSTREAM (p->pipe_outstream));
1087 wait_ms = min (1000, 2 * wait_ms);
1094 * Send a signal number SIGNO to PROCESS.
1095 * CURRENT_GROUP means send to the process group that currently owns
1096 * the terminal being used to communicate with PROCESS.
1097 * This is used for various commands in shell mode.
1098 * If NOMSG is zero, insert signal-announcements into process's buffers
1101 * If we can, we try to signal PROCESS by sending control characters
1102 * down the pty. This allows us to signal inferiors who have changed
1103 * their uid, for which killpg would return an EPERM error.
1105 * The method signals an error if the given SIGNO is not valid
1109 nt_kill_child_process (Lisp_Object proc, int signo,
1110 int current_group, int nomsg)
1112 Lisp_Process *p = XPROCESS (proc);
1114 /* Signal error if SIGNO cannot be sent */
1115 validate_signal_number (signo);
1118 if (!send_signal (NT_DATA (p), 0, signo))
1119 invalid_operation ("Cannot send signal to process", proc);
1123 * Kill any process in the system given its PID
1125 * Returns zero if a signal successfully sent, or
1126 * negative number upon failure
1129 nt_kill_process_by_pid (int pid, int signo)
1131 struct Lisp_Process *p;
1133 /* Signal error if SIGNO cannot be sent */
1134 validate_signal_number (signo);
1136 p = find_process_from_pid (pid);
1137 return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1;
1140 /*-----------------------------------------------------------------------*/
1141 /* Sockets connections */
1142 /*-----------------------------------------------------------------------*/
1145 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
1147 #define SOCK_TIMER_ID 666
1148 #define XM_SOCKREPLY (WM_USER + 666)
1151 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
1152 Error_behavior errb)
1154 char buf [MAXGETHOSTSTRUCT];
1159 address->sin_family = AF_INET;
1161 /* First check if HOST is already a numeric address */
1163 unsigned long inaddr = inet_addr (XSTRING_DATA (host));
1164 if (inaddr != INADDR_NONE)
1166 address->sin_addr.s_addr = inaddr;
1171 /* Create a window which will receive completion messages */
1172 hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
1173 NULL, NULL, NULL, NULL);
1176 /* Post name resolution request */
1177 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
1182 /* Set a timer to poll for quit every 250 ms */
1183 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
1188 GetMessage (&msg, hwnd, 0, 0);
1189 if (msg.message == XM_SOCKREPLY)
1191 /* Ok, got an answer */
1192 if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
1196 warn_when_safe(Qstream, Qwarning,
1197 "cannot get IP address for host \"%s\"",
1198 XSTRING_DATA (host));
1202 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
1206 WSACancelAsyncRequest (hasync);
1207 KillTimer (hwnd, SOCK_TIMER_ID);
1208 DestroyWindow (hwnd);
1212 DispatchMessage (&msg);
1216 KillTimer (hwnd, SOCK_TIMER_ID);
1217 DestroyWindow (hwnd);
1220 /* BUF starts with struct hostent */
1221 struct hostent* he = (struct hostent*) buf;
1222 address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
1228 nt_canonicalize_host_name (Lisp_Object host)
1230 struct sockaddr_in address;
1232 if (!get_internet_address (host, &address, ERROR_ME_NOT))
1235 if (address.sin_family == AF_INET)
1236 return build_string (inet_ntoa (address.sin_addr));
1241 /* open a TCP network connection to a given HOST/SERVICE. Treated
1242 exactly like a normal process when reading and writing. Only
1243 differences are in status display and process deletion. A network
1244 connection has no PID; you cannot signal it. All you can do is
1245 deactivate and close it via delete-process */
1248 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
1249 Lisp_Object service,
1250 Lisp_Object protocol, void** vinfd, void** voutfd)
1252 /* !!#### not Mule-ized */
1253 struct sockaddr_in address;
1258 CHECK_STRING (host);
1260 if (!EQ (protocol, Qtcp))
1261 invalid_argument ("Unsupported protocol", protocol);
1264 port = htons ((unsigned short) XINT (service));
1267 struct servent *svc_info;
1268 CHECK_STRING (service);
1269 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
1271 invalid_argument ("Unknown service", service);
1272 port = svc_info->s_port;
1275 get_internet_address (host, &address, ERROR_ME);
1276 address.sin_port = port;
1278 s = socket (address.sin_family, SOCK_STREAM, 0);
1280 report_file_error ("error creating socket", list1 (name));
1282 /* We don't want to be blocked on connect */
1284 unsigned long nonblock = 1;
1285 ioctlsocket (s, FIONBIO, &nonblock);
1288 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
1289 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
1290 goto connect_failed;
1291 /* Wait while connection is established */
1304 /* Poll for quit every 250 ms */
1306 tv.tv_usec = 250 * 1000;
1310 nsel = select (0, NULL, &fdset, &fdset, &tv);
1314 /* Check: was connection successful or not? */
1316 nsel = select (0, NULL, NULL, &fdset, &tv);
1318 goto connect_failed;
1324 /* We are connected at this point */
1326 DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
1327 GetCurrentProcess(), (LPHANDLE)voutfd,
1328 0, FALSE, DUPLICATE_SAME_ACCESS);
1335 warn_when_safe (Qstream, Qwarning,
1336 "failure to open network stream to host \"%s\" for service \"%d\"",
1337 XSTRING_DATA (host),
1338 (unsigned short) XINT (service));
1342 warn_when_safe (Qstream, Qwarning,
1343 "failure to open network stream to host \"%s\" for service \"%s\"",
1344 XSTRING_DATA (host),
1345 XSTRING_DATA (service));
1347 report_file_error ("connection failed", list2 (host, name));
1352 /*-----------------------------------------------------------------------*/
1353 /* Initialization */
1354 /*-----------------------------------------------------------------------*/
1357 process_type_create_nt (void)
1359 PROCESS_HAS_METHOD (nt, alloc_process_data);
1360 PROCESS_HAS_METHOD (nt, finalize_process_data);
1361 PROCESS_HAS_METHOD (nt, init_process);
1362 PROCESS_HAS_METHOD (nt, create_process);
1363 PROCESS_HAS_METHOD (nt, update_status_if_terminated);
1364 PROCESS_HAS_METHOD (nt, send_process);
1365 PROCESS_HAS_METHOD (nt, kill_child_process);
1366 PROCESS_HAS_METHOD (nt, kill_process_by_pid);
1368 PROCESS_HAS_METHOD (nt, canonicalize_host_name);
1369 PROCESS_HAS_METHOD (nt, open_network_stream);
1370 #ifdef HAVE_MULTICAST
1371 #error I won't do this until '95 has winsock2
1372 PROCESS_HAS_METHOD (nt, open_multicast_group);
1378 syms_of_process_nt (void)
1380 DEFSYMBOL (Qmswindows_construct_process_command_line);
1384 vars_of_process_nt (void)
1386 DEFVAR_LISP ("mswindows-quote-process-args",
1387 &Vmswindows_quote_process_args /*
1388 Non-nil enables quoting of process arguments to ensure correct parsing.
1389 Because Windows does not directly pass argv arrays to child processes,
1390 programs have to reconstruct the argv array by parsing the command
1391 line string. For an argument to contain a space, it must be enclosed
1392 in double quotes or it will be parsed as multiple arguments.
1394 If the value is a character, that character will be used to escape any
1395 quote characters that appear, otherwise a suitable escape character
1396 will be chosen based on the type of the program (normal or Cygwin).
1398 Vmswindows_quote_process_args = Qt;
1400 DEFVAR_LISP ("mswindows-start-process-share-console",
1401 &Vmswindows_start_process_share_console /*
1402 When nil, new child processes are given a new console.
1403 When non-nil, they share the Emacs console; this has the limitation of
1404 allowing only only DOS subprocess to run at a time (whether started directly
1405 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
1406 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
1407 otherwise respond to interrupts from Emacs.
1409 Vmswindows_start_process_share_console = Qnil;
1411 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
1412 &Vmswindows_start_process_inherit_error_mode /*
1413 "When nil, new child processes revert to the default error mode.
1414 When non-nil, they inherit their error mode setting from Emacs, which stops
1415 them blocking when trying to access unmounted drives etc.
1417 Vmswindows_start_process_inherit_error_mode = Qt;