comparison src/process-unix.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 4af0ddfb7c5b
children 2f8bb876ab1d
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
25 `open-network-stream-internal' and `open-multicast-group-internal'. */ 25 `open-network-stream-internal' and `open-multicast-group-internal'. */
26 26
27 /* This file has been split into process.c and process-unix.c by 27 /* This file has been split into process.c and process-unix.c by
28 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not 28 Kirill M. Katsnelson <kkm@kis.ru>, so please bash him and not
29 the original author(s) */ 29 the original author(s) */
30
31 /* The IPv6 support is derived from the code for GNU Emacs-20.3
32 written by Wolfgang S. Rupprecht */
30 33
31 #include <config.h> 34 #include <config.h>
32 35
33 #if !defined (NO_SUBPROCESSES) 36 #if !defined (NO_SUBPROCESSES)
34 37
122 /* Close all descriptors currently in use for communication 125 /* Close all descriptors currently in use for communication
123 with subprocess. This is used in a newly-forked subprocess 126 with subprocess. This is used in a newly-forked subprocess
124 to get rid of irrelevant descriptors. */ 127 to get rid of irrelevant descriptors. */
125 128
126 static int 129 static int
127 close_process_descs_mapfun (CONST void* key, void* contents, void* arg) 130 close_process_descs_mapfun (const void* key, void* contents, void* arg)
128 { 131 {
129 Lisp_Object proc; 132 Lisp_Object proc;
130 CVOID_TO_LISP (proc, contents); 133 CVOID_TO_LISP (proc, contents);
131 event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream, 134 event_stream_delete_stream_pair (XPROCESS(proc)->pipe_instream,
132 XPROCESS(proc)->pipe_outstream); 135 XPROCESS(proc)->pipe_outstream);
210 are no pseudoterminals with names ending in 'f'. So we wait for 213 are no pseudoterminals with names ending in 'f'. So we wait for
211 three failures in a row before deciding that we've reached the 214 three failures in a row before deciding that we've reached the
212 end of the ptys. */ 215 end of the ptys. */
213 int failed_count = 0; 216 int failed_count = 0;
214 #endif 217 #endif
218 int fd;
219 #ifndef HAVE_GETPT
215 int i; 220 int i;
216 int fd;
217 int c; 221 int c;
222 #endif
218 223
219 #ifdef PTY_ITERATION 224 #ifdef PTY_ITERATION
220 PTY_ITERATION 225 PTY_ITERATION
221 #else 226 #else
222 for (c = FIRST_PTY_LETTER; c <= 'z'; c++) 227 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
259 #ifdef PTY_TTY_NAME_SPRINTF 264 #ifdef PTY_TTY_NAME_SPRINTF
260 PTY_TTY_NAME_SPRINTF 265 PTY_TTY_NAME_SPRINTF
261 #else 266 #else
262 sprintf (pty_name, "/dev/tty%c%x", c, i); 267 sprintf (pty_name, "/dev/tty%c%x", c, i);
263 #endif /* no PTY_TTY_NAME_SPRINTF */ 268 #endif /* no PTY_TTY_NAME_SPRINTF */
264 #ifndef UNIPLUS 269 #if !defined(UNIPLUS) && !defined(HAVE_GETPT)
265 if (access (pty_name, 6) != 0) 270 if (access (pty_name, 6) != 0)
266 { 271 {
267 close (fd); 272 close (fd);
268 #if !defined(IRIS) && !defined(__sgi) 273 #if !defined(IRIS) && !defined(__sgi)
269 continue; 274 continue;
306 } 311 }
307 312
308 313
309 #ifdef HAVE_SOCKETS 314 #ifdef HAVE_SOCKETS
310 315
316 #if !(defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO))
311 static int 317 static int
312 get_internet_address (Lisp_Object host, struct sockaddr_in *address, 318 get_internet_address (Lisp_Object host, struct sockaddr_in *address,
313 Error_behavior errb) 319 Error_behavior errb)
314 { 320 {
315 struct hostent *host_info_ptr = NULL; 321 struct hostent *host_info_ptr = NULL;
361 * (IN_ADDR *) &address->sin_addr = numeric_addr; 367 * (IN_ADDR *) &address->sin_addr = numeric_addr;
362 } 368 }
363 369
364 return 1; 370 return 1;
365 } 371 }
372 #endif /* !(HAVE_GETADDRINFO && HAVE_GETNAMEINFO) */
366 373
367 static void 374 static void
368 set_socket_nonblocking_maybe (int fd, int port, CONST char* proto) 375 set_socket_nonblocking_maybe (int fd, int port, const char* proto)
369 { 376 {
370 #ifdef PROCESS_IO_BLOCKING 377 #ifdef PROCESS_IO_BLOCKING
371 Lisp_Object tail; 378 Lisp_Object tail;
372 379
373 for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail)) 380 for (tail = network_stream_blocking_port_list; CONSP (tail); tail = XCDR (tail))
382 if ((svc_info != 0) && (svc_info->s_port == port)) 389 if ((svc_info != 0) && (svc_info->s_port == port))
383 break; 390 break;
384 else 391 else
385 continue; 392 continue;
386 } 393 }
387 else if ((INTP (tail_port)) && (htons ((unsigned short) XINT (tail_port)) == port)) 394 else if (INTP (tail_port) && (htons ((unsigned short) XINT (tail_port)) == port))
388 break; 395 break;
389 } 396 }
390 397
391 if (!CONSP (tail)) 398 if (!CONSP (tail))
392 { 399 {
401 408
402 /* Compute the Lisp form of the process status from 409 /* Compute the Lisp form of the process status from
403 the numeric status that was returned by `wait'. */ 410 the numeric status that was returned by `wait'. */
404 411
405 static void 412 static void
406 update_status_from_wait_code (struct Lisp_Process *p, int *w_fmh) 413 update_status_from_wait_code (Lisp_Process *p, int *w_fmh)
407 { 414 {
408 /* C compiler lossage when attempting to pass w directly */ 415 /* C compiler lossage when attempting to pass w directly */
409 int w = *w_fmh; 416 int w = *w_fmh;
410 417
411 if (WIFSTOPPED (w)) 418 if (WIFSTOPPED (w))
516 if (block_sigchld) 523 if (block_sigchld)
517 EMACS_UNBLOCK_SIGNAL (SIGCHLD); 524 EMACS_UNBLOCK_SIGNAL (SIGCHLD);
518 } 525 }
519 526
520 /* For any processes that have changed status and are recorded 527 /* For any processes that have changed status and are recorded
521 and such, update the corresponding struct Lisp_Process. 528 and such, update the corresponding Lisp_Process.
522 We separate this from record_exited_processes() so that 529 We separate this from record_exited_processes() so that
523 we never have to call this function from within a signal 530 we never have to call this function from within a signal
524 handler. We block SIGCHLD in case record_exited_processes() 531 handler. We block SIGCHLD in case record_exited_processes()
525 is called from a signal handler. */ 532 is called from a signal handler. */
526 533
645 /* 652 /*
646 * Allocate and initialize Lisp_Process->process_data 653 * Allocate and initialize Lisp_Process->process_data
647 */ 654 */
648 655
649 static void 656 static void
650 unix_alloc_process_data (struct Lisp_Process *p) 657 unix_alloc_process_data (Lisp_Process *p)
651 { 658 {
652 p->process_data = xnew (struct unix_process_data); 659 p->process_data = xnew (struct unix_process_data);
653 660
654 UNIX_DATA(p)->connected_via_filedesc_p = 0; 661 UNIX_DATA(p)->connected_via_filedesc_p = 0;
655 UNIX_DATA(p)->infd = -1; 662 UNIX_DATA(p)->infd = -1;
661 /* 668 /*
662 * Mark any Lisp objects in Lisp_Process->process_data 669 * Mark any Lisp objects in Lisp_Process->process_data
663 */ 670 */
664 671
665 static void 672 static void
666 unix_mark_process_data (struct Lisp_Process *proc, 673 unix_mark_process_data (Lisp_Process *proc)
667 void (*markobj) (Lisp_Object)) 674 {
668 { 675 mark_object (UNIX_DATA(proc)->tty_name);
669 markobj (UNIX_DATA(proc)->tty_name);
670 } 676 }
671 677
672 /* 678 /*
673 * Initialize XEmacs process implementation once 679 * Initialize XEmacs process implementation once
674 */ 680 */
690 * handles are generally represented by void* type, but are 696 * handles are generally represented by void* type, but are
691 * of type int (file descriptors) for UNIX 697 * of type int (file descriptors) for UNIX
692 */ 698 */
693 699
694 static void 700 static void
695 unix_init_process_io_handles (struct Lisp_Process *p, void* in, void* out, int flags) 701 unix_init_process_io_handles (Lisp_Process *p, void* in, void* out, int flags)
696 { 702 {
697 UNIX_DATA(p)->infd = (int)in; 703 UNIX_DATA(p)->infd = (int)in;
698 } 704 }
699 705
700 /* 706 /*
706 * which fits into Lisp_Int. No return value indicates an error, the method 712 * which fits into Lisp_Int. No return value indicates an error, the method
707 * must signal an error instead. 713 * must signal an error instead.
708 */ 714 */
709 715
710 static int 716 static int
711 unix_create_process (struct Lisp_Process *p, 717 unix_create_process (Lisp_Process *p,
712 Lisp_Object *argv, int nargv, 718 Lisp_Object *argv, int nargv,
713 Lisp_Object program, Lisp_Object cur_dir) 719 Lisp_Object program, Lisp_Object cur_dir)
714 { 720 {
715 /* This function rewritten by ben@xemacs.org. */ 721 /* This function rewritten by ben@xemacs.org. */
716 722
920 CHECK_STRING (argv[i]); 926 CHECK_STRING (argv[i]);
921 new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]); 927 new_argv[i + 1] = (char *) XSTRING_DATA (argv[i]);
922 } 928 }
923 new_argv[i + 1] = 0; 929 new_argv[i + 1] = 0;
924 930
925 GET_C_STRING_FILENAME_DATA_ALLOCA (cur_dir, current_dir); 931 TO_EXTERNAL_FORMAT (LISP_STRING, cur_dir,
932 C_STRING_ALLOCA, current_dir,
933 Qfile_name);
926 934
927 child_setup (xforkin, xforkout, xforkout, new_argv, current_dir); 935 child_setup (xforkin, xforkout, xforkout, new_argv, current_dir);
928 } 936 }
929 937
930 } /**** End of child code ****/ 938 } /**** End of child code ****/
979 } 987 }
980 988
981 /* Return nonzero if this process is a ToolTalk connection. */ 989 /* Return nonzero if this process is a ToolTalk connection. */
982 990
983 static int 991 static int
984 unix_tooltalk_connection_p (struct Lisp_Process *p) 992 unix_tooltalk_connection_p (Lisp_Process *p)
985 { 993 {
986 return UNIX_DATA(p)->connected_via_filedesc_p; 994 return UNIX_DATA(p)->connected_via_filedesc_p;
987 } 995 }
988 996
989 /* This is called to set process' virtual terminal size */ 997 /* This is called to set process' virtual terminal size */
990 998
991 static int 999 static int
992 unix_set_window_size (struct Lisp_Process* p, int cols, int rows) 1000 unix_set_window_size (Lisp_Process* p, int cols, int rows)
993 { 1001 {
994 return set_window_size (UNIX_DATA(p)->infd, cols, rows); 1002 return set_window_size (UNIX_DATA(p)->infd, cols, rows);
995 } 1003 }
996 1004
997 /* 1005 /*
1002 * The method is called only for real child processes. 1010 * The method is called only for real child processes.
1003 */ 1011 */
1004 1012
1005 #ifdef HAVE_WAITPID 1013 #ifdef HAVE_WAITPID
1006 static void 1014 static void
1007 unix_update_status_if_terminated (struct Lisp_Process* p) 1015 unix_update_status_if_terminated (Lisp_Process* p)
1008 { 1016 {
1009 int w; 1017 int w;
1010 #ifdef SIGCHLD 1018 #ifdef SIGCHLD
1011 EMACS_BLOCK_SIGNAL (SIGCHLD); 1019 EMACS_BLOCK_SIGNAL (SIGCHLD);
1012 #endif 1020 #endif
1028 #ifdef SIGCHLD 1036 #ifdef SIGCHLD
1029 static void 1037 static void
1030 unix_reap_exited_processes (void) 1038 unix_reap_exited_processes (void)
1031 { 1039 {
1032 int i; 1040 int i;
1033 struct Lisp_Process *p; 1041 Lisp_Process *p;
1034 1042
1035 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR 1043 #ifndef OBNOXIOUS_SYSV_SIGCLD_BEHAVIOR
1036 record_exited_processes (1); 1044 record_exited_processes (1);
1037 #endif 1045 #endif
1038 1046
1127 unix_send_process (Lisp_Object proc, struct lstream* lstream) 1135 unix_send_process (Lisp_Object proc, struct lstream* lstream)
1128 { 1136 {
1129 /* Use volatile to protect variables from being clobbered by longjmp. */ 1137 /* Use volatile to protect variables from being clobbered by longjmp. */
1130 SIGTYPE (*volatile old_sigpipe) (int) = 0; 1138 SIGTYPE (*volatile old_sigpipe) (int) = 0;
1131 volatile Lisp_Object vol_proc = proc; 1139 volatile Lisp_Object vol_proc = proc;
1132 struct Lisp_Process *volatile p = XPROCESS (proc); 1140 Lisp_Process *volatile p = XPROCESS (proc);
1133 1141
1134 if (!SETJMP (send_process_frame)) 1142 if (!SETJMP (send_process_frame))
1135 { 1143 {
1136 /* use a reasonable-sized buffer (somewhere around the size of the 1144 /* use a reasonable-sized buffer (somewhere around the size of the
1137 stream buffer) so as to avoid inundating the stream with blocked 1145 stream buffer) so as to avoid inundating the stream with blocked
1139 Bufbyte chunkbuf[512]; 1147 Bufbyte chunkbuf[512];
1140 Bytecount chunklen; 1148 Bytecount chunklen;
1141 1149
1142 while (1) 1150 while (1)
1143 { 1151 {
1144 int writeret; 1152 ssize_t writeret;
1145 1153
1146 chunklen = Lstream_read (lstream, chunkbuf, 512); 1154 chunklen = Lstream_read (lstream, chunkbuf, 512);
1147 if (chunklen <= 0) 1155 if (chunklen <= 0)
1148 break; /* perhaps should abort() if < 0? 1156 break; /* perhaps should abort() if < 0?
1149 This should never happen. */ 1157 This should never happen. */
1213 things up. */ 1221 things up. */
1214 #if 0 1222 #if 0
1215 Bufbyte eof_char = get_eof_char (XPROCESS (proc)); 1223 Bufbyte eof_char = get_eof_char (XPROCESS (proc));
1216 send_process (proc, Qnil, &eof_char, 0, 1); 1224 send_process (proc, Qnil, &eof_char, 0, 1);
1217 #else 1225 #else
1218 send_process (proc, Qnil, (CONST Bufbyte *) "\004", 0, 1); 1226 send_process (proc, Qnil, (const Bufbyte *) "\004", 0, 1);
1219 #endif 1227 #endif
1220 return 1; 1228 return 1;
1221 } 1229 }
1222 1230
1223 /* 1231 /*
1233 * 1241 *
1234 * The UNIX version guards this by ignoring possible SIGPIPE. 1242 * The UNIX version guards this by ignoring possible SIGPIPE.
1235 */ 1243 */
1236 1244
1237 static USID 1245 static USID
1238 unix_deactivate_process (struct Lisp_Process *p) 1246 unix_deactivate_process (Lisp_Process *p)
1239 { 1247 {
1240 SIGTYPE (*old_sigpipe) (int) = 0; 1248 SIGTYPE (*old_sigpipe) (int) = 0;
1241 USID usid; 1249 USID usid;
1242 1250
1243 if (UNIX_DATA(p)->infd >= 0) 1251 if (UNIX_DATA(p)->infd >= 0)
1272 int current_group, int nomsg) 1280 int current_group, int nomsg)
1273 { 1281 {
1274 int gid; 1282 int gid;
1275 int no_pgrp = 0; 1283 int no_pgrp = 0;
1276 int kill_retval; 1284 int kill_retval;
1277 struct Lisp_Process *p = XPROCESS (proc); 1285 Lisp_Process *p = XPROCESS (proc);
1278 1286
1279 if (!UNIX_DATA(p)->pty_flag) 1287 if (!UNIX_DATA(p)->pty_flag)
1280 current_group = 0; 1288 current_group = 0;
1281 1289
1282 /* If we are using pgrps, get a pgrp number and make it negative. */ 1290 /* If we are using pgrps, get a pgrp number and make it negative. */
1392 /* 1400 /*
1393 * Return TTY name used to communicate with subprocess 1401 * Return TTY name used to communicate with subprocess
1394 */ 1402 */
1395 1403
1396 static Lisp_Object 1404 static Lisp_Object
1397 unix_get_tty_name (struct Lisp_Process *p) 1405 unix_get_tty_name (Lisp_Process *p)
1398 { 1406 {
1399 return UNIX_DATA (p)->tty_name; 1407 return UNIX_DATA (p)->tty_name;
1400 } 1408 }
1401 1409
1402 /* 1410 /*
1407 1415
1408 #ifdef HAVE_SOCKETS 1416 #ifdef HAVE_SOCKETS
1409 static Lisp_Object 1417 static Lisp_Object
1410 unix_canonicalize_host_name (Lisp_Object host) 1418 unix_canonicalize_host_name (Lisp_Object host)
1411 { 1419 {
1420 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
1421 struct addrinfo hints, *res;
1422 static char addrbuf[NI_MAXHOST];
1423 Lisp_Object canonname;
1424 int retval;
1425 char *ext_host;
1426
1427 xzero (hints);
1428 hints.ai_flags = AI_CANONNAME;
1429 hints.ai_family = AF_UNSPEC;
1430 hints.ai_socktype = SOCK_STREAM;
1431 hints.ai_protocol = 0;
1432 TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative);
1433 retval = getaddrinfo (ext_host, NULL, &hints, &res);
1434 if (retval != 0)
1435 {
1436 char *gai_error;
1437
1438 TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
1439 C_STRING_ALLOCA, gai_error,
1440 Qnative);
1441 maybe_error (Qprocess, ERROR_ME_NOT,
1442 "%s \"%s\"", gai_error, XSTRING_DATA (host));
1443 canonname = host;
1444 }
1445 else
1446 {
1447 int gni = getnameinfo (res->ai_addr, res->ai_addrlen,
1448 addrbuf, sizeof(addrbuf),
1449 NULL, 0, NI_NUMERICHOST);
1450 canonname = gni ? host : build_ext_string (addrbuf, Qnative);
1451
1452 freeaddrinfo (res);
1453 }
1454
1455 return canonname;
1456 #else /* ! HAVE_GETADDRINFO */
1412 struct sockaddr_in address; 1457 struct sockaddr_in address;
1413 1458
1414 if (!get_internet_address (host, &address, ERROR_ME_NOT)) 1459 if (!get_internet_address (host, &address, ERROR_ME_NOT))
1415 return host; 1460 return host;
1416 1461
1417 if (address.sin_family == AF_INET) 1462 if (address.sin_family == AF_INET)
1418 return build_string (inet_ntoa (address.sin_addr)); 1463 return build_string (inet_ntoa (address.sin_addr));
1419 else 1464 else
1420 /* #### any clue what to do here? */ 1465 /* #### any clue what to do here? */
1421 return host; 1466 return host;
1467 #endif /* ! HAVE_GETADDRINFO */
1422 } 1468 }
1423 1469
1424 /* open a TCP network connection to a given HOST/SERVICE. Treated 1470 /* open a TCP network connection to a given HOST/SERVICE. Treated
1425 exactly like a normal process when reading and writing. Only 1471 exactly like a normal process when reading and writing. Only
1426 differences are in status display and process deletion. A network 1472 differences are in status display and process deletion. A network
1427 connection has no PID; you cannot signal it. All you can do is 1473 connection has no PID; you cannot signal it. All you can do is
1428 deactivate and close it via delete-process */ 1474 deactivate and close it via delete-process */
1429 1475
1430 static void 1476 static void
1431 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service, 1477 unix_open_network_stream (Lisp_Object name, Lisp_Object host, Lisp_Object service,
1432 Lisp_Object family, void** vinfd, void** voutfd) 1478 Lisp_Object protocol, void** vinfd, void** voutfd)
1433 { 1479 {
1434 struct sockaddr_in address; 1480 int inch;
1435 int s, inch, outch; 1481 int outch;
1482 volatile int s;
1436 volatile int port; 1483 volatile int port;
1437 volatile int retry = 0; 1484 volatile int retry = 0;
1438 int retval; 1485 int retval;
1439 1486
1440 CHECK_STRING (host); 1487 CHECK_STRING (host);
1441 1488
1442 if (!EQ (family, Qtcpip)) 1489 if (!EQ (protocol, Qtcp) && !EQ (protocol, Qudp))
1443 error ("Unsupported protocol family \"%s\"", 1490 error ("Unsupported protocol \"%s\"",
1444 string_data (symbol_name (XSYMBOL (family)))); 1491 string_data (symbol_name (XSYMBOL (protocol))));
1445 1492
1446 if (INTP (service)) 1493 {
1447 port = htons ((unsigned short) XINT (service)); 1494 #if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO)
1448 else 1495 struct addrinfo hints, *res;
1449 { 1496 struct addrinfo * volatile lres;
1450 struct servent *svc_info; 1497 char *portstring;
1451 CHECK_STRING (service); 1498 volatile int xerrno = 0;
1452 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp"); 1499 volatile int failed_connect = 0;
1453 if (svc_info == 0) 1500 char *ext_host;
1454 error ("Unknown service \"%s\"", XSTRING_DATA (service)); 1501 /*
1455 port = svc_info->s_port; 1502 * Caution: service can either be a string or int.
1456 } 1503 * Convert to a C string for later use by getaddrinfo.
1457 1504 */
1458 get_internet_address (host, &address, ERROR_ME); 1505 if (INTP (service))
1459 address.sin_port = port; 1506 {
1460 1507 char portbuf[128];
1461 s = socket (address.sin_family, SOCK_STREAM, 0); 1508 snprintf (portbuf, sizeof (portbuf), "%ld", (long) XINT (service));
1462 if (s < 0) 1509 portstring = portbuf;
1463 report_file_error ("error creating socket", list1 (name)); 1510 port = htons ((unsigned short) XINT (service));
1464 1511 }
1465 /* Turn off interrupts here -- see comments below. There used to 1512 else
1466 be code which called bind_polling_period() to slow the polling 1513 {
1467 period down rather than turn it off, but that seems rather 1514 CHECK_STRING (service);
1468 bogus to me. Best thing here is to use a non-blocking connect 1515 TO_EXTERNAL_FORMAT (LISP_STRING, service,
1469 or something, to check for QUIT. */ 1516 C_STRING_ALLOCA, portstring,
1470 1517 Qnative);
1471 /* Comments that are not quite valid: */ 1518 port = 0;
1472 1519 }
1473 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) 1520
1474 when connect is interrupted. So let's not let it get interrupted. 1521 xzero (hints);
1475 Note we do not turn off polling, because polling is only used 1522 hints.ai_flags = 0;
1476 when not interrupt_input, and thus not normally used on the systems 1523 hints.ai_family = AF_UNSPEC;
1477 which have this bug. On systems which use polling, there's no way 1524 if (EQ (protocol, Qtcp))
1478 to quit if polling is turned off. */ 1525 hints.ai_socktype = SOCK_STREAM;
1479 1526 else /* EQ (protocol, Qudp) */
1480 /* Slow down polling. Some kernels have a bug which causes retrying 1527 hints.ai_socktype = SOCK_DGRAM;
1481 connect to fail after a connect. */ 1528 hints.ai_protocol = 0;
1482 1529 TO_EXTERNAL_FORMAT (LISP_STRING, host, C_STRING_ALLOCA, ext_host, Qnative);
1483 slow_down_interrupts (); 1530 retval = getaddrinfo (ext_host, portstring, &hints, &res);
1484 1531 if (retval != 0)
1485 loop: 1532 {
1486 1533 char *gai_error;
1487 /* A system call interrupted with a SIGALRM or SIGIO comes back 1534
1488 here, with can_break_system_calls reset to 0. */ 1535 TO_INTERNAL_FORMAT (C_STRING, gai_strerror (retval),
1489 SETJMP (break_system_call_jump); 1536 C_STRING_ALLOCA, gai_error,
1490 if (QUITP) 1537 Qnative);
1491 { 1538 error ("%s/%s %s", XSTRING_DATA (host), portstring, gai_error);
1492 speed_up_interrupts (); 1539 }
1493 REALLY_QUIT; 1540
1494 /* In case something really weird happens ... */ 1541 /* address loop */
1495 slow_down_interrupts (); 1542 for (lres = res; lres ; lres = lres->ai_next)
1496 } 1543 {
1497 1544 if (EQ (protocol, Qtcp))
1498 /* Break out of connect with a signal (it isn't otherwise possible). 1545 s = socket (lres->ai_family, SOCK_STREAM, 0);
1499 Thus you don't get screwed with a hung network. */ 1546 else /* EQ (protocol, Qudp) */
1500 can_break_system_calls = 1; 1547 s = socket (lres->ai_family, SOCK_DGRAM, 0);
1501 retval = connect (s, (struct sockaddr *) &address, sizeof (address)); 1548
1502 can_break_system_calls = 0; 1549 if (s < 0)
1503 if (retval == -1 && errno != EISCONN) 1550 continue;
1504 { 1551
1505 int xerrno = errno; 1552 /* Turn off interrupts here -- see comments below. There used to
1506 if (errno == EINTR) 1553 be code which called bind_polling_period() to slow the polling
1507 goto loop; 1554 period down rather than turn it off, but that seems rather
1508 if (errno == EADDRINUSE && retry < 20) 1555 bogus to me. Best thing here is to use a non-blocking connect
1509 { 1556 or something, to check for QUIT. */
1510 /* A delay here is needed on some FreeBSD systems, 1557
1511 and it is harmless, since this retrying takes time anyway 1558 /* Comments that are not quite valid: */
1512 and should be infrequent. 1559
1513 `sleep-for' allowed for quitting this loop with interrupts 1560 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1514 slowed down so it can't be used here. Async timers should 1561 when connect is interrupted. So let's not let it get interrupted.
1515 already be disabled at this point so we can use `sleep'. */ 1562 Note we do not turn off polling, because polling is only used
1516 sleep (1); 1563 when not interrupt_input, and thus not normally used on the systems
1517 retry++; 1564 which have this bug. On systems which use polling, there's no way
1565 to quit if polling is turned off. */
1566
1567 /* Slow down polling. Some kernels have a bug which causes retrying
1568 connect to fail after a connect. */
1569
1570 slow_down_interrupts ();
1571
1572 loop:
1573
1574 /* A system call interrupted with a SIGALRM or SIGIO comes back
1575 here, with can_break_system_calls reset to 0. */
1576 SETJMP (break_system_call_jump);
1577 if (QUITP)
1578 {
1579 speed_up_interrupts ();
1580 REALLY_QUIT;
1581 /* In case something really weird happens ... */
1582 slow_down_interrupts ();
1583 }
1584
1585 /* Break out of connect with a signal (it isn't otherwise possible).
1586 Thus you don't get screwed with a hung network. */
1587 can_break_system_calls = 1;
1588 retval = connect (s, lres->ai_addr, lres->ai_addrlen);
1589 can_break_system_calls = 0;
1590 if (retval == -1)
1591 {
1592 xerrno = errno;
1593 if (errno != EISCONN)
1594 {
1595 if (errno == EINTR)
1596 goto loop;
1597 if (errno == EADDRINUSE && retry < 20)
1598 {
1599 /* A delay here is needed on some FreeBSD systems,
1600 and it is harmless, since this retrying takes time anyway
1601 and should be infrequent.
1602 `sleep-for' allowed for quitting this loop with interrupts
1603 slowed down so it can't be used here. Async timers should
1604 already be disabled at this point so we can use `sleep'. */
1605 sleep (1);
1606 retry++;
1607 goto loop;
1608 }
1609 }
1610
1611 failed_connect = 1;
1612 close (s);
1613
1614 speed_up_interrupts ();
1615
1616 continue;
1617 }
1618
1619 if (port == 0)
1620 {
1621 int gni;
1622 char servbuf[NI_MAXSERV];
1623
1624 if (EQ (protocol, Qtcp))
1625 gni = getnameinfo (lres->ai_addr, lres->ai_addrlen,
1626 NULL, 0, servbuf, sizeof(servbuf),
1627 NI_NUMERICSERV);
1628 else /* EQ (protocol, Qudp) */
1629 gni = getnameinfo (lres->ai_addr, lres->ai_addrlen,
1630 NULL, 0, servbuf, sizeof(servbuf),
1631 NI_NUMERICSERV | NI_DGRAM);
1632
1633 if (gni == 0)
1634 port = strtol (servbuf, NULL, 10);
1635 }
1636
1637 break;
1638 } /* address loop */
1639
1640 speed_up_interrupts ();
1641
1642 freeaddrinfo (res);
1643 if (s < 0)
1644 {
1645 errno = xerrno;
1646
1647 if (failed_connect)
1648 report_file_error ("connection failed", list2 (host, name));
1649 else
1650 report_file_error ("error creating socket", list1 (name));
1651 }
1652 #else /* ! HAVE_GETADDRINFO */
1653 struct sockaddr_in address;
1654
1655 if (INTP (service))
1656 port = htons ((unsigned short) XINT (service));
1657 else
1658 {
1659 struct servent *svc_info;
1660 CHECK_STRING (service);
1661
1662 if (EQ (protocol, Qtcp))
1663 svc_info = getservbyname ((char *) XSTRING_DATA (service), "tcp");
1664 else /* EQ (protocol, Qudp) */
1665 svc_info = getservbyname ((char *) XSTRING_DATA (service), "udp");
1666
1667 if (svc_info == 0)
1668 error ("Unknown service \"%s\"", XSTRING_DATA (service));
1669 port = svc_info->s_port;
1670 }
1671
1672 get_internet_address (host, &address, ERROR_ME);
1673 address.sin_port = port;
1674
1675 if (EQ (protocol, Qtcp))
1676 s = socket (address.sin_family, SOCK_STREAM, 0);
1677 else /* EQ (protocol, Qudp) */
1678 s = socket (address.sin_family, SOCK_DGRAM, 0);
1679
1680 if (s < 0)
1681 report_file_error ("error creating socket", list1 (name));
1682
1683 /* Turn off interrupts here -- see comments below. There used to
1684 be code which called bind_polling_period() to slow the polling
1685 period down rather than turn it off, but that seems rather
1686 bogus to me. Best thing here is to use a non-blocking connect
1687 or something, to check for QUIT. */
1688
1689 /* Comments that are not quite valid: */
1690
1691 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
1692 when connect is interrupted. So let's not let it get interrupted.
1693 Note we do not turn off polling, because polling is only used
1694 when not interrupt_input, and thus not normally used on the systems
1695 which have this bug. On systems which use polling, there's no way
1696 to quit if polling is turned off. */
1697
1698 /* Slow down polling. Some kernels have a bug which causes retrying
1699 connect to fail after a connect. */
1700
1701 slow_down_interrupts ();
1702
1703 loop:
1704
1705 /* A system call interrupted with a SIGALRM or SIGIO comes back
1706 here, with can_break_system_calls reset to 0. */
1707 SETJMP (break_system_call_jump);
1708 if (QUITP)
1709 {
1710 speed_up_interrupts ();
1711 REALLY_QUIT;
1712 /* In case something really weird happens ... */
1713 slow_down_interrupts ();
1714 }
1715
1716 /* Break out of connect with a signal (it isn't otherwise possible).
1717 Thus you don't get screwed with a hung network. */
1718 can_break_system_calls = 1;
1719 retval = connect (s, (struct sockaddr *) &address, sizeof (address));
1720 can_break_system_calls = 0;
1721 if (retval == -1 && errno != EISCONN)
1722 {
1723 int xerrno = errno;
1724 if (errno == EINTR)
1518 goto loop; 1725 goto loop;
1519 } 1726 if (errno == EADDRINUSE && retry < 20)
1520 1727 {
1521 close (s); 1728 /* A delay here is needed on some FreeBSD systems,
1522 1729 and it is harmless, since this retrying takes time anyway
1523 speed_up_interrupts (); 1730 and should be infrequent.
1524 1731 `sleep-for' allowed for quitting this loop with interrupts
1525 errno = xerrno; 1732 slowed down so it can't be used here. Async timers should
1526 report_file_error ("connection failed", list2 (host, name)); 1733 already be disabled at this point so we can use `sleep'. */
1527 } 1734 sleep (1);
1528 1735 retry++;
1529 speed_up_interrupts (); 1736 goto loop;
1737 }
1738
1739 close (s);
1740
1741 speed_up_interrupts ();
1742
1743 errno = xerrno;
1744 report_file_error ("connection failed", list2 (host, name));
1745 }
1746
1747 speed_up_interrupts ();
1748 #endif /* ! HAVE_GETADDRINFO */
1749 }
1530 1750
1531 inch = s; 1751 inch = s;
1532 outch = dup (s); 1752 outch = dup (s);
1533 if (outch < 0) 1753 if (outch < 0)
1534 { 1754 {