Mercurial > hg > xemacs-beta
annotate src/process-nt.c @ 5518:3cc7470ea71c
gnuclient: if TMPDIR was set and connect failed, try again with /tmp
2011-06-03 Aidan Kehoe <kehoea@parhasard.net>
* gnuslib.c (connect_to_unix_server):
Retry with /tmp as a directory in which to search for Unix sockets
if an attempt to connect with some other directory failed (which
may be because gnuclient and gnuserv don't share an environment
value for TMPDIR, or because gnuserv was compiled with USE_TMPDIR
turned off).
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Fri, 03 Jun 2011 18:40:57 +0100 |
parents | 308d34e9f07d |
children | 56144c8593a8 |
rev | line source |
---|---|
428 | 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. | |
2367 | 5 Copyright (C) 1995, 1996, 2000, 2001, 2002, 2004 Ben Wing. |
428 | 6 |
7 This file is part of XEmacs. | |
8 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5125
diff
changeset
|
9 XEmacs is free software: you can redistribute it and/or modify it |
428 | 10 under the terms of the GNU General Public License as published by the |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5125
diff
changeset
|
11 Free Software Foundation, either version 3 of the License, or (at your |
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5125
diff
changeset
|
12 option) any later version. |
428 | 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 | |
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5125
diff
changeset
|
20 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
428 | 21 |
22 /* Written by Kirill M. Katsnelson <kkm@kis.ru>, April 1998 */ | |
23 | |
771 | 24 /* Mule-ized as of 8-6-00 */ |
25 | |
2367 | 26 /* Major comment about parsing and/or constructing a command line taken |
27 from Windows, or suitable for giving to one of the library routines that | |
28 calls a subprocess is in win32-native.el */ | |
29 | |
428 | 30 #include <config.h> |
31 #include "lisp.h" | |
32 | |
442 | 33 #include "console-msw.h" |
2367 | 34 #include "events.h" |
428 | 35 #include "hash.h" |
36 #include "lstream.h" | |
37 #include "process.h" | |
38 #include "procimpl.h" | |
39 | |
558 | 40 #include "sysfile.h" |
41 #include "sysproc.h" | |
859 | 42 #include "syssignal.h" |
428 | 43 |
442 | 44 /* Bound by win32-native.el */ |
45 Lisp_Object Qmswindows_construct_process_command_line; | |
46 | |
428 | 47 /* Arbitrary size limit for code fragments passed to run_in_other_process */ |
48 #define FRAGMENT_CODE_SIZE 32 | |
49 | |
50 /* Implementation-specific data. Pointed to by Lisp_Process->process_data */ | |
51 struct nt_process_data | |
52 { | |
53 HANDLE h_process; | |
442 | 54 DWORD dwProcessId; |
55 HWND hwnd; /* console window */ | |
853 | 56 int selected_for_exit_notify; |
428 | 57 }; |
58 | |
442 | 59 /* Control whether create_child causes the process to inherit Emacs' |
60 console window, or be given a new one of its own. The default is | |
61 nil, to allow multiple DOS programs to run on Win95. Having separate | |
62 consoles also allows Emacs to cleanly terminate process groups. */ | |
63 Lisp_Object Vmswindows_start_process_share_console; | |
64 | |
65 /* Control whether create_child cause the process to inherit Emacs' | |
66 error mode setting. The default is t, to minimize the possibility of | |
67 subprocesses blocking when accessing unmounted drives. */ | |
68 Lisp_Object Vmswindows_start_process_inherit_error_mode; | |
69 | |
771 | 70 #define NT_DATA(p) ((struct nt_process_data *)((p)->process_data)) |
428 | 71 |
72 /*-----------------------------------------------------------------------*/ | |
73 /* Process helpers */ | |
74 /*-----------------------------------------------------------------------*/ | |
75 | |
853 | 76 /* These break process abstraction. Prototypes in console-msw.h, |
77 used by select_process method in event-msw.c. | |
78 | |
79 If called the first time on a process, return the process handle, so we | |
80 can select on it and receive exit notification. "First time only" so we | |
81 don't select the same process multiple times if someone turns off and on | |
82 the receipt of process data. */ | |
83 | |
84 HANDLE | |
85 get_nt_process_handle_only_first_time (Lisp_Process *p) | |
86 { | |
87 if (NT_DATA (p)->selected_for_exit_notify) | |
88 return INVALID_HANDLE_VALUE; | |
89 NT_DATA (p)->selected_for_exit_notify = 1; | |
90 return (NT_DATA (p)->h_process); | |
91 } | |
92 | |
428 | 93 HANDLE |
440 | 94 get_nt_process_handle (Lisp_Process *p) |
428 | 95 { |
96 return (NT_DATA (p)->h_process); | |
97 } | |
442 | 98 |
99 static struct Lisp_Process * | |
100 find_process_from_pid (DWORD pid) | |
101 { | |
102 Lisp_Object tail, proc; | |
103 | |
104 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
105 { | |
106 proc = XCAR (tail); | |
107 if (NT_DATA (XPROCESS (proc))->dwProcessId == pid) | |
108 return XPROCESS (proc); | |
109 } | |
110 return 0; | |
111 } | |
112 | |
428 | 113 |
114 /*-----------------------------------------------------------------------*/ | |
115 /* Running remote threads. See Microsoft Systems Journal 1994 Number 5 */ | |
116 /* Jeffrey Richter, Load Your 32-bit DLL into Another Process's Address..*/ | |
117 /*-----------------------------------------------------------------------*/ | |
118 | |
119 typedef struct | |
120 { | |
121 HANDLE h_process; | |
122 HANDLE h_thread; | |
123 LPVOID address; | |
124 } process_memory; | |
125 | |
2367 | 126 static void |
127 free_process_memory (process_memory *pmc) | |
128 { | |
129 ResumeThread (pmc->h_thread); | |
130 CloseHandle (pmc->h_thread); | |
131 } | |
132 | |
428 | 133 /* |
134 * Allocate SIZE bytes in H_PROCESS address space. Fill in PMC used | |
135 * further by other routines. Return nonzero if successful. | |
136 * | |
137 * The memory in other process is allocated by creating a suspended | |
138 * thread. Initial stack of that thread is used as the memory | |
139 * block. The thread entry point is the routine ExitThread in | |
854 | 140 * kernel32.dll, so the allocated memory is freed just by resuming the |
428 | 141 * thread, which immediately terminates after that. |
142 */ | |
143 | |
854 | 144 static int |
665 | 145 alloc_process_memory (HANDLE h_process, Bytecount size, |
771 | 146 process_memory *pmc) |
428 | 147 { |
148 LPTHREAD_START_ROUTINE adr_ExitThread = | |
149 (LPTHREAD_START_ROUTINE) | |
771 | 150 GetProcAddress (qxeGetModuleHandle (XETEXT ("kernel32")), "ExitThread"); |
428 | 151 DWORD dw_unused; |
152 CONTEXT context; | |
153 MEMORY_BASIC_INFORMATION mbi; | |
154 | |
155 pmc->h_process = h_process; | |
156 pmc->h_thread = CreateRemoteThread (h_process, NULL, size, | |
771 | 157 adr_ExitThread, NULL, |
158 CREATE_SUSPENDED, &dw_unused); | |
428 | 159 if (pmc->h_thread == NULL) |
160 return 0; | |
161 | |
162 /* Get context, for thread's stack pointer */ | |
163 context.ContextFlags = CONTEXT_CONTROL; | |
164 if (!GetThreadContext (pmc->h_thread, &context)) | |
165 goto failure; | |
166 | |
167 /* Determine base address of the committed range */ | |
168 if (sizeof(mbi) != VirtualQueryEx (h_process, | |
169 #if defined (_X86_) | |
170 (LPDWORD)context.Esp - 1, | |
171 #elif defined (_ALPHA_) | |
172 (LPDWORD)context.IntSp - 1, | |
173 #else | |
174 #error Unknown processor architecture | |
175 #endif | |
176 &mbi, sizeof(mbi))) | |
177 goto failure; | |
178 | |
179 /* Change the page protection of the allocated memory to executable, | |
180 read, and write. */ | |
181 if (!VirtualProtectEx (h_process, mbi.BaseAddress, size, | |
182 PAGE_EXECUTE_READWRITE, &dw_unused)) | |
183 goto failure; | |
184 | |
185 pmc->address = mbi.BaseAddress; | |
186 return 1; | |
187 | |
188 failure: | |
2367 | 189 free_process_memory (pmc); |
428 | 190 pmc->address = 0; |
191 return 0; | |
192 } | |
193 | |
194 /* | |
195 * Run ROUTINE in the context of process determined by H_PROCESS. The | |
196 * routine is passed the address of DATA as parameter. The ROUTINE must | |
197 * not be longer than ROUTINE_CODE_SIZE bytes. DATA_SIZE is the size of | |
198 * DATA structure. | |
199 * | |
200 * Note that the code must be positionally independent, and compiled | |
201 * without stack checks (they cause implicit calls into CRT so will | |
202 * fail). DATA should not refer any data in calling process, as both | |
203 * routine and its data are copied into remote process. Size of data | |
204 * and code together should not exceed one page (4K on x86 systems). | |
205 * | |
206 * Return the value returned by ROUTINE, or (DWORD)-1 if call failed. | |
207 */ | |
208 static DWORD | |
209 run_in_other_process (HANDLE h_process, | |
210 LPTHREAD_START_ROUTINE routine, | |
665 | 211 LPVOID data, Bytecount data_size) |
428 | 212 { |
213 process_memory pm; | |
665 | 214 const Bytecount code_size = FRAGMENT_CODE_SIZE; |
428 | 215 /* Need at most 3 extra bytes of memory, for data alignment */ |
665 | 216 Bytecount total_size = code_size + data_size + 3; |
428 | 217 LPVOID remote_data; |
218 HANDLE h_thread; | |
219 DWORD dw_unused; | |
220 | |
221 /* Allocate memory */ | |
222 if (!alloc_process_memory (h_process, total_size, &pm)) | |
223 return (DWORD)-1; | |
224 | |
225 /* Copy code */ | |
226 if (!WriteProcessMemory (h_process, pm.address, (LPVOID)routine, | |
227 code_size, NULL)) | |
228 goto failure; | |
229 | |
230 /* Copy data */ | |
231 if (data_size) | |
232 { | |
233 remote_data = (LPBYTE)pm.address + ((code_size + 4) & ~3); | |
234 if (!WriteProcessMemory (h_process, remote_data, data, data_size, NULL)) | |
235 goto failure; | |
236 } | |
237 else | |
238 remote_data = NULL; | |
239 | |
240 /* Execute the remote copy of code, passing it remote data */ | |
241 h_thread = CreateRemoteThread (h_process, NULL, 0, | |
242 (LPTHREAD_START_ROUTINE) pm.address, | |
243 remote_data, 0, &dw_unused); | |
244 if (h_thread == NULL) | |
245 goto failure; | |
246 | |
247 /* Wait till thread finishes */ | |
248 WaitForSingleObject (h_thread, INFINITE); | |
249 | |
250 /* Free remote memory */ | |
251 free_process_memory (&pm); | |
252 | |
253 /* Return thread's exit code */ | |
254 { | |
255 DWORD exit_code; | |
256 GetExitCodeThread (h_thread, &exit_code); | |
257 CloseHandle (h_thread); | |
258 return exit_code; | |
259 } | |
260 | |
261 failure: | |
262 free_process_memory (&pm); | |
2367 | 263 return (DWORD) -1; |
428 | 264 } |
265 | |
266 /*-----------------------------------------------------------------------*/ | |
267 /* Sending signals */ | |
268 /*-----------------------------------------------------------------------*/ | |
269 | |
442 | 270 /* ---------------------------- the NT way ------------------------------- */ |
271 | |
428 | 272 /* |
273 * We handle the following signals: | |
274 * | |
275 * SIGKILL, SIGTERM, SIGQUIT, SIGHUP - These four translate to ExitProcess | |
276 * executed by the remote process | |
277 * SIGINT - The remote process is sent CTRL_BREAK_EVENT | |
278 * | |
279 * The MSVC5.0 compiler feels free to re-order functions within a | |
280 * compilation unit, so we have no way of finding out the size of the | |
281 * following functions. Therefore these functions must not be larger than | |
282 * FRAGMENT_CODE_SIZE. | |
283 */ | |
284 | |
285 /* | |
286 * Sending SIGKILL | |
287 */ | |
288 typedef struct | |
289 { | |
290 void (WINAPI *adr_ExitProcess) (UINT); | |
291 } sigkill_data; | |
292 | |
293 static DWORD WINAPI | |
771 | 294 sigkill_proc (sigkill_data *data) |
428 | 295 { |
296 (*data->adr_ExitProcess)(255); | |
297 return 1; | |
298 } | |
299 | |
300 /* | |
301 * Sending break or control c | |
302 */ | |
303 typedef struct | |
304 { | |
305 BOOL (WINAPI *adr_GenerateConsoleCtrlEvent) (DWORD, DWORD); | |
306 DWORD event; | |
307 } sigint_data; | |
308 | |
309 static DWORD WINAPI | |
771 | 310 sigint_proc (sigint_data *data) |
428 | 311 { |
312 return (*data->adr_GenerateConsoleCtrlEvent) (data->event, 0); | |
313 } | |
314 | |
315 /* | |
316 * Enabling signals | |
317 */ | |
318 typedef struct | |
319 { | |
320 BOOL (WINAPI *adr_SetConsoleCtrlHandler) (LPVOID, BOOL); | |
321 } sig_enable_data; | |
322 | |
323 static DWORD WINAPI | |
771 | 324 sig_enable_proc (sig_enable_data *data) |
428 | 325 { |
326 (*data->adr_SetConsoleCtrlHandler) (NULL, FALSE); | |
327 return 1; | |
328 } | |
329 | |
330 /* | |
331 * Send signal SIGNO to process H_PROCESS. | |
332 * Return nonzero if successful. | |
333 */ | |
334 | |
335 static int | |
442 | 336 send_signal_the_nt_way (struct nt_process_data *cp, int pid, int signo) |
428 | 337 { |
442 | 338 HANDLE h_process; |
771 | 339 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32")); |
442 | 340 int close_process = 0; |
428 | 341 DWORD retval; |
854 | 342 |
428 | 343 assert (h_kernel != NULL); |
854 | 344 |
442 | 345 if (cp) |
346 { | |
347 pid = cp->dwProcessId; | |
348 h_process = cp->h_process; | |
349 } | |
350 else | |
351 { | |
352 close_process = 1; | |
353 /* Try to open the process with required privileges */ | |
354 h_process = OpenProcess (PROCESS_CREATE_THREAD | |
854 | 355 | PROCESS_QUERY_INFORMATION |
442 | 356 | PROCESS_VM_OPERATION |
357 | PROCESS_VM_WRITE, | |
358 FALSE, pid); | |
359 if (!h_process) | |
360 return 0; | |
361 } | |
362 | |
428 | 363 switch (signo) |
364 { | |
365 case SIGKILL: | |
366 case SIGTERM: | |
367 case SIGQUIT: | |
368 case SIGHUP: | |
369 { | |
370 sigkill_data d; | |
442 | 371 |
372 d.adr_ExitProcess = | |
373 (void (WINAPI *) (UINT)) GetProcAddress (h_kernel, "ExitProcess"); | |
428 | 374 assert (d.adr_ExitProcess); |
854 | 375 retval = run_in_other_process (h_process, |
771 | 376 (LPTHREAD_START_ROUTINE) sigkill_proc, |
428 | 377 &d, sizeof (d)); |
378 break; | |
379 } | |
380 case SIGINT: | |
381 { | |
382 sigint_data d; | |
383 d.adr_GenerateConsoleCtrlEvent = | |
442 | 384 (BOOL (WINAPI *) (DWORD, DWORD)) |
428 | 385 GetProcAddress (h_kernel, "GenerateConsoleCtrlEvent"); |
386 assert (d.adr_GenerateConsoleCtrlEvent); | |
387 d.event = CTRL_C_EVENT; | |
854 | 388 retval = run_in_other_process (h_process, |
2367 | 389 (LPTHREAD_START_ROUTINE) sigint_proc, |
428 | 390 &d, sizeof (d)); |
391 break; | |
392 } | |
393 default: | |
394 assert (0); | |
395 } | |
396 | |
442 | 397 if (close_process) |
398 CloseHandle (h_process); | |
2367 | 399 return (int) retval > 0 ? 1 : 0; |
428 | 400 } |
401 | |
402 /* | |
403 * Enable CTRL_C_EVENT handling in a new child process | |
404 */ | |
405 static void | |
406 enable_child_signals (HANDLE h_process) | |
407 { | |
771 | 408 HMODULE h_kernel = qxeGetModuleHandle (XETEXT ("kernel32")); |
428 | 409 sig_enable_data d; |
854 | 410 |
428 | 411 assert (h_kernel != NULL); |
412 d.adr_SetConsoleCtrlHandler = | |
442 | 413 (BOOL (WINAPI *) (LPVOID, BOOL)) |
428 | 414 GetProcAddress (h_kernel, "SetConsoleCtrlHandler"); |
415 assert (d.adr_SetConsoleCtrlHandler); | |
416 run_in_other_process (h_process, (LPTHREAD_START_ROUTINE)sig_enable_proc, | |
417 &d, sizeof (d)); | |
418 } | |
854 | 419 |
442 | 420 /* ---------------------------- the 95 way ------------------------------- */ |
421 | |
422 static BOOL CALLBACK | |
423 find_child_console (HWND hwnd, long putada) | |
424 { | |
425 DWORD thread_id; | |
426 DWORD process_id; | |
427 struct nt_process_data *cp = (struct nt_process_data *) putada; | |
428 | |
429 thread_id = GetWindowThreadProcessId (hwnd, &process_id); | |
430 if (process_id == cp->dwProcessId) | |
431 { | |
771 | 432 Extbyte window_class[32]; |
442 | 433 |
771 | 434 /* GetClassNameA to avoid problems with Unicode return values */ |
435 GetClassNameA (hwnd, window_class, sizeof (window_class)); | |
442 | 436 if (strcmp (window_class, |
771 | 437 mswindows_windows9x_p |
442 | 438 ? "tty" |
439 : "ConsoleWindowClass") == 0) | |
440 { | |
441 cp->hwnd = hwnd; | |
442 return FALSE; | |
443 } | |
444 } | |
445 /* keep looking */ | |
446 return TRUE; | |
447 } | |
448 | |
449 static int | |
450 send_signal_the_95_way (struct nt_process_data *cp, int pid, int signo) | |
451 { | |
452 HANDLE h_process; | |
453 int close_process = 0; | |
454 int rc = 1; | |
854 | 455 |
442 | 456 if (cp) |
457 { | |
458 pid = cp->dwProcessId; | |
459 h_process = cp->h_process; | |
460 | |
461 /* Try to locate console window for process. */ | |
462 EnumWindows (find_child_console, (LPARAM) cp); | |
463 } | |
464 else | |
465 { | |
466 close_process = 1; | |
467 /* Try to open the process with required privileges */ | |
468 h_process = OpenProcess (PROCESS_TERMINATE, FALSE, pid); | |
469 if (!h_process) | |
470 return 0; | |
471 } | |
854 | 472 |
442 | 473 if (signo == SIGINT) |
474 { | |
475 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) | |
476 { | |
771 | 477 BYTE control_scan_code = (BYTE) MapVirtualKeyA (VK_CONTROL, 0); |
442 | 478 BYTE vk_break_code = VK_CANCEL; |
771 | 479 BYTE break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0); |
442 | 480 HWND foreground_window; |
481 | |
482 if (break_scan_code == 0) | |
483 { | |
484 /* Fake Ctrl-C if we can't manage Ctrl-Break. */ | |
485 vk_break_code = 'C'; | |
771 | 486 break_scan_code = (BYTE) MapVirtualKeyA (vk_break_code, 0); |
442 | 487 } |
488 | |
489 foreground_window = GetForegroundWindow (); | |
490 if (foreground_window) | |
491 { | |
492 /* NT 5.0, and apparently also Windows 98, will not allow | |
493 a Window to be set to foreground directly without the | |
494 user's involvement. The workaround is to attach | |
495 ourselves to the thread that owns the foreground | |
496 window, since that is the only thread that can set the | |
497 foreground window. */ | |
498 DWORD foreground_thread, child_thread; | |
499 foreground_thread = | |
500 GetWindowThreadProcessId (foreground_window, NULL); | |
501 if (foreground_thread == GetCurrentThreadId () | |
502 || !AttachThreadInput (GetCurrentThreadId (), | |
503 foreground_thread, TRUE)) | |
504 foreground_thread = 0; | |
505 | |
506 child_thread = GetWindowThreadProcessId (cp->hwnd, NULL); | |
507 if (child_thread == GetCurrentThreadId () | |
508 || !AttachThreadInput (GetCurrentThreadId (), | |
509 child_thread, TRUE)) | |
510 child_thread = 0; | |
511 | |
512 /* Set the foreground window to the child. */ | |
513 if (SetForegroundWindow (cp->hwnd)) | |
514 { | |
515 /* Generate keystrokes as if user had typed Ctrl-Break or | |
516 Ctrl-C. */ | |
517 keybd_event (VK_CONTROL, control_scan_code, 0, 0); | |
518 keybd_event (vk_break_code, break_scan_code, | |
519 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY), 0); | |
520 keybd_event (vk_break_code, break_scan_code, | |
521 (vk_break_code == 'C' ? 0 : KEYEVENTF_EXTENDEDKEY) | |
522 | KEYEVENTF_KEYUP, 0); | |
523 keybd_event (VK_CONTROL, control_scan_code, | |
524 KEYEVENTF_KEYUP, 0); | |
525 | |
526 /* Sleep for a bit to give time for Emacs frame to respond | |
527 to focus change events (if Emacs was active app). */ | |
528 Sleep (100); | |
529 | |
530 SetForegroundWindow (foreground_window); | |
531 } | |
532 /* Detach from the foreground and child threads now that | |
533 the foreground switching is over. */ | |
534 if (foreground_thread) | |
535 AttachThreadInput (GetCurrentThreadId (), | |
536 foreground_thread, FALSE); | |
537 if (child_thread) | |
538 AttachThreadInput (GetCurrentThreadId (), | |
539 child_thread, FALSE); | |
540 } | |
541 } | |
542 /* Ctrl-Break is NT equivalent of SIGINT. */ | |
543 else if (!GenerateConsoleCtrlEvent (CTRL_BREAK_EVENT, pid)) | |
544 { | |
545 #if 0 /* FSF Emacs */ | |
546 DebPrint (("sys_kill.GenerateConsoleCtrlEvent return %d " | |
547 "for pid %lu\n", GetLastError (), pid)); | |
548 errno = EINVAL; | |
549 #endif | |
550 rc = 0; | |
551 } | |
552 } | |
553 else | |
554 { | |
555 if (NILP (Vmswindows_start_process_share_console) && cp && cp->hwnd) | |
556 { | |
557 #if 1 | |
771 | 558 if (mswindows_windows9x_p) |
442 | 559 { |
560 /* | |
561 Another possibility is to try terminating the VDM out-right by | |
562 calling the Shell VxD (id 0x17) V86 interface, function #4 | |
563 "SHELL_Destroy_VM", ie. | |
564 | |
565 mov edx,4 | |
566 mov ebx,vm_handle | |
567 call shellapi | |
568 | |
569 First need to determine the current VM handle, and then arrange for | |
570 the shellapi call to be made from the system vm (by using | |
571 Switch_VM_and_callback). | |
572 | |
573 Could try to invoke DestroyVM through CallVxD. | |
574 | |
575 */ | |
576 #if 0 | |
577 /* On Win95, posting WM_QUIT causes the 16-bit subsystem | |
578 to hang when cmdproxy is used in conjunction with | |
579 command.com for an interactive shell. Posting | |
580 WM_CLOSE pops up a dialog that, when Yes is selected, | |
581 does the same thing. TerminateProcess is also less | |
582 than ideal in that subprocesses tend to stick around | |
583 until the machine is shutdown, but at least it | |
584 doesn't freeze the 16-bit subsystem. */ | |
800 | 585 qxePostMessage (cp->hwnd, WM_QUIT, 0xff, 0); |
442 | 586 #endif |
587 if (!TerminateProcess (h_process, 0xff)) | |
588 { | |
589 #if 0 /* FSF Emacs */ | |
590 DebPrint (("sys_kill.TerminateProcess returned %d " | |
591 "for pid %lu\n", GetLastError (), pid)); | |
592 errno = EINVAL; | |
593 #endif | |
594 rc = 0; | |
595 } | |
596 } | |
597 else | |
598 #endif | |
800 | 599 qxePostMessage (cp->hwnd, WM_CLOSE, 0, 0); |
442 | 600 } |
601 /* Kill the process. On W32 this doesn't kill child processes | |
602 so it doesn't work very well for shells which is why it's not | |
603 used in every case. */ | |
604 else if (!TerminateProcess (h_process, 0xff)) | |
605 { | |
606 #if 0 /* FSF Emacs */ | |
607 DebPrint (("sys_kill.TerminateProcess returned %d " | |
608 "for pid %lu\n", GetLastError (), pid)); | |
609 errno = EINVAL; | |
610 #endif | |
611 rc = 0; | |
612 } | |
613 } | |
614 | |
615 if (close_process) | |
616 CloseHandle (h_process); | |
617 | |
618 return rc; | |
619 } | |
620 | |
621 /* -------------------------- all-OS functions ---------------------------- */ | |
622 | |
623 static int | |
624 send_signal (struct nt_process_data *cp, int pid, int signo) | |
625 { | |
771 | 626 return (!mswindows_windows9x_p && send_signal_the_nt_way (cp, pid, signo)) |
442 | 627 || send_signal_the_95_way (cp, pid, signo); |
628 } | |
629 | |
428 | 630 /* |
631 * Signal error if SIGNO is not supported | |
632 */ | |
633 static void | |
634 validate_signal_number (int signo) | |
635 { | |
636 if (signo != SIGKILL && signo != SIGTERM | |
637 && signo != SIGQUIT && signo != SIGINT | |
638 && signo != SIGHUP) | |
563 | 639 invalid_constant ("Signal number not supported", make_int (signo)); |
428 | 640 } |
854 | 641 |
428 | 642 /*-----------------------------------------------------------------------*/ |
643 /* Process methods */ | |
644 /*-----------------------------------------------------------------------*/ | |
645 | |
646 /* | |
647 * Allocate and initialize Lisp_Process->process_data | |
648 */ | |
649 | |
650 static void | |
440 | 651 nt_alloc_process_data (Lisp_Process *p) |
428 | 652 { |
653 p->process_data = xnew_and_zero (struct nt_process_data); | |
654 } | |
655 | |
656 static void | |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
657 nt_finalize_process_data (Lisp_Process *p) |
428 | 658 { |
791 | 659 /* If it's still in the list of processes we are waiting on delete |
2367 | 660 it. This can happen if we forcibly delete a process and are unable |
661 to kill it. */ | |
791 | 662 mswindows_unwait_process (p); |
442 | 663 if (NT_DATA (p)->h_process) |
2367 | 664 { |
665 CloseHandle (NT_DATA (p)->h_process); | |
666 NT_DATA (p)->h_process = 0; | |
667 } | |
428 | 668 } |
669 | |
670 /* | |
671 * Initialize XEmacs process implementation once | |
672 */ | |
673 static void | |
674 nt_init_process (void) | |
675 { | |
676 /* Initialize winsock */ | |
677 WSADATA wsa_data; | |
678 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */ | |
679 WSAStartup (MAKEWORD (1,1), &wsa_data); | |
680 } | |
681 | |
853 | 682 /* |
683 * Fork off a subprocess. P is a pointer to newly created subprocess | |
684 * object. If this function signals, the caller is responsible for | |
685 * deleting (and finalizing) the process object. | |
686 * | |
687 * The method must return PID of the new process, a (positive??? ####) number | |
688 * which fits into Lisp_Int. No return value indicates an error, the method | |
689 * must signal an error instead. | |
690 */ | |
691 | |
563 | 692 static DOESNT_RETURN |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
693 mswindows_report_winsock_error (const Ascbyte *reason, Lisp_Object data, |
563 | 694 int errnum) |
428 | 695 { |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
696 signal_error_2 (Qnetwork_error, reason, mswindows_lisp_error (errnum), data); |
442 | 697 } |
698 | |
699 static void | |
700 ensure_console_window_exists (void) | |
701 { | |
771 | 702 if (mswindows_windows9x_p) |
442 | 703 mswindows_hide_console (); |
704 } | |
705 | |
706 int | |
771 | 707 mswindows_compare_env (const void *strp1, const void *strp2) |
442 | 708 { |
2367 | 709 const Itext *str1 = * (const Itext **) strp1, |
710 *str2 = * (const Itext **) strp2; | |
442 | 711 |
712 while (*str1 && *str2 && *str1 != '=' && *str2 != '=') | |
713 { | |
714 if ((*str1) > (*str2)) | |
715 return 1; | |
716 else if ((*str1) < (*str2)) | |
717 return -1; | |
718 str1++, str2++; | |
719 } | |
720 | |
721 if (*str1 == '=' && *str2 == '=') | |
722 return 0; | |
723 else if (*str1 == '=') | |
724 return -1; | |
725 else | |
726 return 1; | |
428 | 727 } |
728 | |
563 | 729 /* |
730 * Fork off a subprocess. P is a pointer to newly created subprocess | |
731 * object. If this function signals, the caller is responsible for | |
732 * deleting (and finalizing) the process object. | |
733 * | |
734 * The method must return PID of the new process, a (positive??? ####) number | |
735 * which fits into Lisp_Int. No return value indicates an error, the method | |
736 * must signal an error instead. | |
737 */ | |
738 | |
428 | 739 static int |
440 | 740 nt_create_process (Lisp_Process *p, |
428 | 741 Lisp_Object *argv, int nargv, |
853 | 742 Lisp_Object program, Lisp_Object cur_dir, |
743 int separate_err) | |
428 | 744 { |
442 | 745 /* Synched up with sys_spawnve in FSF 20.6. Significantly different |
746 but still synchable. */ | |
853 | 747 HANDLE hmyshove, hmyslurp, hmyslurp_err, hprocin, hprocout, hprocerr; |
442 | 748 Extbyte *command_line; |
428 | 749 BOOL do_io, windowed; |
771 | 750 Extbyte *proc_env; |
428 | 751 |
442 | 752 /* No need to DOS-ize the filename; expand-file-name (called prior) |
753 already does this. */ | |
754 | |
428 | 755 /* Find out whether the application is windowed or not */ |
771 | 756 { |
757 /* SHGetFileInfo tends to return ERROR_FILE_NOT_FOUND on most | |
758 errors. This leads to bogus error message. */ | |
759 DWORD image_type; | |
1204 | 760 if (mswindows_is_executable (XSTRING_DATA (program))) |
771 | 761 { |
762 Extbyte *progext; | |
2526 | 763 LISP_PATHNAME_CONVERT_OUT (program, progext); |
771 | 764 image_type = qxeSHGetFileInfo (progext, 0, NULL, 0, SHGFI_EXETYPE); |
765 } | |
766 else | |
767 { | |
768 DECLARE_EISTRING (progext); | |
2526 | 769 Ibyte *prog2; |
770 LISP_PATHNAME_RESOLVE_LINKS (program, prog2); | |
771 eicpy_rawz (progext, prog2); | |
2421 | 772 eicat_ascii (progext, ".exe"); |
771 | 773 eito_external (progext, Qmswindows_tstr); |
774 image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0, | |
775 SHGFI_EXETYPE); | |
776 } | |
777 if (image_type == 0) | |
778 mswindows_report_process_error | |
779 ("Determining executable file type", | |
780 program, | |
781 GetLastError () == ERROR_FILE_NOT_FOUND | |
782 ? ERROR_BAD_FORMAT : GetLastError ()); | |
783 windowed = HIWORD (image_type) != 0; | |
784 } | |
785 | |
428 | 786 |
787 /* Decide whether to do I/O on process handles, or just mark the | |
788 process exited immediately upon successful launching. We do I/O if the | |
789 process is a console one, or if it is windowed but windowed_process_io | |
790 is non-zero */ | |
791 do_io = !windowed || windowed_process_io ; | |
854 | 792 |
428 | 793 if (do_io) |
794 { | |
795 /* Create two unidirectional named pipes */ | |
796 HANDLE htmp; | |
797 SECURITY_ATTRIBUTES sa; | |
798 | |
826 | 799 sa.nLength = sizeof (sa); |
428 | 800 sa.bInheritHandle = TRUE; |
801 sa.lpSecurityDescriptor = NULL; | |
802 | |
803 CreatePipe (&hprocin, &hmyshove, &sa, 0); | |
804 CreatePipe (&hmyslurp, &hprocout, &sa, 0); | |
805 | |
853 | 806 if (separate_err) |
807 CreatePipe (&hmyslurp_err, &hprocerr, &sa, 0); | |
808 else | |
809 /* Duplicate the stdout handle for use as stderr */ | |
2367 | 810 DuplicateHandle (GetCurrentProcess(), hprocout, GetCurrentProcess(), |
811 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS); | |
430 | 812 |
428 | 813 /* Stupid Win32 allows to create a pipe with *both* ends either |
814 inheritable or not. We need process ends inheritable, and local | |
815 ends not inheritable. */ | |
442 | 816 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(), |
817 &htmp, 0, FALSE, | |
818 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
428 | 819 hmyshove = htmp; |
442 | 820 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(), |
821 &htmp, 0, FALSE, | |
822 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
428 | 823 hmyslurp = htmp; |
853 | 824 if (separate_err) |
825 { | |
826 DuplicateHandle (GetCurrentProcess(), hmyslurp_err, | |
827 GetCurrentProcess(), &htmp, 0, FALSE, | |
828 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS); | |
829 hmyslurp_err = htmp; | |
830 } | |
428 | 831 } |
832 | |
833 /* Convert an argv vector into Win32 style command line by a call to | |
442 | 834 lisp function `mswindows-construct-process-command-line' |
835 (in win32-native.el) */ | |
428 | 836 { |
837 int i; | |
838 Lisp_Object args_or_ret = Qnil; | |
839 struct gcpro gcpro1; | |
840 | |
841 GCPRO1 (args_or_ret); | |
842 | |
843 for (i = 0; i < nargv; ++i) | |
844 args_or_ret = Fcons (*argv++, args_or_ret); | |
845 args_or_ret = Fnreverse (args_or_ret); | |
846 args_or_ret = Fcons (program, args_or_ret); | |
847 | |
2367 | 848 /* This Lisp function is in win32-native.el and has lots of comments |
849 about what exactly is going on. */ | |
442 | 850 args_or_ret = call1 (Qmswindows_construct_process_command_line, |
851 args_or_ret); | |
428 | 852 |
853 if (!STRINGP (args_or_ret)) | |
854 /* Luser wrote his/her own clever version */ | |
442 | 855 invalid_argument |
856 ("Bogus return value from `mswindows-construct-process-command-line'", | |
857 args_or_ret); | |
428 | 858 |
2526 | 859 /* #### What about path names, which may be links? */ |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
860 command_line = LISP_STRING_TO_TSTR (args_or_ret); |
428 | 861 |
862 UNGCPRO; /* args_or_ret */ | |
863 } | |
864 | |
865 /* Set `proc_env' to a nul-separated array of the strings in | |
866 Vprocess_environment terminated by 2 nuls. */ | |
771 | 867 |
428 | 868 { |
867 | 869 Ibyte **env; |
428 | 870 REGISTER Lisp_Object tem; |
867 | 871 REGISTER Ibyte **new_env; |
771 | 872 REGISTER int new_length = 0, i; |
854 | 873 |
428 | 874 for (tem = Vprocess_environment; |
875 (CONSP (tem) | |
876 && STRINGP (XCAR (tem))); | |
877 tem = XCDR (tem)) | |
878 new_length++; | |
442 | 879 |
880 /* FSF adds an extra env var to hold the current process ID of the | |
881 Emacs process. Apparently this is used only by emacsserver.c, | |
771 | 882 which we have superseded by gnuserv.c. (#### Does it work under |
442 | 883 MS Windows?) |
884 | |
854 | 885 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d", |
442 | 886 GetCurrentProcessId ()); |
887 arglen += strlen (ppid_env_var_buffer) + 1; | |
888 numenv++; | |
889 */ | |
854 | 890 |
428 | 891 /* new_length + 1 to include terminating 0. */ |
867 | 892 env = new_env = alloca_array (Ibyte *, new_length + 1); |
854 | 893 |
428 | 894 /* Copy the Vprocess_environment strings into new_env. */ |
895 for (tem = Vprocess_environment; | |
896 (CONSP (tem) | |
897 && STRINGP (XCAR (tem))); | |
898 tem = XCDR (tem)) | |
899 { | |
867 | 900 Ibyte **ep = env; |
901 Ibyte *string = XSTRING_DATA (XCAR (tem)); | |
428 | 902 /* See if this string duplicates any string already in the env. |
903 If so, don't put it in. | |
904 When an env var has multiple definitions, | |
905 we keep the definition that comes first in process-environment. */ | |
906 for (; ep != new_env; ep++) | |
907 { | |
867 | 908 Ibyte *p = *ep, *q = string; |
428 | 909 while (1) |
910 { | |
911 if (*q == 0) | |
912 /* The string is malformed; might as well drop it. */ | |
913 goto duplicate; | |
914 if (*q != *p) | |
915 break; | |
916 if (*q == '=') | |
917 goto duplicate; | |
918 p++, q++; | |
919 } | |
920 } | |
921 *new_env++ = string; | |
922 duplicate: ; | |
923 } | |
924 *new_env = 0; | |
854 | 925 |
428 | 926 /* Sort the environment variables */ |
927 new_length = new_env - env; | |
867 | 928 qsort (env, new_length, sizeof (Ibyte *), mswindows_compare_env); |
771 | 929 |
930 { | |
931 DECLARE_EISTRING (envout); | |
932 | |
933 for (i = 0; i < new_length; i++) | |
934 { | |
1204 | 935 eicat_raw (envout, env[i], qxestrlen (env[i])); |
936 eicat_raw (envout, (Ibyte *) "\0", 1); | |
771 | 937 } |
938 | |
1204 | 939 eicat_raw (envout, (Ibyte *) "\0", 1); |
771 | 940 eito_external (envout, Qmswindows_tstr); |
941 proc_env = eiextdata (envout); | |
942 } | |
428 | 943 } |
442 | 944 |
945 #if 0 | |
946 /* #### we need to port this. */ | |
947 /* On Windows 95, if cmdname is a DOS app, we invoke a helper | |
948 application to start it by specifying the helper app as cmdname, | |
949 while leaving the real app name as argv[0]. */ | |
950 if (is_dos_app) | |
951 { | |
2421 | 952 cmdname = alloca_ibytes (PATH_MAX_INTERNAL); |
442 | 953 if (egetenv ("CMDPROXY")) |
771 | 954 qxestrcpy (cmdname, egetenv ("CMDPROXY")); |
442 | 955 else |
956 { | |
771 | 957 qxestrcpy (cmdname, XSTRING_DATA (Vinvocation_directory)); |
867 | 958 qxestrcat (cmdname, (Ibyte *) "cmdproxy.exe"); |
442 | 959 } |
960 } | |
961 #endif | |
854 | 962 |
428 | 963 /* Create process */ |
964 { | |
771 | 965 STARTUPINFOW si; |
428 | 966 PROCESS_INFORMATION pi; |
967 DWORD err; | |
442 | 968 DWORD flags; |
428 | 969 |
970 xzero (si); | |
971 si.dwFlags = STARTF_USESHOWWINDOW; | |
972 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE; | |
973 if (do_io) | |
974 { | |
975 si.hStdInput = hprocin; | |
976 si.hStdOutput = hprocout; | |
430 | 977 si.hStdError = hprocerr; |
428 | 978 si.dwFlags |= STARTF_USESTDHANDLES; |
979 } | |
980 | |
442 | 981 flags = CREATE_SUSPENDED; |
771 | 982 if (mswindows_windows9x_p) |
442 | 983 flags |= (!NILP (Vmswindows_start_process_share_console) |
984 ? CREATE_NEW_PROCESS_GROUP | |
985 : CREATE_NEW_CONSOLE); | |
986 else | |
987 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP; | |
988 if (NILP (Vmswindows_start_process_inherit_error_mode)) | |
989 flags |= CREATE_DEFAULT_ERROR_MODE; | |
990 | |
991 ensure_console_window_exists (); | |
992 | |
771 | 993 { |
994 Extbyte *curdirext; | |
995 | |
2526 | 996 LISP_PATHNAME_CONVERT_OUT (cur_dir, curdirext); |
771 | 997 |
998 err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE, | |
999 (XEUNICODE_P ? | |
1000 flags | CREATE_UNICODE_ENVIRONMENT : | |
1001 flags), proc_env, | |
1002 curdirext, &si, &pi) | |
1003 ? 0 : GetLastError ()); | |
1004 } | |
428 | 1005 |
1006 if (do_io) | |
1007 { | |
1008 /* These just have been inherited; we do not need a copy */ | |
1009 CloseHandle (hprocin); | |
1010 CloseHandle (hprocout); | |
430 | 1011 CloseHandle (hprocerr); |
428 | 1012 } |
854 | 1013 |
428 | 1014 /* Handle process creation failure */ |
1015 if (err) | |
1016 { | |
1017 if (do_io) | |
1018 { | |
1019 CloseHandle (hmyshove); | |
1020 CloseHandle (hmyslurp); | |
853 | 1021 if (separate_err) |
1022 CloseHandle (hmyslurp_err); | |
428 | 1023 } |
563 | 1024 mswindows_report_process_error |
1025 ("Error starting", | |
1026 program, GetLastError ()); | |
428 | 1027 } |
1028 | |
1029 /* The process started successfully */ | |
1030 if (do_io) | |
1031 { | |
1032 NT_DATA(p)->h_process = pi.hProcess; | |
442 | 1033 NT_DATA(p)->dwProcessId = pi.dwProcessId; |
853 | 1034 init_process_io_handles (p, (void *) hmyslurp, (void *) hmyshove, |
1035 separate_err ? (void *) hmyslurp_err | |
1036 : (void *) -1, 0); | |
428 | 1037 } |
1038 else | |
1039 { | |
1040 /* Indicate as if the process has exited immediately. */ | |
1041 p->status_symbol = Qexit; | |
1042 CloseHandle (pi.hProcess); | |
1043 } | |
1044 | |
442 | 1045 if (!windowed) |
1046 enable_child_signals (pi.hProcess); | |
1047 | |
428 | 1048 ResumeThread (pi.hThread); |
1049 CloseHandle (pi.hThread); | |
1050 | |
432 | 1051 return ((int)pi.dwProcessId); |
428 | 1052 } |
1053 } | |
1054 | |
854 | 1055 /* |
428 | 1056 * This method is called to update status fields of the process |
1057 * structure. If the process has not existed, this method is expected | |
1058 * to do nothing. | |
1059 * | |
854 | 1060 * The method is called only for real child processes. |
428 | 1061 */ |
1062 | |
1063 static void | |
771 | 1064 nt_update_status_if_terminated (Lisp_Process *p) |
428 | 1065 { |
1066 DWORD exit_code; | |
1067 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code) | |
1068 && exit_code != STILL_ACTIVE) | |
1069 { | |
1070 p->tick++; | |
1071 p->core_dumped = 0; | |
1072 /* The exit code can be a code returned by process, or an | |
1073 NTSTATUS value. We cannot accurately handle the latter since | |
1074 it is a full 32 bit integer */ | |
1075 if (exit_code & 0xC0000000) | |
1076 { | |
1077 p->status_symbol = Qsignal; | |
1078 p->exit_code = exit_code & 0x1FFFFFFF; | |
1079 } | |
1080 else | |
1081 { | |
1082 p->status_symbol = Qexit; | |
1083 p->exit_code = exit_code; | |
1084 } | |
1085 } | |
1086 } | |
1087 | |
1088 /* | |
1089 * Stuff the entire contents of LSTREAM to the process output pipe | |
1090 */ | |
1091 | |
1092 /* #### If only this function could be somehow merged with | |
1093 unix_send_process... */ | |
1094 | |
1095 static void | |
771 | 1096 nt_send_process (Lisp_Object proc, struct lstream *lstream) |
428 | 1097 { |
432 | 1098 volatile Lisp_Object vol_proc = proc; |
440 | 1099 Lisp_Process *volatile p = XPROCESS (proc); |
428 | 1100 |
1101 /* use a reasonable-sized buffer (somewhere around the size of the | |
1102 stream buffer) so as to avoid inundating the stream with blocked | |
1103 data. */ | |
867 | 1104 Ibyte chunkbuf[512]; |
428 | 1105 Bytecount chunklen; |
1106 | |
1107 while (1) | |
1108 { | |
771 | 1109 int writeret; |
428 | 1110 |
442 | 1111 chunklen = Lstream_read (lstream, chunkbuf, 512); |
428 | 1112 if (chunklen <= 0) |
2500 | 1113 break; /* perhaps should ABORT() if < 0? |
428 | 1114 This should never happen. */ |
1115 | |
1116 /* Lstream_write() will never successfully write less than the | |
1117 amount sent in. In the worst case, it just buffers the | |
1118 unwritten data. */ | |
771 | 1119 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM (p)), chunkbuf, |
428 | 1120 chunklen); |
771 | 1121 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p))); |
428 | 1122 if (writeret < 0) |
1123 { | |
1124 p->status_symbol = Qexit; | |
1125 p->exit_code = ERROR_BROKEN_PIPE; | |
1126 p->core_dumped = 0; | |
1127 p->tick++; | |
1128 process_tick++; | |
432 | 1129 deactivate_process (*((Lisp_Object *) (&vol_proc))); |
442 | 1130 invalid_operation ("Broken pipe error sending to process; closed it", |
1131 p->name); | |
428 | 1132 } |
1133 | |
1134 { | |
1135 int wait_ms = 25; | |
1136 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream))) | |
1137 { | |
1138 /* Buffer is full. Wait, accepting input; that may allow | |
1139 the program to finish doing output and read more. */ | |
1140 Faccept_process_output (Qnil, Qzero, make_int (wait_ms)); | |
1141 Lstream_flush (XLSTREAM (p->pipe_outstream)); | |
1142 wait_ms = min (1000, 2 * wait_ms); | |
1143 } | |
1144 } | |
1145 } | |
1146 } | |
1147 | |
2367 | 1148 static void |
1149 nt_deactivate_process (Lisp_Process *p, | |
1150 USID *in_usid, | |
1151 USID *err_usid) | |
1152 { | |
1153 event_stream_delete_io_streams (p->pipe_instream, p->pipe_outstream, | |
1154 p->pipe_errstream, in_usid, err_usid); | |
1155 /* Go ahead and close the process handle now to prevent accumulation | |
1156 of handles when lots of processes are run. (The handle gets closed | |
1157 anyway upon GC, but that might be a ways away, esp. if | |
1158 deleted-exited-processes is set to nil.) */ | |
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
1159 nt_finalize_process_data (p); |
2367 | 1160 } |
1161 | |
428 | 1162 /* |
1163 * Send a signal number SIGNO to PROCESS. | |
1164 * CURRENT_GROUP means send to the process group that currently owns | |
1165 * the terminal being used to communicate with PROCESS. | |
1166 * This is used for various commands in shell mode. | |
1167 * If NOMSG is zero, insert signal-announcements into process's buffers | |
1168 * right away. | |
1169 * | |
1170 * If we can, we try to signal PROCESS by sending control characters | |
1171 * down the pty. This allows us to signal inferiors who have changed | |
1172 * their uid, for which killpg would return an EPERM error. | |
1173 * | |
1174 * The method signals an error if the given SIGNO is not valid | |
1175 */ | |
1176 | |
1177 static void | |
1178 nt_kill_child_process (Lisp_Object proc, int signo, | |
2286 | 1179 int UNUSED (current_group), int UNUSED (nomsg)) |
428 | 1180 { |
440 | 1181 Lisp_Process *p = XPROCESS (proc); |
428 | 1182 |
1183 /* Signal error if SIGNO cannot be sent */ | |
1184 validate_signal_number (signo); | |
1185 | |
1186 /* Send signal */ | |
442 | 1187 if (!send_signal (NT_DATA (p), 0, signo)) |
1188 invalid_operation ("Cannot send signal to process", proc); | |
428 | 1189 } |
1190 | |
1191 /* | |
442 | 1192 * Kill any process in the system given its PID |
428 | 1193 * |
1194 * Returns zero if a signal successfully sent, or | |
1195 * negative number upon failure | |
1196 */ | |
1197 static int | |
1198 nt_kill_process_by_pid (int pid, int signo) | |
1199 { | |
442 | 1200 struct Lisp_Process *p; |
1201 | |
428 | 1202 /* Signal error if SIGNO cannot be sent */ |
1203 validate_signal_number (signo); | |
1204 | |
442 | 1205 p = find_process_from_pid (pid); |
1206 return send_signal (p ? NT_DATA (p) : 0, pid, signo) ? 0 : -1; | |
428 | 1207 } |
1208 | |
1209 /*-----------------------------------------------------------------------*/ | |
1210 /* Sockets connections */ | |
1211 /*-----------------------------------------------------------------------*/ | |
1212 #ifdef HAVE_SOCKETS | |
1213 | |
1214 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */ | |
1215 | |
1216 #define SOCK_TIMER_ID 666 | |
1217 #define XM_SOCKREPLY (WM_USER + 666) | |
1218 | |
563 | 1219 /* Return 0 for success, or error code */ |
1220 | |
428 | 1221 static int |
563 | 1222 get_internet_address (Lisp_Object host, struct sockaddr_in *address) |
428 | 1223 { |
2367 | 1224 CBinbyte buf[MAXGETHOSTSTRUCT]; |
428 | 1225 HWND hwnd; |
1226 HANDLE hasync; | |
563 | 1227 int errcode = 0; |
428 | 1228 |
1229 address->sin_family = AF_INET; | |
1230 | |
1231 /* First check if HOST is already a numeric address */ | |
1232 { | |
1204 | 1233 Extbyte *hostext; |
1234 unsigned long inaddr; | |
1235 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1236 hostext = LISP_STRING_TO_EXTERNAL (host, Qmswindows_host_name_encoding); |
1204 | 1237 inaddr = inet_addr (hostext); |
428 | 1238 if (inaddr != INADDR_NONE) |
1239 { | |
1240 address->sin_addr.s_addr = inaddr; | |
563 | 1241 return 0; |
428 | 1242 } |
1243 } | |
1244 | |
1245 /* Create a window which will receive completion messages */ | |
771 | 1246 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1, |
1247 NULL, NULL, NULL, NULL); | |
428 | 1248 assert (hwnd); |
1249 | |
1250 /* Post name resolution request */ | |
771 | 1251 { |
1252 Extbyte *hostext; | |
1253 | |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1254 hostext = LISP_STRING_TO_EXTERNAL (host, Qmswindows_host_name_encoding); |
771 | 1255 |
1256 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, hostext, | |
1257 buf, sizeof (buf)); | |
1258 if (hasync == NULL) | |
1259 { | |
1260 errcode = WSAGetLastError (); | |
1261 goto done; | |
1262 } | |
1263 } | |
428 | 1264 |
1265 /* Set a timer to poll for quit every 250 ms */ | |
1266 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL); | |
1267 | |
1268 while (1) | |
1269 { | |
1270 MSG msg; | |
800 | 1271 qxeGetMessage (&msg, hwnd, 0, 0); |
428 | 1272 if (msg.message == XM_SOCKREPLY) |
1273 { | |
1274 /* Ok, got an answer */ | |
563 | 1275 errcode = WSAGETASYNCERROR (msg.lParam); |
428 | 1276 goto done; |
1277 } | |
1278 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) | |
1279 { | |
1280 if (QUITP) | |
1281 { | |
1282 WSACancelAsyncRequest (hasync); | |
1283 KillTimer (hwnd, SOCK_TIMER_ID); | |
1284 DestroyWindow (hwnd); | |
853 | 1285 QUIT; |
428 | 1286 } |
1287 } | |
800 | 1288 qxeDispatchMessage (&msg); |
428 | 1289 } |
1290 | |
1291 done: | |
1292 KillTimer (hwnd, SOCK_TIMER_ID); | |
1293 DestroyWindow (hwnd); | |
563 | 1294 if (!errcode) |
428 | 1295 { |
1296 /* BUF starts with struct hostent */ | |
771 | 1297 struct hostent *he = (struct hostent *) buf; |
1298 address->sin_addr.s_addr = * (unsigned long *) he->h_addr_list[0]; | |
428 | 1299 } |
563 | 1300 return errcode; |
428 | 1301 } |
1302 | |
1303 static Lisp_Object | |
1304 nt_canonicalize_host_name (Lisp_Object host) | |
1305 { | |
1306 struct sockaddr_in address; | |
1307 | |
563 | 1308 if (get_internet_address (host, &address)) /* error */ |
428 | 1309 return host; |
1310 | |
1311 if (address.sin_family == AF_INET) | |
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
1312 return build_extstring (inet_ntoa (address.sin_addr), |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
1313 Qunix_host_name_encoding); |
428 | 1314 else |
1315 return host; | |
1316 } | |
1317 | |
1318 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
1319 exactly like a normal process when reading and writing. Only | |
1320 differences are in status display and process deletion. A network | |
1321 connection has no PID; you cannot signal it. All you can do is | |
1322 deactivate and close it via delete-process */ | |
1323 | |
1324 static void | |
442 | 1325 nt_open_network_stream (Lisp_Object name, Lisp_Object host, |
1326 Lisp_Object service, | |
771 | 1327 Lisp_Object protocol, void **vinfd, void **voutfd) |
428 | 1328 { |
1329 struct sockaddr_in address; | |
1330 SOCKET s; | |
1331 int port; | |
1332 int retval; | |
563 | 1333 int errnum; |
428 | 1334 |
1335 CHECK_STRING (host); | |
1336 | |
1337 if (!EQ (protocol, Qtcp)) | |
563 | 1338 invalid_constant ("Unsupported protocol", protocol); |
428 | 1339 |
1340 if (INTP (service)) | |
1341 port = htons ((unsigned short) XINT (service)); | |
1342 else | |
1343 { | |
1344 struct servent *svc_info; | |
771 | 1345 Extbyte *servext; |
1346 | |
428 | 1347 CHECK_STRING (service); |
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1348 servext = LISP_STRING_TO_EXTERNAL (service, |
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
1349 Qmswindows_service_name_encoding); |
771 | 1350 |
1351 svc_info = getservbyname (servext, "tcp"); | |
428 | 1352 if (svc_info == 0) |
442 | 1353 invalid_argument ("Unknown service", service); |
428 | 1354 port = svc_info->s_port; |
1355 } | |
1356 | |
563 | 1357 retval = get_internet_address (host, &address); |
1358 if (retval) | |
1359 mswindows_report_winsock_error ("Getting IP address", host, | |
1360 retval); | |
428 | 1361 address.sin_port = port; |
1362 | |
1363 s = socket (address.sin_family, SOCK_STREAM, 0); | |
1364 if (s < 0) | |
563 | 1365 mswindows_report_winsock_error ("Creating socket", name, |
1366 WSAGetLastError ()); | |
428 | 1367 |
1368 /* We don't want to be blocked on connect */ | |
1369 { | |
1370 unsigned long nonblock = 1; | |
1371 ioctlsocket (s, FIONBIO, &nonblock); | |
1372 } | |
854 | 1373 |
428 | 1374 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); |
1375 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK) | |
563 | 1376 { |
1377 errnum = WSAGetLastError (); | |
1378 goto connect_failed; | |
1379 } | |
1380 | |
1381 #if 0 /* PUTA! I thought getsockopt() was failing, so I created the | |
1382 following based on the code in get_internet_address(), but | |
1383 it was my own fault down below. Both versions should work. */ | |
428 | 1384 /* Wait while connection is established */ |
563 | 1385 { |
1386 HWND hwnd; | |
1387 | |
1388 /* Create a window which will receive completion messages */ | |
771 | 1389 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1, |
1390 NULL, NULL, NULL, NULL); | |
563 | 1391 assert (hwnd); |
1392 | |
1393 /* Post request */ | |
1394 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT)) | |
1395 { | |
1396 errnum = WSAGetLastError (); | |
1397 goto done; | |
1398 } | |
1399 | |
1400 /* Set a timer to poll for quit every 250 ms */ | |
1401 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL); | |
1402 | |
1403 while (1) | |
1404 { | |
1405 MSG msg; | |
1406 GetMessage (&msg, hwnd, 0, 0); | |
1407 if (msg.message == XM_SOCKREPLY) | |
1408 { | |
1409 /* Ok, got an answer */ | |
1410 errnum = WSAGETASYNCERROR (msg.lParam); | |
1411 goto done; | |
1412 } | |
1413 | |
1414 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) | |
1415 { | |
1416 if (QUITP) | |
1417 { | |
1418 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
1419 KillTimer (hwnd, SOCK_TIMER_ID); | |
1420 DestroyWindow (hwnd); | |
853 | 1421 QUIT; |
563 | 1422 } |
1423 } | |
1424 DispatchMessage (&msg); | |
1425 } | |
1426 | |
1427 done: | |
1428 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
1429 KillTimer (hwnd, SOCK_TIMER_ID); | |
1430 DestroyWindow (hwnd); | |
1431 if (errnum) | |
1432 goto connect_failed; | |
1433 } | |
1434 | |
1435 #else | |
428 | 1436 while (1) |
1437 { | |
563 | 1438 fd_set fdwriteset, fdexceptset; |
428 | 1439 struct timeval tv; |
1440 int nsel; | |
1441 | |
1442 if (QUITP) | |
1443 { | |
1444 closesocket (s); | |
853 | 1445 QUIT; |
428 | 1446 } |
1447 | |
1448 /* Poll for quit every 250 ms */ | |
1449 tv.tv_sec = 0; | |
1450 tv.tv_usec = 250 * 1000; | |
1451 | |
563 | 1452 FD_ZERO (&fdwriteset); |
1453 FD_SET (s, &fdwriteset); | |
1454 FD_ZERO (&fdexceptset); | |
1455 FD_SET (s, &fdexceptset); | |
1456 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv); | |
1457 | |
1458 if (nsel == SOCKET_ERROR) | |
1459 { | |
1460 errnum = WSAGetLastError (); | |
1461 goto connect_failed; | |
1462 } | |
428 | 1463 |
1464 if (nsel > 0) | |
1465 { | |
1466 /* Check: was connection successful or not? */ | |
563 | 1467 if (FD_ISSET (s, &fdwriteset)) |
1468 break; | |
1469 else if (FD_ISSET (s, &fdexceptset)) | |
1470 { | |
1471 int store_me_harder = sizeof (errnum); | |
1472 /* OK, we finally can get the REAL error code. Any paths | |
1473 in this code that lead to a call of WSAGetLastError() | |
1474 indicate probable logic failure. */ | |
1475 if (getsockopt (s, SOL_SOCKET, SO_ERROR, (char *) &errnum, | |
1476 &store_me_harder)) | |
1477 errnum = WSAGetLastError (); | |
1478 goto connect_failed; | |
1479 } | |
428 | 1480 else |
563 | 1481 { |
1482 signal_error (Qinternal_error, | |
1483 "Porra, esse caralho de um sistema de operacao", | |
1484 Qunbound); | |
1485 break; | |
1486 } | |
428 | 1487 } |
1488 } | |
563 | 1489 #endif |
428 | 1490 |
1491 /* We are connected at this point */ | |
771 | 1492 *vinfd = (void *)s; |
428 | 1493 DuplicateHandle (GetCurrentProcess(), (HANDLE)s, |
1494 GetCurrentProcess(), (LPHANDLE)voutfd, | |
1495 0, FALSE, DUPLICATE_SAME_ACCESS); | |
1496 return; | |
1497 | |
563 | 1498 connect_failed: |
1499 { | |
1500 closesocket (s); | |
1501 mswindows_report_winsock_error ("Connection failed", | |
1502 list3 (Qunbound, host, service), | |
1503 errnum); | |
1504 } | |
428 | 1505 } |
1506 | |
1507 #endif | |
771 | 1508 |
1509 | |
1510 DEFUN ("mswindows-set-process-priority", Fmswindows_set_process_priority, 2, 2, "", /* | |
1511 Set the priority of PROCESS to PRIORITY. | |
1512 If PROCESS is nil, the priority of Emacs is changed, otherwise the | |
1513 priority of the process whose pid is PROCESS is changed. | |
1514 PRIORITY should be one of the symbols high, normal, or low; | |
1515 any other symbol will be interpreted as normal. | |
1516 | |
1517 If successful, the return value is t, otherwise nil. | |
1518 */ | |
1519 (process, priority)) | |
1520 { | |
1521 HANDLE proc_handle = GetCurrentProcess (); | |
1522 DWORD priority_class = NORMAL_PRIORITY_CLASS; | |
1523 Lisp_Object result = Qnil; | |
1524 | |
1525 CHECK_SYMBOL (priority); | |
1526 | |
1527 if (!NILP (process)) | |
1528 { | |
1529 DWORD pid; | |
1530 struct Lisp_Process *p = 0; | |
1531 | |
1532 if (PROCESSP (process)) | |
1533 { | |
1534 CHECK_LIVE_PROCESS (process); | |
1535 p = XPROCESS (process); | |
1536 pid = NT_DATA (p)->dwProcessId; | |
1537 } | |
1538 else | |
1539 { | |
1540 CHECK_INT (process); | |
1541 | |
1542 /* Allow pid to be an internally generated one, or one obtained | |
1543 externally. This is necessary because real pids on Win95 are | |
1544 negative. */ | |
1545 | |
1546 pid = XINT (process); | |
1547 p = find_process_from_pid (pid); | |
1548 if (p != NULL) | |
1549 pid = NT_DATA (p)->dwProcessId; | |
1550 } | |
1551 | |
1552 /* #### Should we be using the existing process handle from NT_DATA(p)? | |
1553 Will we fail if we open it a second time? */ | |
1554 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid); | |
1555 } | |
1556 | |
1557 if (EQ (priority, Qhigh)) | |
1558 priority_class = HIGH_PRIORITY_CLASS; | |
1559 else if (EQ (priority, Qlow)) | |
1560 priority_class = IDLE_PRIORITY_CLASS; | |
1561 | |
1562 if (proc_handle != NULL) | |
1563 { | |
1564 if (SetPriorityClass (proc_handle, priority_class)) | |
1565 result = Qt; | |
1566 if (!NILP (process)) | |
1567 CloseHandle (proc_handle); | |
1568 } | |
1569 | |
1570 return result; | |
1571 } | |
1572 | |
428 | 1573 |
1574 /*-----------------------------------------------------------------------*/ | |
1575 /* Initialization */ | |
1576 /*-----------------------------------------------------------------------*/ | |
1577 | |
1578 void | |
1579 process_type_create_nt (void) | |
1580 { | |
1581 PROCESS_HAS_METHOD (nt, alloc_process_data); | |
1582 PROCESS_HAS_METHOD (nt, finalize_process_data); | |
1583 PROCESS_HAS_METHOD (nt, init_process); | |
1584 PROCESS_HAS_METHOD (nt, create_process); | |
1585 PROCESS_HAS_METHOD (nt, update_status_if_terminated); | |
1586 PROCESS_HAS_METHOD (nt, send_process); | |
2367 | 1587 PROCESS_HAS_METHOD (nt, deactivate_process); |
428 | 1588 PROCESS_HAS_METHOD (nt, kill_child_process); |
1589 PROCESS_HAS_METHOD (nt, kill_process_by_pid); | |
1590 #ifdef HAVE_SOCKETS | |
1591 PROCESS_HAS_METHOD (nt, canonicalize_host_name); | |
1592 PROCESS_HAS_METHOD (nt, open_network_stream); | |
1593 #ifdef HAVE_MULTICAST | |
1594 #error I won't do this until '95 has winsock2 | |
1595 PROCESS_HAS_METHOD (nt, open_multicast_group); | |
1596 #endif | |
1597 #endif | |
1598 } | |
1599 | |
1600 void | |
1601 syms_of_process_nt (void) | |
1602 { | |
771 | 1603 DEFSUBR (Fmswindows_set_process_priority); |
442 | 1604 DEFSYMBOL (Qmswindows_construct_process_command_line); |
428 | 1605 } |
1606 | |
1607 void | |
1608 vars_of_process_nt (void) | |
1609 { | |
442 | 1610 DEFVAR_LISP ("mswindows-start-process-share-console", |
1611 &Vmswindows_start_process_share_console /* | |
1612 When nil, new child processes are given a new console. | |
1613 When non-nil, they share the Emacs console; this has the limitation of | |
638 | 1614 allowing only one DOS subprocess to run at a time (whether started directly |
442 | 1615 or indirectly by Emacs), and preventing Emacs from cleanly terminating the |
1616 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't | |
1617 otherwise respond to interrupts from Emacs. | |
1618 */ ); | |
1619 Vmswindows_start_process_share_console = Qnil; | |
1620 | |
1621 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode", | |
1622 &Vmswindows_start_process_inherit_error_mode /* | |
1623 "When nil, new child processes revert to the default error mode. | |
1624 When non-nil, they inherit their error mode setting from Emacs, which stops | |
1625 them blocking when trying to access unmounted drives etc. | |
1626 */ ); | |
1627 Vmswindows_start_process_inherit_error_mode = Qt; | |
428 | 1628 } |