aboutsummaryrefslogtreecommitdiffstats
path: root/src/process.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/process.c')
-rw-r--r--src/process.c1904
1 files changed, 1630 insertions, 274 deletions
diff --git a/src/process.c b/src/process.c
index daf4563c608..0b90649fb9d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -57,6 +57,17 @@ Boston, MA 02111-1307, USA. */
57#ifdef NEED_NET_ERRNO_H 57#ifdef NEED_NET_ERRNO_H
58#include <net/errno.h> 58#include <net/errno.h>
59#endif /* NEED_NET_ERRNO_H */ 59#endif /* NEED_NET_ERRNO_H */
60
61/* Are local (unix) sockets supported? */
62#ifndef NO_SOCKETS_IN_FILE_SYSTEM
63#if !defined (AF_LOCAL) && defined (AF_UNIX)
64#define AF_LOCAL AF_UNIX
65#endif
66#ifdef AF_LOCAL
67#define HAVE_LOCAL_SOCKETS
68#include <sys/un.h>
69#endif
70#endif
60#endif /* HAVE_SOCKETS */ 71#endif /* HAVE_SOCKETS */
61 72
62/* TERM is a poor-man's SLIP, used on GNU/Linux. */ 73/* TERM is a poor-man's SLIP, used on GNU/Linux. */
@@ -113,7 +124,12 @@ Boston, MA 02111-1307, USA. */
113 124
114Lisp_Object Qprocessp; 125Lisp_Object Qprocessp;
115Lisp_Object Qrun, Qstop, Qsignal; 126Lisp_Object Qrun, Qstop, Qsignal;
116Lisp_Object Qopen, Qclosed, Qconnect, Qfailed; 127Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
128Lisp_Object Qlocal;
129Lisp_Object QCname, QCbuffer, QChost, QCservice, QCfamily;
130Lisp_Object QClocal, QCremote, QCcoding;
131Lisp_Object QCserver, QCdatagram, QCnowait, QCnoquery, QCstop;
132Lisp_Object QCfilter, QCsentinel, QClog, QCoptions, QCfeature;
117Lisp_Object Qlast_nonmenu_event; 133Lisp_Object Qlast_nonmenu_event;
118/* Qexit is declared and initialized in eval.c. */ 134/* Qexit is declared and initialized in eval.c. */
119 135
@@ -122,8 +138,10 @@ Lisp_Object Qlast_nonmenu_event;
122 138
123#ifdef HAVE_SOCKETS 139#ifdef HAVE_SOCKETS
124#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp)) 140#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
141#define NETCONN1_P(p) (GC_CONSP ((p)->childp))
125#else 142#else
126#define NETCONN_P(p) 0 143#define NETCONN_P(p) 0
144#define NETCONN1_P(p) 0
127#endif /* HAVE_SOCKETS */ 145#endif /* HAVE_SOCKETS */
128 146
129/* Define first descriptor number available for subprocesses. */ 147/* Define first descriptor number available for subprocesses. */
@@ -194,10 +212,39 @@ int update_tick;
194#endif /* NON_BLOCKING_CONNECT */ 212#endif /* NON_BLOCKING_CONNECT */
195#endif /* BROKEN_NON_BLOCKING_CONNECT */ 213#endif /* BROKEN_NON_BLOCKING_CONNECT */
196 214
215/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
216 this system. We need to read full packets, so we need a
217 "non-destructive" select. So we require either native select,
218 or emulation of select using FIONREAD. */
219
220#ifdef GNU_LINUX
221/* These are not yet in configure.in (they will be eventually)
222 -- so add them here temporarily. ++kfs */
223#define HAVE_RECVFROM
224#define HAVE_SENDTO
225#define HAVE_GETSOCKNAME
226#endif
227
228#ifdef BROKEN_DATAGRAM_SOCKETS
229#undef DATAGRAM_SOCKETS
230#else
231#ifndef DATAGRAM_SOCKETS
232#ifdef HAVE_SOCKETS
233#if defined (HAVE_SELECT) || defined (FIONREAD)
234#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
235#define DATAGRAM_SOCKETS
236#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
237#endif /* HAVE_SELECT || FIONREAD */
238#endif /* HAVE_SOCKETS */
239#endif /* DATAGRAM_SOCKETS */
240#endif /* BROKEN_DATAGRAM_SOCKETS */
241
197#ifdef TERM 242#ifdef TERM
198#undef NON_BLOCKING_CONNECT 243#undef NON_BLOCKING_CONNECT
244#undef DATAGRAM_SOCKETS
199#endif 245#endif
200 246
247
201#include "sysselect.h" 248#include "sysselect.h"
202 249
203extern int keyboard_bit_set P_ ((SELECT_TYPE *)); 250extern int keyboard_bit_set P_ ((SELECT_TYPE *));
@@ -257,6 +304,19 @@ int proc_buffered_char[MAXDESC];
257static struct coding_system *proc_decode_coding_system[MAXDESC]; 304static struct coding_system *proc_decode_coding_system[MAXDESC];
258static struct coding_system *proc_encode_coding_system[MAXDESC]; 305static struct coding_system *proc_encode_coding_system[MAXDESC];
259 306
307#ifdef DATAGRAM_SOCKETS
308/* Table of `partner address' for datagram sockets. */
309struct sockaddr_and_len {
310 struct sockaddr *sa;
311 int len;
312} datagram_address[MAXDESC];
313#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
314#define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].sa != 0)
315#else
316#define DATAGRAM_CHAN_P(chan) (0)
317#define DATAGRAM_CONN_P(proc) (0)
318#endif
319
260static Lisp_Object get_process (); 320static Lisp_Object get_process ();
261static void exec_sentinel (); 321static void exec_sentinel ();
262 322
@@ -367,15 +427,15 @@ status_message (status)
367 return build_string ("finished\n"); 427 return build_string ("finished\n");
368 string = Fnumber_to_string (make_number (code)); 428 string = Fnumber_to_string (make_number (code));
369 string2 = build_string (coredump ? " (core dumped)\n" : "\n"); 429 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
370 return concat2 (build_string ("exited abnormally with code "), 430 return concat3 (build_string ("exited abnormally with code "),
371 concat2 (string, string2)); 431 string, string2);
372 } 432 }
373 else if (EQ (symbol, Qfailed)) 433 else if (EQ (symbol, Qfailed))
374 { 434 {
375 string = Fnumber_to_string (make_number (code)); 435 string = Fnumber_to_string (make_number (code));
376 string2 = build_string ("\n"); 436 string2 = build_string ("\n");
377 return concat2 (build_string ("failed with code "), 437 return concat3 (build_string ("failed with code "),
378 concat2 (string, string2)); 438 string, string2);
379 } 439 }
380 else 440 else
381 return Fcopy_sequence (Fsymbol_name (symbol)); 441 return Fcopy_sequence (Fsymbol_name (symbol));
@@ -635,6 +695,7 @@ stop -- for a process stopped but continuable.
635exit -- for a process that has exited. 695exit -- for a process that has exited.
636signal -- for a process that has got a fatal signal. 696signal -- for a process that has got a fatal signal.
637open -- for a network stream connection that is open. 697open -- for a network stream connection that is open.
698listen -- for a network stream server that is listening.
638closed -- for a network stream connection that is closed. 699closed -- for a network stream connection that is closed.
639connect -- when waiting for a non-blocking connection to complete. 700connect -- when waiting for a non-blocking connection to complete.
640failed -- when a non-blocking connection has failed. 701failed -- when a non-blocking connection has failed.
@@ -661,12 +722,14 @@ nil, indicating the current buffer's process. */)
661 status = p->status; 722 status = p->status;
662 if (CONSP (status)) 723 if (CONSP (status))
663 status = XCAR (status); 724 status = XCAR (status);
664 if (NETCONN_P (process)) 725 if (NETCONN1_P (p))
665 { 726 {
666 if (EQ (status, Qrun)) 727 if (EQ (status, Qexit))
667 status = Qopen;
668 else if (EQ (status, Qexit))
669 status = Qclosed; 728 status = Qclosed;
729 else if (EQ (p->command, Qt))
730 status = Qstop;
731 else if (EQ (status, Qrun))
732 status = Qopen;
670 } 733 }
671 return status; 734 return status;
672} 735}
@@ -737,10 +800,15 @@ DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
737 (process, buffer) 800 (process, buffer)
738 register Lisp_Object process, buffer; 801 register Lisp_Object process, buffer;
739{ 802{
803 struct Lisp_Process *p;
804
740 CHECK_PROCESS (process); 805 CHECK_PROCESS (process);
741 if (!NILP (buffer)) 806 if (!NILP (buffer))
742 CHECK_BUFFER (buffer); 807 CHECK_BUFFER (buffer);
743 XPROCESS (process)->buffer = buffer; 808 p = XPROCESS (process);
809 p->buffer = buffer;
810 if (NETCONN1_P (p))
811 p->childp = Fplist_put (p->childp, QCbuffer, buffer);
744 return buffer; 812 return buffer;
745} 813}
746 814
@@ -791,12 +859,13 @@ If the process has a filter, its buffer is not used for output. */)
791 859
792 if (XINT (p->infd) >= 0) 860 if (XINT (p->infd) >= 0)
793 { 861 {
794 if (EQ (filter, Qt)) 862 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
795 { 863 {
796 FD_CLR (XINT (p->infd), &input_wait_mask); 864 FD_CLR (XINT (p->infd), &input_wait_mask);
797 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); 865 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
798 } 866 }
799 else if (EQ (XPROCESS (process)->filter, Qt)) 867 else if (EQ (p->filter, Qt)
868 && !EQ (p->command, Qt)) /* Network process not stopped. */
800 { 869 {
801 FD_SET (XINT (p->infd), &input_wait_mask); 870 FD_SET (XINT (p->infd), &input_wait_mask);
802 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 871 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
@@ -804,6 +873,8 @@ If the process has a filter, its buffer is not used for output. */)
804 } 873 }
805 874
806 p->filter = filter; 875 p->filter = filter;
876 if (NETCONN1_P (p))
877 p->childp = Fplist_put (p->childp, QCfilter, filter);
807 return filter; 878 return filter;
808} 879}
809 880
@@ -899,32 +970,64 @@ the process output. */)
899 return XPROCESS (process)->inherit_coding_system_flag; 970 return XPROCESS (process)->inherit_coding_system_flag;
900} 971}
901 972
902DEFUN ("process-kill-without-query", Fprocess_kill_without_query, 973DEFUN ("set-process-query-on-exit-flag",
903 Sprocess_kill_without_query, 1, 2, 0, 974 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
904 doc: /* Say no query needed if PROCESS is running when Emacs is exited. 975 2, 2, 0,
905Optional second argument if non-nil says to require a query. 976 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
906Value is t if a query was formerly required. */) 977If the second argument FLAG is non-nil, emacs will query the user before
907 (process, value) 978exiting if PROCESS is running. */)
908 register Lisp_Object process, value; 979 (process, flag)
980 register Lisp_Object process, flag;
909{ 981{
910 Lisp_Object tem;
911
912 CHECK_PROCESS (process); 982 CHECK_PROCESS (process);
913 tem = XPROCESS (process)->kill_without_query; 983 XPROCESS (process)->kill_without_query = Fnull (flag);
914 XPROCESS (process)->kill_without_query = Fnull (value); 984 return flag;
915
916 return Fnull (tem);
917} 985}
918 986
919DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 987DEFUN ("process-query-on-exit-flag",
988 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
920 1, 1, 0, 989 1, 1, 0,
921 doc: /* Return the contact info of PROCESS; t for a real child. 990 doc: /* Return the current value of query on exit flag for PROCESS. */)
922For a net connection, the value is a cons cell of the form (HOST SERVICE). */)
923 (process) 991 (process)
924 register Lisp_Object process; 992 register Lisp_Object process;
925{ 993{
926 CHECK_PROCESS (process); 994 CHECK_PROCESS (process);
927 return XPROCESS (process)->childp; 995 return Fnull (XPROCESS (process)->kill_without_query);
996}
997
998#ifdef DATAGRAM_SOCKETS
999Lisp_Object Fprocess_datagram_address ();
1000#endif
1001
1002DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1003 1, 2, 0,
1004 doc: /* Return the contact info of PROCESS; t for a real child.
1005For a net connection, the value depends on the optional KEY arg.
1006If KEY is nil, value is a cons cell of the form (HOST SERVICE),
1007if KEY is t, the complete contact information for the connection is
1008returned, else the specific value for the keyword KEY is returned.
1009See `make-network-process' for a list of keywords. */)
1010 (process, key)
1011 register Lisp_Object process, key;
1012{
1013 Lisp_Object contact;
1014
1015 CHECK_PROCESS (process);
1016 contact = XPROCESS (process)->childp;
1017
1018#ifdef DATAGRAM_SOCKETS
1019 if (DATAGRAM_CONN_P (process)
1020 && (EQ (key, Qt) || EQ (key, QCremote)))
1021 contact = Fplist_put (contact, QCremote,
1022 Fprocess_datagram_address (process));
1023#endif
1024
1025 if (!NETCONN_P (process) || EQ (key, Qt))
1026 return contact;
1027 if (NILP (key))
1028 return Fcons (Fplist_get (contact, QChost),
1029 Fcons (Fplist_get (contact, QCservice), Qnil));
1030 return Fplist_get (contact, key);
928} 1031}
929 1032
930#if 0 /* Turned off because we don't currently record this info 1033#if 0 /* Turned off because we don't currently record this info
@@ -941,12 +1044,55 @@ a socket connection. */)
941#endif 1044#endif
942 1045
943Lisp_Object 1046Lisp_Object
944list_processes_1 () 1047list_processes_1 (query_only)
1048 Lisp_Object query_only;
945{ 1049{
946 register Lisp_Object tail, tem; 1050 register Lisp_Object tail, tem;
947 Lisp_Object proc, minspace, tem1; 1051 Lisp_Object proc, minspace, tem1;
948 register struct Lisp_Process *p; 1052 register struct Lisp_Process *p;
949 char tembuf[80]; 1053 char tembuf[300];
1054 int w_proc, w_buffer, w_tty;
1055 Lisp_Object i_status, i_buffer, i_tty, i_command;
1056
1057 w_proc = 4; /* Proc */
1058 w_buffer = 6; /* Buffer */
1059 w_tty = 0; /* Omit if no ttys */
1060
1061 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
1062 {
1063 int i;
1064
1065 proc = Fcdr (Fcar (tail));
1066 p = XPROCESS (proc);
1067 if (NILP (p->childp))
1068 continue;
1069 if (!NILP (query_only) && !NILP (p->kill_without_query))
1070 continue;
1071 if (STRINGP (p->name)
1072 && ( i = XSTRING (p->name)->size, (i > w_proc)))
1073 w_proc = i;
1074 if (!NILP (p->buffer))
1075 {
1076 if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8)
1077 w_buffer = 8; /* (Killed) */
1078 else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer)))
1079 w_buffer = i;
1080 }
1081 if (STRINGP (p->tty_name)
1082 && (i = XSTRING (p->tty_name)->size, (i > w_tty)))
1083 w_tty = i;
1084 }
1085
1086 XSETFASTINT (i_status, w_proc + 1);
1087 XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
1088 if (w_tty)
1089 {
1090 XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
1091 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1);
1092 } else {
1093 i_tty = Qnil;
1094 XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
1095 }
950 1096
951 XSETFASTINT (minspace, 1); 1097 XSETFASTINT (minspace, 1);
952 1098
@@ -955,9 +1101,25 @@ list_processes_1 ()
955 1101
956 current_buffer->truncate_lines = Qt; 1102 current_buffer->truncate_lines = Qt;
957 1103
958 write_string ("\ 1104 write_string ("Proc", -1);
959Proc Status Buffer Tty Command\n\ 1105 Findent_to (i_status, minspace); write_string ("Status", -1);
960---- ------ ------ --- -------\n", -1); 1106 Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
1107 if (!NILP (i_tty))
1108 {
1109 Findent_to (i_tty, minspace); write_string ("Tty", -1);
1110 }
1111 Findent_to (i_command, minspace); write_string ("Command", -1);
1112 write_string ("\n", -1);
1113
1114 write_string ("----", -1);
1115 Findent_to (i_status, minspace); write_string ("------", -1);
1116 Findent_to (i_buffer, minspace); write_string ("------", -1);
1117 if (!NILP (i_tty))
1118 {
1119 Findent_to (i_tty, minspace); write_string ("---", -1);
1120 }
1121 Findent_to (i_command, minspace); write_string ("-------", -1);
1122 write_string ("\n", -1);
961 1123
962 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) 1124 for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail))
963 { 1125 {
@@ -967,9 +1129,11 @@ Proc Status Buffer Tty Command\n\
967 p = XPROCESS (proc); 1129 p = XPROCESS (proc);
968 if (NILP (p->childp)) 1130 if (NILP (p->childp))
969 continue; 1131 continue;
1132 if (!NILP (query_only) && !NILP (p->kill_without_query))
1133 continue;
970 1134
971 Finsert (1, &p->name); 1135 Finsert (1, &p->name);
972 Findent_to (make_number (13), minspace); 1136 Findent_to (i_status, minspace);
973 1137
974 if (!NILP (p->raw_status_low)) 1138 if (!NILP (p->raw_status_low))
975 update_status (p); 1139 update_status (p);
@@ -989,12 +1153,14 @@ Proc Status Buffer Tty Command\n\
989#endif 1153#endif
990 Fprinc (symbol, Qnil); 1154 Fprinc (symbol, Qnil);
991 } 1155 }
992 else if (NETCONN_P (proc)) 1156 else if (NETCONN1_P (p))
993 { 1157 {
994 if (EQ (symbol, Qrun)) 1158 if (EQ (symbol, Qexit))
995 write_string ("open", -1);
996 else if (EQ (symbol, Qexit))
997 write_string ("closed", -1); 1159 write_string ("closed", -1);
1160 else if (EQ (p->command, Qt))
1161 write_string ("stopped", -1);
1162 else if (EQ (symbol, Qrun))
1163 write_string ("open", -1);
998 else 1164 else
999 Fprinc (symbol, Qnil); 1165 Fprinc (symbol, Qnil);
1000 } 1166 }
@@ -1015,7 +1181,7 @@ Proc Status Buffer Tty Command\n\
1015 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) 1181 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
1016 remove_process (proc); 1182 remove_process (proc);
1017 1183
1018 Findent_to (make_number (22), minspace); 1184 Findent_to (i_buffer, minspace);
1019 if (NILP (p->buffer)) 1185 if (NILP (p->buffer))
1020 insert_string ("(none)"); 1186 insert_string ("(none)");
1021 else if (NILP (XBUFFER (p->buffer)->name)) 1187 else if (NILP (XBUFFER (p->buffer)->name))
@@ -1023,19 +1189,39 @@ Proc Status Buffer Tty Command\n\
1023 else 1189 else
1024 Finsert (1, &XBUFFER (p->buffer)->name); 1190 Finsert (1, &XBUFFER (p->buffer)->name);
1025 1191
1026 Findent_to (make_number (37), minspace); 1192 if (!NILP (i_tty))
1027 1193 {
1028 if (STRINGP (p->tty_name)) 1194 Findent_to (i_tty, minspace);
1029 Finsert (1, &p->tty_name); 1195 if (STRINGP (p->tty_name))
1030 else 1196 Finsert (1, &p->tty_name);
1031 insert_string ("(none)"); 1197 }
1032 1198
1033 Findent_to (make_number (49), minspace); 1199 Findent_to (i_command, minspace);
1034 1200
1035 if (NETCONN_P (proc)) 1201 if (EQ (p->status, Qlisten))
1202 {
1203 Lisp_Object port = Fplist_get (p->childp, QCservice);
1204 if (INTEGERP (port))
1205 port = Fnumber_to_string (port);
1206 sprintf (tembuf, "(network %s server on %s)\n",
1207 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1208 XSTRING (port)->data);
1209 insert_string (tembuf);
1210 }
1211 else if (NETCONN1_P (p))
1036 { 1212 {
1037 sprintf (tembuf, "(network stream connection to %s)\n", 1213 /* For a local socket, there is no host name,
1038 XSTRING (XCAR (p->childp))->data); 1214 so display service instead. */
1215 Lisp_Object host = Fplist_get (p->childp, QChost);
1216 if (!STRINGP (host))
1217 {
1218 host = Fplist_get (p->childp, QCservice);
1219 if (INTEGERP (host))
1220 host = Fnumber_to_string (host);
1221 }
1222 sprintf (tembuf, "(network %s connection to %s)\n",
1223 (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
1224 XSTRING (host)->data);
1039 insert_string (tembuf); 1225 insert_string (tembuf);
1040 } 1226 }
1041 else 1227 else
@@ -1056,14 +1242,17 @@ Proc Status Buffer Tty Command\n\
1056 return Qnil; 1242 return Qnil;
1057} 1243}
1058 1244
1059DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", 1245DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
1060 doc: /* Display a list of all processes. 1246 doc: /* Display a list of all processes.
1247If optional argument QUERY-ONLY is non-nil, only processes with
1248the query-on-exit flag set will be listed.
1061Any process listed as exited or signaled is actually eliminated 1249Any process listed as exited or signaled is actually eliminated
1062after the listing is made. */) 1250after the listing is made. */)
1063 () 1251 (query_only)
1252 Lisp_Object query_only;
1064{ 1253{
1065 internal_with_output_to_temp_buffer ("*Process List*", 1254 internal_with_output_to_temp_buffer ("*Process List*",
1066 list_processes_1, Qnil); 1255 list_processes_1, query_only);
1067 return Qnil; 1256 return Qnil;
1068} 1257}
1069 1258
@@ -1776,54 +1965,661 @@ create_process (process, new_argv, current_dir)
1776} 1965}
1777#endif /* not VMS */ 1966#endif /* not VMS */
1778 1967
1968
1779#ifdef HAVE_SOCKETS 1969#ifdef HAVE_SOCKETS
1780 1970
1781/* open a TCP network connection to a given HOST/SERVICE. Treated 1971/* Convert an internal struct sockaddr to a lisp object (vector or string).
1782 exactly like a normal process when reading and writing. Only 1972 The address family of sa is not included in the result. */
1973
1974static Lisp_Object
1975conv_sockaddr_to_lisp (sa, len)
1976 struct sockaddr *sa;
1977 int len;
1978{
1979 Lisp_Object address;
1980 int i;
1981 unsigned char *cp;
1982 register struct Lisp_Vector *p;
1983
1984 switch (sa->sa_family)
1985 {
1986 case AF_INET:
1987 {
1988 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
1989 len = sizeof (sin->sin_addr) + 1;
1990 address = Fmake_vector (make_number (len), Qnil);
1991 p = XVECTOR (address);
1992 p->contents[--len] = make_number (ntohs (sin->sin_port));
1993 cp = (unsigned char *)&sin->sin_addr;
1994 break;
1995 }
1996#ifdef HAVE_LOCAL_SOCKETS
1997 case AF_LOCAL:
1998 {
1999 struct sockaddr_un *sun = (struct sockaddr_un *) sa;
2000 for (i = 0; i < sizeof (sun->sun_path); i++)
2001 if (sun->sun_path[i] == 0)
2002 break;
2003 return make_unibyte_string (sun->sun_path, i);
2004 }
2005#endif
2006 default:
2007 len -= sizeof (sa->sa_family);
2008 address = Fcons (make_number (sa->sa_family),
2009 Fmake_vector (make_number (len), Qnil));
2010 p = XVECTOR (XCDR (address));
2011 cp = (unsigned char *) sa + sizeof (sa->sa_family);
2012 break;
2013 }
2014
2015 i = 0;
2016 while (i < len)
2017 p->contents[i++] = make_number (*cp++);
2018
2019 return address;
2020}
2021
2022
2023/* Get family and required size for sockaddr structure to hold ADDRESS. */
2024
2025static int
2026get_lisp_to_sockaddr_size (address, familyp)
2027 Lisp_Object address;
2028 int *familyp;
2029{
2030 register struct Lisp_Vector *p;
2031
2032 if (VECTORP (address))
2033 {
2034 p = XVECTOR (address);
2035 if (p->size == 5)
2036 {
2037 *familyp = AF_INET;
2038 return sizeof (struct sockaddr_in);
2039 }
2040 }
2041#ifdef HAVE_LOCAL_SOCKETS
2042 else if (STRINGP (address))
2043 {
2044 *familyp = AF_LOCAL;
2045 return sizeof (struct sockaddr_un);
2046 }
2047#endif
2048 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2049 {
2050 struct sockaddr *sa;
2051 *familyp = XINT (XCAR (address));
2052 p = XVECTOR (XCDR (address));
2053 return p->size + sizeof (sa->sa_family);
2054 }
2055 return 0;
2056}
2057
2058/* Convert an address object (vector or string) to an internal sockaddr.
2059 Format of address has already been validated by size_lisp_to_sockaddr. */
2060
2061static void
2062conv_lisp_to_sockaddr (family, address, sa, len)
2063 int family;
2064 Lisp_Object address;
2065 struct sockaddr *sa;
2066 int len;
2067{
2068 register struct Lisp_Vector *p;
2069 register unsigned char *cp;
2070 register int i;
2071
2072 bzero (sa, len);
2073 sa->sa_family = family;
2074
2075 if (VECTORP (address))
2076 {
2077 p = XVECTOR (address);
2078 if (family == AF_INET)
2079 {
2080 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2081 len = sizeof (sin->sin_addr) + 1;
2082 i = XINT (p->contents[--len]);
2083 sin->sin_port = htons (i);
2084 cp = (unsigned char *)&sin->sin_addr;
2085 }
2086 }
2087 else if (STRINGP (address))
2088 {
2089#ifdef HAVE_LOCAL_SOCKETS
2090 if (family == AF_LOCAL)
2091 {
2092 struct sockaddr_un *sun = (struct sockaddr_un *) sa;
2093 cp = XSTRING (address)->data;
2094 for (i = 0; i < sizeof (sun->sun_path) && *cp; i++)
2095 sun->sun_path[i] = *cp++;
2096 }
2097#endif
2098 return;
2099 }
2100 else
2101 {
2102 p = XVECTOR (XCDR (address));
2103 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2104 }
2105
2106 for (i = 0; i < len; i++)
2107 if (INTEGERP (p->contents[i]))
2108 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2109}
2110
2111#ifdef DATAGRAM_SOCKETS
2112DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2113 1, 1, 0,
2114 doc: /* Get the current datagram address associated with PROCESS. */)
2115 (process)
2116 Lisp_Object process;
2117{
2118 int channel;
2119
2120 CHECK_PROCESS (process);
2121
2122 if (!DATAGRAM_CONN_P (process))
2123 return Qnil;
2124
2125 channel = XPROCESS (process)->infd;
2126 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2127 datagram_address[channel].len);
2128}
2129
2130DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2131 2, 2, 0,
2132 doc: /* Set the datagram address for PROCESS to ADDRESS.
2133Returns nil upon error setting address, ADDRESS otherwise. */)
2134 (process, address)
2135 Lisp_Object process, address;
2136{
2137 int channel;
2138 int family, len;
2139
2140 CHECK_PROCESS (process);
2141
2142 if (!DATAGRAM_CONN_P (process))
2143 return Qnil;
2144
2145 channel = XPROCESS (process)->infd;
2146
2147 len = get_lisp_to_sockaddr_size (address, &family);
2148 if (datagram_address[channel].len != len)
2149 return Qnil;
2150 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2151 return address;
2152}
2153#endif
2154
2155
2156static struct socket_options {
2157 /* The name of this option. Should be lowercase version of option
2158 name without SO_ prefix. */
2159 char *name;
2160 /* Length of name. */
2161 int nlen;
2162 /* Option level SOL_... */
2163 int optlevel;
2164 /* Option number SO_... */
2165 int optnum;
2166 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype;
2167} socket_options[] =
2168 {
2169#ifdef SO_BINDTODEVICE
2170 { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
2171#endif
2172#ifdef SO_BROADCAST
2173 { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
2174#endif
2175#ifdef SO_DONTROUTE
2176 { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
2177#endif
2178#ifdef SO_KEEPALIVE
2179 { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
2180#endif
2181#ifdef SO_LINGER
2182 { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
2183#endif
2184#ifdef SO_OOBINLINE
2185 { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
2186#endif
2187#ifdef SO_PRIORITY
2188 { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
2189#endif
2190#ifdef SO_REUSEADDR
2191 { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
2192#endif
2193 { 0, 0, 0, 0, SOPT_UNKNOWN }
2194 };
2195
2196/* Process list of socket options OPTS on socket S.
2197 Only check if options are supported is S < 0.
2198 If NO_ERROR is non-zero, continue silently if an option
2199 cannot be set.
2200
2201 Each element specifies one option. An element is either a string
2202 "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string
2203 or a symbol. */
2204
2205static int
2206set_socket_options (s, opts, no_error)
2207 int s;
2208 Lisp_Object opts;
2209 int no_error;
2210{
2211 if (!CONSP (opts))
2212 opts = Fcons (opts, Qnil);
2213
2214 while (CONSP (opts))
2215 {
2216 Lisp_Object opt;
2217 Lisp_Object val;
2218 char *name, *arg;
2219 struct socket_options *sopt;
2220 int optnum, opttype;
2221 int ret = 0;
2222
2223 opt = XCAR (opts);
2224 opts = XCDR (opts);
2225
2226 name = 0;
2227 val = Qt;
2228 if (CONSP (opt))
2229 {
2230 val = XCDR (opt);
2231 opt = XCAR (opt);
2232 }
2233 if (STRINGP (opt))
2234 name = (char *) XSTRING (opt)->data;
2235 else if (SYMBOLP (opt))
2236 name = (char *) XSYMBOL (opt)->name->data;
2237 else {
2238 error ("Mal-formed option list");
2239 return 0;
2240 }
2241
2242 if (strncmp (name, "no", 2) == 0)
2243 {
2244 val = Qnil;
2245 name += 2;
2246 }
2247
2248 arg = 0;
2249 for (sopt = socket_options; sopt->name; sopt++)
2250 if (strncmp (name, sopt->name, sopt->nlen) == 0)
2251 {
2252 if (name[sopt->nlen] == 0)
2253 break;
2254 if (name[sopt->nlen] == '=')
2255 {
2256 arg = name + sopt->nlen + 1;
2257 break;
2258 }
2259 }
2260
2261 switch (sopt->opttype)
2262 {
2263 case SOPT_BOOL:
2264 {
2265 int optval;
2266 if (s < 0)
2267 return 1;
2268 if (arg)
2269 optval = (*arg == '0' || *arg == 'n') ? 0 : 1;
2270 else if (INTEGERP (val))
2271 optval = XINT (val) == 0 ? 0 : 1;
2272 else
2273 optval = NILP (val) ? 0 : 1;
2274 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2275 &optval, sizeof (optval));
2276 break;
2277 }
2278
2279 case SOPT_INT:
2280 {
2281 int optval;
2282 if (arg)
2283 optval = atoi(arg);
2284 else if (INTEGERP (val))
2285 optval = XINT (val);
2286 else
2287 error ("Bad option argument for %s", name);
2288 if (s < 0)
2289 return 1;
2290 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2291 &optval, sizeof (optval));
2292 break;
2293 }
2294
2295 case SOPT_STR:
2296 {
2297 if (!arg)
2298 {
2299 if (NILP (val))
2300 arg = "";
2301 else if (STRINGP (val))
2302 arg = (char *) XSTRING (val)->data;
2303 else if (XSYMBOL (val))
2304 arg = (char *) XSYMBOL (val)->name->data;
2305 else
2306 error ("Invalid argument to %s option", name);
2307 }
2308 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2309 arg, strlen (arg));
2310 }
2311
2312#ifdef SO_LINGER
2313 case SOPT_LINGER:
2314 {
2315 struct linger linger;
2316
2317 linger.l_onoff = 1;
2318 linger.l_linger = 0;
2319
2320 if (s < 0)
2321 return 1;
2322
2323 if (arg)
2324 {
2325 if (*arg == 'n' || *arg == 't' || *arg == 'y')
2326 linger.l_onoff = (*arg == 'n') ? 0 : 1;
2327 else
2328 linger.l_linger = atoi(arg);
2329 }
2330 else if (INTEGERP (val))
2331 linger.l_linger = XINT (val);
2332 else
2333 linger.l_onoff = NILP (val) ? 0 : 1;
2334 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2335 &linger, sizeof (linger));
2336 break;
2337 }
2338#endif
2339 default:
2340 if (s < 0)
2341 return 0;
2342 if (no_error)
2343 continue;
2344 error ("Unsupported option: %s", name);
2345 }
2346 if (ret < 0 && ! no_error)
2347 report_file_error ("Cannot set network option: %s", opt);
2348 }
2349 return 1;
2350}
2351
2352DEFUN ("set-network-process-options",
2353 Fset_network_process_options, Sset_network_process_options,
2354 1, MANY, 0,
2355 doc: /* Set one or more options for network process PROCESS.
2356Arguments are PROCESS &rest OPTIONS.
2357Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE).
2358A boolean value is false if it either zero or nil, true otherwise.
2359
2360The following options are known. Consult the relevant system manual
2361pages for more information.
2362
2363bindtodevice=NAME -- bind to interface NAME, or remove binding if nil.
2364broadcast=BOOL -- Allow send and receive of datagram broadcasts.
2365dontroute=BOOL -- Only send to directly connected hosts.
2366keepalive=BOOL -- Send keep-alive messages on network stream.
2367linger=BOOL or TIMEOUT -- Send queued messages before closing.
2368oobinline=BOOL -- Place out-of-band data in receive data stream.
2369priority=INT -- Set protocol defined priority for sent packets.
2370reuseaddr=BOOL -- Allow reusing a recently used address. */)
2371 (nargs, args)
2372 int nargs;
2373 Lisp_Object *args;
2374{
2375 Lisp_Object process;
2376 Lisp_Object opts;
2377
2378 process = args[0];
2379 CHECK_PROCESS (process);
2380 if (nargs > 1 && XPROCESS (process)->infd >= 0)
2381 {
2382 opts = Flist (nargs, args);
2383 set_socket_options (XPROCESS (process)->infd, opts, 0);
2384 }
2385 return process;
2386}
2387
2388/* Check whether a given KEY VALUE pair is supported on this system. */
2389
2390static int
2391network_process_featurep (key, value)
2392 Lisp_Object key, value;
2393{
2394
2395 if (EQ (key, QCnowait))
2396 {
2397#ifdef NON_BLOCKING_CONNECT
2398 return 1;
2399#else
2400 return NILP (value);
2401#endif
2402 }
2403
2404 if (EQ (key, QCdatagram))
2405 {
2406#ifdef DATAGRAM_SOCKETS
2407 return 1;
2408#else
2409 return NILP (value);
2410#endif
2411 }
2412
2413 if (EQ (key, QCfamily))
2414 {
2415 if (NILP (value))
2416 return 1;
2417#ifdef HAVE_LOCAL_SOCKETS
2418 if (EQ (key, Qlocal))
2419 return 1;
2420#endif
2421 return 0;
2422 }
2423
2424 if (EQ (key, QCname))
2425 return STRINGP (value);
2426
2427 if (EQ (key, QCbuffer))
2428 return (NILP (value) || STRINGP (value) || BUFFERP (value));
2429
2430 if (EQ (key, QClocal) || EQ (key, QCremote))
2431 {
2432 int family;
2433 return get_lisp_to_sockaddr_size (value, &family);
2434 }
2435
2436 if (EQ (key, QChost))
2437 return (NILP (value) || STRINGP (value));
2438
2439 if (EQ (key, QCservice))
2440 {
2441#ifdef HAVE_GETSOCKNAME
2442 if (EQ (value, Qt))
2443 return 1;
2444#endif
2445 return (INTEGERP (value) || STRINGP (value));
2446 }
2447
2448 if (EQ (key, QCserver))
2449 {
2450#ifndef TERM
2451 return 1;
2452#else
2453 return NILP (value);
2454#endif
2455 }
2456
2457 if (EQ (key, QCoptions))
2458 return set_socket_options (-1, value, 0);
2459
2460 if (EQ (key, QCcoding))
2461 return 1;
2462 if (EQ (key, QCsentinel))
2463 return 1;
2464 if (EQ (key, QCfilter))
2465 return 1;
2466 if (EQ (key, QClog))
2467 return 1;
2468 if (EQ (key, QCnoquery))
2469 return 1;
2470 if (EQ (key, QCstop))
2471 return 1;
2472
2473 return 0;
2474}
2475
2476/* A version of request_sigio suitable for a record_unwind_protect. */
2477
2478Lisp_Object
2479unwind_request_sigio (dummy)
2480 Lisp_Object dummy;
2481{
2482 if (interrupt_input)
2483 request_sigio ();
2484 return Qnil;
2485}
2486
2487/* Create a network stream/datagram client/server process. Treated
2488 exactly like a normal process when reading and writing. Primary
1783 differences are in status display and process deletion. A network 2489 differences are in status display and process deletion. A network
1784 connection has no PID; you cannot signal it. All you can do is 2490 connection has no PID; you cannot signal it. All you can do is
1785 deactivate and close it via delete-process */ 2491 stop/continue it and deactivate/close it via delete-process */
1786 2492
1787DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, 2493DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
1788 4, 7, 0, 2494 0, MANY, 0,
1789 doc: /* Open a TCP connection for a service to a host. 2495 doc: /* Create and return a network server or client process.
1790Returns a subprocess-object to represent the connection. 2496
1791Returns nil if a non-blocking connect is attempted on a system which 2497In emacs, network connections are represented by process objects, so
1792cannot support that; in that case, the caller should attempt a 2498input and output work as for subprocesses and `delete-process' closes
1793normal connect instead. 2499a network connection. However, a network process has no process id,
1794 2500it cannot be signalled, and the status codes are different from normal
1795Input and output work as for subprocesses; `delete-process' closes it. 2501processes.
1796Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING. 2502
1797NAME is name for process. It is modified if necessary to make it unique. 2503Arguments are specified as keyword/argument pairs. The following
1798BUFFER is the buffer (or buffer-name) to associate with the process. 2504arguments are defined:
1799 Process output goes at end of that buffer, unless you specify 2505
1800 an output stream or filter function to handle the output. 2506:name NAME -- NAME is name for process. It is modified if necessary
1801 BUFFER may be also nil, meaning that this process is not associated 2507to make it unique.
1802 with any buffer. 2508
1803HOST is name of the host to connect to, or its IP address. 2509:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1804SERVICE is name of the service desired, or an integer specifying a 2510with the process. Process output goes at end of that buffer, unless
1805 port number to connect to. 2511you specify an output stream or filter function to handle the output.
1806FILTER and SENTINEL are optional args specifying the filter and 2512BUFFER may be also nil, meaning that this process is not associated
1807 sentinel functions associated with the network stream. 2513with any buffer.
1808NON-BLOCKING is optional arg requesting an non-blocking connect. 2514
1809 When non-nil, open-network-stream will return immediately without 2515:host HOST -- HOST is name of the host to connect to, or its IP
1810 waiting for the connection to be made. Instead, the sentinel function 2516address. The symbol `local' specifies the local host. If specified
1811 will be called with second matching "open" (if successful) or 2517for a server process, it must be a valid name or address for the local
1812 "failed" when the connect completes. */) 2518host, and only clients connecting to that address will be accepted.
1813 (name, buffer, host, service, filter, sentinel, non_blocking) 2519
1814 Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking; 2520:service SERVICE -- SERVICE is name of the service desired, or an
2521integer specifying a port number to connect to. If SERVICE is t,
2522a random port number is selected for the server.
2523
2524:family FAMILY -- FAMILY is the address (and protocol) family for the
2525service specified by HOST and SERVICE. The default address family is
2526Inet (or IPv4) for the host and port number specified by HOST and
2527SERVICE. Other address families supported are:
2528 local -- for a local (i.e. UNIX) address specified by SERVICE.
2529
2530:local ADDRESS -- ADDRESS is the local address used for the connection.
2531This parameter is ignored when opening a client process. When specified
2532for a server process, the FAMILY, HOST and SERVICE args are ignored.
2533
2534:remote ADDRESS -- ADDRESS is the remote partner's address for the
2535connection. This parameter is ignored when opening a stream server
2536process. For a datagram server process, it specifies the initial
2537setting of the remote datagram address. When specified for a client
2538process, the FAMILY, HOST, and SERVICE args are ignored.
2539
2540The format of ADDRESS depends on the address family:
2541- An IPv4 address is represented as an vector of integers [A B C D P]
2542corresponding to numeric IP address A.B.C.D and port number P.
2543- A local address is represented as a string with the address in the
2544local address space.
2545- An "unsupported family" address is represented by a cons (F . AV)
2546where F is the family number and AV is a vector containing the socket
2547address data with one element per address data byte. Do not rely on
2548this format in portable code, as it may depend on implementation
2549defined constants, data sizes, and data structure alignment.
2550
2551:coding CODING -- CODING is coding system for this process.
2552
2553:datagram BOOL -- Create a datagram type connection if BOOL is
2554non-nil. Default is a stream type connection.
2555
2556:options OPTIONS -- Set the specified options for the network process.
2557See `set-process-options' for details.
2558
2559:nowait BOOL -- If BOOL is non-nil for a stream type client process,
2560return without waiting for the connection to complete; instead, the
2561sentinel function will be called with second arg matching "open" (if
2562successful) or "failed" when the connect completes. Default is to use
2563a blocking connect (i.e. wait) for stream type connections.
2564
2565:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
2566running when emacs is exited.
2567
2568:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2569In the stopped state, a server process does not accept new
2570connections, and a client process does not handle incoming traffic.
2571The stopped state is cleared by `continue-process' and set by
2572`stop-process'.
2573
2574:filter FILTER -- Install FILTER as the process filter.
2575
2576:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2577
2578:log LOG -- Install LOG as the server process log function. This
2579function is called as when the server accepts a network connection from a
2580client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2581is the server process, CLIENT is the new process for the connection,
2582and MESSAGE is a string.
2583
2584:server BOOL -- if BOOL is non-nil, create a server process for the
2585specified FAMILY, SERVICE, and connection type (stream or datagram).
2586Default is a client process.
2587
2588A server process will listen for and accept connections from
2589clients. When a client connection is accepted, a new network process
2590is created for the connection with the following parameters:
2591- The client's process name is constructed by concatenating the server
2592process' NAME and a client identification string.
2593- If the FILTER argument is non-nil, the client process will not get a
2594separate process buffer; otherwise, the client's process buffer is a newly
2595created buffer named after the server process' BUFFER name or process
2596NAME concatenated with the client identification string.
2597- The connection type and the process filter and sentinel parameters are
2598inherited from the server process' TYPE, FILTER and SENTINEL.
2599- The client process' contact info is set according to the client's
2600addressing information (typically an IP address and a port number).
2601
2602Notice that the FILTER and SENTINEL args are never used directly by
2603the server process. Also, the BUFFER argument is not used directly by
2604the server process, but via `network-server-log-function' hook, a log
2605of the accepted (and failed) connections may be recorded in the server
2606process' buffer.
2607
2608The following special call returns t iff a given KEY VALUE
2609pair is supported on this system:
2610 (make-network-process :feature KEY VALUE) */)
2611 (nargs, args)
2612 int nargs;
2613 Lisp_Object *args;
1815{ 2614{
1816 Lisp_Object proc; 2615 Lisp_Object proc;
2616 Lisp_Object contact;
2617 struct Lisp_Process *p;
1817#ifdef HAVE_GETADDRINFO 2618#ifdef HAVE_GETADDRINFO
1818 struct addrinfo hints, *res, *lres; 2619 struct addrinfo ai, *res, *lres;
1819 char *portstring, portbuf[128]; 2620 struct addrinfo hints;
2621 char *portstring, portbuf[128];
1820#else /* HAVE_GETADDRINFO */ 2622#else /* HAVE_GETADDRINFO */
1821 struct sockaddr_in address;
1822 struct servent *svc_info;
1823 struct hostent *host_info_ptr, host_info;
1824 char *(addr_list[2]);
1825 IN_ADDR numeric_addr;
1826 int port;
1827 struct _emacs_addrinfo 2623 struct _emacs_addrinfo
1828 { 2624 {
1829 int ai_family; 2625 int ai_family;
@@ -1834,150 +2630,313 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
1834 struct _emacs_addrinfo *ai_next; 2630 struct _emacs_addrinfo *ai_next;
1835 } ai, *res, *lres; 2631 } ai, *res, *lres;
1836#endif /* HAVE_GETADDRINFO */ 2632#endif /* HAVE_GETADDRINFO */
2633 struct sockaddr *sa = 0;
2634 struct sockaddr_in address_in;
2635#ifdef HAVE_LOCAL_SOCKETS
2636 struct sockaddr_un address_un;
2637#endif
2638 int port;
1837 int ret = 0; 2639 int ret = 0;
1838 int xerrno = 0; 2640 int xerrno = 0;
1839 int s = -1, outch, inch; 2641 int s = -1, outch, inch;
1840 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; 2642 struct gcpro gcpro1;
1841 int retry = 0; 2643 int retry = 0;
1842 int count = specpdl_ptr - specpdl; 2644 int count = specpdl_ptr - specpdl;
1843 int count1; 2645 int count1;
1844 int is_non_blocking = 0; 2646 Lisp_Object QCaddress; /* one of QClocal or QCremote */
2647 Lisp_Object tem;
2648 Lisp_Object name, buffer, host, service, address;
2649 Lisp_Object filter, sentinel;
2650 int is_non_blocking_client = 0;
2651 int is_server = 0;
2652 int socktype = SOCK_STREAM;
2653 int family = -1;
2654
2655 if (nargs == 0)
2656 return Qnil;
1845 2657
1846 if (!NILP (non_blocking)) 2658 /* Handle :feature KEY VALUE query. */
2659 if (EQ (args[0], QCfeature))
1847 { 2660 {
1848#ifndef NON_BLOCKING_CONNECT 2661 if (nargs != 3)
1849 return Qnil; 2662 return Qnil;
1850#else 2663 return network_process_featurep (args[1], args[2]) ? Qt : Qnil;
1851 non_blocking = Qt; /* Instead of GCPRO */
1852 is_non_blocking = 1;
1853#endif
1854 } 2664 }
1855 2665
2666 /* Save arguments for process-contact and clone-process. */
2667 contact = Flist (nargs, args);
2668 GCPRO1 (contact);
2669
1856#ifdef WINDOWSNT 2670#ifdef WINDOWSNT
1857 /* Ensure socket support is loaded if available. */ 2671 /* Ensure socket support is loaded if available. */
1858 init_winsock (TRUE); 2672 init_winsock (TRUE);
1859#endif 2673#endif
1860 2674
1861 /* Can only GCPRO 5 variables */ 2675 /* :datagram BOOL */
1862 GCPRO6 (name, buffer, host, service, sentinel, filter); 2676 tem = Fplist_get (contact, QCdatagram);
1863 CHECK_STRING (name); 2677 if (!NILP (tem))
1864 CHECK_STRING (host); 2678 {
2679#ifndef DATAGRAM_SOCKETS
2680 error ("Datagram connections not supported");
2681#else
2682 socktype = SOCK_DGRAM;
2683#endif
2684 }
1865 2685
1866#ifdef HAVE_GETADDRINFO 2686 /* :server BOOL */
1867 /* SERVICE can either be a string or int. 2687 tem = Fplist_get (contact, QCserver);
1868 Convert to a C string for later use by getaddrinfo. */ 2688 if (!NILP (tem))
1869 if (INTEGERP (service))
1870 { 2689 {
1871 sprintf (portbuf, "%ld", (long) XINT (service)); 2690#ifdef TERM
1872 portstring = portbuf; 2691 error ("Network servers not supported");
2692#else
2693 is_server = 1;
2694#endif
1873 } 2695 }
1874 else 2696
2697 /* Make QCaddress an alias for :local (server) or :remote (client). */
2698 QCaddress = is_server ? QClocal : QCremote;
2699
2700 /* :wait BOOL */
2701 if (!is_server && socktype == SOCK_STREAM
2702 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
1875 { 2703 {
1876 CHECK_STRING (service); 2704#ifndef NON_BLOCKING_CONNECT
1877 portstring = XSTRING (service)->data; 2705 error ("Non-blocking connect not supported");
2706#else
2707 is_non_blocking_client = 1;
2708#endif
1878 } 2709 }
1879#else /* HAVE_GETADDRINFO */ 2710
2711 name = Fplist_get (contact, QCname);
2712 buffer = Fplist_get (contact, QCbuffer);
2713 filter = Fplist_get (contact, QCfilter);
2714 sentinel = Fplist_get (contact, QCsentinel);
2715
2716 CHECK_STRING (name);
2717
2718#ifdef TERM
2719 /* Let's handle TERM before things get complicated ... */
2720 host = Fplist_get (contact, QChost);
2721 CHECK_STRING (host);
2722
2723 service = Fplist_get (contact, QCservice);
1880 if (INTEGERP (service)) 2724 if (INTEGERP (service))
1881 port = htons ((unsigned short) XINT (service)); 2725 port = htons ((unsigned short) XINT (service));
1882 else 2726 else
1883 { 2727 {
2728 struct servent *svc_info;
1884 CHECK_STRING (service); 2729 CHECK_STRING (service);
1885 svc_info = getservbyname (XSTRING (service)->data, "tcp"); 2730 svc_info = getservbyname (XSTRING (service)->data, "tcp");
1886 if (svc_info == 0) 2731 if (svc_info == 0)
1887 error ("Unknown service \"%s\"", XSTRING (service)->data); 2732 error ("Unknown service: %s", XSTRING (service)->data);
1888 port = svc_info->s_port; 2733 port = svc_info->s_port;
1889 } 2734 }
1890#endif /* HAVE_GETADDRINFO */
1891 2735
2736 s = connect_server (0);
2737 if (s < 0)
2738 report_file_error ("error creating socket", Fcons (name, Qnil));
2739 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2740 send_command (s, C_DUMB, 1, 0);
2741
2742#else /* not TERM */
2743
2744 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2745 ai.ai_socktype = socktype;
2746 ai.ai_protocol = 0;
2747 ai.ai_next = NULL;
2748 res = &ai;
2749
2750 /* :local ADDRESS or :remote ADDRESS */
2751 address = Fplist_get (contact, QCaddress);
2752 if (!NILP (address))
2753 {
2754 host = service = Qnil;
2755
2756 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2757 error ("Malformed :address");
2758 ai.ai_family = family;
2759 ai.ai_addr = alloca (ai.ai_addrlen);
2760 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2761 goto open_socket;
2762 }
2763
2764 /* :family FAMILY -- nil (for Inet), local, or integer. */
2765 tem = Fplist_get (contact, QCfamily);
2766 if (INTEGERP (tem))
2767 family = XINT (tem);
2768 else
2769 {
2770 if (NILP (tem))
2771 family = AF_INET;
2772#ifdef HAVE_LOCAL_SOCKETS
2773 else if (EQ (tem, Qlocal))
2774 family = AF_LOCAL;
2775#endif
2776 }
2777 if (family < 0)
2778 error ("Unknown address family");
2779 ai.ai_family = family;
2780
2781 /* :service SERVICE -- string, integer (port number), or t (random port). */
2782 service = Fplist_get (contact, QCservice);
2783
2784#ifdef HAVE_LOCAL_SOCKETS
2785 if (family == AF_LOCAL)
2786 {
2787 /* Host is not used. */
2788 host = Qnil;
2789 CHECK_STRING (service);
2790 bzero (&address_un, sizeof address_un);
2791 address_un.sun_family = AF_LOCAL;
2792 strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path);
2793 ai.ai_addr = (struct sockaddr *) &address_un;
2794 ai.ai_addrlen = sizeof address_un;
2795 goto open_socket;
2796 }
2797#endif
2798
2799 /* :host HOST -- hostname, ip address, or 'local for localhost. */
2800 host = Fplist_get (contact, QChost);
2801 if (!NILP (host))
2802 {
2803 if (EQ (host, Qlocal))
2804 host = build_string ("localhost");
2805 CHECK_STRING (host);
2806 }
1892 2807
1893 /* Slow down polling to every ten seconds. 2808 /* Slow down polling to every ten seconds.
1894 Some kernels have a bug which causes retrying connect to fail 2809 Some kernels have a bug which causes retrying connect to fail
1895 after a connect. Polling can interfere with gethostbyname too. */ 2810 after a connect. Polling can interfere with gethostbyname too. */
1896#ifdef POLL_FOR_INPUT 2811#ifdef POLL_FOR_INPUT
1897 record_unwind_protect (unwind_stop_other_atimers, Qnil); 2812 if (socktype == SOCK_STREAM)
1898 bind_polling_period (10); 2813 {
2814 record_unwind_protect (unwind_stop_other_atimers, Qnil);
2815 bind_polling_period (10);
2816 }
1899#endif 2817#endif
1900 2818
1901#ifndef TERM
1902#ifdef HAVE_GETADDRINFO 2819#ifdef HAVE_GETADDRINFO
1903 immediate_quit = 1; 2820 /* If we have a host, use getaddrinfo to resolve both host and service.
1904 QUIT; 2821 Otherwise, use getservbyname to lookup the service. */
1905 memset (&hints, 0, sizeof (hints)); 2822 if (!NILP (host))
1906 hints.ai_flags = 0; 2823 {
1907 hints.ai_family = AF_UNSPEC; 2824
1908 hints.ai_socktype = SOCK_STREAM; 2825 /* SERVICE can either be a string or int.
1909 hints.ai_protocol = 0; 2826 Convert to a C string for later use by getaddrinfo. */
1910 ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res); 2827 if (EQ (service, Qt))
1911 if (ret) 2828 portstring = "0";
2829 else if (INTEGERP (service))
2830 {
2831 sprintf (portbuf, "%ld", (long) XINT (service));
2832 portstring = portbuf;
2833 }
2834 else
2835 {
2836 CHECK_STRING (service);
2837 portstring = XSTRING (service)->data;
2838 }
2839
2840 immediate_quit = 1;
2841 QUIT;
2842 memset (&hints, 0, sizeof (hints));
2843 hints.ai_flags = 0;
2844 hints.ai_family = NILP (Fplist_member (contact, QCfamily)) ? AF_UNSPEC : family;
2845 hints.ai_socktype = socktype;
2846 hints.ai_protocol = 0;
2847 ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res);
2848 if (ret)
1912#ifdef HAVE_GAI_STRERROR 2849#ifdef HAVE_GAI_STRERROR
1913 error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret)); 2850 error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret));
1914#else 2851#else
1915 error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, 2852 error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret);
1916 ret);
1917#endif 2853#endif
1918 immediate_quit = 0; 2854 immediate_quit = 0;
2855
2856 goto open_socket;
2857 }
2858#endif /* HAVE_GETADDRINFO */
1919 2859
1920#else /* not HAVE_GETADDRINFO */ 2860 /* We end up here if getaddrinfo is not defined, or in case no hostname
2861 has been specified (e.g. for a local server process). */
1921 2862
1922 while (1) 2863 if (EQ (service, Qt))
2864 port = 0;
2865 else if (INTEGERP (service))
2866 port = htons ((unsigned short) XINT (service));
2867 else
1923 { 2868 {
1924#if 0 2869 struct servent *svc_info;
1925#ifdef TRY_AGAIN 2870 CHECK_STRING (service);
1926 h_errno = 0; 2871 svc_info = getservbyname (XSTRING (service)->data,
1927#endif 2872 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
1928#endif 2873 if (svc_info == 0)
2874 error ("Unknown service: %s", XSTRING (service)->data);
2875 port = svc_info->s_port;
2876 }
2877
2878 bzero (&address_in, sizeof address_in);
2879 address_in.sin_family = family;
2880 address_in.sin_addr.s_addr = INADDR_ANY;
2881 address_in.sin_port = port;
2882
2883#ifndef HAVE_GETADDRINFO
2884 if (!NILP (host))
2885 {
2886 struct hostent *host_info_ptr;
2887
2888 /* gethostbyname may fail with TRY_AGAIN, but we don't honour that,
2889 as it may `hang' emacs for a very long time. */
1929 immediate_quit = 1; 2890 immediate_quit = 1;
1930 QUIT; 2891 QUIT;
1931 host_info_ptr = gethostbyname (XSTRING (host)->data); 2892 host_info_ptr = gethostbyname (XSTRING (host)->data);
1932 immediate_quit = 0; 2893 immediate_quit = 0;
1933#if 0
1934#ifdef TRY_AGAIN
1935 if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN))
1936#endif
1937#endif
1938 break;
1939 Fsleep_for (make_number (1), Qnil);
1940 }
1941 2894
1942 if (host_info_ptr == 0) 2895 if (host_info_ptr)
1943 /* Attempt to interpret host as numeric inet address */ 2896 {
1944 { 2897 bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
1945 numeric_addr = inet_addr ((char *) XSTRING (host)->data); 2898 host_info_ptr->h_length);
1946 if (NUMERIC_ADDR_ERROR) 2899 family = host_info_ptr->h_addrtype;
1947 error ("Unknown host \"%s\"", XSTRING (host)->data); 2900 address_in.sin_family = family;
1948 2901 }
1949 host_info_ptr = &host_info; 2902 else
1950 host_info.h_name = 0; 2903 /* Attempt to interpret host as numeric inet address */
1951 host_info.h_aliases = 0; 2904 {
1952 host_info.h_addrtype = AF_INET; 2905 IN_ADDR numeric_addr;
1953#ifdef h_addr 2906 numeric_addr = inet_addr ((char *) XSTRING (host)->data);
1954 /* Older machines have only one address slot called h_addr. 2907 if (NUMERIC_ADDR_ERROR)
1955 Newer machines have h_addr_list, but #define h_addr to 2908 error ("Unknown host \"%s\"", XSTRING (host)->data);
1956 be its first element. */
1957 host_info.h_addr_list = &(addr_list[0]);
1958#endif
1959 host_info.h_addr = (char*)(&numeric_addr);
1960 addr_list[1] = 0;
1961 /* numeric_addr isn't null-terminated; it has fixed length. */
1962 host_info.h_length = sizeof (numeric_addr);
1963 }
1964 2909
1965 bzero (&address, sizeof address); 2910 bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr,
1966 bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr, 2911 sizeof (address_in.sin_addr));
1967 host_info_ptr->h_length); 2912 }
1968 address.sin_family = host_info_ptr->h_addrtype;
1969 address.sin_port = port;
1970 2913
1971 /* Emulate HAVE_GETADDRINFO for the loop over `res' below. */ 2914 }
1972 ai.ai_family = host_info_ptr->h_addrtype;
1973 ai.ai_socktype = SOCK_STREAM;
1974 ai.ai_protocol = 0;
1975 ai.ai_addr = (struct sockaddr *) &address;
1976 ai.ai_addrlen = sizeof address;
1977 ai.ai_next = NULL;
1978 res = &ai;
1979#endif /* not HAVE_GETADDRINFO */ 2915#endif /* not HAVE_GETADDRINFO */
1980 2916
2917 ai.ai_family = family;
2918 ai.ai_addr = (struct sockaddr *) &address_in;
2919 ai.ai_addrlen = sizeof address_in;
2920
2921 open_socket:
2922
2923 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2924 when connect is interrupted. So let's not let it get interrupted.
2925 Note we do not turn off polling, because polling is only used
2926 when not interrupt_input, and thus not normally used on the systems
2927 which have this bug. On systems which use polling, there's no way
2928 to quit if polling is turned off. */
2929 if (interrupt_input
2930 && !is_server && socktype == SOCK_STREAM)
2931 {
2932 /* Comment from KFS: The original open-network-stream code
2933 didn't unwind protect this, but it seems like the proper
2934 thing to do. In any case, I don't see how it could harm to
2935 do this -- and it makes cleanup (using unbind_to) easier. */
2936 record_unwind_protect (unwind_request_sigio, Qnil);
2937 unrequest_sigio ();
2938 }
2939
1981 /* Do this in case we never enter the for-loop below. */ 2940 /* Do this in case we never enter the for-loop below. */
1982 count1 = specpdl_ptr - specpdl; 2941 count1 = specpdl_ptr - specpdl;
1983 s = -1; 2942 s = -1;
@@ -1991,8 +2950,13 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
1991 continue; 2950 continue;
1992 } 2951 }
1993 2952
2953#ifdef DATAGRAM_SOCKETS
2954 if (!is_server && socktype == SOCK_DGRAM)
2955 break;
2956#endif /* DATAGRAM_SOCKETS */
2957
1994#ifdef NON_BLOCKING_CONNECT 2958#ifdef NON_BLOCKING_CONNECT
1995 if (is_non_blocking) 2959 if (is_non_blocking_client)
1996 { 2960 {
1997#ifdef O_NONBLOCK 2961#ifdef O_NONBLOCK
1998 ret = fcntl (s, F_SETFL, O_NONBLOCK); 2962 ret = fcntl (s, F_SETFL, O_NONBLOCK);
@@ -2008,21 +2972,46 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2008 } 2972 }
2009 } 2973 }
2010#endif 2974#endif
2011 2975
2012 /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR)
2013 when connect is interrupted. So let's not let it get interrupted.
2014 Note we do not turn off polling, because polling is only used
2015 when not interrupt_input, and thus not normally used on the systems
2016 which have this bug. On systems which use polling, there's no way
2017 to quit if polling is turned off. */
2018 if (interrupt_input)
2019 unrequest_sigio ();
2020
2021 /* Make us close S if quit. */ 2976 /* Make us close S if quit. */
2022 count1 = specpdl_ptr - specpdl;
2023 record_unwind_protect (close_file_unwind, make_number (s)); 2977 record_unwind_protect (close_file_unwind, make_number (s));
2024 2978
2025 loop: 2979 if (is_server)
2980 {
2981 /* Configure as a server socket. */
2982#ifdef HAVE_LOCAL_SOCKETS
2983 if (family != AF_LOCAL)
2984#endif
2985 {
2986 int optval = 1;
2987 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
2988 report_file_error ("Cannot set reuse option on server socket.", Qnil);
2989 }
2990
2991 if (bind (s, lres->ai_addr, lres->ai_addrlen))
2992 report_file_error ("Cannot bind server socket", Qnil);
2993
2994#ifdef HAVE_GETSOCKNAME
2995 if (EQ (service, Qt))
2996 {
2997 struct sockaddr_in sa1;
2998 int len1 = sizeof (sa1);
2999 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3000 {
3001 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
3002 service = make_number (sa1.sin_port);
3003 contact = Fplist_put (contact, QCservice, service);
3004 }
3005 }
3006#endif
3007
3008 if (socktype == SOCK_STREAM && listen (s, 5))
3009 report_file_error ("Cannot listen on server socket", Qnil);
3010
3011 break;
3012 }
3013
3014 retry_connect:
2026 3015
2027 immediate_quit = 1; 3016 immediate_quit = 1;
2028 QUIT; 3017 QUIT;
@@ -2046,7 +3035,6 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2046 3035
2047 if (ret == 0 || xerrno == EISCONN) 3036 if (ret == 0 || xerrno == EISCONN)
2048 { 3037 {
2049 is_non_blocking = 0;
2050 /* The unwind-protect will be discarded afterwards. 3038 /* The unwind-protect will be discarded afterwards.
2051 Likewise for immediate_quit. */ 3039 Likewise for immediate_quit. */
2052 break; 3040 break;
@@ -2054,11 +3042,11 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2054 3042
2055#ifdef NON_BLOCKING_CONNECT 3043#ifdef NON_BLOCKING_CONNECT
2056#ifdef EINPROGRESS 3044#ifdef EINPROGRESS
2057 if (is_non_blocking && xerrno == EINPROGRESS) 3045 if (is_non_blocking_client && xerrno == EINPROGRESS)
2058 break; 3046 break;
2059#else 3047#else
2060#ifdef EWOULDBLOCK 3048#ifdef EWOULDBLOCK
2061 if (is_non_blocking && xerrno == EWOULDBLOCK) 3049 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
2062 break; 3050 break;
2063#endif 3051#endif
2064#endif 3052#endif
@@ -2067,7 +3055,7 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2067 immediate_quit = 0; 3055 immediate_quit = 0;
2068 3056
2069 if (xerrno == EINTR) 3057 if (xerrno == EINTR)
2070 goto loop; 3058 goto retry_connect;
2071 if (xerrno == EADDRINUSE && retry < 20) 3059 if (xerrno == EADDRINUSE && retry < 20)
2072 { 3060 {
2073 /* A delay here is needed on some FreeBSD systems, 3061 /* A delay here is needed on some FreeBSD systems,
@@ -2075,62 +3063,79 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2075 and should be infrequent. */ 3063 and should be infrequent. */
2076 Fsleep_for (make_number (1), Qnil); 3064 Fsleep_for (make_number (1), Qnil);
2077 retry++; 3065 retry++;
2078 goto loop; 3066 goto retry_connect;
2079 } 3067 }
2080 3068
2081 /* Discard the unwind protect closing S. */ 3069 /* Discard the unwind protect closing S. */
2082 specpdl_ptr = specpdl + count1; 3070 specpdl_ptr = specpdl + count1;
2083 count1 = specpdl_ptr - specpdl;
2084
2085 emacs_close (s); 3071 emacs_close (s);
2086 s = -1; 3072 s = -1;
2087 } 3073 }
2088 3074
3075 if (s >= 0)
3076 {
3077#ifdef DATAGRAM_SOCKETS
3078 if (socktype == SOCK_DGRAM)
3079 {
3080 if (datagram_address[s].sa)
3081 abort ();
3082 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3083 datagram_address[s].len = lres->ai_addrlen;
3084 if (is_server)
3085 {
3086 Lisp_Object remote;
3087 bzero (datagram_address[s].sa, lres->ai_addrlen);
3088 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3089 {
3090 int rfamily, rlen;
3091 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3092 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3093 conv_lisp_to_sockaddr (rfamily, remote,
3094 datagram_address[s].sa, rlen);
3095 }
3096 }
3097 else
3098 bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
3099 }
3100#endif
3101 contact = Fplist_put (contact, QCaddress,
3102 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
3103 }
3104
2089#ifdef HAVE_GETADDRINFO 3105#ifdef HAVE_GETADDRINFO
2090 freeaddrinfo (res); 3106 if (res != &ai)
3107 freeaddrinfo (res);
2091#endif 3108#endif
2092 3109
3110 immediate_quit = 0;
3111
3112 /* Discard the unwind protect for closing S, if any. */
3113 specpdl_ptr = specpdl + count1;
3114
3115 /* Unwind bind_polling_period and request_sigio. */
3116 unbind_to (count, Qnil);
3117
2093 if (s < 0) 3118 if (s < 0)
2094 { 3119 {
2095 if (interrupt_input)
2096 request_sigio ();
2097
2098 /* If non-blocking got this far - and failed - assume non-blocking is 3120 /* If non-blocking got this far - and failed - assume non-blocking is
2099 not supported after all. This is probably a wrong assumption, but 3121 not supported after all. This is probably a wrong assumption, but
2100 the normal blocking calls to open-network-stream handles this error 3122 the normal blocking calls to open-network-stream handles this error
2101 better. */ 3123 better. */
2102 if (is_non_blocking) 3124 if (is_non_blocking_client)
2103 {
2104#ifdef POLL_FOR_INPUT
2105 unbind_to (count, Qnil);
2106#endif
2107 return Qnil; 3125 return Qnil;
2108 }
2109 3126
2110 errno = xerrno; 3127 errno = xerrno;
2111 report_file_error ("connection failed", 3128 if (is_server)
2112 Fcons (host, Fcons (name, Qnil))); 3129 report_file_error ("make server process failed", contact);
3130 else
3131 report_file_error ("make client process failed", contact);
2113 } 3132 }
2114
2115 immediate_quit = 0;
2116 3133
2117 /* Discard the unwind protect, if any. */ 3134 tem = Fplist_get (contact, QCoptions);
2118 specpdl_ptr = specpdl + count1; 3135 if (!NILP (tem))
3136 set_socket_options (s, tem, 1);
2119 3137
2120#ifdef POLL_FOR_INPUT 3138#endif /* not TERM */
2121 unbind_to (count, Qnil);
2122#endif
2123
2124 if (interrupt_input)
2125 request_sigio ();
2126
2127#else /* TERM */
2128 s = connect_server (0);
2129 if (s < 0)
2130 report_file_error ("error creating socket", Fcons (name, Qnil));
2131 send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port));
2132 send_command (s, C_DUMB, 1, 0);
2133#endif /* TERM */
2134 3139
2135 inch = s; 3140 inch = s;
2136 outch = s; 3141 outch = s;
@@ -2149,24 +3154,30 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2149#endif 3154#endif
2150#endif 3155#endif
2151 3156
2152 XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil)); 3157 p = XPROCESS (proc);
2153 XPROCESS (proc)->command_channel_p = Qnil; 3158
2154 XPROCESS (proc)->buffer = buffer; 3159 p->childp = contact;
2155 XPROCESS (proc)->sentinel = sentinel; 3160 p->buffer = buffer;
2156 XPROCESS (proc)->filter = filter; 3161 p->sentinel = sentinel;
2157 XPROCESS (proc)->command = Qnil; 3162 p->filter = filter;
2158 XPROCESS (proc)->pid = Qnil; 3163 p->log = Fplist_get (contact, QClog);
2159 XSETINT (XPROCESS (proc)->infd, inch); 3164 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2160 XSETINT (XPROCESS (proc)->outfd, outch); 3165 p->kill_without_query = Qt;
2161 XPROCESS (proc)->status = Qrun; 3166 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3167 p->command = Qt;
3168 p->pid = Qnil;
3169 XSETINT (p->infd, inch);
3170 XSETINT (p->outfd, outch);
3171 if (is_server && socktype == SOCK_STREAM)
3172 p->status = Qlisten;
2162 3173
2163#ifdef NON_BLOCKING_CONNECT 3174#ifdef NON_BLOCKING_CONNECT
2164 if (!NILP (non_blocking)) 3175 if (is_non_blocking_client)
2165 { 3176 {
2166 /* We may get here if connect did succeed immediately. However, 3177 /* We may get here if connect did succeed immediately. However,
2167 in that case, we still need to signal this like a non-blocking 3178 in that case, we still need to signal this like a non-blocking
2168 connection. */ 3179 connection. */
2169 XPROCESS (proc)->status = Qconnect; 3180 p->status = Qconnect;
2170 if (!FD_ISSET (inch, &connect_wait_mask)) 3181 if (!FD_ISSET (inch, &connect_wait_mask))
2171 { 3182 {
2172 FD_SET (inch, &connect_wait_mask); 3183 FD_SET (inch, &connect_wait_mask);
@@ -2175,7 +3186,10 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2175 } 3186 }
2176 else 3187 else
2177#endif 3188#endif
2178 if (!EQ (XPROCESS (proc)->filter, Qt)) 3189 /* A server may have a client filter setting of Qt, but it must
3190 still listen for incoming connects unless it is stopped. */
3191 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3192 || (EQ (p->status, Qlisten) && NILP (p->command)))
2179 { 3193 {
2180 FD_SET (inch, &input_wait_mask); 3194 FD_SET (inch, &input_wait_mask);
2181 FD_SET (inch, &non_keyboard_wait_mask); 3195 FD_SET (inch, &non_keyboard_wait_mask);
@@ -2184,6 +3198,10 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2184 if (inch > max_process_desc) 3198 if (inch > max_process_desc)
2185 max_process_desc = inch; 3199 max_process_desc = inch;
2186 3200
3201 tem = Fplist_member (contact, QCcoding);
3202 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3203 tem = Qnil; /* No error message (too late!). */
3204
2187 { 3205 {
2188 /* Setup coding systems for communicating with the network stream. */ 3206 /* Setup coding systems for communicating with the network stream. */
2189 struct gcpro gcpro1; 3207 struct gcpro gcpro1;
@@ -2191,7 +3209,9 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2191 Lisp_Object coding_systems = Qt; 3209 Lisp_Object coding_systems = Qt;
2192 Lisp_Object args[5], val; 3210 Lisp_Object args[5], val;
2193 3211
2194 if (!NILP (Vcoding_system_for_read)) 3212 if (!NILP (tem))
3213 val = XCAR (XCDR (tem));
3214 else if (!NILP (Vcoding_system_for_read))
2195 val = Vcoding_system_for_read; 3215 val = Vcoding_system_for_read;
2196 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) 3216 else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
2197 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) 3217 || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters)))
@@ -2214,9 +3234,11 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2214 else 3234 else
2215 val = Qnil; 3235 val = Qnil;
2216 } 3236 }
2217 XPROCESS (proc)->decode_coding_system = val; 3237 p->decode_coding_system = val;
2218 3238
2219 if (!NILP (Vcoding_system_for_write)) 3239 if (!NILP (tem))
3240 val = XCAR (XCDR (tem));
3241 else if (!NILP (Vcoding_system_for_write))
2220 val = Vcoding_system_for_write; 3242 val = Vcoding_system_for_write;
2221 else if (NILP (current_buffer->enable_multibyte_characters)) 3243 else if (NILP (current_buffer->enable_multibyte_characters))
2222 val = Qnil; 3244 val = Qnil;
@@ -2237,27 +3259,27 @@ NON-BLOCKING is optional arg requesting an non-blocking connect.
2237 else 3259 else
2238 val = Qnil; 3260 val = Qnil;
2239 } 3261 }
2240 XPROCESS (proc)->encode_coding_system = val; 3262 p->encode_coding_system = val;
2241 } 3263 }
2242 3264
2243 if (!proc_decode_coding_system[inch]) 3265 if (!proc_decode_coding_system[inch])
2244 proc_decode_coding_system[inch] 3266 proc_decode_coding_system[inch]
2245 = (struct coding_system *) xmalloc (sizeof (struct coding_system)); 3267 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
2246 setup_coding_system (XPROCESS (proc)->decode_coding_system, 3268 setup_coding_system (p->decode_coding_system,
2247 proc_decode_coding_system[inch]); 3269 proc_decode_coding_system[inch]);
2248 if (!proc_encode_coding_system[outch]) 3270 if (!proc_encode_coding_system[outch])
2249 proc_encode_coding_system[outch] 3271 proc_encode_coding_system[outch]
2250 = (struct coding_system *) xmalloc (sizeof (struct coding_system)); 3272 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
2251 setup_coding_system (XPROCESS (proc)->encode_coding_system, 3273 setup_coding_system (p->encode_coding_system,
2252 proc_encode_coding_system[outch]); 3274 proc_encode_coding_system[outch]);
2253 3275
2254 XPROCESS (proc)->decoding_buf = make_uninit_string (0); 3276 p->decoding_buf = make_uninit_string (0);
2255 XPROCESS (proc)->decoding_carryover = make_number (0); 3277 p->decoding_carryover = make_number (0);
2256 XPROCESS (proc)->encoding_buf = make_uninit_string (0); 3278 p->encoding_buf = make_uninit_string (0);
2257 XPROCESS (proc)->encoding_carryover = make_number (0); 3279 p->encoding_carryover = make_number (0);
2258 3280
2259 XPROCESS (proc)->inherit_coding_system_flag 3281 p->inherit_coding_system_flag
2260 = (NILP (buffer) || !inherit_process_coding_system 3282 = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system
2261 ? Qnil : Qt); 3283 ? Qnil : Qt);
2262 3284
2263 UNGCPRO; 3285 UNGCPRO;
@@ -2295,6 +3317,14 @@ deactivate_process (proc)
2295 3317
2296 XSETINT (p->infd, -1); 3318 XSETINT (p->infd, -1);
2297 XSETINT (p->outfd, -1); 3319 XSETINT (p->outfd, -1);
3320#ifdef DATAGRAM_SOCKETS
3321 if (DATAGRAM_CHAN_P (inchannel))
3322 {
3323 xfree (datagram_address[inchannel].sa);
3324 datagram_address[inchannel].sa = 0;
3325 datagram_address[inchannel].len = 0;
3326 }
3327#endif
2298 chan_process[inchannel] = Qnil; 3328 chan_process[inchannel] = Qnil;
2299 FD_CLR (inchannel, &input_wait_mask); 3329 FD_CLR (inchannel, &input_wait_mask);
2300 FD_CLR (inchannel, &non_keyboard_wait_mask); 3330 FD_CLR (inchannel, &non_keyboard_wait_mask);
@@ -2411,6 +3441,202 @@ Return non-nil iff we received any output before the timeout expired. */)
2411 ? Qt : Qnil); 3441 ? Qt : Qnil);
2412} 3442}
2413 3443
3444/* Accept a connection for server process SERVER on CHANNEL. */
3445
3446static int connect_counter = 0;
3447
3448static void
3449server_accept_connection (server, channel)
3450 Lisp_Object server;
3451 int channel;
3452{
3453 Lisp_Object proc, caller, name, buffer;
3454 Lisp_Object contact, host, service;
3455 struct Lisp_Process *ps= XPROCESS (server);
3456 struct Lisp_Process *p;
3457 int s;
3458 union u_sockaddr {
3459 struct sockaddr sa;
3460 struct sockaddr_in in;
3461#ifdef HAVE_LOCAL_SOCKETS
3462 struct sockaddr_un un;
3463#endif
3464 } saddr;
3465 int len = sizeof saddr;
3466
3467 s = accept (channel, &saddr.sa, &len);
3468
3469 if (s < 0)
3470 {
3471 int code = errno;
3472
3473 if (code == EAGAIN)
3474 return;
3475#ifdef EWOULDBLOCK
3476 if (code == EWOULDBLOCK)
3477 return;
3478#endif
3479
3480 if (!NILP (ps->log))
3481 call3 (ps->log, server, Qnil,
3482 concat3 (build_string ("accept failed with code"),
3483 Fnumber_to_string (make_number (code)),
3484 build_string ("\n")));
3485 return;
3486 }
3487
3488 connect_counter++;
3489
3490 /* Setup a new process to handle the connection. */
3491
3492 /* Generate a unique identification of the caller, and build contact
3493 information for this process. */
3494 host = Qt;
3495 service = Qnil;
3496 switch (saddr.sa.sa_family)
3497 {
3498 case AF_INET:
3499 {
3500 Lisp_Object args[5];
3501 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
3502 args[0] = build_string ("%d.%d.%d.%d");
3503 args[1] = make_number (*ip++);
3504 args[2] = make_number (*ip++);
3505 args[3] = make_number (*ip++);
3506 args[4] = make_number (*ip++);
3507 host = Fformat (5, args);
3508 service = make_number (ntohs (saddr.in.sin_port));
3509
3510 args[0] = build_string (" <%s:%d>");
3511 args[1] = host;
3512 args[2] = service;
3513 caller = Fformat (3, args);
3514 }
3515 break;
3516
3517#ifdef HAVE_LOCAL_SOCKETS
3518 case AF_LOCAL:
3519#endif
3520 default:
3521 caller = Fnumber_to_string (make_number (connect_counter));
3522 caller = concat3 (build_string (" <*"), caller, build_string ("*>"));
3523 break;
3524 }
3525
3526 /* Create a new buffer name for this process if it doesn't have a
3527 filter. The new buffer name is based on the buffer name or
3528 process name of the server process concatenated with the caller
3529 identification. */
3530
3531 if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
3532 buffer = Qnil;
3533 else
3534 {
3535 buffer = ps->buffer;
3536 if (!NILP (buffer))
3537 buffer = Fbuffer_name (buffer);
3538 else
3539 buffer = ps->name;
3540 if (!NILP (buffer))
3541 {
3542 buffer = concat2 (buffer, caller);
3543 buffer = Fget_buffer_create (buffer);
3544 }
3545 }
3546
3547 /* Generate a unique name for the new server process. Combine the
3548 server process name with the caller identification. */
3549
3550 name = concat2 (ps->name, caller);
3551 proc = make_process (name);
3552
3553 chan_process[s] = proc;
3554
3555#ifdef O_NONBLOCK
3556 fcntl (s, F_SETFL, O_NONBLOCK);
3557#else
3558#ifdef O_NDELAY
3559 fcntl (s, F_SETFL, O_NDELAY);
3560#endif
3561#endif
3562
3563 p = XPROCESS (proc);
3564
3565 /* Build new contact information for this setup. */
3566 contact = Fcopy_sequence (ps->childp);
3567 contact = Fplist_put (contact, QCserver, Qnil);
3568 contact = Fplist_put (contact, QChost, host);
3569 if (!NILP (service))
3570 contact = Fplist_put (contact, QCservice, service);
3571 contact = Fplist_put (contact, QCremote,
3572 conv_sockaddr_to_lisp (&saddr.sa, len));
3573#ifdef HAVE_GETSOCKNAME
3574 len = sizeof saddr;
3575 if (getsockname (channel, &saddr.sa, &len) == 0)
3576 contact = Fplist_put (contact, QClocal,
3577 conv_sockaddr_to_lisp (&saddr.sa, len));
3578#endif
3579
3580 p->childp = contact;
3581 p->buffer = buffer;
3582 p->sentinel = ps->sentinel;
3583 p->filter = ps->filter;
3584 p->command = Qnil;
3585 p->pid = Qnil;
3586 XSETINT (p->infd, s);
3587 XSETINT (p->outfd, s);
3588 p->status = Qrun;
3589
3590 /* Client processes for accepted connections are not stopped initially. */
3591 if (!EQ (p->filter, Qt))
3592 {
3593 FD_SET (s, &input_wait_mask);
3594 FD_SET (s, &non_keyboard_wait_mask);
3595 }
3596
3597 if (s > max_process_desc)
3598 max_process_desc = s;
3599
3600 /* Setup coding system for new process based on server process.
3601 This seems to be the proper thing to do, as the coding system
3602 of the new process should reflect the settings at the time the
3603 server socket was opened; not the current settings. */
3604
3605 p->decode_coding_system = ps->decode_coding_system;
3606 p->encode_coding_system = ps->encode_coding_system;
3607
3608 if (!proc_decode_coding_system[s])
3609 proc_decode_coding_system[s]
3610 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3611 setup_coding_system (p->decode_coding_system,
3612 proc_decode_coding_system[s]);
3613 if (!proc_encode_coding_system[s])
3614 proc_encode_coding_system[s]
3615 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
3616 setup_coding_system (p->encode_coding_system,
3617 proc_encode_coding_system[s]);
3618
3619 p->decoding_buf = make_uninit_string (0);
3620 p->decoding_carryover = make_number (0);
3621 p->encoding_buf = make_uninit_string (0);
3622 p->encoding_carryover = make_number (0);
3623
3624 p->inherit_coding_system_flag
3625 = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag);
3626
3627 if (!NILP (ps->log))
3628 call3 (ps->log, server, proc,
3629 concat3 (build_string ("accept from "),
3630 (STRINGP (host) ? host : build_string ("-")),
3631 build_string ("\n")));
3632
3633 if (p->sentinel)
3634 exec_sentinel (proc,
3635 concat3 (build_string ("open from "),
3636 (STRINGP (host) ? host : build_string ("-")),
3637 build_string ("\n")));
3638}
3639
2414/* This variable is different from waiting_for_input in keyboard.c. 3640/* This variable is different from waiting_for_input in keyboard.c.
2415 It is used to communicate to a lisp process-filter/sentinel (via the 3641 It is used to communicate to a lisp process-filter/sentinel (via the
2416 function Fwaiting_for_user_input_p below) whether emacs was waiting 3642 function Fwaiting_for_user_input_p below) whether emacs was waiting
@@ -2909,6 +4135,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
2909 if (NILP (proc)) 4135 if (NILP (proc))
2910 continue; 4136 continue;
2911 4137
4138 /* If this is a server stream socket, accept connection. */
4139 if (EQ (XPROCESS (proc)->status, Qlisten))
4140 {
4141 server_accept_connection (proc, channel);
4142 continue;
4143 }
4144
2912 /* Read data from the process, starting with our 4145 /* Read data from the process, starting with our
2913 buffered-ahead character if we have one. */ 4146 buffered-ahead character if we have one. */
2914 4147
@@ -2983,7 +4216,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
2983 { 4216 {
2984 struct Lisp_Process *p; 4217 struct Lisp_Process *p;
2985 struct sockaddr pname; 4218 struct sockaddr pname;
2986 socklen_t pnamelen = sizeof(pname); 4219 int pnamelen = sizeof(pname);
2987 4220
2988 FD_CLR (channel, &connect_wait_mask); 4221 FD_CLR (channel, &connect_wait_mask);
2989 if (--num_pending_connects < 0) 4222 if (--num_pending_connects < 0)
@@ -2999,7 +4232,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
2999 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems. 4232 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
3000 So only use it on systems where it is known to work. */ 4233 So only use it on systems where it is known to work. */
3001 { 4234 {
3002 socklen_t xlen = sizeof(xerrno); 4235 int xlen = sizeof(xerrno);
3003 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen)) 4236 if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
3004 xerrno = errno; 4237 xerrno = errno;
3005 } 4238 }
@@ -3028,7 +4261,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display)
3028 status_notify to do it later, it will read input 4261 status_notify to do it later, it will read input
3029 from the process before calling the sentinel. */ 4262 from the process before calling the sentinel. */
3030 exec_sentinel (proc, build_string ("open\n")); 4263 exec_sentinel (proc, build_string ("open\n"));
3031 if (!EQ (p->filter, Qt)) 4264 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3032 { 4265 {
3033 FD_SET (XINT (p->infd), &input_wait_mask); 4266 FD_SET (XINT (p->infd), &input_wait_mask);
3034 FD_SET (XINT (p->infd), &non_keyboard_wait_mask); 4267 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
@@ -3106,6 +4339,7 @@ read_process_output (proc, channel)
3106 register int opoint; 4339 register int opoint;
3107 struct coding_system *coding = proc_decode_coding_system[channel]; 4340 struct coding_system *coding = proc_decode_coding_system[channel];
3108 int carryover = XINT (p->decoding_carryover); 4341 int carryover = XINT (p->decoding_carryover);
4342 int readmax = 1024;
3109 4343
3110#ifdef VMS 4344#ifdef VMS
3111 VMS_PROC_STUFF *vs, *get_vms_process_pointer(); 4345 VMS_PROC_STUFF *vs, *get_vms_process_pointer();
@@ -3137,18 +4371,39 @@ read_process_output (proc, channel)
3137 bcopy (vs->inputBuffer, chars + carryover, nbytes); 4371 bcopy (vs->inputBuffer, chars + carryover, nbytes);
3138 } 4372 }
3139#else /* not VMS */ 4373#else /* not VMS */
3140 chars = (char *) alloca (carryover + 1024); 4374
4375#ifdef DATAGRAM_SOCKETS
4376 /* A datagram is one packet; allow at least 1500+ bytes of data
4377 corresponding to the typical Ethernet frame size. */
4378 if (DATAGRAM_CHAN_P (channel))
4379 {
4380 /* carryover = 0; */ /* Does carryover make sense for datagrams? */
4381 readmax += 1024;
4382 }
4383#endif
4384
4385 chars = (char *) alloca (carryover + readmax);
3141 if (carryover) 4386 if (carryover)
3142 /* See the comment above. */ 4387 /* See the comment above. */
3143 bcopy (XSTRING (p->decoding_buf)->data, chars, carryover); 4388 bcopy (XSTRING (p->decoding_buf)->data, chars, carryover);
3144 4389
4390#ifdef DATAGRAM_SOCKETS
4391 /* We have a working select, so proc_buffered_char is always -1. */
4392 if (DATAGRAM_CHAN_P (channel))
4393 {
4394 int len = datagram_address[channel].len;
4395 nbytes = recvfrom (channel, chars + carryover, readmax - carryover,
4396 0, datagram_address[channel].sa, &len);
4397 }
4398 else
4399#endif
3145 if (proc_buffered_char[channel] < 0) 4400 if (proc_buffered_char[channel] < 0)
3146 nbytes = emacs_read (channel, chars + carryover, 1024 - carryover); 4401 nbytes = emacs_read (channel, chars + carryover, readmax - carryover);
3147 else 4402 else
3148 { 4403 {
3149 chars[carryover] = proc_buffered_char[channel]; 4404 chars[carryover] = proc_buffered_char[channel];
3150 proc_buffered_char[channel] = -1; 4405 proc_buffered_char[channel] = -1;
3151 nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover); 4406 nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover);
3152 if (nbytes < 0) 4407 if (nbytes < 0)
3153 nbytes = 1; 4408 nbytes = 1;
3154 else 4409 else
@@ -3614,9 +4869,20 @@ send_process (proc, buf, len, object)
3614 /* Send this batch, using one or more write calls. */ 4869 /* Send this batch, using one or more write calls. */
3615 while (this > 0) 4870 while (this > 0)
3616 { 4871 {
4872 int outfd = XINT (XPROCESS (proc)->outfd);
3617 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); 4873 old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap);
3618 rv = emacs_write (XINT (XPROCESS (proc)->outfd), 4874#ifdef DATAGRAM_SOCKETS
3619 (char *) buf, this); 4875 if (DATAGRAM_CHAN_P (outfd))
4876 {
4877 rv = sendto (outfd, (char *) buf, this,
4878 0, datagram_address[outfd].sa,
4879 datagram_address[outfd].len);
4880 if (rv < 0 && errno == EMSGSIZE)
4881 report_file_error ("sending datagram", Fcons (proc, Qnil));
4882 }
4883 else
4884#endif
4885 rv = emacs_write (outfd, (char *) buf, this);
3620 signal (SIGPIPE, old_sigpipe); 4886 signal (SIGPIPE, old_sigpipe);
3621 4887
3622 if (rv < 0) 4888 if (rv < 0)
@@ -4071,10 +5337,27 @@ See function `interrupt-process' for more details on usage. */)
4071 5337
4072DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, 5338DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
4073 doc: /* Stop process PROCESS. May be process or name of one. 5339 doc: /* Stop process PROCESS. May be process or name of one.
4074See function `interrupt-process' for more details on usage. */) 5340See function `interrupt-process' for more details on usage.
5341If PROCESS is a network process, inhibit handling of incoming traffic. */)
4075 (process, current_group) 5342 (process, current_group)
4076 Lisp_Object process, current_group; 5343 Lisp_Object process, current_group;
4077{ 5344{
5345#ifdef HAVE_SOCKETS
5346 if (PROCESSP (process) && NETCONN_P (process))
5347 {
5348 struct Lisp_Process *p;
5349
5350 p = XPROCESS (process);
5351 if (NILP (p->command)
5352 && XINT (p->infd) >= 0)
5353 {
5354 FD_CLR (XINT (p->infd), &input_wait_mask);
5355 FD_CLR (XINT (p->infd), &non_keyboard_wait_mask);
5356 }
5357 p->command = Qt;
5358 return process;
5359 }
5360#endif
4078#ifndef SIGTSTP 5361#ifndef SIGTSTP
4079 error ("no SIGTSTP support"); 5362 error ("no SIGTSTP support");
4080#else 5363#else
@@ -4085,10 +5368,28 @@ See function `interrupt-process' for more details on usage. */)
4085 5368
4086DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, 5369DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
4087 doc: /* Continue process PROCESS. May be process or name of one. 5370 doc: /* Continue process PROCESS. May be process or name of one.
4088See function `interrupt-process' for more details on usage. */) 5371See function `interrupt-process' for more details on usage.
5372If PROCESS is a network process, resume handling of incoming traffic. */)
4089 (process, current_group) 5373 (process, current_group)
4090 Lisp_Object process, current_group; 5374 Lisp_Object process, current_group;
4091{ 5375{
5376#ifdef HAVE_SOCKETS
5377 if (PROCESSP (process) && NETCONN_P (process))
5378 {
5379 struct Lisp_Process *p;
5380
5381 p = XPROCESS (process);
5382 if (EQ (p->command, Qt)
5383 && XINT (p->infd) >= 0
5384 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5385 {
5386 FD_SET (XINT (p->infd), &input_wait_mask);
5387 FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
5388 }
5389 p->command = Qnil;
5390 return process;
5391 }
5392#endif
4092#ifdef SIGCONT 5393#ifdef SIGCONT
4093 process_send_signal (process, SIGCONT, current_group, 0); 5394 process_send_signal (process, SIGCONT, current_group, 0);
4094#else 5395#else
@@ -4235,6 +5536,9 @@ text to PROCESS after you call this function. */)
4235 Lisp_Object proc; 5536 Lisp_Object proc;
4236 struct coding_system *coding; 5537 struct coding_system *coding;
4237 5538
5539 if (DATAGRAM_CONN_P (process))
5540 return process;
5541
4238 proc = get_process (process); 5542 proc = get_process (process);
4239 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; 5543 coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)];
4240 5544
@@ -4619,6 +5923,8 @@ status_notify ()
4619 /* If process is still active, read any output that remains. */ 5923 /* If process is still active, read any output that remains. */
4620 while (! EQ (p->filter, Qt) 5924 while (! EQ (p->filter, Qt)
4621 && ! EQ (p->status, Qconnect) 5925 && ! EQ (p->status, Qconnect)
5926 && ! EQ (p->status, Qlisten)
5927 && ! EQ (p->command, Qt) /* Network process not stopped. */
4622 && XINT (p->infd) >= 0 5928 && XINT (p->infd) >= 0
4623 && read_process_output (proc, XINT (p->infd)) > 0); 5929 && read_process_output (proc, XINT (p->infd)) > 0);
4624 5930
@@ -4829,6 +6135,9 @@ init_process ()
4829 } 6135 }
4830 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system); 6136 bzero (proc_decode_coding_system, sizeof proc_decode_coding_system);
4831 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system); 6137 bzero (proc_encode_coding_system, sizeof proc_encode_coding_system);
6138#ifdef DATAGRAM_SOCKETS
6139 bzero (datagram_address, sizeof datagram_address);
6140#endif
4832} 6141}
4833 6142
4834void 6143void
@@ -4857,7 +6166,48 @@ syms_of_process ()
4857 staticpro (&Qconnect); 6166 staticpro (&Qconnect);
4858 Qfailed = intern ("failed"); 6167 Qfailed = intern ("failed");
4859 staticpro (&Qfailed); 6168 staticpro (&Qfailed);
4860 6169 Qlisten = intern ("listen");
6170 staticpro (&Qlisten);
6171 Qlocal = intern ("local");
6172 staticpro (&Qlocal);
6173
6174 QCname = intern (":name");
6175 staticpro (&QCname);
6176 QCbuffer = intern (":buffer");
6177 staticpro (&QCbuffer);
6178 QChost = intern (":host");
6179 staticpro (&QChost);
6180 QCservice = intern (":service");
6181 staticpro (&QCservice);
6182 QCfamily = intern (":family");
6183 staticpro (&QCfamily);
6184 QClocal = intern (":local");
6185 staticpro (&QClocal);
6186 QCremote = intern (":remote");
6187 staticpro (&QCremote);
6188 QCcoding = intern (":coding");
6189 staticpro (&QCcoding);
6190 QCserver = intern (":server");
6191 staticpro (&QCserver);
6192 QCdatagram = intern (":datagram");
6193 staticpro (&QCdatagram);
6194 QCnowait = intern (":nowait");
6195 staticpro (&QCnowait);
6196 QCfilter = intern (":filter");
6197 staticpro (&QCfilter);
6198 QCsentinel = intern (":sentinel");
6199 staticpro (&QCsentinel);
6200 QClog = intern (":log");
6201 staticpro (&QClog);
6202 QCnoquery = intern (":noquery");
6203 staticpro (&QCnoquery);
6204 QCstop = intern (":stop");
6205 staticpro (&QCstop);
6206 QCoptions = intern (":options");
6207 staticpro (&QCoptions);
6208 QCfeature = intern (":feature");
6209 staticpro (&QCfeature);
6210
4861 Qlast_nonmenu_event = intern ("last-nonmenu-event"); 6211 Qlast_nonmenu_event = intern ("last-nonmenu-event");
4862 staticpro (&Qlast_nonmenu_event); 6212 staticpro (&Qlast_nonmenu_event);
4863 6213
@@ -4897,14 +6247,20 @@ The value takes effect when `start-process' is called. */);
4897 defsubr (&Sset_process_window_size); 6247 defsubr (&Sset_process_window_size);
4898 defsubr (&Sset_process_inherit_coding_system_flag); 6248 defsubr (&Sset_process_inherit_coding_system_flag);
4899 defsubr (&Sprocess_inherit_coding_system_flag); 6249 defsubr (&Sprocess_inherit_coding_system_flag);
4900 defsubr (&Sprocess_kill_without_query); 6250 defsubr (&Sset_process_query_on_exit_flag);
6251 defsubr (&Sprocess_query_on_exit_flag);
4901 defsubr (&Sprocess_contact); 6252 defsubr (&Sprocess_contact);
4902 defsubr (&Slist_processes); 6253 defsubr (&Slist_processes);
4903 defsubr (&Sprocess_list); 6254 defsubr (&Sprocess_list);
4904 defsubr (&Sstart_process); 6255 defsubr (&Sstart_process);
4905#ifdef HAVE_SOCKETS 6256#ifdef HAVE_SOCKETS
4906 defsubr (&Sopen_network_stream); 6257 defsubr (&Sset_network_process_options);
6258 defsubr (&Smake_network_process);
4907#endif /* HAVE_SOCKETS */ 6259#endif /* HAVE_SOCKETS */
6260#ifdef DATAGRAM_SOCKETS
6261 defsubr (&Sprocess_datagram_address);
6262 defsubr (&Sset_process_datagram_address);
6263#endif
4908 defsubr (&Saccept_process_output); 6264 defsubr (&Saccept_process_output);
4909 defsubr (&Sprocess_send_region); 6265 defsubr (&Sprocess_send_region);
4910 defsubr (&Sprocess_send_string); 6266 defsubr (&Sprocess_send_string);
generated by cgit v1.2.1 (git 2.18.0) at 2026-01-24 15:14:27 +0000