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