Mercurial > hg > xemacs-beta
annotate src/process-unix.c @ 4903:70089046adef
fix compile problems in intl-encap* under VS6
-------------------- ChangeLog entries follow: --------------------
lib-src/ChangeLog addition:
2010-01-30 Ben Wing <ben@xemacs.org>
* make-mswin-unicode.pl:
Make it possible to specify an overridden prototype in cases where
either Cygwin or Visual Studio has errors in their headers that
can be corrected by falling back to a less qualified type (typically
without const).
src/ChangeLog addition:
2010-01-30 Ben Wing <ben@xemacs.org>
* intl-auto-encap-win32.c:
* intl-auto-encap-win32.c (qxeExtractAssociatedIcon):
* intl-auto-encap-win32.c (qxeExtractIconEx):
* intl-auto-encap-win32.c (qxeCreateMDIWindow):
* intl-auto-encap-win32.c (qxeCreateWindowStation):
* intl-auto-encap-win32.c (qxeDdeCreateStringHandle):
* intl-auto-encap-win32.c (qxeAbortSystemShutdown):
* intl-auto-encap-win32.c (qxeRegConnectRegistry):
* intl-auto-encap-win32.c (qxeGetICMProfile):
* intl-auto-encap-win32.h:
Rebuild.
* intl-encap-win32.c:
* intl-encap-win32.c (qxeUpdateICMRegKey):
Delete manual definitions of functions with former errors in
Cygwin headers but no longer. Use "override" with some functions
where Cygwin or VS6 accidentally omits a const declaration or
includes an extra one. Use "no" on SendMessageTimeout, which
has an error in the VS6 prototype (you could manually fix this
with an ifdef to split the Cygwin vs. VS6 calls, if we ever
actually used this function).
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 30 Jan 2010 20:34:23 -0600 |
parents | b3ea9c582280 |
children | 19a72041c5ed |
rev | line source |
---|---|
428 | 1 /* Asynchronous subprocess implementation for UNIX |
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 | |
3 Free Software Foundation, Inc. | |
4 Copyright (C) 1995 Sun Microsystems, Inc. | |
1330 | 5 Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. |
428 | 6 |
7 This file is part of XEmacs. | |
8 | |
9 XEmacs is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
11 Free Software Foundation; either version 2, or (at your option) any | |
12 later version. | |
13 | |
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
20 along with XEmacs; see the file COPYING. If not, write to | |
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 Boston, MA 02111-1307, USA. */ | |
23 | |
771 | 24 /* Mule-ized as of 6-14-00 */ |
428 | 25 |
26 /* This file has been split into process.c and process-unix.c by | |
27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not | |
28 the original author(s) */ | |
29 | |
440 | 30 /* The IPv6 support is derived from the code for GNU Emacs-20.3 |
31 written by Wolfgang S. Rupprecht */ | |
32 | |
428 | 33 #include <config.h> |
34 | |
35 #include "lisp.h" | |
36 | |
37 #include "buffer.h" | |
38 #include "events.h" | |
39 #include "frame.h" | |
40 #include "hash.h" | |
41 #include "lstream.h" | |
42 #include "opaque.h" | |
43 #include "process.h" | |
44 #include "procimpl.h" | |
45 #include "sysdep.h" | |
46 #include "window.h" | |
47 #include "file-coding.h" | |
48 | |
49 #include <setjmp.h> | |
853 | 50 #include "sysdir.h" |
428 | 51 #include "sysfile.h" |
52 #include "sysproc.h" | |
859 | 53 #include "syssignal.h" |
428 | 54 #include "systime.h" |
55 #include "systty.h" | |
56 #include "syswait.h" | |
57 | |
442 | 58 #ifdef HPUX |
59 #include <grp.h> /* See grantpt fixups for HPUX below. */ | |
60 #endif | |
428 | 61 |
502 | 62 #if defined (HAVE_GETADDRINFO) && defined (HAVE_GETNAMEINFO) |
63 #define USE_GETADDRINFO | |
64 #endif | |
65 | |
66 | |
428 | 67 /* |
68 * Implementation-specific data. Pointed to by Lisp_Process->process_data | |
69 */ | |
70 | |
71 struct unix_process_data | |
72 { | |
73 /* Non-0 if this is really a ToolTalk channel. */ | |
74 int connected_via_filedesc_p; | |
75 /* Descriptor by which we read from this process. -1 for dead process */ | |
76 int infd; | |
853 | 77 /* Descriptor by which we read stderr from this process. -1 for |
78 dead process */ | |
79 int errfd; | |
428 | 80 /* Descriptor for the tty which this process is using. |
81 -1 if we didn't record it (on some systems, there's no need). */ | |
82 int subtty; | |
83 /* Non-false if communicating through a pty. */ | |
84 char pty_flag; | |
85 }; | |
853 | 86 #define UNIX_DATA(p) ((struct unix_process_data*) ((p)->process_data)) |
428 | 87 |
88 | |
89 | |
90 /**********************************************************************/ | |
91 /* Static helper routines */ | |
92 /**********************************************************************/ | |
93 | |
94 static SIGTYPE | |
2286 | 95 close_safely_handler (int SIG_ARG_MAYBE_UNUSED (signo)) |
428 | 96 { |
97 EMACS_REESTABLISH_SIGNAL (signo, close_safely_handler); | |
98 SIGRETURN; | |
99 } | |
100 | |
101 static void | |
102 close_safely (int fd) | |
103 { | |
104 stop_interrupts (); | |
613 | 105 set_timeout_signal (SIGALRM, close_safely_handler); |
428 | 106 alarm (1); |
771 | 107 retry_close (fd); |
428 | 108 alarm (0); |
109 start_interrupts (); | |
110 } | |
111 | |
112 static void | |
113 close_descriptor_pair (int in, int out) | |
114 { | |
115 if (in >= 0) | |
771 | 116 retry_close (in); |
428 | 117 if (out != in && out >= 0) |
771 | 118 retry_close (out); |
428 | 119 } |
120 | |
121 /* Close all descriptors currently in use for communication | |
122 with subprocess. This is used in a newly-forked subprocess | |
123 to get rid of irrelevant descriptors. */ | |
124 | |
125 static int | |
2286 | 126 close_process_descs_mapfun (const void *UNUSED (key), void *contents, |
127 void *UNUSED (arg)) | |
428 | 128 { |
853 | 129 Lisp_Object proc = VOID_TO_LISP (contents); |
130 USID vaffan, culo; | |
131 | |
132 event_stream_delete_io_streams (XPROCESS (proc)->pipe_instream, | |
133 XPROCESS (proc)->pipe_outstream, | |
134 XPROCESS (proc)->pipe_errstream, | |
135 &vaffan, &culo); | |
428 | 136 return 0; |
137 } | |
138 | |
139 void | |
140 close_process_descs (void) | |
141 { | |
142 maphash (close_process_descs_mapfun, usid_to_process, 0); | |
143 } | |
144 | |
145 /* connect to an existing file descriptor. This is very similar to | |
146 open-network-stream except that it assumes that the connection has | |
147 already been initialized. It is currently used for ToolTalk | |
148 communication. */ | |
149 | |
150 /* This function used to be visible on the Lisp level, but there is no | |
151 real point in doing that. Here is the doc string: | |
152 | |
442 | 153 "Connect to an existing file descriptor. |
154 Return a subprocess-object to represent the connection. | |
155 Input and output work as for subprocesses; `delete-process' closes it. | |
156 Args are NAME BUFFER INFD OUTFD. | |
157 NAME is name for process. It is modified if necessary to make it unique. | |
158 BUFFER is the buffer (or buffer-name) to associate with the process. | |
159 Process output goes at end of that buffer, unless you specify | |
160 an output stream or filter function to handle the output. | |
161 BUFFER may also be nil, meaning that this process is not associated | |
162 with any buffer. | |
163 INFD and OUTFD specify the file descriptors to use for input and | |
428 | 164 output, respectively." |
165 */ | |
166 | |
167 Lisp_Object | |
168 connect_to_file_descriptor (Lisp_Object name, Lisp_Object buffer, | |
169 Lisp_Object infd, Lisp_Object outfd) | |
170 { | |
171 /* This function can GC */ | |
172 Lisp_Object proc; | |
4123 | 173 EMACS_INT inch; |
428 | 174 |
175 CHECK_STRING (name); | |
176 CHECK_INT (infd); | |
177 CHECK_INT (outfd); | |
178 | |
179 inch = XINT (infd); | |
442 | 180 if (get_process_from_usid (FD_TO_USID (inch))) |
181 invalid_operation ("There is already a process connected to fd", infd); | |
428 | 182 if (!NILP (buffer)) |
183 buffer = Fget_buffer_create (buffer); | |
184 proc = make_process_internal (name); | |
185 | |
186 XPROCESS (proc)->pid = Fcons (infd, name); | |
187 XPROCESS (proc)->buffer = buffer; | |
853 | 188 init_process_io_handles (XPROCESS (proc), (void *) inch, |
189 (void *) XINT (outfd), (void *) -1, 0); | |
428 | 190 UNIX_DATA (XPROCESS (proc))->connected_via_filedesc_p = 1; |
191 | |
853 | 192 event_stream_select_process (XPROCESS (proc), 1, 1); |
428 | 193 |
194 return proc; | |
195 } | |
196 | |
442 | 197 static int allocate_pty_the_old_fashioned_way (void); |
198 | |
199 /* The file name of the (slave) pty opened by allocate_pty(). */ | |
200 #ifndef MAX_PTYNAME_LEN | |
201 #define MAX_PTYNAME_LEN 64 | |
202 #endif | |
867 | 203 static Ibyte pty_name[MAX_PTYNAME_LEN]; |
428 | 204 |
205 /* Open an available pty, returning a file descriptor. | |
206 Return -1 on failure. | |
207 The file name of the terminal corresponding to the pty | |
442 | 208 is left in the variable `pty_name'. */ |
428 | 209 |
210 static int | |
211 allocate_pty (void) | |
212 { | |
442 | 213 /* Unix98 standardized grantpt, unlockpt, and ptsname, but not the |
214 functions required to open a master pty in the first place :-( | |
215 | |
216 Modern Unix systems all seems to have convenience methods to open | |
217 a master pty fd in one function call, but there is little | |
218 agreement on how to do it. | |
219 | |
220 allocate_pty() tries all the different known easy ways of opening | |
221 a pty. In case of failure, we resort to the old BSD-style pty | |
222 grovelling code in allocate_pty_the_old_fashioned_way(). */ | |
223 int master_fd = -1; | |
771 | 224 const Extbyte *slave_name = NULL; |
867 | 225 const CIbyte *clone = NULL; |
226 static const CIbyte * const clones[] = | |
771 | 227 /* Different pty master clone devices */ |
442 | 228 { |
229 "/dev/ptmx", /* Various systems */ | |
230 "/dev/ptm/clone", /* HPUX */ | |
231 "/dev/ptc", /* AIX */ | |
232 "/dev/ptmx_bsd" /* Tru64 */ | |
233 }; | |
234 | |
235 #ifdef HAVE_GETPT /* glibc */ | |
236 master_fd = getpt (); | |
237 if (master_fd >= 0) | |
238 goto have_master; | |
239 #endif /* HAVE_GETPT */ | |
240 | |
241 | |
242 #if defined(HAVE_OPENPTY) /* BSD, Tru64, glibc */ | |
243 { | |
244 int slave_fd = -1; | |
245 int rc; | |
246 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
247 rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL); | |
248 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
249 if (rc == 0) | |
250 { | |
251 slave_name = ttyname (slave_fd); | |
771 | 252 retry_close (slave_fd); |
442 | 253 goto have_slave_name; |
254 } | |
255 else | |
256 { | |
257 if (master_fd >= 0) | |
771 | 258 retry_close (master_fd); |
442 | 259 if (slave_fd >= 0) |
771 | 260 retry_close (slave_fd); |
442 | 261 } |
262 } | |
263 #endif /* HAVE_OPENPTY */ | |
264 | |
265 #if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */ | |
266 master_fd = -1; | |
267 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
268 slave_name = _getpty (&master_fd, O_RDWR | O_NDELAY, 0600, 0); | |
269 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
270 if (master_fd >= 0 && slave_name != NULL) | |
271 goto have_slave_name; | |
272 #endif /* HAVE__GETPTY */ | |
273 | |
274 /* Master clone devices are available on most systems */ | |
275 { | |
276 int i; | |
277 for (i = 0; i < countof (clones); i++) | |
278 { | |
279 clone = clones[i]; | |
867 | 280 master_fd = qxe_open ((Ibyte *) clone, |
771 | 281 O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); |
442 | 282 if (master_fd >= 0) |
283 goto have_master; | |
284 } | |
285 clone = NULL; | |
286 } | |
287 | |
288 goto lose; | |
289 | |
290 have_master: | |
291 | |
292 #if defined (HAVE_PTSNAME) | |
293 slave_name = ptsname (master_fd); | |
294 if (slave_name) | |
295 goto have_slave_name; | |
296 #endif | |
297 | |
298 /* AIX docs say to use ttyname, not ptsname, to get slave_name */ | |
299 if (clone | |
300 && !strcmp (clone, "/dev/ptc") | |
301 && (slave_name = ttyname (master_fd)) != NULL) | |
302 goto have_slave_name; | |
303 | |
304 goto lose; | |
305 | |
306 have_slave_name: | |
771 | 307 { |
867 | 308 Ibyte *slaveint; |
771 | 309 |
310 EXTERNAL_TO_C_STRING (slave_name, slaveint, Qfile_name); | |
311 qxestrncpy (pty_name, slaveint, sizeof (pty_name)); | |
312 } | |
313 | |
442 | 314 pty_name[sizeof (pty_name) - 1] = '\0'; |
315 setup_pty (master_fd); | |
316 | |
317 /* We jump through some hoops to frob the pty. | |
318 It's not obvious that checking the return code here is useful. */ | |
319 | |
320 /* "The grantpt() function will fail if it is unable to successfully | |
321 invoke the setuid root program. It may also fail if the | |
322 application has installed a signal handler to catch SIGCHLD | |
323 signals." */ | |
324 #if defined (HAVE_GRANTPT) || defined (HAVE_UNLOCKPT) | |
325 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
326 | |
327 #if defined (HAVE_GRANTPT) | |
328 grantpt (master_fd); | |
329 #ifdef HPUX | |
330 /* grantpt() behavior on some versions of HP-UX differs from what's | |
331 specified in the man page: the group of the slave PTY is set to | |
332 the user's primary group, and we fix that. */ | |
333 { | |
334 struct group *tty_group = getgrnam ("tty"); | |
335 if (tty_group != NULL) | |
771 | 336 { |
337 Extbyte *ptyout; | |
338 | |
339 C_STRING_TO_EXTERNAL (pty_name, ptyout, Qfile_name); | |
340 chown (ptyout, (uid_t) -1, tty_group->gr_gid); | |
341 } | |
442 | 342 } |
343 #endif /* HPUX has broken grantpt() */ | |
344 #endif /* HAVE_GRANTPT */ | |
345 | |
346 #if defined (HAVE_UNLOCKPT) | |
347 unlockpt (master_fd); | |
348 #endif | |
349 | |
350 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
351 #endif /* HAVE_GRANTPT || HAVE_UNLOCKPT */ | |
352 | |
353 return master_fd; | |
354 | |
355 lose: | |
356 if (master_fd >= 0) | |
771 | 357 retry_close (master_fd); |
442 | 358 return allocate_pty_the_old_fashioned_way (); |
359 } | |
360 | |
361 /* This function tries to allocate a pty by iterating through file | |
362 pairs with names like /dev/ptyp1 and /dev/ttyp1. */ | |
363 static int | |
364 allocate_pty_the_old_fashioned_way (void) | |
365 { | |
428 | 366 struct stat stb; |
367 | |
368 /* Some systems name their pseudoterminals so that there are gaps in | |
369 the usual sequence - for example, on HP9000/S700 systems, there | |
370 are no pseudoterminals with names ending in 'f'. So we wait for | |
371 three failures in a row before deciding that we've reached the | |
372 end of the ptys. */ | |
373 int failed_count = 0; | |
374 int fd; | |
375 int i; | |
376 int c; | |
377 | |
378 #ifdef PTY_ITERATION | |
379 PTY_ITERATION | |
380 #else | |
442 | 381 # ifndef FIRST_PTY_LETTER |
382 # define FIRST_PTY_LETTER 'p' | |
383 # endif | |
428 | 384 for (c = FIRST_PTY_LETTER; c <= 'z'; c++) |
385 for (i = 0; i < 16; i++) | |
442 | 386 #endif /* PTY_ITERATION */ |
387 | |
428 | 388 { |
389 #ifdef PTY_NAME_SPRINTF | |
390 PTY_NAME_SPRINTF | |
391 #else | |
771 | 392 qxesprintf (pty_name, "/dev/pty%c%x", c, i); |
428 | 393 #endif /* no PTY_NAME_SPRINTF */ |
394 | |
771 | 395 if (qxe_stat (pty_name, &stb) < 0) |
428 | 396 { |
442 | 397 if (++failed_count >= 3) |
428 | 398 return -1; |
399 } | |
400 else | |
401 failed_count = 0; | |
771 | 402 fd = qxe_open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); |
428 | 403 |
404 if (fd >= 0) | |
405 { | |
406 #ifdef PTY_TTY_NAME_SPRINTF | |
407 PTY_TTY_NAME_SPRINTF | |
408 #else | |
771 | 409 qxesprintf (pty_name, "/dev/tty%c%x", c, i); |
428 | 410 #endif /* no PTY_TTY_NAME_SPRINTF */ |
771 | 411 if (qxe_access (pty_name, R_OK | W_OK) == 0) |
428 | 412 { |
442 | 413 setup_pty (fd); |
414 return fd; | |
428 | 415 } |
771 | 416 retry_close (fd); |
428 | 417 } |
442 | 418 } /* iteration */ |
428 | 419 return -1; |
420 } | |
421 | |
422 static int | |
4123 | 423 create_bidirectional_pipe (EMACS_INT *inchannel, EMACS_INT *outchannel, |
424 volatile EMACS_INT *forkin, volatile EMACS_INT *forkout) | |
428 | 425 { |
426 int sv[2]; | |
427 | |
4759
aa5ed11f473b
Remove support for obsolete systems. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
4123
diff
changeset
|
428 if (pipe (sv) < 0) return -1; |
428 | 429 *inchannel = sv[0]; |
430 *forkout = sv[1]; | |
4759
aa5ed11f473b
Remove support for obsolete systems. See xemacs-patches message with ID
Jerry James <james@xemacs.org>
parents:
4123
diff
changeset
|
431 if (pipe (sv) < 0) return -1; |
428 | 432 *outchannel = sv[1]; |
433 *forkin = sv[0]; | |
434 return 0; | |
435 } | |
436 | |
437 | |
438 #ifdef HAVE_SOCKETS | |
439 | |
502 | 440 #ifndef USE_GETADDRINFO |
428 | 441 static int |
442 get_internet_address (Lisp_Object host, struct sockaddr_in *address, | |
578 | 443 Error_Behavior errb) |
428 | 444 { |
445 struct hostent *host_info_ptr = NULL; | |
446 #ifdef TRY_AGAIN | |
447 int count = 0; | |
448 #endif | |
449 | |
450 xzero (*address); | |
451 | |
452 while (1) | |
453 { | |
771 | 454 Extbyte *hostext; |
455 | |
428 | 456 #ifdef TRY_AGAIN |
457 if (count++ > 10) break; | |
458 h_errno = 0; | |
459 #endif | |
771 | 460 |
1204 | 461 LISP_STRING_TO_EXTERNAL (host, hostext, Qunix_host_name_encoding); |
771 | 462 |
428 | 463 /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */ |
464 slow_down_interrupts (); | |
771 | 465 host_info_ptr = gethostbyname (hostext); |
428 | 466 speed_up_interrupts (); |
467 #ifdef TRY_AGAIN | |
468 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) | |
469 #endif | |
470 break; | |
471 Fsleep_for (make_int (1)); | |
472 } | |
473 if (host_info_ptr) | |
474 { | |
475 address->sin_family = host_info_ptr->h_addrtype; | |
502 | 476 memcpy (&address->sin_addr, host_info_ptr->h_addr, |
477 host_info_ptr->h_length); | |
428 | 478 } |
479 else | |
480 { | |
481 IN_ADDR numeric_addr; | |
1204 | 482 Extbyte *hostext; |
483 | |
428 | 484 /* Attempt to interpret host as numeric inet address */ |
1204 | 485 LISP_STRING_TO_EXTERNAL (host, hostext, Qunix_host_name_encoding); |
486 numeric_addr = inet_addr (hostext); | |
428 | 487 if (NUMERIC_ADDR_ERROR) |
488 { | |
563 | 489 maybe_signal_error (Qio_error, "Unknown host", host, |
1204 | 490 Qprocess, errb); |
428 | 491 return 0; |
492 } | |
493 | |
494 /* There was some broken code here that called strlen() here | |
495 on (char *) &numeric_addr and even sometimes accessed | |
496 uninitialized data. */ | |
497 address->sin_family = AF_INET; | |
498 * (IN_ADDR *) &address->sin_addr = numeric_addr; | |
499 } | |
500 | |
501 return 1; | |
502 } | |
502 | 503 #endif /* !USE_GETADDRINFO */ |
428 | 504 |
505 static void | |
2286 | 506 set_socket_nonblocking_maybe (int fd, |
507 #ifdef PROCESS_IO_BLOCKING | |
508 int port, const char *proto | |
509 #else | |
510 int UNUSED (port), const char *UNUSED (proto) | |
511 #endif | |
512 ) | |
428 | 513 { |
514 #ifdef PROCESS_IO_BLOCKING | |
515 Lisp_Object tail; | |
516 | |
517 for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail)) | |
518 { | |
519 Lisp_Object tail_port = XCAR (tail); | |
520 | |
521 if (STRINGP (tail_port)) | |
522 { | |
523 struct servent *svc_info; | |
771 | 524 Extbyte *tailportext; |
525 | |
428 | 526 CHECK_STRING (tail_port); |
771 | 527 TO_EXTERNAL_FORMAT (LISP_STRING, tail_port, C_STRING_ALLOCA, |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
528 tailportext, Qunix_service_name_encoding); |
771 | 529 |
530 svc_info = getservbyname (tailportext, proto); | |
428 | 531 if ((svc_info != 0) && (svc_info->s_port == port)) |
532 break; | |
533 else | |
534 continue; | |
535 } | |
536 else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port)) | |
537 break; | |
538 } | |
539 | |
540 if (!CONSP (tail)) | |
541 { | |
542 set_descriptor_non_blocking (fd); | |
543 } | |
544 #else | |
545 set_descriptor_non_blocking (fd); | |
546 #endif /* PROCESS_IO_BLOCKING */ | |
547 } | |
548 | |
549 #endif /* HAVE_SOCKETS */ | |
550 | |
551 /* Compute the Lisp form of the process status from | |
552 the numeric status that was returned by `wait'. */ | |
553 | |
554 static void | |
440 | 555 update_status_from_wait_code (Lisp_Process *p, int *w_fmh) |
428 | 556 { |
557 /* C compiler lossage when attempting to pass w directly */ | |
558 int w = *w_fmh; | |
559 | |
560 if (WIFSTOPPED (w)) | |
561 { | |
562 p->status_symbol = Qstop; | |
563 p->exit_code = WSTOPSIG (w); | |
564 p->core_dumped = 0; | |
565 } | |
566 else if (WIFEXITED (w)) | |
567 { | |
568 p->status_symbol = Qexit; | |
569 p->exit_code = WEXITSTATUS (w); | |
570 p->core_dumped = 0; | |
571 } | |
572 else if (WIFSIGNALED (w)) | |
573 { | |
574 p->status_symbol = Qsignal; | |
575 p->exit_code = WTERMSIG (w); | |
576 p->core_dumped = WCOREDUMP (w); | |
577 } | |
578 else | |
579 { | |
580 p->status_symbol = Qrun; | |
581 p->exit_code = 0; | |
582 } | |
583 } | |
584 | |
585 #ifdef SIGCHLD | |
586 | |
587 #define MAX_EXITED_PROCESSES 1000 | |
588 static volatile pid_t exited_processes[MAX_EXITED_PROCESSES]; | |
589 static volatile int exited_processes_status[MAX_EXITED_PROCESSES]; | |
590 static volatile int exited_processes_index; | |
591 | |
592 static volatile int sigchld_happened; | |
593 | |
594 /* On receipt of a signal that a child status has changed, | |
595 loop asking about children with changed statuses until | |
596 the system says there are no more. All we do is record | |
597 the processes and wait status. | |
598 | |
599 This function could be called from within the SIGCHLD | |
600 handler, so it must be completely reentrant. When | |
601 not called from a SIGCHLD handler, BLOCK_SIGCHLD should | |
602 be non-zero so that SIGCHLD is blocked while this | |
603 function is running. (This is necessary so avoid | |
604 race conditions with the SIGCHLD_HAPPENED flag). */ | |
605 | |
606 static void | |
607 record_exited_processes (int block_sigchld) | |
608 { | |
609 if (!sigchld_happened) | |
610 { | |
611 return; | |
612 } | |
613 | |
614 #ifdef EMACS_BLOCK_SIGNAL | |
615 if (block_sigchld) | |
616 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
617 #endif | |
618 | |
619 while (sigchld_happened) | |
620 { | |
621 int pid; | |
622 int w; | |
623 | |
624 /* Keep trying to get a status until we get a definitive result. */ | |
625 do | |
626 { | |
627 errno = 0; | |
628 #ifdef WNOHANG | |
629 # ifndef WUNTRACED | |
630 # define WUNTRACED 0 | |
631 # endif /* not WUNTRACED */ | |
632 # ifdef HAVE_WAITPID | |
633 pid = waitpid ((pid_t) -1, &w, WNOHANG | WUNTRACED); | |
634 # else | |
635 pid = wait3 (&w, WNOHANG | WUNTRACED, 0); | |
636 # endif | |
637 #else /* not WNOHANG */ | |
638 pid = wait (&w); | |
639 #endif /* not WNOHANG */ | |
640 } | |
641 while (pid <= 0 && errno == EINTR); | |
642 | |
643 if (pid <= 0) | |
644 break; | |
645 | |
646 if (exited_processes_index < MAX_EXITED_PROCESSES) | |
647 { | |
648 exited_processes[exited_processes_index] = pid; | |
649 exited_processes_status[exited_processes_index] = w; | |
650 exited_processes_index++; | |
651 } | |
652 | |
653 /* On systems with WNOHANG, we just ignore the number | |
654 of times that SIGCHLD was signalled, and keep looping | |
655 until there are no more processes to wait on. If we | |
656 don't have WNOHANG, we have to rely on the count in | |
657 SIGCHLD_HAPPENED. */ | |
658 #ifndef WNOHANG | |
659 sigchld_happened--; | |
660 #endif /* not WNOHANG */ | |
661 } | |
662 | |
663 sigchld_happened = 0; | |
664 | |
665 if (block_sigchld) | |
666 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
667 } | |
668 | |
669 /* For any processes that have changed status and are recorded | |
440 | 670 and such, update the corresponding Lisp_Process. |
428 | 671 We separate this from record_exited_processes() so that |
672 we never have to call this function from within a signal | |
673 handler. We block SIGCHLD in case record_exited_processes() | |
674 is called from a signal handler. */ | |
675 | |
676 /** USG WARNING: Although it is not obvious from the documentation | |
677 in signal(2), on a USG system the SIGCLD handler MUST NOT call | |
678 signal() before executing at least one wait(), otherwise the handler | |
679 will be called again, resulting in an infinite loop. The relevant | |
680 portion of the documentation reads "SIGCLD signals will be queued | |
681 and the signal-catching function will be continually reentered until | |
682 the queue is empty". Invoking signal() causes the kernel to reexamine | |
683 the SIGCLD queue. Fred Fish, UniSoft Systems Inc. | |
684 | |
685 (Note that now this only applies in SYS V Release 2 and before. | |
686 On SYS V Release 3, we use sigset() to set the signal handler for | |
687 the first time, and so we don't have to reestablish the signal handler | |
688 in the handler below. On SYS V Release 4, we don't get this weirdo | |
689 behavior when we use sigaction(), which we do use.) */ | |
690 | |
691 static SIGTYPE | |
2286 | 692 sigchld_handler (int SIG_ARG_MAYBE_UNUSED (signo)) |
428 | 693 { |
694 #ifdef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR | |
695 int old_errno = errno; | |
696 | |
697 sigchld_happened++; | |
698 record_exited_processes (0); | |
699 errno = old_errno; | |
700 #else | |
701 sigchld_happened++; | |
702 #endif | |
703 #ifdef HAVE_UNIXOID_EVENT_LOOP | |
704 signal_fake_event (); | |
705 #endif | |
706 /* WARNING - must come after wait3() for USG systems */ | |
707 EMACS_REESTABLISH_SIGNAL (signo, sigchld_handler); | |
708 SIGRETURN; | |
709 } | |
710 | |
711 #endif /* SIGCHLD */ | |
712 | |
713 #ifdef SIGNALS_VIA_CHARACTERS | |
714 /* Get signal character to send to process if SIGNALS_VIA_CHARACTERS */ | |
715 | |
716 static int | |
717 process_signal_char (int tty_fd, int signo) | |
718 { | |
719 /* If it's not a tty, pray that these default values work */ | |
853 | 720 if (! isatty (tty_fd)) |
721 { | |
428 | 722 #define CNTL(ch) (037 & (ch)) |
853 | 723 switch (signo) |
724 { | |
725 case SIGINT: return CNTL ('C'); | |
726 case SIGQUIT: return CNTL ('\\'); | |
428 | 727 #ifdef SIGTSTP |
853 | 728 case SIGTSTP: return CNTL ('Z'); |
428 | 729 #endif |
853 | 730 } |
731 } | |
428 | 732 |
733 #ifdef HAVE_TERMIOS | |
734 /* TERMIOS is the latest and bestest, and seems most likely to work. | |
735 If the system has it, use it. */ | |
736 { | |
737 struct termios t; | |
738 tcgetattr (tty_fd, &t); | |
739 switch (signo) | |
740 { | |
741 case SIGINT: return t.c_cc[VINTR]; | |
742 case SIGQUIT: return t.c_cc[VQUIT]; | |
743 #if defined(SIGTSTP) && defined(VSUSP) | |
744 case SIGTSTP: return t.c_cc[VSUSP]; | |
745 #endif | |
746 } | |
747 } | |
748 | |
749 # elif defined (TIOCGLTC) && defined (TIOCGETC) /* not HAVE_TERMIOS */ | |
750 { | |
751 /* On Berkeley descendants, the following IOCTL's retrieve the | |
752 current control characters. */ | |
753 struct tchars c; | |
754 struct ltchars lc; | |
755 switch (signo) | |
756 { | |
757 case SIGINT: ioctl (tty_fd, TIOCGETC, &c); return c.t_intrc; | |
758 case SIGQUIT: ioctl (tty_fd, TIOCGETC, &c); return c.t_quitc; | |
759 # ifdef SIGTSTP | |
760 case SIGTSTP: ioctl (tty_fd, TIOCGLTC, &lc); return lc.t_suspc; | |
761 # endif /* SIGTSTP */ | |
762 } | |
763 } | |
764 | |
765 # elif defined (TCGETA) /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ | |
766 { | |
767 /* On SYSV descendants, the TCGETA ioctl retrieves the current | |
768 control characters. */ | |
769 struct termio t; | |
770 ioctl (tty_fd, TCGETA, &t); | |
771 switch (signo) { | |
772 case SIGINT: return t.c_cc[VINTR]; | |
773 case SIGQUIT: return t.c_cc[VQUIT]; | |
774 # ifdef SIGTSTP | |
775 case SIGTSTP: return t.c_cc[VSWTCH]; | |
776 # endif /* SIGTSTP */ | |
777 } | |
778 } | |
779 # else /* ! defined (TCGETA) */ | |
780 #error ERROR! Using SIGNALS_VIA_CHARACTERS, but not HAVE_TERMIOS || (TIOCGLTC && TIOCGETC) || TCGETA | |
781 /* If your system configuration files define SIGNALS_VIA_CHARACTERS, | |
782 you'd better be using one of the alternatives above! */ | |
783 # endif /* ! defined (TCGETA) */ | |
784 return '\0'; | |
785 } | |
786 #endif /* SIGNALS_VIA_CHARACTERS */ | |
787 | |
788 | |
789 | |
790 | |
791 /**********************************************************************/ | |
792 /* Process implementation methods */ | |
793 /**********************************************************************/ | |
794 | |
795 /* | |
796 * Allocate and initialize Lisp_Process->process_data | |
797 */ | |
798 | |
799 static void | |
440 | 800 unix_alloc_process_data (Lisp_Process *p) |
428 | 801 { |
802 p->process_data = xnew (struct unix_process_data); | |
803 | |
1204 | 804 UNIX_DATA (p)->connected_via_filedesc_p = 0; |
805 UNIX_DATA (p)->infd = -1; | |
806 UNIX_DATA (p)->errfd = -1; | |
807 UNIX_DATA (p)->subtty = -1; | |
808 UNIX_DATA (p)->pty_flag = 0; | |
428 | 809 } |
810 | |
811 /* | |
812 * Initialize XEmacs process implementation once | |
813 */ | |
814 | |
815 #ifdef SIGCHLD | |
816 static void | |
817 unix_init_process (void) | |
818 { | |
819 if (! noninteractive || initialized) | |
613 | 820 EMACS_SIGNAL (SIGCHLD, sigchld_handler); |
428 | 821 } |
822 #endif /* SIGCHLD */ | |
823 | |
824 /* | |
825 * Initialize any process local data. This is called when newly | |
826 * created process is connected to real OS file handles. The | |
827 * handles are generally represented by void* type, but are | |
442 | 828 * of type int (file descriptors) for UNIX. |
428 | 829 */ |
830 | |
831 static void | |
2286 | 832 unix_init_process_io_handles (Lisp_Process *p, void *in, void *UNUSED (out), |
833 void *err, int UNUSED (flags)) | |
853 | 834 { |
4031 | 835 /* if sizeof(EMACS_INT) > sizeof(int) this truncates the value */ |
836 UNIX_DATA(p)->infd = (EMACS_INT) in; | |
837 UNIX_DATA(p)->errfd = (EMACS_INT) err; | |
853 | 838 } |
839 | |
840 /* Move the file descriptor FD so that its number is not less than MIN. * | |
841 The original file descriptor remains open. */ | |
842 static int | |
843 relocate_fd (int fd, int min) | |
844 { | |
845 if (fd >= min) | |
846 return fd; | |
847 else | |
848 { | |
849 int newfd = dup (fd); | |
850 if (newfd == -1) | |
851 { | |
867 | 852 Ibyte *errmess; |
853 | 853 GET_STRERROR (errmess, errno); |
854 stderr_out ("Error while setting up child: %s\n", errmess); | |
855 _exit (1); | |
856 } | |
857 return relocate_fd (newfd, min); | |
858 } | |
859 } | |
860 | |
861 /* This is the last thing run in a newly forked inferior process. | |
862 Copy descriptors IN, OUT and ERR | |
863 as descriptors STDIN_FILENO, STDOUT_FILENO, and STDERR_FILENO. | |
864 Initialize inferior's priority, pgrp, connected dir and environment. | |
865 then exec another program based on new_argv. | |
866 | |
867 XEmacs: We've removed the SET_PGRP argument because it's already | |
868 done by the callers of child_setup. | |
869 | |
870 CURRENT_DIR is an elisp string giving the path of the current | |
871 directory the subprocess should have. Since we can't really signal | |
872 a decent error from within the child (#### not quite correct in | |
873 XEmacs?), this should be verified as an executable directory by the | |
874 parent. */ | |
875 | |
2268 | 876 static DECLARE_DOESNT_RETURN (child_setup (int, int, int, Ibyte **, |
877 Lisp_Object)); | |
878 | |
879 static DOESNT_RETURN | |
867 | 880 child_setup (int in, int out, int err, Ibyte **new_argv, |
853 | 881 Lisp_Object current_dir) |
428 | 882 { |
867 | 883 Ibyte **env; |
884 Ibyte *pwd; | |
853 | 885 |
886 #ifdef SET_EMACS_PRIORITY | |
887 if (emacs_priority != 0) | |
888 nice (- emacs_priority); | |
889 #endif | |
890 | |
891 /* Close Emacs's descriptors that this process should not have. */ | |
892 close_process_descs (); | |
893 close_load_descs (); | |
894 | |
895 /* [[Note that use of alloca is always safe here. It's obvious for systems | |
896 that do not have true vfork or that have true (stack) alloca. | |
897 If using vfork and C_ALLOCA it is safe because that changes | |
898 the superior's static variables as if the superior had done alloca | |
899 and will be cleaned up in the usual way.]] -- irrelevant because | |
900 XEmacs does not use vfork. */ | |
901 { | |
902 REGISTER Bytecount i; | |
903 | |
904 i = XSTRING_LENGTH (current_dir); | |
2367 | 905 pwd = alloca_ibytes (i + 6); |
853 | 906 memcpy (pwd, "PWD=", 4); |
907 memcpy (pwd + 4, XSTRING_DATA (current_dir), i); | |
908 i += 4; | |
909 if (!IS_DIRECTORY_SEP (pwd[i - 1])) | |
910 pwd[i++] = DIRECTORY_SEP; | |
911 pwd[i] = 0; | |
912 | |
913 /* [[We can't signal an Elisp error here; we're in a vfork. Since | |
914 the callers check the current directory before forking, this | |
915 should only return an error if the directory's permissions | |
916 are changed between the check and this chdir, but we should | |
917 at least check.]] -- irrelevant because XEmacs does not use vfork. */ | |
918 if (qxe_chdir (pwd + 4) < 0) | |
919 { | |
920 /* Don't report the chdir error, or ange-ftp.el doesn't work. */ | |
921 /* (FSFmacs does _exit (errno) here.) */ | |
922 pwd = 0; | |
923 } | |
924 else | |
925 { | |
926 /* Strip trailing "/". Cretinous *[]&@$#^%@#$% Un*x */ | |
927 /* leave "//" (from FSF) */ | |
928 while (i > 6 && IS_DIRECTORY_SEP (pwd[i - 1])) | |
929 pwd[--i] = 0; | |
930 } | |
931 } | |
932 | |
933 /* Set `env' to a vector of the strings in Vprocess_environment. */ | |
934 /* + 2 to include PWD and terminating 0. */ | |
867 | 935 env = alloca_array (Ibyte *, XINT (Flength (Vprocess_environment)) + 2); |
853 | 936 { |
937 REGISTER Lisp_Object tail; | |
867 | 938 Ibyte **new_env = env; |
853 | 939 |
940 /* If we have a PWD envvar and we know the real current directory, | |
941 pass one down, but with corrected value. */ | |
942 if (pwd && egetenv ("PWD")) | |
943 *new_env++ = pwd; | |
944 | |
945 /* Copy the Vprocess_environment strings into new_env. */ | |
946 for (tail = Vprocess_environment; | |
947 CONSP (tail) && STRINGP (XCAR (tail)); | |
948 tail = XCDR (tail)) | |
949 { | |
867 | 950 Ibyte **ep = env; |
951 Ibyte *envvar = XSTRING_DATA (XCAR (tail)); | |
853 | 952 |
953 /* See if envvar duplicates any string already in the env. | |
954 If so, don't put it in. | |
955 When an env var has multiple definitions, | |
956 we keep the definition that comes first in process-environment. */ | |
957 for (; ep != new_env; ep++) | |
958 { | |
867 | 959 Ibyte *p = *ep, *q = envvar; |
853 | 960 while (1) |
961 { | |
962 if (*q == 0) | |
963 /* The string is malformed; might as well drop it. */ | |
964 goto duplicate; | |
965 if (*q != *p) | |
966 break; | |
967 if (*q == '=') | |
968 goto duplicate; | |
969 p++, q++; | |
970 } | |
971 } | |
867 | 972 if (pwd && !qxestrncmp ((Ibyte *) "PWD=", envvar, 4)) |
853 | 973 { |
974 *new_env++ = pwd; | |
975 pwd = 0; | |
976 } | |
977 else | |
978 *new_env++ = envvar; | |
979 | |
980 duplicate: ; | |
981 } | |
982 | |
983 *new_env = 0; | |
984 } | |
985 | |
986 /* Make sure that in, out, and err are not actually already in | |
987 descriptors zero, one, or two; this could happen if Emacs is | |
988 started with its standard in, out, or error closed, as might | |
989 happen under X. */ | |
990 in = relocate_fd (in, 3); | |
991 out = relocate_fd (out, 3); | |
992 err = relocate_fd (err, 3); | |
993 | |
994 /* Set the standard input/output channels of the new process. */ | |
995 retry_close (STDIN_FILENO); | |
996 retry_close (STDOUT_FILENO); | |
997 retry_close (STDERR_FILENO); | |
998 | |
999 dup2 (in, STDIN_FILENO); | |
1000 dup2 (out, STDOUT_FILENO); | |
1001 dup2 (err, STDERR_FILENO); | |
1002 | |
1003 retry_close (in); | |
1004 retry_close (out); | |
1005 retry_close (err); | |
1006 | |
1015 | 1007 /* Close non-process-related file descriptors. It would be cleaner to |
932 | 1008 close just the ones that need to be, but the following brute |
1015 | 1009 force approach is certainly effective, and not too slow. */ |
932 | 1010 |
1011 { | |
1012 int fd; | |
1015 | 1013 |
1014 for (fd = 3; fd < MAXDESC; fd++) | |
932 | 1015 retry_close (fd); |
1016 } | |
1017 | |
853 | 1018 /* we've wrapped execve; it translates its arguments */ |
1019 qxe_execve (new_argv[0], new_argv, env); | |
1020 | |
1021 stdout_out ("Can't exec program %s\n", new_argv[0]); | |
1022 _exit (1); | |
428 | 1023 } |
1024 | |
1025 /* | |
1026 * Fork off a subprocess. P is a pointer to a newly created subprocess | |
1027 * object. If this function signals, the caller is responsible for | |
1028 * deleting (and finalizing) the process object. | |
1029 * | |
1030 * The method must return PID of the new process, a (positive??? ####) number | |
1031 * which fits into Lisp_Int. No return value indicates an error, the method | |
1032 * must signal an error instead. | |
1033 */ | |
1034 | |
1035 static int | |
440 | 1036 unix_create_process (Lisp_Process *p, |
428 | 1037 Lisp_Object *argv, int nargv, |
853 | 1038 Lisp_Object program, Lisp_Object cur_dir, |
1039 int separate_err) | |
428 | 1040 { |
1041 int pid; | |
4123 | 1042 EMACS_INT inchannel = -1; |
1043 EMACS_INT outchannel = -1; | |
1044 EMACS_INT errchannel = -1; | |
428 | 1045 /* Use volatile to protect variables from being clobbered by longjmp. */ |
4123 | 1046 volatile EMACS_INT forkin = -1; |
1047 volatile EMACS_INT forkout = -1; | |
1048 volatile EMACS_INT forkerr = -1; | |
428 | 1049 volatile int pty_flag = 0; |
1050 | |
1051 if (!NILP (Vprocess_connection_type)) | |
1052 { | |
1053 /* find a new pty, open the master side, return the opened | |
1054 file handle, and store the name of the corresponding slave | |
1055 side in global variable pty_name. */ | |
1056 outchannel = inchannel = allocate_pty (); | |
1057 } | |
1058 | |
535 | 1059 if (inchannel >= 0) /* We successfully allocated a pty. */ |
428 | 1060 { |
1061 /* You're "supposed" to now open the slave in the child. | |
1062 On some systems, we can open it here; this allows for | |
1063 better error checking. */ | |
1064 #if !defined(USG) | |
1065 /* On USG systems it does not work to open the pty's tty here | |
1066 and then close and reopen it in the child. */ | |
853 | 1067 # ifdef O_NOCTTY |
428 | 1068 /* Don't let this terminal become our controlling terminal |
1069 (in case we don't have one). */ | |
771 | 1070 forkout = forkin = qxe_open (pty_name, |
1071 O_RDWR | O_NOCTTY | OPEN_BINARY, 0); | |
853 | 1072 # else |
771 | 1073 forkout = forkin = qxe_open (pty_name, O_RDWR | OPEN_BINARY, 0); |
853 | 1074 # endif |
428 | 1075 if (forkin < 0) |
1076 goto io_failure; | |
1077 #endif /* not USG */ | |
853 | 1078 UNIX_DATA (p)->pty_flag = pty_flag = 1; |
428 | 1079 } |
1080 else | |
1081 if (create_bidirectional_pipe (&inchannel, &outchannel, | |
1082 &forkin, &forkout) < 0) | |
1083 goto io_failure; | |
1084 | |
853 | 1085 if (separate_err) |
1086 { | |
1087 int sv[2]; | |
854 | 1088 |
853 | 1089 if (pipe (sv) < 0) |
1090 goto io_failure; | |
1091 forkerr = sv[1]; | |
1092 errchannel = sv[0]; | |
1093 } | |
854 | 1094 |
428 | 1095 #if 0 |
1096 /* Replaced by close_process_descs */ | |
1097 set_exclusive_use (inchannel); | |
1098 set_exclusive_use (outchannel); | |
1099 #endif | |
1100 | |
1101 set_descriptor_non_blocking (inchannel); | |
1192 | 1102 set_descriptor_non_blocking (outchannel); |
853 | 1103 if (errchannel >= 0) |
1104 set_descriptor_non_blocking (errchannel); | |
428 | 1105 |
1106 /* Record this as an active process, with its channels. | |
1107 As a result, child_setup will close Emacs's side of the pipes. */ | |
853 | 1108 init_process_io_handles (p, (void *) inchannel, (void *) outchannel, |
1109 (void *) errchannel, | |
428 | 1110 pty_flag ? STREAM_PTY_FLUSHING : 0); |
1111 /* Record the tty descriptor used in the subprocess. */ | |
853 | 1112 UNIX_DATA (p)->subtty = forkin; |
428 | 1113 |
1114 { | |
1115 pid = fork (); | |
1116 if (pid == 0) | |
1117 { | |
1118 /**** Now we're in the child process ****/ | |
1119 int xforkin = forkin; | |
1120 int xforkout = forkout; | |
853 | 1121 int xforkerr = forkerr; |
428 | 1122 |
1015 | 1123 /* Checking for quit in the child is bad because that will |
1124 cause I/O, and that, in turn, can confuse the X connection. */ | |
1125 begin_dont_check_for_quit(); | |
1126 | |
442 | 1127 /* Disconnect the current controlling terminal, pursuant to |
1128 making the pty be the controlling terminal of the process. | |
1129 Also put us in our own process group. */ | |
1130 | |
1131 disconnect_controlling_terminal (); | |
1132 | |
1133 if (pty_flag) | |
428 | 1134 { |
1135 /* Open the pty connection and make the pty's terminal | |
1136 our controlling terminal. | |
1137 | |
1138 On systems with TIOCSCTTY, we just use it to set | |
1139 the controlling terminal. On other systems, the | |
1140 first TTY we open becomes the controlling terminal. | |
1141 So, we end up with four possibilities: | |
1142 | |
1143 (1) on USG and TIOCSCTTY systems, we open the pty | |
1144 and use TIOCSCTTY. | |
1145 (2) on other USG systems, we just open the pty. | |
1146 (3) on non-USG systems with TIOCSCTTY, we | |
1147 just use TIOCSCTTY. (On non-USG systems, we | |
1148 already opened the pty in the parent process.) | |
1149 (4) on non-USG systems without TIOCSCTTY, we | |
1150 close the pty and reopen it. | |
1151 | |
1152 This would be cleaner if we didn't open the pty | |
1153 in the parent process, but doing it that way | |
1154 makes it possible to trap error conditions. | |
1155 It's harder to convey an error from the child | |
1156 process, and I don't feel like messing with | |
1157 this now. */ | |
1158 | |
1159 /* SunOS has TIOCSCTTY but the close/open method | |
1160 also works. */ | |
1161 | |
853 | 1162 #if defined (USG) || !defined (TIOCSCTTY) |
428 | 1163 /* Now close the pty (if we had it open) and reopen it. |
1164 This makes the pty the controlling terminal of the | |
1165 subprocess. */ | |
853 | 1166 /* I wonder if retry_close (qxe_open (pty_name, ...)) would |
1167 work? */ | |
428 | 1168 if (xforkin >= 0) |
771 | 1169 retry_close (xforkin); |
1170 xforkout = xforkin = qxe_open (pty_name, O_RDWR | OPEN_BINARY, 0); | |
428 | 1171 if (xforkin < 0) |
1172 { | |
771 | 1173 retry_write (1, "Couldn't open the pty terminal ", 31); |
1174 retry_write (1, pty_name, qxestrlen (pty_name)); | |
1175 retry_write (1, "\n", 1); | |
428 | 1176 _exit (1); |
1177 } | |
853 | 1178 #endif /* USG or not TIOCSCTTY */ |
428 | 1179 |
1180 /* Miscellaneous setup required for some systems. | |
1181 Must be done before using tc* functions on xforkin. | |
1182 This guarantees that isatty(xforkin) is true. */ | |
1183 | |
853 | 1184 #if defined (HAVE_ISASTREAM) && defined (I_PUSH) |
442 | 1185 if (isastream (xforkin)) |
1186 { | |
853 | 1187 # if defined (I_FIND) |
1188 # define stream_module_pushed(fd, module) (ioctl (fd, I_FIND, module) == 1) | |
1189 # else | |
1190 # define stream_module_pushed(fd, module) 0 | |
1191 # endif | |
442 | 1192 if (! stream_module_pushed (xforkin, "ptem")) |
1193 ioctl (xforkin, I_PUSH, "ptem"); | |
1194 if (! stream_module_pushed (xforkin, "ldterm")) | |
1195 ioctl (xforkin, I_PUSH, "ldterm"); | |
1196 if (! stream_module_pushed (xforkin, "ttcompat")) | |
1197 ioctl (xforkin, I_PUSH, "ttcompat"); | |
1198 } | |
853 | 1199 #endif /* defined (HAVE_ISASTREAM) && defined (I_PUSH) */ |
428 | 1200 |
853 | 1201 #ifdef TIOCSCTTY |
428 | 1202 /* We ignore the return value |
1203 because faith@cs.unc.edu says that is necessary on Linux. */ | |
1204 assert (isatty (xforkin)); | |
1205 ioctl (xforkin, TIOCSCTTY, 0); | |
853 | 1206 #endif /* TIOCSCTTY */ |
428 | 1207 |
1208 /* Change the line discipline. */ | |
1209 | |
853 | 1210 #if defined (HAVE_TERMIOS) && defined (LDISC1) |
428 | 1211 { |
1212 struct termios t; | |
1213 assert (isatty (xforkin)); | |
1214 tcgetattr (xforkin, &t); | |
1215 t.c_lflag = LDISC1; | |
1216 if (tcsetattr (xforkin, TCSANOW, &t) < 0) | |
1217 perror ("create_process/tcsetattr LDISC1 failed\n"); | |
1218 } | |
853 | 1219 #elif defined (NTTYDISC) && defined (TIOCSETD) |
428 | 1220 { |
1221 /* Use new line discipline. TIOCSETD is accepted and | |
1222 ignored on Sys5.4 systems with ttcompat. */ | |
1223 int ldisc = NTTYDISC; | |
1224 assert (isatty (xforkin)); | |
1225 ioctl (xforkin, TIOCSETD, &ldisc); | |
1226 } | |
853 | 1227 #endif /* TIOCSETD & NTTYDISC */ |
428 | 1228 |
1229 /* Make our process group be the foreground group | |
1230 of our new controlling terminal. */ | |
1231 | |
1232 { | |
442 | 1233 pid_t piddly = EMACS_GET_PROCESS_GROUP (); |
428 | 1234 EMACS_SET_TTY_PROCESS_GROUP (xforkin, &piddly); |
1235 } | |
1236 | |
1237 /* On AIX, we've disabled SIGHUP above once we start a | |
1238 child on a pty. Now reenable it in the child, so it | |
1239 will die when we want it to. | |
1240 JV: This needs to be done ALWAYS as we might have inherited | |
1241 a SIG_IGN handling from our parent (nohup) and we are in new | |
1242 process group. | |
1243 */ | |
613 | 1244 EMACS_SIGNAL (SIGHUP, SIG_DFL); |
428 | 1245 |
535 | 1246 /* Set up the terminal characteristics of the pty. */ |
1247 child_setup_tty (xforkout); | |
1248 } /* if (pty_flag) */ | |
428 | 1249 |
1250 | |
613 | 1251 EMACS_SIGNAL (SIGINT, SIG_DFL); |
1252 EMACS_SIGNAL (SIGQUIT, SIG_DFL); | |
428 | 1253 |
1254 { | |
867 | 1255 Ibyte **new_argv = alloca_array (Ibyte *, nargv + 2); |
428 | 1256 int i; |
1257 | |
1258 /* Nothing below here GCs so our string pointers shouldn't move. */ | |
771 | 1259 new_argv[0] = XSTRING_DATA (program); |
428 | 1260 for (i = 0; i < nargv; i++) |
1261 { | |
1262 CHECK_STRING (argv[i]); | |
771 | 1263 new_argv[i + 1] = XSTRING_DATA (argv[i]); |
428 | 1264 } |
1265 new_argv[i + 1] = 0; | |
1266 | |
853 | 1267 child_setup (xforkin, xforkout, separate_err ? xforkerr : xforkout, |
1268 new_argv, cur_dir); | |
428 | 1269 } |
1270 | |
1271 } /**** End of child code ****/ | |
1272 | |
1273 /**** Back in parent process ****/ | |
1274 } | |
1275 | |
1276 if (pid < 0) | |
1277 { | |
853 | 1278 /* Note: The caller set up an unwind-protect to automatically delete |
1279 the process if we fail. This will correctly deselect and close | |
1280 inchannel, outchannel, and errchannel. */ | |
442 | 1281 int save_errno = errno; |
428 | 1282 close_descriptor_pair (forkin, forkout); |
853 | 1283 if (separate_err) |
1284 retry_close (forkerr); | |
442 | 1285 errno = save_errno; |
563 | 1286 report_process_error ("Doing fork", Qunbound); |
428 | 1287 } |
1288 | |
1289 /* #### dmoore - why is this commented out, otherwise we leave | |
1290 subtty = forkin, but then we close forkin just below. */ | |
853 | 1291 /* UNIX_DATA (p)->subtty = -1; */ |
428 | 1292 |
1293 /* If the subfork execv fails, and it exits, | |
1294 this close hangs. I don't know why. | |
1295 So have an interrupt jar it loose. */ | |
1296 if (forkin >= 0) | |
1297 close_safely (forkin); | |
1298 if (forkin != forkout && forkout >= 0) | |
771 | 1299 retry_close (forkout); |
853 | 1300 if (separate_err) |
1301 retry_close (forkerr); | |
428 | 1302 |
1204 | 1303 p->tty_name = pty_flag ? build_intstring (pty_name) : Qnil; |
428 | 1304 |
1305 /* Notice that SIGCHLD was not blocked. (This is not possible on | |
1306 some systems.) No biggie if SIGCHLD occurs right around the | |
1307 time that this call happens, because SIGCHLD() does not actually | |
1308 deselect the process (that doesn't occur until the next time | |
1309 we're waiting for an event, when status_notify() is called). */ | |
1310 return pid; | |
1311 | |
853 | 1312 io_failure: |
428 | 1313 { |
1314 int save_errno = errno; | |
1315 close_descriptor_pair (forkin, forkout); | |
1316 close_descriptor_pair (inchannel, outchannel); | |
853 | 1317 close_descriptor_pair (forkerr, errchannel); |
428 | 1318 errno = save_errno; |
563 | 1319 report_process_error ("Opening pty or pipe", Qunbound); |
1204 | 1320 RETURN_NOT_REACHED (0); |
428 | 1321 } |
1322 } | |
1323 | |
1324 /* Return nonzero if this process is a ToolTalk connection. */ | |
1325 | |
1326 static int | |
440 | 1327 unix_tooltalk_connection_p (Lisp_Process *p) |
428 | 1328 { |
853 | 1329 return UNIX_DATA (p)->connected_via_filedesc_p; |
428 | 1330 } |
1331 | |
1332 /* This is called to set process' virtual terminal size */ | |
1333 | |
1334 static int | |
853 | 1335 unix_set_window_size (Lisp_Process *p, int cols, int rows) |
428 | 1336 { |
853 | 1337 return set_window_size (UNIX_DATA (p)->infd, cols, rows); |
428 | 1338 } |
1339 | |
1340 /* | |
1341 * This method is called to update status fields of the process | |
1342 * structure. If the process has not existed, this method is | |
1343 * expected to do nothing. | |
1344 * | |
1345 * The method is called only for real child processes. | |
1346 */ | |
1347 | |
1348 #ifdef HAVE_WAITPID | |
1349 static void | |
853 | 1350 unix_update_status_if_terminated (Lisp_Process *p) |
428 | 1351 { |
1352 int w; | |
1353 #ifdef SIGCHLD | |
1354 EMACS_BLOCK_SIGNAL (SIGCHLD); | |
1355 #endif | |
1356 if (waitpid (XINT (p->pid), &w, WNOHANG) == XINT (p->pid)) | |
1357 { | |
1358 p->tick++; | |
1359 update_status_from_wait_code (p, &w); | |
1360 } | |
1361 #ifdef SIGCHLD | |
1362 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
1363 #endif | |
1364 } | |
1365 #endif | |
1366 | |
1367 /* | |
1368 * Update status of all exited processes. Called when SIGCLD has signaled. | |
1369 */ | |
1370 | |
1371 #ifdef SIGCHLD | |
1372 static void | |
1373 unix_reap_exited_processes (void) | |
1374 { | |
1375 int i; | |
440 | 1376 Lisp_Process *p; |
428 | 1377 |
1378 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR | |
1379 record_exited_processes (1); | |
1380 #endif | |
1381 | |
1382 if (exited_processes_index <= 0) | |
1383 { | |
1384 return; | |
1385 } | |
1386 | |
853 | 1387 #ifdef EMACS_BLOCK_SIGNAL |
428 | 1388 EMACS_BLOCK_SIGNAL (SIGCHLD); |
1389 #endif | |
1390 for (i = 0; i < exited_processes_index; i++) | |
1391 { | |
1392 int pid = exited_processes[i]; | |
1393 int w = exited_processes_status[i]; | |
1394 | |
1395 /* Find the process that signaled us, and record its status. */ | |
1396 | |
1397 p = 0; | |
1398 { | |
1399 Lisp_Object tail; | |
1400 LIST_LOOP (tail, Vprocess_list) | |
1401 { | |
1402 Lisp_Object proc = XCAR (tail); | |
1403 p = XPROCESS (proc); | |
1404 if (INTP (p->pid) && XINT (p->pid) == pid) | |
1405 break; | |
1406 p = 0; | |
1407 } | |
1408 } | |
1409 | |
1410 if (p) | |
1411 { | |
1412 /* Change the status of the process that was found. */ | |
1413 p->tick++; | |
1414 process_tick++; | |
1415 update_status_from_wait_code (p, &w); | |
1416 | |
1417 /* If process has terminated, stop waiting for its output. */ | |
1418 if (WIFSIGNALED (w) || WIFEXITED (w)) | |
1419 { | |
853 | 1420 if (!NILP (p->pipe_instream)) |
428 | 1421 { |
1422 /* We can't just call event_stream->unselect_process_cb (p) | |
1423 here, because that calls XtRemoveInput, which is not | |
1424 necessarily reentrant, so we can't call this at interrupt | |
1425 level. | |
1426 */ | |
1427 } | |
1428 } | |
1429 } | |
853 | 1430 #ifdef NEED_SYNC_PROCESS_CODE |
428 | 1431 else |
1432 { | |
1433 /* There was no asynchronous process found for that id. Check | |
1434 if we have a synchronous process. Only set sync process status | |
1435 if there is one, so we work OK with the waitpid() call in | |
1436 wait_for_termination(). */ | |
1437 if (synch_process_alive != 0) | |
1438 { /* Set the global sync process status variables. */ | |
1439 synch_process_alive = 0; | |
1440 | |
1441 /* Report the status of the synchronous process. */ | |
1442 if (WIFEXITED (w)) | |
1443 synch_process_retcode = WEXITSTATUS (w); | |
1444 else if (WIFSIGNALED (w)) | |
1445 synch_process_death = signal_name (WTERMSIG (w)); | |
1446 } | |
1447 } | |
853 | 1448 #endif /* NEED_SYNC_PROCESS_CODE */ |
428 | 1449 } |
1450 | |
1451 exited_processes_index = 0; | |
1452 | |
1453 EMACS_UNBLOCK_SIGNAL (SIGCHLD); | |
1454 } | |
1455 #endif /* SIGCHLD */ | |
1456 | |
1457 /* | |
1458 * Stuff the entire contents of LSTREAM to the process output pipe | |
1459 */ | |
1460 | |
1461 static JMP_BUF send_process_frame; | |
1462 | |
1463 static SIGTYPE | |
1464 send_process_trap (int signum) | |
1465 { | |
1466 EMACS_REESTABLISH_SIGNAL (signum, send_process_trap); | |
1467 EMACS_UNBLOCK_SIGNAL (signum); | |
1468 LONGJMP (send_process_frame, 1); | |
1469 } | |
1470 | |
1471 static void | |
853 | 1472 unix_send_process (Lisp_Object proc, struct lstream *lstream) |
428 | 1473 { |
1111 | 1474 /* See comment lisp.h circa line 787 */ |
1475 SIGTYPE (*VOLATILE_IF_NOT_CPP old_sigpipe) (int) = 0; | |
1476 VOLATILE_IF_NOT_CPP Lisp_Object vol_proc = proc; | |
1477 Lisp_Process *VOLATILE_IF_NOT_CPP p = XPROCESS (proc); | |
428 | 1478 |
442 | 1479 /* #### JV: layering violation? |
1480 | |
1481 This function knows too much about the relation between the encoding | |
1482 stream (DATA_OUTSTREAM) and the actual output stream p->output_stream. | |
1483 | |
1484 If encoding streams properly forwarded all calls, we could simply | |
1485 use DATA_OUTSTREAM everywhere. */ | |
1486 | |
428 | 1487 if (!SETJMP (send_process_frame)) |
1488 { | |
1489 /* use a reasonable-sized buffer (somewhere around the size of the | |
1490 stream buffer) so as to avoid inundating the stream with blocked | |
1491 data. */ | |
867 | 1492 Ibyte chunkbuf[512]; |
428 | 1493 Bytecount chunklen; |
1494 | |
2566 | 1495 do |
428 | 1496 { |
771 | 1497 int writeret; |
428 | 1498 |
1499 chunklen = Lstream_read (lstream, chunkbuf, 512); | |
1500 old_sigpipe = | |
613 | 1501 (SIGTYPE (*) (int)) EMACS_SIGNAL (SIGPIPE, send_process_trap); |
2566 | 1502 if (chunklen > 0) |
1503 { | |
1504 int save_errno; | |
1505 | |
1506 /* Lstream_write() will never successfully write less than | |
1507 the amount sent in. In the worst case, it just buffers | |
1508 the unwritten data. */ | |
1509 writeret = Lstream_write (XLSTREAM (DATA_OUTSTREAM(p)), chunkbuf, | |
1510 chunklen); | |
1511 save_errno = errno; | |
1512 EMACS_SIGNAL (SIGPIPE, old_sigpipe); | |
1513 errno = save_errno; | |
1514 if (writeret < 0) | |
1515 /* This is a real error. Blocking errors are handled | |
1516 specially inside of the filedesc stream. */ | |
1517 report_file_error ("writing to process", list1 (proc)); | |
1518 } | |
1519 else | |
1520 { | |
1521 /* Need to make sure that everything up to and including the | |
1522 last chunk is flushed, even when the pipe is currently | |
1523 blocked. */ | |
1524 Lstream_flush (XLSTREAM (DATA_OUTSTREAM(p))); | |
1525 EMACS_SIGNAL (SIGPIPE, old_sigpipe); | |
1526 } | |
428 | 1527 while (Lstream_was_blocked_p (XLSTREAM (p->pipe_outstream))) |
1528 { | |
3325 | 1529 /* Buffer is full. Wait 10ms, accepting input; that may |
1530 allow the program to finish doing output and read more. | |
1531 Used to be 1s, but that's excruciating. nt_send_process | |
1532 uses geometrically increasing timeouts (up to 1s). This | |
1533 might be a good idea here. | |
1534 N.B. timeout_secs = Qnil is faster than Qzero. */ | |
1535 Faccept_process_output (Qnil, Qnil, make_int (10)); | |
442 | 1536 /* It could have *really* finished, deleting the process */ |
1537 if (NILP(p->pipe_outstream)) | |
1538 return; | |
428 | 1539 old_sigpipe = |
613 | 1540 (SIGTYPE (*) (int)) EMACS_SIGNAL (SIGPIPE, send_process_trap); |
428 | 1541 Lstream_flush (XLSTREAM (p->pipe_outstream)); |
613 | 1542 EMACS_SIGNAL (SIGPIPE, old_sigpipe); |
428 | 1543 } |
2566 | 1544 /* Perhaps should ABORT() if < 0? This should never happen. */ |
428 | 1545 } |
2566 | 1546 while (chunklen > 0); |
428 | 1547 } |
1548 else | |
1549 { /* We got here from a longjmp() from the SIGPIPE handler */ | |
613 | 1550 EMACS_SIGNAL (SIGPIPE, old_sigpipe); |
428 | 1551 /* Close the file lstream so we don't attempt to write to it further */ |
1552 /* #### There is controversy over whether this might cause fd leakage */ | |
1553 /* my tests say no. -slb */ | |
1554 XLSTREAM (p->pipe_outstream)->flags &= ~LSTREAM_FL_IS_OPEN; | |
898 | 1555 XLSTREAM (p->coding_outstream)->flags &= ~LSTREAM_FL_IS_OPEN; |
428 | 1556 p->status_symbol = Qexit; |
1557 p->exit_code = 256; /* #### SIGPIPE ??? */ | |
1558 p->core_dumped = 0; | |
1559 p->tick++; | |
1560 process_tick++; | |
898 | 1561 deactivate_process (vol_proc); |
442 | 1562 invalid_operation ("SIGPIPE raised on process; closed it", p->name); |
428 | 1563 } |
1564 | |
613 | 1565 old_sigpipe = (SIGTYPE (*) (int)) EMACS_SIGNAL (SIGPIPE, send_process_trap); |
800 | 1566 Lstream_flush (XLSTREAM (DATA_OUTSTREAM (p))); |
613 | 1567 EMACS_SIGNAL (SIGPIPE, old_sigpipe); |
428 | 1568 } |
1569 | |
1570 /* | |
1571 * Send EOF to the process. The default implementation simply | |
1572 * closes the output stream. The method must return 0 to call | |
1573 * the default implementation, or 1 if it has taken all care about | |
1574 * sending EOF to the process. | |
1575 */ | |
1576 | |
1577 static int | |
1578 unix_process_send_eof (Lisp_Object proc) | |
1579 { | |
1580 if (!UNIX_DATA (XPROCESS (proc))->pty_flag) | |
1581 return 0; | |
1582 | |
1583 /* #### get_eof_char simply doesn't return the correct character | |
1584 here. Maybe it is needed to determine the right eof | |
1585 character in init_process_io_handles but here it simply screws | |
1586 things up. */ | |
1587 #if 0 | |
867 | 1588 Ibyte eof_char = get_eof_char (XPROCESS (proc)); |
428 | 1589 send_process (proc, Qnil, &eof_char, 0, 1); |
1590 #else | |
867 | 1591 send_process (proc, Qnil, (const Ibyte *) "\004", 0, 1); |
428 | 1592 #endif |
1593 return 1; | |
1594 } | |
1595 | |
1596 /* | |
1597 * Called before the process is deactivated. The process object | |
1598 * is not immediately finalized, just undergoes a transition to | |
1599 * inactive state. | |
1600 * | |
1601 * The return value is a unique stream ID, as returned by | |
853 | 1602 * event_stream_delete_io_streams |
428 | 1603 * |
853 | 1604 * In the lack of this method, only event_stream_delete_io_streams |
428 | 1605 * is called on both I/O streams of the process. |
1606 * | |
1607 * The UNIX version guards this by ignoring possible SIGPIPE. | |
1608 */ | |
1609 | |
853 | 1610 static void |
1611 unix_deactivate_process (Lisp_Process *p, | |
1612 USID *in_usid, | |
1613 USID *err_usid) | |
428 | 1614 { |
1615 SIGTYPE (*old_sigpipe) (int) = 0; | |
1616 | |
2367 | 1617 if (UNIX_DATA (p)->infd >= 0) |
1618 flush_pending_output (UNIX_DATA (p)->infd); | |
1619 if (UNIX_DATA (p)->errfd >= 0) | |
1620 flush_pending_output (UNIX_DATA (p)->errfd); | |
428 | 1621 |
1622 /* closing the outstream could result in SIGPIPE, so ignore it. */ | |
613 | 1623 old_sigpipe = (SIGTYPE (*) (int)) EMACS_SIGNAL (SIGPIPE, SIG_IGN); |
853 | 1624 event_stream_delete_io_streams (p->pipe_instream, p->pipe_outstream, |
1625 p->pipe_errstream, in_usid, err_usid); | |
613 | 1626 EMACS_SIGNAL (SIGPIPE, old_sigpipe); |
428 | 1627 |
2367 | 1628 UNIX_DATA (p)->infd = -1; |
1629 UNIX_DATA (p)->errfd = -1; | |
428 | 1630 } |
1631 | |
442 | 1632 /* If the subtty field of the process data is not filled in, do so now. */ |
1633 static void | |
1204 | 1634 try_to_initialize_subtty (Lisp_Process *p) |
442 | 1635 { |
1204 | 1636 struct unix_process_data *upd = UNIX_DATA (p); |
442 | 1637 if (upd->pty_flag |
444 | 1638 && (upd->subtty == -1 || ! isatty (upd->subtty)) |
1204 | 1639 && STRINGP (p->tty_name)) |
1640 upd->subtty = qxe_open (XSTRING_DATA (p->tty_name), O_RDWR, 0); | |
442 | 1641 } |
1642 | |
1643 /* Send signal number SIGNO to PROCESS. | |
428 | 1644 CURRENT_GROUP means send to the process group that currently owns |
1645 the terminal being used to communicate with PROCESS. | |
1646 This is used for various commands in shell mode. | |
1647 If NOMSG is zero, insert signal-announcements into process's buffers | |
1648 right away. | |
1649 | |
1650 If we can, we try to signal PROCESS by sending control characters | |
1651 down the pty. This allows us to signal inferiors who have changed | |
442 | 1652 their uid, for which killpg would return an EPERM error, |
1653 or processes running on other machines via remote login. | |
428 | 1654 |
442 | 1655 The method signals an error if the given SIGNO is not valid. */ |
428 | 1656 |
1657 static void | |
1658 unix_kill_child_process (Lisp_Object proc, int signo, | |
1659 int current_group, int nomsg) | |
1660 { | |
442 | 1661 pid_t pgid = -1; |
440 | 1662 Lisp_Process *p = XPROCESS (proc); |
442 | 1663 struct unix_process_data *d = UNIX_DATA (p); |
428 | 1664 |
1665 switch (signo) | |
1666 { | |
1667 #ifdef SIGCONT | |
1668 case SIGCONT: | |
1669 p->status_symbol = Qrun; | |
1670 p->exit_code = 0; | |
1671 p->tick++; | |
1672 process_tick++; | |
1673 if (!nomsg) | |
1674 status_notify (); | |
1675 break; | |
1676 #endif /* ! defined (SIGCONT) */ | |
1677 case SIGINT: | |
1678 case SIGQUIT: | |
1679 case SIGKILL: | |
442 | 1680 flush_pending_output (d->infd); |
853 | 1681 flush_pending_output (d->errfd); |
428 | 1682 break; |
1683 } | |
1684 | |
442 | 1685 if (! d->pty_flag) |
1686 current_group = 0; | |
1687 | |
1688 /* If current_group is true, we want to send a signal to the | |
1689 foreground process group of the terminal our child process is | |
1690 running on. You would think that would be easy. | |
1691 | |
1692 The BSD people invented the TIOCPGRP ioctl to get the foreground | |
1693 process group of a tty. That, combined with killpg, gives us | |
1694 what we want. | |
1695 | |
1696 However, the POSIX standards people, in their infinite wisdom, | |
1697 have seen fit to only allow this for processes which have the | |
1698 terminal as controlling terminal, which doesn't apply to us. | |
1699 | |
1700 Sooo..., we have to do something non-standard. The ioctls | |
1701 TIOCSIGNAL, TIOCSIG, and TIOCSIGSEND send the signal directly on | |
1702 many systems. POSIX tcgetpgrp(), since it is *documented* as not | |
1703 doing what we want, is actually less likely to work than the BSD | |
1704 ioctl TIOCGPGRP it is supposed to obsolete. Sometimes we have to | |
1705 use TIOCGPGRP on the master end, sometimes the slave end | |
1706 (probably an AIX bug). So we better get a fd for the slave if we | |
444 | 1707 haven't got it yet. |
1708 | |
1709 Anal operating systems like SGI Irix and Compaq Tru64 adhere | |
1710 strictly to the letter of the law, so our hack doesn't work. | |
1711 The following fragment from an Irix header file is suggestive: | |
1712 | |
1713 #ifdef __notdef__ | |
1714 // this is not currently supported | |
1715 #define TIOCSIGNAL (tIOC|31) // pty: send signal to slave | |
1716 #endif | |
1717 | |
1718 On those systems where none of our tricks work, we just fall back | |
1719 to the non-current_group behavior and kill the process group of | |
1720 the child. | |
1721 */ | |
442 | 1722 if (current_group) |
428 | 1723 { |
1204 | 1724 try_to_initialize_subtty (p); |
442 | 1725 |
1726 #ifdef SIGNALS_VIA_CHARACTERS | |
1727 /* If possible, send signals to the entire pgrp | |
1728 by sending an input character to it. */ | |
1729 { | |
867 | 1730 Ibyte sigchar = process_signal_char (d->subtty, signo); |
442 | 1731 if (sigchar) |
1732 { | |
853 | 1733 send_process (proc, Qnil, &sigchar, 0, 1); |
442 | 1734 return; |
1735 } | |
1736 } | |
1737 #endif /* SIGNALS_VIA_CHARACTERS */ | |
1738 | |
1739 #ifdef TIOCGPGRP | |
1740 if (pgid == -1) | |
1741 ioctl (d->infd, TIOCGPGRP, &pgid); /* BSD */ | |
1742 if (pgid == -1 && d->subtty != -1) | |
1743 ioctl (d->subtty, TIOCGPGRP, &pgid); /* Only this works on AIX! */ | |
1744 #endif /* TIOCGPGRP */ | |
1745 | |
1746 if (pgid == -1) | |
428 | 1747 { |
442 | 1748 /* Many systems provide an ioctl to send a signal directly */ |
1749 #ifdef TIOCSIGNAL /* Solaris, HP-UX */ | |
1750 if (ioctl (d->infd, TIOCSIGNAL, signo) != -1) | |
1751 return; | |
1752 #endif /* TIOCSIGNAL */ | |
1753 | |
1754 #ifdef TIOCSIG /* BSD */ | |
1755 if (ioctl (d->infd, TIOCSIG, signo) != -1) | |
1756 return; | |
1757 #endif /* TIOCSIG */ | |
428 | 1758 } |
442 | 1759 } /* current_group */ |
428 | 1760 |
442 | 1761 if (pgid == -1) |
1762 /* Either current_group is 0, or we failed to get the foreground | |
1763 process group using the trickery above. So we fall back to | |
1764 sending the signal to the process group of our child process. | |
1765 Since this is often a shell that ignores signals like SIGINT, | |
1766 the shell's subprocess is killed, which is the desired effect. | |
1767 The process group of p->pid is always p->pid, since it was | |
1768 created as a process group leader. */ | |
1769 pgid = XINT (p->pid); | |
1770 | |
1771 /* Finally send the signal. */ | |
1772 if (EMACS_KILLPG (pgid, signo) == -1) | |
458 | 1773 { |
1774 /* It's not an error if our victim is already dead. | |
462 | 1775 And we can't rely on the result of killing a zombie, since |
1776 XPG 4.2 requires that killing a zombie fail with ESRCH, | |
1777 while FIPS 151-2 requires that it succeeds! */ | |
458 | 1778 #ifdef ESRCH |
1779 if (errno != ESRCH) | |
1780 #endif | |
563 | 1781 signal_ferror_with_frob (Qio_error, lisp_strerror (errno), |
1782 "kill (pgid=%ld, signo=%ld) failed", | |
1783 (long) pgid, (long) signo); | |
458 | 1784 } |
428 | 1785 } |
1786 | |
442 | 1787 /* Send signal SIGCODE to any process in the system given its PID. |
1788 Return zero if successful, a negative number upon failure. */ | |
428 | 1789 |
1790 static int | |
1791 unix_kill_process_by_pid (int pid, int sigcode) | |
1792 { | |
1793 return kill (pid, sigcode); | |
1794 } | |
1795 | |
442 | 1796 /* Canonicalize host name HOST, and return its canonical form. |
1797 The default implementation just takes HOST for a canonical name. */ | |
428 | 1798 |
1799 #ifdef HAVE_SOCKETS | |
1800 static Lisp_Object | |
1801 unix_canonicalize_host_name (Lisp_Object host) | |
1802 { | |
502 | 1803 #ifdef USE_GETADDRINFO |
440 | 1804 struct addrinfo hints, *res; |
1805 static char addrbuf[NI_MAXHOST]; | |
1806 Lisp_Object canonname; | |
1807 int retval; | |
1808 char *ext_host; | |
1809 | |
1810 xzero (hints); | |
1811 hints.ai_flags = AI_CANONNAME; | |
724 | 1812 #ifdef IPV6_CANONICALIZE |
440 | 1813 hints.ai_family = AF_UNSPEC; |
724 | 1814 #else |
1815 hints.ai_family = PF_INET; | |
1816 #endif | |
440 | 1817 hints.ai_socktype = SOCK_STREAM; |
1818 hints.ai_protocol = 0; | |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1819 LISP_STRING_TO_EXTERNAL (host, ext_host, Qunix_host_name_encoding); |
440 | 1820 retval = getaddrinfo (ext_host, NULL, &hints, &res); |
1821 if (retval != 0) | |
1822 { | |
867 | 1823 CIbyte *gai_err; |
440 | 1824 |
855 | 1825 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_err, |
771 | 1826 Qstrerror_encoding); |
855 | 1827 maybe_signal_error (Qio_error, gai_err, host, |
793 | 1828 Qprocess, ERROR_ME_DEBUG_WARN); |
440 | 1829 canonname = host; |
1830 } | |
1831 else | |
1832 { | |
1833 int gni = getnameinfo (res->ai_addr, res->ai_addrlen, | |
1834 addrbuf, sizeof(addrbuf), | |
1835 NULL, 0, NI_NUMERICHOST); | |
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1836 canonname = gni ? host : build_ext_string (addrbuf, |
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
4759
diff
changeset
|
1837 Qunix_host_name_encoding); |
440 | 1838 |
1839 freeaddrinfo (res); | |
1840 } | |
1841 | |
1842 return canonname; | |
502 | 1843 #else /* ! USE_GETADDRINFO */ |
428 | 1844 struct sockaddr_in address; |
1845 | |
1846 if (!get_internet_address (host, &address, ERROR_ME_NOT)) | |
1847 return host; | |
1848 | |
1849 if (address.sin_family == AF_INET) | |
1850 return build_string (inet_ntoa (address.sin_addr)); | |
1851 else | |
1852 /* #### any clue what to do here? */ | |
1853 return host; | |
502 | 1854 #endif /* ! USE_GETADDRINFO */ |
428 | 1855 } |
1856 | |
442 | 1857 /* Open a TCP network connection to a given HOST/SERVICE. |
1858 Treated exactly like a normal process when reading and writing. | |
1859 Only differences are in status display and process deletion. | |
1860 A network connection has no PID; you cannot signal it. All you can | |
1861 do is deactivate and close it via delete-process. */ | |
428 | 1862 |
1863 static void | |
502 | 1864 unix_open_network_stream (Lisp_Object name, Lisp_Object host, |
1865 Lisp_Object service, Lisp_Object protocol, | |
1866 void **vinfd, void **voutfd) | |
428 | 1867 { |
4123 | 1868 EMACS_INT inch; |
1869 EMACS_INT outch; | |
502 | 1870 volatile int s = -1; |
428 | 1871 volatile int port; |
1872 volatile int retry = 0; | |
502 | 1873 volatile int xerrno = 0; |
1874 volatile int failed_connect = 0; | |
428 | 1875 int retval; |
1876 | |
1877 CHECK_STRING (host); | |
1878 | |
1879 if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp)) | |
563 | 1880 invalid_constant ("Unsupported protocol", protocol); |
428 | 1881 |
440 | 1882 { |
502 | 1883 #ifdef USE_GETADDRINFO |
1884 | |
440 | 1885 struct addrinfo hints, *res; |
1886 struct addrinfo * volatile lres; | |
771 | 1887 Extbyte *portstring; |
1888 Extbyte *ext_host; | |
1889 Extbyte portbuf[128]; | |
440 | 1890 /* |
1891 * Caution: service can either be a string or int. | |
1892 * Convert to a C string for later use by getaddrinfo. | |
1893 */ | |
1894 if (INTP (service)) | |
1895 { | |
1896 snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service)); | |
1897 portstring = portbuf; | |
1898 port = htons ((unsigned short) XINT (service)); | |
1899 } | |
1900 else | |
1901 { | |
1902 CHECK_STRING (service); | |
771 | 1903 LISP_STRING_TO_EXTERNAL (service, portstring, |
1904 Qunix_service_name_encoding); | |
440 | 1905 port = 0; |
1906 } | |
1907 | |
1908 xzero (hints); | |
1909 hints.ai_flags = 0; | |
1910 hints.ai_family = AF_UNSPEC; | |
1911 if (EQ (protocol, Qtcp)) | |
1912 hints.ai_socktype = SOCK_STREAM; | |
1913 else /* EQ (protocol, Qudp) */ | |
1914 hints.ai_socktype = SOCK_DGRAM; | |
1915 hints.ai_protocol = 0; | |
771 | 1916 LISP_STRING_TO_EXTERNAL (host, ext_host, Qunix_host_name_encoding); |
440 | 1917 retval = getaddrinfo (ext_host, portstring, &hints, &res); |
1918 if (retval != 0) | |
1919 { | |
867 | 1920 CIbyte *gai_err; |
440 | 1921 |
855 | 1922 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_err, |
771 | 1923 Qstrerror_encoding); |
855 | 1924 signal_error (Qio_error, gai_err, list2 (host, service)); |
440 | 1925 } |
1926 | |
1927 /* address loop */ | |
1928 for (lres = res; lres ; lres = lres->ai_next) | |
1929 | |
502 | 1930 #else /* !USE_GETADDRINFO */ |
440 | 1931 |
1932 struct sockaddr_in address; | |
502 | 1933 volatile int i; |
440 | 1934 |
1935 if (INTP (service)) | |
1936 port = htons ((unsigned short) XINT (service)); | |
1937 else | |
1938 { | |
1939 struct servent *svc_info; | |
771 | 1940 Extbyte *servext; |
1941 | |
440 | 1942 CHECK_STRING (service); |
771 | 1943 LISP_STRING_TO_EXTERNAL (service, servext, |
1944 Qunix_service_name_encoding); | |
440 | 1945 |
1946 if (EQ (protocol, Qtcp)) | |
771 | 1947 svc_info = getservbyname (servext, "tcp"); |
440 | 1948 else /* EQ (protocol, Qudp) */ |
771 | 1949 svc_info = getservbyname (servext, "udp"); |
428 | 1950 |
440 | 1951 if (svc_info == 0) |
442 | 1952 invalid_argument ("Unknown service", service); |
440 | 1953 port = svc_info->s_port; |
1954 } | |
428 | 1955 |
440 | 1956 get_internet_address (host, &address, ERROR_ME); |
1957 address.sin_port = port; | |
428 | 1958 |
502 | 1959 /* use a trivial address loop */ |
1960 for (i = 0; i < 1; i++) | |
1961 | |
1962 #endif /* !USE_GETADDRINFO */ | |
1963 { | |
1964 #ifdef USE_GETADDRINFO | |
1965 int family = lres->ai_family; | |
1966 #else | |
1967 int family = address.sin_family; | |
1968 #endif | |
1969 | |
1970 if (EQ (protocol, Qtcp)) | |
1971 s = socket (family, SOCK_STREAM, 0); | |
1972 else /* EQ (protocol, Qudp) */ | |
1973 s = socket (family, SOCK_DGRAM, 0); | |
1974 | |
1975 if (s < 0) | |
1976 { | |
1977 xerrno = errno; | |
1978 failed_connect = 0; | |
1979 continue; | |
1980 } | |
1981 | |
1982 loop: | |
1983 | |
1984 /* A system call interrupted with a SIGALRM or SIGIO comes back | |
1985 here, with can_break_system_calls reset to 0. */ | |
1986 SETJMP (break_system_call_jump); | |
1987 if (QUITP) | |
1988 { | |
853 | 1989 QUIT; |
502 | 1990 /* In case something really weird happens ... */ |
1991 } | |
1992 | |
1993 /* Break out of connect with a signal (it isn't otherwise possible). | |
1994 Thus you don't get screwed with a hung network. */ | |
1995 can_break_system_calls = 1; | |
1996 | |
1997 #ifdef USE_GETADDRINFO | |
1998 retval = connect (s, lres->ai_addr, lres->ai_addrlen); | |
1999 #else | |
2000 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); | |
2001 #endif | |
2002 can_break_system_calls = 0; | |
2003 if (retval == -1 && errno != EISCONN) | |
2004 { | |
2005 xerrno = errno; | |
859 | 2006 |
2007 if (errno == EINTR || errno == EINPROGRESS || errno == EALREADY) | |
502 | 2008 goto loop; |
2009 if (errno == EADDRINUSE && retry < 20) | |
2010 { | |
2011 #ifdef __FreeBSD__ | |
2012 /* A delay here is needed on some FreeBSD systems, | |
2013 and it is harmless, since this retrying takes | |
2014 time anyway and should be infrequent. | |
2015 `sleep-for' allowed for quitting this loop with | |
2016 interrupts slowed down so it can't be used | |
2017 here. Async timers should already be disabled | |
2018 at this point so we can use `sleep'. | |
2019 | |
2020 (Again, this was not conditionalized on FreeBSD. | |
854 | 2021 Let's not mess up systems without the problem. --ben) |
502 | 2022 */ |
2023 sleep (1); | |
2024 #endif | |
2025 retry++; | |
2026 goto loop; | |
2027 } | |
2028 | |
2029 failed_connect = 1; | |
771 | 2030 retry_close (s); |
502 | 2031 s = -1; |
2032 continue; | |
2033 } | |
2034 | |
2035 #ifdef USE_GETADDRINFO | |
2036 if (port == 0) | |
2037 { | |
2038 int gni; | |
2039 char servbuf[NI_MAXSERV]; | |
2040 | |
2041 if (EQ (protocol, Qtcp)) | |
2042 gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, | |
2043 NULL, 0, servbuf, sizeof(servbuf), | |
2044 NI_NUMERICSERV); | |
2045 else /* EQ (protocol, Qudp) */ | |
2046 gni = getnameinfo (lres->ai_addr, lres->ai_addrlen, | |
2047 NULL, 0, servbuf, sizeof(servbuf), | |
2048 NI_NUMERICSERV | NI_DGRAM); | |
2049 | |
2050 if (gni == 0) | |
2051 port = strtol (servbuf, NULL, 10); | |
2052 } | |
2053 | |
2054 break; | |
2055 #endif /* USE_GETADDRINFO */ | |
2056 } /* address loop */ | |
2057 | |
2058 #ifdef USE_GETADDRINFO | |
2059 freeaddrinfo (res); | |
2060 #endif | |
428 | 2061 |
440 | 2062 if (s < 0) |
502 | 2063 { |
2064 errno = xerrno; | |
428 | 2065 |
502 | 2066 if (failed_connect) |
563 | 2067 report_network_error ("connection failed", list3 (Qunbound, host, |
2068 name)); | |
502 | 2069 else |
563 | 2070 report_network_error ("error creating socket", name); |
440 | 2071 } |
2072 } | |
428 | 2073 |
2074 inch = s; | |
2075 outch = dup (s); | |
2076 if (outch < 0) | |
2077 { | |
563 | 2078 int save_errno = errno; |
771 | 2079 retry_close (s); /* this used to be leaked; from Kyle Jones */ |
563 | 2080 errno = save_errno; |
2081 report_network_error ("error duplicating socket", name); | |
428 | 2082 } |
2083 | |
2084 set_socket_nonblocking_maybe (inch, port, "tcp"); | |
2085 | |
502 | 2086 *vinfd = (void *) inch; |
2087 *voutfd = (void *) outch; | |
428 | 2088 } |
2089 | |
2090 | |
2091 #ifdef HAVE_MULTICAST | |
2092 | |
442 | 2093 /* Didier Verna <didier@xemacs.org> Nov. 28 1997. |
428 | 2094 |
2095 This function is similar to open-network-stream-internal, but provides a | |
2096 mean to open an UDP multicast connection instead of a TCP one. Like in the | |
2097 TCP case, the multicast connection will be seen as a sub-process, | |
2098 | |
2099 Some notes: | |
2100 - Normally, we should use sendto and recvfrom with non connected | |
2101 sockets. The current code doesn't allow us to do this. In the future, it | |
2102 would be a good idea to extend the process data structure in order to deal | |
2103 properly with the different types network connections. | |
2104 - For the same reason, when leaving a multicast group, it is better to make | |
2105 a setsockopt - IP_DROP_MEMBERSHIP before closing the descriptors. | |
2106 Unfortunately, this can't be done here because delete_process doesn't know | |
2107 about the kind of connection we have. However, this is not such an | |
2108 important issue. | |
2109 */ | |
2110 | |
2111 static void | |
442 | 2112 unix_open_multicast_group (Lisp_Object name, Lisp_Object dest, |
853 | 2113 Lisp_Object port, Lisp_Object ttl, void **vinfd, |
2114 void **voutfd) | |
428 | 2115 { |
2116 struct ip_mreq imr; | |
2117 struct sockaddr_in sa; | |
2118 struct protoent *udp; | |
4123 | 2119 EMACS_INT ws, rs; |
428 | 2120 int theport; |
2121 unsigned char thettl; | |
2122 int one = 1; /* For REUSEADDR */ | |
2123 int ret; | |
2124 volatile int retry = 0; | |
2125 | |
2126 CHECK_STRING (dest); | |
2127 | |
2128 CHECK_NATNUM (port); | |
2129 theport = htons ((unsigned short) XINT (port)); | |
2130 | |
2131 CHECK_NATNUM (ttl); | |
2132 thettl = (unsigned char) XINT (ttl); | |
2133 | |
2134 if ((udp = getprotobyname ("udp")) == NULL) | |
563 | 2135 invalid_operation ("No info available for UDP protocol", Qunbound); |
428 | 2136 |
2137 /* Init the sockets. Yes, I need 2 sockets. I couldn't duplicate one. */ | |
2138 if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) | |
563 | 2139 report_network_error ("error creating socket", name); |
428 | 2140 if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) |
2141 { | |
563 | 2142 int save_errno = errno; |
771 | 2143 retry_close (rs); |
563 | 2144 errno = save_errno; |
2145 report_network_error ("error creating socket", name); | |
428 | 2146 } |
2147 | |
2148 /* This will be used for both sockets */ | |
2149 memset (&sa, 0, sizeof(sa)); | |
2150 sa.sin_family = AF_INET; | |
2151 sa.sin_port = theport; | |
671 | 2152 sa.sin_addr.s_addr = inet_addr ((char *) XSTRING_DATA (dest)); |
428 | 2153 |
2154 /* Socket configuration for reading ------------------------ */ | |
2155 | |
2156 /* Multiple connections from the same machine. This must be done before | |
2157 bind. If it fails, it shouldn't be fatal. The only consequence is that | |
2158 people won't be able to connect twice from the same machine. */ | |
2159 if (setsockopt (rs, SOL_SOCKET, SO_REUSEADDR, (char *) &one, sizeof (one)) | |
2160 < 0) | |
2161 warn_when_safe (Qmulticast, Qwarning, "Cannot reuse socket address"); | |
2162 | |
2163 /* bind socket name */ | |
2164 if (bind (rs, (struct sockaddr *)&sa, sizeof(sa))) | |
2165 { | |
563 | 2166 int save_errno = errno; |
771 | 2167 retry_close (rs); |
2168 retry_close (ws); | |
563 | 2169 errno = save_errno; |
2170 report_network_error ("error binding socket", list3 (Qunbound, name, | |
2171 port)); | |
428 | 2172 } |
2173 | |
2174 /* join multicast group */ | |
671 | 2175 imr.imr_multiaddr.s_addr = inet_addr ((char *) XSTRING_DATA (dest)); |
428 | 2176 imr.imr_interface.s_addr = htonl (INADDR_ANY); |
2177 if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, | |
442 | 2178 &imr, sizeof (struct ip_mreq)) < 0) |
428 | 2179 { |
563 | 2180 int save_errno = errno; |
771 | 2181 retry_close (ws); |
2182 retry_close (rs); | |
563 | 2183 errno = save_errno; |
2184 report_network_error ("error adding membership", list3 (Qunbound, name, | |
2185 dest)); | |
428 | 2186 } |
2187 | |
2188 /* Socket configuration for writing ----------------------- */ | |
2189 | |
2190 /* Normally, there's no 'connect' in multicast, since we prefer to use | |
2191 'sendto' and 'recvfrom'. However, in order to handle this connection in | |
2192 the process-like way it is done for TCP, we must be able to use 'write' | |
2193 instead of 'sendto'. Consequently, we 'connect' this socket. */ | |
2194 | |
2195 /* See open-network-stream-internal for comments on this part of the code */ | |
2196 loop: | |
2197 | |
2198 /* A system call interrupted with a SIGALRM or SIGIO comes back | |
2199 here, with can_break_system_calls reset to 0. */ | |
2200 SETJMP (break_system_call_jump); | |
2201 if (QUITP) | |
2202 { | |
853 | 2203 QUIT; |
428 | 2204 /* In case something really weird happens ... */ |
2205 } | |
2206 | |
2207 /* Break out of connect with a signal (it isn't otherwise possible). | |
2208 Thus you don't get screwed with a hung network. */ | |
2209 can_break_system_calls = 1; | |
2210 ret = connect (ws, (struct sockaddr *) &sa, sizeof (sa)); | |
2211 can_break_system_calls = 0; | |
2212 if (ret == -1 && errno != EISCONN) | |
2213 { | |
2214 int xerrno = errno; | |
2215 | |
859 | 2216 if (errno == EINTR || errno == EINPROGRESS || errno == EALREADY) |
428 | 2217 goto loop; |
2218 if (errno == EADDRINUSE && retry < 20) | |
2219 { | |
859 | 2220 #ifdef __FreeBSD__ |
428 | 2221 /* A delay here is needed on some FreeBSD systems, |
2222 and it is harmless, since this retrying takes time anyway | |
2223 and should be infrequent. | |
2224 `sleep-for' allowed for quitting this loop with interrupts | |
2225 slowed down so it can't be used here. Async timers should | |
2226 already be disabled at this point so we can use `sleep'. */ | |
2227 sleep (1); | |
859 | 2228 #endif |
428 | 2229 retry++; |
2230 goto loop; | |
2231 } | |
2232 | |
771 | 2233 retry_close (rs); |
2234 retry_close (ws); | |
428 | 2235 |
2236 errno = xerrno; | |
563 | 2237 report_network_error ("error connecting socket", list3 (Qunbound, name, |
2238 port)); | |
428 | 2239 } |
2240 | |
2241 /* scope */ | |
2242 if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, | |
442 | 2243 &thettl, sizeof (thettl)) < 0) |
428 | 2244 { |
563 | 2245 int save_errno = errno; |
771 | 2246 retry_close (rs); |
2247 retry_close (ws); | |
563 | 2248 errno = save_errno; |
2249 report_network_error ("error setting ttl", list3 (Qunbound, name, ttl)); | |
428 | 2250 } |
2251 | |
2252 set_socket_nonblocking_maybe (rs, theport, "udp"); | |
2253 | |
2254 *vinfd = (void*)rs; | |
2255 *voutfd = (void*)ws; | |
2256 } | |
2257 | |
2258 #endif /* HAVE_MULTICAST */ | |
2259 | |
2260 #endif /* HAVE_SOCKETS */ | |
2261 | |
2262 | |
2263 /**********************************************************************/ | |
2264 /* Initialization */ | |
2265 /**********************************************************************/ | |
2266 | |
2267 void | |
2268 process_type_create_unix (void) | |
2269 { | |
2270 PROCESS_HAS_METHOD (unix, alloc_process_data); | |
2271 #ifdef SIGCHLD | |
2272 PROCESS_HAS_METHOD (unix, init_process); | |
2273 PROCESS_HAS_METHOD (unix, reap_exited_processes); | |
2274 #endif | |
2275 PROCESS_HAS_METHOD (unix, init_process_io_handles); | |
2276 PROCESS_HAS_METHOD (unix, create_process); | |
2277 PROCESS_HAS_METHOD (unix, tooltalk_connection_p); | |
2278 PROCESS_HAS_METHOD (unix, set_window_size); | |
2279 #ifdef HAVE_WAITPID | |
2280 PROCESS_HAS_METHOD (unix, update_status_if_terminated); | |
2281 #endif | |
2282 PROCESS_HAS_METHOD (unix, send_process); | |
2283 PROCESS_HAS_METHOD (unix, process_send_eof); | |
2284 PROCESS_HAS_METHOD (unix, deactivate_process); | |
2285 PROCESS_HAS_METHOD (unix, kill_child_process); | |
2286 PROCESS_HAS_METHOD (unix, kill_process_by_pid); | |
2287 #ifdef HAVE_SOCKETS | |
2288 PROCESS_HAS_METHOD (unix, canonicalize_host_name); | |
2289 PROCESS_HAS_METHOD (unix, open_network_stream); | |
2290 #ifdef HAVE_MULTICAST | |
2291 PROCESS_HAS_METHOD (unix, open_multicast_group); | |
2292 #endif | |
2293 #endif | |
2294 } | |
2295 | |
2296 void | |
2297 vars_of_process_unix (void) | |
2298 { | |
2299 Fprovide (intern ("unix-processes")); | |
2300 } |