comparison src/process-nt.c @ 428:3ecd8885ac67 r21-2-22

Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children a5df635868b2
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Asynchronous subprocess implementation for Win32
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing.
6
7 This file is part of XEmacs.
8
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
12 later version.
13
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
17 for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
23
24 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */
25
26 #include <config.h>
27 #include "lisp.h"
28
29 #include "hash.h"
30 #include "lstream.h"
31 #include "process.h"
32 #include "procimpl.h"
33 #include "sysdep.h"
34
35 #include <windows.h>
36 #ifndef __MINGW32__
37 #include <shellapi.h>
38 #else
39 #include <errno.h>
40 #endif
41 #include <signal.h>
42 #ifdef HAVE_SOCKETS
43 #include <winsock.h>
44 #endif
45
46 /* Arbitrary size limit for code fragments passed to run_in_other_process */
47 #define FRAGMENT_CODE_SIZE 32
48
49 /* Bound by winnt.el */
50 Lisp_Object Qnt_quote_process_args;
51
52 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */
53 struct nt_process_data
54 {
55 HANDLE h_process;
56 };
57
58 #define NT_DATA(p) ((struct nt_process_data*)((p)->process_data))
59
60 /*-----------------------------------------------------------------------*/
61 /* Process helpers */
62 /*-----------------------------------------------------------------------*/
63
64 /* This one breaks process abstraction. Prototype is in console-msw.h,
65 used by select_process method in event-msw.c */
66 HANDLE
67 get_nt_process_handle (struct Lisp_Process *p)
68 {
69 return (NT_DATA (p)->h_process);
70 }
71
72 /*-----------------------------------------------------------------------*/
73 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */
74 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/
75 /*-----------------------------------------------------------------------*/
76
77 typedef struct
78 {
79 HANDLE h_process;
80 HANDLE h_thread;
81 LPVOID address;
82 } process_memory;
83
84 /*
85 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used
86 * further by other routines. Return nonzero if successful.
87 *
88 * The memory in other process is allocated by creating a suspended
89 * thread. Initial stack of that thread is used as the memory
90 * block. The thread entry point is the routine ExitThread in
91 * kernel32.dll, so the allocated memory is freed just by resuming the
92 * thread, which immediately terminates after that.
93 */
94
95 static int
96 alloc_process_memory (HANDLE h_process, size_t size,
97 process_memory* pmc)
98 {
99 LPTHREAD_START_ROUTINE adr_ExitThread =
100 (LPTHREAD_START_ROUTINE)
101 GetProcAddress (GetModuleHandle ("kernel32"), "ExitThread");
102 DWORD dw_unused;
103 CONTEXT context;
104 MEMORY_BASIC_INFORMATION mbi;
105
106 pmc->h_process = h_process;
107 pmc->h_thread = CreateRemoteThread (h_process, NULL, size,
108 adr_ExitThread, NULL,
109 CREATE_SUSPENDED, &dw_unused);
110 if (pmc->h_thread == NULL)
111 return 0;
112
113 /* Get context, for thread's stack pointer */
114 context.ContextFlags = CONTEXT_CONTROL;
115 if (!GetThreadContext (pmc->h_thread, &context))
116 goto failure;
117
118 /* Determine base address of the committed range */
119 if (sizeof(mbi) != VirtualQueryEx (h_process,
120 #if defined (_X86_)
121 (LPDWORD)context.Esp - 1,
122 #elif defined (_ALPHA_)
123 (LPDWORD)context.IntSp - 1,
124 #else
125 #error Unknown processor architecture
126 #endif
127 &mbi, sizeof(mbi)))
128 goto failure;
129
130 /* Change the page protection of the allocated memory to executable,
131 read, and write. */
132 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size,
133 PAGE_EXECUTE_READWRITE, &dw_unused))
134 goto failure;
135
136 pmc->address = mbi.BaseAddress;
137 return 1;
138
139 failure:
140 ResumeThread (pmc->h_thread);
141 pmc->address = 0;
142 return 0;
143 }
144
145 static void
146 free_process_memory (process_memory* pmc)
147 {
148 ResumeThread (pmc->h_thread);
149 }
150
151 /*
152 * Run ROUTINE in the context of process determined by H_PROCESS. The
153 * routine is passed the address of DATA as parameter. The ROUTINE must
154 * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of
155 * DATA structure.
156 *
157 * Note that the code must be positionally independent, and compiled
158 * without stack checks (they cause implicit calls into CRT so will
159 * fail). DATA should not refer any data in calling process, as both
160 * routine and its data are copied into remote process. Size of data
161 * and code together should not exceed one page (4K on x86 systems).
162 *
163 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed.
164 */
165 static DWORD
166 run_in_other_process (HANDLE h_process,
167 LPTHREAD_START_ROUTINE routine,
168 LPVOID data, size_t data_size)
169 {
170 process_memory pm;
171 CONST size_t code_size = FRAGMENT_CODE_SIZE;
172 /* Need at most 3 extra bytes of memory, for data alignment */
173 size_t total_size = code_size + data_size + 3;
174 LPVOID remote_data;
175 HANDLE h_thread;
176 DWORD dw_unused;
177
178 /* Allocate memory */
179 if (!alloc_process_memory (h_process, total_size, &pm))
180 return (DWORD)-1;
181
182 /* Copy code */
183 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine,
184 code_size, NULL))
185 goto failure;
186
187 /* Copy data */
188 if (data_size)
189 {
190 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3);
191 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL))
192 goto failure;
193 }
194 else
195 remote_data = NULL;
196
197 /* Execute the remote copy of code, passing it remote data */
198 h_thread = CreateRemoteThread (h_process, NULL, 0,
199 (LPTHREAD_START_ROUTINE) pm.address,
200 remote_data, 0, &dw_unused);
201 if (h_thread == NULL)
202 goto failure;
203
204 /* Wait till thread finishes */
205 WaitForSingleObject (h_thread, INFINITE);
206
207 /* Free remote memory */
208 free_process_memory (&pm);
209
210 /* Return thread's exit code */
211 {
212 DWORD exit_code;
213 GetExitCodeThread (h_thread, &exit_code);
214 CloseHandle (h_thread);
215 return exit_code;
216 }
217
218 failure:
219 free_process_memory (&pm);
220 return (DWORD)-1;
221 }
222
223 /*-----------------------------------------------------------------------*/
224 /* Sending signals */
225 /*-----------------------------------------------------------------------*/
226
227 /*
228 * We handle the following signals:
229 *
230 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess
231 * executed by the remote process
232 * SIGINT - The remote process is sent CTRL_BREAK_EVENT
233 *
234 * The MSVC5.0 compiler feels free to re-order functions within a
235 * compilation unit, so we have no way of finding out the size of the
236 * following functions. Therefore these functions must not be larger than
237 * FRAGMENT_CODE_SIZE.
238 */
239
240 /*
241 * Sending SIGKILL
242 */
243 typedef struct
244 {
245 void (WINAPI *adr_ExitProcess) (UINT);
246 } sigkill_data;
247
248 static DWORD WINAPI
249 sigkill_proc (sigkill_data* data)
250 {
251 (*data->adr_ExitProcess)(255);
252 return 1;
253 }
254
255 /*
256 * Sending break or control c
257 */
258 typedef struct
259 {
260 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD);
261 DWORD event;
262 } sigint_data;
263
264 static DWORD WINAPI
265 sigint_proc (sigint_data* data)
266 {
267 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0);
268 }
269
270 /*
271 * Enabling signals
272 */
273 typedef struct
274 {
275 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL);
276 } sig_enable_data;
277
278 static DWORD WINAPI
279 sig_enable_proc (sig_enable_data* data)
280 {
281 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE);
282 return 1;
283 }
284
285 /*
286 * Send signal SIGNO to process H_PROCESS.
287 * Return nonzero if successful.
288 */
289
290 /* This code assigns a return value of GetProcAddress to function pointers
291 of many different types. Instead of heavy obscure casts, we just disable
292 warnings about assignments to different function pointer types. */
293 #pragma warning (disable : 4113)
294
295 static int
296 send_signal (HANDLE h_process, int signo)
297 {
298 HMODULE h_kernel = GetModuleHandle ("kernel32");
299 DWORD retval;
300
301 assert (h_kernel != NULL);
302
303 switch (signo)
304 {
305 case SIGKILL:
306 case SIGTERM:
307 case SIGQUIT:
308 case SIGHUP:
309 {
310 sigkill_data d;
311 d.adr_ExitProcess = GetProcAddress (h_kernel, "ExitProcess");
312 assert (d.adr_ExitProcess);
313 retval = run_in_other_process (h_process,
314 (LPTHREAD_START_ROUTINE)sigkill_proc,
315 &d, sizeof (d));
316 break;
317 }
318 case SIGINT:
319 {
320 sigint_data d;
321 d.adr_GenerateConsoleCtrlEvent =
322 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent");
323 assert (d.adr_GenerateConsoleCtrlEvent);
324 d.event = CTRL_C_EVENT;
325 retval = run_in_other_process (h_process,
326 (LPTHREAD_START_ROUTINE)sigint_proc,
327 &d, sizeof (d));
328 break;
329 }
330 default:
331 assert (0);
332 }
333
334 return (int)retval > 0 ? 1 : 0;
335 }
336
337 /*
338 * Enable CTRL_C_EVENT handling in a new child process
339 */
340 static void
341 enable_child_signals (HANDLE h_process)
342 {
343 HMODULE h_kernel = GetModuleHandle ("kernel32");
344 sig_enable_data d;
345
346 assert (h_kernel != NULL);
347 d.adr_SetConsoleCtrlHandler =
348 GetProcAddress (h_kernel, "SetConsoleCtrlHandler");
349 assert (d.adr_SetConsoleCtrlHandler);
350 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc,
351 &d, sizeof (d));
352 }
353
354 #pragma warning (default : 4113)
355
356 /*
357 * Signal error if SIGNO is not supported
358 */
359 static void
360 validate_signal_number (int signo)
361 {
362 if (signo != SIGKILL && signo != SIGTERM
363 && signo != SIGQUIT && signo != SIGINT
364 && signo != SIGHUP)
365 signal_simple_error ("Signal number not supported", make_int (signo));
366 }
367
368 /*-----------------------------------------------------------------------*/
369 /* Process methods */
370 /*-----------------------------------------------------------------------*/
371
372 /*
373 * Allocate and initialize Lisp_Process->process_data
374 */
375
376 static void
377 nt_alloc_process_data (struct Lisp_Process *p)
378 {
379 p->process_data = xnew_and_zero (struct nt_process_data);
380 }
381
382 static void
383 nt_finalize_process_data (struct Lisp_Process *p, int for_disksave)
384 {
385 assert (!for_disksave);
386 if (NT_DATA(p)->h_process)
387 CloseHandle (NT_DATA(p)->h_process);
388 }
389
390 /*
391 * Initialize XEmacs process implementation once
392 */
393 static void
394 nt_init_process (void)
395 {
396 /* Initialize winsock */
397 WSADATA wsa_data;
398 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
399 WSAStartup (MAKEWORD (1,1), &wsa_data);
400 }
401
402 /*
403 * Fork off a subprocess. P is a pointer to newly created subprocess
404 * object. If this function signals, the caller is responsible for
405 * deleting (and finalizing) the process object.
406 *
407 * The method must return PID of the new process, a (positive??? ####) number
408 * which fits into Lisp_Int. No return value indicates an error, the method
409 * must signal an error instead.
410 */
411
412 static void
413 signal_cannot_launch (Lisp_Object image_file, DWORD err)
414 {
415 mswindows_set_errno (err);
416 signal_simple_error_2 ("Error starting", image_file, lisp_strerror (errno));
417 }
418
419 static int
420 nt_create_process (struct Lisp_Process *p,
421 Lisp_Object *argv, int nargv,
422 Lisp_Object program, Lisp_Object cur_dir)
423 {
424 HANDLE hmyshove, hmyslurp, hprocin, hprocout;
425 LPTSTR command_line;
426 BOOL do_io, windowed;
427 char *proc_env;
428
429 /* Find out whether the application is windowed or not */
430 {
431 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most
432 errors. This leads to bogus error message. */
433 DWORD image_type;
434 char *p = strrchr ((char *)XSTRING_DATA (program), '.');
435 if (p != NULL &&
436 (stricmp (p, ".exe") == 0 ||
437 stricmp (p, ".com") == 0 ||
438 stricmp (p, ".bat") == 0 ||
439 stricmp (p, ".cmd") == 0))
440 {
441 image_type = SHGetFileInfo ((char *)XSTRING_DATA (program), 0,NULL,
442 0, SHGFI_EXETYPE);
443 }
444 else
445 {
446 char progname[MAX_PATH];
447 sprintf (progname, "%s.exe", (char *)XSTRING_DATA (program));
448 image_type = SHGetFileInfo (progname, 0, NULL, 0, SHGFI_EXETYPE);
449 }
450 if (image_type == 0)
451 signal_cannot_launch (program, (GetLastError () == ERROR_FILE_NOT_FOUND
452 ? ERROR_BAD_FORMAT : GetLastError ()));
453 windowed = HIWORD (image_type) != 0;
454 }
455
456 /* Decide whether to do I/O on process handles, or just mark the
457 process exited immediately upon successful launching. We do I/O if the
458 process is a console one, or if it is windowed but windowed_process_io
459 is non-zero */
460 do_io = !windowed || windowed_process_io ;
461
462 if (do_io)
463 {
464 /* Create two unidirectional named pipes */
465 HANDLE htmp;
466 SECURITY_ATTRIBUTES sa;
467
468 sa.nLength = sizeof(sa);
469 sa.bInheritHandle = TRUE;
470 sa.lpSecurityDescriptor = NULL;
471
472 CreatePipe (&hprocin, &hmyshove, &sa, 0);
473 CreatePipe (&hmyslurp, &hprocout, &sa, 0);
474
475 /* Stupid Win32 allows to create a pipe with *both* ends either
476 inheritable or not. We need process ends inheritable, and local
477 ends not inheritable. */
478 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), &htmp,
479 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
480 hmyshove = htmp;
481 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), &htmp,
482 0, FALSE, DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
483 hmyslurp = htmp;
484 }
485
486 /* Convert an argv vector into Win32 style command line by a call to
487 lisp function `nt-quote-process-args' which see (in winnt.el)*/
488 {
489 int i;
490 Lisp_Object args_or_ret = Qnil;
491 struct gcpro gcpro1;
492
493 GCPRO1 (args_or_ret);
494
495 for (i = 0; i < nargv; ++i)
496 args_or_ret = Fcons (*argv++, args_or_ret);
497 args_or_ret = Fnreverse (args_or_ret);
498 args_or_ret = Fcons (program, args_or_ret);
499
500 args_or_ret = call1 (Qnt_quote_process_args, args_or_ret);
501
502 if (!STRINGP (args_or_ret))
503 /* Luser wrote his/her own clever version */
504 error ("Bogus return value from `nt-quote-process-args'");
505
506 command_line = alloca_array (char, (XSTRING_LENGTH (program)
507 + XSTRING_LENGTH (args_or_ret) + 2));
508 strcpy (command_line, XSTRING_DATA (program));
509 strcat (command_line, " ");
510 strcat (command_line, XSTRING_DATA (args_or_ret));
511
512 UNGCPRO; /* args_or_ret */
513 }
514
515 /* Set `proc_env' to a nul-separated array of the strings in
516 Vprocess_environment terminated by 2 nuls. */
517
518 {
519 extern int compare_env (const char **strp1, const char **strp2);
520 char **env;
521 REGISTER Lisp_Object tem;
522 REGISTER char **new_env;
523 REGISTER int new_length = 0, i, new_space;
524 char *penv;
525
526 for (tem = Vprocess_environment;
527 (CONSP (tem)
528 && STRINGP (XCAR (tem)));
529 tem = XCDR (tem))
530 new_length++;
531
532 /* new_length + 1 to include terminating 0. */
533 env = new_env = alloca_array (char *, new_length + 1);
534
535 /* Copy the Vprocess_environment strings into new_env. */
536 for (tem = Vprocess_environment;
537 (CONSP (tem)
538 && STRINGP (XCAR (tem)));
539 tem = XCDR (tem))
540 {
541 char **ep = env;
542 char *string = (char *) XSTRING_DATA (XCAR (tem));
543 /* See if this string duplicates any string already in the env.
544 If so, don't put it in.
545 When an env var has multiple definitions,
546 we keep the definition that comes first in process-environment. */
547 for (; ep != new_env; ep++)
548 {
549 char *p = *ep, *q = string;
550 while (1)
551 {
552 if (*q == 0)
553 /* The string is malformed; might as well drop it. */
554 goto duplicate;
555 if (*q != *p)
556 break;
557 if (*q == '=')
558 goto duplicate;
559 p++, q++;
560 }
561 }
562 *new_env++ = string;
563 duplicate: ;
564 }
565 *new_env = 0;
566
567 /* Sort the environment variables */
568 new_length = new_env - env;
569 qsort (env, new_length, sizeof (char *), compare_env);
570
571 /* Work out how much space to allocate */
572 new_space = 0;
573 for (i = 0; i < new_length; i++)
574 {
575 new_space += strlen(env[i]) + 1;
576 }
577 new_space++;
578
579 /* Allocate space and copy variables into it */
580 penv = proc_env = alloca(new_space);
581 for (i = 0; i < new_length; i++)
582 {
583 strcpy(penv, env[i]);
584 penv += strlen(env[i]) + 1;
585 }
586 *penv = 0;
587 }
588
589 /* Create process */
590 {
591 STARTUPINFO si;
592 PROCESS_INFORMATION pi;
593 DWORD err;
594
595 xzero (si);
596 si.dwFlags = STARTF_USESHOWWINDOW;
597 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
598 if (do_io)
599 {
600 si.hStdInput = hprocin;
601 si.hStdOutput = hprocout;
602 si.hStdError = hprocout;
603 si.dwFlags |= STARTF_USESTDHANDLES;
604 }
605
606 err = (CreateProcess (NULL, command_line, NULL, NULL, TRUE,
607 CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP
608 | CREATE_SUSPENDED,
609 proc_env, (char *) XSTRING_DATA (cur_dir), &si, &pi)
610 ? 0 : GetLastError ());
611
612 if (do_io)
613 {
614 /* These just have been inherited; we do not need a copy */
615 CloseHandle (hprocin);
616 CloseHandle (hprocout);
617 }
618
619 /* Handle process creation failure */
620 if (err)
621 {
622 if (do_io)
623 {
624 CloseHandle (hmyshove);
625 CloseHandle (hmyslurp);
626 }
627 signal_cannot_launch (program, GetLastError ());
628 }
629
630 /* The process started successfully */
631 if (do_io)
632 {
633 NT_DATA(p)->h_process = pi.hProcess;
634 init_process_io_handles (p, (void*)hmyslurp, (void*)hmyshove, 0);
635 }
636 else
637 {
638 /* Indicate as if the process has exited immediately. */
639 p->status_symbol = Qexit;
640 CloseHandle (pi.hProcess);
641 }
642
643 if (!windowed)
644 enable_child_signals (pi.hProcess);
645
646 ResumeThread (pi.hThread);
647 CloseHandle (pi.hThread);
648
649 /* Hack to support Windows 95 negative pids */
650 return ((int)pi.dwProcessId < 0
651 ? -(int)pi.dwProcessId : (int)pi.dwProcessId);
652 }
653 }
654
655 /*
656 * This method is called to update status fields of the process
657 * structure. If the process has not existed, this method is expected
658 * to do nothing.
659 *
660 * The method is called only for real child processes.
661 */
662
663 static void
664 nt_update_status_if_terminated (struct Lisp_Process* p)
665 {
666 DWORD exit_code;
667 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
668 && exit_code != STILL_ACTIVE)
669 {
670 p->tick++;
671 p->core_dumped = 0;
672 /* The exit code can be a code returned by process, or an
673 NTSTATUS value. We cannot accurately handle the latter since
674 it is a full 32 bit integer */
675 if (exit_code & 0xC0000000)
676 {
677 p->status_symbol = Qsignal;
678 p->exit_code = exit_code & 0x1FFFFFFF;
679 }
680 else
681 {
682 p->status_symbol = Qexit;
683 p->exit_code = exit_code;
684 }
685 }
686 }
687
688 /*
689 * Stuff the entire contents of LSTREAM to the process output pipe
690 */
691
692 /* #### If only this function could be somehow merged with
693 unix_send_process... */
694
695 static void
696 nt_send_process (Lisp_Object proc, struct lstream* lstream)
697 {
698 struct Lisp_Process *p = XPROCESS (proc);
699
700 /* use a reasonable-sized buffer (somewhere around the size of the
701 stream buffer) so as to avoid inundating the stream with blocked
702 data. */
703 Bufbyte chunkbuf[128];
704 Bytecount chunklen;
705
706 while (1)
707 {
708 ssize_t writeret;
709
710 chunklen = Lstream_read (lstream, chunkbuf, 128);
711 if (chunklen <= 0)
712 break; /* perhaps should abort() if < 0?
713 This should never happen. */
714
715 /* Lstream_write() will never successfully write less than the
716 amount sent in. In the worst case, it just buffers the
717 unwritten data. */
718 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf,
719 chunklen);
720 Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p)));
721 if (writeret < 0)
722 {
723 p->status_symbol = Qexit;
724 p->exit_code = ERROR_BROKEN_PIPE;
725 p->core_dumped = 0;
726 p->tick++;
727 process_tick++;
728 deactivate_process (proc);
729 error ("Broken pipe error sending to process %s; closed it",
730 XSTRING_DATA (p->name));
731 }
732
733 {
734 int wait_ms = 25;
735 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
736 {
737 /* Buffer is full. Wait, accepting input; that may allow
738 the program to finish doing output and read more. */
739 Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
740 Lstream_flush (XLSTREAM (p->pipe_outstream));
741 wait_ms = min (1000, 2 * wait_ms);
742 }
743 }
744 }
745 }
746
747 /*
748 * Send a signal number SIGNO to PROCESS.
749 * CURRENT_GROUP means send to the process group that currently owns
750 * the terminal being used to communicate with PROCESS.
751 * This is used for various commands in shell mode.
752 * If NOMSG is zero, insert signal-announcements into process's buffers
753 * right away.
754 *
755 * If we can, we try to signal PROCESS by sending control characters
756 * down the pty. This allows us to signal inferiors who have changed
757 * their uid, for which killpg would return an EPERM error.
758 *
759 * The method signals an error if the given SIGNO is not valid
760 */
761
762 static void
763 nt_kill_child_process (Lisp_Object proc, int signo,
764 int current_group, int nomsg)
765 {
766 struct Lisp_Process *p = XPROCESS (proc);
767
768 /* Signal error if SIGNO cannot be sent */
769 validate_signal_number (signo);
770
771 /* Send signal */
772 if (!send_signal (NT_DATA(p)->h_process, signo))
773 error ("Cannot send signal to process");
774 }
775
776 /*
777 * Kill any process in the system given its PID.
778 *
779 * Returns zero if a signal successfully sent, or
780 * negative number upon failure
781 */
782 static int
783 nt_kill_process_by_pid (int pid, int signo)
784 {
785 HANDLE h_process;
786 int send_result;
787
788 /* Signal error if SIGNO cannot be sent */
789 validate_signal_number (signo);
790
791 /* Try to open the process with required privileges */
792 h_process = OpenProcess (PROCESS_CREATE_THREAD
793 | PROCESS_QUERY_INFORMATION
794 | PROCESS_VM_OPERATION
795 | PROCESS_VM_WRITE,
796 FALSE, pid);
797 if (h_process == NULL)
798 return -1;
799
800 send_result = send_signal (h_process, signo);
801
802 CloseHandle (h_process);
803
804 return send_result ? 0 : -1;
805 }
806
807 /*-----------------------------------------------------------------------*/
808 /* Sockets connections */
809 /*-----------------------------------------------------------------------*/
810 #ifdef HAVE_SOCKETS
811
812 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
813
814 #define SOCK_TIMER_ID 666
815 #define XM_SOCKREPLY (WM_USER + 666)
816
817 static int
818 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
819 Error_behavior errb)
820 {
821 char buf [MAXGETHOSTSTRUCT];
822 HWND hwnd;
823 HANDLE hasync;
824 int success = 0;
825
826 address->sin_family = AF_INET;
827
828 /* First check if HOST is already a numeric address */
829 {
830 unsigned long inaddr = inet_addr (XSTRING_DATA (host));
831 if (inaddr != INADDR_NONE)
832 {
833 address->sin_addr.s_addr = inaddr;
834 return 1;
835 }
836 }
837
838 /* Create a window which will receive completion messages */
839 hwnd = CreateWindow ("STATIC", NULL, WS_OVERLAPPED, 0, 0, 1, 1,
840 NULL, NULL, NULL, NULL);
841 assert (hwnd);
842
843 /* Post name resolution request */
844 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, XSTRING_DATA (host),
845 buf, sizeof (buf));
846 if (hasync == NULL)
847 goto done;
848
849 /* Set a timer to poll for quit every 250 ms */
850 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
851
852 while (1)
853 {
854 MSG msg;
855 GetMessage (&msg, hwnd, 0, 0);
856 if (msg.message == XM_SOCKREPLY)
857 {
858 /* Ok, got an answer */
859 if (WSAGETASYNCERROR(msg.lParam) == NO_ERROR)
860 success = 1;
861 goto done;
862 }
863 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
864 {
865 if (QUITP)
866 {
867 WSACancelAsyncRequest (hasync);
868 KillTimer (hwnd, SOCK_TIMER_ID);
869 DestroyWindow (hwnd);
870 REALLY_QUIT;
871 }
872 }
873 DispatchMessage (&msg);
874 }
875
876 done:
877 KillTimer (hwnd, SOCK_TIMER_ID);
878 DestroyWindow (hwnd);
879 if (success)
880 {
881 /* BUF starts with struct hostent */
882 struct hostent* he = (struct hostent*) buf;
883 address->sin_addr.s_addr = *(unsigned long*)he->h_addr_list[0];
884 }
885 return success;
886 }
887
888 static Lisp_Object
889 nt_canonicalize_host_name (Lisp_Object host)
890 {
891 struct sockaddr_in address;
892
893 if (!get_internet_address (host, &address, ERROR_ME_NOT))
894 return host;
895
896 if (address.sin_family == AF_INET)
897 return build_string (inet_ntoa (address.sin_addr));
898 else
899 return host;
900 }
901
902 /* open a TCP network connection to a given HOST/SERVICE. Treated
903 exactly like a normal process when reading and writing. Only
904 differences are in status display and process deletion. A network
905 connection has no PID; you cannot signal it. All you can do is
906 deactivate and close it via delete-process */
907
908 static void
909 nt_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
910 Lisp_Object protocol, void** vinfd, void** voutfd)
911 {
912 struct sockaddr_in address;
913 SOCKET s;
914 int port;
915 int retval;
916
917 CHECK_STRING (host);
918
919 if (!EQ (protocol, Qtcp))
920 error ("Unsupported protocol \"%s\"",
921 string_data (symbol_name (XSYMBOL (protocol))));
922
923 if (INTP (service))
924 port = htons ((unsigned short) XINT (service));
925 else
926 {
927 struct servent *svc_info;
928 CHECK_STRING (service);
929 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
930 if (svc_info == 0)
931 error ("Unknown service \"%s\"", XSTRING_DATA (service));
932 port = svc_info->s_port;
933 }
934
935 get_internet_address (host, &address, ERROR_ME);
936 address.sin_port = port;
937
938 s = socket (address.sin_family, SOCK_STREAM, 0);
939 if (s < 0)
940 report_file_error ("error creating socket", list1 (name));
941
942 /* We don't want to be blocked on connect */
943 {
944 unsigned long nonblock = 1;
945 ioctlsocket (s, FIONBIO, &nonblock);
946 }
947
948 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
949 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
950 goto connect_failed;
951
952 /* Wait while connection is established */
953 while (1)
954 {
955 fd_set fdset;
956 struct timeval tv;
957 int nsel;
958
959 if (QUITP)
960 {
961 closesocket (s);
962 REALLY_QUIT;
963 }
964
965 /* Poll for quit every 250 ms */
966 tv.tv_sec = 0;
967 tv.tv_usec = 250 * 1000;
968
969 FD_ZERO (&fdset);
970 FD_SET (s, &fdset);
971 nsel = select (0, NULL, &fdset, &fdset, &tv);
972
973 if (nsel > 0)
974 {
975 /* Check: was connection successful or not? */
976 tv.tv_usec = 0;
977 nsel = select (0, NULL, NULL, &fdset, &tv);
978 if (nsel > 0)
979 goto connect_failed;
980 else
981 break;
982 }
983 }
984
985 /* We are connected at this point */
986 *vinfd = (void*)s;
987 DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
988 GetCurrentProcess(), (LPHANDLE)voutfd,
989 0, FALSE, DUPLICATE_SAME_ACCESS);
990 return;
991
992 connect_failed:
993 closesocket (s);
994 report_file_error ("connection failed", list2 (host, name));
995 }
996
997 #endif
998
999 /*-----------------------------------------------------------------------*/
1000 /* Initialization */
1001 /*-----------------------------------------------------------------------*/
1002
1003 void
1004 process_type_create_nt (void)
1005 {
1006 PROCESS_HAS_METHOD (nt, alloc_process_data);
1007 PROCESS_HAS_METHOD (nt, finalize_process_data);
1008 PROCESS_HAS_METHOD (nt, init_process);
1009 PROCESS_HAS_METHOD (nt, create_process);
1010 PROCESS_HAS_METHOD (nt, update_status_if_terminated);
1011 PROCESS_HAS_METHOD (nt, send_process);
1012 PROCESS_HAS_METHOD (nt, kill_child_process);
1013 PROCESS_HAS_METHOD (nt, kill_process_by_pid);
1014 #ifdef HAVE_SOCKETS
1015 PROCESS_HAS_METHOD (nt, canonicalize_host_name);
1016 PROCESS_HAS_METHOD (nt, open_network_stream);
1017 #ifdef HAVE_MULTICAST
1018 #error I won't do this until '95 has winsock2
1019 PROCESS_HAS_METHOD (nt, open_multicast_group);
1020 #endif
1021 #endif
1022 }
1023
1024 void
1025 syms_of_process_nt (void)
1026 {
1027 defsymbol (&Qnt_quote_process_args, "nt-quote-process-args");
1028 }
1029
1030 void
1031 vars_of_process_nt (void)
1032 {
1033 }