annotate src/process-nt.c @ 801:2b676dc88c66

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