annotate src/process-nt.c @ 844:047d37eb70d7

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