XEmacs 21.2.32 "Kastor & Polydeukes".
[chise/xemacs-chise.git.1] / src / process-nt.c
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.
6
7 This file is part of XEmacs.
8
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
12 later version.
13
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
17 for more details.
18
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.  */
23
24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "console-msw.h"
30 #include "hash.h"
31 #include "lstream.h"
32 #include "process.h"
33 #include "procimpl.h"
34 #include "sysdep.h"
35
36 #include <shellapi.h>
37 #ifdef __MINGW32__
38 #include <errno.h>
39 #endif
40 #include <signal.h>
41 #ifdef HAVE_SOCKETS
42 #include <winsock.h>
43 #endif
44
45 /* Arbitrary size limit for code fragments passed to run_in_other_process */
46 #define FRAGMENT_CODE_SIZE 32
47
48 /* Bound by winnt.el */
49 Lisp_Object Qnt_quote_process_args;
50
51 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
52 struct nt_process_data
53 {
54   HANDLE h_process;
55   DWORD dwProcessId;
56   HWND hwnd; /* console window */
57   int need_enable_child_signals;
58 };
59
60 /* Control whether create_child causes the process to inherit Emacs'
61    console window, or be given a new one of its own.  The default is
62    nil, to allow multiple DOS programs to run on Win95.  Having separate
63    consoles also allows Emacs to cleanly terminate process groups.  */
64 Lisp_Object Vmswindows_start_process_share_console;
65
66 /* Control whether create_child cause the process to inherit Emacs'
67    error mode setting.  The default is t, to minimize the possibility of
68    subprocesses blocking when accessing unmounted drives.  */
69 Lisp_Object Vmswindows_start_process_inherit_error_mode;
70
71 #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data))
72 \f
73 /*-----------------------------------------------------------------------*/
74 /* Process helpers                                                       */
75 /*-----------------------------------------------------------------------*/
76
77 /* This one breaks process abstraction. Prototype is in console-msw.h,
78    used by select_process method in event-msw.c */
79 HANDLE
80 get_nt_process_handle (Lisp_Process *p)
81 {
82   return (NT_DATA (p)->h_process);
83 }
84
85 static struct Lisp_Process *
86 find_process_from_pid (DWORD pid)
87 {
88   Lisp_Object tail, proc;
89
90   for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail))
91     {
92       proc = XCAR (tail);
93       if (NT_DATA (XPROCESS (proc))->dwProcessId == pid)
94         return XPROCESS (proc);
95     }
96   return 0;
97 }
98
99 \f
100 /*-----------------------------------------------------------------------*/
101 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5   */
102 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
103 /*-----------------------------------------------------------------------*/
104
105 typedef struct
106 {
107   HANDLE h_process;
108   HANDLE h_thread;
109   LPVOID address;
110 } process_memory;
111
112 /*
113  * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
114  * further by other routines. Return nonzero if successful.
115  *
116  * The memory in other process is allocated by creating a suspended
117  * thread. Initial stack of that thread is used as the memory
118  * block. The thread entry point is the routine ExitThread in
119  * kernel32.dll, so the allocated memory is freed just by resuming the 
120  * thread, which immediately terminates after that.
121  */
122
123 static int 
124 alloc_process_memory (HANDLE h_process, size_t size,
125                       process_memory* pmc)
126 {
127   LPTHREAD_START_ROUTINE adr_ExitThread =
128     (LPTHREAD_START_ROUTINE)
129     GetProcAddress (GetModuleHandle ("kernel32"), "ExitThread");
130   DWORD dw_unused;
131   CONTEXT context;
132   MEMORY_BASIC_INFORMATION mbi;
133
134   pmc->h_process = h_process;
135   pmc->h_thread = CreateRemoteThread (h_process, NULL, size,
136                                      adr_ExitThread, NULL,
137                                      CREATE_SUSPENDED, &dw_unused);
138   if (pmc->h_thread == NULL)
139     return 0;
140
141   /* Get context, for thread's stack pointer */
142   context.ContextFlags = CONTEXT_CONTROL;
143   if (!GetThreadContext (pmc->h_thread, &context))
144     goto failure;
145
146   /* Determine base address of the committed range */
147   if (sizeof(mbi) != VirtualQueryEx (h_process,
148 #if defined (_X86_)
149                                      (LPDWORD)context.Esp - 1,
150 #elif defined (_ALPHA_)
151                                      (LPDWORD)context.IntSp - 1,
152 #else
153 #error Unknown processor architecture
154 #endif
155                                      &mbi, sizeof(mbi)))
156     goto failure;
157
158   /* Change the page protection of the allocated memory to executable,
159      read, and write. */
160   if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
161                          PAGE_EXECUTE_READWRITE, &dw_unused))
162     goto failure;
163
164   pmc->address = mbi.BaseAddress;
165   return 1;
166
167  failure:
168   ResumeThread (pmc->h_thread);
169   pmc->address = 0;
170   return 0;
171 }
172
173 static void
174 free_process_memory (process_memory* pmc)
175 {
176   ResumeThread (pmc->h_thread);
177 }
178
179 /*
180  * Run ROUTINE in the context of process determined by H_PROCESS. The
181  * routine is passed the address of DATA as parameter. The ROUTINE must
182  * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of
183  * DATA structure.
184  *
185  * Note that the code must be positionally independent, and compiled
186  * without stack checks (they cause implicit calls into CRT so will
187  * fail). DATA should not refer any data in calling process, as both
188  * routine and its data are copied into remote process. Size of data
189  * and code together should not exceed one page (4K on x86 systems).
190  *
191  * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
192  */
193 static DWORD
194 run_in_other_process (HANDLE h_process,
195                       LPTHREAD_START_ROUTINE routine,
196                       LPVOID data, size_t data_size)
197 {
198   process_memory pm;
199   const size_t code_size = FRAGMENT_CODE_SIZE;
200   /* Need at most 3 extra bytes of memory, for data alignment */
201   size_t total_size = code_size + data_size + 3;
202   LPVOID remote_data;
203   HANDLE h_thread;
204   DWORD dw_unused;
205
206   /* Allocate memory */
207   if (!alloc_process_memory (h_process, total_size, &pm))
208     return (DWORD)-1;
209
210   /* Copy code */
211   if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
212                            code_size, NULL))
213     goto failure;
214
215   /* Copy data */
216   if (data_size)
217     {
218       remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
219       if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
220         goto failure;
221     }
222   else
223     remote_data = NULL;
224
225   /* Execute the remote copy of code, passing it remote data */
226   h_thread = CreateRemoteThread (h_process, NULL, 0,
227                                  (LPTHREAD_START_ROUTINE) pm.address,
228                                  remote_data, 0, &dw_unused);
229   if (h_thread == NULL)
230     goto failure;
231
232   /* Wait till thread finishes */
233   WaitForSingleObject (h_thread, INFINITE);
234
235   /* Free remote memory */
236   free_process_memory (&pm);
237
238   /* Return thread's exit code */
239   {
240     DWORD exit_code;
241     GetExitCodeThread (h_thread, &exit_code);
242     CloseHandle (h_thread);
243     return exit_code;
244   }
245
246  failure:
247   free_process_memory (&pm);
248   return (DWORD)-1;
249 }
250 \f
251 /*-----------------------------------------------------------------------*/
252 /* Sending signals                                                       */
253 /*-----------------------------------------------------------------------*/
254
255 /* ---------------------------- the NT way ------------------------------- */
256
257 /*
258  * We handle the following signals:
259  *
260  * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
261  *    executed by the remote process
262  * SIGINT - The remote process is sent CTRL_BREAK_EVENT
263  *
264  * The MSVC5.0 compiler feels free to re-order functions within a
265  * compilation unit, so we have no way of finding out the size of the
266  * following functions. Therefore these functions must not be larger than
267  * FRAGMENT_CODE_SIZE.
268  */
269
270 /*
271  * Sending SIGKILL
272  */
273 typedef struct
274 {
275   void (WINAPI *adr_ExitProcess) (UINT);
276 } sigkill_data;
277
278 static DWORD WINAPI
279 sigkill_proc (sigkill_data* data)
280 {
281   (*data->adr_ExitProcess)(255);
282   return 1;
283 }
284
285 /*
286  * Sending break or control c
287  */
288 typedef struct
289 {
290   BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
291   DWORD event;
292 } sigint_data;
293
294 static DWORD WINAPI
295 sigint_proc (sigint_data* data)
296 {
297   return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
298 }
299
300 /*
301  * Enabling signals
302  */
303 typedef struct
304 {
305   BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
306 } sig_enable_data;
307
308 static DWORD WINAPI
309 sig_enable_proc (sig_enable_data* data)
310 {
311   (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
312   return 1;
313 }
314
315 /*
316  * Send signal SIGNO to process H_PROCESS.
317  * Return nonzero if successful.
318  */
319
320 static int
321 send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo)
322 {
323   HANDLE h_process;
324   HMODULE h_kernel = GetModuleHandle ("kernel32");
325   int close_process = 0;
326   DWORD retval;
327   
328   assert (h_kernel != NULL);
329   
330   if (cp)
331     {
332       pid = cp->dwProcessId;
333       h_process = cp->h_process;
334     }
335   else
336     {
337       close_process = 1;
338       /* Try to open the process with required privileges */
339       h_process = OpenProcess (PROCESS_CREATE_THREAD
340                                | PROCESS_QUERY_INFORMATION 
341                                | PROCESS_VM_OPERATION
342                                | PROCESS_VM_WRITE,
343                                FALSE, pid);
344       if (!h_process)
345         return 0;
346     }
347
348   switch (signo)
349     {
350     case SIGKILL:
351     case SIGTERM:
352     case SIGQUIT:
353     case SIGHUP:
354       {
355         sigkill_data d;
356
357         d.adr_ExitProcess =
358           (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess");
359         assert (d.adr_ExitProcess);
360         retval = run_in_other_process (h_process, 
361                                        (LPTHREAD_START_ROUTINE)sigkill_proc,
362                                        &d, sizeof (d));
363         break;
364       }
365     case SIGINT:
366       {
367         sigint_data d;
368         d.adr_GenerateConsoleCtrlEvent =
369           (BOOL (WINAPI *) (DWORD, DWORD))
370           GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
371         assert (d.adr_GenerateConsoleCtrlEvent);
372         d.event = CTRL_C_EVENT;
373         retval = run_in_other_process (h_process, 
374                                        (LPTHREAD_START_ROUTINE)sigint_proc,
375                                        &d, sizeof (d));
376         break;
377       }
378     default:
379       assert (0);
380     }
381
382   if (close_process)
383     CloseHandle (h_process);
384   return (int)retval > 0 ? 1 : 0;
385 }
386
387 /*
388  * Enable CTRL_C_EVENT handling in a new child process
389  */
390 static void
391 enable_child_signals (HANDLE h_process)
392 {
393   HMODULE h_kernel = GetModuleHandle ("kernel32");
394   sig_enable_data d;
395   
396   assert (h_kernel != NULL);
397   d.adr_SetConsoleCtrlHandler =
398     (BOOL (WINAPI *) (LPVOID, BOOL))
399     GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
400   assert (d.adr_SetConsoleCtrlHandler);
401   run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
402                         &d, sizeof (d));
403 }
404   
405 #pragma warning (default : 4113)
406
407 /* ---------------------------- the 95 way ------------------------------- */
408
409 static BOOL CALLBACK
410 find_child_console (HWND hwnd, struct nt_process_data *cp)
411 {
412   DWORD thread_id;
413   DWORD process_id;
414
415   thread_id = GetWindowThreadProcessId (hwnd, &process_id);
416   if (process_id == cp->dwProcessId)
417     {
418       char window_class[32];
419
420       GetClassName (hwnd, window_class, sizeof (window_class));
421       if (strcmp (window_class,
422                   msw_windows9x_p ()
423                   ? "tty"
424                   : "ConsoleWindowClass") == 0)
425         {
426           cp->hwnd = hwnd;
427           return FALSE;
428         }
429     }
430   /* keep looking */
431   return TRUE;
432 }
433
434 static int
435 send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo)
436 {
437   HANDLE h_process;
438   int close_process = 0;
439   int rc = 1;
440   
441   if (cp)
442     {
443       pid = cp->dwProcessId;
444       h_process = cp->h_process;
445
446       /* Try to locate console window for process. */
447       EnumWindows (find_child_console, (LPARAM) cp);
448     }
449   else
450     {
451       close_process = 1;
452       /* Try to open the process with required privileges */
453       h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid);
454       if (!h_process)
455         return 0;
456     }
457     
458   if (signo == SIGINT)
459     {
460       if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
461         {
462           BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
463           BYTE vk_break_code = VK_CANCEL;
464           BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
465           HWND foreground_window;
466
467           if (break_scan_code == 0)
468             {
469               /* Fake Ctrl-C if we can't manage Ctrl-Break. */
470               vk_break_code = 'C';
471               break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
472             }
473
474           foreground_window = GetForegroundWindow ();
475           if (foreground_window)
476             {
477               /* NT 5.0, and apparently also Windows 98, will not allow
478                  a Window to be set to foreground directly without the
479                  user's involvement. The workaround is to attach
480                  ourselves to the thread that owns the foreground
481                  window, since that is the only thread that can set the
482                  foreground window.  */
483               DWORD foreground_thread, child_thread;
484               foreground_thread =
485                 GetWindowThreadProcessId (foreground_window, NULL);
486               if (foreground_thread == GetCurrentThreadId ()
487                   || !AttachThreadInput (GetCurrentThreadId (),
488                                          foreground_thread, TRUE))
489                 foreground_thread = 0;
490
491               child_thread = GetWindowThreadProcessId (cp->hwnd, NULL);
492               if (child_thread == GetCurrentThreadId ()
493                   || !AttachThreadInput (GetCurrentThreadId (),
494                                          child_thread, TRUE))
495                 child_thread = 0;
496
497               /* Set the foreground window to the child.  */
498               if (SetForegroundWindow (cp->hwnd))
499                 {
500                   /* Generate keystrokes as if user had typed Ctrl-Break or
501                      Ctrl-C.  */
502                   keybd_event (VK_CONTROL, control_scan_code, 0, 0);
503                   keybd_event (vk_break_code, break_scan_code,
504                     (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0);
505                   keybd_event (vk_break_code, break_scan_code,
506                     (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY)
507                     | KEYEVENTF_KEYUP, 0);
508                   keybd_event (VK_CONTROL, control_scan_code,
509                                KEYEVENTF_KEYUP, 0);
510
511                   /* Sleep for a bit to give time for Emacs frame to respond
512                      to focus change events (if Emacs was active app).  */
513                   Sleep (100);
514
515                   SetForegroundWindow (foreground_window);
516                 }
517               /* Detach from the foreground and child threads now that
518                  the foreground switching is over.  */
519               if (foreground_thread)
520                 AttachThreadInput (GetCurrentThreadId (),
521                                    foreground_thread, FALSE);
522               if (child_thread)
523                 AttachThreadInput (GetCurrentThreadId (),
524                                    child_thread, FALSE);
525             }
526         }
527       /* Ctrl-Break is NT equivalent of SIGINT.  */
528       else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
529         {
530 #if 0 /* FSF Emacs */
531           DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
532                      "for pid %lu\n", GetLastError (), pid));
533           errno = EINVAL;
534 #endif
535           rc = 0;
536         }
537     }
538   else
539     {
540       if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd)
541         {
542 #if 1
543           if (msw_windows9x_p ())
544             {
545 /*
546    Another possibility is to try terminating the VDM out-right by
547    calling the Shell VxD (id 0x17) V86 interface, function #4
548    "SHELL_Destroy_VM", ie.
549
550      mov edx,4
551      mov ebx,vm_handle
552      call shellapi
553
554    First need to determine the current VM handle, and then arrange for
555    the shellapi call to be made from the system vm (by using
556    Switch_VM_and_callback).
557
558    Could try to invoke DestroyVM through CallVxD.
559
560 */
561 #if 0
562               /* On Win95, posting WM_QUIT causes the 16-bit subsystem
563                  to hang when cmdproxy is used in conjunction with
564                  command.com for an interactive shell.  Posting
565                  WM_CLOSE pops up a dialog that, when Yes is selected,
566                  does the same thing.  TerminateProcess is also less
567                  than ideal in that subprocesses tend to stick around
568                  until the machine is shutdown, but at least it
569                  doesn't freeze the 16-bit subsystem.  */
570               PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
571 #endif
572               if (!TerminateProcess (h_process, 0xff))
573                 {
574 #if 0 /* FSF Emacs */
575                   DebPrint (("sys_kill.TerminateProcess returned %d "
576                              "for pid %lu\n", GetLastError (), pid));
577                   errno = EINVAL;
578 #endif
579                   rc = 0;
580                 }
581             }
582           else
583 #endif
584             PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
585         }
586       /* Kill the process.  On W32 this doesn't kill child processes
587          so it doesn't work very well for shells which is why it's not
588          used in every case.  */
589       else if (!TerminateProcess (h_process, 0xff))
590         {
591 #if 0 /* FSF Emacs */
592           DebPrint (("sys_kill.TerminateProcess returned %d "
593                      "for pid %lu\n", GetLastError (), pid));
594           errno = EINVAL;
595 #endif
596           rc = 0;
597         }
598     }
599
600   if (close_process)
601     CloseHandle (h_process);
602
603   return rc;
604 }
605
606 /* -------------------------- all-OS functions ---------------------------- */
607
608 static int
609 send_signal (struct nt_process_data *cp, int pid, int signo)
610 {
611   return send_signal_the_nt_way (cp, pid, signo)
612     || send_signal_the_95_way (cp, pid, signo);
613 }
614
615 /*
616  * Signal error if SIGNO is not supported
617  */
618 static void
619 validate_signal_number (int signo)
620 {
621   if (signo != SIGKILL && signo != SIGTERM
622       && signo != SIGQUIT && signo != SIGINT
623       && signo != SIGHUP)
624     signal_simple_error ("Signal number not supported", make_int (signo));
625 }
626 \f  
627 /*-----------------------------------------------------------------------*/
628 /* Process methods                                                       */
629 /*-----------------------------------------------------------------------*/
630
631 /*
632  * Allocate and initialize Lisp_Process->process_data
633  */
634
635 static void
636 nt_alloc_process_data (Lisp_Process *p)
637 {
638   p->process_data = xnew_and_zero (struct nt_process_data);
639 }
640
641 static void
642 nt_finalize_process_data (Lisp_Process *p, int for_disksave)
643 {
644   assert (!for_disksave);
645   if (NT_DATA (p)->h_process)
646     CloseHandle (NT_DATA (p)->h_process);
647 }
648
649 /*
650  * Initialize XEmacs process implementation once
651  */
652 static void
653 nt_init_process (void)
654 {
655   /* Initialize winsock */
656   WSADATA wsa_data;
657   /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
658   WSAStartup (MAKEWORD (1,1), &wsa_data);
659 }
660
661 /*
662  * Fork off a subprocess. P is a pointer to newly created subprocess
663  * object. If this function signals, the caller is responsible for
664  * deleting (and finalizing) the process object.
665  *
666  * The method must return PID of the new process, a (positive??? ####) number
667  * which fits into Lisp_Int. No return value indicates an error, the method
668  * must signal an error instead.
669  */
670
671 static void
672 signal_cannot_launch (Lisp_Object image_file, DWORD err)
673 {
674   mswindows_set_errno (err);
675   signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno));
676 }
677
678 static void
679 ensure_console_window_exists ()
680 {
681   if (msw_windows9x_p ())
682     msw_hide_console ();
683 }
684
685 static int
686 nt_create_process (Lisp_Process *p,
687                    Lisp_Object *argv, int nargv,
688                    Lisp_Object program, Lisp_Object cur_dir)
689 {
690   HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
691   LPTSTR command_line;
692   BOOL do_io, windowed;
693   char *proc_env;
694
695   /* Find out whether the application is windowed or not */
696   {
697     /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
698        errors. This leads to bogus error message. */
699     DWORD image_type;
700     char *p = strrchr ((char *)XSTRING_DATA (program), '.');
701     if (p != NULL &&
702         (stricmp (p, ".exe") == 0 ||
703          stricmp (p, ".com") == 0 ||
704          stricmp (p, ".bat") == 0 ||
705          stricmp (p, ".cmd") == 0))
706       {
707         image_type = SHGetFileInfo ((char *)XSTRING_DATA (program), 0,NULL,
708                                     0, SHGFI_EXETYPE);
709       }
710     else
711       {
712         char progname[MAX_PATH];
713         sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program));
714         image_type = SHGetFileInfo (progname, 0, NULL, 0, SHGFI_EXETYPE);
715       }
716     if (image_type == 0)
717       signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
718                                       ? ERROR_BAD_FORMAT : GetLastError ()));
719     windowed = HIWORD (image_type) != 0;
720   }
721
722   /* Decide whether to do I/O on process handles, or just mark the
723      process exited immediately upon successful launching. We do I/O if the
724      process is a console one, or if it is windowed but windowed_process_io
725      is non-zero */
726   do_io = !windowed || windowed_process_io ;
727   
728   if (do_io)
729     {
730       /* Create two unidirectional named pipes */
731       HANDLE htmp;
732       SECURITY_ATTRIBUTES sa;
733
734       sa.nLength = sizeof(sa);
735       sa.bInheritHandle = TRUE;
736       sa.lpSecurityDescriptor = NULL;
737
738       CreatePipe (&hprocin, &hmyshove, &sa, 0);
739       CreatePipe (&hmyslurp, &hprocout, &sa, 0);
740
741       /* Duplicate the stdout handle for use as stderr */
742       DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(), &hprocerr,
743         0, TRUE, DUPLICATE_SAME_ACCESS);
744
745       /* Stupid Win32 allows to create a pipe with *both* ends either
746          inheritable or not. We need process ends inheritable, and local
747          ends not inheritable. */
748       DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), &htmp,
749                        0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
750       hmyshove = htmp;
751       DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), &htmp,
752                        0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
753       hmyslurp = htmp;
754     }
755
756   /* Convert an argv vector into Win32 style command line by a call to
757      lisp function `nt-quote-process-args' which see (in winnt.el)*/
758   {
759     int i;
760     Lisp_Object args_or_ret = Qnil;
761     struct gcpro gcpro1;
762
763     GCPRO1 (args_or_ret);
764
765     for (i = 0; i < nargv; ++i)
766       args_or_ret = Fcons (*argv++, args_or_ret);
767     args_or_ret = Fnreverse (args_or_ret);
768     args_or_ret = Fcons (program, args_or_ret);
769
770     args_or_ret = call1 (Qnt_quote_process_args, args_or_ret);
771
772     if (!STRINGP (args_or_ret))
773       /* Luser wrote his/her own clever version */
774       error ("Bogus return value from `nt-quote-process-args'");
775
776     command_line = alloca_array (char, (XSTRING_LENGTH (program)
777                                         + XSTRING_LENGTH (args_or_ret) + 2));
778     strcpy (command_line, XSTRING_DATA (program));
779     strcat (command_line, " ");
780     strcat (command_line, XSTRING_DATA (args_or_ret));
781
782     UNGCPRO; /* args_or_ret */
783   }
784
785   /* Set `proc_env' to a nul-separated array of the strings in
786      Vprocess_environment terminated by 2 nuls.  */
787  
788   {
789     extern int compare_env (const char **strp1, const char **strp2);
790     char **env;
791     REGISTER Lisp_Object tem;
792     REGISTER char **new_env;
793     REGISTER int new_length = 0, i, new_space;
794     char *penv;
795     
796     for (tem = Vprocess_environment;
797          (CONSP (tem)
798           && STRINGP (XCAR (tem)));
799          tem = XCDR (tem))
800       new_length++;
801     
802     /* new_length + 1 to include terminating 0.  */
803     env = new_env = alloca_array (char *, new_length + 1);
804  
805     /* Copy the Vprocess_environment strings into new_env.  */
806     for (tem = Vprocess_environment;
807          (CONSP (tem)
808           && STRINGP (XCAR (tem)));
809          tem = XCDR (tem))
810       {
811         char **ep = env;
812         char *string = (char *) XSTRING_DATA (XCAR (tem));
813         /* See if this string duplicates any string already in the env.
814            If so, don't put it in.
815            When an env var has multiple definitions,
816            we keep the definition that comes first in process-environment.  */
817         for (; ep != new_env; ep++)
818           {
819             char *p = *ep, *q = string;
820             while (1)
821               {
822                 if (*q == 0)
823                   /* The string is malformed; might as well drop it.  */
824                   goto duplicate;
825                 if (*q != *p)
826                   break;
827                 if (*q == '=')
828                   goto duplicate;
829                 p++, q++;
830               }
831           }
832         *new_env++ = string;
833       duplicate: ;
834       }
835     *new_env = 0;
836     
837     /* Sort the environment variables */
838     new_length = new_env - env;
839     qsort (env, new_length, sizeof (char *), compare_env);
840     
841     /* Work out how much space to allocate */
842     new_space = 0;
843     for (i = 0; i < new_length; i++)
844       {
845         new_space += strlen(env[i]) + 1;
846       }
847     new_space++;
848     
849     /* Allocate space and copy variables into it */
850     penv = proc_env = (char*) alloca(new_space);
851     for (i = 0; i < new_length; i++)
852       {
853         strcpy(penv, env[i]);
854         penv += strlen(env[i]) + 1;
855       }
856     *penv = 0;
857   }
858   
859   /* Create process */
860   {
861     STARTUPINFO si;
862     PROCESS_INFORMATION pi;
863     DWORD err;
864     DWORD flags;
865
866     xzero (si);
867     si.dwFlags = STARTF_USESHOWWINDOW;
868     si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
869     if (do_io)
870       {
871         si.hStdInput = hprocin;
872         si.hStdOutput = hprocout;
873         si.hStdError = hprocerr;
874         si.dwFlags |= STARTF_USESTDHANDLES;
875       }
876
877     flags = CREATE_SUSPENDED;
878     if (msw_windows9x_p ())
879       flags |= (!NILP (Vmswindows_start_process_share_console)
880                 ? CREATE_NEW_PROCESS_GROUP
881                 : CREATE_NEW_CONSOLE);
882     else
883       flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
884     if (NILP (Vmswindows_start_process_inherit_error_mode))
885       flags |= CREATE_DEFAULT_ERROR_MODE;
886
887     ensure_console_window_exists ();
888
889     err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, flags,
890                           proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
891            ? 0 : GetLastError ());
892
893     if (do_io)
894       {
895         /* These just have been inherited; we do not need a copy */
896         CloseHandle (hprocin);
897         CloseHandle (hprocout);
898         CloseHandle (hprocerr);
899       }
900     
901     /* Handle process creation failure */
902     if (err)
903       {
904         if (do_io)
905           {
906             CloseHandle (hmyshove);
907             CloseHandle (hmyslurp);
908           }
909         signal_cannot_launch (program, GetLastError ());
910       }
911
912     /* The process started successfully */
913     if (do_io)
914       {
915         NT_DATA(p)->h_process = pi.hProcess;
916         NT_DATA(p)->dwProcessId = pi.dwProcessId;
917         init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
918       }
919     else
920       {
921         /* Indicate as if the process has exited immediately. */
922         p->status_symbol = Qexit;
923         CloseHandle (pi.hProcess);
924       }
925
926     ResumeThread (pi.hThread);
927     CloseHandle (pi.hThread);
928
929     /* Remember to enable child signals later if this is not a windowed
930        app.  Can't do it right now because that screws up the MKS Toolkit
931        shell. */
932     if (!windowed)
933       {
934         NT_DATA(p)->need_enable_child_signals = 10;
935         kick_status_notify ();
936       }
937
938     return ((int)pi.dwProcessId);
939   }
940 }
941
942 /* 
943  * This method is called to update status fields of the process
944  * structure. If the process has not existed, this method is expected
945  * to do nothing.
946  *
947  * The method is called only for real child processes.  
948  */
949
950 static void
951 nt_update_status_if_terminated (Lisp_Process* p)
952 {
953   DWORD exit_code;
954
955   if (NT_DATA(p)->need_enable_child_signals > 1)
956     {
957       NT_DATA(p)->need_enable_child_signals -= 1;
958       kick_status_notify ();
959     }
960   else if (NT_DATA(p)->need_enable_child_signals == 1)
961     {
962       enable_child_signals(NT_DATA(p)->h_process);
963       NT_DATA(p)->need_enable_child_signals = 0;
964     }
965
966   if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
967       && exit_code != STILL_ACTIVE)
968     {
969       p->tick++;
970       p->core_dumped = 0;
971       /* The exit code can be a code returned by process, or an
972          NTSTATUS value. We cannot accurately handle the latter since
973          it is a full 32 bit integer */
974       if (exit_code & 0xC0000000)
975         {
976           p->status_symbol = Qsignal;
977           p->exit_code = exit_code & 0x1FFFFFFF;
978         }
979       else
980         {
981           p->status_symbol = Qexit;
982           p->exit_code = exit_code;
983         }
984     }
985 }
986
987 /*
988  * Stuff the entire contents of LSTREAM to the process output pipe
989  */
990
991 /* #### If only this function could be somehow merged with
992    unix_send_process... */
993
994 static void
995 nt_send_process (Lisp_Object proc, struct lstream* lstream)
996 {
997   volatile Lisp_Object vol_proc = proc;
998   Lisp_Process *volatile p = XPROCESS (proc);
999
1000   /* use a reasonable-sized buffer (somewhere around the size of the
1001      stream buffer) so as to avoid inundating the stream with blocked
1002      data. */
1003   Bufbyte chunkbuf[128];
1004   Bytecount chunklen;
1005
1006   while (1)
1007     {
1008       ssize_t writeret;
1009
1010       chunklen = Lstream_read (lstream, chunkbuf, 128);
1011       if (chunklen <= 0)
1012         break; /* perhaps should abort() if < 0?
1013                   This should never happen. */
1014
1015       /* Lstream_write() will never successfully write less than the
1016          amount sent in.  In the worst case, it just buffers the
1017          unwritten data. */
1018       writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
1019                                 chunklen);
1020       Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
1021       if (writeret < 0)
1022         {
1023           p->status_symbol = Qexit;
1024           p->exit_code = ERROR_BROKEN_PIPE;
1025           p->core_dumped = 0;
1026           p->tick++;
1027           process_tick++;
1028           deactivate_process (*((Lisp_Object *) (&vol_proc)));
1029           error ("Broken pipe error sending to process %s; closed it",
1030                  XSTRING_DATA (p->name));
1031         }
1032
1033       {
1034         int wait_ms = 25;
1035         while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
1036           {
1037             /* Buffer is full.  Wait, accepting input; that may allow
1038                the program to finish doing output and read more.  */
1039             Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
1040             Lstream_flush (XLSTREAM (p->pipe_outstream));
1041             wait_ms = min (1000, 2 * wait_ms);
1042           }
1043       }
1044     }
1045 }
1046
1047 /*
1048  * Send a signal number SIGNO to PROCESS.
1049  * CURRENT_GROUP means send to the process group that currently owns
1050  * the terminal being used to communicate with PROCESS.
1051  * This is used for various commands in shell mode.
1052  * If NOMSG is zero, insert signal-announcements into process's buffers
1053  * right away.
1054  *
1055  * If we can, we try to signal PROCESS by sending control characters
1056  * down the pty.  This allows us to signal inferiors who have changed
1057  * their uid, for which killpg would return an EPERM error.
1058  *
1059  * The method signals an error if the given SIGNO is not valid
1060  */
1061
1062 static void
1063 nt_kill_child_process (Lisp_Object proc, int signo,
1064                        int current_group, int nomsg)
1065 {
1066   Lisp_Process *p = XPROCESS (proc);
1067
1068   /* Enable child signals if necessary.  This may lose the first
1069      but it's better than nothing. */
1070   if (NT_DATA (p)->need_enable_child_signals > 0)
1071     {
1072       enable_child_signals (NT_DATA(p)->h_process);
1073       NT_DATA (p)->need_enable_child_signals = 0;
1074     }
1075
1076   /* Signal error if SIGNO cannot be sent */
1077   validate_signal_number (signo);
1078
1079   /* Send signal */
1080   if (!send_signal (NT_DATA (p), 0, signo))
1081     signal_simple_error ("Cannot send signal to process", proc);
1082 }
1083
1084 /*
1085  * Kill any process in the system given its PID.
1086  *
1087  * Returns zero if a signal successfully sent, or
1088  * negative number upon failure
1089  */
1090 static int
1091 nt_kill_process_by_pid (int pid, int signo)
1092 {
1093   struct Lisp_Process *p;
1094
1095   /* Signal error if SIGNO cannot be sent */
1096   validate_signal_number (signo);
1097
1098   p = find_process_from_pid (pid);
1099   return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1;
1100 }
1101 \f
1102 /*-----------------------------------------------------------------------*/
1103 /* Sockets connections                                                   */
1104 /*-----------------------------------------------------------------------*/
1105 #ifdef HAVE_SOCKETS
1106
1107 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
1108
1109 #define SOCK_TIMER_ID 666
1110 #define XM_SOCKREPLY (WM_USER + 666)
1111
1112 static int
1113 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
1114                       Error_behavior errb)
1115 {
1116   char buf [MAXGETHOSTSTRUCT];
1117   HWND hwnd;
1118   HANDLE hasync;
1119   int success = 0;
1120
1121   address->sin_family = AF_INET;
1122
1123   /* First check if HOST is already a numeric address */
1124   {
1125     unsigned long inaddr = inet_addr (XSTRING_DATA (host));
1126     if (inaddr != INADDR_NONE)
1127       {
1128         address->sin_addr.s_addr = inaddr;
1129         return 1;
1130       }
1131   }
1132
1133   /* Create a window which will receive completion messages */
1134   hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
1135                        NULL, NULL, NULL, NULL);
1136   assert (hwnd);
1137
1138   /* Post name resolution request */
1139   hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
1140                                   buf, sizeof (buf));
1141   if (hasync == NULL)
1142     goto done;
1143
1144   /* Set a timer to poll for quit every 250 ms */
1145   SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
1146
1147   while (1)
1148     {
1149       MSG msg;
1150       GetMessage (&msg, hwnd, 0, 0);
1151       if (msg.message == XM_SOCKREPLY)
1152         {
1153           /* Ok, got an answer */
1154           if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
1155             success = 1;
1156           else
1157             {
1158               warn_when_safe(Qstream, Qwarning,
1159                              "cannot get IP address for host \"%s\"",
1160                              XSTRING_DATA (host));
1161             }
1162           goto done;
1163         }
1164       else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
1165         {
1166           if (QUITP)
1167             {
1168               WSACancelAsyncRequest (hasync);
1169               KillTimer (hwnd, SOCK_TIMER_ID);
1170               DestroyWindow (hwnd);
1171               REALLY_QUIT;
1172             }
1173         }
1174       DispatchMessage (&msg);
1175     }
1176
1177  done:
1178   KillTimer (hwnd, SOCK_TIMER_ID);
1179   DestroyWindow (hwnd);
1180   if (success)
1181     {
1182       /* BUF starts with struct hostent */
1183       struct hostent* he = (struct hostent*) buf;
1184       address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
1185     }
1186   return success;
1187 }
1188
1189 static Lisp_Object
1190 nt_canonicalize_host_name (Lisp_Object host)
1191 {
1192   struct sockaddr_in address;
1193
1194   if (!get_internet_address (host, &address, ERROR_ME_NOT))
1195     return host;
1196
1197   if (address.sin_family == AF_INET)
1198     return build_string (inet_ntoa (address.sin_addr));
1199   else
1200     return host;
1201 }
1202
1203 /* open a TCP network connection to a given HOST/SERVICE.  Treated
1204    exactly like a normal process when reading and writing.  Only
1205    differences are in status display and process deletion.  A network
1206    connection has no PID; you cannot signal it.  All you can do is
1207    deactivate and close it via delete-process */
1208
1209 static void
1210 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
1211                         Lisp_Object service,
1212                         Lisp_Object protocol, void** vinfd, void** voutfd)
1213 {
1214   /* !!#### not Mule-ized */
1215   struct sockaddr_in address;
1216   SOCKET s;
1217   int port;
1218   int retval;
1219
1220   CHECK_STRING (host);
1221
1222   if (!EQ (protocol, Qtcp))
1223     signal_simple_error ("Unsupported protocol", protocol);
1224
1225   if (INTP (service))
1226     port = htons ((unsigned short) XINT (service));
1227   else
1228     {
1229       struct servent *svc_info;
1230       CHECK_STRING (service);
1231       svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
1232       if (svc_info == 0)
1233         signal_simple_error ("Unknown service", service);
1234       port = svc_info->s_port;
1235     }
1236
1237   get_internet_address (host, &address, ERROR_ME);
1238   address.sin_port = port;
1239
1240   s = socket (address.sin_family, SOCK_STREAM, 0);
1241   if (s < 0)
1242     report_file_error ("error creating socket", list1 (name));
1243
1244   /* We don't want to be blocked on connect */
1245   {
1246     unsigned long nonblock = 1;
1247     ioctlsocket (s, FIONBIO, &nonblock);
1248   }
1249   
1250   retval = connect (s, (struct sockaddr *) &address, sizeof (address));
1251   if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
1252     goto connect_failed;
1253   /* Wait while connection is established */
1254   while (1)
1255     {
1256       fd_set fdset;
1257       struct timeval tv;
1258       int nsel;
1259
1260       if (QUITP)
1261         {
1262           closesocket (s);
1263           REALLY_QUIT;
1264         }
1265
1266       /* Poll for quit every 250 ms */
1267       tv.tv_sec = 0;
1268       tv.tv_usec = 250 * 1000;
1269
1270       FD_ZERO (&fdset);
1271       FD_SET (s, &fdset);
1272       nsel = select (0, NULL, &fdset, &fdset, &tv);
1273
1274       if (nsel > 0)
1275         {
1276           /* Check: was connection successful or not? */
1277           tv.tv_usec = 0;
1278           nsel = select (0, NULL, NULL, &fdset, &tv);
1279           if (nsel > 0)
1280             goto connect_failed;
1281           else
1282             break;
1283         }
1284     }
1285
1286   /* We are connected at this point */
1287   *vinfd = (void*)s;
1288   DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
1289                    GetCurrentProcess(), (LPHANDLE)voutfd,
1290                    0, FALSE, DUPLICATE_SAME_ACCESS);
1291   return;
1292
1293  connect_failed:  
1294   closesocket (s);
1295   if (INTP (service))
1296     {
1297       warn_when_safe (Qstream, Qwarning,
1298                       "failure to open network stream to host \"%s\" for service \"%d\"",
1299                       XSTRING_DATA (host),
1300                       (unsigned short) XINT (service));
1301     }
1302   else
1303     {
1304       warn_when_safe (Qstream, Qwarning,
1305                       "failure to open network stream to host \"%s\" for service \"%s\"",
1306                       XSTRING_DATA (host),
1307                       XSTRING_DATA (service));
1308     }
1309   report_file_error ("connection failed", list2 (host, name));
1310 }
1311
1312 #endif
1313 \f
1314 /*-----------------------------------------------------------------------*/
1315 /* Initialization                                                        */
1316 /*-----------------------------------------------------------------------*/
1317
1318 void
1319 process_type_create_nt (void)
1320 {
1321   PROCESS_HAS_METHOD (nt, alloc_process_data);
1322   PROCESS_HAS_METHOD (nt, finalize_process_data);
1323   PROCESS_HAS_METHOD (nt, init_process);
1324   PROCESS_HAS_METHOD (nt, create_process);
1325   PROCESS_HAS_METHOD (nt, update_status_if_terminated);
1326   PROCESS_HAS_METHOD (nt, send_process);
1327   PROCESS_HAS_METHOD (nt, kill_child_process);
1328   PROCESS_HAS_METHOD (nt, kill_process_by_pid);
1329 #ifdef HAVE_SOCKETS
1330   PROCESS_HAS_METHOD (nt, canonicalize_host_name);
1331   PROCESS_HAS_METHOD (nt, open_network_stream);
1332 #ifdef HAVE_MULTICAST
1333 #error I won't do this until '95 has winsock2
1334   PROCESS_HAS_METHOD (nt, open_multicast_group);
1335 #endif
1336 #endif
1337 }
1338
1339 void
1340 syms_of_process_nt (void)
1341 {
1342   defsymbol (&Qnt_quote_process_args, "nt-quote-process-args");
1343 }
1344
1345 void
1346 vars_of_process_nt (void)
1347 {
1348   DEFVAR_LISP ("mswindows-start-process-share-console",
1349                &Vmswindows_start_process_share_console /*
1350 When nil, new child processes are given a new console.
1351 When non-nil, they share the Emacs console; this has the limitation of
1352 allowing only only DOS subprocess to run at a time (whether started directly
1353 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
1354 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
1355 otherwise respond to interrupts from Emacs.
1356 */ );
1357   Vmswindows_start_process_share_console = Qnil;
1358
1359   DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
1360                &Vmswindows_start_process_inherit_error_mode /*
1361     "When nil, new child processes revert to the default error mode.
1362 When non-nil, they inherit their error mode setting from Emacs, which stops
1363 them blocking when trying to access unmounted drives etc.
1364 */ );
1365   Vmswindows_start_process_inherit_error_mode = Qt;
1366 }