annotate src/process-nt.c @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents fdefd0186b75
children 7b1f30330a19
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. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
567 PostMessage (cp->hwnd, WM_QUIT, 0xff, 0);
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
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
581 PostMessage (cp->hwnd, WM_CLOSE, 0, 0);
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);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
642 if (NT_DATA (p)->h_process)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
643 CloseHandle (NT_DATA (p)->h_process);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 * Initialize XEmacs process implementation once
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650 nt_init_process (void)
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 /* Initialize winsock */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 WSADATA wsa_data;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 /* Request Winsock v1.1 Note the order: (minor=1, major=1) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 WSAStartup (MAKEWORD (1,1), &wsa_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
658 static DOESNT_RETURN
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
659 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
660 int errnum)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
662 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
663 string, data);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
664 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
665
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
666 static void
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
667 ensure_console_window_exists (void)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
668 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
669 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
670 mswindows_hide_console ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
671 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
672
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
673 int
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
674 mswindows_compare_env (const void *strp1, const void *strp2)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
675 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
676 const Intbyte *str1 = *(const Intbyte **)strp1,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
677 *str2 = *(const Intbyte **)strp2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
678
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
679 while (*str1 && *str2 && *str1 != '=' && *str2 != '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
680 {
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
681 if ((*str1) > (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
682 return 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
683 else if ((*str1) < (*str2))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
684 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
685 str1++, str2++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
686 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
687
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
688 if (*str1 == '=' && *str2 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
689 return 0;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
690 else if (*str1 == '=')
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
691 return -1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
692 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
693 return 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
694 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
696 /*
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
697 * 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
698 * 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
699 * deleting (and finalizing) the process object.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
700 *
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
701 * 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
702 * 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
703 * must signal an error instead.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
704 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
705
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
707 nt_create_process (Lisp_Process *p,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 Lisp_Object *argv, int nargv,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 Lisp_Object program, Lisp_Object cur_dir)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
711 /* Synched up with sys_spawnve in FSF 20.6. Significantly different
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
712 but still synchable. */
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
713 HANDLE hmyshove, hmyslurp, hprocin, hprocout, hprocerr;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
714 Extbyte *command_line;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 BOOL do_io, windowed;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
716 Extbyte *proc_env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
718 /* 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
719 already does this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
720
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 /* 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
722 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
723 /* 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
724 errors. This leads to bogus error message. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
725 DWORD image_type;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
726 Intbyte *p = qxestrrchr (XSTRING_DATA (program), '.');
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
727 if (p != NULL &&
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
728 (qxestrcasecmp (p, ".exe") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
729 qxestrcasecmp (p, ".com") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
730 qxestrcasecmp (p, ".bat") == 0 ||
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
731 qxestrcasecmp (p, ".cmd") == 0))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
732 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
733 Extbyte *progext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
734 LISP_STRING_TO_TSTR (program, progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
735 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
736 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
737 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
738 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
739 DECLARE_EISTRING (progext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
740 eicpy_lstr (progext, program);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
741 eicat_c (progext, ".exe");
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
742 eito_external (progext, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
743 image_type = qxeSHGetFileInfo (eiextdata (progext), 0, NULL, 0,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
744 SHGFI_EXETYPE);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
745 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
746 if (image_type == 0)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
747 mswindows_report_process_error
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
748 ("Determining executable file type",
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
749 program,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
750 GetLastError () == ERROR_FILE_NOT_FOUND
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
751 ? ERROR_BAD_FORMAT : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
752 windowed = HIWORD (image_type) != 0;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
753 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
754
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 /* 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
757 process exited immediately upon successful launching. We do I/O if the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 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
759 is non-zero */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 do_io = !windowed || windowed_process_io ;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 /* Create two unidirectional named pipes */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 HANDLE htmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 SECURITY_ATTRIBUTES sa;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 sa.nLength = sizeof(sa);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769 sa.bInheritHandle = TRUE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 sa.lpSecurityDescriptor = NULL;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 CreatePipe (&hprocin, &hmyshove, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 CreatePipe (&hmyslurp, &hprocout, &sa, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
775 /* Duplicate the stdout handle for use as stderr */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
776 DuplicateHandle(GetCurrentProcess(), hprocout, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
777 &hprocerr, 0, TRUE, DUPLICATE_SAME_ACCESS);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
778
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 /* Stupid Win32 allows to create a pipe with *both* ends either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 inheritable or not. We need process ends inheritable, and local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781 ends not inheritable. */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
782 DuplicateHandle (GetCurrentProcess(), hmyshove, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
783 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
784 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 hmyshove = htmp;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
786 DuplicateHandle (GetCurrentProcess(), hmyslurp, GetCurrentProcess(),
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
787 &htmp, 0, FALSE,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
788 DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 hmyslurp = htmp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792 /* 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
793 lisp function `mswindows-construct-process-command-line'
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
794 (in win32-native.el) */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 Lisp_Object args_or_ret = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 struct gcpro gcpro1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 GCPRO1 (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 for (i = 0; i < nargv; ++i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 args_or_ret = Fcons (*argv++, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 args_or_ret = Fnreverse (args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 args_or_ret = Fcons (program, args_or_ret);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
807 args_or_ret = call1 (Qmswindows_construct_process_command_line,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
808 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 if (!STRINGP (args_or_ret))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 /* Luser wrote his/her own clever version */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
812 invalid_argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
813 ("Bogus return value from `mswindows-construct-process-command-line'",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
814 args_or_ret);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
816 LISP_STRING_TO_TSTR (args_or_ret, command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 UNGCPRO; /* args_or_ret */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 }
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 /* Set `proc_env' to a nul-separated array of the strings in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 Vprocess_environment terminated by 2 nuls. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
823
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
825 Intbyte **env;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 REGISTER Lisp_Object tem;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
827 REGISTER Intbyte **new_env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
828 REGISTER int new_length = 0, i;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 new_length++;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
835
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
836 /* 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
837 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
838 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
839 MS Windows?)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
840
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
841 sprintf (ppid_env_var_buffer, "EM_PARENT_PROCESS_ID=%d",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
842 GetCurrentProcessId ());
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
843 arglen += strlen (ppid_env_var_buffer) + 1;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
844 numenv++;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
845 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 /* new_length + 1 to include terminating 0. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
848 env = new_env = alloca_array (Intbyte *, new_length + 1);
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 /* Copy the Vprocess_environment strings into new_env. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 for (tem = Vprocess_environment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (CONSP (tem)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 && STRINGP (XCAR (tem)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 tem = XCDR (tem))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
856 Intbyte **ep = env;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
857 Intbyte *string = XSTRING_DATA (XCAR (tem));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 /* See if this string duplicates any string already in the env.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 If so, don't put it in.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 When an env var has multiple definitions,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 we keep the definition that comes first in process-environment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 for (; ep != new_env; ep++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
864 Intbyte *p = *ep, *q = string;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 if (*q == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 /* The string is malformed; might as well drop it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 if (*q != *p)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 if (*q == '=')
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 goto duplicate;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 p++, q++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 *new_env++ = string;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 duplicate: ;
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 = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 /* Sort the environment variables */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 new_length = new_env - env;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
884 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
885
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
886 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
887 DECLARE_EISTRING (envout);
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 for (i = 0; i < new_length; i++)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
890 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
891 eicat_raw (envout, env[i], strlen (env[i]));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
892 eicat_raw (envout, "\0", 1);
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
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 eito_external (envout, Qmswindows_tstr);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
897 proc_env = eiextdata (envout);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
898 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 }
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
900
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
901 #if 0
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
902 /* #### we need to port this. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
903 /* 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
904 application to start it by specifying the helper app as cmdname,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
905 while leaving the real app name as argv[0]. */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
906 if (is_dos_app)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
907 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
908 cmdname = (Intbyte *) alloca (PATH_MAX);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
909 if (egetenv ("CMDPROXY"))
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
910 qxestrcpy (cmdname, egetenv ("CMDPROXY"));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
911 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
912 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
913 qxestrcpy (cmdname, XSTRING_DATA (Vinvocation_directory));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
914 qxestrcat (cmdname, (Intbyte *) "cmdproxy.exe");
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
915 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
916 }
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
917 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 /* Create process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
921 STARTUPINFOW si;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 PROCESS_INFORMATION pi;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 DWORD err;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
924 DWORD flags;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 xzero (si);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 si.dwFlags = STARTF_USESHOWWINDOW;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 si.wShowWindow = windowed ? SW_SHOWNORMAL : SW_HIDE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 si.hStdInput = hprocin;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 si.hStdOutput = hprocout;
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
933 si.hStdError = hprocerr;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 si.dwFlags |= STARTF_USESTDHANDLES;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
937 flags = CREATE_SUSPENDED;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
938 if (mswindows_windows9x_p)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
939 flags |= (!NILP (Vmswindows_start_process_share_console)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
940 ? CREATE_NEW_PROCESS_GROUP
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
941 : CREATE_NEW_CONSOLE);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
942 else
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
943 flags |= CREATE_NEW_CONSOLE | CREATE_NEW_PROCESS_GROUP;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
944 if (NILP (Vmswindows_start_process_inherit_error_mode))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
945 flags |= CREATE_DEFAULT_ERROR_MODE;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
946
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
947 ensure_console_window_exists ();
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
948
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
949 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
950 Extbyte *curdirext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
951
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
952 LISP_STRING_TO_TSTR (cur_dir, curdirext);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
953
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
954 err = (qxeCreateProcess (NULL, command_line, NULL, NULL, TRUE,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
955 (XEUNICODE_P ?
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
956 flags | CREATE_UNICODE_ENVIRONMENT :
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
957 flags), proc_env,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
958 curdirext, &si, &pi)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
959 ? 0 : GetLastError ());
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
960 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 /* These just have been inherited; we do not need a copy */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 CloseHandle (hprocin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 CloseHandle (hprocout);
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
967 CloseHandle (hprocerr);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 /* Handle process creation failure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 if (err)
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 if (do_io)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 CloseHandle (hmyshove);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 CloseHandle (hmyslurp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
978 mswindows_report_process_error
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
979 ("Error starting",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
980 program, GetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 /* The process started successfully */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 if (do_io)
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 NT_DATA(p)->h_process = pi.hProcess;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
987 NT_DATA(p)->dwProcessId = pi.dwProcessId;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
988 init_process_io_handles (p, (void *)hmyslurp, (void *)hmyshove, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 /* Indicate as if the process has exited immediately. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 CloseHandle (pi.hProcess);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
997 if (!windowed)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
998 enable_child_signals (pi.hProcess);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
999
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 ResumeThread (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 CloseHandle (pi.hThread);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1003 return ((int)pi.dwProcessId);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006
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 * This method is called to update status fields of the process
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 * structure. If the process has not existed, this method is expected
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 * to do nothing.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 * The method is called only for real child processes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 */
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 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1016 nt_update_status_if_terminated (Lisp_Process *p)
428
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 DWORD exit_code;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 if (GetExitCodeProcess (NT_DATA(p)->h_process, &exit_code)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 && exit_code != STILL_ACTIVE)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 p->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 /* The exit code can be a code returned by process, or an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 NTSTATUS value. We cannot accurately handle the latter since
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 it is a full 32 bit integer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 if (exit_code & 0xC0000000)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 p->status_symbol = Qsignal;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 p->exit_code = exit_code & 0x1FFFFFFF;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 p->exit_code = exit_code;
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 }
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 * Stuff the entire contents of LSTREAM to the process output pipe
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 /* #### If only this function could be somehow merged with
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 unix_send_process... */
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 static void
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1048 nt_send_process (Lisp_Object proc, struct lstream *lstream)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 {
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1050 volatile Lisp_Object vol_proc = proc;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1051 Lisp_Process *volatile p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 /* use a reasonable-sized buffer (somewhere around the size of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 stream buffer) so as to avoid inundating the stream with blocked
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 data. */
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
1056 Intbyte chunkbuf[512];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 Bytecount chunklen;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1061 int writeret;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1063 chunklen = Lstream_read (lstream, chunkbuf, 512);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 if (chunklen <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 break; /* perhaps should abort() if < 0?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 This should never happen. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 /* Lstream_write() will never successfully write less than the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 amount sent in. In the worst case, it just buffers the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 unwritten data. */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1071 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM (p)), chunkbuf,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 chunklen);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1073 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p)));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 if (writeret < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 p->status_symbol = Qexit;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 p->exit_code = ERROR_BROKEN_PIPE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 p->core_dumped = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 p->tick++;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 process_tick++;
432
3a7e78e1142d Import from CVS: tag r21-2-24
cvs
parents: 430
diff changeset
1081 deactivate_process (*((Lisp_Object *) (&vol_proc)));
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1082 invalid_operation ("Broken pipe error sending to process; closed it",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1083 p->name);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1085
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1087 int wait_ms = 25;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream)))
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 /* Buffer is full. Wait, accepting input; that may allow
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1091 the program to finish doing output and read more. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1092 Faccept_process_output (Qnil, Qzero, make_int (wait_ms));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 Lstream_flush (XLSTREAM (p->pipe_outstream));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1094 wait_ms = min (1000, 2 * wait_ms);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1095 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1096 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1097 }
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 * Send a signal number SIGNO to PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1102 * CURRENT_GROUP means send to the process group that currently owns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1103 * the terminal being used to communicate with PROCESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1104 * This is used for various commands in shell mode.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1105 * If NOMSG is zero, insert signal-announcements into process's buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1106 * right away.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1107 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1108 * If we can, we try to signal PROCESS by sending control characters
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1109 * down the pty. This allows us to signal inferiors who have changed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1110 * their uid, for which killpg would return an EPERM error.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1111 *
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1112 * The method signals an error if the given SIGNO is not valid
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1113 */
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1116 nt_kill_child_process (Lisp_Object proc, int signo,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1117 int current_group, int nomsg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1118 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 436
diff changeset
1119 Lisp_Process *p = XPROCESS (proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122 validate_signal_number (signo);
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 /* Send signal */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1125 if (!send_signal (NT_DATA (p), 0, signo))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1126 invalid_operation ("Cannot send signal to process", proc);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1127 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1128
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1129 /*
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1130 * Kill any process in the system given its PID
428
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 * Returns zero if a signal successfully sent, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1133 * negative number upon failure
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 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1136 nt_kill_process_by_pid (int pid, int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1137 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1138 struct Lisp_Process *p;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1139
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1140 /* Signal error if SIGNO cannot be sent */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1141 validate_signal_number (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1142
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1143 p = find_process_from_pid (pid);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1144 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
1145 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1146
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1147 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1148 /* Sockets connections */
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 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1152 /* #### Hey MS, how long Winsock 2 for '95 will be in beta? */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1154 #define SOCK_TIMER_ID 666
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1155 #define XM_SOCKREPLY (WM_USER + 666)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1157 /* Return 0 for success, or error code */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1158
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 static int
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1160 get_internet_address (Lisp_Object host, struct sockaddr_in *address)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1162 Char_Binary buf[MAXGETHOSTSTRUCT];
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 HWND hwnd;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1164 HANDLE hasync;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1165 int errcode = 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 address->sin_family = AF_INET;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 /* First check if HOST is already a numeric address */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 unsigned long inaddr = inet_addr (XSTRING_DATA (host));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1172 if (inaddr != INADDR_NONE)
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 address->sin_addr.s_addr = inaddr;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1175 return 0;
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 /* 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
1180 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
1181 NULL, NULL, NULL, NULL);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 assert (hwnd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184 /* Post name resolution request */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1185 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1186 Extbyte *hostext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1187
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1188 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
1189
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1190 hasync = WSAAsyncGetHostByName (hwnd, XM_SOCKREPLY, hostext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1191 buf, sizeof (buf));
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1192 if (hasync == NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1193 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1194 errcode = WSAGetLastError ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1195 goto done;
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 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 /* Set a timer to poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
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 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 MSG msg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1205 GetMessage (&msg, hwnd, 0, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 if (msg.message == XM_SOCKREPLY)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 /* Ok, got an answer */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1209 errcode = WSAGETASYNCERROR (msg.lParam);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 goto done;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1211 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1212 else if (msg.message == WM_TIMER && msg.wParam == SOCK_TIMER_ID)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1213 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216 WSACancelAsyncRequest (hasync);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218 DestroyWindow (hwnd);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1219 REALLY_QUIT;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1221 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1222 DispatchMessage (&msg);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 done:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 KillTimer (hwnd, SOCK_TIMER_ID);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 DestroyWindow (hwnd);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1228 if (!errcode)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230 /* BUF starts with struct hostent */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1231 struct hostent *he = (struct hostent *) buf;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1232 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
1233 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1234 return errcode;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1235 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 nt_canonicalize_host_name (Lisp_Object host)
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 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1242 if (get_internet_address (host, &address)) /* error */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 return host;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245 if (address.sin_family == AF_INET)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1246 return build_string (inet_ntoa (address.sin_addr));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1247 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 return host;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251 /* open a TCP network connection to a given HOST/SERVICE. Treated
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 exactly like a normal process when reading and writing. Only
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 differences are in status display and process deletion. A network
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1254 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
1255 deactivate and close it via delete-process */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1257 static void
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1258 nt_open_network_stream (Lisp_Object name, Lisp_Object host,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1259 Lisp_Object service,
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1260 Lisp_Object protocol, void **vinfd, void **voutfd)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1261 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 struct sockaddr_in address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 SOCKET s;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 int port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 int retval;
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1266 int errnum;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1267
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 CHECK_STRING (host);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1270 if (!EQ (protocol, Qtcp))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1271 invalid_constant ("Unsupported protocol", protocol);
428
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 (INTP (service))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 port = htons ((unsigned short) XINT (service));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1277 struct servent *svc_info;
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1278 Extbyte *servext;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1279
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280 CHECK_STRING (service);
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1281 LISP_STRING_TO_EXTERNAL (service, servext,
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1282 Qmswindows_service_name_encoding);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1283
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1284 svc_info = getservbyname (servext, "tcp");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 if (svc_info == 0)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1286 invalid_argument ("Unknown service", service);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 port = svc_info->s_port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1289
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1290 retval = get_internet_address (host, &address);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1291 if (retval)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1292 mswindows_report_winsock_error ("Getting IP address", host,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1293 retval);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294 address.sin_port = port;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1296 s = socket (address.sin_family, SOCK_STREAM, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 if (s < 0)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1298 mswindows_report_winsock_error ("Creating socket", name,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1299 WSAGetLastError ());
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 /* We don't want to be blocked on connect */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1302 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 unsigned long nonblock = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 ioctlsocket (s, FIONBIO, &nonblock);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308 if (retval != NO_ERROR && WSAGetLastError() != WSAEWOULDBLOCK)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1309 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1310 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1311 goto connect_failed;
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
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1314 #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
1315 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
1316 it was my own fault down below. Both versions should work. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 /* Wait while connection is established */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1318 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1319 HWND hwnd;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1320
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1321 /* 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
1322 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
1323 NULL, NULL, NULL, NULL);
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1324 assert (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1325
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1326 /* Post request */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1327 if (WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, FD_CONNECT))
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 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1330 goto done;
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
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1333 /* 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
1334 SetTimer (hwnd, SOCK_TIMER_ID, 250, NULL);
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 while (1)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1337 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1338 MSG msg;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1339 GetMessage (&msg, hwnd, 0, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1340 if (msg.message == XM_SOCKREPLY)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1341 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1342 /* Ok, got an answer */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1343 errnum = WSAGETASYNCERROR (msg.lParam);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1344 goto done;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1345 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1346
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1347 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
1348 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1349 if (QUITP)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1350 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1351 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1352 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1353 DestroyWindow (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1354 REALLY_QUIT;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1355 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1356 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1357 DispatchMessage (&msg);
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 done:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1361 WSAAsyncSelect (s, hwnd, XM_SOCKREPLY, 0);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1362 KillTimer (hwnd, SOCK_TIMER_ID);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1363 DestroyWindow (hwnd);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1364 if (errnum)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1365 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1366 }
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1367
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1368 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1369 while (1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1370 {
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1371 fd_set fdwriteset, fdexceptset;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1372 struct timeval tv;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 int nsel;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 if (QUITP)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 closesocket (s);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378 REALLY_QUIT;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381 /* Poll for quit every 250 ms */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 tv.tv_sec = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 tv.tv_usec = 250 * 1000;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1385 FD_ZERO (&fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1386 FD_SET (s, &fdwriteset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1387 FD_ZERO (&fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1388 FD_SET (s, &fdexceptset);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1389 nsel = select (0, NULL, &fdwriteset, &fdexceptset, &tv);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1390
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1391 if (nsel == SOCKET_ERROR)
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1392 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1393 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1394 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1395 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1396
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 if (nsel > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399 /* Check: was connection successful or not? */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1400 if (FD_ISSET (s, &fdwriteset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1401 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1402 else if (FD_ISSET (s, &fdexceptset))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1403 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1404 int store_me_harder = sizeof (errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1405 /* 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
1406 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
1407 indicate probable logic failure. */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1408 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
1409 &store_me_harder))
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1410 errnum = WSAGetLastError ();
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1411 goto connect_failed;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1412 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1414 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1415 signal_error (Qinternal_error,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1416 "Porra, esse caralho de um sistema de operacao",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1417 Qunbound);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1418 break;
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1419 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1421 }
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1422 #endif
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 /* We are connected at this point */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1425 *vinfd = (void *)s;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426 DuplicateHandle (GetCurrentProcess(), (HANDLE)s,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427 GetCurrentProcess(), (LPHANDLE)voutfd,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428 0, FALSE, DUPLICATE_SAME_ACCESS);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 return;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1431 connect_failed:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1432 {
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1433 closesocket (s);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1434 mswindows_report_winsock_error ("Connection failed",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1435 list3 (Qunbound, host, service),
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1436 errnum);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 558
diff changeset
1437 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 #endif
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1441
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1442
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1443 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
1444 Set the priority of PROCESS to PRIORITY.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1445 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
1446 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
1447 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
1448 any other symbol will be interpreted as normal.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1449
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1450 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
1451 */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1452 (process, priority))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1453 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1454 HANDLE proc_handle = GetCurrentProcess ();
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1455 DWORD priority_class = NORMAL_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1456 Lisp_Object result = Qnil;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1457
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1458 CHECK_SYMBOL (priority);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1459
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1460 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1461 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1462 DWORD pid;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1463 struct Lisp_Process *p = 0;
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 if (PROCESSP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1466 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1467 CHECK_LIVE_PROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1468 p = XPROCESS (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1469 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1470 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1471 else
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1472 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1473 CHECK_INT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1474
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1475 /* 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
1476 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
1477 negative. */
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1478
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1479 pid = XINT (process);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1480 p = find_process_from_pid (pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1481 if (p != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1482 pid = NT_DATA (p)->dwProcessId;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1483 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1484
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1485 /* #### 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
1486 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
1487 proc_handle = OpenProcess (PROCESS_SET_INFORMATION, FALSE, pid);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1488 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1489
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1490 if (EQ (priority, Qhigh))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1491 priority_class = HIGH_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1492 else if (EQ (priority, Qlow))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1493 priority_class = IDLE_PRIORITY_CLASS;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1494
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1495 if (proc_handle != NULL)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1496 {
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1497 if (SetPriorityClass (proc_handle, priority_class))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1498 result = Qt;
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1499 if (!NILP (process))
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1500 CloseHandle (proc_handle);
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1501 }
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1502
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1503 return result;
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
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 /*-----------------------------------------------------------------------*/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 /* Initialization */
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 process_type_create_nt (void)
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 PROCESS_HAS_METHOD (nt, alloc_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 PROCESS_HAS_METHOD (nt, finalize_process_data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 PROCESS_HAS_METHOD (nt, init_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 PROCESS_HAS_METHOD (nt, create_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 PROCESS_HAS_METHOD (nt, update_status_if_terminated);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 PROCESS_HAS_METHOD (nt, send_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 PROCESS_HAS_METHOD (nt, kill_child_process);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521 PROCESS_HAS_METHOD (nt, kill_process_by_pid);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 #ifdef HAVE_SOCKETS
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 PROCESS_HAS_METHOD (nt, canonicalize_host_name);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524 PROCESS_HAS_METHOD (nt, open_network_stream);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 #ifdef HAVE_MULTICAST
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526 #error I won't do this until '95 has winsock2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527 PROCESS_HAS_METHOD (nt, open_multicast_group);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1533 syms_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1535 DEFSUBR (Fmswindows_set_process_priority);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1536 DEFSYMBOL (Qmswindows_construct_process_command_line);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 vars_of_process_nt (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1542 DEFVAR_LISP ("mswindows-start-process-share-console",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1543 &Vmswindows_start_process_share_console /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1544 When nil, new child processes are given a new console.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1545 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
1546 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
1547 or indirectly by Emacs), and preventing Emacs from cleanly terminating the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1548 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
1549 otherwise respond to interrupts from Emacs.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1550 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1551 Vmswindows_start_process_share_console = Qnil;
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1552
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1553 DEFVAR_LISP ("mswindows-start-process-inherit-error-mode",
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1554 &Vmswindows_start_process_inherit_error_mode /*
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1555 "When nil, new child processes revert to the default error mode.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1556 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
1557 them blocking when trying to access unmounted drives etc.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1558 */ );
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1559 Vmswindows_start_process_inherit_error_mode = Qt;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 }