Mercurial > hg > xemacs-beta
comparison src/process.c @ 263:727739f917cb r20-5b30
Import from CVS: tag r20-5b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:24:41 +0200 |
parents | 11cf20601dec |
children | 966663fcf606 |
comparison
equal
deleted
inserted
replaced
262:9d8607af9e13 | 263:727739f917cb |
---|---|
19 You should have received a copy of the GNU General Public License | 19 You should have received a copy of the GNU General Public License |
20 along with XEmacs; see the file COPYING. If not, write to | 20 along with XEmacs; see the file COPYING. If not, write to |
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
22 Boston, MA 02111-1307, USA. */ | 22 Boston, MA 02111-1307, USA. */ |
23 | 23 |
24 /* Synched up with: Mule 2.0, FSF 19.30. */ | |
25 | |
26 /* This file has been Mule-ized except for `start-process-internal', | 24 /* This file has been Mule-ized except for `start-process-internal', |
27 `open-network-stream-internal' and `open-multicast-group-internal'. */ | 25 `open-network-stream-internal' and `open-multicast-group-internal'. */ |
26 | |
27 /* This file has been split into process.c and process-unix.c by | |
28 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not | |
29 the original author(s) */ | |
28 | 30 |
29 #include <config.h> | 31 #include <config.h> |
30 | 32 |
31 #if !defined (NO_SUBPROCESSES) | 33 #if !defined (NO_SUBPROCESSES) |
32 | 34 |
36 | 38 |
37 #include "buffer.h" | 39 #include "buffer.h" |
38 #include "commands.h" | 40 #include "commands.h" |
39 #include "events.h" | 41 #include "events.h" |
40 #include "frame.h" | 42 #include "frame.h" |
43 #include "hash.h" | |
41 #include "insdel.h" | 44 #include "insdel.h" |
42 #include "lstream.h" | 45 #include "lstream.h" |
43 #include "opaque.h" | 46 #include "opaque.h" |
44 #include "process.h" | 47 #include "process.h" |
48 #include "procimpl.h" | |
45 #include "sysdep.h" | 49 #include "sysdep.h" |
46 #include "window.h" | 50 #include "window.h" |
47 #ifdef FILE_CODING | 51 #ifdef FILE_CODING |
48 #include "file-coding.h" | 52 #include "file-coding.h" |
49 #endif | 53 #endif |
50 | 54 |
51 #include <setjmp.h> | |
52 #include "sysfile.h" | 55 #include "sysfile.h" |
53 #include "sysproc.h" | 56 #include "sysproc.h" |
54 #include "systime.h" | 57 #include "systime.h" |
55 #include "syssignal.h" /* Always include before systty.h */ | 58 #include "syssignal.h" /* Always include before systty.h */ |
56 | |
57 #include "systty.h" | 59 #include "systty.h" |
58 #include "syswait.h" | 60 #include "syswait.h" |
61 | |
62 Lisp_Object Qprocessp; | |
63 | |
64 /* Process methods */ | |
65 struct process_methods the_process_methods; | |
59 | 66 |
60 /* a process object is a network connection when its pid field a cons | 67 /* a process object is a network connection when its pid field a cons |
61 (name of name of port we are connected to . foreign host name) */ | 68 (name of name of port we are connected to . foreign host name) */ |
62 | 69 |
63 /* Valid values of process->status_symbol */ | 70 /* Valid values of process->status_symbol */ |
64 Lisp_Object Qrun, Qstop; /* Qexit from eval.c, Qsignal from data.c. */ | 71 Lisp_Object Qrun, Qstop; /* Qexit from eval.c, Qsignal from data.c. */ |
65 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ | 72 /* Qrun => Qopen, Qexit => Qclosed for "network connection" processes */ |
66 Lisp_Object Qopen, Qclosed; | 73 Lisp_Object Qopen, Qclosed; |
74 /* Protocol families */ | |
75 Lisp_Object Qtcpip; | |
67 | 76 |
68 #ifdef HAVE_MULTICAST | 77 #ifdef HAVE_MULTICAST |
69 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ | 78 Lisp_Object Qmulticast; /* Will be used for occasional warnings */ |
70 #endif | 79 #endif |
71 | 80 |
72 /* t means use pty, nil means use a pipe, | 81 /* t means use pty, nil means use a pipe, |
73 maybe other values to come. */ | 82 maybe other values to come. */ |
74 static Lisp_Object Vprocess_connection_type; | 83 Lisp_Object Vprocess_connection_type; |
75 | 84 |
76 #ifdef PROCESS_IO_BLOCKING | 85 #ifdef PROCESS_IO_BLOCKING |
77 /* List of port numbers or port names to set a blocking I/O mode. | 86 /* List of port numbers or port names to set a blocking I/O mode. |
78 Nil means set a non-blocking I/O mode [default]. */ | 87 Nil means set a non-blocking I/O mode [default]. */ |
79 static Lisp_Object network_stream_blocking_port_list; | 88 Lisp_Object network_stream_blocking_port_list; |
80 #endif /* PROCESS_IO_BLOCKING */ | 89 #endif /* PROCESS_IO_BLOCKING */ |
81 | 90 |
82 /* FSFmacs says: | |
83 | |
84 These next two vars are non-static since sysdep.c uses them in the | |
85 emulation of `select'. */ | |
86 /* Number of events of change of status of a process. */ | 91 /* Number of events of change of status of a process. */ |
87 static volatile int process_tick; | 92 volatile int process_tick; |
88 | 93 |
89 /* Number of events for which the user or sentinel has been notified. */ | 94 /* Number of events for which the user or sentinel has been notified. */ |
90 static int update_tick; | 95 static int update_tick; |
91 | 96 |
92 /* Nonzero means delete a process right away if it exits. */ | 97 /* Nonzero means delete a process right away if it exits. */ |
93 int delete_exited_processes; | 98 int delete_exited_processes; |
94 | 99 |
95 /* Indexed by descriptor, gives the process (if any) for that descriptor */ | 100 /* Hashtable which maps USIDs as returned by create_stream_pair_cb to |
96 Lisp_Object descriptor_to_process[MAXDESC]; | 101 process objects. Processes are not GC-protected through this! */ |
102 c_hashtable usid_to_process; | |
97 | 103 |
98 /* List of process objects. */ | 104 /* List of process objects. */ |
99 Lisp_Object Vprocess_list; | 105 Lisp_Object Vprocess_list; |
100 | 106 |
101 Lisp_Object Qprocessp; | |
102 | |
103 /* Buffered-ahead input char from process, indexed by channel. | |
104 -1 means empty (no char is buffered). | |
105 Used on sys V where the only way to tell if there is any | |
106 output from the process is to read at least one char. | |
107 Always -1 on systems that support FIONREAD. */ | |
108 | |
109 #if 0 /* FSFmacs */ | |
110 /* FSFmacs says: | |
111 Don't make static; need to access externally. */ | |
112 static int proc_buffered_char[MAXDESC]; | |
113 #endif | |
114 | |
115 #ifdef HAVE_PTYS | |
116 /* The file name of the pty opened by allocate_pty. */ | |
117 | |
118 static char pty_name[24]; | |
119 #endif | |
120 | |
121 | 107 |
122 /************************************************************************/ | |
123 /* the process Lisp object */ | |
124 /************************************************************************/ | |
125 | |
126 /* | |
127 * Structure records pertinent information about open channels. | |
128 * There is one channel associated with each process. | |
129 */ | |
130 | |
131 struct Lisp_Process | |
132 { | |
133 struct lcrecord_header header; | |
134 /* Name of this process */ | |
135 Lisp_Object name; | |
136 /* List of command arguments that this process was run with */ | |
137 Lisp_Object command; | |
138 /* (funcall FILTER PROC STRING) (if FILTER is non-nil) | |
139 to dispose of a bunch of chars from the process all at once */ | |
140 Lisp_Object filter; | |
141 /* (funcall SENTINEL PROCESS) when process state changes */ | |
142 Lisp_Object sentinel; | |
143 /* Buffer that output is going to */ | |
144 Lisp_Object buffer; | |
145 /* Marker set to end of last buffer-inserted output from this process */ | |
146 Lisp_Object mark; | |
147 /* Lisp_Int of subprocess' PID, or a cons of | |
148 service/host if this is really a network connection */ | |
149 Lisp_Object pid; | |
150 /* Non-0 if this is really a ToolTalk channel. */ | |
151 int connected_via_filedesc_p; | |
152 #if 0 /* FSFmacs */ | |
153 /* Perhaps it's cleaner this way, but FSFmacs | |
154 provides no way of retrieving this value, so I'll | |
155 leave this info with PID. */ | |
156 /* Non-nil if this is really a child process */ | |
157 Lisp_Object childp; | |
158 #endif | |
159 | |
160 /* Symbol indicating status of process. | |
161 This may be a symbol: run, stop, exit, signal */ | |
162 Lisp_Object status_symbol; | |
163 | |
164 | |
165 /* Exit code if process has terminated, | |
166 signal which stopped/interrupted process | |
167 or 0 if process is running */ | |
168 int exit_code; | |
169 /* Number of this process */ | |
170 /* Non-false if process has exited and "dumped core" on its way down */ | |
171 char core_dumped; | |
172 /* Descriptor by which we read from this process. -1 for dead process */ | |
173 int infd; | |
174 /* Descriptor by which we write to this process. -1 for dead process */ | |
175 int outfd; | |
176 /* Descriptor for the tty which this process is using. | |
177 -1 if we didn't record it (on some systems, there's no need). */ | |
178 int subtty; | |
179 /* Name of subprocess terminal. */ | |
180 Lisp_Object tty_name; | |
181 /* Non-false if communicating through a pty. */ | |
182 char pty_flag; | |
183 /* This next field is only actually used #ifdef ENERGIZE */ | |
184 /* if this flag is not NIL, then filter will do the read on the | |
185 channel, rather than having a call to make_string. | |
186 This only works if the filter is a subr. */ | |
187 char filter_does_read; | |
188 /* Non-nil means kill silently if Emacs is exited. */ | |
189 char kill_without_query; | |
190 char selected; | |
191 /* Event-count of last event in which this process changed status. */ | |
192 volatile int tick; | |
193 /* Event-count of last such event reported. */ | |
194 int update_tick; | |
195 /* streams used in input and output */ | |
196 Lisp_Object instream; | |
197 Lisp_Object outstream; | |
198 /* The actual filedesc stream used for output; may be different | |
199 than OUTSTREAM under Mule */ | |
200 Lisp_Object filedesc_stream; | |
201 }; | |
202 | |
203 static Lisp_Object mark_process (Lisp_Object, void (*) (Lisp_Object)); | 108 static Lisp_Object mark_process (Lisp_Object, void (*) (Lisp_Object)); |
204 static void print_process (Lisp_Object, Lisp_Object, int); | 109 static void print_process (Lisp_Object, Lisp_Object, int); |
205 static void finalize_process (void *, int); | 110 static void finalize_process (void *, int); |
206 DEFINE_LRECORD_IMPLEMENTATION ("process", process, | 111 DEFINE_LRECORD_IMPLEMENTATION ("process", process, |
207 mark_process, print_process, finalize_process, | 112 mark_process, print_process, finalize_process, |
209 | 114 |
210 static Lisp_Object | 115 static Lisp_Object |
211 mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) | 116 mark_process (Lisp_Object obj, void (*markobj) (Lisp_Object)) |
212 { | 117 { |
213 struct Lisp_Process *proc = XPROCESS (obj); | 118 struct Lisp_Process *proc = XPROCESS (obj); |
119 MAYBE_PROCMETH (mark_process_data, (proc, markobj)); | |
214 ((markobj) (proc->name)); | 120 ((markobj) (proc->name)); |
215 ((markobj) (proc->command)); | 121 ((markobj) (proc->command)); |
216 ((markobj) (proc->filter)); | 122 ((markobj) (proc->filter)); |
217 ((markobj) (proc->sentinel)); | 123 ((markobj) (proc->sentinel)); |
218 ((markobj) (proc->buffer)); | 124 ((markobj) (proc->buffer)); |
219 ((markobj) (proc->mark)); | 125 ((markobj) (proc->mark)); |
220 ((markobj) (proc->pid)); | 126 ((markobj) (proc->pid)); |
221 ((markobj) (proc->tty_name)); | 127 ((markobj) (proc->pipe_instream)); |
222 ((markobj) (proc->instream)); | 128 ((markobj) (proc->pipe_outstream)); |
223 ((markobj) (proc->outstream)); | 129 #ifdef FILE_CODING |
224 ((markobj) (proc->filedesc_stream)); | 130 ((markobj) (proc->coding_instream)); |
131 ((markobj) (proc->coding_outstream)); | |
132 #endif | |
225 return proc->status_symbol; | 133 return proc->status_symbol; |
226 } | 134 } |
227 | 135 |
228 static void | 136 static void |
229 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) | 137 print_process (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
246 print_internal (proc->name, printcharfun, 1); | 154 print_internal (proc->name, printcharfun, 1); |
247 write_c_string (((netp) ? " " : " pid "), printcharfun); | 155 write_c_string (((netp) ? " " : " pid "), printcharfun); |
248 print_internal (proc->pid, printcharfun, 1); | 156 print_internal (proc->pid, printcharfun, 1); |
249 write_c_string (" state:", printcharfun); | 157 write_c_string (" state:", printcharfun); |
250 print_internal (proc->status_symbol, printcharfun, 1); | 158 print_internal (proc->status_symbol, printcharfun, 1); |
159 MAYBE_PROCMETH (print_process_data, (proc, printcharfun)); | |
251 write_c_string (">", printcharfun); | 160 write_c_string (">", printcharfun); |
252 } | 161 } |
253 } | 162 } |
254 | 163 |
255 #ifdef HAVE_WINDOW_SYSTEM | 164 #ifdef HAVE_WINDOW_SYSTEM |
257 #endif /* HAVE_WINDOW_SYSTEM */ | 166 #endif /* HAVE_WINDOW_SYSTEM */ |
258 | 167 |
259 static void | 168 static void |
260 finalize_process (void *header, int for_disksave) | 169 finalize_process (void *header, int for_disksave) |
261 { | 170 { |
262 if (for_disksave) return; /* hmm, what would this do anyway? */ | |
263 /* #### this probably needs to be tied into the tty event loop */ | 171 /* #### this probably needs to be tied into the tty event loop */ |
264 /* #### when there is one */ | 172 /* #### when there is one */ |
173 struct Lisp_Process *p = (struct Lisp_Process *) header; | |
265 #ifdef HAVE_WINDOW_SYSTEM | 174 #ifdef HAVE_WINDOW_SYSTEM |
266 { | 175 if (!for_disksave) |
267 struct Lisp_Process *p = (struct Lisp_Process *) header; | 176 { |
268 debug_process_finalization (p); | 177 debug_process_finalization (p); |
269 } | 178 } |
270 #endif /* HAVE_WINDOW_SYSTEM */ | 179 #endif /* HAVE_WINDOW_SYSTEM */ |
180 | |
181 if (p->process_data) | |
182 { | |
183 MAYBE_PROCMETH (finalize_process_data, (p, for_disksave)); | |
184 if (!for_disksave) | |
185 xfree (p->process_data); | |
186 } | |
271 } | 187 } |
272 | 188 |
273 | 189 |
274 /************************************************************************/ | 190 /************************************************************************/ |
275 /* basic process accessors */ | 191 /* basic process accessors */ |
276 /************************************************************************/ | 192 /************************************************************************/ |
277 | 193 |
278 static SIGTYPE | 194 /* Under FILE_CODING, this function returns low-level streams, connected |
279 close_safely_handler (int signo) | 195 directrly to the child process, rather than en/decoding FILE_CODING |
280 { | 196 streams */ |
281 EMACS_REESTABLISH_SIGNAL (signo, close_safely_handler); | |
282 SIGRETURN; | |
283 } | |
284 | |
285 static void | |
286 close_safely (int fd) | |
287 { | |
288 stop_interrupts (); | |
289 signal (SIGALRM, close_safely_handler); | |
290 alarm (1); | |
291 close (fd); | |
292 alarm (0); | |
293 start_interrupts (); | |
294 } | |
295 | |
296 static void | |
297 close_descriptor_pair (int in, int out) | |
298 { | |
299 if (in >= 0) | |
300 close (in); | |
301 if (out != in && out >= 0) | |
302 close (out); | |
303 } | |
304 | |
305 /* Close all descriptors currently in use for communication | |
306 with subprocess. This is used in a newly-forked subprocess | |
307 to get rid of irrelevant descriptors. */ | |
308 | |
309 void | 197 void |
310 close_process_descs (void) | 198 get_process_streams (struct Lisp_Process *p, |
311 { | 199 Lisp_Object *instr, Lisp_Object *outstr) |
312 #ifndef WINDOWSNT | 200 { |
313 int i; | 201 assert (p); |
314 for (i = 0; i < MAXDESC; i++) | 202 assert (NILP (p->pipe_instream) || LSTREAMP(p->pipe_instream)); |
315 { | 203 assert (NILP (p->pipe_outstream) || LSTREAMP(p->pipe_outstream)); |
316 Lisp_Object process; | 204 *instr = p->pipe_instream; |
317 process = descriptor_to_process[i]; | 205 *outstr = p->pipe_outstream; |
318 if (!NILP (process)) | |
319 { | |
320 close_descriptor_pair (XPROCESS (process)->infd, | |
321 XPROCESS (process)->outfd); | |
322 } | |
323 } | |
324 #endif | |
325 } | |
326 | |
327 void | |
328 get_process_file_descriptors (struct Lisp_Process *p, int *infd, | |
329 int *outfd) | |
330 { | |
331 if (! p) abort (); | |
332 /* the cast of MAXDESC is needed for some versions of Linux */ | |
333 assert (p->infd >= -1 && p->infd < ((int) (MAXDESC))); | |
334 assert (p->outfd >= -1 && p->outfd < ((int) (MAXDESC))); | |
335 *infd = p->infd; | |
336 *outfd = p->outfd; | |
337 } | 206 } |
338 | 207 |
339 struct Lisp_Process * | 208 struct Lisp_Process * |
340 get_process_from_input_descriptor (int infd) | 209 get_process_from_usid (USID usid) |
341 { | 210 { |
342 Lisp_Object proc; | 211 CONST void *vval; |
343 | 212 |
344 if ((infd < 0) || (infd >= ((int) (MAXDESC)))) abort (); | 213 assert (usid != USID_ERROR && usid != USID_DONTHASH); |
345 proc = descriptor_to_process[infd]; | 214 |
346 if (NILP (proc)) | 215 if (gethash ((CONST void*)usid, usid_to_process, &vval)) |
216 { | |
217 Lisp_Object proc; | |
218 CVOID_TO_LISP (proc, vval); | |
219 return XPROCESS (proc); | |
220 } | |
221 else | |
347 return 0; | 222 return 0; |
348 else | |
349 return XPROCESS (proc); | |
350 } | 223 } |
351 | 224 |
352 int | 225 int |
353 get_process_selected_p (struct Lisp_Process *p) | 226 get_process_selected_p (struct Lisp_Process *p) |
354 { | 227 { |
357 | 230 |
358 void | 231 void |
359 set_process_selected_p (struct Lisp_Process *p, int selected_p) | 232 set_process_selected_p (struct Lisp_Process *p, int selected_p) |
360 { | 233 { |
361 p->selected = !!selected_p; | 234 p->selected = !!selected_p; |
235 } | |
236 | |
237 int | |
238 connected_via_filedesc_p (struct Lisp_Process *p) | |
239 { | |
240 return MAYBE_INT_PROCMETH (tooltalk_connection_p, (p)); | |
362 } | 241 } |
363 | 242 |
364 #ifdef HAVE_SOCKETS | 243 #ifdef HAVE_SOCKETS |
365 int | 244 int |
366 network_connection_p (Lisp_Object process) | 245 network_connection_p (Lisp_Object process) |
367 { | 246 { |
368 return GC_CONSP (XPROCESS (process)->pid); | 247 return GC_CONSP (XPROCESS (process)->pid); |
369 } | 248 } |
370 #endif | 249 #endif |
371 | |
372 int | |
373 connected_via_filedesc_p (struct Lisp_Process *p) | |
374 { | |
375 return p->connected_via_filedesc_p; | |
376 } | |
377 | 250 |
378 DEFUN ("processp", Fprocessp, 1, 1, 0, /* | 251 DEFUN ("processp", Fprocessp, 1, 1, 0, /* |
379 Return t if OBJECT is a process. | 252 Return t if OBJECT is a process. |
380 */ | 253 */ |
381 (obj)) | 254 (obj)) |
481 if (GC_NILP (proc)) | 354 if (GC_NILP (proc)) |
482 error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); | 355 error ("Buffer %s has no process", XSTRING_DATA (XBUFFER(obj)->name)); |
483 } | 356 } |
484 else | 357 else |
485 { | 358 { |
486 /* fsf: CHECK_PROCESS (obj, 0); */ | 359 /* #### This was commented out. Although, simple |
360 (kill-process 7 "qqq") resulted in a falat error. - kkm */ | |
361 CHECK_PROCESS (obj); | |
487 proc = obj; | 362 proc = obj; |
488 } | 363 } |
489 return proc; | 364 return proc; |
490 } | 365 } |
491 | 366 |
533 | 408 |
534 /************************************************************************/ | 409 /************************************************************************/ |
535 /* creating a process */ | 410 /* creating a process */ |
536 /************************************************************************/ | 411 /************************************************************************/ |
537 | 412 |
538 static Lisp_Object | 413 Lisp_Object |
539 make_process_internal (Lisp_Object name) | 414 make_process_internal (Lisp_Object name) |
540 { | 415 { |
541 Lisp_Object val, name1; | 416 Lisp_Object val, name1; |
542 int i; | 417 int i; |
543 struct Lisp_Process *p = | 418 struct Lisp_Process *p = |
562 p->sentinel = Qnil; | 437 p->sentinel = Qnil; |
563 p->buffer = Qnil; | 438 p->buffer = Qnil; |
564 p->mark = Fmake_marker (); | 439 p->mark = Fmake_marker (); |
565 p->pid = Qnil; | 440 p->pid = Qnil; |
566 p->status_symbol = Qrun; | 441 p->status_symbol = Qrun; |
567 p->connected_via_filedesc_p = 0; | |
568 p->exit_code = 0; | 442 p->exit_code = 0; |
569 p->core_dumped = 0; | 443 p->core_dumped = 0; |
570 p->infd = -1; | |
571 p->outfd = -1; | |
572 p->subtty = -1; | |
573 p->tty_name = Qnil; | |
574 p->pty_flag = 0; | |
575 p->filter_does_read = 0; | 444 p->filter_does_read = 0; |
576 p->kill_without_query = 0; | 445 p->kill_without_query = 0; |
577 p->selected = 0; | 446 p->selected = 0; |
578 p->tick = 0; | 447 p->tick = 0; |
579 p->update_tick = 0; | 448 p->update_tick = 0; |
580 p->instream = Qnil; | 449 p->pipe_instream = Qnil; |
581 p->outstream = Qnil; | 450 p->pipe_outstream = Qnil; |
451 #ifdef FILE_CODING | |
452 p->coding_instream = Qnil; | |
453 p->coding_outstream = Qnil; | |
454 #endif | |
455 | |
456 p->process_data = 0; | |
457 MAYBE_PROCMETH (alloc_process_data, (p)); | |
582 | 458 |
583 XSETPROCESS (val, p); | 459 XSETPROCESS (val, p); |
584 | 460 |
585 Vprocess_list = Fcons (val, Vprocess_list); | 461 Vprocess_list = Fcons (val, Vprocess_list); |
586 return val; | 462 return val; |
587 } | 463 } |
588 | 464 |
589 #ifdef HAVE_PTYS | 465 void |
590 | 466 init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) |
591 /* Open an available pty, returning a file descriptor. | 467 { |
592 Return -1 on failure. | 468 USID usid = event_stream_create_stream_pair (in, out, |
593 The file name of the terminal corresponding to the pty | 469 &p->pipe_instream, &p->pipe_outstream, |
594 is left in the variable pty_name. */ | 470 flags); |
595 | 471 |
596 static int | 472 if (usid == USID_ERROR) |
597 allocate_pty (void) | 473 report_file_error ("Setting up communication with subprocess", Qnil); |
598 { | 474 |
599 struct stat stb; | 475 if (usid != USID_DONTHASH) |
600 int c, i; | 476 { |
601 int fd; | 477 Lisp_Object proc = Qnil; |
602 | 478 XSETPROCESS (proc, p); |
603 /* Some systems name their pseudoterminals so that there are gaps in | 479 puthash ((CONST void*)usid, LISP_TO_VOID (proc), usid_to_process); |
604 the usual sequence - for example, on HP9000/S700 systems, there | 480 } |
605 are no pseudoterminals with names ending in 'f'. So we wait for | 481 |
606 three failures in a row before deciding that we've reached the | 482 MAYBE_PROCMETH (init_process_io_handles, (p, in, out, flags)); |
607 end of the ptys. */ | |
608 int failed_count = 0; | |
609 | |
610 #ifdef PTY_ITERATION | |
611 PTY_ITERATION | |
612 #else | |
613 for (c = FIRST_PTY_LETTER; c <= 'z'; c++) | |
614 for (i = 0; i < 16; i++) | |
615 #endif | |
616 { | |
617 #ifdef PTY_NAME_SPRINTF | |
618 PTY_NAME_SPRINTF | |
619 #else | |
620 sprintf (pty_name, "/dev/pty%c%x", c, i); | |
621 #endif /* no PTY_NAME_SPRINTF */ | |
622 | |
623 #ifdef PTY_OPEN | |
624 PTY_OPEN; | |
625 #else /* no PTY_OPEN */ | |
626 #ifdef IRIS | |
627 /* Unusual IRIS code */ | |
628 *ptyv = open ("/dev/ptc", O_RDWR | O_NDELAY | OPEN_BINARY, 0); | |
629 if (fd < 0) | |
630 return -1; | |
631 if (fstat (fd, &stb) < 0) | |
632 return -1; | |
633 #else /* not IRIS */ | |
634 if (stat (pty_name, &stb) < 0) | |
635 { | |
636 failed_count++; | |
637 if (failed_count >= 3) | |
638 return -1; | |
639 } | |
640 else | |
641 failed_count = 0; | |
642 #ifdef O_NONBLOCK | |
643 fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); | |
644 #else | |
645 fd = open (pty_name, O_RDWR | O_NDELAY | OPEN_BINARY, 0); | |
646 #endif | |
647 #endif /* not IRIS */ | |
648 #endif /* no PTY_OPEN */ | |
649 | |
650 if (fd >= 0) | |
651 { | |
652 /* check to make certain that both sides are available | |
653 this avoids a nasty yet stupid bug in rlogins */ | |
654 #ifdef PTY_TTY_NAME_SPRINTF | |
655 PTY_TTY_NAME_SPRINTF | |
656 #else | |
657 sprintf (pty_name, "/dev/tty%c%x", c, i); | |
658 #endif /* no PTY_TTY_NAME_SPRINTF */ | |
659 #ifndef UNIPLUS | |
660 if (access (pty_name, 6) != 0) | |
661 { | |
662 close (fd); | |
663 #if !defined(IRIS) && !defined(__sgi) | |
664 continue; | |
665 #else | |
666 return -1; | |
667 #endif /* IRIS */ | |
668 } | |
669 #endif /* not UNIPLUS */ | |
670 setup_pty (fd); | |
671 return fd; | |
672 } | |
673 } | |
674 return -1; | |
675 } | |
676 #endif /* HAVE_PTYS */ | |
677 | |
678 static int | |
679 create_bidirectional_pipe (int *inchannel, int *outchannel, | |
680 volatile int *forkin, volatile int *forkout) | |
681 { | |
682 int sv[2]; | |
683 | |
684 #ifdef SKTPAIR | |
685 if (socketpair (AF_UNIX, SOCK_STREAM, 0, sv) < 0) | |
686 return -1; | |
687 *outchannel = *inchannel = sv[0]; | |
688 *forkout = *forkin = sv[1]; | |
689 #else /* not SKTPAIR */ | |
690 int temp; | |
691 temp = pipe (sv); | |
692 if (temp < 0) return -1; | |
693 *inchannel = sv[0]; | |
694 *forkout = sv[1]; | |
695 temp = pipe (sv); | |
696 if (temp < 0) return -1; | |
697 *outchannel = sv[1]; | |
698 *forkin = sv[0]; | |
699 #endif /* not SKTPAIR */ | |
700 return 0; | |
701 } | |
702 | |
703 | |
704 static Bufbyte | |
705 get_eof_char (struct Lisp_Process *p) | |
706 { | |
707 /* Figure out the eof character for the outfd of the given process. | |
708 * The following code is similar to that in process_send_signal, and | |
709 * should probably be merged with that code somehow. */ | |
710 | |
711 CONST Bufbyte ctrl_d = (Bufbyte) '\004'; | |
712 | |
713 if (!isatty (p->outfd)) | |
714 return ctrl_d; | |
715 #ifdef HAVE_TERMIOS | |
716 { | |
717 struct termios t; | |
718 tcgetattr (p->outfd, &t); | |
719 #if 0 | |
720 /* What is the following line designed to do??? -mrb */ | |
721 if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VEOF + 1)) | |
722 return ctrl_d; | |
723 else | |
724 return (Bufbyte) t.c_cc[VEOF]; | |
725 #endif | |
726 return t.c_cc[VEOF] == CDISABLE ? ctrl_d : (Bufbyte) t.c_cc[VEOF]; | |
727 } | |
728 #else /* ! HAVE_TERMIOS */ | |
729 /* On Berkeley descendants, the following IOCTL's retrieve the | |
730 current control characters. */ | |
731 #if defined (TIOCGETC) | |
732 { | |
733 struct tchars c; | |
734 ioctl (p->outfd, TIOCGETC, &c); | |
735 return (Bufbyte) c.t_eofc; | |
736 } | |
737 #else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ | |
738 /* On SYSV descendants, the TCGETA ioctl retrieves the current control | |
739 characters. */ | |
740 #ifdef TCGETA | |
741 { | |
742 struct termio t; | |
743 ioctl (p->outfd, TCGETA, &t); | |
744 if (strlen ((CONST char *) t.c_cc) < (unsigned int) (VINTR + 1)) | |
745 return ctrl_d; | |
746 else | |
747 return (Bufbyte) t.c_cc[VINTR]; | |
748 } | |
749 #else /* ! defined (TCGETA) */ | |
750 /* Rather than complain, we'll just guess ^D, which is what | |
751 * earlier emacsen always used. */ | |
752 return ctrl_d; | |
753 #endif /* ! defined (TCGETA) */ | |
754 #endif /* ! defined (TIOCGETC) */ | |
755 #endif /* ! defined (HAVE_TERMIOS) */ | |
756 } | |
757 | |
758 static int | |
759 get_pty_max_bytes (struct Lisp_Process *p) | |
760 { | |
761 int pty_max_bytes; | |
762 | |
763 #if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON) | |
764 pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON); | |
765 if (pty_max_bytes < 0) | |
766 pty_max_bytes = 250; | |
767 #else | |
768 pty_max_bytes = 250; | |
769 #endif | |
770 /* Deduct one, to leave space for the eof. */ | |
771 pty_max_bytes--; | |
772 | |
773 return pty_max_bytes; | |
774 } | |
775 | |
776 static void | |
777 init_process_fds (struct Lisp_Process *p, int in, int out) | |
778 { | |
779 p->infd = in; | |
780 p->outfd = out; | |
781 p->instream = make_filedesc_input_stream (in, 0, -1, 0); | |
782 p->outstream = make_filedesc_output_stream (out, 0, -1, | |
783 LSTR_BLOCKED_OK | |
784 | (p->pty_flag ? | |
785 LSTR_PTY_FLUSHING : 0)); | |
786 p->filedesc_stream = p->outstream; | |
787 if (p->pty_flag) | |
788 { | |
789 Bufbyte eof_char = get_eof_char (p); | |
790 int pty_max_bytes = get_pty_max_bytes (p); | |
791 filedesc_stream_set_pty_flushing (XLSTREAM (p->outstream), | |
792 pty_max_bytes, eof_char); | |
793 } | |
794 | 483 |
795 #ifdef FILE_CODING | 484 #ifdef FILE_CODING |
796 | 485 p->coding_instream = make_decoding_input_stream |
797 p->instream = make_decoding_input_stream | 486 (XLSTREAM (p->pipe_instream), |
798 (XLSTREAM (p->instream), | |
799 Fget_coding_system (Vcoding_system_for_read)); | 487 Fget_coding_system (Vcoding_system_for_read)); |
800 Lstream_set_character_mode (XLSTREAM (p->instream)); | 488 Lstream_set_character_mode (XLSTREAM (p->coding_instream)); |
801 p->outstream = make_encoding_output_stream | 489 p->coding_outstream = make_encoding_output_stream |
802 (XLSTREAM (p->outstream), | 490 (XLSTREAM (p->pipe_outstream), |
803 Fget_coding_system (Vcoding_system_for_write)); | 491 Fget_coding_system (Vcoding_system_for_write)); |
804 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!#### | 492 /* CODE_CNTL (&out_state[outchannel]) |= CC_END; !!#### |
805 What's going on here? */ | 493 What's going on here? */ |
806 #endif | 494 #endif /* FILE_CODING */ |
807 } | 495 } |
808 | 496 |
809 static void | 497 static void |
810 create_process (Lisp_Object process, | 498 create_process (Lisp_Object process, |
811 char **new_argv, CONST char *current_dir) | 499 char **new_argv, CONST char *current_dir) |
812 { | 500 { |
813 /* This function rewritten by wing@666.com. */ | |
814 | |
815 int pid, inchannel, outchannel; | |
816 /* Use volatile to protect variables from being clobbered by longjmp. */ | |
817 volatile int forkin, forkout; | |
818 volatile int pty_flag = 0; | |
819 char **env; | |
820 struct Lisp_Process *p = XPROCESS (process); | 501 struct Lisp_Process *p = XPROCESS (process); |
821 | 502 int pid; |
822 env = environ; | 503 |
823 | 504 /* *_create_process may change status_symbol, if the process |
824 inchannel = outchannel = forkin = forkout = -1; | 505 is a kind of "fire-and-forget" (no I/O, unwaitable) */ |
825 | |
826 #ifdef HAVE_PTYS | |
827 if (!NILP (Vprocess_connection_type)) | |
828 { | |
829 /* find a new pty, open the master side, return the opened | |
830 file handle, and store the name of the corresponding slave | |
831 side in global variable pty_name. */ | |
832 outchannel = inchannel = allocate_pty (); | |
833 } | |
834 | |
835 if (inchannel >= 0) | |
836 { | |
837 /* You're "supposed" to now open the slave in the child. | |
838 On some systems, we can open it here; this allows for | |
839 better error checking. */ | |
840 #if !defined(USG) | |
841 /* On USG systems it does not work to open the pty's tty here | |
842 and then close and reopen it in the child. */ | |
843 #ifdef O_NOCTTY | |
844 /* Don't let this terminal become our controlling terminal | |
845 (in case we don't have one). */ | |
846 forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY | OPEN_BINARY, 0); | |
847 #else | |
848 forkout = forkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); | |
849 #endif | |
850 if (forkin < 0) | |
851 goto io_failure; | |
852 #endif /* not USG */ | |
853 p->pty_flag = pty_flag = 1; | |
854 } | |
855 else | |
856 #endif /* HAVE_PTYS */ | |
857 if (create_bidirectional_pipe (&inchannel, &outchannel, | |
858 &forkin, &forkout) < 0) | |
859 goto io_failure; | |
860 | |
861 #if 0 | |
862 /* Replaced by close_process_descs */ | |
863 set_exclusive_use (inchannel); | |
864 set_exclusive_use (outchannel); | |
865 #endif | |
866 | |
867 set_descriptor_non_blocking (inchannel); | |
868 | |
869 /* Record this as an active process, with its channels. | |
870 As a result, child_setup will close Emacs's side of the pipes. */ | |
871 descriptor_to_process[inchannel] = process; | |
872 init_process_fds (p, inchannel, outchannel); | |
873 /* Record the tty descriptor used in the subprocess. */ | |
874 p->subtty = forkin; | |
875 p->status_symbol = Qrun; | 506 p->status_symbol = Qrun; |
876 p->exit_code = 0; | 507 p->exit_code = 0; |
877 | 508 |
878 { | 509 pid = PROCMETH (create_process, (p, new_argv, current_dir)); |
879 #if !defined(__CYGWIN32__) | |
880 /* child_setup must clobber environ on systems with true vfork. | |
881 Protect it from permanent change. */ | |
882 char **save_environ = environ; | |
883 #endif | |
884 | |
885 #ifdef EMACS_BTL | |
886 /* when performance monitoring is on, turn it off before the vfork(), | |
887 as the child has no handler for the signal -- when back in the | |
888 parent process, turn it back on if it was really on when you "turned | |
889 it off" */ | |
890 int logging_on = cadillac_stop_logging (); /* #### rename me */ | |
891 #endif | |
892 | |
893 #ifndef WINDOWSNT | |
894 pid = fork (); | |
895 if (pid == 0) | |
896 #endif /* not WINDOWSNT */ | |
897 { | |
898 /**** Now we're in the child process ****/ | |
899 int xforkin = forkin; | |
900 int xforkout = forkout; | |
901 | |
902 if (!pty_flag) | |
903 EMACS_SEPARATE_PROCESS_GROUP (); | |
904 #ifdef HAVE_PTYS | |
905 else | |
906 { | |
907 /* Disconnect the current controlling terminal, pursuant to | |
908 making the pty be the controlling terminal of the process. | |
909 Also put us in our own process group. */ | |
910 | |
911 disconnect_controlling_terminal (); | |
912 | |
913 /* Open the pty connection and make the pty's terminal | |
914 our controlling terminal. | |
915 | |
916 On systems with TIOCSCTTY, we just use it to set | |
917 the controlling terminal. On other systems, the | |
918 first TTY we open becomes the controlling terminal. | |
919 So, we end up with four possibilities: | |
920 | |
921 (1) on USG and TIOCSCTTY systems, we open the pty | |
922 and use TIOCSCTTY. | |
923 (2) on other USG systems, we just open the pty. | |
924 (3) on non-USG systems with TIOCSCTTY, we | |
925 just use TIOCSCTTY. (On non-USG systems, we | |
926 already opened the pty in the parent process.) | |
927 (4) on non-USG systems without TIOCSCTTY, we | |
928 close the pty and reopen it. | |
929 | |
930 This would be cleaner if we didn't open the pty | |
931 in the parent process, but doing it that way | |
932 makes it possible to trap error conditions. | |
933 It's harder to convey an error from the child | |
934 process, and I don't feel like messing with | |
935 this now. */ | |
936 | |
937 /* There was some weirdo, probably wrong, | |
938 conditionalization on RTU and UNIPLUS here. | |
939 I deleted it. So sue me. */ | |
940 | |
941 /* SunOS has TIOCSCTTY but the close/open method | |
942 also works. */ | |
943 | |
944 # if defined (USG) || !defined (TIOCSCTTY) | |
945 /* Now close the pty (if we had it open) and reopen it. | |
946 This makes the pty the controlling terminal of the | |
947 subprocess. */ | |
948 /* I wonder if close (open (pty_name, ...)) would work? */ | |
949 if (xforkin >= 0) | |
950 close (xforkin); | |
951 xforkout = xforkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); | |
952 if (xforkin < 0) | |
953 { | |
954 write (1, "Couldn't open the pty terminal ", 31); | |
955 write (1, pty_name, strlen (pty_name)); | |
956 write (1, "\n", 1); | |
957 _exit (1); | |
958 } | |
959 # endif /* USG or not TIOCSCTTY */ | |
960 | |
961 /* Miscellaneous setup required for some systems. | |
962 Must be done before using tc* functions on xforkin. | |
963 This guarantees that isatty(xforkin) is true. */ | |
964 | |
965 # ifdef SETUP_SLAVE_PTY | |
966 SETUP_SLAVE_PTY; | |
967 # endif /* SETUP_SLAVE_PTY */ | |
968 | |
969 # ifdef TIOCSCTTY | |
970 /* We ignore the return value | |
971 because faith@cs.unc.edu says that is necessary on Linux. */ | |
972 assert (isatty (xforkin)); | |
973 ioctl (xforkin, TIOCSCTTY, 0); | |
974 # endif /* TIOCSCTTY */ | |
975 | |
976 /* Change the line discipline. */ | |
977 | |
978 # if defined (HAVE_TERMIOS) && defined (LDISC1) | |
979 { | |
980 struct termios t; | |
981 assert (isatty (xforkin)); | |
982 tcgetattr (xforkin, &t); | |
983 t.c_lflag = LDISC1; | |
984 if (tcsetattr (xforkin, TCSANOW, &t) < 0) | |
985 perror ("create_process/tcsetattr LDISC1 failed\n"); | |
986 } | |
987 # elif defined (NTTYDISC) && defined (TIOCSETD) | |
988 { | |
989 /* Use new line discipline. TIOCSETD is accepted and | |
990 ignored on Sys5.4 systems with ttcompat. */ | |
991 int ldisc = NTTYDISC; | |
992 assert (isatty (xforkin)); | |
993 ioctl (xforkin, TIOCSETD, &ldisc); | |
994 } | |
995 # endif /* TIOCSETD & NTTYDISC */ | |
996 | |
997 /* Make our process group be the foreground group | |
998 of our new controlling terminal. */ | |
999 | |
1000 { | |
1001 int piddly = EMACS_GET_PROCESS_GROUP (); | |
1002 EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly); | |
1003 } | |
1004 | |
1005 # ifdef AIX | |
1006 /* On AIX, we've disabled SIGHUP above once we start a | |
1007 child on a pty. Now reenable it in the child, so it | |
1008 will die when we want it to. */ | |
1009 signal (SIGHUP, SIG_DFL); | |
1010 # endif /* AIX */ | |
1011 } | |
1012 #endif /* HAVE_PTYS */ | |
1013 | |
1014 signal (SIGINT, SIG_DFL); | |
1015 signal (SIGQUIT, SIG_DFL); | |
1016 | |
1017 #if !defined(MSDOS) && !defined(WINDOWSNT) | |
1018 if (pty_flag) | |
1019 { | |
1020 /* Set up the terminal characteristics of the pty. */ | |
1021 child_setup_tty (xforkout); | |
1022 } | |
1023 | |
1024 #ifdef WINDOWSNT | |
1025 pid = child_setup (xforkin, xforkout, xforkout, | |
1026 new_argv, current_dir); | |
1027 #else /* not WINDOWSNT */ | |
1028 child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); | |
1029 #endif /* not WINDOWSNT */ | |
1030 #endif /* not MSDOS */ | |
1031 } | |
1032 #ifdef EMACS_BTL | |
1033 else if (logging_on) | |
1034 cadillac_start_logging (); /* #### rename me */ | |
1035 #endif | |
1036 | |
1037 #if !defined(__CYGWIN32__) | |
1038 environ = save_environ; | |
1039 #endif | |
1040 } | |
1041 | |
1042 if (pid < 0) | |
1043 { | |
1044 close_descriptor_pair (forkin, forkout); | |
1045 report_file_error ("Doing fork", Qnil); | |
1046 } | |
1047 | 510 |
1048 p->pid = make_int (pid); | 511 p->pid = make_int (pid); |
1049 /* #### dmoore - why is this commented out, otherwise we leave | 512 if (!NILP(p->pipe_instream)) |
1050 subtty = forkin, but then we close forkin just below. */ | 513 event_stream_select_process (p); |
1051 /* p->subtty = -1; */ | |
1052 | |
1053 #ifdef WINDOWSNT | |
1054 register_child (pid, inchannel); | |
1055 #endif /* WINDOWSNT */ | |
1056 | |
1057 /* If the subfork execv fails, and it exits, | |
1058 this close hangs. I don't know why. | |
1059 So have an interrupt jar it loose. */ | |
1060 if (forkin >= 0) | |
1061 close_safely (forkin); | |
1062 if (forkin != forkout && forkout >= 0) | |
1063 close (forkout); | |
1064 | |
1065 #ifdef HAVE_PTYS | |
1066 if (pty_flag) | |
1067 XPROCESS (process)->tty_name = build_string (pty_name); | |
1068 else | |
1069 #endif | |
1070 XPROCESS (process)->tty_name = Qnil; | |
1071 | |
1072 /* Notice that SIGCHLD was not blocked. (This is not possible on | |
1073 some systems.) No biggie if SIGCHLD occurs right around the | |
1074 time that this call happens, because SIGCHLD() does not actually | |
1075 deselect the process (that doesn't occur until the next time | |
1076 we're waiting for an event, when status_notify() is called). */ | |
1077 event_stream_select_process (XPROCESS (process)); | |
1078 | |
1079 return; | |
1080 | |
1081 io_failure: | |
1082 { | |
1083 int temp = errno; | |
1084 close_descriptor_pair (forkin, forkout); | |
1085 close_descriptor_pair (inchannel, outchannel); | |
1086 errno = temp; | |
1087 report_file_error ("Opening pty or pipe", Qnil); | |
1088 } | |
1089 } | 514 } |
1090 | 515 |
1091 /* This function is the unwind_protect form for Fstart_process_internal. If | 516 /* This function is the unwind_protect form for Fstart_process_internal. If |
1092 PROC doesn't have its pid set, then we know someone has signalled | 517 PROC doesn't have its pid set, then we know someone has signalled |
1093 an error and the process wasn't started successfully, so we should | 518 an error and the process wasn't started successfully, so we should |
1215 UNGCPRO; | 640 UNGCPRO; |
1216 return unbind_to (speccount, proc); | 641 return unbind_to (speccount, proc); |
1217 } | 642 } |
1218 | 643 |
1219 | 644 |
1220 /* connect to an existing file descriptor. This is very similar to | |
1221 open-network-stream except that it assumes that the connection has | |
1222 already been initialized. It is currently used for ToolTalk | |
1223 communication. */ | |
1224 | |
1225 /* This function used to be visible on the Lisp level, but there is no | |
1226 real point in doing that. Here is the doc string: | |
1227 | |
1228 "Connect to an existing file descriptor.\n\ | |
1229 Returns a subprocess-object to represent the connection.\n\ | |
1230 Input and output work as for subprocesses; `delete-process' closes it.\n\ | |
1231 Args are NAME BUFFER INFD OUTFD.\n\ | |
1232 NAME is name for process. It is modified if necessary to make it unique.\n\ | |
1233 BUFFER is the buffer (or buffer-name) to associate with the process.\n\ | |
1234 Process output goes at end of that buffer, unless you specify\n\ | |
1235 an output stream or filter function to handle the output.\n\ | |
1236 BUFFER may be also nil, meaning that this process is not associated\n\ | |
1237 with any buffer\n\ | |
1238 INFD and OUTFD specify the file descriptors to use for input and\n\ | |
1239 output, respectively." | |
1240 */ | |
1241 | |
1242 Lisp_Object | |
1243 connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer, | |
1244 Lisp_Object infd, Lisp_Object outfd) | |
1245 { | |
1246 /* This function can GC */ | |
1247 Lisp_Object proc; | |
1248 int inch; | |
1249 | |
1250 CHECK_STRING (name); | |
1251 CHECK_INT (infd); | |
1252 CHECK_INT (outfd); | |
1253 | |
1254 inch = XINT (infd); | |
1255 if (!NILP (descriptor_to_process[inch])) | |
1256 error ("There is already a process connected to fd %d", inch); | |
1257 if (!NILP (buffer)) | |
1258 buffer = Fget_buffer_create (buffer); | |
1259 proc = make_process_internal (name); | |
1260 | |
1261 descriptor_to_process[inch] = proc; | |
1262 | |
1263 XPROCESS (proc)->pid = Fcons (infd, name); | |
1264 XPROCESS (proc)->buffer = buffer; | |
1265 init_process_fds (XPROCESS (proc), inch, XINT (outfd)); | |
1266 XPROCESS (proc)->connected_via_filedesc_p = 1; | |
1267 | |
1268 event_stream_select_process (XPROCESS (proc)); | |
1269 | |
1270 return proc; | |
1271 } | |
1272 | |
1273 | |
1274 #ifdef HAVE_SOCKETS | 645 #ifdef HAVE_SOCKETS |
1275 | 646 |
1276 static int | 647 |
1277 get_internet_address (Lisp_Object host, struct sockaddr_in *address, | 648 /* #### The network support is fairly synthetical. What we actually |
1278 Error_behavior errb) | 649 need is a single function, which supports all datagram, stream and |
1279 { | 650 packet stream connections, arbitrary protocol families should they |
1280 struct hostent *host_info_ptr = NULL; | 651 be supported by the target system, multicast groups, in both data |
1281 #ifdef TRY_AGAIN | 652 and control rooted/nonrooted flavors, service quality etc whatever |
1282 int count = 0; | 653 is supported by the underlying network. |
1283 #endif | 654 |
1284 | 655 It must accept a property list describing the connection. The current |
1285 memset (address, 0, sizeof (*address)); | 656 functions must then go to lisp and provide a suitable list for the |
1286 | 657 generalized connection function. |
1287 while (1) | 658 |
1288 { | 659 Both UNIX ans Win32 support BSD sockets, and there are many extensions |
1289 #ifdef TRY_AGAIN | 660 availalble (Sockets 2 spec). |
1290 if (count++ > 10) break; | 661 |
1291 #ifndef BROKEN_CYGWIN | 662 A todo is define a consistent set of properties abstracting a |
1292 h_errno = 0; | 663 network connection. -kkm |
1293 #endif | 664 */ |
1294 #endif | 665 |
1295 /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */ | |
1296 slow_down_interrupts (); | |
1297 host_info_ptr = gethostbyname ((char *) XSTRING_DATA (host)); | |
1298 speed_up_interrupts (); | |
1299 #ifdef TRY_AGAIN | |
1300 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) | |
1301 #endif | |
1302 break; | |
1303 Fsleep_for (make_int (1)); | |
1304 } | |
1305 if (host_info_ptr) | |
1306 { | |
1307 address->sin_family = host_info_ptr->h_addrtype; | |
1308 memcpy (&address->sin_addr, host_info_ptr->h_addr, host_info_ptr->h_length); | |
1309 } | |
1310 else | |
1311 { | |
1312 IN_ADDR numeric_addr; | |
1313 /* Attempt to interpret host as numeric inet address */ | |
1314 numeric_addr = inet_addr ((char *) XSTRING_DATA (host)); | |
1315 if (NUMERIC_ADDR_ERROR) | |
1316 { | |
1317 maybe_error (Qprocess, errb, | |
1318 "Unknown host \"%s\"", XSTRING_DATA (host)); | |
1319 return 0; | |
1320 } | |
1321 | |
1322 /* There was some broken code here that called strlen() here | |
1323 on (char *) &numeric_addr and even sometimes accessed | |
1324 uninitialized data. */ | |
1325 address->sin_family = AF_INET; | |
1326 * (IN_ADDR *) &address->sin_addr = numeric_addr; | |
1327 } | |
1328 | |
1329 return 1; | |
1330 } | |
1331 | 666 |
1332 /* open a TCP network connection to a given HOST/SERVICE. Treated | 667 /* open a TCP network connection to a given HOST/SERVICE. Treated |
1333 exactly like a normal process when reading and writing. Only | 668 exactly like a normal process when reading and writing. Only |
1334 differences are in status display and process deletion. A network | 669 differences are in status display and process deletion. A network |
1335 connection has no PID; you cannot signal it. All you can do is | 670 connection has no PID; you cannot signal it. All you can do is |
1336 deactivate and close it via delete-process */ | 671 deactivate and close it via delete-process */ |
1337 | 672 |
1338 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 4, 0, /* | 673 DEFUN ("open-network-stream-internal", Fopen_network_stream_internal, 4, 5, 0, /* |
1339 Open a TCP connection for a service to a host. | 674 Open a TCP connection for a service to a host. |
1340 Returns a subprocess-object to represent the connection. | 675 Returns a subprocess-object to represent the connection. |
1341 Input and output work as for subprocesses; `delete-process' closes it. | 676 Input and output work as for subprocesses; `delete-process' closes it. |
1342 | 677 |
1343 NAME is name for process. It is modified if necessary to make it unique. | 678 NAME is name for process. It is modified if necessary to make it unique. |
1347 BUFFER may also be nil, meaning that this process is not associated | 682 BUFFER may also be nil, meaning that this process is not associated |
1348 with any buffer. | 683 with any buffer. |
1349 Third arg is name of the host to connect to, or its IP address. | 684 Third arg is name of the host to connect to, or its IP address. |
1350 Fourth arg SERVICE is name of the service desired, or an integer | 685 Fourth arg SERVICE is name of the service desired, or an integer |
1351 specifying a port number to connect to. | 686 specifying a port number to connect to. |
1352 */ | 687 Fifth argument FAMILY is a protocol family. When omitted, 'tcp/ip |
1353 (name, buffer, host, service)) | 688 (Internet protocol family TCP/IP) is assumed. |
689 */ | |
690 (name, buffer, host, service, family)) | |
1354 { | 691 { |
1355 /* !!#### This function has not been Mule-ized */ | 692 /* !!#### This function has not been Mule-ized */ |
1356 /* This function can GC */ | 693 /* This function can GC */ |
1357 Lisp_Object proc; | 694 Lisp_Object proc = Qnil; |
1358 struct sockaddr_in address; | 695 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, ngcpro1; |
1359 int s, outch, inch; | 696 void *inch, *outch; |
1360 volatile int port; | 697 |
1361 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | 698 GCPRO5 (name, buffer, host, service, family); |
1362 volatile int retry = 0; | |
1363 int retval; | |
1364 | |
1365 GCPRO4 (name, buffer, host, service); | |
1366 CHECK_STRING (name); | 699 CHECK_STRING (name); |
1367 CHECK_STRING (host); | 700 |
1368 if (INTP (service)) | 701 if (NILP(family)) |
1369 port = htons ((unsigned short) XINT (service)); | 702 family = Qtcpip; |
1370 else | 703 else |
1371 { | 704 CHECK_SYMBOL (family); |
1372 struct servent *svc_info; | 705 |
1373 CHECK_STRING (service); | 706 /* Since this code is inside HAVE_SOCKETS, existence of |
1374 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); | 707 open_network_stream is mandatory */ |
1375 if (svc_info == 0) | 708 PROCMETH (open_network_stream, (name, host, service, family, |
1376 #ifdef WIN32 | 709 &inch, &outch)); |
1377 error ("Unknown service \"%s\" (%d)", | 710 |
1378 XSTRING_DATA (service), WSAGetLastError ()); | |
1379 #else | |
1380 error ("Unknown service \"%s\"", XSTRING_DATA (service)); | |
1381 #endif | |
1382 port = svc_info->s_port; | |
1383 } | |
1384 | |
1385 get_internet_address (host, &address, ERROR_ME); | |
1386 address.sin_port = port; | |
1387 | |
1388 s = socket (address.sin_family, SOCK_STREAM, 0); | |
1389 if (s < 0) | |
1390 report_file_error ("error creating socket", list1 (name)); | |
1391 | |
1392 /* Turn off interrupts here -- see comments below. There used to | |
1393 be code which called bind_polling_period() to slow the polling | |
1394 period down rather than turn it off, but that seems rather | |
1395 bogus to me. Best thing here is to use a non-blocking connect | |
1396 or something, to check for QUIT. */ | |
1397 | |
1398 /* Comments that are not quite valid: */ | |
1399 | |
1400 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) | |
1401 when connect is interrupted. So let's not let it get interrupted. | |
1402 Note we do not turn off polling, because polling is only used | |
1403 when not interrupt_input, and thus not normally used on the systems | |
1404 which have this bug. On systems which use polling, there's no way | |
1405 to quit if polling is turned off. */ | |
1406 | |
1407 /* Slow down polling. Some kernels have a bug which causes retrying | |
1408 connect to fail after a connect. */ | |
1409 | |
1410 slow_down_interrupts (); | |
1411 | |
1412 loop: | |
1413 | |
1414 /* A system call interrupted with a SIGALRM or SIGIO comes back | |
1415 here, with can_break_system_calls reset to 0. */ | |
1416 SETJMP (break_system_call_jump); | |
1417 if (QUITP) | |
1418 { | |
1419 speed_up_interrupts (); | |
1420 REALLY_QUIT; | |
1421 /* In case something really weird happens ... */ | |
1422 slow_down_interrupts (); | |
1423 } | |
1424 | |
1425 /* Break out of connect with a signal (it isn't otherwise possible). | |
1426 Thus you don't get screwed with a hung network. */ | |
1427 can_break_system_calls = 1; | |
1428 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); | |
1429 can_break_system_calls = 0; | |
1430 if (retval == -1 && errno != EISCONN) | |
1431 { | |
1432 int xerrno = errno; | |
1433 if (errno == EINTR) | |
1434 goto loop; | |
1435 if (errno == EADDRINUSE && retry < 20) | |
1436 { | |
1437 /* A delay here is needed on some FreeBSD systems, | |
1438 and it is harmless, since this retrying takes time anyway | |
1439 and should be infrequent. | |
1440 `sleep-for' allowed for quitting this loop with interrupts | |
1441 slowed down so it can't be used here. Async timers should | |
1442 already be disabled at this point so we can use `sleep'. */ | |
1443 sleep (1); | |
1444 retry++; | |
1445 goto loop; | |
1446 } | |
1447 | |
1448 close (s); | |
1449 | |
1450 speed_up_interrupts (); | |
1451 | |
1452 errno = xerrno; | |
1453 report_file_error ("connection failed", list2 (host, name)); | |
1454 } | |
1455 | |
1456 speed_up_interrupts (); | |
1457 | |
1458 inch = s; | |
1459 outch = dup (s); | |
1460 if (outch < 0) | |
1461 { | |
1462 close (s); /* this used to be leaked; from Kyle Jones */ | |
1463 report_file_error ("error duplicating socket", list1 (name)); | |
1464 } | |
1465 | |
1466 if (!NILP (buffer)) | 711 if (!NILP (buffer)) |
1467 buffer = Fget_buffer_create (buffer); | 712 buffer = Fget_buffer_create (buffer); |
1468 proc = make_process_internal (name); | 713 proc = make_process_internal (name); |
1469 | 714 NGCPRO1 (proc); |
1470 descriptor_to_process[inch] = proc; | |
1471 | |
1472 #ifdef PROCESS_IO_BLOCKING | |
1473 { | |
1474 Lisp_Object tail; | |
1475 | |
1476 for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail)) | |
1477 { | |
1478 Lisp_Object tail_port = XCAR (tail); | |
1479 | |
1480 if (STRINGP (tail_port)) | |
1481 { | |
1482 struct servent *svc_info; | |
1483 CHECK_STRING (tail_port); | |
1484 svc_info = getservbyname ((char *) XSTRING_DATA (tail_port), "tcp"); | |
1485 if ((svc_info != 0) && (svc_info->s_port == port)) | |
1486 break; | |
1487 else | |
1488 continue; | |
1489 } | |
1490 else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port)) | |
1491 break; | |
1492 } | |
1493 | |
1494 if (!CONSP (tail)) | |
1495 { | |
1496 #endif /* PROCESS_IO_BLOCKING */ | |
1497 set_descriptor_non_blocking (inch); | |
1498 #ifdef PROCESS_IO_BLOCKING | |
1499 } | |
1500 } | |
1501 #endif /* PROCESS_IO_BLOCKING */ | |
1502 | 715 |
1503 XPROCESS (proc)->pid = Fcons (service, host); | 716 XPROCESS (proc)->pid = Fcons (service, host); |
1504 XPROCESS (proc)->buffer = buffer; | 717 XPROCESS (proc)->buffer = buffer; |
1505 init_process_fds (XPROCESS (proc), inch, outch); | 718 init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 0); |
1506 XPROCESS (proc)->connected_via_filedesc_p = 0; | |
1507 | 719 |
1508 event_stream_select_process (XPROCESS (proc)); | 720 event_stream_select_process (XPROCESS (proc)); |
1509 | 721 |
1510 UNGCPRO; | 722 UNGCPRO; |
723 NUNGCPRO; | |
1511 return proc; | 724 return proc; |
1512 } | 725 } |
1513 | 726 |
1514 #ifdef HAVE_MULTICAST | 727 #ifdef HAVE_MULTICAST |
1515 /* Didier Verna <verna@inf.enst.fr> Nov. 28 1997. | 728 |
1516 | |
1517 This function is similar to open-network-stream-internal, but provides a | |
1518 mean to open an UDP multicast connection instead of a TCP one. Like in the | |
1519 TCP case, the multicast connection will be seen as a sub-process, | |
1520 | |
1521 Some notes: | |
1522 - Normaly, we should use sendto and recvfrom with non connected | |
1523 sockets. The current code doesn't allow us to do this. In the future, it | |
1524 would be a good idea to extend the process data structure in order to deal | |
1525 properly with the different types network connections. | |
1526 - For the same reason, when leaving a multicast group, it is better to make | |
1527 a setsockopt - IP_DROP_MEMBERSHIP before closing the descriptors. | |
1528 Unfortunately, this can't be done here because delete_process doesn't know | |
1529 about the kind of connection we have. However, this is not such an | |
1530 important issue. | |
1531 */ | |
1532 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* | 729 DEFUN ("open-multicast-group-internal", Fopen_multicast_group_internal, 5, 5, 0, /* |
1533 Open a multicast connection on the specified dest/port/ttl. | 730 Open a multicast connection on the specified dest/port/ttl. |
1534 Returns a subprocess-object to represent the connection. | 731 Returns a subprocess-object to represent the connection. |
1535 Input and output work as for subprocesses; `delete-process' closes it. | 732 Input and output work as for subprocesses; `delete-process' closes it. |
1536 | 733 |
1547 */ | 744 */ |
1548 (name, buffer, dest, port, ttl)) | 745 (name, buffer, dest, port, ttl)) |
1549 { | 746 { |
1550 /* !!#### This function has not been Mule-ized */ | 747 /* !!#### This function has not been Mule-ized */ |
1551 /* This function can GC */ | 748 /* This function can GC */ |
1552 Lisp_Object proc; | 749 Lisp_Object proc = Qnil; |
1553 struct ip_mreq imr; | |
1554 struct sockaddr_in sa; | |
1555 struct protoent *udp; | |
1556 int ws, rs; | |
1557 int theport; | |
1558 unsigned char thettl; | |
1559 int one = 1; /* For REUSEADDR */ | |
1560 int ret; | |
1561 volatile int retry = 0; | |
1562 struct gcpro gcpro1; | 750 struct gcpro gcpro1; |
1563 | 751 void *inch, *outch; |
752 | |
1564 CHECK_STRING (name); | 753 CHECK_STRING (name); |
1565 CHECK_STRING (dest); | 754 |
1566 | 755 /* Since this code is inside HAVE_MULTICAST, existence of |
1567 CHECK_NATNUM (port); | 756 open_network_stream is mandatory */ |
1568 theport = htons ((unsigned short) XINT (port)); | 757 PROCMETH (open_multicast_group, (name, dest, port, ttl, |
1569 | 758 &inch, &outch)); |
1570 CHECK_NATNUM (ttl); | |
1571 thettl = (unsigned char) XINT (ttl); | |
1572 | |
1573 if ((udp = getprotobyname ("udp")) == NULL) | |
1574 error ("No info available for UDP protocol"); | |
1575 | |
1576 /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */ | |
1577 if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) | |
1578 report_file_error ("error creating socket", list1(name)); | |
1579 if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) | |
1580 { | |
1581 close (rs); | |
1582 report_file_error ("error creating socket", list1(name)); | |
1583 } | |
1584 | |
1585 /* This will be used for both sockets */ | |
1586 bzero(&sa, sizeof(sa)); | |
1587 sa.sin_family = AF_INET; | |
1588 sa.sin_port = theport; | |
1589 sa.sin_addr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); | |
1590 | |
1591 /* Socket configuration for reading ------------------------ */ | |
1592 | |
1593 /* Multiple connections from the same machine. This must be done before | |
1594 bind. If it fails, it shouldn't be fatal. The only consequence is that | |
1595 people won't be able to connect twice from the same machine. */ | |
1596 if (setsockopt (rs, SOL_SOCKET, SO_REUSEADDR, (char *) &one, sizeof (one)) | |
1597 < 0) | |
1598 warn_when_safe (Qmulticast, Qwarning, "Cannot reuse socket address"); | |
1599 | |
1600 /* bind socket name */ | |
1601 if (bind (rs, (struct sockaddr *)&sa, sizeof(sa))) | |
1602 { | |
1603 close (rs); | |
1604 close (ws); | |
1605 report_file_error ("error binding socket", list2(name, port)); | |
1606 } | |
1607 | |
1608 /* join multicast group */ | |
1609 imr.imr_multiaddr.s_addr = htonl (inet_addr ((char *) XSTRING_DATA (dest))); | |
1610 imr.imr_interface.s_addr = htonl (INADDR_ANY); | |
1611 if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, | |
1612 (char *) &imr, sizeof (struct ip_mreq)) < 0) | |
1613 { | |
1614 close (ws); | |
1615 close (rs); | |
1616 report_file_error ("error adding membership", list2(name, dest)); | |
1617 } | |
1618 | |
1619 /* Socket configuration for writing ----------------------- */ | |
1620 | |
1621 /* Normaly, there's no 'connect' in multicast, since we use preferentialy | |
1622 'sendto' and 'recvfrom'. However, in order to handle this connection in | |
1623 the process-like way it is done for TCP, we must be able to use 'write' | |
1624 instead of 'sendto'. Consequently, we 'connect' this socket. */ | |
1625 | |
1626 /* See open-network-stream-internal for comments on this part of the code */ | |
1627 slow_down_interrupts (); | |
1628 | |
1629 loop: | |
1630 | |
1631 /* A system call interrupted with a SIGALRM or SIGIO comes back | |
1632 here, with can_break_system_calls reset to 0. */ | |
1633 SETJMP (break_system_call_jump); | |
1634 if (QUITP) | |
1635 { | |
1636 speed_up_interrupts (); | |
1637 REALLY_QUIT; | |
1638 /* In case something really weird happens ... */ | |
1639 slow_down_interrupts (); | |
1640 } | |
1641 | |
1642 /* Break out of connect with a signal (it isn't otherwise possible). | |
1643 Thus you don't get screwed with a hung network. */ | |
1644 can_break_system_calls = 1; | |
1645 ret = connect (ws, (struct sockaddr *) &sa, sizeof (sa)); | |
1646 can_break_system_calls = 0; | |
1647 if (ret == -1 && errno != EISCONN) | |
1648 { | |
1649 int xerrno = errno; | |
1650 | |
1651 if (errno == EINTR) | |
1652 goto loop; | |
1653 if (errno == EADDRINUSE && retry < 20) | |
1654 { | |
1655 /* A delay here is needed on some FreeBSD systems, | |
1656 and it is harmless, since this retrying takes time anyway | |
1657 and should be infrequent. | |
1658 `sleep-for' allowed for quitting this loop with interrupts | |
1659 slowed down so it can't be used here. Async timers should | |
1660 already be disabled at this point so we can use `sleep'. */ | |
1661 sleep (1); | |
1662 retry++; | |
1663 goto loop; | |
1664 } | |
1665 | |
1666 close (rs); | |
1667 close (ws); | |
1668 speed_up_interrupts (); | |
1669 | |
1670 errno = xerrno; | |
1671 report_file_error ("error connecting socket", list2(name, port)); | |
1672 } | |
1673 | |
1674 speed_up_interrupts (); | |
1675 | |
1676 /* scope */ | |
1677 if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, | |
1678 (char *) &thettl, sizeof (thettl)) < 0) | |
1679 { | |
1680 close (rs); | |
1681 close (ws); | |
1682 report_file_error ("error setting ttl", list2(name, ttl)); | |
1683 } | |
1684 | 759 |
1685 if (!NILP (buffer)) | 760 if (!NILP (buffer)) |
1686 buffer = Fget_buffer_create (buffer); | 761 buffer = Fget_buffer_create (buffer); |
1687 | 762 |
1688 proc = make_process_internal (name); | 763 proc = make_process_internal (name); |
1689 GCPRO1 (proc); | 764 GCPRO1 (proc); |
1690 | 765 |
1691 descriptor_to_process[rs] = proc; | |
1692 | |
1693 #ifdef PROCESS_IO_BLOCKING | |
1694 { | |
1695 Lisp_Object tail; | |
1696 | |
1697 for (tail = network_stream_blocking_port_list; | |
1698 CONSP (tail); tail = XCDR (tail)) | |
1699 { | |
1700 Lisp_Object tail_port = XCAR (tail); | |
1701 | |
1702 if (STRINGP (tail_port)) | |
1703 { | |
1704 struct servent *svc_info; | |
1705 | |
1706 svc_info = | |
1707 getservbyname ((char *) XSTRING_DATA (tail_port), "udp"); | |
1708 if ((svc_info != 0) && (svc_info->s_port == theport)) | |
1709 break; | |
1710 else | |
1711 continue; | |
1712 } | |
1713 else if ((INTP (tail_port)) && | |
1714 (htons ((unsigned short) XINT (tail_port)) == theport)) | |
1715 break; | |
1716 } | |
1717 | |
1718 if (!CONSP (tail)) | |
1719 { | |
1720 #endif /* PROCESS_IO_BLOCKING */ | |
1721 set_descriptor_non_blocking (rs); | |
1722 #ifdef PROCESS_IO_BLOCKING | |
1723 } | |
1724 } | |
1725 #endif /* PROCESS_IO_BLOCKING */ | |
1726 | |
1727 XPROCESS (proc)->pid = Fcons (port, dest); | 766 XPROCESS (proc)->pid = Fcons (port, dest); |
1728 XPROCESS (proc)->buffer = buffer; | 767 XPROCESS (proc)->buffer = buffer; |
1729 init_process_fds (XPROCESS (proc), rs, ws); | 768 init_process_io_handles (XPROCESS (proc), (void*)inch, (void*)outch, 0); |
1730 XPROCESS (proc)->connected_via_filedesc_p = 0; | |
1731 | 769 |
1732 event_stream_select_process (XPROCESS (proc)); | 770 event_stream_select_process (XPROCESS (proc)); |
1733 | 771 |
1734 UNGCPRO; | 772 UNGCPRO; |
1735 return proc; | 773 return proc; |
1739 #endif /* HAVE_SOCKETS */ | 777 #endif /* HAVE_SOCKETS */ |
1740 | 778 |
1741 Lisp_Object | 779 Lisp_Object |
1742 canonicalize_host_name (Lisp_Object host) | 780 canonicalize_host_name (Lisp_Object host) |
1743 { | 781 { |
1744 #ifdef HAVE_SOCKETS | 782 return PROCMETH_OR_GIVEN (canonicalize_host_name, (host), host); |
1745 /* #### for HAVE_TERM, you probably have to do something else. */ | |
1746 struct sockaddr_in address; | |
1747 | |
1748 if (!get_internet_address (host, &address, ERROR_ME_NOT)) | |
1749 return host; | |
1750 | |
1751 if (address.sin_family == AF_INET) | |
1752 return build_string (inet_ntoa (address.sin_addr)); | |
1753 else | |
1754 /* #### any clue what to do here? */ | |
1755 return host; | |
1756 #else | |
1757 return host; | |
1758 #endif | |
1759 } | 783 } |
1760 | 784 |
1761 | 785 |
1762 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* | 786 DEFUN ("set-process-window-size", Fset_process_window_size, 3, 3, 0, /* |
1763 Tell PROCESS that it has logical window size HEIGHT and WIDTH. | 787 Tell PROCESS that it has logical window size HEIGHT and WIDTH. |
1765 (proc, height, width)) | 789 (proc, height, width)) |
1766 { | 790 { |
1767 CHECK_PROCESS (proc); | 791 CHECK_PROCESS (proc); |
1768 CHECK_NATNUM (height); | 792 CHECK_NATNUM (height); |
1769 CHECK_NATNUM (width); | 793 CHECK_NATNUM (width); |
1770 if (set_window_size (XPROCESS (proc)->infd, XINT (height), XINT (width)) | 794 return |
1771 <= 0) | 795 MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (proc), XINT (height), XINT (width))) <= 0 |
1772 return Qnil; | 796 ? Qnil : Qt; |
1773 else | |
1774 return Qt; | |
1775 } | 797 } |
1776 | 798 |
1777 | 799 |
1778 /************************************************************************/ | 800 /************************************************************************/ |
1779 /* Process I/O */ | 801 /* Process I/O */ |
1780 /************************************************************************/ | 802 /************************************************************************/ |
1781 | |
1782 /* (Faccept_process_output is now in event-stream.c) */ | |
1783 | |
1784 /* Some FSFmacs error handlers here. We handle this | |
1785 in call2_trapping_errors(). */ | |
1786 | 803 |
1787 /* Read pending output from the process channel, | 804 /* Read pending output from the process channel, |
1788 starting with our buffered-ahead character if we have one. | 805 starting with our buffered-ahead character if we have one. |
1789 Yield number of characters read. | 806 Yield number of characters read. |
1790 | 807 |
1807 calls set the filter to t, we have to stop now. Return -1 rather | 824 calls set the filter to t, we have to stop now. Return -1 rather |
1808 than 0 so execute_internal_event() doesn't close the process. | 825 than 0 so execute_internal_event() doesn't close the process. |
1809 Really, the loop in execute_internal_event() should check itself | 826 Really, the loop in execute_internal_event() should check itself |
1810 for a process-filter change, like in status_notify(); but the | 827 for a process-filter change, like in status_notify(); but the |
1811 struct Lisp_Process is not exported outside of this file. */ | 828 struct Lisp_Process is not exported outside of this file. */ |
1812 if (p->infd < 0) | 829 if (NILP(p->pipe_instream)) |
1813 return -1; /* already closed */ | 830 return -1; /* already closed */ |
1814 | 831 |
1815 if (!NILP (p->filter) && (p->filter_does_read)) | 832 if (!NILP (p->filter) && (p->filter_does_read)) |
1816 { | 833 { |
1817 Lisp_Object filter_result; | 834 Lisp_Object filter_result; |
1825 restore_match_data (); | 842 restore_match_data (); |
1826 CHECK_INT (filter_result); | 843 CHECK_INT (filter_result); |
1827 return XINT (filter_result); | 844 return XINT (filter_result); |
1828 } | 845 } |
1829 | 846 |
1830 #if 0 /* FSFmacs */ | 847 nbytes = Lstream_read (XLSTREAM (DATA_INSTREAM(p)), chars, sizeof (chars)); |
1831 /* #### equivalent code from FSFmacs. Would need some porting | |
1832 for Windows NT. */ | |
1833 if (proc_buffered_char[channel] < 0) | |
1834 #ifdef WINDOWSNT | |
1835 nchars = read_child_output (channel, chars, sizeof (chars)); | |
1836 #else | |
1837 nchars = read (channel, chars, sizeof chars); | |
1838 #endif | |
1839 else | |
1840 { | |
1841 chars[0] = proc_buffered_char[channel]; | |
1842 proc_buffered_char[channel] = -1; | |
1843 #ifdef WINDOWSNT | |
1844 nchars = read_child_output (channel, chars + 1, sizeof (chars) - 1); | |
1845 #else | |
1846 nchars = read (channel, chars + 1, sizeof chars - 1); | |
1847 #endif | |
1848 if (nchars < 0) | |
1849 nchars = 1; | |
1850 else | |
1851 nchars = nchars + 1; | |
1852 } | |
1853 #endif /* FSFmacs */ | |
1854 | |
1855 nbytes = Lstream_read (XLSTREAM (p->instream), chars, sizeof (chars)); | |
1856 if (nbytes <= 0) return nbytes; | 848 if (nbytes <= 0) return nbytes; |
1857 | 849 |
1858 nchars = bytecount_to_charcount (chars, nbytes); | 850 nchars = bytecount_to_charcount (chars, nbytes); |
1859 outstream = p->filter; | 851 outstream = p->filter; |
1860 if (!NILP (outstream)) | 852 if (!NILP (outstream)) |
1954 | 946 |
1955 UNGCPRO; | 947 UNGCPRO; |
1956 } | 948 } |
1957 return nchars; | 949 return nchars; |
1958 } | 950 } |
1959 | 951 |
1960 /* Sending data to subprocess */ | 952 /* Sending data to subprocess */ |
1961 | |
1962 static JMP_BUF send_process_frame; | |
1963 | |
1964 static SIGTYPE | |
1965 send_process_trap (int signum) | |
1966 { | |
1967 EMACS_REESTABLISH_SIGNAL (signum, send_process_trap); | |
1968 EMACS_UNBLOCK_SIGNAL (signum); | |
1969 LONGJMP (send_process_frame, 1); | |
1970 } | |
1971 | 953 |
1972 /* send some data to process PROC. If NONRELOCATABLE is non-NULL, it | 954 /* send some data to process PROC. If NONRELOCATABLE is non-NULL, it |
1973 specifies the address of the data. Otherwise, the data comes from the | 955 specifies the address of the data. Otherwise, the data comes from the |
1974 object RELOCATABLE (either a string or a buffer). START and LEN | 956 object RELOCATABLE (either a string or a buffer). START and LEN |
1975 specify the offset and length of the data to send. | 957 specify the offset and length of the data to send. |
1976 | 958 |
1977 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, | 959 Note that START and LEN are in Bufpos's if RELOCATABLE is a buffer, |
1978 and in Bytecounts otherwise. */ | 960 and in Bytecounts otherwise. */ |
1979 | 961 |
1980 static void | 962 void |
1981 send_process (volatile Lisp_Object proc, | 963 send_process (Lisp_Object proc, |
1982 Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, | 964 Lisp_Object relocatable, CONST Bufbyte *nonrelocatable, |
1983 int start, int len) | 965 int start, int len) |
1984 { | 966 { |
1985 /* This function can GC */ | 967 /* This function can GC */ |
1986 /* Use volatile to protect variables from being clobbered by longjmp. */ | |
1987 struct gcpro gcpro1, gcpro2; | 968 struct gcpro gcpro1, gcpro2; |
1988 SIGTYPE (*volatile old_sigpipe) (int) = 0; | |
1989 Lisp_Object lstream = Qnil; | 969 Lisp_Object lstream = Qnil; |
1990 volatile struct Lisp_Process *p = XPROCESS (proc); | 970 |
1991 #if defined (NO_UNION_TYPE) /* || !defined (__GNUC__) GCC bug only??? */ | 971 GCPRO2 (proc, lstream); |
1992 /* #### ugh! There must be a better solution. */ | 972 |
1993 Lisp_Object defeat_volatile_kludge = (Lisp_Object) proc; | 973 if (NILP (DATA_OUTSTREAM (XPROCESS (proc)))) |
1994 #else | |
1995 Lisp_Object defeat_volatile_kludge = proc; | |
1996 #endif | |
1997 | |
1998 GCPRO2 (defeat_volatile_kludge, lstream); | |
1999 | |
2000 if (p->outfd < 0) | |
2001 signal_simple_error ("Process not open for writing", proc); | 974 signal_simple_error ("Process not open for writing", proc); |
2002 | 975 |
2003 if (nonrelocatable) | 976 if (nonrelocatable) |
2004 lstream = | 977 lstream = |
2005 make_fixed_buffer_input_stream (nonrelocatable + start, len); | 978 make_fixed_buffer_input_stream (nonrelocatable + start, len); |
2007 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), | 980 lstream = make_lisp_buffer_input_stream (XBUFFER (relocatable), |
2008 start, start + len, 0); | 981 start, start + len, 0); |
2009 else | 982 else |
2010 lstream = make_lisp_string_input_stream (relocatable, start, len); | 983 lstream = make_lisp_string_input_stream (relocatable, start, len); |
2011 | 984 |
2012 if (!SETJMP (send_process_frame)) | 985 PROCMETH (send_process, (proc, XLSTREAM (lstream))); |
2013 { | 986 |
2014 /* use a reasonable-sized buffer (somewhere around the size of the | |
2015 stream buffer) so as to avoid inundating the stream with blocked | |
2016 data. */ | |
2017 Bufbyte chunkbuf[512]; | |
2018 Bytecount chunklen; | |
2019 | |
2020 while (1) | |
2021 { | |
2022 int writeret; | |
2023 | |
2024 chunklen = Lstream_read (XLSTREAM (lstream), chunkbuf, 512); | |
2025 if (chunklen <= 0) | |
2026 break; /* perhaps should abort() if < 0? | |
2027 This should never happen. */ | |
2028 old_sigpipe = | |
2029 (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); | |
2030 /* Lstream_write() will never successfully write less than | |
2031 the amount sent in. In the worst case, it just buffers | |
2032 the unwritten data. */ | |
2033 writeret = Lstream_write (XLSTREAM (p->outstream), chunkbuf, | |
2034 chunklen); | |
2035 signal (SIGPIPE, old_sigpipe); | |
2036 if (writeret < 0) | |
2037 /* This is a real error. Blocking errors are handled | |
2038 specially inside of the filedesc stream. */ | |
2039 report_file_error ("writing to process", | |
2040 list1 (proc)); | |
2041 while (filedesc_stream_was_blocked (XLSTREAM (p->filedesc_stream))) | |
2042 { | |
2043 /* Buffer is full. Wait, accepting input; | |
2044 that may allow the program | |
2045 to finish doing output and read more. */ | |
2046 Faccept_process_output (Qnil, make_int (1), Qnil); | |
2047 old_sigpipe = | |
2048 (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); | |
2049 Lstream_flush (XLSTREAM (p->filedesc_stream)); | |
2050 signal (SIGPIPE, old_sigpipe); | |
2051 } | |
2052 } | |
2053 } | |
2054 else | |
2055 { /* We got here from a longjmp() from the SIGPIPE handler */ | |
2056 signal (SIGPIPE, old_sigpipe); | |
2057 p->status_symbol = Qexit; | |
2058 p->exit_code = 256; /* #### SIGPIPE ??? */ | |
2059 p->core_dumped = 0; | |
2060 p->tick++; | |
2061 process_tick++; | |
2062 deactivate_process (proc); | |
2063 error ("SIGPIPE raised on process %s; closed it", | |
2064 XSTRING_DATA (p->name)); | |
2065 } | |
2066 old_sigpipe = (SIGTYPE (*) (int)) signal (SIGPIPE, send_process_trap); | |
2067 Lstream_flush (XLSTREAM (p->outstream)); | |
2068 signal (SIGPIPE, old_sigpipe); | |
2069 UNGCPRO; | 987 UNGCPRO; |
2070 Lstream_delete (XLSTREAM (lstream)); | 988 Lstream_delete (XLSTREAM (lstream)); |
2071 } | 989 } |
2072 | 990 |
2073 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* | 991 DEFUN ("process-tty-name", Fprocess_tty_name, 1, 1, 0, /* |
2076 not the name of the pty that Emacs uses to talk with that terminal. | 994 not the name of the pty that Emacs uses to talk with that terminal. |
2077 */ | 995 */ |
2078 (proc)) | 996 (proc)) |
2079 { | 997 { |
2080 CHECK_PROCESS (proc); | 998 CHECK_PROCESS (proc); |
2081 return XPROCESS (proc)->tty_name; | 999 return MAYBE_LISP_PROCMETH (get_tty_name, (XPROCESS (proc))); |
2082 } | 1000 } |
2083 | 1001 |
2084 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* | 1002 DEFUN ("set-process-buffer", Fset_process_buffer, 2, 2, 0, /* |
2085 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). | 1003 Set buffer associated with PROCESS to BUFFER (a buffer, or nil). |
2086 */ | 1004 */ |
2204 Return PROCESS's input coding system. | 1122 Return PROCESS's input coding system. |
2205 */ | 1123 */ |
2206 (process)) | 1124 (process)) |
2207 { | 1125 { |
2208 process = get_process (process); | 1126 process = get_process (process); |
2209 return decoding_stream_coding_system (XLSTREAM ( XPROCESS (process)->instream) ); | 1127 return decoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_instream) ); |
2210 } | 1128 } |
2211 | 1129 |
2212 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* | 1130 DEFUN ("process-output-coding-system", Fprocess_output_coding_system, 1, 1, 0, /* |
2213 Return PROCESS's output coding system. | 1131 Return PROCESS's output coding system. |
2214 */ | 1132 */ |
2215 (process)) | 1133 (process)) |
2216 { | 1134 { |
2217 process = get_process (process); | 1135 process = get_process (process); |
2218 return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->outstream)); | 1136 return encoding_stream_coding_system (XLSTREAM (XPROCESS (process)->coding_outstream)); |
2219 } | 1137 } |
2220 | 1138 |
2221 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* | 1139 DEFUN ("process-coding-system", Fprocess_coding_system, 1, 1, 0, /* |
2222 Return a pair of coding-system for decoding and encoding of PROCESS. | 1140 Return a pair of coding-system for decoding and encoding of PROCESS. |
2223 */ | 1141 */ |
2224 (process)) | 1142 (process)) |
2225 { | 1143 { |
2226 process = get_process (process); | 1144 process = get_process (process); |
2227 return Fcons (decoding_stream_coding_system | 1145 return Fcons (decoding_stream_coding_system |
2228 (XLSTREAM (XPROCESS (process)->instream)), | 1146 (XLSTREAM (XPROCESS (process)->coding_instream)), |
2229 encoding_stream_coding_system | 1147 encoding_stream_coding_system |
2230 (XLSTREAM (XPROCESS (process)->outstream))); | 1148 (XLSTREAM (XPROCESS (process)->coding_outstream))); |
2231 } | 1149 } |
2232 | 1150 |
2233 DEFUN ("set-process-input-coding-system", | 1151 DEFUN ("set-process-input-coding-system", |
2234 Fset_process_input_coding_system, 2, 2, 0, /* | 1152 Fset_process_input_coding_system, 2, 2, 0, /* |
2235 Set PROCESS's input coding system to CODESYS. | 1153 Set PROCESS's input coding system to CODESYS. |
2236 */ | 1154 */ |
2237 (process, codesys)) | 1155 (process, codesys)) |
2238 { | 1156 { |
2239 codesys = Fget_coding_system (codesys); | 1157 codesys = Fget_coding_system (codesys); |
2240 process = get_process (process); | 1158 process = get_process (process); |
2241 set_decoding_stream_coding_system ( XLSTREAM ( XPROCESS (process)->instream ), codesys); | 1159 set_decoding_stream_coding_system ( XLSTREAM ( XPROCESS (process)->coding_instream ), codesys); |
2242 return Qnil; | 1160 return Qnil; |
2243 } | 1161 } |
2244 | 1162 |
2245 DEFUN ("set-process-output-coding-system", | 1163 DEFUN ("set-process-output-coding-system", |
2246 Fset_process_output_coding_system, 2, 2, 0, /* | 1164 Fset_process_output_coding_system, 2, 2, 0, /* |
2249 (process, codesys)) | 1167 (process, codesys)) |
2250 { | 1168 { |
2251 codesys = Fget_coding_system (codesys); | 1169 codesys = Fget_coding_system (codesys); |
2252 process = get_process (process); | 1170 process = get_process (process); |
2253 set_encoding_stream_coding_system | 1171 set_encoding_stream_coding_system |
2254 ( XLSTREAM ( XPROCESS (process)->outstream), codesys); | 1172 ( XLSTREAM ( XPROCESS (process)->coding_outstream), codesys); |
2255 return Qnil; | 1173 return Qnil; |
2256 } | 1174 } |
2257 | 1175 |
2258 DEFUN ("set-process-coding-system", | 1176 DEFUN ("set-process-coding-system", |
2259 Fset_process_coding_system, 1, 3, 0, /* | 1177 Fset_process_coding_system, 1, 3, 0, /* |
2268 Fset_process_output_coding_system(process, encoding); | 1186 Fset_process_output_coding_system(process, encoding); |
2269 } | 1187 } |
2270 return Qnil; | 1188 return Qnil; |
2271 } | 1189 } |
2272 | 1190 |
2273 #endif | 1191 #endif /* FILE_CODING */ |
2274 | |
2275 | 1192 |
2276 /************************************************************************/ | 1193 /************************************************************************/ |
2277 /* process status */ | 1194 /* process status */ |
2278 /************************************************************************/ | 1195 /************************************************************************/ |
2279 | |
2280 /* Some FSFmacs error handlers here. We handle this | |
2281 in call2_trapping_errors(). */ | |
2282 | 1196 |
2283 static Lisp_Object | 1197 static Lisp_Object |
2284 exec_sentinel_unwind (Lisp_Object datum) | 1198 exec_sentinel_unwind (Lisp_Object datum) |
2285 { | 1199 { |
2286 struct Lisp_Cons *d = XCONS (datum); | 1200 struct Lisp_Cons *d = XCONS (datum); |
2346 return (CONST char *) sys_siglist[signum]; | 1260 return (CONST char *) sys_siglist[signum]; |
2347 | 1261 |
2348 return (CONST char *) GETTEXT ("unknown signal"); | 1262 return (CONST char *) GETTEXT ("unknown signal"); |
2349 } | 1263 } |
2350 | 1264 |
2351 /* Compute the Lisp form of the process status from | |
2352 the numeric status that was returned by `wait'. */ | |
2353 | |
2354 static void | |
2355 update_status_from_wait_code (struct Lisp_Process *p, int *w_fmh) | |
2356 { | |
2357 /* C compiler lossage when attempting to pass w directly */ | |
2358 int w = *w_fmh; | |
2359 | |
2360 if (WIFSTOPPED (w)) | |
2361 { | |
2362 p->status_symbol = Qstop; | |
2363 p->exit_code = WSTOPSIG (w); | |
2364 p->core_dumped = 0; | |
2365 } | |
2366 else if (WIFEXITED (w)) | |
2367 { | |
2368 p->status_symbol = Qexit; | |
2369 p->exit_code = WEXITSTATUS (w); | |
2370 p->core_dumped = 0; | |
2371 } | |
2372 else if (WIFSIGNALED (w)) | |
2373 { | |
2374 p->status_symbol = Qsignal; | |
2375 p->exit_code = WTERMSIG (w); | |
2376 p->core_dumped = WCOREDUMP (w); | |
2377 } | |
2378 else | |
2379 { | |
2380 p->status_symbol = Qrun; | |
2381 p->exit_code = 0; | |
2382 } | |
2383 } | |
2384 | |
2385 void | 1265 void |
2386 update_process_status (Lisp_Object p, | 1266 update_process_status (Lisp_Object p, |
2387 Lisp_Object status_symbol, | 1267 Lisp_Object status_symbol, |
2388 int exit_code, | 1268 int exit_code, |
2389 int core_dumped) | 1269 int core_dumped) |
2392 process_tick++; | 1272 process_tick++; |
2393 XPROCESS (p)->status_symbol = status_symbol; | 1273 XPROCESS (p)->status_symbol = status_symbol; |
2394 XPROCESS (p)->exit_code = exit_code; | 1274 XPROCESS (p)->exit_code = exit_code; |
2395 XPROCESS (p)->core_dumped = core_dumped; | 1275 XPROCESS (p)->core_dumped = core_dumped; |
2396 } | 1276 } |
2397 | |
2398 #ifdef SIGCHLD | |
2399 | |
2400 #define MAX_EXITED_PROCESSES 1000 | |
2401 static volatile pid_t exited_processes[MAX_EXITED_PROCESSES]; | |
2402 static volatile int exited_processes_status[MAX_EXITED_PROCESSES]; | |
2403 static volatile int exited_processes_index; | |
2404 | |
2405 static volatile int sigchld_happened; | |
2406 | |
2407 /* For any processes that have changed status and are recorded | |
2408 and such, update the corresponding struct Lisp_Process. | |
2409 We separate this from record_exited_processes() so that | |
2410 we never have to call this function from within a signal | |
2411 handler. We block SIGCHLD in case record_exited_processes() | |
2412 is called from a signal handler. */ | |
2413 | |
2414 static void | |
2415 reap_exited_processes (void) | |
2416 { | |
2417 int i; | |
2418 struct Lisp_Process *p; | |
2419 | |
2420 if (exited_processes_index <= 0) | |
2421 { | |
2422 return; | |
2423 } | |
2424 | |
2425 #ifdef EMACS_BLOCK_SIGNAL | |
2426 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
2427 #endif | |
2428 for (i = 0; i < exited_processes_index; i++) | |
2429 { | |
2430 int pid = exited_processes[i]; | |
2431 int w = exited_processes_status[i]; | |
2432 | |
2433 /* Find the process that signaled us, and record its status. */ | |
2434 | |
2435 p = 0; | |
2436 { | |
2437 Lisp_Object tail; | |
2438 LIST_LOOP (tail, Vprocess_list) | |
2439 { | |
2440 Lisp_Object proc = XCAR (tail); | |
2441 p = XPROCESS (proc); | |
2442 if (INTP (p->pid) && XINT (p->pid) == pid) | |
2443 break; | |
2444 p = 0; | |
2445 } | |
2446 } | |
2447 | |
2448 if (p) | |
2449 { | |
2450 /* Change the status of the process that was found. */ | |
2451 p->tick++; | |
2452 process_tick++; | |
2453 update_status_from_wait_code (p, &w); | |
2454 | |
2455 /* If process has terminated, stop waiting for its output. */ | |
2456 if (WIFSIGNALED (w) || WIFEXITED (w)) | |
2457 { | |
2458 if (p->infd >= 0) | |
2459 { | |
2460 /* We can't just call event_stream->unselect_process_cb (p) | |
2461 here, because that calls XtRemoveInput, which is not | |
2462 necessarily reentrant, so we can't call this at interrupt | |
2463 level. | |
2464 */ | |
2465 } | |
2466 } | |
2467 } | |
2468 else | |
2469 { | |
2470 /* There was no asynchronous process found for that id. Check | |
2471 if we have a synchronous process. Only set sync process status | |
2472 if there is one, so we work OK with the waitpid() call in | |
2473 wait_for_termination(). */ | |
2474 if (synch_process_alive != 0) | |
2475 { /* Set the global sync process status variables. */ | |
2476 synch_process_alive = 0; | |
2477 | |
2478 /* Report the status of the synchronous process. */ | |
2479 if (WIFEXITED (w)) | |
2480 synch_process_retcode = WEXITSTATUS (w); | |
2481 else if (WIFSIGNALED (w)) | |
2482 synch_process_death = signal_name (WTERMSIG (w)); | |
2483 } | |
2484 } | |
2485 } | |
2486 | |
2487 exited_processes_index = 0; | |
2488 | |
2489 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
2490 } | |
2491 | |
2492 /* On receipt of a signal that a child status has changed, | |
2493 loop asking about children with changed statuses until | |
2494 the system says there are no more. All we do is record | |
2495 the processes and wait status. | |
2496 | |
2497 This function could be called from within the SIGCHLD | |
2498 handler, so it must be completely reentrant. When | |
2499 not called from a SIGCHLD handler, BLOCK_SIGCHLD should | |
2500 be non-zero so that SIGCHLD is blocked while this | |
2501 function is running. (This is necessary so avoid | |
2502 race conditions with the SIGCHLD_HAPPENED flag). */ | |
2503 | |
2504 static void | |
2505 record_exited_processes (int block_sigchld) | |
2506 { | |
2507 if (!sigchld_happened) | |
2508 { | |
2509 return; | |
2510 } | |
2511 | |
2512 #ifdef EMACS_BLOCK_SIGNAL | |
2513 if (block_sigchld) | |
2514 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
2515 #endif | |
2516 | |
2517 while (sigchld_happened) | |
2518 { | |
2519 int pid; | |
2520 int w; | |
2521 | |
2522 /* Keep trying to get a status until we get a definitive result. */ | |
2523 do | |
2524 { | |
2525 errno = 0; | |
2526 #ifdef WNOHANG | |
2527 # ifndef WUNTRACED | |
2528 # define WUNTRACED 0 | |
2529 # endif /* not WUNTRACED */ | |
2530 # ifdef HAVE_WAITPID | |
2531 pid = waitpid ((pid_t) -1, &w, WNOHANG | WUNTRACED); | |
2532 # else | |
2533 pid = wait3 (&w, WNOHANG | WUNTRACED, 0); | |
2534 # endif | |
2535 #else /* not WNOHANG */ | |
2536 pid = wait (&w); | |
2537 #endif /* not WNOHANG */ | |
2538 } | |
2539 while (pid <= 0 && errno == EINTR); | |
2540 | |
2541 if (pid <= 0) | |
2542 break; | |
2543 | |
2544 if (exited_processes_index < MAX_EXITED_PROCESSES) | |
2545 { | |
2546 exited_processes[exited_processes_index] = pid; | |
2547 exited_processes_status[exited_processes_index] = w; | |
2548 exited_processes_index++; | |
2549 } | |
2550 | |
2551 /* On systems with WNOHANG, we just ignore the number | |
2552 of times that SIGCHLD was signalled, and keep looping | |
2553 until there are no more processes to wait on. If we | |
2554 don't have WNOHANG, we have to rely on the count in | |
2555 SIGCHLD_HAPPENED. */ | |
2556 #ifndef WNOHANG | |
2557 sigchld_happened--; | |
2558 #endif /* not WNOHANG */ | |
2559 } | |
2560 | |
2561 sigchld_happened = 0; | |
2562 | |
2563 if (block_sigchld) | |
2564 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
2565 } | |
2566 | |
2567 /** USG WARNING: Although it is not obvious from the documentation | |
2568 in signal(2), on a USG system the SIGCLD handler MUST NOT call | |
2569 signal() before executing at least one wait(), otherwise the handler | |
2570 will be called again, resulting in an infinite loop. The relevant | |
2571 portion of the documentation reads "SIGCLD signals will be queued | |
2572 and the signal-catching function will be continually reentered until | |
2573 the queue is empty". Invoking signal() causes the kernel to reexamine | |
2574 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. | |
2575 | |
2576 (Note that now this only applies in SYS V Release 2 and before. | |
2577 On SYS V Release 3, we use sigset() to set the signal handler for | |
2578 the first time, and so we don't have to reestablish the signal handler | |
2579 in the handler below. On SYS V Release 4, we don't get this weirdo | |
2580 behavior when we use sigaction(), which we do use.) */ | |
2581 | |
2582 static SIGTYPE | |
2583 sigchld_handler (int signo) | |
2584 { | |
2585 #ifdef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR | |
2586 int old_errno = errno; | |
2587 | |
2588 sigchld_happened++; | |
2589 record_exited_processes (0); | |
2590 errno = old_errno; | |
2591 #else | |
2592 sigchld_happened++; | |
2593 #endif | |
2594 #ifdef HAVE_UNIXOID_EVENT_LOOP | |
2595 signal_fake_event (); | |
2596 #endif | |
2597 /* WARNING - must come after wait3() for USG systems */ | |
2598 EMACS_REESTABLISH_SIGNAL (signo, sigchld_handler); | |
2599 SIGRETURN; | |
2600 } | |
2601 | |
2602 #endif /* SIGCHLD */ | |
2603 | 1277 |
2604 /* Return a string describing a process status list. */ | 1278 /* Return a string describing a process status list. */ |
2605 | 1279 |
2606 static Lisp_Object | 1280 static Lisp_Object |
2607 status_message (struct Lisp_Process *p) | 1281 status_message (struct Lisp_Process *p) |
2647 kick_status_notify (void) | 1321 kick_status_notify (void) |
2648 { | 1322 { |
2649 process_tick++; | 1323 process_tick++; |
2650 } | 1324 } |
2651 | 1325 |
1326 | |
2652 /* Report all recent events of a change in process status | 1327 /* Report all recent events of a change in process status |
2653 (either run the sentinel or output a message). | 1328 (either run the sentinel or output a message). |
2654 This is done while Emacs is waiting for keyboard input. */ | 1329 This is done while Emacs is waiting for keyboard input. */ |
2655 | 1330 |
2656 void | 1331 void |
2669 update the process structures has been moved out of the | 1344 update the process structures has been moved out of the |
2670 SIGCHLD handler. But for the moment I'm leaving this | 1345 SIGCHLD handler. But for the moment I'm leaving this |
2671 stuff in -- it can't hurt.) */ | 1346 stuff in -- it can't hurt.) */ |
2672 int temp_process_tick; | 1347 int temp_process_tick; |
2673 | 1348 |
2674 #ifdef SIGCHLD | 1349 MAYBE_PROCMETH (reap_exited_processes, ()); |
2675 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR | |
2676 record_exited_processes (1); | |
2677 #endif | |
2678 reap_exited_processes (); | |
2679 #endif | |
2680 | 1350 |
2681 temp_process_tick = process_tick; | 1351 temp_process_tick = process_tick; |
2682 | 1352 |
2683 if (update_tick == temp_process_tick) | 1353 if (update_tick == temp_process_tick) |
2684 return; | 1354 return; |
2694 Lisp_Object proc = XCAR (tail); | 1364 Lisp_Object proc = XCAR (tail); |
2695 struct Lisp_Process *p = XPROCESS (proc); | 1365 struct Lisp_Process *p = XPROCESS (proc); |
2696 /* p->tick is also volatile. Same thing as above applies. */ | 1366 /* p->tick is also volatile. Same thing as above applies. */ |
2697 int this_process_tick; | 1367 int this_process_tick; |
2698 | 1368 |
2699 #ifdef HAVE_WAITPID | |
2700 /* #### extra check for terminated processes, in case a SIGCHLD | 1369 /* #### extra check for terminated processes, in case a SIGCHLD |
2701 got missed (this seems to happen sometimes, I'm not sure why). | 1370 got missed (this seems to happen sometimes, I'm not sure why). |
2702 */ | 1371 */ |
2703 { | 1372 if (INTP (p->pid)) |
2704 int w; | 1373 MAYBE_PROCMETH (update_status_if_terminated, (p)); |
2705 #ifdef SIGCHLD | 1374 |
2706 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
2707 #endif | |
2708 if (INTP (p->pid) && | |
2709 waitpid (XINT (p->pid), &w, WNOHANG) == XINT (p->pid)) | |
2710 { | |
2711 p->tick++; | |
2712 update_status_from_wait_code (p, &w); | |
2713 } | |
2714 #ifdef SIGCHLD | |
2715 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
2716 #endif | |
2717 } | |
2718 #endif | |
2719 this_process_tick = p->tick; | 1375 this_process_tick = p->tick; |
2720 if (this_process_tick != p->update_tick) | 1376 if (this_process_tick != p->update_tick) |
2721 { | 1377 { |
2722 p->update_tick = this_process_tick; | 1378 p->update_tick = this_process_tick; |
2723 | 1379 |
2849 CHECK_PROCESS (proc); | 1505 CHECK_PROCESS (proc); |
2850 return make_int (XPROCESS (proc)->exit_code); | 1506 return make_int (XPROCESS (proc)->exit_code); |
2851 } | 1507 } |
2852 | 1508 |
2853 | 1509 |
2854 #ifdef SIGNALS_VIA_CHARACTERS | 1510 |
2855 /* Get signal character to send to process if SIGNALS_VIA_CHARACTERS */ | |
2856 | |
2857 static int | |
2858 process_signal_char (int tty_fd, int signo) | |
2859 { | |
2860 /* If it's not a tty, pray that these default values work */ | |
2861 if (!isatty(tty_fd)) { | |
2862 #define CNTL(ch) (037 & (ch)) | |
2863 switch (signo) | |
2864 { | |
2865 case SIGINT: return CNTL('C'); | |
2866 case SIGQUIT: return CNTL('\\'); | |
2867 #ifdef SIGTSTP | |
2868 case SIGTSTP: return CNTL('Z'); | |
2869 #endif | |
2870 } | |
2871 } | |
2872 | |
2873 #ifdef HAVE_TERMIOS | |
2874 /* TERMIOS is the latest and bestest, and seems most likely to work. | |
2875 If the system has it, use it. */ | |
2876 { | |
2877 struct termios t; | |
2878 tcgetattr (tty_fd, &t); | |
2879 switch (signo) | |
2880 { | |
2881 case SIGINT: return t.c_cc[VINTR]; | |
2882 case SIGQUIT: return t.c_cc[VQUIT]; | |
2883 # if defined (VSWTCH) && !defined (PREFER_VSUSP) | |
2884 case SIGTSTP: return t.c_cc[VSWTCH]; | |
2885 # else | |
2886 case SIGTSTP: return t.c_cc[VSUSP]; | |
2887 # endif | |
2888 } | |
2889 } | |
2890 | |
2891 # elif defined (TIOCGLTC) && defined (TIOCGETC) /* not HAVE_TERMIOS */ | |
2892 { | |
2893 /* On Berkeley descendants, the following IOCTL's retrieve the | |
2894 current control characters. */ | |
2895 struct tchars c; | |
2896 struct ltchars lc; | |
2897 switch (signo) | |
2898 { | |
2899 case SIGINT: ioctl (tty_fd, TIOCGETC, &c); return c.t_intrc; | |
2900 case SIGQUIT: ioctl (tty_fd, TIOCGETC, &c); return c.t_quitc; | |
2901 # ifdef SIGTSTP | |
2902 case SIGTSTP: ioctl (tty_fd, TIOCGLTC, &lc); return lc.t_suspc; | |
2903 # endif /* SIGTSTP */ | |
2904 } | |
2905 } | |
2906 | |
2907 # elif defined (TCGETA) /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ | |
2908 { | |
2909 /* On SYSV descendants, the TCGETA ioctl retrieves the current | |
2910 control characters. */ | |
2911 struct termio t; | |
2912 ioctl (tty_fd, TCGETA, &t); | |
2913 switch (signo) { | |
2914 case SIGINT: return t.c_cc[VINTR]; | |
2915 case SIGQUIT: return t.c_cc[VQUIT]; | |
2916 # ifdef SIGTSTP | |
2917 case SIGTSTP: return t.c_cc[VSWTCH]; | |
2918 # endif /* SIGTSTP */ | |
2919 } | |
2920 } | |
2921 # else /* ! defined (TCGETA) */ | |
2922 #error ERROR! Using SIGNALS_VIA_CHARACTERS, but not HAVE_TERMIOS || (TIOCGLTC && TIOCGETC) || TCGETA | |
2923 /* If your system configuration files define SIGNALS_VIA_CHARACTERS, | |
2924 you'd better be using one of the alternatives above! */ | |
2925 # endif /* ! defined (TCGETA) */ | |
2926 return '\0'; | |
2927 } | |
2928 #endif /* SIGNALS_VIA_CHARACTERS */ | |
2929 | |
2930 | |
2931 /* send a signal number SIGNO to PROCESS. | 1511 /* send a signal number SIGNO to PROCESS. |
2932 CURRENT_GROUP means send to the process group that currently owns | 1512 CURRENT_GROUP means send to the process group that currently owns |
2933 the terminal being used to communicate with PROCESS. | 1513 the terminal being used to communicate with PROCESS. |
2934 This is used for various commands in shell mode. | 1514 This is used for various commands in shell mode. |
2935 If NOMSG is zero, insert signal-announcements into process's buffers | 1515 If NOMSG is zero, insert signal-announcements into process's buffers |
2938 If we can, we try to signal PROCESS by sending control characters | 1518 If we can, we try to signal PROCESS by sending control characters |
2939 down the pty. This allows us to signal inferiors who have changed | 1519 down the pty. This allows us to signal inferiors who have changed |
2940 their uid, for which killpg would return an EPERM error. */ | 1520 their uid, for which killpg would return an EPERM error. */ |
2941 | 1521 |
2942 static void | 1522 static void |
2943 process_send_signal (Lisp_Object process0, int signo, | 1523 process_send_signal (Lisp_Object process, int signo, |
2944 int current_group, int nomsg) | 1524 int current_group, int nomsg) |
2945 { | 1525 { |
2946 /* This function can GC */ | 1526 /* This function can GC */ |
2947 Lisp_Object proc = get_process (process0); | 1527 Lisp_Object proc = get_process (process); |
2948 struct Lisp_Process *p = XPROCESS (proc); | |
2949 int gid; | |
2950 int no_pgrp = 0; | |
2951 | 1528 |
2952 if (network_connection_p (proc)) | 1529 if (network_connection_p (proc)) |
2953 error ("Network connection %s is not a subprocess", | 1530 error ("Network connection %s is not a subprocess", |
2954 XSTRING_DATA (p->name)); | 1531 XSTRING_DATA (XPROCESS(proc)->name)); |
2955 if (p->infd < 0) | 1532 if (!PROCESS_LIVE_P (proc)) |
2956 error ("Process %s is not active", | 1533 error ("Process %s is not active", |
2957 XSTRING_DATA (p->name)); | 1534 XSTRING_DATA (XPROCESS(proc)->name)); |
2958 | 1535 |
2959 if (!p->pty_flag) | 1536 MAYBE_PROCMETH (kill_child_process, (proc, signo, current_group, nomsg)); |
2960 current_group = 0; | |
2961 | |
2962 /* If we are using pgrps, get a pgrp number and make it negative. */ | |
2963 if (current_group) | |
2964 { | |
2965 #ifdef SIGNALS_VIA_CHARACTERS | |
2966 /* If possible, send signals to the entire pgrp | |
2967 by sending an input character to it. */ | |
2968 { | |
2969 char sigchar = process_signal_char(p->subtty, signo); | |
2970 if (sigchar) { | |
2971 send_process (proc, Qnil, (Bufbyte *) &sigchar, 0, 1); | |
2972 return; | |
2973 } | |
2974 } | |
2975 #endif /* ! defined (SIGNALS_VIA_CHARACTERS) */ | |
2976 | |
2977 #ifdef TIOCGPGRP | |
2978 /* Get the pgrp using the tty itself, if we have that. | |
2979 Otherwise, use the pty to get the pgrp. | |
2980 On pfa systems, saka@pfu.fujitsu.co.JP writes: | |
2981 "TIOCGPGRP symbol defined in sys/ioctl.h at E50. | |
2982 But, TIOCGPGRP does not work on E50 ;-P works fine on E60" | |
2983 His patch indicates that if TIOCGPGRP returns an error, then | |
2984 we should just assume that p->pid is also the process group id. */ | |
2985 { | |
2986 int err; | |
2987 | |
2988 err = ioctl ( (p->subtty != -1 ? p->subtty : p->infd), TIOCGPGRP, &gid); | |
2989 | |
2990 #ifdef pfa | |
2991 if (err == -1) | |
2992 gid = - XINT (p->pid); | |
2993 #endif /* ! defined (pfa) */ | |
2994 } | |
2995 if (gid == -1) | |
2996 no_pgrp = 1; | |
2997 else | |
2998 gid = - gid; | |
2999 #else /* ! defined (TIOCGPGRP ) */ | |
3000 /* Can't select pgrps on this system, so we know that | |
3001 the child itself heads the pgrp. */ | |
3002 gid = - XINT (p->pid); | |
3003 #endif /* ! defined (TIOCGPGRP ) */ | |
3004 } | |
3005 else | |
3006 gid = - XINT (p->pid); | |
3007 | |
3008 switch (signo) | |
3009 { | |
3010 #ifdef SIGCONT | |
3011 case SIGCONT: | |
3012 p->status_symbol = Qrun; | |
3013 p->exit_code = 0; | |
3014 p->tick++; | |
3015 process_tick++; | |
3016 if (!nomsg) | |
3017 status_notify (); | |
3018 break; | |
3019 #endif /* ! defined (SIGCONT) */ | |
3020 case SIGINT: | |
3021 case SIGQUIT: | |
3022 case SIGKILL: | |
3023 flush_pending_output (p->infd); | |
3024 break; | |
3025 } | |
3026 | |
3027 /* If we don't have process groups, send the signal to the immediate | |
3028 subprocess. That isn't really right, but it's better than any | |
3029 obvious alternative. */ | |
3030 if (no_pgrp) | |
3031 { | |
3032 kill (XINT (p->pid), signo); | |
3033 return; | |
3034 } | |
3035 | |
3036 /* gid may be a pid, or minus a pgrp's number */ | |
3037 #ifdef TIOCSIGSEND | |
3038 if (current_group) | |
3039 ioctl (p->infd, TIOCSIGSEND, signo); | |
3040 else | |
3041 { | |
3042 gid = - XINT (p->pid); | |
3043 kill (gid, signo); | |
3044 } | |
3045 #else /* ! defined (TIOCSIGSEND) */ | |
3046 EMACS_KILLPG (-gid, signo); | |
3047 #endif /* ! defined (TIOCSIGSEND) */ | |
3048 } | 1537 } |
3049 | 1538 |
3050 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* | 1539 DEFUN ("interrupt-process", Finterrupt_process, 0, 2, 0, /* |
3051 Interrupt process PROCESS. May be process or name of one. | 1540 Interrupt process PROCESS. May be process or name of one. |
3052 Nil or no arg means current buffer's process. | 1541 Nil or no arg means current buffer's process. |
3068 See function `interrupt-process' for more details on usage. | 1557 See function `interrupt-process' for more details on usage. |
3069 */ | 1558 */ |
3070 (process, current_group)) | 1559 (process, current_group)) |
3071 { | 1560 { |
3072 /* This function can GC */ | 1561 /* This function can GC */ |
3073 process_send_signal (process, SIGKILL, !NILP (current_group), | 1562 process_send_signal (process, SIGKILL, !NILP (current_group), 0); |
3074 0); | |
3075 return process; | 1563 return process; |
3076 } | 1564 } |
3077 | 1565 |
3078 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* | 1566 DEFUN ("quit-process", Fquit_process, 0, 2, 0, /* |
3079 Send QUIT signal to process PROCESS. May be process or name of one. | 1567 Send QUIT signal to process PROCESS. May be process or name of one. |
3080 See function `interrupt-process' for more details on usage. | 1568 See function `interrupt-process' for more details on usage. |
3081 */ | 1569 */ |
3082 (process, current_group)) | 1570 (process, current_group)) |
3083 { | 1571 { |
3084 /* This function can GC */ | 1572 /* This function can GC */ |
3085 process_send_signal (process, SIGQUIT, !NILP (current_group), | 1573 process_send_signal (process, SIGQUIT, !NILP (current_group), 0); |
3086 0); | |
3087 return process; | 1574 return process; |
3088 } | 1575 } |
3089 | 1576 |
3090 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* | 1577 DEFUN ("stop-process", Fstop_process, 0, 2, 0, /* |
3091 Stop process PROCESS. May be process or name of one. | 1578 Stop process PROCESS. May be process or name of one. |
3092 See function `interrupt-process' for more details on usage. | 1579 See function `interrupt-process' for more details on usage. |
3093 */ | 1580 */ |
3094 (process, current_group)) | 1581 (process, current_group)) |
3095 { | 1582 { |
3096 /* This function can GC */ | 1583 /* This function can GC */ |
3097 #ifndef SIGTSTP | 1584 #ifdef SIGTSTP |
3098 error ("no SIGTSTP support"); | 1585 process_send_signal (process, SIGTSTP, !NILP (current_group), 0); |
3099 #else | 1586 #else |
3100 process_send_signal (process, SIGTSTP, !NILP (current_group), | 1587 error ("stop-process: Not supported on this system"); |
3101 0); | |
3102 #endif | 1588 #endif |
3103 return process; | 1589 return process; |
3104 } | 1590 } |
3105 | 1591 |
3106 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* | 1592 DEFUN ("continue-process", Fcontinue_process, 0, 2, 0, /* |
3109 */ | 1595 */ |
3110 (process, current_group)) | 1596 (process, current_group)) |
3111 { | 1597 { |
3112 /* This function can GC */ | 1598 /* This function can GC */ |
3113 #ifdef SIGCONT | 1599 #ifdef SIGCONT |
3114 process_send_signal (process, SIGCONT, !NILP (current_group), | 1600 process_send_signal (process, SIGCONT, !NILP (current_group), 0); |
3115 0); | |
3116 #else | 1601 #else |
3117 error ("no SIGCONT support"); | 1602 error ("continue-process: Not supported on this system"); |
3118 #endif | 1603 #endif |
3119 return process; | 1604 return process; |
3120 } | 1605 } |
3121 | 1606 |
3122 DEFUN ("signal-process", Fsignal_process, 2, 2, | 1607 DEFUN ("signal-process", Fsignal_process, 2, 2, |
3238 error ("Undefined signal name %s", name); | 1723 error ("Undefined signal name %s", name); |
3239 } | 1724 } |
3240 | 1725 |
3241 #undef handle_signal | 1726 #undef handle_signal |
3242 | 1727 |
3243 return make_int (kill (XINT (pid), XINT (sigcode))); | 1728 return make_int (PROCMETH_OR_GIVEN (kill_process_by_pid, |
1729 (XINT (pid), XINT (sigcode)), -1)); | |
3244 } | 1730 } |
3245 | 1731 |
3246 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* | 1732 DEFUN ("process-send-eof", Fprocess_send_eof, 0, 1, 0, /* |
3247 Make PROCESS see end-of-file in its input. | 1733 Make PROCESS see end-of-file in its input. |
3248 PROCESS may be a process, a buffer, the name of a process or buffer, or | 1734 PROCESS may be a process, a buffer, the name of a process or buffer, or |
3260 | 1746 |
3261 /* Make sure the process is really alive. */ | 1747 /* Make sure the process is really alive. */ |
3262 if (! EQ (XPROCESS (proc)->status_symbol, Qrun)) | 1748 if (! EQ (XPROCESS (proc)->status_symbol, Qrun)) |
3263 error ("Process %s not running", XSTRING_DATA (XPROCESS (proc)->name)); | 1749 error ("Process %s not running", XSTRING_DATA (XPROCESS (proc)->name)); |
3264 | 1750 |
3265 if (XPROCESS (proc)->pty_flag) | 1751 if (!MAYBE_INT_PROCMETH (process_send_eof, (proc))) |
3266 { | 1752 { |
3267 /* #### get_eof_char simply doesn't return the correct character | 1753 event_stream_delete_stream_pair (Qnil, XPROCESS (proc)->pipe_outstream); |
3268 here. Maybe it is needed to determine the right eof | 1754 XPROCESS (proc)->pipe_outstream = Qnil; |
3269 character in init_process_fds but here it simply screws | 1755 #ifdef FILE_CODING |
3270 things up. */ | 1756 XPROCESS (proc)->coding_outstream = Qnil; |
3271 #if 0 | 1757 #endif |
3272 Bufbyte eof_char = get_eof_char (XPROCESS (proc)); | |
3273 send_process (proc, Qnil, &eof_char, 0, 1); | |
3274 #else | |
3275 send_process (proc, Qnil, (CONST Bufbyte *) "\004", 0, 1); | |
3276 #endif | |
3277 } | |
3278 else | |
3279 { | |
3280 close (XPROCESS (proc)->outfd); | |
3281 XPROCESS (proc)->outfd = open (NULL_DEVICE, O_WRONLY | OPEN_BINARY, 0); | |
3282 } | 1758 } |
3283 | 1759 |
3284 return process; | 1760 return process; |
3285 } | 1761 } |
3286 | 1762 |
3290 /************************************************************************/ | 1766 /************************************************************************/ |
3291 | 1767 |
3292 void | 1768 void |
3293 deactivate_process (Lisp_Object proc) | 1769 deactivate_process (Lisp_Object proc) |
3294 { | 1770 { |
3295 int inchannel, outchannel; | |
3296 struct Lisp_Process *p = XPROCESS (proc); | 1771 struct Lisp_Process *p = XPROCESS (proc); |
3297 SIGTYPE (*old_sigpipe) (int) = 0; | 1772 USID usid; |
3298 | 1773 |
3299 inchannel = p->infd; | 1774 /* It's possible that we got as far in the process-creation |
3300 outchannel = p->outfd; | 1775 process as creating the descriptors but didn't get so |
3301 | 1776 far as selecting the process for input. In this |
3302 /* closing the outstream could result in SIGPIPE, so ignore it. */ | 1777 case, p->pid is nil: p->pid is set at the same time that |
3303 old_sigpipe = | 1778 the process is selected for input. */ |
3304 (SIGTYPE (*) (int)) signal (SIGPIPE, SIG_IGN); | 1779 /* #### The comment does not look correct. event_stream_unselect_process |
3305 if (!NILP (p->instream)) | 1780 is guarded by process->selected, so this is not a problem. - kkm*/ |
3306 Lstream_close (XLSTREAM (p->instream)); | 1781 /* Must call this before setting the streams to nil */ |
3307 if (!NILP (p->outstream)) | 1782 event_stream_unselect_process (p); |
3308 Lstream_close (XLSTREAM (p->outstream)); | 1783 |
3309 signal (SIGPIPE, old_sigpipe); | 1784 /* Provide minimal implementation for deactivate_process |
3310 | 1785 if there's no process-specific one */ |
3311 if (inchannel >= 0) | 1786 if (HAS_PROCMETH_P (deactivate_process)) |
3312 { | 1787 usid = PROCMETH (deactivate_process, (p)); |
3313 /* Beware SIGCHLD hereabouts. */ | 1788 else |
3314 flush_pending_output (inchannel); | 1789 usid = event_stream_delete_stream_pair (p->pipe_instream, |
3315 close_descriptor_pair (inchannel, outchannel); | 1790 p->pipe_outstream); |
3316 if (!NILP (p->pid)) | 1791 |
3317 { | 1792 if (usid != USID_DONTHASH) |
3318 /* It's possible that we got as far in the process-creation | 1793 remhash ((CONST void*)usid, usid_to_process); |
3319 process as creating the descriptors but didn't get so | 1794 |
3320 far as selecting the process for input. In this | 1795 p->pipe_instream = Qnil; |
3321 case, p->pid is nil: p->pid is set at the same time that | 1796 p->pipe_outstream = Qnil; |
3322 the process is selected for input. */ | 1797 #ifdef FILE_CODING |
3323 /* Must call this before setting the file descriptors to 0 */ | 1798 p->coding_instream = Qnil; |
3324 event_stream_unselect_process (p); | 1799 p->coding_outstream = Qnil; |
3325 } | 1800 #endif |
3326 | |
3327 p->infd = -1; | |
3328 p->outfd = -1; | |
3329 descriptor_to_process[inchannel] = Qnil; | |
3330 } | |
3331 } | 1801 } |
3332 | 1802 |
3333 static void | 1803 static void |
3334 remove_process (Lisp_Object proc) | 1804 remove_process (Lisp_Object proc) |
3335 { | 1805 { |
3355 p->exit_code = 0; | 1825 p->exit_code = 0; |
3356 p->core_dumped = 0; | 1826 p->core_dumped = 0; |
3357 p->tick++; | 1827 p->tick++; |
3358 process_tick++; | 1828 process_tick++; |
3359 } | 1829 } |
3360 else if (p->infd >= 0) | 1830 else if (!NILP(p->pipe_instream)) |
3361 { | 1831 { |
3362 Fkill_process (proc, Qnil); | 1832 Fkill_process (proc, Qnil); |
3363 /* Do this now, since remove_process will make sigchld_handler do nothing. */ | 1833 /* Do this now, since remove_process will make sigchld_handler do nothing. */ |
3364 p->status_symbol = Qsignal; | 1834 p->status_symbol = Qsignal; |
3365 p->exit_code = SIGKILL; | 1835 p->exit_code = SIGKILL; |
3387 if (GC_PROCESSP (proc) | 1857 if (GC_PROCESSP (proc) |
3388 && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer))) | 1858 && (GC_NILP (buffer) || GC_EQ (XPROCESS (proc)->buffer, buffer))) |
3389 { | 1859 { |
3390 if (network_connection_p (proc)) | 1860 if (network_connection_p (proc)) |
3391 Fdelete_process (proc); | 1861 Fdelete_process (proc); |
3392 else if (XPROCESS (proc)->infd >= 0) | 1862 else if (!NILP (XPROCESS (proc)->pipe_instream)) |
3393 process_send_signal (proc, SIGHUP, 0, 1); | 1863 process_send_signal (proc, SIGHUP, 0, 1); |
3394 } | 1864 } |
3395 } | 1865 } |
3396 } | 1866 } |
3397 | |
3398 #if 0 /* Unused */ | |
3399 int | |
3400 count_active_processes (void) | |
3401 { | |
3402 Lisp_Object tail; | |
3403 int count = 0; | |
3404 | |
3405 for (tail = Vprocess_list; CONSP (tail); tail = XCDR (tail)) | |
3406 { | |
3407 Lisp_Object status = XPROCESS (XCAR (tail))->status_symbol; | |
3408 if ((EQ (status, Qrun) || EQ (status, Qstop))) | |
3409 count++; | |
3410 } | |
3411 | |
3412 return count; | |
3413 } | |
3414 #endif /* Unused */ | |
3415 | 1867 |
3416 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* | 1868 DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 1, 2, 0, /* |
3417 Say no query needed if PROCESS is running when Emacs is exited. | 1869 Say no query needed if PROCESS is running when Emacs is exited. |
3418 Optional second argument if non-nil says to require a query. | 1870 Optional second argument if non-nil says to require a query. |
3419 Value is t if a query was formerly required. | 1871 Value is t if a query was formerly required. |
3441 | 1893 |
3442 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ | 1894 /* This is not named init_process in order to avoid a conflict with NS 3.3 */ |
3443 void | 1895 void |
3444 init_xemacs_process (void) | 1896 init_xemacs_process (void) |
3445 { | 1897 { |
3446 int i; | 1898 MAYBE_PROCMETH (init_process, ()); |
3447 | |
3448 #ifdef SIGCHLD | |
3449 # ifndef CANNOT_DUMP | |
3450 if (! noninteractive || initialized) | |
3451 # endif | |
3452 signal (SIGCHLD, sigchld_handler); | |
3453 #endif /* SIGCHLD */ | |
3454 | 1899 |
3455 Vprocess_list = Qnil; | 1900 Vprocess_list = Qnil; |
3456 for (i = 0; i < MAXDESC; i++) | 1901 usid_to_process = make_hashtable (32); |
3457 { | |
3458 descriptor_to_process[i] = Qnil; | |
3459 #if 0 /* FSFmacs */ | |
3460 proc_buffered_char[i] = -1; | |
3461 #endif | |
3462 } | |
3463 } | 1902 } |
3464 | 1903 |
3465 #if 0 | 1904 #if 0 |
3466 | 1905 |
3467 xxDEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* | 1906 xxDEFUN ("process-connection", Fprocess_connection, 0, 1, 0, /* |
3485 /* Qexit is already defined by syms_of_eval | 1924 /* Qexit is already defined by syms_of_eval |
3486 * defsymbol (&Qexit, "exit"); | 1925 * defsymbol (&Qexit, "exit"); |
3487 */ | 1926 */ |
3488 defsymbol (&Qopen, "open"); | 1927 defsymbol (&Qopen, "open"); |
3489 defsymbol (&Qclosed, "closed"); | 1928 defsymbol (&Qclosed, "closed"); |
1929 | |
1930 defsymbol (&Qtcpip, "tcp/ip"); | |
3490 | 1931 |
3491 #ifdef HAVE_MULTICAST | 1932 #ifdef HAVE_MULTICAST |
3492 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ | 1933 defsymbol(&Qmulticast, "multicast"); /* Used for occasional warnings */ |
3493 #endif | 1934 #endif |
3494 | 1935 |
3535 DEFSUBR (Fprocess_output_coding_system); | 1976 DEFSUBR (Fprocess_output_coding_system); |
3536 DEFSUBR (Fset_process_input_coding_system); | 1977 DEFSUBR (Fset_process_input_coding_system); |
3537 DEFSUBR (Fset_process_output_coding_system); | 1978 DEFSUBR (Fset_process_output_coding_system); |
3538 DEFSUBR (Fprocess_coding_system); | 1979 DEFSUBR (Fprocess_coding_system); |
3539 DEFSUBR (Fset_process_coding_system); | 1980 DEFSUBR (Fset_process_coding_system); |
3540 #endif | 1981 #endif /* FILE_CODING */ |
3541 } | 1982 } |
3542 | 1983 |
3543 void | 1984 void |
3544 vars_of_process (void) | 1985 vars_of_process (void) |
3545 { | 1986 { |