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