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