Mercurial > hg > xemacs-beta

comparison src/process-unix.c @ 771:943eaba38521

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.
author ben
date Wed, 13 Mar 2002 08:54:06 +0000
parents 76d5a3dd827a
children e38acbeb1cae
comparison
equal deleted inserted replaced
770:336a418893b5 771:943eaba38521
1 /* Asynchronous subprocess implementation for UNIX 1 /* Asynchronous subprocess implementation for UNIX
2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995 2 Copyright (C) 1985, 1986, 1987, 1988, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 Copyright (C) 1995 Sun Microsystems, Inc. 4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Copyright (C) 1995, 1996 Ben Wing. 5 Copyright (C) 1995, 1996, 2001 Ben Wing.
6 6
7 This file is part of XEmacs. 7 This file is part of XEmacs.
8 8
9 XEmacs is free software; you can redistribute it and/or modify it 9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the 10 under the terms of the GNU General Public License as published by the
19 You should have received a copy of the GNU General Public License 19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to 20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, 21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */ 22 Boston, MA 02111-1307, USA. */
23 23
24 /* This file has been Mule-ized except for `start-process-internal', 24 /* Mule-ized as of 6-14-00 */
25 `open-network-stream-internal' and `open-multicast-group-internal'. */
26 25
27 /* This file has been split into process.c and process-unix.c by 26 /* This file has been split into process.c and process-unix.c by
28 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not 27 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
29 the original author(s) */ 28 the original author(s) */
30 29
47 #include "opaque.h" 46 #include "opaque.h"
48 #include "process.h" 47 #include "process.h"
49 #include "procimpl.h" 48 #include "procimpl.h"
50 #include "sysdep.h" 49 #include "sysdep.h"
51 #include "window.h" 50 #include "window.h"
52 #ifdef FILE_CODING
53 #include "file-coding.h" 51 #include "file-coding.h"
54 #endif
55 52
56 #include <setjmp.h> 53 #include <setjmp.h>
57 #include "sysfile.h" 54 #include "sysfile.h"
58 #include "sysproc.h" 55 #include "sysproc.h"
59 #include "systime.h" 56 #include "systime.h"
108 close_safely (int fd) 105 close_safely (int fd)
109 { 106 {
110 stop_interrupts (); 107 stop_interrupts ();
111 set_timeout_signal (SIGALRM, close_safely_handler); 108 set_timeout_signal (SIGALRM, close_safely_handler);
112 alarm (1); 109 alarm (1);
113 close (fd); 110 retry_close (fd);
114 alarm (0); 111 alarm (0);
115 start_interrupts (); 112 start_interrupts ();
116 } 113 }
117 114
118 static void 115 static void
119 close_descriptor_pair (int in, int out) 116 close_descriptor_pair (int in, int out)
120 { 117 {
121 if (in >= 0) 118 if (in >= 0)
122 close (in); 119 retry_close (in);
123 if (out != in && out >= 0) 120 if (out != in && out >= 0)
124 close (out); 121 retry_close (out);
125 } 122 }
126 123
127 /* Close all descriptors currently in use for communication 124 /* Close all descriptors currently in use for communication
128 with subprocess. This is used in a newly-forked subprocess 125 with subprocess. This is used in a newly-forked subprocess
129 to get rid of irrelevant descriptors. */ 126 to get rid of irrelevant descriptors. */
202 199
203 /* The file name of the (slave) pty opened by allocate_pty(). */ 200 /* The file name of the (slave) pty opened by allocate_pty(). */
204 #ifndef MAX_PTYNAME_LEN 201 #ifndef MAX_PTYNAME_LEN
205 #define MAX_PTYNAME_LEN 64 202 #define MAX_PTYNAME_LEN 64
206 #endif 203 #endif
207 static char pty_name[MAX_PTYNAME_LEN]; 204 static Intbyte pty_name[MAX_PTYNAME_LEN];
208 205
209 /* Open an available pty, returning a file descriptor. 206 /* Open an available pty, returning a file descriptor.
210 Return -1 on failure. 207 Return -1 on failure.
211 The file name of the terminal corresponding to the pty 208 The file name of the terminal corresponding to the pty
212 is left in the variable `pty_name'. */ 209 is left in the variable `pty_name'. */
223 220
224 allocate_pty() tries all the different known easy ways of opening 221 allocate_pty() tries all the different known easy ways of opening
225 a pty. In case of failure, we resort to the old BSD-style pty 222 a pty. In case of failure, we resort to the old BSD-style pty
226 grovelling code in allocate_pty_the_old_fashioned_way(). */ 223 grovelling code in allocate_pty_the_old_fashioned_way(). */
227 int master_fd = -1; 224 int master_fd = -1;
228 const char *slave_name = NULL; 225 const Extbyte *slave_name = NULL;
229 const char *clone = NULL; 226 const CIntbyte *clone = NULL;
230 static const char * const clones[] = /* Different pty master clone devices */ 227 static const CIntbyte * const clones[] =
228 /* Different pty master clone devices */
231 { 229 {
232 "/dev/ptmx", /* Various systems */ 230 "/dev/ptmx", /* Various systems */
233 "/dev/ptm/clone", /* HPUX */ 231 "/dev/ptm/clone", /* HPUX */
234 "/dev/ptc", /* AIX */ 232 "/dev/ptc", /* AIX */
235 "/dev/ptmx_bsd" /* Tru64 */ 233 "/dev/ptmx_bsd" /* Tru64 */
250 rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL); 248 rc = openpty (&master_fd, &slave_fd, NULL, NULL, NULL);
251 EMACS_UNBLOCK_SIGNAL (SIGCHLD); 249 EMACS_UNBLOCK_SIGNAL (SIGCHLD);
252 if (rc == 0) 250 if (rc == 0)
253 { 251 {
254 slave_name = ttyname (slave_fd); 252 slave_name = ttyname (slave_fd);
255 close (slave_fd); 253 retry_close (slave_fd);
256 goto have_slave_name; 254 goto have_slave_name;
257 } 255 }
258 else 256 else
259 { 257 {
260 if (master_fd >= 0) 258 if (master_fd >= 0)
261 close (master_fd); 259 retry_close (master_fd);
262 if (slave_fd >= 0) 260 if (slave_fd >= 0)
263 close (slave_fd); 261 retry_close (slave_fd);
264 } 262 }
265 } 263 }
266 #endif /* HAVE_OPENPTY */ 264 #endif /* HAVE_OPENPTY */
267 265
268 #if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */ 266 #if defined(HAVE__GETPTY) && defined (O_NDELAY) /* SGI */
278 { 276 {
279 int i; 277 int i;
280 for (i = 0; i < countof (clones); i++) 278 for (i = 0; i < countof (clones); i++)
281 { 279 {
282 clone = clones[i]; 280 clone = clones[i];
283 master_fd = open (clone, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); 281 master_fd = qxe_open ((Intbyte *) clone,
282 O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
284 if (master_fd >= 0) 283 if (master_fd >= 0)
285 goto have_master; 284 goto have_master;
286 } 285 }
287 clone = NULL; 286 clone = NULL;
288 } 287 }
304 goto have_slave_name; 303 goto have_slave_name;
305 304
306 goto lose; 305 goto lose;
307 306
308 have_slave_name: 307 have_slave_name:
309 strncpy (pty_name, slave_name, sizeof (pty_name)); 308 {
309 Intbyte *slaveint;
310
311 EXTERNAL_TO_C_STRING (slave_name, slaveint, Qfile_name);
312 qxestrncpy (pty_name, slaveint, sizeof (pty_name));
313 }
314
310 pty_name[sizeof (pty_name) - 1] = '\0'; 315 pty_name[sizeof (pty_name) - 1] = '\0';
311 setup_pty (master_fd); 316 setup_pty (master_fd);
312 317
313 /* We jump through some hoops to frob the pty. 318 /* We jump through some hoops to frob the pty.
314 It's not obvious that checking the return code here is useful. */ 319 It's not obvious that checking the return code here is useful. */
327 specified in the man page: the group of the slave PTY is set to 332 specified in the man page: the group of the slave PTY is set to
328 the user's primary group, and we fix that. */ 333 the user's primary group, and we fix that. */
329 { 334 {
330 struct group *tty_group = getgrnam ("tty"); 335 struct group *tty_group = getgrnam ("tty");
331 if (tty_group != NULL) 336 if (tty_group != NULL)
332 chown (pty_name, (uid_t) -1, tty_group->gr_gid); 337 {
338 Extbyte *ptyout;
339
340 C_STRING_TO_EXTERNAL (pty_name, ptyout, Qfile_name);
341 chown (ptyout, (uid_t) -1, tty_group->gr_gid);
342 }
333 } 343 }
334 #endif /* HPUX has broken grantpt() */ 344 #endif /* HPUX has broken grantpt() */
335 #endif /* HAVE_GRANTPT */ 345 #endif /* HAVE_GRANTPT */
336 346
337 #if defined (HAVE_UNLOCKPT) 347 #if defined (HAVE_UNLOCKPT)
343 353
344 return master_fd; 354 return master_fd;
345 355
346 lose: 356 lose:
347 if (master_fd >= 0) 357 if (master_fd >= 0)
348 close (master_fd); 358 retry_close (master_fd);
349 return allocate_pty_the_old_fashioned_way (); 359 return allocate_pty_the_old_fashioned_way ();
350 } 360 }
351 361
352 /* This function tries to allocate a pty by iterating through file 362 /* This function tries to allocate a pty by iterating through file
353 pairs with names like /dev/ptyp1 and /dev/ttyp1. */ 363 pairs with names like /dev/ptyp1 and /dev/ttyp1. */
378 388
379 { 389 {
380 #ifdef PTY_NAME_SPRINTF 390 #ifdef PTY_NAME_SPRINTF
381 PTY_NAME_SPRINTF 391 PTY_NAME_SPRINTF
382 #else 392 #else
383 sprintf (pty_name, "/dev/pty%c%x", c, i); 393 qxesprintf (pty_name, "/dev/pty%c%x", c, i);
384 #endif /* no PTY_NAME_SPRINTF */ 394 #endif /* no PTY_NAME_SPRINTF */
385 395
386 if (xemacs_stat (pty_name, &stb) < 0) 396 if (qxe_stat (pty_name, &stb) < 0)
387 { 397 {
388 if (++failed_count >= 3) 398 if (++failed_count >= 3)
389 return -1; 399 return -1;
390 } 400 }
391 else 401 else
392 failed_count = 0; 402 failed_count = 0;
393 fd = open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0); 403 fd = qxe_open (pty_name, O_RDWR | O_NONBLOCK | OPEN_BINARY, 0);
394 404
395 if (fd >= 0) 405 if (fd >= 0)
396 { 406 {
397 #ifdef PTY_TTY_NAME_SPRINTF 407 #ifdef PTY_TTY_NAME_SPRINTF
398 PTY_TTY_NAME_SPRINTF 408 PTY_TTY_NAME_SPRINTF
399 #else 409 #else
400 sprintf (pty_name, "/dev/tty%c%x", c, i); 410 qxesprintf (pty_name, "/dev/tty%c%x", c, i);
401 #endif /* no PTY_TTY_NAME_SPRINTF */ 411 #endif /* no PTY_TTY_NAME_SPRINTF */
402 if (access (pty_name, R_OK | W_OK) == 0) 412 if (qxe_access (pty_name, R_OK | W_OK) == 0)
403 { 413 {
404 setup_pty (fd); 414 setup_pty (fd);
405 return fd; 415 return fd;
406 } 416 }
407 close (fd); 417 retry_close (fd);
408 } 418 }
409 } /* iteration */ 419 } /* iteration */
410 return -1; 420 return -1;
411 } 421 }
412 422
450 460
451 xzero (*address); 461 xzero (*address);
452 462
453 while (1) 463 while (1)
454 { 464 {
465 Extbyte *hostext;
466
455 #ifdef TRY_AGAIN 467 #ifdef TRY_AGAIN
456 if (count++ > 10) break; 468 if (count++ > 10) break;
457 h_errno = 0; 469 h_errno = 0;
458 #endif 470 #endif
471
472 TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, hostext,
473 Qnative);
474
459 /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */ 475 /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */
460 slow_down_interrupts (); 476 slow_down_interrupts ();
461 host_info_ptr = gethostbyname ((char *) XSTRING_DATA (host)); 477 host_info_ptr = gethostbyname (hostext);
462 speed_up_interrupts (); 478 speed_up_interrupts ();
463 #ifdef TRY_AGAIN 479 #ifdef TRY_AGAIN
464 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) 480 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
465 #endif 481 #endif
466 break; 482 break;
506 Lisp_Object tail_port = XCAR (tail); 522 Lisp_Object tail_port = XCAR (tail);
507 523
508 if (STRINGP (tail_port)) 524 if (STRINGP (tail_port))
509 { 525 {
510 struct servent *svc_info; 526 struct servent *svc_info;
527 Extbyte *tailportext;
528
511 CHECK_STRING (tail_port); 529 CHECK_STRING (tail_port);
512 svc_info = getservbyname ((char *) XSTRING_DATA (tail_port), proto); 530 TO_EXTERNAL_FORMAT (LISP_STRING, tail_port, C_STRING_ALLOCA,
531 tailportext, Qnative);
532
533 svc_info = getservbyname (tailportext, proto);
513 if ((svc_info != 0) && (svc_info->s_port == port)) 534 if ((svc_info != 0) && (svc_info->s_port == port))
514 break; 535 break;
515 else 536 else
516 continue; 537 continue;
517 } 538 }
867 /* On USG systems it does not work to open the pty's tty here 888 /* On USG systems it does not work to open the pty's tty here
868 and then close and reopen it in the child. */ 889 and then close and reopen it in the child. */
869 #ifdef O_NOCTTY 890 #ifdef O_NOCTTY
870 /* Don't let this terminal become our controlling terminal 891 /* Don't let this terminal become our controlling terminal
871 (in case we don't have one). */ 892 (in case we don't have one). */
872 forkout = forkin = open (pty_name, O_RDWR | O_NOCTTY | OPEN_BINARY, 0); 893 forkout = forkin = qxe_open (pty_name,
894 O_RDWR | O_NOCTTY | OPEN_BINARY, 0);
873 #else 895 #else
874 forkout = forkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); 896 forkout = forkin = qxe_open (pty_name, O_RDWR | OPEN_BINARY, 0);
875 #endif 897 #endif
876 if (forkin < 0) 898 if (forkin < 0)
877 goto io_failure; 899 goto io_failure;
878 #endif /* not USG */ 900 #endif /* not USG */
879 UNIX_DATA(p)->pty_flag = pty_flag = 1; 901 UNIX_DATA(p)->pty_flag = pty_flag = 1;
897 pty_flag ? STREAM_PTY_FLUSHING : 0); 919 pty_flag ? STREAM_PTY_FLUSHING : 0);
898 /* Record the tty descriptor used in the subprocess. */ 920 /* Record the tty descriptor used in the subprocess. */
899 UNIX_DATA(p)->subtty = forkin; 921 UNIX_DATA(p)->subtty = forkin;
900 922
901 { 923 {
902 #if !defined(CYGWIN)
903 /* child_setup must clobber environ on systems with true vfork.
904 Protect it from permanent change. */
905 char **save_environ = environ;
906 #endif
907
908 pid = fork (); 924 pid = fork ();
909 if (pid == 0) 925 if (pid == 0)
910 { 926 {
911 /**** Now we're in the child process ****/ 927 /**** Now we're in the child process ****/
912 int xforkin = forkin; 928 int xforkin = forkin;
953 969
954 # if defined (USG) || !defined (TIOCSCTTY) 970 # if defined (USG) || !defined (TIOCSCTTY)
955 /* Now close the pty (if we had it open) and reopen it. 971 /* Now close the pty (if we had it open) and reopen it.
956 This makes the pty the controlling terminal of the 972 This makes the pty the controlling terminal of the
957 subprocess. */ 973 subprocess. */
958 /* I wonder if close (open (pty_name, ...)) would work? */ 974 /* I wonder if retry_close (qxe_open (pty_name, ...)) would work? */
959 if (xforkin >= 0) 975 if (xforkin >= 0)
960 close (xforkin); 976 retry_close (xforkin);
961 xforkout = xforkin = open (pty_name, O_RDWR | OPEN_BINARY, 0); 977 xforkout = xforkin = qxe_open (pty_name, O_RDWR | OPEN_BINARY, 0);
962 if (xforkin < 0) 978 if (xforkin < 0)
963 { 979 {
964 write (1, "Couldn't open the pty terminal ", 31); 980 retry_write (1, "Couldn't open the pty terminal ", 31);
965 write (1, pty_name, strlen (pty_name)); 981 retry_write (1, pty_name, qxestrlen (pty_name));
966 write (1, "\n", 1); 982 retry_write (1, "\n", 1);
967 _exit (1); 983 _exit (1);
968 } 984 }
969 # endif /* USG or not TIOCSCTTY */ 985 # endif /* USG or not TIOCSCTTY */
970 986
971 /* Miscellaneous setup required for some systems. 987 /* Miscellaneous setup required for some systems.
1041 1057
1042 EMACS_SIGNAL (SIGINT, SIG_DFL); 1058 EMACS_SIGNAL (SIGINT, SIG_DFL);
1043 EMACS_SIGNAL (SIGQUIT, SIG_DFL); 1059 EMACS_SIGNAL (SIGQUIT, SIG_DFL);
1044 1060
1045 { 1061 {
1046 char *current_dir; 1062 Intbyte **new_argv = alloca_array (Intbyte *, nargv + 2);
1047 char **new_argv = alloca_array (char *, nargv + 2);
1048 int i; 1063 int i;
1049 1064
1050 /* Nothing below here GCs so our string pointers shouldn't move. */ 1065 /* Nothing below here GCs so our string pointers shouldn't move. */
1051 new_argv[0] = (char *) XSTRING_DATA (program); 1066 new_argv[0] = XSTRING_DATA (program);
1052 for (i = 0; i < nargv; i++) 1067 for (i = 0; i < nargv; i++)
1053 { 1068 {
1054 CHECK_STRING (argv[i]); 1069 CHECK_STRING (argv[i]);
1055 new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]); 1070 new_argv[i + 1] = XSTRING_DATA (argv[i]);
1056 } 1071 }
1057 new_argv[i + 1] = 0; 1072 new_argv[i + 1] = 0;
1058 1073
1059 LISP_STRING_TO_EXTERNAL (cur_dir, current_dir, Qfile_name); 1074 child_setup (xforkin, xforkout, xforkout, new_argv, cur_dir);
1060
1061 child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
1062 } 1075 }
1063 1076
1064 } /**** End of child code ****/ 1077 } /**** End of child code ****/
1065 1078
1066 /**** Back in parent process ****/ 1079 /**** Back in parent process ****/
1067 #if !defined(CYGWIN)
1068 environ = save_environ;
1069 #endif
1070 } 1080 }
1071 1081
1072 if (pid < 0) 1082 if (pid < 0)
1073 { 1083 {
1074 int save_errno = errno; 1084 int save_errno = errno;
1085 this close hangs. I don't know why. 1095 this close hangs. I don't know why.
1086 So have an interrupt jar it loose. */ 1096 So have an interrupt jar it loose. */
1087 if (forkin >= 0) 1097 if (forkin >= 0)
1088 close_safely (forkin); 1098 close_safely (forkin);
1089 if (forkin != forkout && forkout >= 0) 1099 if (forkin != forkout && forkout >= 0)
1090 close (forkout); 1100 retry_close (forkout);
1091 1101
1092 UNIX_DATA (p)->tty_name = pty_flag ? build_string (pty_name) : Qnil; 1102 UNIX_DATA (p)->tty_name = pty_flag ? build_intstring (pty_name) : Qnil;
1093 1103
1094 /* Notice that SIGCHLD was not blocked. (This is not possible on 1104 /* Notice that SIGCHLD was not blocked. (This is not possible on
1095 some systems.) No biggie if SIGCHLD occurs right around the 1105 some systems.) No biggie if SIGCHLD occurs right around the
1096 time that this call happens, because SIGCHLD() does not actually 1106 time that this call happens, because SIGCHLD() does not actually
1097 deselect the process (that doesn't occur until the next time 1107 deselect the process (that doesn't occur until the next time
1278 Intbyte chunkbuf[512]; 1288 Intbyte chunkbuf[512];
1279 Bytecount chunklen; 1289 Bytecount chunklen;
1280 1290
1281 while (1) 1291 while (1)
1282 { 1292 {
1283 Bytecount writeret; 1293 int writeret;
1284 1294
1285 chunklen = Lstream_read (lstream, chunkbuf, 512); 1295 chunklen = Lstream_read (lstream, chunkbuf, 512);
1286 if (chunklen <= 0) 1296 if (chunklen <= 0)
1287 break; /* perhaps should abort() if < 0? 1297 break; /* perhaps should abort() if < 0?
1288 This should never happen. */ 1298 This should never happen. */
1403 try_to_initialize_subtty (struct unix_process_data *upd) 1413 try_to_initialize_subtty (struct unix_process_data *upd)
1404 { 1414 {
1405 if (upd->pty_flag 1415 if (upd->pty_flag
1406 && (upd->subtty == -1 || ! isatty (upd->subtty)) 1416 && (upd->subtty == -1 || ! isatty (upd->subtty))
1407 && STRINGP (upd->tty_name)) 1417 && STRINGP (upd->tty_name))
1408 upd->subtty = open ((char *) XSTRING_DATA (upd->tty_name), O_RDWR, 0); 1418 upd->subtty = qxe_open (XSTRING_DATA (upd->tty_name), O_RDWR, 0);
1409 } 1419 }
1410 1420
1411 /* Send signal number SIGNO to PROCESS. 1421 /* Send signal number SIGNO to PROCESS.
1412 CURRENT_GROUP means send to the process group that currently owns 1422 CURRENT_GROUP means send to the process group that currently owns
1413 the terminal being used to communicate with PROCESS. 1423 the terminal being used to communicate with PROCESS.
1595 retval = getaddrinfo (ext_host, NULL, &hints, &res); 1605 retval = getaddrinfo (ext_host, NULL, &hints, &res);
1596 if (retval != 0) 1606 if (retval != 0)
1597 { 1607 {
1598 CIntbyte *gai_error; 1608 CIntbyte *gai_error;
1599 1609
1600 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative); 1610 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error,
1611 Qstrerror_encoding);
1601 maybe_signal_error (Qio_error, gai_error, host, 1612 maybe_signal_error (Qio_error, gai_error, host,
1602 Qprocess, ERROR_ME_NOT); 1613 Qprocess, ERROR_ME_NOT);
1603 canonname = host; 1614 canonname = host;
1604 } 1615 }
1605 else 1616 else
1655 { 1666 {
1656 #ifdef USE_GETADDRINFO 1667 #ifdef USE_GETADDRINFO
1657 1668
1658 struct addrinfo hints, *res; 1669 struct addrinfo hints, *res;
1659 struct addrinfo * volatile lres; 1670 struct addrinfo * volatile lres;
1660 char *portstring; 1671 Extbyte *portstring;
1661 char *ext_host; 1672 Extbyte *ext_host;
1673 Extbyte portbuf[128];
1662 /* 1674 /*
1663 * Caution: service can either be a string or int. 1675 * Caution: service can either be a string or int.
1664 * Convert to a C string for later use by getaddrinfo. 1676 * Convert to a C string for later use by getaddrinfo.
1665 */ 1677 */
1666 if (INTP (service)) 1678 if (INTP (service))
1667 { 1679 {
1668 char portbuf[128];
1669 snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service)); 1680 snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service));
1670 portstring = portbuf; 1681 portstring = portbuf;
1671 port = htons ((unsigned short) XINT (service)); 1682 port = htons ((unsigned short) XINT (service));
1672 } 1683 }
1673 else 1684 else
1674 { 1685 {
1675 CHECK_STRING (service); 1686 CHECK_STRING (service);
1676 LISP_STRING_TO_EXTERNAL (service, portstring, Qnative); 1687 LISP_STRING_TO_EXTERNAL (service, portstring,
1688 Qunix_service_name_encoding);
1677 port = 0; 1689 port = 0;
1678 } 1690 }
1679 1691
1680 xzero (hints); 1692 xzero (hints);
1681 hints.ai_flags = 0; 1693 hints.ai_flags = 0;
1683 if (EQ (protocol, Qtcp)) 1695 if (EQ (protocol, Qtcp))
1684 hints.ai_socktype = SOCK_STREAM; 1696 hints.ai_socktype = SOCK_STREAM;
1685 else /* EQ (protocol, Qudp) */ 1697 else /* EQ (protocol, Qudp) */
1686 hints.ai_socktype = SOCK_DGRAM; 1698 hints.ai_socktype = SOCK_DGRAM;
1687 hints.ai_protocol = 0; 1699 hints.ai_protocol = 0;
1688 LISP_STRING_TO_EXTERNAL (host, ext_host, Qnative); 1700 LISP_STRING_TO_EXTERNAL (host, ext_host, Qunix_host_name_encoding);
1689 retval = getaddrinfo (ext_host, portstring, &hints, &res); 1701 retval = getaddrinfo (ext_host, portstring, &hints, &res);
1690 if (retval != 0) 1702 if (retval != 0)
1691 { 1703 {
1692 CIntbyte *gai_error; 1704 CIntbyte *gai_error;
1693 1705
1694 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error, Qnative); 1706 EXTERNAL_TO_C_STRING (gai_strerror (retval), gai_error,
1707 Qstrerror_encoding);
1695 signal_error (Qio_error, gai_error, list2 (host, service)); 1708 signal_error (Qio_error, gai_error, list2 (host, service));
1696 } 1709 }
1697 1710
1698 /* address loop */ 1711 /* address loop */
1699 for (lres = res; lres ; lres = lres->ai_next) 1712 for (lres = res; lres ; lres = lres->ai_next)
1706 if (INTP (service)) 1719 if (INTP (service))
1707 port = htons ((unsigned short) XINT (service)); 1720 port = htons ((unsigned short) XINT (service));
1708 else 1721 else
1709 { 1722 {
1710 struct servent *svc_info; 1723 struct servent *svc_info;
1724 Extbyte *servext;
1725
1711 CHECK_STRING (service); 1726 CHECK_STRING (service);
1727 LISP_STRING_TO_EXTERNAL (service, servext,
1728 Qunix_service_name_encoding);
1712 1729
1713 if (EQ (protocol, Qtcp)) 1730 if (EQ (protocol, Qtcp))
1714 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); 1731 svc_info = getservbyname (servext, "tcp");
1715 else /* EQ (protocol, Qudp) */ 1732 else /* EQ (protocol, Qudp) */
1716 svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp"); 1733 svc_info = getservbyname (servext, "udp");
1717 1734
1718 if (svc_info == 0) 1735 if (svc_info == 0)
1719 invalid_argument ("Unknown service", service); 1736 invalid_argument ("Unknown service", service);
1720 port = svc_info->s_port; 1737 port = svc_info->s_port;
1721 } 1738 }
1809 retry++; 1826 retry++;
1810 goto loop; 1827 goto loop;
1811 } 1828 }
1812 1829
1813 failed_connect = 1; 1830 failed_connect = 1;
1814 close (s); 1831 retry_close (s);
1815 s = -1; 1832 s = -1;
1816 1833
1817 #ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS 1834 #ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS
1818 speed_up_interrupts (); 1835 speed_up_interrupts ();
1819 #endif 1836 #endif
1867 inch = s; 1884 inch = s;
1868 outch = dup (s); 1885 outch = dup (s);
1869 if (outch < 0) 1886 if (outch < 0)
1870 { 1887 {
1871 int save_errno = errno; 1888 int save_errno = errno;
1872 close (s); /* this used to be leaked; from Kyle Jones */ 1889 retry_close (s); /* this used to be leaked; from Kyle Jones */
1873 errno = save_errno; 1890 errno = save_errno;
1874 report_network_error ("error duplicating socket", name); 1891 report_network_error ("error duplicating socket", name);
1875 } 1892 }
1876 1893
1877 set_socket_nonblocking_maybe (inch, port, "tcp"); 1894 set_socket_nonblocking_maybe (inch, port, "tcp");
1931 if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) 1948 if ((rs = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
1932 report_network_error ("error creating socket", name); 1949 report_network_error ("error creating socket", name);
1933 if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0) 1950 if ((ws = socket (PF_INET, SOCK_DGRAM, udp->p_proto)) < 0)
1934 { 1951 {
1935 int save_errno = errno; 1952 int save_errno = errno;
1936 close (rs); 1953 retry_close (rs);
1937 errno = save_errno; 1954 errno = save_errno;
1938 report_network_error ("error creating socket", name); 1955 report_network_error ("error creating socket", name);
1939 } 1956 }
1940 1957
1941 /* This will be used for both sockets */ 1958 /* This will be used for both sockets */
1955 1972
1956 /* bind socket name */ 1973 /* bind socket name */
1957 if (bind (rs, (struct sockaddr *)&sa, sizeof(sa))) 1974 if (bind (rs, (struct sockaddr *)&sa, sizeof(sa)))
1958 { 1975 {
1959 int save_errno = errno; 1976 int save_errno = errno;
1960 close (rs); 1977 retry_close (rs);
1961 close (ws); 1978 retry_close (ws);
1962 errno = save_errno; 1979 errno = save_errno;
1963 report_network_error ("error binding socket", list3 (Qunbound, name, 1980 report_network_error ("error binding socket", list3 (Qunbound, name,
1964 port)); 1981 port));
1965 } 1982 }
1966 1983
1969 imr.imr_interface.s_addr = htonl (INADDR_ANY); 1986 imr.imr_interface.s_addr = htonl (INADDR_ANY);
1970 if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP, 1987 if (setsockopt (rs, IPPROTO_IP, IP_ADD_MEMBERSHIP,
1971 &imr, sizeof (struct ip_mreq)) < 0) 1988 &imr, sizeof (struct ip_mreq)) < 0)
1972 { 1989 {
1973 int save_errno = errno; 1990 int save_errno = errno;
1974 close (ws); 1991 retry_close (ws);
1975 close (rs); 1992 retry_close (rs);
1976 errno = save_errno; 1993 errno = save_errno;
1977 report_network_error ("error adding membership", list3 (Qunbound, name, 1994 report_network_error ("error adding membership", list3 (Qunbound, name,
1978 dest)); 1995 dest));
1979 } 1996 }
1980 1997
2029 sleep (1); 2046 sleep (1);
2030 retry++; 2047 retry++;
2031 goto loop; 2048 goto loop;
2032 } 2049 }
2033 2050
2034 close (rs); 2051 retry_close (rs);
2035 close (ws); 2052 retry_close (ws);
2036 #ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS 2053 #ifdef CONNECT_NEEDS_SLOWED_INTERRUPTS
2037 speed_up_interrupts (); 2054 speed_up_interrupts ();
2038 #endif 2055 #endif
2039 2056
2040 errno = xerrno; 2057 errno = xerrno;
2049 /* scope */ 2066 /* scope */
2050 if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL, 2067 if (setsockopt (ws, IPPROTO_IP, IP_MULTICAST_TTL,
2051 &thettl, sizeof (thettl)) < 0) 2068 &thettl, sizeof (thettl)) < 0)
2052 { 2069 {
2053 int save_errno = errno; 2070 int save_errno = errno;
2054 close (rs); 2071 retry_close (rs);
2055 close (ws); 2072 retry_close (ws);
2056 errno = save_errno; 2073 errno = save_errno;
2057 report_network_error ("error setting ttl", list3 (Qunbound, name, ttl)); 2074 report_network_error ("error setting ttl", list3 (Qunbound, name, ttl));
2058 } 2075 }
2059 2076
2060 set_socket_nonblocking_maybe (rs, theport, "udp"); 2077 set_socket_nonblocking_maybe (rs, theport, "udp");