This commit was generated by cvs2svn to compensate for changes in r1705,
[chise/xemacs-chise.git.1] / src / ntproc.c
1 /* Process support for Windows NT port of XEMACS.
2    Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING.  If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA.
20
21    Drew Bliss                   Oct 14, 1993
22      Adapted from alarm.c by Tim Fleehart */
23
24 /* Adapted for XEmacs by David Hobley <david@spook-le0.cia.com.au> */
25 /* Synced with FSF Emacs 19.34.6 by Marc Paquette <marcpa@cam.org> */
26
27 #include <config.h>
28 #undef signal
29 #undef wait
30 #undef spawnve
31 #undef select
32 #undef kill
33
34 #include <windows.h>
35 #ifdef HAVE_A_OUT_H
36 #include <a.out.h>
37 #endif
38 #include "lisp.h"
39 #include "sysproc.h"
40 #include "nt.h"
41 #include "ntheap.h" /* From 19.34.6 */
42 #include "systime.h"
43 #include "syssignal.h"
44 #include "sysfile.h"
45 #include "syswait.h"
46 #include "buffer.h"
47 #include "process.h"
48
49 #include "console-msw.h"
50
51 /*#include "w32term.h"*/ /* From 19.34.6: sync in ? --marcpa */
52
53 /* #### I'm not going to play with shit. */
54 #pragma warning (disable:4013 4024 4090)
55
56 /* Control whether spawnve quotes arguments as necessary to ensure
57    correct parsing by child process.  Because not all uses of spawnve
58    are careful about constructing argv arrays, we make this behavior
59    conditional (off by default). */
60 Lisp_Object Vwin32_quote_process_args;
61
62 /* Control whether create_child causes the process' window to be
63    hidden.  The default is nil. */
64 Lisp_Object Vwin32_start_process_show_window;
65
66 /* Control whether create_child causes the process to inherit Emacs'
67    console window, or be given a new one of its own.  The default is
68    nil, to allow multiple DOS programs to run on Win95.  Having separate
69    consoles also allows Emacs to cleanly terminate process groups.  */
70 Lisp_Object Vwin32_start_process_share_console;
71
72 /* Time to sleep before reading from a subprocess output pipe - this
73    avoids the inefficiency of frequently reading small amounts of data.
74    This is primarily necessary for handling DOS processes on Windows 95,
75    but is useful for Win32 processes on both Win95 and NT as well.  */
76 Lisp_Object Vwin32_pipe_read_delay;
77
78 /* Control whether xemacs_stat() attempts to generate fake but hopefully
79    "accurate" inode values, by hashing the absolute truenames of files.
80    This should detect aliasing between long and short names, but still
81    allows the possibility of hash collisions.  */
82 Lisp_Object Vwin32_generate_fake_inodes;
83
84 Lisp_Object Qhigh, Qlow;
85
86 extern Lisp_Object Vlisp_EXEC_SUFFIXES;
87
88 #ifndef DEBUG_XEMACS
89 __inline
90 #endif
91 void _DebPrint (const char *fmt, ...)
92 {
93 #ifdef DEBUG_XEMACS
94   char buf[1024];
95   va_list args;
96
97   va_start (args, fmt);
98   vsprintf (buf, fmt, args);
99   va_end (args);
100   OutputDebugString (buf);
101 #endif
102 }
103
104 /* sys_signal moved to nt.c. It's now called mswindows_signal... */
105
106 /* Defined in <process.h> which conflicts with the local copy */
107 #define _P_NOWAIT 1
108
109 /* Child process management list.  */
110 int child_proc_count = 0;
111 child_process child_procs[ MAX_CHILDREN ];
112 child_process *dead_child = NULL;
113
114 DWORD WINAPI reader_thread (void *arg);
115
116 /* Find an unused process slot.  */
117 child_process *
118 new_child (void)
119 {
120   child_process *cp;
121   DWORD id;
122   
123   for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
124     if (!CHILD_ACTIVE (cp))
125       goto Initialize;
126   if (child_proc_count == MAX_CHILDREN)
127     return NULL;
128   cp = &child_procs[child_proc_count++];
129
130  Initialize:
131   xzero (*cp);
132   cp->fd = -1;
133   cp->pid = -1;
134   if (cp->procinfo.hProcess)
135     CloseHandle(cp->procinfo.hProcess);
136   cp->procinfo.hProcess = NULL;
137   cp->status = STATUS_READ_ERROR;
138
139   /* use manual reset event so that select() will function properly */
140   cp->char_avail = CreateEvent (NULL, TRUE, FALSE, NULL);
141   if (cp->char_avail)
142     {
143       cp->char_consumed = CreateEvent (NULL, FALSE, FALSE, NULL);
144       if (cp->char_consumed)
145         {
146           cp->thrd = CreateThread (NULL, 1024, reader_thread, cp, 0, &id);
147           if (cp->thrd)
148             return cp;
149         }
150     }
151   delete_child (cp);
152   return NULL;
153 }
154
155 void 
156 delete_child (child_process *cp)
157 {
158   int i;
159
160   /* Should not be deleting a child that is still needed. */
161   for (i = 0; i < MAXDESC; i++)
162     if (fd_info[i].cp == cp)
163       abort ();
164
165   if (!CHILD_ACTIVE (cp))
166     return;
167
168   /* reap thread if necessary */
169   if (cp->thrd)
170     {
171       DWORD rc;
172
173       if (GetExitCodeThread (cp->thrd, &rc) && rc == STILL_ACTIVE)
174         {
175           /* let the thread exit cleanly if possible */
176           cp->status = STATUS_READ_ERROR;
177           SetEvent (cp->char_consumed);
178           if (WaitForSingleObject (cp->thrd, 1000) != WAIT_OBJECT_0)
179             {
180               DebPrint (("delete_child.WaitForSingleObject (thread) failed "
181                          "with %lu for fd %ld\n", GetLastError (), cp->fd));
182               TerminateThread (cp->thrd, 0);
183             }
184         }
185       CloseHandle (cp->thrd);
186       cp->thrd = NULL;
187     }
188   if (cp->char_avail)
189     {
190       CloseHandle (cp->char_avail);
191       cp->char_avail = NULL;
192     }
193   if (cp->char_consumed)
194     {
195       CloseHandle (cp->char_consumed);
196       cp->char_consumed = NULL;
197     }
198
199   /* update child_proc_count (highest numbered slot in use plus one) */
200   if (cp == child_procs + child_proc_count - 1)
201     {
202       for (i = child_proc_count-1; i >= 0; i--)
203         if (CHILD_ACTIVE (&child_procs[i]))
204           {
205             child_proc_count = i + 1;
206             break;
207           }
208     }
209   if (i < 0)
210     child_proc_count = 0;
211 }
212
213 /* Find a child by pid.  */
214 static child_process *
215 find_child_pid (DWORD pid)
216 {
217   child_process *cp;
218
219   for (cp = child_procs+(child_proc_count-1); cp >= child_procs; cp--)
220     if (CHILD_ACTIVE (cp) && pid == cp->pid)
221       return cp;
222   return NULL;
223 }
224
225 /* Function to do blocking read of one byte, needed to implement
226    select.  It is only allowed on sockets and pipes. */
227 static int
228 _sys_read_ahead (int fd)
229 {
230   child_process * cp;
231   int rc = 0;
232
233   if (fd < 0 || fd >= MAXDESC)
234     return STATUS_READ_ERROR;
235
236   cp = fd_info[fd].cp;
237
238   if (cp == NULL || cp->fd != fd || cp->status != STATUS_READ_READY)
239     return STATUS_READ_ERROR;
240
241   if ((fd_info[fd].flags & (FILE_PIPE | FILE_SOCKET)) == 0
242       || (fd_info[fd].flags & FILE_READ) == 0)
243     {
244       /* fd is not a pipe or socket */
245       abort ();
246     }
247   
248   cp->status = STATUS_READ_IN_PROGRESS;
249   
250   if (fd_info[fd].flags & FILE_PIPE)
251     {
252       rc = _read (fd, &cp->chr, sizeof (char));
253
254       /* Give subprocess time to buffer some more output for us before
255          reporting that input is available; we need this because Win95
256          connects DOS programs to pipes by making the pipe appear to be
257          the normal console stdout - as a result most DOS programs will
258          write to stdout without buffering, ie.  one character at a
259          time.  Even some Win32 programs do this - "dir" in a command
260          shell on NT is very slow if we don't do this. */
261       if (rc > 0)
262         {
263           int wait = XINT (Vwin32_pipe_read_delay);
264
265           if (wait > 0)
266             Sleep (wait);
267           else if (wait < 0)
268             while (++wait <= 0)
269               /* Yield remainder of our time slice, effectively giving a
270                  temporary priority boost to the child process. */
271               Sleep (0);
272         }
273     }
274
275   if (rc == sizeof (char))
276     cp->status = STATUS_READ_SUCCEEDED;
277   else
278     cp->status = STATUS_READ_FAILED;
279
280   return cp->status;
281 }
282
283 /* Thread proc for child process and socket reader threads. Each thread
284    is normally blocked until woken by select() to check for input by
285    reading one char.  When the read completes, char_avail is signalled
286    to wake up the select emulator and the thread blocks itself again. */
287 DWORD WINAPI 
288 reader_thread (void *arg)
289 {
290   child_process *cp;
291   
292   /* Our identity */
293   cp = (child_process *)arg;
294   
295   /* <matts@tibco.com> - I think the test below is wrong - we don't
296      want to wait for someone to signal char_consumed, as we haven't
297      read anything for them to consume yet! */
298
299   /*
300   if (cp == NULL ||
301       WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
302   */
303
304   if (cp == NULL)
305   {
306       return 1;
307   }
308
309   for (;;)
310     {
311       int rc;
312
313       rc = _sys_read_ahead (cp->fd);
314
315       /* The name char_avail is a misnomer - it really just means the
316          read-ahead has completed, whether successfully or not. */
317       if (!SetEvent (cp->char_avail))
318         {
319           DebPrint (("reader_thread.SetEvent failed with %lu for fd %ld\n",
320                      GetLastError (), cp->fd));
321           return 1;
322         }
323
324       if (rc == STATUS_READ_ERROR)
325       {
326         /* We are finished, so clean up handles and set to NULL so
327            that CHILD_ACTIVE will see what is going on */
328         if (cp->char_avail) {
329           CloseHandle (cp->char_avail);
330           cp->char_avail = NULL;
331         }
332         if (cp->thrd) {
333           CloseHandle (cp->thrd);
334           cp->thrd = NULL;
335         }
336         if (cp->char_consumed) {
337           CloseHandle(cp->char_consumed);
338           cp->char_consumed = NULL;
339         }
340         if (cp->procinfo.hProcess)
341         {
342           CloseHandle (cp->procinfo.hProcess);
343           cp->procinfo.hProcess=NULL;
344         }
345         return 1;
346       }
347         
348       /* If the read died, the child has died so let the thread die */
349       if (rc == STATUS_READ_FAILED)
350         break;
351         
352       /* Wait until our input is acknowledged before reading again */
353       if (WaitForSingleObject (cp->char_consumed, INFINITE) != WAIT_OBJECT_0)
354         {
355           DebPrint (("reader_thread.WaitForSingleObject failed with "
356                      "%lu for fd %ld\n", GetLastError (), cp->fd));
357           break;
358         }
359     }
360   /* We are finished, so clean up handles and set to NULL so that
361      CHILD_ACTIVE will see what is going on */
362   if (cp->char_avail) {
363     CloseHandle (cp->char_avail);
364     cp->char_avail = NULL;
365   }
366   if (cp->thrd) {
367     CloseHandle (cp->thrd);
368     cp->thrd = NULL;
369   }
370   if (cp->char_consumed) {
371     CloseHandle(cp->char_consumed);
372     cp->char_consumed = NULL;
373   }
374   if (cp->procinfo.hProcess)
375   {
376     CloseHandle (cp->procinfo.hProcess);
377     cp->procinfo.hProcess=NULL;
378   }
379   
380   return 0;
381 }
382
383 /* To avoid Emacs changing directory, we just record here the directory
384    the new process should start in.  This is set just before calling
385    sys_spawnve, and is not generally valid at any other time.  */
386 static const char * process_dir;
387
388 static BOOL 
389 create_child (const char *exe, char *cmdline, char *env,
390               int * pPid, child_process *cp)
391 {
392   STARTUPINFO start;
393   SECURITY_ATTRIBUTES sec_attrs;
394   SECURITY_DESCRIPTOR sec_desc;
395   char dir[ MAXPATHLEN ];
396   
397   if (cp == NULL) abort ();
398   
399   xzero (start);
400   start.cb = sizeof (start);
401   
402   if (NILP (Vwin32_start_process_show_window))
403   start.dwFlags = STARTF_USESTDHANDLES | STARTF_USESHOWWINDOW;
404   else
405     start.dwFlags = STARTF_USESTDHANDLES;
406   start.wShowWindow = SW_HIDE;
407
408   start.hStdInput = GetStdHandle (STD_INPUT_HANDLE);
409   start.hStdOutput = GetStdHandle (STD_OUTPUT_HANDLE);
410   start.hStdError = GetStdHandle (STD_ERROR_HANDLE);
411
412   /* Explicitly specify no security */
413   /* #### not supported under win98, but will go away */
414   if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
415     goto EH_Fail;
416   /* #### not supported under win98, but will go away */
417   if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
418     goto EH_Fail;
419   sec_attrs.nLength = sizeof (sec_attrs);
420   sec_attrs.lpSecurityDescriptor = &sec_desc;
421   sec_attrs.bInheritHandle = FALSE;
422   
423   strcpy (dir, process_dir);
424   unixtodos_filename (dir);
425   
426   if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
427                       (!NILP (Vwin32_start_process_share_console)
428                        ? CREATE_NEW_PROCESS_GROUP
429                        : CREATE_NEW_CONSOLE),
430                       env, dir,
431                       &start, &cp->procinfo))
432     goto EH_Fail;
433
434   cp->pid = (int) cp->procinfo.dwProcessId;
435
436   CloseHandle (cp->procinfo.hThread);
437   CloseHandle (cp->procinfo.hProcess);
438   cp->procinfo.hThread=NULL;
439   cp->procinfo.hProcess=NULL;
440
441   /* pid must fit in a Lisp_Int */
442
443
444   *pPid = cp->pid;
445   
446   return TRUE;
447   
448  EH_Fail:
449   DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
450   return FALSE;
451 }
452
453 void
454 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
455 {
456   char **optr, **nptr;
457   int num;
458
459   nptr = new_envp;
460   optr = envp1;
461   while (*optr)
462     *nptr++ = *optr++;
463   num = optr - envp1;
464
465   optr = envp2;
466   while (*optr)
467     *nptr++ = *optr++;
468   num += optr - envp2;
469
470   qsort (new_envp, num, sizeof (char*), compare_env);
471
472   *nptr = NULL;
473 }
474
475 /* When a new child process is created we need to register it in our list,
476    so intercept spawn requests.  */
477 int 
478 sys_spawnve (int mode, const char *cmdname,
479              const char * const *argv, const char *const *envp)
480 {
481   Lisp_Object program, full;
482   char *cmdline, *env, *parg, **targ;
483   int arglen, numenv;
484   int pid;
485   child_process *cp;
486   int is_dos_app, is_cygnus_app;
487   int do_quoting = 0;
488   char escape_char = 0;
489   /* We pass our process ID to our children by setting up an environment
490      variable in their environment.  */
491   char ppid_env_var_buffer[64];
492   char *extra_env[] = {ppid_env_var_buffer, NULL};
493   struct gcpro gcpro1;
494     
495   /* We don't care about the other modes */
496   if (mode != _P_NOWAIT)
497     {
498       errno = EINVAL;
499       return -1;
500     }
501
502   /* Handle executable names without an executable suffix.  */
503   program = build_string (cmdname);
504   GCPRO1 (program);
505   if (NILP (Ffile_executable_p (program)))
506     {
507       full = Qnil;
508       locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &full, 1);
509       if (NILP (full))
510         {
511           UNGCPRO;
512           errno = EINVAL;
513           return -1;
514         }
515       TO_EXTERNAL_FORMAT (LISP_STRING, full,
516                           C_STRING_ALLOCA, cmdname,
517                           Qfile_name);
518     }
519   else
520     {
521       cmdname = (char*)alloca (strlen (argv[0]) + 1);
522       strcpy ((char*)cmdname, argv[0]);
523     }
524   UNGCPRO;
525
526   /* make sure argv[0] and cmdname are both in DOS format */
527   unixtodos_filename ((char*)cmdname);
528   /* #### KLUDGE */
529   ((const char**)argv)[0] = cmdname;
530
531   /* Determine whether program is a 16-bit DOS executable, or a Win32
532      executable that is implicitly linked to the Cygnus dll (implying it
533      was compiled with the Cygnus GNU toolchain and hence relies on
534      cygwin.dll to parse the command line - we use this to decide how to
535      escape quote chars in command line args that must be quoted). */
536   mswindows_executable_type (cmdname, &is_dos_app, &is_cygnus_app);
537
538   /* On Windows 95, if cmdname is a DOS app, we invoke a helper
539      application to start it by specifying the helper app as cmdname,
540      while leaving the real app name as argv[0].  */
541   if (is_dos_app)
542     {
543       cmdname = (char*) alloca (MAXPATHLEN);
544       if (egetenv ("CMDPROXY"))
545         strcpy ((char*)cmdname, egetenv ("CMDPROXY"));
546       else
547     {
548           strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory));
549           strcat ((char*)cmdname, "cmdproxy.exe");
550         }
551       unixtodos_filename ((char*)cmdname);
552     }
553   
554   /* we have to do some conjuring here to put argv and envp into the
555      form CreateProcess wants...  argv needs to be a space separated/null
556      terminated list of parameters, and envp is a null
557      separated/double-null terminated list of parameters.
558
559      Additionally, zero-length args and args containing whitespace or
560      quote chars need to be wrapped in double quotes - for this to work,
561      embedded quotes need to be escaped as well.  The aim is to ensure
562      the child process reconstructs the argv array we start with
563      exactly, so we treat quotes at the beginning and end of arguments
564      as embedded quotes.
565
566      The Win32 GNU-based library from Cygnus doubles quotes to escape
567      them, while MSVC uses backslash for escaping.  (Actually the MSVC
568      startup code does attempt to recognize doubled quotes and accept
569      them, but gets it wrong and ends up requiring three quotes to get a
570      single embedded quote!)  So by default we decide whether to use
571      quote or backslash as the escape character based on whether the
572      binary is apparently a Cygnus compiled app.
573
574      Note that using backslash to escape embedded quotes requires
575      additional special handling if an embedded quote is already
576      preceded by backslash, or if an arg requiring quoting ends with
577      backslash.  In such cases, the run of escape characters needs to be
578      doubled.  For consistency, we apply this special handling as long
579      as the escape character is not quote.
580    
581      Since we have no idea how large argv and envp are likely to be we
582      figure out list lengths on the fly and allocate them.  */
583   
584   if (!NILP (Vwin32_quote_process_args))
585     {
586       do_quoting = 1;
587       /* Override escape char by binding win32-quote-process-args to
588          desired character, or use t for auto-selection.  */
589       if (INTP (Vwin32_quote_process_args))
590         escape_char = (char) XINT (Vwin32_quote_process_args);
591       else
592         escape_char = is_cygnus_app ? '"' : '\\';
593     }
594   
595   /* do argv...  */
596   arglen = 0;
597   targ = (char**)argv;
598   while (*targ)
599     {
600       char * p = *targ;
601       int need_quotes = 0;
602       int escape_char_run = 0;
603
604       if (*p == 0)
605         need_quotes = 1;
606       for ( ; *p; p++)
607         {
608           if (*p == '"')
609           {
610               /* allow for embedded quotes to be escaped */
611             arglen++;
612               need_quotes = 1;
613               /* handle the case where the embedded quote is already escaped */
614               if (escape_char_run > 0)
615                 {
616                   /* To preserve the arg exactly, we need to double the
617                      preceding escape characters (plus adding one to
618                      escape the quote character itself).  */
619                   arglen += escape_char_run;
620           }
621             }
622       else if (*p == ' ' || *p == '\t')
623             {
624               need_quotes = 1;
625             }
626
627           if (*p == escape_char && escape_char != '"')
628             escape_char_run++;
629           else
630             escape_char_run = 0;
631         }
632       if (need_quotes)
633         {
634         arglen += 2;
635           /* handle the case where the arg ends with an escape char - we
636              must not let the enclosing quote be escaped.  */
637           if (escape_char_run > 0)
638             arglen += escape_char_run;
639         }
640       arglen += strlen (*targ++) + 1;
641     }
642   cmdline = (char*) alloca (arglen);
643   targ = (char**)argv;
644   parg = cmdline;
645   while (*targ)
646     {
647       char * p = *targ;
648       int need_quotes = 0;
649
650       if (*p == 0)
651         need_quotes = 1;
652
653       if (do_quoting)
654         {
655           for ( ; *p; p++)
656             if (*p == ' ' || *p == '\t' || *p == '"')
657               need_quotes = 1;
658         }
659       if (need_quotes)
660         {
661           int escape_char_run = 0;
662           char * first;
663           char * last;
664
665           p = *targ;
666           first = p;
667           last = p + strlen (p) - 1;
668           *parg++ = '"';
669 #if 0
670           /* This version does not escape quotes if they occur at the
671              beginning or end of the arg - this could lead to incorrect
672              behavior when the arg itself represents a command line
673              containing quoted args.  I believe this was originally done
674              as a hack to make some things work, before
675              `win32-quote-process-args' was added.  */
676           while (*p)
677             {
678               if (*p == '"' && p > first && p < last)
679                 *parg++ = escape_char;  /* escape embedded quotes */
680               *parg++ = *p++;
681             }
682 #else
683           for ( ; *p; p++)
684             {
685               if (*p == '"')
686                 {
687                   /* double preceding escape chars if any */
688                   while (escape_char_run > 0)
689                     {
690                       *parg++ = escape_char;
691                       escape_char_run--;
692                     }
693                   /* escape all quote chars, even at beginning or end */
694                   *parg++ = escape_char;
695                 }
696               *parg++ = *p;
697
698               if (*p == escape_char && escape_char != '"')
699                 escape_char_run++;
700               else
701                 escape_char_run = 0;
702             }
703           /* double escape chars before enclosing quote */
704           while (escape_char_run > 0)
705             {
706               *parg++ = escape_char;
707               escape_char_run--;
708             }
709 #endif
710           *parg++ = '"';
711         }
712       else
713         {
714           strcpy (parg, *targ);
715           parg += strlen (*targ);
716         }
717       *parg++ = ' ';
718       targ++;
719     }
720   *--parg = '\0';
721   
722   /* and envp...  */
723   arglen = 1;
724   targ = (char**) envp;
725   numenv = 1; /* for end null */
726   while (*targ)
727     {
728       arglen += strlen (*targ++) + 1;
729       numenv++;
730     }
731   /* extra env vars... */
732   sprintf (ppid_env_var_buffer, "__PARENT_PROCESS_ID=%d", 
733            GetCurrentProcessId ());
734   arglen += strlen (ppid_env_var_buffer) + 1;
735   numenv++;
736
737   /* merge env passed in and extra env into one, and sort it.  */
738   targ = (char **) alloca (numenv * sizeof (char*));
739   merge_and_sort_env ((char**) envp, extra_env, targ);
740
741   /* concatenate env entries.  */
742   env = (char*) alloca (arglen);
743   parg = env;
744   while (*targ)
745     {
746       strcpy (parg, *targ);
747       parg += strlen (*targ++);
748       *parg++ = '\0';
749     }
750   *parg++ = '\0';
751   *parg = '\0';
752
753   cp = new_child ();
754   if (cp == NULL)
755     {
756       errno = EAGAIN;
757       return -1;
758     }
759   
760   /* Now create the process.  */
761   if (!create_child (cmdname, cmdline, env, &pid, cp))
762     {
763       delete_child (cp);
764       errno = ENOEXEC;
765       return -1;
766     }
767
768   return pid;
769 }
770
771 /* Substitute for certain kill () operations */
772
773 static BOOL CALLBACK
774 find_child_console (HWND hwnd, child_process * cp)
775 {
776   DWORD thread_id;
777   DWORD process_id;
778
779   thread_id = GetWindowThreadProcessId (hwnd, &process_id);
780   if (process_id == cp->procinfo.dwProcessId)
781     {
782       char window_class[32];
783
784       GetClassName (hwnd, window_class, sizeof (window_class));
785       if (strcmp (window_class,
786                   mswindows_windows9x_p()
787                   ? "tty"
788                   : "ConsoleWindowClass") == 0)
789         {
790           cp->hwnd = hwnd;
791           return FALSE;
792         }
793     }
794   /* keep looking */
795   return TRUE;
796 }
797
798 int 
799 sys_kill (int pid, int sig)
800 {
801   child_process *cp;
802   HANDLE proc_hand;
803   int need_to_free = 0;
804   int rc = 0;
805   
806   /* Only handle signals that will result in the process dying */
807   if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
808     {
809       errno = EINVAL;
810       return -1;
811     }
812
813   cp = find_child_pid (pid);
814   if (cp == NULL)
815     {
816       proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
817       if (proc_hand == NULL)
818         {
819           errno = EPERM;
820           return -1;
821         }
822       need_to_free = 1;
823     }
824   else
825     {
826       proc_hand = cp->procinfo.hProcess;
827       pid = cp->procinfo.dwProcessId;
828
829       /* Try to locate console window for process. */
830       EnumWindows ((WNDENUMPROC)find_child_console, (LPARAM) cp);
831     }
832   
833   if (sig == SIGINT)
834     {
835       if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd)
836         {
837           BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
838           BYTE vk_break_code = VK_CANCEL;
839           BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
840           HWND foreground_window;
841
842           if (break_scan_code == 0)
843             {
844               /* Fake Ctrl-C if we can't manage Ctrl-Break. */
845               vk_break_code = 'C';
846               break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
847             }
848
849           foreground_window = GetForegroundWindow ();
850           if (foreground_window && SetForegroundWindow (cp->hwnd))
851             {
852               /* Generate keystrokes as if user had typed Ctrl-Break or Ctrl-C.  */
853               keybd_event (VK_CONTROL, control_scan_code, 0, 0);
854               keybd_event (vk_break_code, break_scan_code, 0, 0);
855               keybd_event (vk_break_code, break_scan_code, KEYEVENTF_KEYUP, 0);
856               keybd_event (VK_CONTROL, control_scan_code, KEYEVENTF_KEYUP, 0);
857
858               /* Sleep for a bit to give time for Emacs frame to respond
859                  to focus change events (if Emacs was active app).  */
860               Sleep (10);
861
862               SetForegroundWindow (foreground_window);
863             }
864         }
865       /* Ctrl-Break is NT equivalent of SIGINT.  */
866       else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
867         {
868           DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
869                      "for pid %lu\n", GetLastError (), pid));
870           errno = EINVAL;
871           rc = -1;
872         }
873     }
874   else
875     {
876       if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd)
877         {
878 #if 1
879           if (mswindows_windows9x_p())
880             {
881 /*
882    Another possibility is to try terminating the VDM out-right by
883    calling the Shell VxD (id 0x17) V86 interface, function #4
884    "SHELL_Destroy_VM", ie.
885
886      mov edx,4
887      mov ebx,vm_handle
888      call shellapi
889
890    First need to determine the current VM handle, and then arrange for
891    the shellapi call to be made from the system vm (by using
892    Switch_VM_and_callback).
893
894    Could try to invoke DestroyVM through CallVxD.
895
896 */
897 #if 0
898               /* On Win95, posting WM_QUIT causes the 16-bit subsystem
899                  to hang when cmdproxy is used in conjunction with
900                  command.com for an interactive shell.  Posting
901                  WM_CLOSE pops up a dialog that, when Yes is selected,
902                  does the same thing.  TerminateProcess is also less
903                  than ideal in that subprocesses tend to stick around
904                  until the machine is shutdown, but at least it
905                  doesn't freeze the 16-bit subsystem.  */
906               PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
907 #endif
908               if (!TerminateProcess (proc_hand, 0xff))
909                 {
910                   DebPrint (("sys_kill.TerminateProcess returned %d "
911                              "for pid %lu\n", GetLastError (), pid));
912                   errno = EINVAL;
913                   rc = -1;
914                 }
915             }
916           else
917 #endif
918             PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
919         }
920       /* Kill the process.  On Win32 this doesn't kill child processes
921          so it doesn't work very well for shells which is why it's not
922          used in every case.  */
923       else if (!TerminateProcess (proc_hand, 0xff))
924         {
925           DebPrint (("sys_kill.TerminateProcess returned %d "
926                      "for pid %lu\n", GetLastError (), pid));
927           errno = EINVAL;
928           rc = -1;
929         }
930     }
931
932   if (need_to_free)
933     CloseHandle (proc_hand);
934
935   return rc;
936 }
937
938 #if 0
939 /* Sync with FSF Emacs 19.34.6 note: ifdef'ed out in XEmacs */
940 extern int report_file_error (const char *, Lisp_Object);
941 #endif
942 /* The following two routines are used to manipulate stdin, stdout, and
943    stderr of our child processes.
944
945    Assuming that in, out, and err are *not* inheritable, we make them
946    stdin, stdout, and stderr of the child as follows:
947
948    - Save the parent's current standard handles.
949    - Set the std handles to inheritable duplicates of the ones being passed in.
950      (Note that _get_osfhandle() is an io.h procedure that retrieves the
951      NT file handle for a crt file descriptor.)
952    - Spawn the child, which inherits in, out, and err as stdin,
953      stdout, and stderr. (see Spawnve)
954    - Close the std handles passed to the child.
955    - Reset the parent's standard handles to the saved handles.
956      (see reset_standard_handles)
957    We assume that the caller closes in, out, and err after calling us.  */
958
959 void
960 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
961 {
962   HANDLE parent;
963   HANDLE newstdin, newstdout, newstderr;
964
965   parent = GetCurrentProcess ();
966
967   handles[0] = GetStdHandle (STD_INPUT_HANDLE);
968   handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
969   handles[2] = GetStdHandle (STD_ERROR_HANDLE);
970
971   /* make inheritable copies of the new handles */
972   if (!DuplicateHandle (parent, 
973                        (HANDLE) _get_osfhandle (in),
974                        parent,
975                        &newstdin, 
976                        0, 
977                        TRUE, 
978                        DUPLICATE_SAME_ACCESS))
979     report_file_error ("Duplicating input handle for child", Qnil);
980   
981   if (!DuplicateHandle (parent,
982                        (HANDLE) _get_osfhandle (out),
983                        parent,
984                        &newstdout,
985                        0,
986                        TRUE,
987                        DUPLICATE_SAME_ACCESS))
988     report_file_error ("Duplicating output handle for child", Qnil);
989   
990   if (!DuplicateHandle (parent,
991                        (HANDLE) _get_osfhandle (err),
992                        parent,
993                        &newstderr,
994                        0,
995                        TRUE,
996                        DUPLICATE_SAME_ACCESS))
997     report_file_error ("Duplicating error handle for child", Qnil);
998
999   /* and store them as our std handles */
1000   if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
1001     report_file_error ("Changing stdin handle", Qnil);
1002   
1003   if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
1004     report_file_error ("Changing stdout handle", Qnil);
1005
1006   if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
1007     report_file_error ("Changing stderr handle", Qnil);
1008 }
1009
1010 void
1011 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
1012 {
1013   /* close the duplicated handles passed to the child */
1014   CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
1015   CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
1016   CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
1017
1018   /* now restore parent's saved std handles */
1019   SetStdHandle (STD_INPUT_HANDLE, handles[0]);
1020   SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
1021   SetStdHandle (STD_ERROR_HANDLE, handles[2]);
1022 }
1023
1024 void
1025 set_process_dir (const char * dir)
1026 {
1027   process_dir = dir;
1028 }
1029 \f
1030 /* Some miscellaneous functions that are Windows specific, but not GUI
1031    specific (ie. are applicable in terminal or batch mode as well).  */
1032
1033 DEFUN ("win32-short-file-name", Fwin32_short_file_name, 1, 1, "", /*
1034   Return the short file name version (8.3) of the full path of FILENAME.
1035 If FILENAME does not exist, return nil.
1036 All path elements in FILENAME are converted to their short names.
1037 */
1038        (filename))
1039 {
1040   char shortname[MAX_PATH];
1041
1042   CHECK_STRING (filename);
1043
1044   /* first expand it.  */
1045   filename = Fexpand_file_name (filename, Qnil);
1046
1047   /* luckily, this returns the short version of each element in the path.  */
1048   if (GetShortPathName (XSTRING_DATA (filename), shortname, MAX_PATH) == 0)
1049     return Qnil;
1050
1051   CORRECT_DIR_SEPS (shortname);
1052
1053   return build_string (shortname);
1054 }
1055
1056
1057 DEFUN ("win32-long-file-name", Fwin32_long_file_name, 1, 1, "", /*
1058   Return the long file name version of the full path of FILENAME.
1059 If FILENAME does not exist, return nil.
1060 All path elements in FILENAME are converted to their long names.
1061 */
1062        (filename))
1063 {
1064   char longname[ MAX_PATH ];
1065
1066   CHECK_STRING (filename);
1067
1068   /* first expand it.  */
1069   filename = Fexpand_file_name (filename, Qnil);
1070
1071   if (!win32_get_long_filename (XSTRING_DATA (filename), longname, MAX_PATH))
1072     return Qnil;
1073
1074   CORRECT_DIR_SEPS (longname);
1075
1076   return build_string (longname);
1077 }
1078
1079 DEFUN ("win32-set-process-priority", Fwin32_set_process_priority, 2, 2, "", /*
1080   Set the priority of PROCESS to PRIORITY.
1081 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1082 priority of the process whose pid is PROCESS is changed.
1083 PRIORITY should be one of the symbols high, normal, or low;
1084 any other symbol will be interpreted as normal.
1085
1086 If successful, the return value is t, otherwise nil.
1087 */
1088        (process, priority))
1089 {
1090   HANDLE proc_handle = GetCurrentProcess ();
1091   DWORD  priority_class = NORMAL_PRIORITY_CLASS;
1092   Lisp_Object result = Qnil;
1093
1094   CHECK_SYMBOL (priority);
1095
1096   if (!NILP (process))
1097     {
1098       DWORD pid;
1099       child_process *cp;
1100
1101       CHECK_INT (process);
1102
1103       /* Allow pid to be an internally generated one, or one obtained
1104          externally.  This is necessary because real pids on Win95 are
1105          negative.  */
1106
1107       pid = XINT (process);
1108       cp = find_child_pid (pid);
1109       if (cp != NULL)
1110         pid = cp->procinfo.dwProcessId;
1111
1112       proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
1113     }
1114
1115   if (EQ (priority, Qhigh))
1116     priority_class = HIGH_PRIORITY_CLASS;
1117   else if (EQ (priority, Qlow))
1118     priority_class = IDLE_PRIORITY_CLASS;
1119
1120   if (proc_handle != NULL)
1121     {
1122       if (SetPriorityClass (proc_handle, priority_class))
1123         result = Qt;
1124       if (!NILP (process))
1125         CloseHandle (proc_handle);
1126     }
1127
1128   return result;
1129 }
1130
1131
1132 DEFUN ("win32-get-locale-info", Fwin32_get_locale_info, 1, 2, "", /*
1133   "Return information about the Windows locale LCID.
1134 By default, return a three letter locale code which encodes the default
1135 language as the first two characters, and the country or regional variant
1136 as the third letter.  For example, ENU refers to `English (United States)',
1137 while ENC means `English (Canadian)'.
1138
1139 If the optional argument LONGFORM is non-nil, the long form of the locale
1140 name is returned, e.g. `English (United States)' instead.
1141
1142 If LCID (a 16-bit number) is not a valid locale, the result is nil.
1143 */
1144      (lcid, longform))
1145 {
1146   int got_abbrev;
1147   int got_full;
1148   char abbrev_name[32] = { 0 };
1149   char full_name[256] = { 0 };
1150
1151   CHECK_INT (lcid);
1152
1153   if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1154     return Qnil;
1155
1156   if (NILP (longform))
1157     {
1158       got_abbrev = GetLocaleInfo (XINT (lcid),
1159                                   LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
1160                                   abbrev_name, sizeof (abbrev_name));
1161       if (got_abbrev)
1162         return build_string (abbrev_name);
1163     }
1164   else
1165     {
1166       got_full = GetLocaleInfo (XINT (lcid),
1167                                 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
1168                                 full_name, sizeof (full_name));
1169       if (got_full)
1170         return build_string (full_name);
1171     }
1172
1173   return Qnil;
1174 }
1175
1176
1177 DEFUN ("win32-get-current-locale-id", Fwin32_get_current_locale_id, 0, 0, "", /*
1178   "Return Windows locale id for current locale setting.
1179 This is a numerical value; use `win32-get-locale-info' to convert to a
1180 human-readable form.
1181 */
1182        ())
1183 {
1184   return make_int (GetThreadLocale ());
1185 }
1186
1187
1188 DEFUN ("win32-get-default-locale-id", Fwin32_get_default_locale_id, 0, 1, "", /*
1189   "Return Windows locale id for default locale setting.
1190 By default, the system default locale setting is returned; if the optional
1191 parameter USERP is non-nil, the user default locale setting is returned.
1192 This is a numerical value; use `win32-get-locale-info' to convert to a
1193 human-readable form.
1194 */
1195        (userp))
1196 {
1197   if (NILP (userp))
1198     return make_int (GetSystemDefaultLCID ());
1199   return make_int (GetUserDefaultLCID ());
1200 }
1201
1202 DWORD int_from_hex (char * s)
1203 {
1204   DWORD val = 0;
1205   static char hex[] = "0123456789abcdefABCDEF";
1206   char * p;
1207
1208   while (*s && (p = strchr(hex, *s)) != NULL)
1209     {
1210       unsigned digit = p - hex;
1211       if (digit > 15)
1212         digit -= 6;
1213       val = val * 16 + digit;
1214       s++;
1215     }
1216   return val;
1217 }
1218
1219 /* We need to build a global list, since the EnumSystemLocale callback
1220    function isn't given a context pointer.  */
1221 Lisp_Object Vwin32_valid_locale_ids;
1222
1223 BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
1224 {
1225   DWORD id = int_from_hex (localeNum);
1226   Vwin32_valid_locale_ids = Fcons (make_int (id), Vwin32_valid_locale_ids);
1227   return TRUE;
1228 }
1229
1230 DEFUN ("win32-get-valid-locale-ids", Fwin32_get_valid_locale_ids, 0, 0, "", /*
1231   Return list of all valid Windows locale ids.
1232 Each id is a numerical value; use `win32-get-locale-info' to convert to a
1233 human-readable form.
1234 */
1235        ())
1236 {
1237   Vwin32_valid_locale_ids = Qnil;
1238
1239   EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
1240
1241   Vwin32_valid_locale_ids = Fnreverse (Vwin32_valid_locale_ids);
1242   return Vwin32_valid_locale_ids;
1243 }
1244
1245
1246 DEFUN ("win32-set-current-locale", Fwin32_set_current_locale, 1, 1, "", /*
1247   Make Windows locale LCID be the current locale setting for Emacs.
1248 If successful, the new locale id is returned, otherwise nil.
1249 */
1250      (lcid))
1251 {
1252   CHECK_INT (lcid);
1253
1254   if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1255     return Qnil;
1256
1257   /* #### not supported under win98, but will go away */
1258   if (!SetThreadLocale (XINT (lcid)))
1259     return Qnil;
1260
1261 /* Sync with FSF Emacs 19.34.6 note: dwWinThreadId declared in
1262    w32term.h and defined in w32fns.c, both of which are not in current
1263    XEmacs.  #### Check what we lose by ifdef'ing out these. --marcpa */
1264 #if 0
1265   /* Need to set input thread locale if present.  */
1266   if (dwWinThreadId)
1267     /* Reply is not needed.  */
1268     PostThreadMessage (dwWinThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
1269 #endif
1270
1271   return make_int (GetThreadLocale ());
1272 }
1273
1274 \f
1275 void
1276 syms_of_ntproc (void)
1277 {
1278   DEFSUBR (Fwin32_short_file_name);
1279   DEFSUBR (Fwin32_long_file_name);
1280   DEFSUBR (Fwin32_set_process_priority);
1281   DEFSUBR (Fwin32_get_locale_info);
1282   DEFSUBR (Fwin32_get_current_locale_id);
1283   DEFSUBR (Fwin32_get_default_locale_id);
1284   DEFSUBR (Fwin32_get_valid_locale_ids);
1285   DEFSUBR (Fwin32_set_current_locale);
1286 }
1287
1288
1289 void
1290 vars_of_ntproc (void)
1291 {
1292   defsymbol (&Qhigh, "high");
1293   defsymbol (&Qlow, "low");
1294
1295   DEFVAR_LISP ("win32-quote-process-args", &Vwin32_quote_process_args /*
1296     Non-nil enables quoting of process arguments to ensure correct parsing.
1297 Because Windows does not directly pass argv arrays to child processes,
1298 programs have to reconstruct the argv array by parsing the command
1299 line string.  For an argument to contain a space, it must be enclosed
1300 in double quotes or it will be parsed as multiple arguments.
1301
1302 If the value is a character, that character will be used to escape any
1303 quote characters that appear, otherwise a suitable escape character
1304 will be chosen based on the type of the program.
1305 */ );
1306   Vwin32_quote_process_args = Qt;
1307
1308   DEFVAR_LISP ("win32-start-process-show-window",
1309                &Vwin32_start_process_show_window /*
1310     When nil, processes started via start-process hide their windows.
1311 When non-nil, they show their window in the method of their choice.
1312 */ );
1313   Vwin32_start_process_show_window = Qnil;
1314
1315   DEFVAR_LISP ("win32-start-process-share-console",
1316                &Vwin32_start_process_share_console /*
1317     When nil, processes started via start-process are given a new console.
1318 When non-nil, they share the Emacs console; this has the limitation of
1319 allowing only only DOS subprocess to run at a time (whether started directly
1320 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
1321 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
1322 otherwise respond to interrupts from Emacs.
1323 */ );
1324   Vwin32_start_process_share_console = Qt;
1325
1326   DEFVAR_LISP ("win32-pipe-read-delay", &Vwin32_pipe_read_delay /*
1327     Forced delay before reading subprocess output.
1328 This is done to improve the buffering of subprocess output, by
1329 avoiding the inefficiency of frequently reading small amounts of data.
1330
1331 If positive, the value is the number of milliseconds to sleep before
1332 reading the subprocess output.  If negative, the magnitude is the number
1333 of time slices to wait (effectively boosting the priority of the child
1334 process temporarily).  A value of zero disables waiting entirely.
1335 */ );
1336   Vwin32_pipe_read_delay = make_int (50);
1337
1338 #if 0
1339   DEFVAR_LISP ("win32-generate-fake-inodes", &Vwin32_generate_fake_inodes /*
1340     "Non-nil means attempt to fake realistic inode values.
1341 This works by hashing the truename of files, and should detect 
1342 aliasing between long and short (8.3 DOS) names, but can have
1343 false positives because of hash collisions.  Note that determining
1344 the truename of a file can be slow.
1345 */ );
1346   Vwin32_generate_fake_inodes = Qnil;
1347 #endif
1348 }
1349
1350 /* end of ntproc.c */