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