Mercurial > hg > xemacs-beta
annotate src/process-nt.c @ 5712:bee2e2568828 r21-5-33
XEmacs 21.5.33 "horseradish" is released.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Sat, 05 Jan 2013 02:11:22 +0900 |
| parents | 56144c8593a8 |
| children | a216b3c2b09e |
| 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) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
639 invalid_constant ("Signal number not supported", make_fixnum (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. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1140 Faccept_process_output (Qnil, Qzero, make_fixnum (wait_ms)); |
| 428 | 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 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1340 if (FIXNUMP (service)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1341 port = htons ((unsigned short) XFIXNUM (service)); |
| 428 | 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 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1540 CHECK_FIXNUM (process); |
| 771 | 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 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5402
diff
changeset
|
1546 pid = XFIXNUM (process); |
| 771 | 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 } |