Mercurial > hg > xemacs-beta
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 { |