eebf13ffdea02db8eff2d6be7600e802e3541e20
[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 <stdio.h>
28 #include <stdlib.h>
29 #include <errno.h>
30 #include <io.h>
31 #include <fcntl.h>
32 #include <signal.h>
33
34 /* must include CRT headers *before* config.h */
35 /* #### I don't believe it - martin */
36 #include <config.h>
37 #undef signal
38 #undef wait
39 #undef spawnve
40 #undef select
41 #undef kill
42
43 #include <windows.h>
44 #include <sys/socket.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 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 msw_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   if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
424     goto EH_Fail;
425   if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
426     goto EH_Fail;
427   sec_attrs.nLength = sizeof (sec_attrs);
428   sec_attrs.lpSecurityDescriptor = &sec_desc;
429   sec_attrs.bInheritHandle = FALSE;
430   
431   strcpy (dir, process_dir);
432   unixtodos_filename (dir);
433   
434   if (!CreateProcess (exe, cmdline, &sec_attrs, NULL, TRUE,
435                       (!NILP (Vwin32_start_process_share_console)
436                        ? CREATE_NEW_PROCESS_GROUP
437                        : CREATE_NEW_CONSOLE),
438                       env, dir,
439                       &start, &cp->procinfo))
440     goto EH_Fail;
441
442   cp->pid = (int) cp->procinfo.dwProcessId;
443
444   CloseHandle (cp->procinfo.hThread);
445   CloseHandle (cp->procinfo.hProcess);
446   cp->procinfo.hThread=NULL;
447   cp->procinfo.hProcess=NULL;
448
449   /* pid must fit in a Lisp_Int */
450
451
452   *pPid = cp->pid;
453   
454   return TRUE;
455   
456  EH_Fail:
457   DebPrint (("create_child.CreateProcess failed: %ld\n", GetLastError()););
458   return FALSE;
459 }
460
461 void
462 merge_and_sort_env (char **envp1, char **envp2, char **new_envp)
463 {
464   char **optr, **nptr;
465   int num;
466
467   nptr = new_envp;
468   optr = envp1;
469   while (*optr)
470     *nptr++ = *optr++;
471   num = optr - envp1;
472
473   optr = envp2;
474   while (*optr)
475     *nptr++ = *optr++;
476   num += optr - envp2;
477
478   qsort (new_envp, num, sizeof (char*), compare_env);
479
480   *nptr = NULL;
481 }
482
483 /* When a new child process is created we need to register it in our list,
484    so intercept spawn requests.  */
485 int 
486 sys_spawnve (int mode, const char *cmdname,
487              const char * const *argv, const char *const *envp)
488 {
489   Lisp_Object program, full;
490   char *cmdline, *env, *parg, **targ;
491   int arglen, numenv;
492   int pid;
493   child_process *cp;
494   int is_dos_app, is_cygnus_app;
495   int do_quoting = 0;
496   char escape_char = 0;
497   /* We pass our process ID to our children by setting up an environment
498      variable in their environment.  */
499   char ppid_env_var_buffer[64];
500   char *extra_env[] = {ppid_env_var_buffer, NULL};
501   struct gcpro gcpro1;
502     
503   /* We don't care about the other modes */
504   if (mode != _P_NOWAIT)
505     {
506       errno = EINVAL;
507       return -1;
508     }
509
510   /* Handle executable names without an executable suffix.  */
511   program = make_string (cmdname, strlen (cmdname));
512   GCPRO1 (program);
513   if (NILP (Ffile_executable_p (program)))
514     {
515       full = Qnil;
516       locate_file (Vexec_path, program, Vlisp_EXEC_SUFFIXES, &full, 1);
517       if (NILP (full))
518         {
519           UNGCPRO;
520           errno = EINVAL;
521           return -1;
522         }
523       TO_EXTERNAL_FORMAT (LISP_STRING, full,
524                           C_STRING_ALLOCA, cmdname,
525                           Qfile_name);
526     }
527   else
528     {
529       cmdname = (char*)alloca (strlen (argv[0]) + 1);
530       strcpy ((char*)cmdname, argv[0]);
531     }
532   UNGCPRO;
533
534   /* make sure argv[0] and cmdname are both in DOS format */
535   unixtodos_filename ((char*)cmdname);
536   /* #### KLUDGE */
537   ((const char**)argv)[0] = cmdname;
538
539   /* Determine whether program is a 16-bit DOS executable, or a Win32
540      executable that is implicitly linked to the Cygnus dll (implying it
541      was compiled with the Cygnus GNU toolchain and hence relies on
542      cygwin.dll to parse the command line - we use this to decide how to
543      escape quote chars in command line args that must be quoted). */
544   mswindows_executable_type (cmdname, &is_dos_app, &is_cygnus_app);
545
546   /* On Windows 95, if cmdname is a DOS app, we invoke a helper
547      application to start it by specifying the helper app as cmdname,
548      while leaving the real app name as argv[0].  */
549   if (is_dos_app)
550     {
551       cmdname = (char*) alloca (MAXPATHLEN);
552       if (egetenv ("CMDPROXY"))
553         strcpy ((char*)cmdname, egetenv ("CMDPROXY"));
554       else
555     {
556           strcpy ((char*)cmdname, XSTRING_DATA (Vinvocation_directory));
557           strcat ((char*)cmdname, "cmdproxy.exe");
558         }
559       unixtodos_filename ((char*)cmdname);
560     }
561   
562   /* we have to do some conjuring here to put argv and envp into the
563      form CreateProcess wants...  argv needs to be a space separated/null
564      terminated list of parameters, and envp is a null
565      separated/double-null terminated list of parameters.
566
567      Additionally, zero-length args and args containing whitespace or
568      quote chars need to be wrapped in double quotes - for this to work,
569      embedded quotes need to be escaped as well.  The aim is to ensure
570      the child process reconstructs the argv array we start with
571      exactly, so we treat quotes at the beginning and end of arguments
572      as embedded quotes.
573
574      The Win32 GNU-based library from Cygnus doubles quotes to escape
575      them, while MSVC uses backslash for escaping.  (Actually the MSVC
576      startup code does attempt to recognize doubled quotes and accept
577      them, but gets it wrong and ends up requiring three quotes to get a
578      single embedded quote!)  So by default we decide whether to use
579      quote or backslash as the escape character based on whether the
580      binary is apparently a Cygnus compiled app.
581
582      Note that using backslash to escape embedded quotes requires
583      additional special handling if an embedded quote is already
584      preceded by backslash, or if an arg requiring quoting ends with
585      backslash.  In such cases, the run of escape characters needs to be
586      doubled.  For consistency, we apply this special handling as long
587      as the escape character is not quote.
588    
589      Since we have no idea how large argv and envp are likely to be we
590      figure out list lengths on the fly and allocate them.  */
591   
592   if (!NILP (Vwin32_quote_process_args))
593     {
594       do_quoting = 1;
595       /* Override escape char by binding win32-quote-process-args to
596          desired character, or use t for auto-selection.  */
597       if (INTP (Vwin32_quote_process_args))
598         escape_char = (char) XINT (Vwin32_quote_process_args);
599       else
600         escape_char = is_cygnus_app ? '"' : '\\';
601     }
602   
603   /* do argv...  */
604   arglen = 0;
605   targ = (char**)argv;
606   while (*targ)
607     {
608       char * p = *targ;
609       int need_quotes = 0;
610       int escape_char_run = 0;
611
612       if (*p == 0)
613         need_quotes = 1;
614       for ( ; *p; p++)
615         {
616           if (*p == '"')
617           {
618               /* allow for embedded quotes to be escaped */
619             arglen++;
620               need_quotes = 1;
621               /* handle the case where the embedded quote is already escaped */
622               if (escape_char_run > 0)
623                 {
624                   /* To preserve the arg exactly, we need to double the
625                      preceding escape characters (plus adding one to
626                      escape the quote character itself).  */
627                   arglen += escape_char_run;
628           }
629             }
630       else if (*p == ' ' || *p == '\t')
631             {
632               need_quotes = 1;
633             }
634
635           if (*p == escape_char && escape_char != '"')
636             escape_char_run++;
637           else
638             escape_char_run = 0;
639         }
640       if (need_quotes)
641         {
642         arglen += 2;
643           /* handle the case where the arg ends with an escape char - we
644              must not let the enclosing quote be escaped.  */
645           if (escape_char_run > 0)
646             arglen += escape_char_run;
647         }
648       arglen += strlen (*targ++) + 1;
649     }
650   cmdline = (char*) alloca (arglen);
651   targ = (char**)argv;
652   parg = cmdline;
653   while (*targ)
654     {
655       char * p = *targ;
656       int need_quotes = 0;
657
658       if (*p == 0)
659         need_quotes = 1;
660
661       if (do_quoting)
662         {
663           for ( ; *p; p++)
664             if (*p == ' ' || *p == '\t' || *p == '"')
665               need_quotes = 1;
666         }
667       if (need_quotes)
668         {
669           int escape_char_run = 0;
670           char * first;
671           char * last;
672
673           p = *targ;
674           first = p;
675           last = p + strlen (p) - 1;
676           *parg++ = '"';
677 #if 0
678           /* This version does not escape quotes if they occur at the
679              beginning or end of the arg - this could lead to incorrect
680              behavior when the arg itself represents a command line
681              containing quoted args.  I believe this was originally done
682              as a hack to make some things work, before
683              `win32-quote-process-args' was added.  */
684           while (*p)
685             {
686               if (*p == '"' && p > first && p < last)
687                 *parg++ = escape_char;  /* escape embedded quotes */
688               *parg++ = *p++;
689             }
690 #else
691           for ( ; *p; p++)
692             {
693               if (*p == '"')
694                 {
695                   /* double preceding escape chars if any */
696                   while (escape_char_run > 0)
697                     {
698                       *parg++ = escape_char;
699                       escape_char_run--;
700                     }
701                   /* escape all quote chars, even at beginning or end */
702                   *parg++ = escape_char;
703                 }
704               *parg++ = *p;
705
706               if (*p == escape_char && escape_char != '"')
707                 escape_char_run++;
708               else
709                 escape_char_run = 0;
710             }
711           /* double escape chars before enclosing quote */
712           while (escape_char_run > 0)
713             {
714               *parg++ = escape_char;
715               escape_char_run--;
716             }
717 #endif
718           *parg++ = '"';
719         }
720       else
721         {
722           strcpy (parg, *targ);
723           parg += strlen (*targ);
724         }
725       *parg++ = ' ';
726       targ++;
727     }
728   *--parg = '\0';
729   
730   /* and envp...  */
731   arglen = 1;
732   targ = (char**) envp;
733   numenv = 1; /* for end null */
734   while (*targ)
735     {
736       arglen += strlen (*targ++) + 1;
737       numenv++;
738     }
739   /* extra env vars... */
740   sprintf (ppid_env_var_buffer, "__PARENT_PROCESS_ID=%d", 
741            GetCurrentProcessId ());
742   arglen += strlen (ppid_env_var_buffer) + 1;
743   numenv++;
744
745   /* merge env passed in and extra env into one, and sort it.  */
746   targ = (char **) alloca (numenv * sizeof (char*));
747   merge_and_sort_env ((char**) envp, extra_env, targ);
748
749   /* concatenate env entries.  */
750   env = (char*) alloca (arglen);
751   parg = env;
752   while (*targ)
753     {
754       strcpy (parg, *targ);
755       parg += strlen (*targ++);
756       *parg++ = '\0';
757     }
758   *parg++ = '\0';
759   *parg = '\0';
760
761   cp = new_child ();
762   if (cp == NULL)
763     {
764       errno = EAGAIN;
765       return -1;
766     }
767   
768   /* Now create the process.  */
769   if (!create_child (cmdname, cmdline, env, &pid, cp))
770     {
771       delete_child (cp);
772       errno = ENOEXEC;
773       return -1;
774     }
775
776   return pid;
777 }
778
779 /* Substitute for certain kill () operations */
780
781 static BOOL CALLBACK
782 find_child_console (HWND hwnd, child_process * cp)
783 {
784   DWORD thread_id;
785   DWORD process_id;
786
787   thread_id = GetWindowThreadProcessId (hwnd, &process_id);
788   if (process_id == cp->procinfo.dwProcessId)
789     {
790       char window_class[32];
791
792       GetClassName (hwnd, window_class, sizeof (window_class));
793       if (strcmp (window_class,
794                   msw_windows9x_p()
795                   ? "tty"
796                   : "ConsoleWindowClass") == 0)
797         {
798           cp->hwnd = hwnd;
799           return FALSE;
800         }
801     }
802   /* keep looking */
803   return TRUE;
804 }
805
806 int 
807 sys_kill (int pid, int sig)
808 {
809   child_process *cp;
810   HANDLE proc_hand;
811   int need_to_free = 0;
812   int rc = 0;
813   
814   /* Only handle signals that will result in the process dying */
815   if (sig != SIGINT && sig != SIGKILL && sig != SIGQUIT && sig != SIGHUP)
816     {
817       errno = EINVAL;
818       return -1;
819     }
820
821   cp = find_child_pid (pid);
822   if (cp == NULL)
823     {
824       proc_hand = OpenProcess (PROCESS_TERMINATE, 0, pid);
825       if (proc_hand == NULL)
826         {
827           errno = EPERM;
828           return -1;
829         }
830       need_to_free = 1;
831     }
832   else
833     {
834       proc_hand = cp->procinfo.hProcess;
835       pid = cp->procinfo.dwProcessId;
836
837       /* Try to locate console window for process. */
838       EnumWindows ((WNDENUMPROC)find_child_console, (LPARAM) cp);
839     }
840   
841   if (sig == SIGINT)
842     {
843       if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd)
844         {
845           BYTE control_scan_code = (BYTE) MapVirtualKey (VK_CONTROL, 0);
846           BYTE vk_break_code = VK_CANCEL;
847           BYTE break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
848           HWND foreground_window;
849
850           if (break_scan_code == 0)
851             {
852               /* Fake Ctrl-C if we can't manage Ctrl-Break. */
853               vk_break_code = 'C';
854               break_scan_code = (BYTE) MapVirtualKey (vk_break_code, 0);
855             }
856
857           foreground_window = GetForegroundWindow ();
858           if (foreground_window && SetForegroundWindow (cp->hwnd))
859             {
860               /* Generate keystrokes as if user had typed Ctrl-Break or Ctrl-C.  */
861               keybd_event (VK_CONTROL, control_scan_code, 0, 0);
862               keybd_event (vk_break_code, break_scan_code, 0, 0);
863               keybd_event (vk_break_code, break_scan_code, KEYEVENTF_KEYUP, 0);
864               keybd_event (VK_CONTROL, control_scan_code, KEYEVENTF_KEYUP, 0);
865
866               /* Sleep for a bit to give time for Emacs frame to respond
867                  to focus change events (if Emacs was active app).  */
868               Sleep (10);
869
870               SetForegroundWindow (foreground_window);
871             }
872         }
873       /* Ctrl-Break is NT equivalent of SIGINT.  */
874       else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid))
875         {
876           DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d "
877                      "for pid %lu\n", GetLastError (), pid));
878           errno = EINVAL;
879           rc = -1;
880         }
881     }
882   else
883     {
884       if (NILP (Vwin32_start_process_share_console) && cp && cp->hwnd)
885         {
886 #if 1
887           if (msw_windows9x_p())
888             {
889 /*
890    Another possibility is to try terminating the VDM out-right by
891    calling the Shell VxD (id 0x17) V86 interface, function #4
892    "SHELL_Destroy_VM", ie.
893
894      mov edx,4
895      mov ebx,vm_handle
896      call shellapi
897
898    First need to determine the current VM handle, and then arrange for
899    the shellapi call to be made from the system vm (by using
900    Switch_VM_and_callback).
901
902    Could try to invoke DestroyVM through CallVxD.
903
904 */
905 #if 0
906               /* On Win95, posting WM_QUIT causes the 16-bit subsystem
907                  to hang when cmdproxy is used in conjunction with
908                  command.com for an interactive shell.  Posting
909                  WM_CLOSE pops up a dialog that, when Yes is selected,
910                  does the same thing.  TerminateProcess is also less
911                  than ideal in that subprocesses tend to stick around
912                  until the machine is shutdown, but at least it
913                  doesn't freeze the 16-bit subsystem.  */
914               PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
915 #endif
916               if (!TerminateProcess (proc_hand, 0xff))
917                 {
918                   DebPrint (("sys_kill.TerminateProcess returned %d "
919                              "for pid %lu\n", GetLastError (), pid));
920                   errno = EINVAL;
921                   rc = -1;
922                 }
923             }
924           else
925 #endif
926             PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
927         }
928       /* Kill the process.  On Win32 this doesn't kill child processes
929          so it doesn't work very well for shells which is why it's not
930          used in every case.  */
931       else if (!TerminateProcess (proc_hand, 0xff))
932         {
933           DebPrint (("sys_kill.TerminateProcess returned %d "
934                      "for pid %lu\n", GetLastError (), pid));
935           errno = EINVAL;
936           rc = -1;
937         }
938     }
939
940   if (need_to_free)
941     CloseHandle (proc_hand);
942
943   return rc;
944 }
945
946 #if 0
947 /* Sync with FSF Emacs 19.34.6 note: ifdef'ed out in XEmacs */
948 extern int report_file_error (const char *, Lisp_Object);
949 #endif
950 /* The following two routines are used to manipulate stdin, stdout, and
951    stderr of our child processes.
952
953    Assuming that in, out, and err are *not* inheritable, we make them
954    stdin, stdout, and stderr of the child as follows:
955
956    - Save the parent's current standard handles.
957    - Set the std handles to inheritable duplicates of the ones being passed in.
958      (Note that _get_osfhandle() is an io.h procedure that retrieves the
959      NT file handle for a crt file descriptor.)
960    - Spawn the child, which inherits in, out, and err as stdin,
961      stdout, and stderr. (see Spawnve)
962    - Close the std handles passed to the child.
963    - Reset the parent's standard handles to the saved handles.
964      (see reset_standard_handles)
965    We assume that the caller closes in, out, and err after calling us.  */
966
967 void
968 prepare_standard_handles (int in, int out, int err, HANDLE handles[3])
969 {
970   HANDLE parent;
971   HANDLE newstdin, newstdout, newstderr;
972
973   parent = GetCurrentProcess ();
974
975   handles[0] = GetStdHandle (STD_INPUT_HANDLE);
976   handles[1] = GetStdHandle (STD_OUTPUT_HANDLE);
977   handles[2] = GetStdHandle (STD_ERROR_HANDLE);
978
979   /* make inheritable copies of the new handles */
980   if (!DuplicateHandle (parent, 
981                        (HANDLE) _get_osfhandle (in),
982                        parent,
983                        &newstdin, 
984                        0, 
985                        TRUE, 
986                        DUPLICATE_SAME_ACCESS))
987     report_file_error ("Duplicating input handle for child", Qnil);
988   
989   if (!DuplicateHandle (parent,
990                        (HANDLE) _get_osfhandle (out),
991                        parent,
992                        &newstdout,
993                        0,
994                        TRUE,
995                        DUPLICATE_SAME_ACCESS))
996     report_file_error ("Duplicating output handle for child", Qnil);
997   
998   if (!DuplicateHandle (parent,
999                        (HANDLE) _get_osfhandle (err),
1000                        parent,
1001                        &newstderr,
1002                        0,
1003                        TRUE,
1004                        DUPLICATE_SAME_ACCESS))
1005     report_file_error ("Duplicating error handle for child", Qnil);
1006
1007   /* and store them as our std handles */
1008   if (!SetStdHandle (STD_INPUT_HANDLE, newstdin))
1009     report_file_error ("Changing stdin handle", Qnil);
1010   
1011   if (!SetStdHandle (STD_OUTPUT_HANDLE, newstdout))
1012     report_file_error ("Changing stdout handle", Qnil);
1013
1014   if (!SetStdHandle (STD_ERROR_HANDLE, newstderr))
1015     report_file_error ("Changing stderr handle", Qnil);
1016 }
1017
1018 void
1019 reset_standard_handles (int in, int out, int err, HANDLE handles[3])
1020 {
1021   /* close the duplicated handles passed to the child */
1022   CloseHandle (GetStdHandle (STD_INPUT_HANDLE));
1023   CloseHandle (GetStdHandle (STD_OUTPUT_HANDLE));
1024   CloseHandle (GetStdHandle (STD_ERROR_HANDLE));
1025
1026   /* now restore parent's saved std handles */
1027   SetStdHandle (STD_INPUT_HANDLE, handles[0]);
1028   SetStdHandle (STD_OUTPUT_HANDLE, handles[1]);
1029   SetStdHandle (STD_ERROR_HANDLE, handles[2]);
1030 }
1031
1032 void
1033 set_process_dir (const char * dir)
1034 {
1035   process_dir = dir;
1036 }
1037 \f
1038 /* Some miscellaneous functions that are Windows specific, but not GUI
1039    specific (ie. are applicable in terminal or batch mode as well).  */
1040
1041 /* lifted from fileio.c  */
1042 #define CORRECT_DIR_SEPS(s) \
1043   do { if ('/' == DIRECTORY_SEP) dostounix_filename (s); \
1044        else unixtodos_filename (s); \
1045   } while (0)
1046
1047 DEFUN ("win32-short-file-name", Fwin32_short_file_name, 1, 1, "", /*
1048   Return the short file name version (8.3) of the full path of FILENAME.
1049 If FILENAME does not exist, return nil.
1050 All path elements in FILENAME are converted to their short names.
1051 */
1052        (filename))
1053 {
1054   char shortname[MAX_PATH];
1055
1056   CHECK_STRING (filename);
1057
1058   /* first expand it.  */
1059   filename = Fexpand_file_name (filename, Qnil);
1060
1061   /* luckily, this returns the short version of each element in the path.  */
1062   if (GetShortPathName (XSTRING_DATA (filename), shortname, MAX_PATH) == 0)
1063     return Qnil;
1064
1065   CORRECT_DIR_SEPS (shortname);
1066
1067   return build_string (shortname);
1068 }
1069
1070
1071 DEFUN ("win32-long-file-name", Fwin32_long_file_name, 1, 1, "", /*
1072   Return the long file name version of the full path of FILENAME.
1073 If FILENAME does not exist, return nil.
1074 All path elements in FILENAME are converted to their long names.
1075 */
1076        (filename))
1077 {
1078   char longname[ MAX_PATH ];
1079
1080   CHECK_STRING (filename);
1081
1082   /* first expand it.  */
1083   filename = Fexpand_file_name (filename, Qnil);
1084
1085   if (!win32_get_long_filename (XSTRING_DATA (filename), longname, MAX_PATH))
1086     return Qnil;
1087
1088   CORRECT_DIR_SEPS (longname);
1089
1090   return build_string (longname);
1091 }
1092
1093 DEFUN ("win32-set-process-priority", Fwin32_set_process_priority, 2, 2, "", /*
1094   Set the priority of PROCESS to PRIORITY.
1095 If PROCESS is nil, the priority of Emacs is changed, otherwise the
1096 priority of the process whose pid is PROCESS is changed.
1097 PRIORITY should be one of the symbols high, normal, or low;
1098 any other symbol will be interpreted as normal.
1099
1100 If successful, the return value is t, otherwise nil.
1101 */
1102        (process, priority))
1103 {
1104   HANDLE proc_handle = GetCurrentProcess ();
1105   DWORD  priority_class = NORMAL_PRIORITY_CLASS;
1106   Lisp_Object result = Qnil;
1107
1108   CHECK_SYMBOL (priority);
1109
1110   if (!NILP (process))
1111     {
1112       DWORD pid;
1113       child_process *cp;
1114
1115       CHECK_INT (process);
1116
1117       /* Allow pid to be an internally generated one, or one obtained
1118          externally.  This is necessary because real pids on Win95 are
1119          negative.  */
1120
1121       pid = XINT (process);
1122       cp = find_child_pid (pid);
1123       if (cp != NULL)
1124         pid = cp->procinfo.dwProcessId;
1125
1126       proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
1127     }
1128
1129   if (EQ (priority, Qhigh))
1130     priority_class = HIGH_PRIORITY_CLASS;
1131   else if (EQ (priority, Qlow))
1132     priority_class = IDLE_PRIORITY_CLASS;
1133
1134   if (proc_handle != NULL)
1135     {
1136       if (SetPriorityClass (proc_handle, priority_class))
1137         result = Qt;
1138       if (!NILP (process))
1139         CloseHandle (proc_handle);
1140     }
1141
1142   return result;
1143 }
1144
1145
1146 DEFUN ("win32-get-locale-info", Fwin32_get_locale_info, 1, 2, "", /*
1147   "Return information about the Windows locale LCID.
1148 By default, return a three letter locale code which encodes the default
1149 language as the first two characters, and the country or regional variant
1150 as the third letter.  For example, ENU refers to `English (United States)',
1151 while ENC means `English (Canadian)'.
1152
1153 If the optional argument LONGFORM is non-nil, the long form of the locale
1154 name is returned, e.g. `English (United States)' instead.
1155
1156 If LCID (a 16-bit number) is not a valid locale, the result is nil.
1157 */
1158      (lcid, longform))
1159 {
1160   int got_abbrev;
1161   int got_full;
1162   char abbrev_name[32] = { 0 };
1163   char full_name[256] = { 0 };
1164
1165   CHECK_INT (lcid);
1166
1167   if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1168     return Qnil;
1169
1170   if (NILP (longform))
1171     {
1172       got_abbrev = GetLocaleInfo (XINT (lcid),
1173                                   LOCALE_SABBREVLANGNAME | LOCALE_USE_CP_ACP,
1174                                   abbrev_name, sizeof (abbrev_name));
1175       if (got_abbrev)
1176         return build_string (abbrev_name);
1177     }
1178   else
1179     {
1180       got_full = GetLocaleInfo (XINT (lcid),
1181                                 LOCALE_SLANGUAGE | LOCALE_USE_CP_ACP,
1182                                 full_name, sizeof (full_name));
1183       if (got_full)
1184         return build_string (full_name);
1185     }
1186
1187   return Qnil;
1188 }
1189
1190
1191 DEFUN ("win32-get-current-locale-id", Fwin32_get_current_locale_id, 0, 0, "", /*
1192   "Return Windows locale id for current locale setting.
1193 This is a numerical value; use `win32-get-locale-info' to convert to a
1194 human-readable form.
1195 */
1196        ())
1197 {
1198   return make_int (GetThreadLocale ());
1199 }
1200
1201
1202 DEFUN ("win32-get-default-locale-id", Fwin32_get_default_locale_id, 0, 1, "", /*
1203   "Return Windows locale id for default locale setting.
1204 By default, the system default locale setting is returned; if the optional
1205 parameter USERP is non-nil, the user default locale setting is returned.
1206 This is a numerical value; use `win32-get-locale-info' to convert to a
1207 human-readable form.
1208 */
1209        (userp))
1210 {
1211   if (NILP (userp))
1212     return make_int (GetSystemDefaultLCID ());
1213   return make_int (GetUserDefaultLCID ());
1214 }
1215
1216 DWORD int_from_hex (char * s)
1217 {
1218   DWORD val = 0;
1219   static char hex[] = "0123456789abcdefABCDEF";
1220   char * p;
1221
1222   while (*s && (p = strchr(hex, *s)) != NULL)
1223     {
1224       unsigned digit = p - hex;
1225       if (digit > 15)
1226         digit -= 6;
1227       val = val * 16 + digit;
1228       s++;
1229     }
1230   return val;
1231 }
1232
1233 /* We need to build a global list, since the EnumSystemLocale callback
1234    function isn't given a context pointer.  */
1235 Lisp_Object Vwin32_valid_locale_ids;
1236
1237 BOOL CALLBACK enum_locale_fn (LPTSTR localeNum)
1238 {
1239   DWORD id = int_from_hex (localeNum);
1240   Vwin32_valid_locale_ids = Fcons (make_int (id), Vwin32_valid_locale_ids);
1241   return TRUE;
1242 }
1243
1244 DEFUN ("win32-get-valid-locale-ids", Fwin32_get_valid_locale_ids, 0, 0, "", /*
1245   Return list of all valid Windows locale ids.
1246 Each id is a numerical value; use `win32-get-locale-info' to convert to a
1247 human-readable form.
1248 */
1249        ())
1250 {
1251   Vwin32_valid_locale_ids = Qnil;
1252
1253   EnumSystemLocales (enum_locale_fn, LCID_SUPPORTED);
1254
1255   Vwin32_valid_locale_ids = Fnreverse (Vwin32_valid_locale_ids);
1256   return Vwin32_valid_locale_ids;
1257 }
1258
1259
1260 DEFUN ("win32-set-current-locale", Fwin32_set_current_locale, 1, 1, "", /*
1261   Make Windows locale LCID be the current locale setting for Emacs.
1262 If successful, the new locale id is returned, otherwise nil.
1263 */
1264      (lcid))
1265 {
1266   CHECK_INT (lcid);
1267
1268   if (!IsValidLocale (XINT (lcid), LCID_SUPPORTED))
1269     return Qnil;
1270
1271   if (!SetThreadLocale (XINT (lcid)))
1272     return Qnil;
1273
1274 /* Sync with FSF Emacs 19.34.6 note: dwWinThreadId declared in
1275    w32term.h and defined in w32fns.c, both of which are not in current
1276    XEmacs.  #### Check what we lose by ifdef'ing out these. --marcpa */
1277 #if 0
1278   /* Need to set input thread locale if present.  */
1279   if (dwWinThreadId)
1280     /* Reply is not needed.  */
1281     PostThreadMessage (dwWinThreadId, WM_EMACS_SETLOCALE, XINT (lcid), 0);
1282 #endif
1283
1284   return make_int (GetThreadLocale ());
1285 }
1286
1287 \f
1288 void
1289 syms_of_ntproc (void)
1290 {
1291   DEFSUBR (Fwin32_short_file_name);
1292   DEFSUBR (Fwin32_long_file_name);
1293   DEFSUBR (Fwin32_set_process_priority);
1294   DEFSUBR (Fwin32_get_locale_info);
1295   DEFSUBR (Fwin32_get_current_locale_id);
1296   DEFSUBR (Fwin32_get_default_locale_id);
1297   DEFSUBR (Fwin32_get_valid_locale_ids);
1298   DEFSUBR (Fwin32_set_current_locale);
1299 }
1300
1301
1302 void
1303 vars_of_ntproc (void)
1304 {
1305   defsymbol (&Qhigh, "high");
1306   defsymbol (&Qlow, "low");
1307
1308   DEFVAR_LISP ("win32-quote-process-args", &Vwin32_quote_process_args /*
1309     Non-nil enables quoting of process arguments to ensure correct parsing.
1310 Because Windows does not directly pass argv arrays to child processes,
1311 programs have to reconstruct the argv array by parsing the command
1312 line string.  For an argument to contain a space, it must be enclosed
1313 in double quotes or it will be parsed as multiple arguments.
1314
1315 If the value is a character, that character will be used to escape any
1316 quote characters that appear, otherwise a suitable escape character
1317 will be chosen based on the type of the program.
1318 */ );
1319   Vwin32_quote_process_args = Qt;
1320
1321   DEFVAR_LISP ("win32-start-process-show-window",
1322                &Vwin32_start_process_show_window /*
1323     When nil, processes started via start-process hide their windows.
1324 When non-nil, they show their window in the method of their choice.
1325 */ );
1326   Vwin32_start_process_show_window = Qnil;
1327
1328   DEFVAR_LISP ("win32-start-process-share-console",
1329                &Vwin32_start_process_share_console /*
1330     When nil, processes started via start-process are given a new console.
1331 When non-nil, they share the Emacs console; this has the limitation of
1332 allowing only only DOS subprocess to run at a time (whether started directly
1333 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
1334 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't
1335 otherwise respond to interrupts from Emacs.
1336 */ );
1337   Vwin32_start_process_share_console = Qt;
1338
1339   DEFVAR_LISP ("win32-pipe-read-delay", &Vwin32_pipe_read_delay /*
1340     Forced delay before reading subprocess output.
1341 This is done to improve the buffering of subprocess output, by
1342 avoiding the inefficiency of frequently reading small amounts of data.
1343
1344 If positive, the value is the number of milliseconds to sleep before
1345 reading the subprocess output.  If negative, the magnitude is the number
1346 of time slices to wait (effectively boosting the priority of the child
1347 process temporarily).  A value of zero disables waiting entirely.
1348 */ );
1349   Vwin32_pipe_read_delay = make_int (50);
1350
1351 #if 0
1352   DEFVAR_LISP ("win32-generate-fake-inodes", &Vwin32_generate_fake_inodes /*
1353     "Non-nil means attempt to fake realistic inode values.
1354 This works by hashing the truename of files, and should detect 
1355 aliasing between long and short (8.3 DOS) names, but can have
1356 false positives because of hash collisions.  Note that determining
1357 the truename of a file can be slow.
1358 */ );
1359   Vwin32_generate_fake_inodes = Qnil;
1360 #endif
1361 }
1362
1363 /* end of ntproc.c */