Mercurial > hg > xemacs-beta
annotate src/process-nt.c @ 5124:623d57b7fbe8 ben-lisp-object
separate regular and disksave finalization, print method fixes.
Create separate disksave method and make the finalize method only be for
actual object finalization, not disksave finalization.
Fix places where 0 was given in place of a printer -- print methods are
mandatory, and internal objects formerly without a print method now must
explicitly specify internal_object_printer().
Change the defn of CONSOLE_LIVE_P to avoid problems in some weird situations.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-01-20 Ben Wing <ben@xemacs.org>
* alloc.c:
* alloc.c (very_old_free_lcrecord):
* alloc.c (disksave_object_finalization_1):
* alloc.c (make_lcrecord_list):
* alloc.c (alloc_managed_lcrecord):
* alloc.c (free_managed_lcrecord):
* alloc.c (sweep_lcrecords_1):
* buffer.c:
* bytecode.c:
* bytecode.c (Fcompiled_function_p):
* chartab.c:
* console-impl.h:
* console-impl.h (CONSOLE_TYPE_P):
* console.c:
* console.c (set_quit_events):
* data.c:
* data.c (Fmake_ephemeron):
* database.c:
* database.c (finalize_database):
* database.c (Fclose_database):
* device-msw.c:
* device-msw.c (finalize_devmode):
* device-msw.c (allocate_devmode):
* device.c:
* elhash.c:
* elhash.c (finalize_hash_table):
* eval.c:
* eval.c (bind_multiple_value_limits):
* event-stream.c:
* event-stream.c (finalize_command_builder):
* events.c:
* events.c (mark_event):
* extents.c:
* extents.c (finalize_extent_info):
* extents.c (uninit_buffer_extents):
* faces.c:
* file-coding.c:
* file-coding.c (finalize_coding_system):
* file-coding.h:
* file-coding.h (struct coding_system_methods):
* file-coding.h (struct detector):
* floatfns.c:
* floatfns.c (extract_float):
* fns.c:
* fns.c (Fidentity):
* font-mgr.c (finalize_fc_pattern):
* font-mgr.c (finalize_fc_config):
* frame.c:
* glyphs.c:
* glyphs.c (finalize_image_instance):
* glyphs.c (unmap_subwindow_instance_cache_mapper):
* gui.c:
* gui.c (gui_error):
* keymap.c:
* lisp.h (struct Lisp_Symbol):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (MC_ALLOC_CALL_FINALIZER):
* lrecord.h (MC_ALLOC_CALL_FINALIZER_FOR_DISKSAVE):
* lrecord.h (DEFINE_DUMPABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_FROB_BLOCK_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_INTERNAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_SIZABLE_INTERNAL_LISP_OBJECT):
* lrecord.h (MAKE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_DUMPABLE_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_GENERAL_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_LISP_OBJECT):
* lrecord.h (DEFINE_NODUMP_MODULE_SIZABLE_GENERAL_LISP_OBJECT):
* lrecord.h (MAKE_MODULE_LISP_OBJECT):
* lstream.c:
* lstream.c (finalize_lstream):
* lstream.c (disksave_lstream):
* marker.c:
* marker.c (finalize_marker):
* mule-charset.c (make_charset):
* number.c:
* objects.c:
* objects.c (finalize_color_instance):
* objects.c (finalize_font_instance):
* opaque.c:
* opaque.c (make_opaque_ptr):
* process-nt.c:
* process-nt.c (nt_finalize_process_data):
* process-nt.c (nt_deactivate_process):
* process.c:
* process.c (finalize_process):
* procimpl.h (struct process_methods):
* scrollbar.c:
* scrollbar.c (free_scrollbar_instance):
* specifier.c (finalize_specifier):
* symbols.c:
* toolbar.c:
* toolbar.c (Ftoolbar_button_p):
* tooltalk.c:
* ui-gtk.c:
* ui-gtk.c (emacs_gtk_object_finalizer):
* ui-gtk.c (allocate_emacs_gtk_boxed_data):
* window.c:
* window.c (finalize_window):
* window.c (mark_window_as_deleted):
Separate out regular and disksave finalization. Instead of a
FOR_DISKSAVE argument to the finalizer, create a separate object
method `disksaver'. Make `finalizer' have only one argument.
Go through and separate out all finalize methods into finalize
and disksave. Delete lots of thereby redundant disksave checking.
Delete places that signal an error if we attempt to disksave --
all of these objects are non-dumpable and we will get an error
from pdump anyway if we attempt to dump them. After this is done,
only one object remains that has a disksave method -- lstream.
Change DEFINE_*_LISP_OBJECT_WITH_PROPS to DEFINE_*_GENERAL_LISP_OBJECT,
which is used for specifying either property methods or disksave
methods (or in the future, any other less-used methods).
Remove the for_disksave argument to finalize_process_data. Don't
provide a disksaver for processes because no one currently needs
it.
Clean up various places where objects didn't provide a print method.
It was made mandatory in previous changes, and all methods now
either provide their own print method or use internal_object_printer
or external_object_printer.
Change the definition of CONSOLE_LIVE_P to use the contype enum
rather than looking into the conmeths structure -- in some weird
situations with dead objects, the conmeths structure is NULL,
and printing such objects from debug_print() will crash if we try
to look into the conmeths structure.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Wed, 20 Jan 2010 07:05:57 -0600 |
| parents | 902d5bd9b75c |
| 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 | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
659 nt_finalize_process_data (Lisp_Process *p) |
| 428 | 660 { |
| 791 | 661 /* If it's still in the list of processes we are waiting on delete |
| 2367 | 662 it. This can happen if we forcibly delete a process and are unable |
| 663 to kill it. */ | |
| 791 | 664 mswindows_unwait_process (p); |
| 442 | 665 if (NT_DATA (p)->h_process) |
| 2367 | 666 { |
| 667 CloseHandle (NT_DATA (p)->h_process); | |
| 668 NT_DATA (p)->h_process = 0; | |
| 669 } | |
| 428 | 670 } |
| 671 | |
| 672 /* | |
| 673 * Initialize XEmacs process implementation once | |
| 674 */ | |
| 675 static void | |
| 676 nt_init_process (void) | |
| 677 { | |
| 678 /* Initialize winsock */ | |
| 679 WSADATA wsa_data; | |
| 680 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */ | |
| 681 WSAStartup (MAKEWORD (1,1), &wsa_data); | |
| 682 } | |
| 683 | |
| 853 | 684 /* |
| 685 * Fork off a subprocess. P is a pointer to newly created subprocess | |
| 686 * object. If this function signals, the caller is responsible for | |
| 687 * deleting (and finalizing) the process object. | |
| 688 * | |
| 689 * The method must return PID of the new process, a (positive??? ####) number | |
| 690 * which fits into Lisp_Int. No return value indicates an error, the method | |
| 691 * must signal an error instead. | |
| 692 */ | |
| 693 | |
| 563 | 694 static DOESNT_RETURN |
| 695 mswindows_report_winsock_error (const char *string, Lisp_Object data, | |
| 696 int errnum) | |
| 428 | 697 { |
| 563 | 698 report_file_type_error (Qnetwork_error, mswindows_lisp_error (errnum), |
| 699 string, 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? */ |
| 771 | 863 LISP_STRING_TO_TSTR (args_or_ret, command_line); |
| 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.) */ | |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
2526
diff
changeset
|
1162 nt_finalize_process_data (p); |
| 2367 | 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 | |
| 1239 LISP_STRING_TO_EXTERNAL (host, hostext, Qmswindows_host_name_encoding); | |
| 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 | |
| 1257 LISP_STRING_TO_EXTERNAL (host, hostext, Qmswindows_host_name_encoding); | |
| 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) | |
| 1315 return build_string (inet_ntoa (address.sin_addr)); | |
| 1316 else | |
| 1317 return host; | |
| 1318 } | |
| 1319 | |
| 1320 /* open a TCP network connection to a given HOST/SERVICE. Treated | |
| 1321 exactly like a normal process when reading and writing. Only | |
| 1322 differences are in status display and process deletion. A network | |
| 1323 connection has no PID; you cannot signal it. All you can do is | |
| 1324 deactivate and close it via delete-process */ | |
| 1325 | |
| 1326 static void | |
| 442 | 1327 nt_open_network_stream (Lisp_Object name, Lisp_Object host, |
| 1328 Lisp_Object service, | |
| 771 | 1329 Lisp_Object protocol, void **vinfd, void **voutfd) |
| 428 | 1330 { |
| 1331 struct sockaddr_in address; | |
| 1332 SOCKET s; | |
| 1333 int port; | |
| 1334 int retval; | |
| 563 | 1335 int errnum; |
| 428 | 1336 |
| 1337 CHECK_STRING (host); | |
| 1338 | |
| 1339 if (!EQ (protocol, Qtcp)) | |
| 563 | 1340 invalid_constant ("Unsupported protocol", protocol); |
| 428 | 1341 |
| 1342 if (INTP (service)) | |
| 1343 port = htons ((unsigned short) XINT (service)); | |
| 1344 else | |
| 1345 { | |
| 1346 struct servent *svc_info; | |
| 771 | 1347 Extbyte *servext; |
| 1348 | |
| 428 | 1349 CHECK_STRING (service); |
| 771 | 1350 LISP_STRING_TO_EXTERNAL (service, servext, |
| 1351 Qmswindows_service_name_encoding); | |
| 1352 | |
| 1353 svc_info = getservbyname (servext, "tcp"); | |
| 428 | 1354 if (svc_info == 0) |
| 442 | 1355 invalid_argument ("Unknown service", service); |
| 428 | 1356 port = svc_info->s_port; |
| 1357 } | |
| 1358 | |
| 563 | 1359 retval = get_internet_address (host, &address); |
| 1360 if (retval) | |
| 1361 mswindows_report_winsock_error ("Getting IP address", host, | |
| 1362 retval); | |
| 428 | 1363 address.sin_port = port; |
| 1364 | |
| 1365 s = socket (address.sin_family, SOCK_STREAM, 0); | |
| 1366 if (s < 0) | |
| 563 | 1367 mswindows_report_winsock_error ("Creating socket", name, |
| 1368 WSAGetLastError ()); | |
| 428 | 1369 |
| 1370 /* We don't want to be blocked on connect */ | |
| 1371 { | |
| 1372 unsigned long nonblock = 1; | |
| 1373 ioctlsocket (s, FIONBIO, &nonblock); | |
| 1374 } | |
| 854 | 1375 |
| 428 | 1376 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); |
| 1377 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK) | |
| 563 | 1378 { |
| 1379 errnum = WSAGetLastError (); | |
| 1380 goto connect_failed; | |
| 1381 } | |
| 1382 | |
| 1383 #if 0 /* PUTA! I thought getsockopt() was failing, so I created the | |
| 1384 following based on the code in get_internet_address(), but | |
| 1385 it was my own fault down below. Both versions should work. */ | |
| 428 | 1386 /* Wait while connection is established */ |
| 563 | 1387 { |
| 1388 HWND hwnd; | |
| 1389 | |
| 1390 /* Create a window which will receive completion messages */ | |
| 771 | 1391 hwnd = qxeCreateWindow (XETEXT ("STATIC"), NULL, WS_OVERLAPPED, 0, 0, 1, 1, |
| 1392 NULL, NULL, NULL, NULL); | |
| 563 | 1393 assert (hwnd); |
| 1394 | |
| 1395 /* Post request */ | |
| 1396 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT)) | |
| 1397 { | |
| 1398 errnum = WSAGetLastError (); | |
| 1399 goto done; | |
| 1400 } | |
| 1401 | |
| 1402 /* Set a timer to poll for quit every 250 ms */ | |
| 1403 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL); | |
| 1404 | |
| 1405 while (1) | |
| 1406 { | |
| 1407 MSG msg; | |
| 1408 GetMessage (&msg, hwnd, 0, 0); | |
| 1409 if (msg.message == XM_SOCKREPLY) | |
| 1410 { | |
| 1411 /* Ok, got an answer */ | |
| 1412 errnum = WSAGETASYNCERROR (msg.lParam); | |
| 1413 goto done; | |
| 1414 } | |
| 1415 | |
| 1416 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID) | |
| 1417 { | |
| 1418 if (QUITP) | |
| 1419 { | |
| 1420 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
| 1421 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1422 DestroyWindow (hwnd); | |
| 853 | 1423 QUIT; |
| 563 | 1424 } |
| 1425 } | |
| 1426 DispatchMessage (&msg); | |
| 1427 } | |
| 1428 | |
| 1429 done: | |
| 1430 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0); | |
| 1431 KillTimer (hwnd, SOCK_TIMER_ID); | |
| 1432 DestroyWindow (hwnd); | |
| 1433 if (errnum) | |
| 1434 goto connect_failed; | |
| 1435 } | |
| 1436 | |
| 1437 #else | |
| 428 | 1438 while (1) |
| 1439 { | |
| 563 | 1440 fd_set fdwriteset, fdexceptset; |
| 428 | 1441 struct timeval tv; |
| 1442 int nsel; | |
| 1443 | |
| 1444 if (QUITP) | |
| 1445 { | |
| 1446 closesocket (s); | |
| 853 | 1447 QUIT; |
| 428 | 1448 } |
| 1449 | |
| 1450 /* Poll for quit every 250 ms */ | |
| 1451 tv.tv_sec = 0; | |
| 1452 tv.tv_usec = 250 * 1000; | |
| 1453 | |
| 563 | 1454 FD_ZERO (&fdwriteset); |
| 1455 FD_SET (s, &fdwriteset); | |
| 1456 FD_ZERO (&fdexceptset); | |
| 1457 FD_SET (s, &fdexceptset); | |
| 1458 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv); | |
| 1459 | |
| 1460 if (nsel == SOCKET_ERROR) | |
| 1461 { | |
| 1462 errnum = WSAGetLastError (); | |
| 1463 goto connect_failed; | |
| 1464 } | |
| 428 | 1465 |
| 1466 if (nsel > 0) | |
| 1467 { | |
| 1468 /* Check: was connection successful or not? */ | |
| 563 | 1469 if (FD_ISSET (s, &fdwriteset)) |
| 1470 break; | |
| 1471 else if (FD_ISSET (s, &fdexceptset)) | |
| 1472 { | |
| 1473 int store_me_harder = sizeof (errnum); | |
| 1474 /* OK, we finally can get the REAL error code. Any paths | |
| 1475 in this code that lead to a call of WSAGetLastError() | |
| 1476 indicate probable logic failure. */ | |
| 1477 if (getsockopt (s, SOL_SOCKET, SO_ERROR, (char *) &errnum, | |
| 1478 &store_me_harder)) | |
| 1479 errnum = WSAGetLastError (); | |
| 1480 goto connect_failed; | |
| 1481 } | |
| 428 | 1482 else |
| 563 | 1483 { |
| 1484 signal_error (Qinternal_error, | |
| 1485 "Porra, esse caralho de um sistema de operacao", | |
| 1486 Qunbound); | |
| 1487 break; | |
| 1488 } | |
| 428 | 1489 } |
| 1490 } | |
| 563 | 1491 #endif |
| 428 | 1492 |
| 1493 /* We are connected at this point */ | |
| 771 | 1494 *vinfd = (void *)s; |
| 428 | 1495 DuplicateHandle (GetCurrentProcess(), (HANDLE)s, |
| 1496 GetCurrentProcess(), (LPHANDLE)voutfd, | |
| 1497 0, FALSE, DUPLICATE_SAME_ACCESS); | |
| 1498 return; | |
| 1499 | |
| 563 | 1500 connect_failed: |
| 1501 { | |
| 1502 closesocket (s); | |
| 1503 mswindows_report_winsock_error ("Connection failed", | |
| 1504 list3 (Qunbound, host, service), | |
| 1505 errnum); | |
| 1506 } | |
| 428 | 1507 } |
| 1508 | |
| 1509 #endif | |
| 771 | 1510 |
| 1511 | |
| 1512 DEFUN ("mswindows-set-process-priority", Fmswindows_set_process_priority, 2, 2, "", /* | |
| 1513 Set the priority of PROCESS to PRIORITY. | |
| 1514 If PROCESS is nil, the priority of Emacs is changed, otherwise the | |
| 1515 priority of the process whose pid is PROCESS is changed. | |
| 1516 PRIORITY should be one of the symbols high, normal, or low; | |
| 1517 any other symbol will be interpreted as normal. | |
| 1518 | |
| 1519 If successful, the return value is t, otherwise nil. | |
| 1520 */ | |
| 1521 (process, priority)) | |
| 1522 { | |
| 1523 HANDLE proc_handle = GetCurrentProcess (); | |
| 1524 DWORD priority_class = NORMAL_PRIORITY_CLASS; | |
| 1525 Lisp_Object result = Qnil; | |
| 1526 | |
| 1527 CHECK_SYMBOL (priority); | |
| 1528 | |
| 1529 if (!NILP (process)) | |
| 1530 { | |
| 1531 DWORD pid; | |
| 1532 struct Lisp_Process *p = 0; | |
| 1533 | |
| 1534 if (PROCESSP (process)) | |
| 1535 { | |
| 1536 CHECK_LIVE_PROCESS (process); | |
| 1537 p = XPROCESS (process); | |
| 1538 pid = NT_DATA (p)->dwProcessId; | |
| 1539 } | |
| 1540 else | |
| 1541 { | |
| 1542 CHECK_INT (process); | |
| 1543 | |
| 1544 /* Allow pid to be an internally generated one, or one obtained | |
| 1545 externally. This is necessary because real pids on Win95 are | |
| 1546 negative. */ | |
| 1547 | |
| 1548 pid = XINT (process); | |
| 1549 p = find_process_from_pid (pid); | |
| 1550 if (p != NULL) | |
| 1551 pid = NT_DATA (p)->dwProcessId; | |
| 1552 } | |
| 1553 | |
| 1554 /* #### Should we be using the existing process handle from NT_DATA(p)? | |
| 1555 Will we fail if we open it a second time? */ | |
| 1556 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid); | |
| 1557 } | |
| 1558 | |
| 1559 if (EQ (priority, Qhigh)) | |
| 1560 priority_class = HIGH_PRIORITY_CLASS; | |
| 1561 else if (EQ (priority, Qlow)) | |
| 1562 priority_class = IDLE_PRIORITY_CLASS; | |
| 1563 | |
| 1564 if (proc_handle != NULL) | |
| 1565 { | |
| 1566 if (SetPriorityClass (proc_handle, priority_class)) | |
| 1567 result = Qt; | |
| 1568 if (!NILP (process)) | |
| 1569 CloseHandle (proc_handle); | |
| 1570 } | |
| 1571 | |
| 1572 return result; | |
| 1573 } | |
| 1574 | |
| 428 | 1575 |
| 1576 /*-----------------------------------------------------------------------*/ | |
| 1577 /* Initialization */ | |
| 1578 /*-----------------------------------------------------------------------*/ | |
| 1579 | |
| 1580 void | |
| 1581 process_type_create_nt (void) | |
| 1582 { | |
| 1583 PROCESS_HAS_METHOD (nt, alloc_process_data); | |
| 1584 PROCESS_HAS_METHOD (nt, finalize_process_data); | |
| 1585 PROCESS_HAS_METHOD (nt, init_process); | |
| 1586 PROCESS_HAS_METHOD (nt, create_process); | |
| 1587 PROCESS_HAS_METHOD (nt, update_status_if_terminated); | |
| 1588 PROCESS_HAS_METHOD (nt, send_process); | |
| 2367 | 1589 PROCESS_HAS_METHOD (nt, deactivate_process); |
| 428 | 1590 PROCESS_HAS_METHOD (nt, kill_child_process); |
| 1591 PROCESS_HAS_METHOD (nt, kill_process_by_pid); | |
| 1592 #ifdef HAVE_SOCKETS | |
| 1593 PROCESS_HAS_METHOD (nt, canonicalize_host_name); | |
| 1594 PROCESS_HAS_METHOD (nt, open_network_stream); | |
| 1595 #ifdef HAVE_MULTICAST | |
| 1596 #error I won't do this until '95 has winsock2 | |
| 1597 PROCESS_HAS_METHOD (nt, open_multicast_group); | |
| 1598 #endif | |
| 1599 #endif | |
| 1600 } | |
| 1601 | |
| 1602 void | |
| 1603 syms_of_process_nt (void) | |
| 1604 { | |
| 771 | 1605 DEFSUBR (Fmswindows_set_process_priority); |
| 442 | 1606 DEFSYMBOL (Qmswindows_construct_process_command_line); |
| 428 | 1607 } |
| 1608 | |
| 1609 void | |
| 1610 vars_of_process_nt (void) | |
| 1611 { | |
| 442 | 1612 DEFVAR_LISP ("mswindows-start-process-share-console", |
| 1613 &Vmswindows_start_process_share_console /* | |
| 1614 When nil, new child processes are given a new console. | |
| 1615 When non-nil, they share the Emacs console; this has the limitation of | |
| 638 | 1616 allowing only one DOS subprocess to run at a time (whether started directly |
| 442 | 1617 or indirectly by Emacs), and preventing Emacs from cleanly terminating the |
| 1618 subprocess group, but may allow Emacs to interrupt a subprocess that doesn't | |
| 1619 otherwise respond to interrupts from Emacs. | |
| 1620 */ ); | |
| 1621 Vmswindows_start_process_share_console = Qnil; | |
| 1622 | |
| 1623 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode", | |
| 1624 &Vmswindows_start_process_inherit_error_mode /* | |
| 1625 "When nil, new child processes revert to the default error mode. | |
| 1626 When non-nil, they inherit their error mode setting from Emacs, which stops | |
| 1627 them blocking when trying to access unmounted drives etc. | |
| 1628 */ ); | |
| 1629 Vmswindows_start_process_inherit_error_mode = Qt; | |
| 428 | 1630 } |