import -ko -b 1.1.3 XEmacs XEmacs-21_2 r21-2-35
[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 "buffer.h"
30 #include "console-msw.h"
31 #include "hash.h"
32 #include "lstream.h"
33 #include "nt.h"
34 #include "process.h"
35 #include "procimpl.h"
36 #include "sysdep.h"
37
38 #include <shellapi.h>
39 #include <errno.h>
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 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
49 struct nt_process_data
50 {
51   HANDLE h_process;
52   DWORD dwProcessId;
53   HWND hwnd; /* console window */
54 };
55
56 /* Control how args are quoted to ensure correct parsing by child
57    process. */
58 Lisp_Object Vmswindows_quote_process_args;
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                   mswindows_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 (mswindows_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 (void)
680 {
681   if (mswindows_windows9x_p ())
682     mswindows_hide_console ();
683 }
684
685 int
686 compare_env (const void *strp1, const void *strp2)
687 {
688   const char *str1 = *(const char**)strp1, *str2 = *(const char**)strp2;
689
690   while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
691     {
692       if ((*str1) > (*str2))
693         return 1;
694       else if ((*str1) < (*str2))
695         return -1;
696       str1++, str2++;
697     }
698
699   if (*str1 == '=' && *str2 == '=')
700     return 0;
701   else if (*str1 == '=')
702     return -1;
703   else
704     return 1;
705 }
706
707 static int
708 nt_create_process (Lisp_Process *p,
709                    Lisp_Object *argv, int nargv,
710                    Lisp_Object program, Lisp_Object cur_dir)
711 {
712   /* Synched up with sys_spawnve in FSF 20.6.  Significantly different
713      but still synchable. */
714   HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
715   Extbyte *command_line;
716   BOOL do_io, windowed;
717   char *proc_env;
718
719   /* No need to DOS-ize the filename; expand-file-name (called prior)
720      already does this. */
721
722   /* Find out whether the application is windowed or not */
723   {
724     /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
725        errors. This leads to bogus error message. */
726     DWORD image_type;
727     char *p = strrchr ((char *)XSTRING_DATA (program), '.');
728     if (p != NULL &&
729         (stricmp (p, ".exe") == 0 ||
730          stricmp (p, ".com") == 0 ||
731          stricmp (p, ".bat") == 0 ||
732          stricmp (p, ".cmd") == 0))
733       {
734         image_type = SHGetFileInfo ((char *)XSTRING_DATA (program), 0,NULL,
735                                     0, SHGFI_EXETYPE);
736       }
737     else
738       {
739         char progname[MAX_PATH];
740         sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program));
741         image_type = SHGetFileInfo (progname, 0, NULL, 0, SHGFI_EXETYPE);
742       }
743     if (image_type == 0)
744       signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
745                                       ? ERROR_BAD_FORMAT : GetLastError ()));
746     windowed = HIWORD (image_type) != 0;
747   }
748
749   /* Decide whether to do I/O on process handles, or just mark the
750      process exited immediately upon successful launching. We do I/O if the
751      process is a console one, or if it is windowed but windowed_process_io
752      is non-zero */
753   do_io = !windowed || windowed_process_io ;
754   
755   if (do_io)
756     {
757       /* Create two unidirectional named pipes */
758       HANDLE htmp;
759       SECURITY_ATTRIBUTES sa;
760
761       sa.nLength = sizeof(sa);
762       sa.bInheritHandle = TRUE;
763       sa.lpSecurityDescriptor = NULL;
764
765       CreatePipe (&hprocin, &hmyshove, &sa, 0);
766       CreatePipe (&hmyslurp, &hprocout, &sa, 0);
767
768       /* Duplicate the stdout handle for use as stderr */
769       DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(),
770                       &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
771
772       /* Stupid Win32 allows to create a pipe with *both* ends either
773          inheritable or not. We need process ends inheritable, and local
774          ends not inheritable. */
775       DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
776                        &htmp, 0, FALSE,
777                        DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
778       hmyshove = htmp;
779       DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
780                        &htmp, 0, FALSE,
781                        DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
782       hmyslurp = htmp;
783     }
784
785   /* Convert an argv vector into Win32 style command line. */
786   {
787     int i;
788     Bufbyte **quoted_args;
789     int is_dos_app, is_cygnus_app;
790     int is_command_shell;
791     int do_quoting = 0;
792     char escape_char = 0;
793
794     nargv++; /* include program; we access argv offset by 1 below */
795     quoted_args = alloca_array (Bufbyte *, nargv);
796
797     /* Determine whether program is a 16-bit DOS executable, or a Win32
798        executable that is implicitly linked to the Cygnus dll (implying it
799        was compiled with the Cygnus GNU toolchain and hence relies on
800        cygwin.dll to parse the command line - we use this to decide how to
801        escape quote chars in command line args that must be quoted). */
802     mswindows_executable_type (XSTRING_DATA (program),
803                                &is_dos_app, &is_cygnus_app);
804
805     {
806       /* #### Bleeeeeeeeeeeeeeeeech!!!!  The command shells appear to
807          use '^' as a quote character, at least under NT.  #### I haven't
808          tested 95.  If it allows no quoting conventions at all, set
809          escape_char to 0 and the code below will work. (e.g. NT tolerates
810          no quoting -- this command
811
812          cmd /c "ls "/Program Files""
813
814          actually works.) */
815          
816       struct gcpro gcpro1, gcpro2;
817       Lisp_Object progname = Qnil;
818
819       GCPRO2 (program, progname);
820       progname = Ffile_name_nondirectory (program);
821       progname = Fdowncase (progname, Qnil);
822
823       is_command_shell =
824         internal_equal (progname, build_string ("command.com"), 0)
825         || internal_equal (progname, build_string ("cmd.exe"), 0);
826       UNGCPRO;
827     }
828         
829 #if 0
830     /* #### we need to port this. */
831     /* On Windows 95, if cmdname is a DOS app, we invoke a helper
832        application to start it by specifying the helper app as cmdname,
833        while leaving the real app name as argv[0].  */
834     if (is_dos_app)
835       {
836         cmdname = (char*) alloca (MAXPATHLEN);
837         if (egetenv ("CMDPROXY"))
838           strcpy ((char*)cmdname, egetenv ("CMDPROXY"));
839         else
840           {
841             strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory));
842             strcat ((char*)cmdname, "cmdproxy.exe");
843           }
844       }
845 #endif
846   
847     /* we have to do some conjuring here to put argv and envp into the
848        form CreateProcess wants...  argv needs to be a space separated/null
849        terminated list of parameters, and envp is a null
850        separated/double-null terminated list of parameters.
851
852        Additionally, zero-length args and args containing whitespace or
853        quote chars need to be wrapped in double quotes - for this to work,
854        embedded quotes need to be escaped as well.  The aim is to ensure
855        the child process reconstructs the argv array we start with
856        exactly, so we treat quotes at the beginning and end of arguments
857        as embedded quotes.
858
859        The Win32 GNU-based library from Cygnus doubles quotes to escape
860        them, while MSVC uses backslash for escaping.  (Actually the MSVC
861        startup code does attempt to recognize doubled quotes and accept
862        them, but gets it wrong and ends up requiring three quotes to get a
863        single embedded quote!)  So by default we decide whether to use
864        quote or backslash as the escape character based on whether the
865        binary is apparently a Cygnus compiled app.
866
867        Note that using backslash to escape embedded quotes requires
868        additional special handling if an embedded quote is already
869        preceded by backslash, or if an arg requiring quoting ends with
870        backslash.  In such cases, the run of escape characters needs to be
871        doubled.  For consistency, we apply this special handling as long
872        as the escape character is not quote.
873    
874        Since we have no idea how large argv and envp are likely to be we
875        figure out list lengths on the fly and allocate them.  */
876   
877     if (!NILP (Vmswindows_quote_process_args))
878       {
879         do_quoting = 1;
880         /* Override escape char by binding mswindows-quote-process-args to
881            desired character, or use t for auto-selection.  */
882         if (INTP (Vmswindows_quote_process_args))
883           escape_char = (char) XINT (Vmswindows_quote_process_args);
884         else
885           escape_char = is_command_shell ? '^' : is_cygnus_app ? '"' : '\\';
886       }
887   
888     /* do argv...  */
889     for (i = 0; i < nargv; ++i)
890       {
891         Bufbyte *targ = XSTRING_DATA (i == 0 ? program : argv[i - 1]);
892         Bufbyte *p = targ;
893         int need_quotes = 0;
894         int escape_char_run = 0;
895         int arglen = 0;
896
897         if (*p == 0)
898           need_quotes = 1;
899         for ( ; *p; p++)
900           {
901             if (*p == '"')
902               {
903                 /* allow for embedded quotes to be escaped */
904                 if (escape_char)
905                   arglen++;
906                 need_quotes = 1;
907                 /* handle the case where the embedded quote is already escaped */
908                 if (escape_char_run > 0)
909                   {
910                     /* To preserve the arg exactly, we need to double the
911                        preceding escape characters (plus adding one to
912                        escape the quote character itself).  */
913                     arglen += escape_char_run;
914                   }
915               }
916             else if (*p == ' ' || *p == '\t')
917               {
918                 need_quotes = 1;
919               }
920
921             if (escape_char && *p == escape_char && escape_char != '"')
922               escape_char_run++;
923             else
924               escape_char_run = 0;
925           }
926         if (need_quotes)
927           {
928             arglen += 2;
929             /* handle the case where the arg ends with an escape char - we
930                must not let the enclosing quote be escaped.  */
931             if (escape_char_run > 0)
932               arglen += escape_char_run;
933           }
934         arglen += strlen (targ) + 1;
935
936         quoted_args[i] = alloca_array (Bufbyte, arglen); 
937       }
938
939     for (i = 0; i < nargv; ++i)
940       {
941         Bufbyte *targ = XSTRING_DATA (i == 0 ? program : argv[i - 1]);
942         Bufbyte *p = targ;
943         int need_quotes = 0;
944         Bufbyte *parg = quoted_args[i];
945
946         if (*p == 0)
947           need_quotes = 1;
948
949         if (do_quoting)
950           {
951             for ( ; *p; p++)
952               if (*p == ' ' || *p == '\t' || *p == '"')
953                 need_quotes = 1;
954           }
955         if (need_quotes)
956           {
957             int escape_char_run = 0;
958             Bufbyte * first;
959             Bufbyte * last;
960
961             p = targ;
962             first = p;
963             last = p + strlen (p) - 1;
964             *parg++ = '"';
965 #if 0
966             /* This version does not escape quotes if they occur at the
967                beginning or end of the arg - this could lead to incorrect
968                behavior when the arg itself represents a command line
969                containing quoted args.  I believe this was originally done
970                as a hack to make some things work, before
971                `mswindows-quote-process-args' was added.  */
972             while (*p)
973               {
974                 if (*p == '"' && p > first && p < last)
975                   *parg++ = escape_char;        /* escape embedded quotes */
976                 *parg++ = *p++;
977               }
978 #else
979             for ( ; *p; p++)
980               {
981                 if (escape_char && *p == '"')
982                   {
983                     /* double preceding escape chars if any */
984                     while (escape_char_run > 0)
985                       {
986                         *parg++ = escape_char;
987                         escape_char_run--;
988                       }
989                     /* escape all quote chars, even at beginning or end */
990                     *parg++ = escape_char;
991                   }
992                 *parg++ = *p;
993
994                 if (escape_char && *p == escape_char && escape_char != '"')
995                   escape_char_run++;
996                 else
997                   escape_char_run = 0;
998               }
999             /* double escape chars before enclosing quote */
1000             while (escape_char_run > 0)
1001               {
1002                 *parg++ = escape_char;
1003                 escape_char_run--;
1004               }
1005 #endif
1006             *parg++ = '"';
1007           }
1008         else
1009           {
1010             strcpy (parg, targ);
1011             parg += strlen (targ);
1012           }
1013         *parg = '\0';
1014       }
1015
1016     {
1017       int total_cmdline_len = 0;
1018       Extcount *extargcount = (Extcount *) alloca_array (Extcount, nargv);
1019       Extbyte **extarg = (Extbyte **) alloca_array (Extbyte *, nargv);
1020       Extbyte *command_ptr;
1021
1022       for (i = 0; i < nargv; ++i)
1023         {
1024           TO_EXTERNAL_FORMAT (C_STRING, quoted_args[i], ALLOCA,
1025                               (extarg[i], extargcount[i]), Qmswindows_tstr);
1026           /* account for space and terminating null */
1027           total_cmdline_len += extargcount[i] + EITCHAR_SIZE;
1028         }
1029
1030       command_line = alloca_array (char, total_cmdline_len);
1031       command_ptr = command_line;
1032       for (i = 0; i < nargv; ++i)
1033         {
1034           memcpy (command_ptr, extarg[i], extargcount[i]);
1035           command_ptr += extargcount[i];
1036           EICOPY_TCHAR (command_ptr, ' ');
1037           command_ptr += EITCHAR_SIZE;
1038         }
1039       EICOPY_TCHAR (command_ptr, '\0');
1040       command_ptr += EITCHAR_SIZE;
1041     }
1042   }
1043   /* Set `proc_env' to a nul-separated array of the strings in
1044      Vprocess_environment terminated by 2 nuls.  */
1045  
1046   {
1047     char **env;
1048     REGISTER Lisp_Object tem;
1049     REGISTER char **new_env;
1050     REGISTER int new_length = 0, i, new_space;
1051     char *penv;
1052     
1053     for (tem = Vprocess_environment;
1054          (CONSP (tem)
1055           && STRINGP (XCAR (tem)));
1056          tem = XCDR (tem))
1057       new_length++;
1058
1059     /* FSF adds an extra env var to hold the current process ID of the
1060        Emacs process.  Apparently this is used only by emacsserver.c,
1061        which we have superseded to gnuserv.c. (#### Does it work under
1062        MS Windows?)
1063
1064        sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", 
1065          GetCurrentProcessId ());
1066        arglen += strlen (ppid_env_var_buffer) + 1;
1067        numenv++;
1068     */
1069     
1070     /* new_length + 1 to include terminating 0.  */
1071     env = new_env = alloca_array (char *, new_length + 1);
1072  
1073     /* Copy the Vprocess_environment strings into new_env.  */
1074     for (tem = Vprocess_environment;
1075          (CONSP (tem)
1076           && STRINGP (XCAR (tem)));
1077          tem = XCDR (tem))
1078       {
1079         char **ep = env;
1080         char *string = (char *) XSTRING_DATA (XCAR (tem));
1081         /* See if this string duplicates any string already in the env.
1082            If so, don't put it in.
1083            When an env var has multiple definitions,
1084            we keep the definition that comes first in process-environment.  */
1085         for (; ep != new_env; ep++)
1086           {
1087             char *p = *ep, *q = string;
1088             while (1)
1089               {
1090                 if (*q == 0)
1091                   /* The string is malformed; might as well drop it.  */
1092                   goto duplicate;
1093                 if (*q != *p)
1094                   break;
1095                 if (*q == '=')
1096                   goto duplicate;
1097                 p++, q++;
1098               }
1099           }
1100         *new_env++ = string;
1101       duplicate: ;
1102       }
1103     *new_env = 0;
1104     
1105     /* Sort the environment variables */
1106     new_length = new_env - env;
1107     qsort (env, new_length, sizeof (char *), compare_env);
1108     
1109     /* Work out how much space to allocate */
1110     new_space = 0;
1111     for (i = 0; i < new_length; i++)
1112       {
1113         new_space += strlen(env[i]) + 1;
1114       }
1115     new_space++;
1116     
1117     /* Allocate space and copy variables into it */
1118     penv = proc_env = (char*) alloca(new_space);
1119     for (i = 0; i < new_length; i++)
1120       {
1121         strcpy(penv, env[i]);
1122         penv += strlen(env[i]) + 1;
1123       }
1124     *penv = 0;
1125   }
1126   
1127   /* Create process */
1128   {
1129     STARTUPINFO si;
1130     PROCESS_INFORMATION pi;
1131     DWORD err;
1132     DWORD flags;
1133
1134     xzero (si);
1135     si.dwFlags = STARTF_USESHOWWINDOW;
1136     si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
1137     if (do_io)
1138       {
1139         si.hStdInput = hprocin;
1140         si.hStdOutput = hprocout;
1141         si.hStdError = hprocerr;
1142         si.dwFlags |= STARTF_USESTDHANDLES;
1143       }
1144
1145     flags = CREATE_SUSPENDED;
1146     if (mswindows_windows9x_p ())
1147       flags |= (!NILP (Vmswindows_start_process_share_console)
1148                 ? CREATE_NEW_PROCESS_GROUP
1149                 : CREATE_NEW_CONSOLE);
1150     else
1151       flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
1152     if (NILP (Vmswindows_start_process_inherit_error_mode))
1153       flags |= CREATE_DEFAULT_ERROR_MODE;
1154
1155     ensure_console_window_exists ();
1156
1157     err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE, flags,
1158                           proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
1159            ? 0 : GetLastError ());
1160
1161     if (do_io)
1162       {
1163         /* These just have been inherited; we do not need a copy */
1164         CloseHandle (hprocin);
1165         CloseHandle (hprocout);
1166         CloseHandle (hprocerr);
1167       }
1168     
1169     /* Handle process creation failure */
1170     if (err)
1171       {
1172         if (do_io)
1173           {
1174             CloseHandle (hmyshove);
1175             CloseHandle (hmyslurp);
1176           }
1177         signal_cannot_launch (program, GetLastError ());
1178       }
1179
1180     /* The process started successfully */
1181     if (do_io)
1182       {
1183         NT_DATA(p)->h_process = pi.hProcess;
1184         NT_DATA(p)->dwProcessId = pi.dwProcessId;
1185         init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
1186       }
1187     else
1188       {
1189         /* Indicate as if the process has exited immediately. */
1190         p->status_symbol = Qexit;
1191         CloseHandle (pi.hProcess);
1192       }
1193
1194     if (!windowed)
1195       enable_child_signals (pi.hProcess);
1196
1197     ResumeThread (pi.hThread);
1198     CloseHandle (pi.hThread);
1199
1200     return ((int)pi.dwProcessId);
1201   }
1202 }
1203
1204 /* 
1205  * This method is called to update status fields of the process
1206  * structure. If the process has not existed, this method is expected
1207  * to do nothing.
1208  *
1209  * The method is called only for real child processes.  
1210  */
1211
1212 static void
1213 nt_update_status_if_terminated (Lisp_Process* p)
1214 {
1215   DWORD exit_code;
1216   if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
1217       && exit_code != STILL_ACTIVE)
1218     {
1219       p->tick++;
1220       p->core_dumped = 0;
1221       /* The exit code can be a code returned by process, or an
1222          NTSTATUS value. We cannot accurately handle the latter since
1223          it is a full 32 bit integer */
1224       if (exit_code & 0xC0000000)
1225         {
1226           p->status_symbol = Qsignal;
1227           p->exit_code = exit_code & 0x1FFFFFFF;
1228         }
1229       else
1230         {
1231           p->status_symbol = Qexit;
1232           p->exit_code = exit_code;
1233         }
1234     }
1235 }
1236
1237 /*
1238  * Stuff the entire contents of LSTREAM to the process output pipe
1239  */
1240
1241 /* #### If only this function could be somehow merged with
1242    unix_send_process... */
1243
1244 static void
1245 nt_send_process (Lisp_Object proc, struct lstream* lstream)
1246 {
1247   volatile Lisp_Object vol_proc = proc;
1248   Lisp_Process *volatile p = XPROCESS (proc);
1249
1250   /* use a reasonable-sized buffer (somewhere around the size of the
1251      stream buffer) so as to avoid inundating the stream with blocked
1252      data. */
1253   Bufbyte chunkbuf[512];
1254   Bytecount chunklen;
1255
1256   while (1)
1257     {
1258       ssize_t writeret;
1259
1260       chunklen = Lstream_read (lstream, chunkbuf, 512);
1261       if (chunklen <= 0)
1262         break; /* perhaps should abort() if < 0?
1263                   This should never happen. */
1264
1265       /* Lstream_write() will never successfully write less than the
1266          amount sent in.  In the worst case, it just buffers the
1267          unwritten data. */
1268       writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
1269                                 chunklen);
1270       Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
1271       if (writeret < 0)
1272         {
1273           p->status_symbol = Qexit;
1274           p->exit_code = ERROR_BROKEN_PIPE;
1275           p->core_dumped = 0;
1276           p->tick++;
1277           process_tick++;
1278           deactivate_process (*((Lisp_Object *) (&vol_proc)));
1279           error ("Broken pipe error sending to process %s; closed it",
1280                  XSTRING_DATA (p->name));
1281         }
1282
1283       {
1284         int wait_ms = 25;
1285         while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
1286           {
1287             /* Buffer is full.  Wait, accepting input; that may allow
1288                the program to finish doing output and read more.  */
1289             Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
1290             Lstream_flush (XLSTREAM (p->pipe_outstream));
1291             wait_ms = min (1000, 2 * wait_ms);
1292           }
1293       }
1294     }
1295 }
1296
1297 /*
1298  * Send a signal number SIGNO to PROCESS.
1299  * CURRENT_GROUP means send to the process group that currently owns
1300  * the terminal being used to communicate with PROCESS.
1301  * This is used for various commands in shell mode.
1302  * If NOMSG is zero, insert signal-announcements into process's buffers
1303  * right away.
1304  *
1305  * If we can, we try to signal PROCESS by sending control characters
1306  * down the pty.  This allows us to signal inferiors who have changed
1307  * their uid, for which killpg would return an EPERM error.
1308  *
1309  * The method signals an error if the given SIGNO is not valid
1310  */
1311
1312 static void
1313 nt_kill_child_process (Lisp_Object proc, int signo,
1314                        int current_group, int nomsg)
1315 {
1316   Lisp_Process *p = XPROCESS (proc);
1317
1318   /* Signal error if SIGNO cannot be sent */
1319   validate_signal_number (signo);
1320
1321   /* Send signal */
1322   if (!send_signal (NT_DATA (p), 0, signo))
1323     signal_simple_error ("Cannot send signal to process", proc);
1324 }
1325
1326 /*
1327  * Kill any process in the system given its PID
1328  *
1329  * Returns zero if a signal successfully sent, or
1330  * negative number upon failure
1331  */
1332 static int
1333 nt_kill_process_by_pid (int pid, int signo)
1334 {
1335   struct Lisp_Process *p;
1336
1337   /* Signal error if SIGNO cannot be sent */
1338   validate_signal_number (signo);
1339
1340   p = find_process_from_pid (pid);
1341   return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1;
1342 }
1343 \f
1344 /*-----------------------------------------------------------------------*/
1345 /* Sockets connections                                                   */
1346 /*-----------------------------------------------------------------------*/
1347 #ifdef HAVE_SOCKETS
1348
1349 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
1350
1351 #define SOCK_TIMER_ID 666
1352 #define XM_SOCKREPLY (WM_USER + 666)
1353
1354 static int
1355 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
1356                       Error_behavior errb)
1357 {
1358   char buf [MAXGETHOSTSTRUCT];
1359   HWND hwnd;
1360   HANDLE hasync;
1361   int success = 0;
1362
1363   address->sin_family = AF_INET;
1364
1365   /* First check if HOST is already a numeric address */
1366   {
1367     unsigned long inaddr = inet_addr (XSTRING_DATA (host));
1368     if (inaddr != INADDR_NONE)
1369       {
1370         address->sin_addr.s_addr = inaddr;
1371         return 1;
1372       }
1373   }
1374
1375   /* Create a window which will receive completion messages */
1376   hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
1377                        NULL, NULL, NULL, NULL);
1378   assert (hwnd);
1379
1380   /* Post name resolution request */
1381   hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
1382                                   buf, sizeof (buf));
1383   if (hasync == NULL)
1384     goto done;
1385
1386   /* Set a timer to poll for quit every 250 ms */
1387   SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
1388
1389   while (1)
1390     {
1391       MSG msg;
1392       GetMessage (&msg, hwnd, 0, 0);
1393       if (msg.message == XM_SOCKREPLY)
1394         {
1395           /* Ok, got an answer */
1396           if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
1397             success = 1;
1398           else
1399             {
1400               warn_when_safe(Qstream, Qwarning,
1401                              "cannot get IP address for host \"%s\"",
1402                              XSTRING_DATA (host));
1403             }
1404           goto done;
1405         }
1406       else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
1407         {
1408           if (QUITP)
1409             {
1410               WSACancelAsyncRequest (hasync);
1411               KillTimer (hwnd, SOCK_TIMER_ID);
1412               DestroyWindow (hwnd);
1413               REALLY_QUIT;
1414             }
1415         }
1416       DispatchMessage (&msg);
1417     }
1418
1419  done:
1420   KillTimer (hwnd, SOCK_TIMER_ID);
1421   DestroyWindow (hwnd);
1422   if (success)
1423     {
1424       /* BUF starts with struct hostent */
1425       struct hostent* he = (struct hostent*) buf;
1426       address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
1427     }
1428   return success;
1429 }
1430
1431 static Lisp_Object
1432 nt_canonicalize_host_name (Lisp_Object host)
1433 {
1434   struct sockaddr_in address;
1435
1436   if (!get_internet_address (host, &address, ERROR_ME_NOT))
1437     return host;
1438
1439   if (address.sin_family == AF_INET)
1440     return build_string (inet_ntoa (address.sin_addr));
1441   else
1442     return host;
1443 }
1444
1445 /* open a TCP network connection to a given HOST/SERVICE.  Treated
1446    exactly like a normal process when reading and writing.  Only
1447    differences are in status display and process deletion.  A network
1448    connection has no PID; you cannot signal it.  All you can do is
1449    deactivate and close it via delete-process */
1450
1451 static void
1452 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
1453                         Lisp_Object service,
1454                         Lisp_Object protocol, void** vinfd, void** voutfd)
1455 {
1456   /* !!#### not Mule-ized */
1457   struct sockaddr_in address;
1458   SOCKET s;
1459   int port;
1460   int retval;
1461
1462   CHECK_STRING (host);
1463
1464   if (!EQ (protocol, Qtcp))
1465     signal_simple_error ("Unsupported protocol", protocol);
1466
1467   if (INTP (service))
1468     port = htons ((unsigned short) XINT (service));
1469   else
1470     {
1471       struct servent *svc_info;
1472       CHECK_STRING (service);
1473       svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
1474       if (svc_info == 0)
1475         signal_simple_error ("Unknown service", service);
1476       port = svc_info->s_port;
1477     }
1478
1479   get_internet_address (host, &address, ERROR_ME);
1480   address.sin_port = port;
1481
1482   s = socket (address.sin_family, SOCK_STREAM, 0);
1483   if (s < 0)
1484     report_file_error ("error creating socket", list1 (name));
1485
1486   /* We don't want to be blocked on connect */
1487   {
1488     unsigned long nonblock = 1;
1489     ioctlsocket (s, FIONBIO, &nonblock);
1490   }
1491   
1492   retval = connect (s, (struct sockaddr *) &address, sizeof (address));
1493   if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
1494     goto connect_failed;
1495   /* Wait while connection is established */
1496   while (1)
1497     {
1498       fd_set fdset;
1499       struct timeval tv;
1500       int nsel;
1501
1502       if (QUITP)
1503         {
1504           closesocket (s);
1505           REALLY_QUIT;
1506         }
1507
1508       /* Poll for quit every 250 ms */
1509       tv.tv_sec = 0;
1510       tv.tv_usec = 250 * 1000;
1511
1512       FD_ZERO (&fdset);
1513       FD_SET (s, &fdset);
1514       nsel = select (0, NULL, &fdset, &fdset, &tv);
1515
1516       if (nsel > 0)
1517         {
1518           /* Check: was connection successful or not? */
1519           tv.tv_usec = 0;
1520           nsel = select (0, NULL, NULL, &fdset, &tv);
1521           if (nsel > 0)
1522             goto connect_failed;
1523           else
1524             break;
1525         }
1526     }
1527
1528   /* We are connected at this point */
1529   *vinfd = (void*)s;
1530   DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
1531                    GetCurrentProcess(), (LPHANDLE)voutfd,
1532                    0, FALSE, DUPLICATE_SAME_ACCESS);
1533   return;
1534
1535  connect_failed:  
1536   closesocket (s);
1537   if (INTP (service))
1538     {
1539       warn_when_safe (Qstream, Qwarning,
1540                       "failure to open network stream to host \"%s\" for service \"%d\"",
1541                       XSTRING_DATA (host),
1542                       (unsigned short) XINT (service));
1543     }
1544   else
1545     {
1546       warn_when_safe (Qstream, Qwarning,
1547                       "failure to open network stream to host \"%s\" for service \"%s\"",
1548                       XSTRING_DATA (host),
1549                       XSTRING_DATA (service));
1550     }
1551   report_file_error ("connection failed", list2 (host, name));
1552 }
1553
1554 #endif
1555 \f
1556 /*-----------------------------------------------------------------------*/
1557 /* Initialization                                                        */
1558 /*-----------------------------------------------------------------------*/
1559
1560 void
1561 process_type_create_nt (void)
1562 {
1563   PROCESS_HAS_METHOD (nt, alloc_process_data);
1564   PROCESS_HAS_METHOD (nt, finalize_process_data);
1565   PROCESS_HAS_METHOD (nt, init_process);
1566   PROCESS_HAS_METHOD (nt, create_process);
1567   PROCESS_HAS_METHOD (nt, update_status_if_terminated);
1568   PROCESS_HAS_METHOD (nt, send_process);
1569   PROCESS_HAS_METHOD (nt, kill_child_process);
1570   PROCESS_HAS_METHOD (nt, kill_process_by_pid);
1571 #ifdef HAVE_SOCKETS
1572   PROCESS_HAS_METHOD (nt, canonicalize_host_name);
1573   PROCESS_HAS_METHOD (nt, open_network_stream);
1574 #ifdef HAVE_MULTICAST
1575 #error I won't do this until '95 has winsock2
1576   PROCESS_HAS_METHOD (nt, open_multicast_group);
1577 #endif
1578 #endif
1579 }
1580
1581 void
1582 syms_of_process_nt (void)
1583 {
1584 }
1585
1586 void
1587 vars_of_process_nt (void)
1588 {
1589   DEFVAR_LISP ("mswindows-quote-process-args",
1590                &Vmswindows_quote_process_args /*
1591 Non-nil enables quoting of process arguments to ensure correct parsing.
1592 Because Windows does not directly pass argv arrays to child processes,
1593 programs have to reconstruct the argv array by parsing the command
1594 line string.  For an argument to contain a space, it must be enclosed
1595 in double quotes or it will be parsed as multiple arguments.
1596
1597 If the value is a character, that character will be used to escape any
1598 quote characters that appear, otherwise a suitable escape character
1599 will be chosen based on the type of the program (normal or Cygwin).
1600 */ );                                                             
1601   Vmswindows_quote_process_args = Qt;
1602
1603   DEFVAR_LISP ("mswindows-start-process-share-console",
1604                &Vmswindows_start_process_share_console /*
1605 When nil, new child processes are given a new console.
1606 When non-nil, they share the Emacs console; this has the limitation of
1607 allowing only only DOS subprocess to run at a time (whether started directly
1608 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
1609 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
1610 otherwise respond to interrupts from Emacs.
1611 */ );
1612   Vmswindows_start_process_share_console = Qnil;
1613
1614   DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
1615                &Vmswindows_start_process_inherit_error_mode /*
1616     "When nil, new child processes revert to the default error mode.
1617 When non-nil, they inherit their error mode setting from Emacs, which stops
1618 them blocking when trying to access unmounted drives etc.
1619 */ );
1620   Vmswindows_start_process_inherit_error_mode = Qt;
1621 }