From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: storm@cua.dk (Kim F. Storm) Newsgroups: gmane.emacs.devel Subject: Final(?) patch for server sockets and datagram (UDP) support. Date: 14 Mar 2002 00:19:27 +0100 Sender: emacs-devel-admin@gnu.org Message-ID: <5xd6y8nji8.fsf_-_@kfs2.cua.dk> References: <5xwux64cxe.fsf@kfs2.cua.dk> <5xg03pyyo3.fsf@kfs2.cua.dk> <5xadtvuodz.fsf@kfs2.cua.dk> <200202280408.g1S48QG19264@aztec.santafe.edu> <5xvgchkui4.fsf@kfs2.cua.dk> <200203012123.g21LNvS20494@aztec.santafe.edu> <5xofi1p7cz.fsf_-_@kfs2.cua.dk> <5xg03cprxi.fsf@kfs2.cua.dk> <874rjsd2uc.fsf@gnu.org> <5xbse0pn55.fsf@kfs2.cua.dk> <200203082106.g28L6CM03188@wijiji.santafe.edu> <5xbsdsea1a.fsf@kfs2.cua.dk> NNTP-Posting-Host: localhost.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii X-Trace: main.gmane.org 1016061735 11098 127.0.0.1 (13 Mar 2002 23:22:15 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Wed, 13 Mar 2002 23:22:15 +0000 (UTC) Cc: helmut@212186011228.11.tuwien.teleweb.at Original-Received: from quimby.gnus.org ([80.91.224.244]) by main.gmane.org with esmtp (Exim 3.33 #1 (Debian)) id 16lI4V-0002su-00 for ; Thu, 14 Mar 2002 00:22:15 +0100 Original-Received: from fencepost.gnu.org ([199.232.76.164]) by quimby.gnus.org with esmtp (Exim 3.12 #1 (Debian)) id 16lI7C-0002XO-00 for ; Thu, 14 Mar 2002 00:25:03 +0100 Original-Received: from localhost ([127.0.0.1] helo=fencepost.gnu.org) by fencepost.gnu.org with esmtp (Exim 3.34 #1 (Debian)) id 16lI3Y-0008J3-00; Wed, 13 Mar 2002 18:21:16 -0500 Original-Received: from mail.filanet.dk ([195.215.206.179]) by fencepost.gnu.org with smtp (Exim 3.34 #1 (Debian)) id 16lI1E-0008CN-00 for ; Wed, 13 Mar 2002 18:18:53 -0500 Original-Received: from kfs2.cua.dk.cua.dk (unknown [10.1.82.3]) by mail.filanet.dk (Postfix) with SMTP id A83A97C035; Wed, 13 Mar 2002 23:18:28 +0000 (GMT) Original-To: emacs-devel@gnu.org In-Reply-To: <5xbsdsea1a.fsf@kfs2.cua.dk> Original-Lines: 3039 User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2.50 Errors-To: emacs-devel-admin@gnu.org X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.0.5 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Emacs development discussions. List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.emacs.devel:1921 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:1921 The following (large) patch encompasses the majority of the requirements raised by people for enhancements to the networking support in emacs: server sockets, datagrams, local (unix) sockets. I still need to add checks for sendto, recvfrom, and getsockname to configure.in/configure. I'll do that eventually, but until then, the patch explicitly defines these for GNU_LINUX. Updates to the Elisp manual are also missing (of course :-) Index: etc/NEWS =================================================================== RCS file: /cvs/emacs/etc/NEWS,v retrieving revision 1.624 diff -c -r1.624 NEWS *** etc/NEWS 13 Mar 2002 09:34:06 -0000 1.624 --- etc/NEWS 13 Mar 2002 23:13:57 -0000 *************** *** 654,671 **** change group you start for any given buffer should be the last one finished. ! ** You can now use non-blocking connect to open network streams. ! The function open-network-stream has a new optional 7th argument. ! If non-nil, that function will initiate a non-blocking connect and ! return immediately before the connection is established. ! ! It returns nil if the system does not support non-blocking connects; ! the caller may then make a normal (blocking) open-network-stream. ! ! The filter and sentinel functions can now be specified as arguments ! to open-network-stream. When the non-blocking connect completes, the ! sentinel is called with the status matching "open" or "failed". ** New function substring-no-properties. --- 654,705 ---- change group you start for any given buffer should be the last one finished. ! ** Enhanced networking support. ! *** There is a new `make-network-process' function which supports ! opening of stream and datagram connections to a server, as well as ! create a stream or datagram server inside emacs. ! ! - A server is started using :server t arg. ! - Datagram connection is selected using :datagram t arg. ! - A server can open on a random port using :service t arg. ! - Local sockets are supported using :family 'local arg. ! - Non-blocking connect is supported using :nowait t arg. ! ! *** Original open-network-stream is now emulated using make-network-process. ! ! *** New function open-network-stream-nowait. ! ! This function initiates a non-blocking connect and returns immediately ! before the connection is established. The filter and sentinel ! functions can be specified as arguments to open-network-stream-nowait. ! When the non-blocking connect completes, the sentinel is called with ! the status matching "open" or "failed". ! ! *** New function open-network-stream-server. ! ! *** New functions process-datagram-address and set-process-datagram-address. ! ! *** By default, the function process-contact still returns (HOST SERVICE) ! for a network process. Using the new optional KEY arg, the complete list ! of network process properties or a specific property can be selected. ! ! Using :local and :remote as the KEY, the address of the local or ! remote end-point is returned. An Inet address is represented as a 5 ! element vector, where the first 4 elements contain the IP address and ! the fifth is the port number. ! ! *** Network processes can now be stopped and restarted with ! `stop-process' and `continue-process'. For a server process, no ! connections are accepted in the stopped state. For a client process, ! no input is received in the stopped state. ! ! *** Function list-processes now has an optional argument; if non-nil, ! only the processes whose query-on-exit flag is set are listed. ! ! *** New set-process-query-on-exit-flag and process-query-on-exit-flag ! functions. The existing process-kill-without-query function is still ! supported, but new code should use the new functions. ** New function substring-no-properties. Index: src/ChangeLog =================================================================== RCS file: /cvs/emacs/src/ChangeLog,v retrieving revision 1.2520 diff -c -r1.2520 ChangeLog *** src/ChangeLog 13 Mar 2002 17:07:45 -0000 1.2520 --- src/ChangeLog 13 Mar 2002 23:13:58 -0000 *************** *** 1,3 **** --- 1,60 ---- + 2002-03-13 Kim F. Storm + + The following changes adds support for network server processes, + datagram connections, and local (unix) sockets. + + * process.h (struct Lisp_Process): New member log. + Doc fix: Member command used to indicate stopped network process. + Doc fix: Member childp contains plist for network process. + Doc fix: Member kill_without_query is inverse of query-on-exit flag. + + * process.c (Qlocal, QCname, QCbuffer, QChost, QCservice, QCfamily) + (QClocal, QCremote, QCserver, QCdatagram, QCnowait, QCnoquery) + (QCstop, QCfilter, QCsentinel, QClog, QCfeature): New variables. + (NETCONN1_P): New macro. + (DATAGRAM_SOCKETS): New conditional symbol. + (datagram_address): New array. + (DATAGRAM_CONN_P, DATAGRAM_CHAN_P): New macros. + (status_message): Use concat3. + (Fprocess_status): Add `listen' status to doc string. Return `stop' + for a stopped network process. + (Fset_process_buffer): Update contact plist for network process. + (Fset_process_filter): Ditto. Don't enable input for stopped + network processes. Server must listen, even if filter is t. + (Fset_process_query_on_exit_flag, Fprocess_query_on_exit_flag): + New functions. + (Fprocess_kill_without_query): Removed. Now defined in simple.el. + (Fprocess_contact): Added KEY argument. Handle datagrams. + (list_processes_1): Optionally show only processes with the query + on exit flag set. Dynamically adjust column widths. Omit tty + column if not needed. Report stopped network processes. + Identify server and datagram network processes. + (Flist_processes): New optional arg `query-only'. + (conv_sockaddr_to_lisp, get_lisp_to_sockaddr_size) + (conv_lisp_to_sockaddr): New helper functions. + (Fprocess_datagram_address, Fset_process_datagram_address): + New lisp functions. + (network_process_featurep, unwind_request_sigio): New helper functions. + (Fopen_network_stream): Removed. Now defined in simple.el. + (Fmake_network_process): New lisp function. Code is based on previous + Fopen_network_stream, but heavily reworked with new property list based + argument list, support for datagrams, server processes, and local + sockets in addition to old client-only functionality. + (server_accept_connection): New function. + (wait_reading_process_input): Use it to handle incoming connects. + Do not enable input on a new connection if process is stopped. + (read_process_output): Handle datagram sockets. Use 2k buffer for them. + (send_process): Handle datagram sockets. + (Fstop_process, Fcontinue_process): Apply to network processes. A stopped + network process is indicated by setting command field to t . + (Fprocess_send_eof): No-op if datagram connection. + (Fstatus_notify): Don't read input for a stream server socket or a + stopped network process. + (init_process): Initialize datagram_address array. + (syms_of_process): Intern and staticpro new variables, defsubr new + functions. + + 2002-03-13 Stefan Monnier * xterm.c (x_set_toolkit_scroll_bar_thumb) : Index: src/process.h =================================================================== RCS file: /cvs/emacs/src/process.h,v retrieving revision 1.18 diff -c -r1.18 process.h *** src/process.h 14 Oct 2001 20:14:49 -0000 1.18 --- src/process.h 13 Mar 2002 23:13:58 -0000 *************** *** 40,52 **** Lisp_Object tty_name; /* Name of this process */ Lisp_Object name; ! /* List of command arguments that this process was run with */ Lisp_Object command; /* (funcall FILTER PROC STRING) (if FILTER is non-nil) to dispose of a bunch of chars from the process all at once */ Lisp_Object filter; /* (funcall SENTINEL PROCESS) when process state changes */ Lisp_Object sentinel; /* Buffer that output is going to */ Lisp_Object buffer; /* Number of this process */ --- 40,56 ---- Lisp_Object tty_name; /* Name of this process */ Lisp_Object name; ! /* List of command arguments that this process was run with. ! Is set to t for a stopped network process; nil otherwise. */ Lisp_Object command; /* (funcall FILTER PROC STRING) (if FILTER is non-nil) to dispose of a bunch of chars from the process all at once */ Lisp_Object filter; /* (funcall SENTINEL PROCESS) when process state changes */ Lisp_Object sentinel; + /* (funcall LOG SERVER CLIENT MESSAGE) when a server process + accepts a connection from a client. */ + Lisp_Object log; /* Buffer that output is going to */ Lisp_Object buffer; /* Number of this process */ *************** *** 54,64 **** /* Non-nil if this is really a command channel */ Lisp_Object command_channel_p; /* t if this is a real child process. ! For a net connection, it is (HOST SERVICE). */ Lisp_Object childp; /* Marker set to end of last buffer-inserted output from this process */ Lisp_Object mark; ! /* Non-nil means kill silently if Emacs is exited. */ Lisp_Object kill_without_query; /* Record the process status in the raw form in which it comes from `wait'. This is to avoid consing in a signal handler. */ --- 58,69 ---- /* Non-nil if this is really a command channel */ Lisp_Object command_channel_p; /* t if this is a real child process. ! For a net connection, it is a plist based on the arguments to make-network-process. */ Lisp_Object childp; /* Marker set to end of last buffer-inserted output from this process */ Lisp_Object mark; ! /* Non-nil means kill silently if Emacs is exited. ! This is the inverse of the `query-on-exit' flag. */ Lisp_Object kill_without_query; /* Record the process status in the raw form in which it comes from `wait'. This is to avoid consing in a signal handler. */ Index: src/process.c =================================================================== RCS file: /cvs/emacs/src/process.c,v retrieving revision 1.355 diff -c -r1.355 process.c *** src/process.c 3 Mar 2002 00:31:22 -0000 1.355 --- src/process.c 13 Mar 2002 23:14:00 -0000 *************** *** 54,59 **** --- 54,67 ---- #include #include #include + #ifndef AF_LOCAL + #ifdef AF_UNIX + #define AF_LOCAL AF_UNIX + #endif + #endif + #ifdef AF_LOCAL + #include + #endif #ifdef NEED_NET_ERRNO_H #include #endif /* NEED_NET_ERRNO_H */ *************** *** 113,119 **** Lisp_Object Qprocessp; Lisp_Object Qrun, Qstop, Qsignal; ! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed; Lisp_Object Qlast_nonmenu_event; /* Qexit is declared and initialized in eval.c. */ --- 121,132 ---- Lisp_Object Qprocessp; Lisp_Object Qrun, Qstop, Qsignal; ! Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten; ! Lisp_Object Qlocal; ! Lisp_Object QCname, QCbuffer, QChost, QCservice, QCfamily; ! Lisp_Object QClocal, QCremote; ! Lisp_Object QCserver, QCdatagram, QCnowait, QCnoquery, QCstop; ! Lisp_Object QCfilter, QCsentinel, QClog, QCfeature; Lisp_Object Qlast_nonmenu_event; /* Qexit is declared and initialized in eval.c. */ *************** *** 122,129 **** --- 135,144 ---- #ifdef HAVE_SOCKETS #define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp)) + #define NETCONN1_P(p) (GC_CONSP ((p)->childp)) #else #define NETCONN_P(p) 0 + #define NETCONN1_P(p) 0 #endif /* HAVE_SOCKETS */ /* Define first descriptor number available for subprocesses. */ *************** *** 194,203 **** --- 209,247 ---- #endif /* NON_BLOCKING_CONNECT */ #endif /* BROKEN_NON_BLOCKING_CONNECT */ + /* Define DATAGRAM_SOCKETS if datagrams can be used safely on + this system. We need to read full packets, so we need a + "non-destructive" select. So we require either native select, + or emulation of select using FIONREAD. */ + + #ifdef GNU_LINUX + /* These are not yet in configure.in (they will be eventually) + -- so add them here temporarily. ++kfs */ + #define HAVE_RECVFROM + #define HAVE_SENDTO + #define HAVE_GETSOCKNAME + #endif + + #ifdef BROKEN_DATAGRAM_SOCKETS + #undef DATAGRAM_SOCKETS + #else + #ifndef DATAGRAM_SOCKETS + #ifdef HAVE_SOCKETS + #if defined (HAVE_SELECT) || defined (FIONREAD) + #if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE) + #define DATAGRAM_SOCKETS + #endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */ + #endif /* HAVE_SELECT || FIONREAD */ + #endif /* HAVE_SOCKETS */ + #endif /* DATAGRAM_SOCKETS */ + #endif /* BROKEN_DATAGRAM_SOCKETS */ + #ifdef TERM #undef NON_BLOCKING_CONNECT + #undef DATAGRAM_SOCKETS #endif + #include "sysselect.h" extern int keyboard_bit_set P_ ((SELECT_TYPE *)); *************** *** 257,262 **** --- 301,319 ---- static struct coding_system *proc_decode_coding_system[MAXDESC]; static struct coding_system *proc_encode_coding_system[MAXDESC]; + #ifdef DATAGRAM_SOCKETS + /* Table of `partner address' for datagram sockets. */ + struct sockaddr_and_len { + struct sockaddr *sa; + int len; + } datagram_address[MAXDESC]; + #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0) + #define DATAGRAM_CONN_P(proc) (datagram_address[XPROCESS (proc)->infd].sa != 0) + #else + #define DATAGRAM_CHAN_P(chan) (0) + #define DATAGRAM_CONN_P(proc) (0) + #endif + static Lisp_Object get_process (); static void exec_sentinel (); *************** *** 367,381 **** return build_string ("finished\n"); string = Fnumber_to_string (make_number (code)); string2 = build_string (coredump ? " (core dumped)\n" : "\n"); ! return concat2 (build_string ("exited abnormally with code "), ! concat2 (string, string2)); } else if (EQ (symbol, Qfailed)) { string = Fnumber_to_string (make_number (code)); string2 = build_string ("\n"); ! return concat2 (build_string ("failed with code "), ! concat2 (string, string2)); } else return Fcopy_sequence (Fsymbol_name (symbol)); --- 424,438 ---- return build_string ("finished\n"); string = Fnumber_to_string (make_number (code)); string2 = build_string (coredump ? " (core dumped)\n" : "\n"); ! return concat3 (build_string ("exited abnormally with code "), ! string, string2); } else if (EQ (symbol, Qfailed)) { string = Fnumber_to_string (make_number (code)); string2 = build_string ("\n"); ! return concat3 (build_string ("failed with code "), ! string, string2); } else return Fcopy_sequence (Fsymbol_name (symbol)); *************** *** 635,640 **** --- 692,698 ---- exit -- for a process that has exited. signal -- for a process that has got a fatal signal. open -- for a network stream connection that is open. + listen -- for a network stream server that is listening. closed -- for a network stream connection that is closed. connect -- when waiting for a non-blocking connection to complete. failed -- when a non-blocking connection has failed. *************** *** 661,672 **** status = p->status; if (CONSP (status)) status = XCAR (status); ! if (NETCONN_P (process)) { ! if (EQ (status, Qrun)) ! status = Qopen; ! else if (EQ (status, Qexit)) status = Qclosed; } return status; } --- 719,732 ---- status = p->status; if (CONSP (status)) status = XCAR (status); ! if (NETCONN1_P (p)) { ! if (EQ (status, Qexit)) status = Qclosed; + else if (EQ (p->command, Qt)) + status = Qstop; + else if (EQ (status, Qrun)) + status = Qopen; } return status; } *************** *** 737,746 **** (process, buffer) register Lisp_Object process, buffer; { CHECK_PROCESS (process); if (!NILP (buffer)) CHECK_BUFFER (buffer); ! XPROCESS (process)->buffer = buffer; return buffer; } --- 797,811 ---- (process, buffer) register Lisp_Object process, buffer; { + struct Lisp_Process *p; + CHECK_PROCESS (process); if (!NILP (buffer)) CHECK_BUFFER (buffer); ! p = XPROCESS (process); ! p->buffer = buffer; ! if (NETCONN1_P (p)) ! p->childp = Fplist_put (p->childp, QCbuffer, buffer); return buffer; } *************** *** 791,802 **** if (XINT (p->infd) >= 0) { ! if (EQ (filter, Qt)) { FD_CLR (XINT (p->infd), &input_wait_mask); FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); } ! else if (EQ (XPROCESS (process)->filter, Qt)) { FD_SET (XINT (p->infd), &input_wait_mask); FD_SET (XINT (p->infd), &non_keyboard_wait_mask); --- 856,868 ---- if (XINT (p->infd) >= 0) { ! if (EQ (filter, Qt) && !EQ (p->status, Qlisten)) { FD_CLR (XINT (p->infd), &input_wait_mask); FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); } ! else if (EQ (p->filter, Qt) ! && !EQ (p->command, Qt)) /* Network process not stopped. */ { FD_SET (XINT (p->infd), &input_wait_mask); FD_SET (XINT (p->infd), &non_keyboard_wait_mask); *************** *** 804,809 **** --- 870,877 ---- } p->filter = filter; + if (NETCONN1_P (p)) + p->childp = Fplist_put (p->childp, QCfilter, filter); return filter; } *************** *** 899,930 **** return XPROCESS (process)->inherit_coding_system_flag; } ! DEFUN ("process-kill-without-query", Fprocess_kill_without_query, ! Sprocess_kill_without_query, 1, 2, 0, ! doc: /* Say no query needed if PROCESS is running when Emacs is exited. ! Optional second argument if non-nil says to require a query. ! Value is t if a query was formerly required. */) ! (process, value) ! register Lisp_Object process, value; { - Lisp_Object tem; - CHECK_PROCESS (process); ! tem = XPROCESS (process)->kill_without_query; ! XPROCESS (process)->kill_without_query = Fnull (value); ! ! return Fnull (tem); } ! DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 1, 1, 0, ! doc: /* Return the contact info of PROCESS; t for a real child. ! For a net connection, the value is a cons cell of the form (HOST SERVICE). */) (process) register Lisp_Object process; { CHECK_PROCESS (process); ! return XPROCESS (process)->childp; } #if 0 /* Turned off because we don't currently record this info --- 967,1030 ---- return XPROCESS (process)->inherit_coding_system_flag; } ! DEFUN ("set-process-query-on-exit-flag", ! Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag, ! 2, 2, 0, ! doc: /* Specify if query is needed for PROCESS when Emacs is exited. ! If the second argument FLAG is non-nil, emacs will query the user before ! exiting if PROCESS is running. */) ! (process, flag) ! register Lisp_Object process, flag; { CHECK_PROCESS (process); ! XPROCESS (process)->kill_without_query = Fnull (flag); ! return flag; } ! DEFUN ("process-query-on-exit-flag", ! Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag, 1, 1, 0, ! doc: /* Return the current value of query on exit flag for PROCESS. */) (process) register Lisp_Object process; { CHECK_PROCESS (process); ! return Fnull (XPROCESS (process)->kill_without_query); ! } ! ! #ifdef DATAGRAM_SOCKETS ! Lisp_Object Fprocess_datagram_address (); ! #endif ! ! DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, ! 1, 2, 0, ! doc: /* Return the contact info of PROCESS; t for a real child. ! For a net connection, the value depends on the optional KEY arg. ! If KEY is nil, value is a cons cell of the form (HOST SERVICE), ! if KEY is t, the complete contact information for the connection is ! returned, else the specific value for the keyword KEY is returned. ! See `make-network-process' for a list of keywords. */) ! (process, key) ! register Lisp_Object process, key; ! { ! Lisp_Object contact; ! ! CHECK_PROCESS (process); ! contact = XPROCESS (process)->childp; ! ! #ifdef DATAGRAM_SOCKETS ! if (DATAGRAM_CONN_P (process) ! && (EQ (key, Qt) || EQ (key, QCremote))) ! contact = Fplist_put (contact, QCremote, ! Fprocess_datagram_address (process)); ! #endif ! ! if (!NETCONN_P (process) || EQ (key, Qt)) ! return contact; ! if (NILP (key)) ! return Fcons (Fplist_get (contact, QChost), ! Fcons (Fplist_get (contact, QCservice), Qnil)); ! return Fplist_get (contact, key); } #if 0 /* Turned off because we don't currently record this info *************** *** 941,952 **** #endif Lisp_Object ! list_processes_1 () { register Lisp_Object tail, tem; Lisp_Object proc, minspace, tem1; register struct Lisp_Process *p; ! char tembuf[80]; XSETFASTINT (minspace, 1); --- 1041,1095 ---- #endif Lisp_Object ! list_processes_1 (query_only) ! Lisp_Object query_only; { register Lisp_Object tail, tem; Lisp_Object proc, minspace, tem1; register struct Lisp_Process *p; ! char tembuf[300]; ! int w_proc, w_buffer, w_tty; ! Lisp_Object i_status, i_buffer, i_tty, i_command; ! ! w_proc = 4; /* Proc */ ! w_buffer = 6; /* Buffer */ ! w_tty = 0; /* Omit if no ttys */ ! ! for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) ! { ! int i; ! ! proc = Fcdr (Fcar (tail)); ! p = XPROCESS (proc); ! if (NILP (p->childp)) ! continue; ! if (!NILP (query_only) && !NILP (p->kill_without_query)) ! continue; ! if (STRINGP (p->name) ! && ( i = XSTRING (p->name)->size, (i > w_proc))) ! w_proc = i; ! if (!NILP (p->buffer)) ! { ! if (NILP (XBUFFER (p->buffer)->name) && w_buffer < 8) ! w_buffer = 8; /* (Killed) */ ! else if ((i = XSTRING (XBUFFER (p->buffer)->name)->size, (i > w_buffer))) ! w_buffer = i; ! } ! if (STRINGP (p->tty_name) ! && (i = XSTRING (p->tty_name)->size, (i > w_tty))) ! w_tty = i; ! } ! ! XSETFASTINT (i_status, w_proc + 1); ! XSETFASTINT (i_buffer, XFASTINT (i_status) + 9); ! if (w_tty) ! { ! XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1); ! XSETFASTINT (i_command, XFASTINT (i_buffer) + w_tty + 1); ! } else { ! i_tty = Qnil; ! XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1); ! } XSETFASTINT (minspace, 1); *************** *** 955,963 **** current_buffer->truncate_lines = Qt; ! write_string ("\ ! Proc Status Buffer Tty Command\n\ ! ---- ------ ------ --- -------\n", -1); for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) { --- 1098,1122 ---- current_buffer->truncate_lines = Qt; ! write_string ("Proc", -1); ! Findent_to (i_status, minspace); write_string ("Status", -1); ! Findent_to (i_buffer, minspace); write_string ("Buffer", -1); ! if (!NILP (i_tty)) ! { ! Findent_to (i_tty, minspace); write_string ("Tty", -1); ! } ! Findent_to (i_command, minspace); write_string ("Command", -1); ! write_string ("\n", -1); ! ! write_string ("----", -1); ! Findent_to (i_status, minspace); write_string ("------", -1); ! Findent_to (i_buffer, minspace); write_string ("------", -1); ! if (!NILP (i_tty)) ! { ! Findent_to (i_tty, minspace); write_string ("---", -1); ! } ! Findent_to (i_command, minspace); write_string ("-------", -1); ! write_string ("\n", -1); for (tail = Vprocess_alist; !NILP (tail); tail = Fcdr (tail)) { *************** *** 967,975 **** p = XPROCESS (proc); if (NILP (p->childp)) continue; Finsert (1, &p->name); ! Findent_to (make_number (13), minspace); if (!NILP (p->raw_status_low)) update_status (p); --- 1126,1136 ---- p = XPROCESS (proc); if (NILP (p->childp)) continue; + if (!NILP (query_only) && !NILP (p->kill_without_query)) + continue; Finsert (1, &p->name); ! Findent_to (i_status, minspace); if (!NILP (p->raw_status_low)) update_status (p); *************** *** 989,1000 **** #endif Fprinc (symbol, Qnil); } ! else if (NETCONN_P (proc)) { ! if (EQ (symbol, Qrun)) ! write_string ("open", -1); ! else if (EQ (symbol, Qexit)) write_string ("closed", -1); else Fprinc (symbol, Qnil); } --- 1150,1163 ---- #endif Fprinc (symbol, Qnil); } ! else if (NETCONN1_P (p)) { ! if (EQ (symbol, Qexit)) write_string ("closed", -1); + else if (EQ (p->command, Qt)) + write_string ("stopped", -1); + else if (EQ (symbol, Qrun)) + write_string ("open", -1); else Fprinc (symbol, Qnil); } *************** *** 1015,1021 **** if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) remove_process (proc); ! Findent_to (make_number (22), minspace); if (NILP (p->buffer)) insert_string ("(none)"); else if (NILP (XBUFFER (p->buffer)->name)) --- 1178,1184 ---- if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) remove_process (proc); ! Findent_to (i_buffer, minspace); if (NILP (p->buffer)) insert_string ("(none)"); else if (NILP (XBUFFER (p->buffer)->name)) *************** *** 1023,1041 **** else Finsert (1, &XBUFFER (p->buffer)->name); ! Findent_to (make_number (37), minspace); ! ! if (STRINGP (p->tty_name)) ! Finsert (1, &p->tty_name); ! else ! insert_string ("(none)"); ! Findent_to (make_number (49), minspace); ! if (NETCONN_P (proc)) { ! sprintf (tembuf, "(network stream connection to %s)\n", ! XSTRING (XCAR (p->childp))->data); insert_string (tembuf); } else --- 1186,1224 ---- else Finsert (1, &XBUFFER (p->buffer)->name); ! if (!NILP (i_tty)) ! { ! Findent_to (i_tty, minspace); ! if (STRINGP (p->tty_name)) ! Finsert (1, &p->tty_name); ! } ! Findent_to (i_command, minspace); ! if (EQ (p->status, Qlisten)) ! { ! Lisp_Object port = Fplist_get (p->childp, QCservice); ! if (INTEGERP (port)) ! port = Fnumber_to_string (port); ! sprintf (tembuf, "(network %s server on %s)\n", ! (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), ! XSTRING (port)->data); ! insert_string (tembuf); ! } ! else if (NETCONN1_P (p)) { ! /* For a local socket, there is no host name, ! so display service instead. */ ! Lisp_Object host = Fplist_get (p->childp, QChost); ! if (!STRINGP (host)) ! { ! host = Fplist_get (p->childp, QCservice); ! if (INTEGERP (host)) ! host = Fnumber_to_string (host); ! } ! sprintf (tembuf, "(network %s connection to %s)\n", ! (DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"), ! XSTRING (host)->data); insert_string (tembuf); } else *************** *** 1056,1069 **** return Qnil; } ! DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", doc: /* Display a list of all processes. Any process listed as exited or signaled is actually eliminated after the listing is made. */) ! () { internal_with_output_to_temp_buffer ("*Process List*", ! list_processes_1, Qnil); return Qnil; } --- 1239,1255 ---- return Qnil; } ! DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P", doc: /* Display a list of all processes. + If optional argument QUERY-ONLY is non-nil, only processes with + the query-on-exit flag set will be listed. Any process listed as exited or signaled is actually eliminated after the listing is made. */) ! (query_only) ! Lisp_Object query_only; { internal_with_output_to_temp_buffer ("*Process List*", ! list_processes_1, query_only); return Qnil; } *************** *** 1776,1829 **** } #endif /* not VMS */ #ifdef HAVE_SOCKETS ! /* open a TCP network connection to a given HOST/SERVICE. Treated ! exactly like a normal process when reading and writing. Only differences are in status display and process deletion. A network connection has no PID; you cannot signal it. All you can do is ! deactivate and close it via delete-process */ ! ! DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, ! 4, 7, 0, ! doc: /* Open a TCP connection for a service to a host. ! Returns a subprocess-object to represent the connection. ! Returns nil if a non-blocking connect is attempted on a system which ! cannot support that; in that case, the caller should attempt a ! normal connect instead. Input and output work as for subprocesses; `delete-process' closes it. ! Args are NAME BUFFER HOST SERVICE FILTER SENTINEL NON-BLOCKING. ! NAME is name for process. It is modified if necessary to make it unique. ! BUFFER is the buffer (or buffer-name) to associate with the process. ! Process output goes at end of that buffer, unless you specify ! an output stream or filter function to handle the output. ! BUFFER may be also nil, meaning that this process is not associated ! with any buffer. ! HOST is name of the host to connect to, or its IP address. ! SERVICE is name of the service desired, or an integer specifying a ! port number to connect to. ! FILTER and SENTINEL are optional args specifying the filter and ! sentinel functions associated with the network stream. ! NON-BLOCKING is optional arg requesting an non-blocking connect. ! When non-nil, open-network-stream will return immediately without ! waiting for the connection to be made. Instead, the sentinel function ! will be called with second matching "open" (if successful) or ! "failed" when the connect completes. */) ! (name, buffer, host, service, filter, sentinel, non_blocking) ! Lisp_Object name, buffer, host, service, filter, sentinel, non_blocking; { Lisp_Object proc; #ifdef HAVE_GETADDRINFO ! struct addrinfo hints, *res, *lres; ! char *portstring, portbuf[128]; #else /* HAVE_GETADDRINFO */ - struct sockaddr_in address; - struct servent *svc_info; - struct hostent *host_info_ptr, host_info; - char *(addr_list[2]); - IN_ADDR numeric_addr; - int port; struct _emacs_addrinfo { int ai_family; --- 1962,2360 ---- } #endif /* not VMS */ + #ifdef HAVE_SOCKETS ! /* Convert an internal struct sockaddr to a lisp object (vector or string). ! The address family of sa is not included in the result. */ ! ! static Lisp_Object ! conv_sockaddr_to_lisp (sa, len) ! struct sockaddr *sa; ! int len; ! { ! Lisp_Object address; ! int i; ! unsigned char *cp; ! register struct Lisp_Vector *p; ! ! switch (sa->sa_family) ! { ! case AF_INET: ! { ! struct sockaddr_in *sin = (struct sockaddr_in *) sa; ! len = sizeof (sin->sin_addr) + 1; ! address = Fmake_vector (make_number (len), Qnil); ! p = XVECTOR (address); ! p->contents[--len] = make_number (ntohs (sin->sin_port)); ! cp = (unsigned char *)&sin->sin_addr; ! break; ! } ! #ifdef AF_LOCAL ! case AF_LOCAL: ! { ! struct sockaddr_un *sun = (struct sockaddr_un *) sa; ! for (i = 0; i < sizeof (sun->sun_path); i++) ! if (sun->sun_path[i] == 0) ! break; ! return make_unibyte_string (sun->sun_path, i); ! } ! #endif ! default: ! len -= sizeof (sa->sa_family); ! address = Fcons (make_number (sa->sa_family), ! Fmake_vector (make_number (len), Qnil)); ! p = XVECTOR (XCDR (address)); ! cp = (unsigned char *) sa + sizeof (sa->sa_family); ! break; ! } ! ! i = 0; ! while (i < len) ! p->contents[i++] = make_number (*cp++); ! ! return address; ! } ! ! ! /* Get family and required size for sockaddr structure to hold ADDRESS. */ ! ! static int ! get_lisp_to_sockaddr_size (address, familyp) ! Lisp_Object address; ! int *familyp; ! { ! register struct Lisp_Vector *p; ! ! if (VECTORP (address)) ! { ! p = XVECTOR (address); ! if (p->size == 5) ! { ! *familyp = AF_INET; ! return sizeof (struct sockaddr_in); ! } ! } ! #ifdef AF_LOCAL ! else if (STRINGP (address)) ! { ! *familyp = AF_LOCAL; ! return sizeof (struct sockaddr_un); ! } ! #endif ! else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address))) ! { ! struct sockaddr *sa; ! *familyp = XINT (XCAR (address)); ! p = XVECTOR (XCDR (address)); ! return p->size + sizeof (sa->sa_family); ! } ! return 0; ! } ! ! /* Convert an address object (vector or string) to an internal sockaddr. ! Format of address has already been validated by size_lisp_to_sockaddr. */ ! ! static void ! conv_lisp_to_sockaddr (family, address, sa, len) ! int family; ! Lisp_Object address; ! struct sockaddr *sa; ! int len; ! { ! register struct Lisp_Vector *p; ! register unsigned char *cp; ! register int i; ! ! bzero (sa, len); ! sa->sa_family = family; ! ! if (VECTORP (address)) ! { ! p = XVECTOR (address); ! if (family == AF_INET) ! { ! struct sockaddr_in *sin = (struct sockaddr_in *) sa; ! len = sizeof (sin->sin_addr) + 1; ! i = XINT (p->contents[--len]); ! sin->sin_port = htons (i); ! cp = (unsigned char *)&sin->sin_addr; ! } ! } ! else if (STRINGP (address)) ! { ! #ifdef AF_LOCAL ! if (family == AF_LOCAL) ! { ! struct sockaddr_un *sun = (struct sockaddr_un *) sa; ! cp = XSTRING (address)->data; ! for (i = 0; i < sizeof (sun->sun_path) && *cp; i++) ! sun->sun_path[i] = *cp++; ! } ! #endif ! return; ! } ! else ! { ! p = XVECTOR (XCDR (address)); ! cp = (unsigned char *)sa + sizeof (sa->sa_family); ! } ! ! for (i = 0; i < len; i++) ! if (INTEGERP (p->contents[i])) ! *cp++ = XFASTINT (p->contents[i]) & 0xff; ! } ! ! #ifdef DATAGRAM_SOCKETS ! DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address, ! 1, 1, 0, ! doc: /* Get the current datagram address associated with PROCESS. */) ! (process) ! Lisp_Object process; ! { ! int channel; ! ! CHECK_PROCESS (process); ! ! if (!DATAGRAM_CONN_P (process)) ! return Qnil; ! ! channel = XPROCESS (process)->infd; ! return conv_sockaddr_to_lisp (datagram_address[channel].sa, ! datagram_address[channel].len); ! } ! ! DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address, ! 2, 2, 0, ! doc: /* Set the datagram address for PROCESS to ADDRESS. ! Returns nil upon error setting address, ADDRESS otherwise. */) ! (process, address) ! Lisp_Object process, address; ! { ! int channel; ! int family, len; ! ! CHECK_PROCESS (process); ! ! if (!DATAGRAM_CONN_P (process)) ! return Qnil; ! ! channel = XPROCESS (process)->infd; ! ! len = get_lisp_to_sockaddr_size (address, &family); ! if (datagram_address[channel].len != len) ! return Qnil; ! conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len); ! return address; ! } ! #endif ! ! /* Check whether a given KEY VALUE pair is supported on this system. */ ! ! static int ! network_process_featurep (key, value) ! Lisp_Object key, value; ! { ! ! if (EQ (key, QCnowait)) ! { ! #ifdef NON_BLOCKING_CONNECT ! return 1; ! #else ! return NILP (value); ! #endif ! } ! ! if (EQ (key, QCdatagram)) ! { ! #ifdef DATAGRAM_SOCKETS ! return 1; ! #else ! return NILP (value); ! #endif ! } ! ! if (EQ (key, QCfamily)) ! { ! if (NILP (value)) ! return 1; ! #ifdef AF_LOCAL ! if (EQ (key, Qlocal)) ! return 1; ! #endif ! return 0; ! } ! ! if (EQ (key, QCname)) ! return STRINGP (value); ! ! if (EQ (key, QCbuffer)) ! return (NILP (value) || STRINGP (value) || BUFFERP (value)); ! ! if (EQ (key, QClocal) || EQ (key, QCremote)) ! { ! int family; ! return get_lisp_to_sockaddr_size (value, &family); ! } ! ! if (EQ (key, QChost)) ! return (NILP (value) || STRINGP (value)); ! ! if (EQ (key, QCservice)) ! { ! #ifdef HAVE_GETSOCKNAME ! if (EQ (value, Qt)) ! return 1; ! #endif ! return (INTEGERP (value) || STRINGP (value)); ! } ! ! if (EQ (key, QCserver)) ! { ! #ifndef TERM ! return 1; ! #else ! return NILP (value); ! #endif ! } ! ! if (EQ (key, QCsentinel)) ! return 1; ! if (EQ (key, QCfilter)) ! return 1; ! if (EQ (key, QClog)) ! return 1; ! if (EQ (key, QCnoquery)) ! return 1; ! if (EQ (key, QCstop)) ! return 1; ! ! return 0; ! } ! ! /* A version of request_sigio suitable for a record_unwind_protect. */ ! ! Lisp_Object ! unwind_request_sigio (dummy) ! Lisp_Object dummy; ! { ! if (interrupt_input) ! request_sigio (); ! return Qnil; ! } ! ! /* Create a network stream/datagram client/server process. Treated ! exactly like a normal process when reading and writing. Primary differences are in status display and process deletion. A network connection has no PID; you cannot signal it. All you can do is ! stop/continue it and deactivate/close it via delete-process */ + DEFUN ("make-network-process", Fmake_network_process, Smake_network_process, + 0, MANY, 0, + doc: /* Create and return a network server or client process. Input and output work as for subprocesses; `delete-process' closes it. ! ! Arguments are specified as keyword/argument pairs. The following ! arguments are defined: ! ! :name NAME -- NAME is name for process. It is modified if necessary ! to make it unique. ! ! :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate ! with the process. Process output goes at end of that buffer, unless ! you specify an output stream or filter function to handle the output. ! BUFFER may be also nil, meaning that this process is not associated ! with any buffer. ! ! :host HOST -- HOST is name of the host to connect to, or its IP ! address. If specified for a server process, only clients on that host ! may connect. The symbol `local' specifies the local host. ! ! :service SERVICE -- SERVICE is name of the service desired, or an ! integer specifying a port number to connect to. If SERVICE is t, ! a random port number is selected for the server. ! ! :local ADDRESS -- ADDRESS is the local address used for the ! connection. This parameter is ignored when opening a client process. ! When specified for a server process, the HOST and SERVICE are ignored. ! ! :remote ADDRESS -- ADDRESS is the remote partner's address for the ! connection. This parameter is ignored when opening a server process. ! When specified for a client process, the HOST and SERVICE are ignored. ! ! :family FAMILY -- FAMILY is the address (and protocol) family for the ! service specified by HOST and SERVICE. The default address family is ! Inet (or IPv4) for the host and port number specified by HOST and ! SERVICE. Other address families supported are: ! local -- for a local (i.e. UNIX) address specified by SERVICE. ! ! :datagram BOOL -- Create a datagram type connection if BOOL is ! non-nil. Default is a stream type connection. ! ! :nowait BOOL -- If BOOL is non-nil for a stream type client process, ! return without waiting for the connection to complete; instead, the ! sentinel function will be called with second arg matching "open" (if ! successful) or "failed" when the connect completes. Default is to use ! a blocking connect (i.e. wait) for stream type connections. ! ! :noquery BOOL -- Query the user unless BOOL is non-nil, and process is ! running when emacs is exited. ! ! :stop BOOL -- Start process in the `stopped' state if BOOL non-nil. ! In the stopped state, a server process does not accept new ! connections, and a client process does not handle incoming traffic. ! The stopped state is cleared by `continue-process' and set by ! `stop-process'. ! ! :filter FILTER -- Install FILTER as the process filter. ! ! :sentinel SENTINEL -- Install SENTINEL as the process sentinel. ! ! :log LOG -- Install LOG as the server process log function. This ! function is called as when the server accepts a network connection from a ! client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER ! is the server process, CLIENT is the new process for the connection, ! and MESSAGE is a string. ! ! :server BOOL -- if BOOL is non-nil, create a server process for the ! specified FAMILY, SERVICE, and connection type (stream or datagram). ! Default is a client process. ! ! A server process will listen for and accept connections from ! clients. When a client connection is accepted, a new network process ! is created for the connection with the following parameters: ! - The client's process name is constructed by concatenating the server ! process' NAME and a client identification string. ! - If the FILTER argument is non-nil, the client process will not get a ! separate process buffer; otherwise, the client's process buffer is a newly ! created buffer named after the server process' BUFFER name or process ! NAME concatenated with the client identification string. ! - The connection type and the process filter and sentinel parameters are ! inherited from the server process' TYPE, FILTER and SENTINEL. ! - The client process' contact info is set according to the client's ! addressing information (typically an IP address and a port number). ! ! Notice that the FILTER and SENTINEL args are never used directly by ! the server process. Also, the BUFFER argument is not used directly by ! the server process, but via `network-server-log-function' hook, a log ! of the accepted (and failed) connections may be recorded in the server ! process' buffer. ! ! The following special call returns t iff a given KEY VALUE ! pair is supported on this system: ! (make-network-process :feature KEY VALUE) */) ! (nargs, args) ! int nargs; ! Lisp_Object *args; { Lisp_Object proc; + Lisp_Object contact; + struct Lisp_Process *p; #ifdef HAVE_GETADDRINFO ! struct addrinfo ai, *res, *lres; ! struct addrinfo hints; ! char *portstring, portbuf[128]; #else /* HAVE_GETADDRINFO */ struct _emacs_addrinfo { int ai_family; *************** *** 1834,1983 **** struct _emacs_addrinfo *ai_next; } ai, *res, *lres; #endif /* HAVE_GETADDRINFO */ int ret = 0; int xerrno = 0; int s = -1, outch, inch; ! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; int retry = 0; int count = specpdl_ptr - specpdl; int count1; ! int is_non_blocking = 0; ! if (!NILP (non_blocking)) { ! #ifndef NON_BLOCKING_CONNECT ! return Qnil; ! #else ! non_blocking = Qt; /* Instead of GCPRO */ ! is_non_blocking = 1; ! #endif } #ifdef WINDOWSNT /* Ensure socket support is loaded if available. */ init_winsock (TRUE); #endif ! /* Can only GCPRO 5 variables */ ! GCPRO6 (name, buffer, host, service, sentinel, filter); ! CHECK_STRING (name); ! CHECK_STRING (host); ! #ifdef HAVE_GETADDRINFO ! /* SERVICE can either be a string or int. ! Convert to a C string for later use by getaddrinfo. */ ! if (INTEGERP (service)) { ! sprintf (portbuf, "%ld", (long) XINT (service)); ! portstring = portbuf; } ! else { ! CHECK_STRING (service); ! portstring = XSTRING (service)->data; } ! #else /* HAVE_GETADDRINFO */ if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { CHECK_STRING (service); svc_info = getservbyname (XSTRING (service)->data, "tcp"); if (svc_info == 0) ! error ("Unknown service \"%s\"", XSTRING (service)->data); port = svc_info->s_port; } - #endif /* HAVE_GETADDRINFO */ /* Slow down polling to every ten seconds. Some kernels have a bug which causes retrying connect to fail after a connect. Polling can interfere with gethostbyname too. */ #ifdef POLL_FOR_INPUT ! record_unwind_protect (unwind_stop_other_atimers, Qnil); ! bind_polling_period (10); #endif - #ifndef TERM #ifdef HAVE_GETADDRINFO ! immediate_quit = 1; ! QUIT; ! memset (&hints, 0, sizeof (hints)); ! hints.ai_flags = 0; ! hints.ai_family = AF_UNSPEC; ! hints.ai_socktype = SOCK_STREAM; ! hints.ai_protocol = 0; ! ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res); ! if (ret) #ifdef HAVE_GAI_STRERROR ! error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret)); #else ! error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ! ret); #endif ! immediate_quit = 0; ! #else /* not HAVE_GETADDRINFO */ ! while (1) { ! #if 0 ! #ifdef TRY_AGAIN ! h_errno = 0; ! #endif ! #endif immediate_quit = 1; QUIT; host_info_ptr = gethostbyname (XSTRING (host)->data); immediate_quit = 0; - #if 0 - #ifdef TRY_AGAIN - if (! (host_info_ptr == 0 && h_errno == TRY_AGAIN)) - #endif - #endif - break; - Fsleep_for (make_number (1), Qnil); - } ! if (host_info_ptr == 0) ! /* Attempt to interpret host as numeric inet address */ ! { ! numeric_addr = inet_addr ((char *) XSTRING (host)->data); ! if (NUMERIC_ADDR_ERROR) ! error ("Unknown host \"%s\"", XSTRING (host)->data); ! ! host_info_ptr = &host_info; ! host_info.h_name = 0; ! host_info.h_aliases = 0; ! host_info.h_addrtype = AF_INET; ! #ifdef h_addr ! /* Older machines have only one address slot called h_addr. ! Newer machines have h_addr_list, but #define h_addr to ! be its first element. */ ! host_info.h_addr_list = &(addr_list[0]); ! #endif ! host_info.h_addr = (char*)(&numeric_addr); ! addr_list[1] = 0; ! /* numeric_addr isn't null-terminated; it has fixed length. */ ! host_info.h_length = sizeof (numeric_addr); ! } ! ! bzero (&address, sizeof address); ! bcopy (host_info_ptr->h_addr, (char *) &address.sin_addr, ! host_info_ptr->h_length); ! address.sin_family = host_info_ptr->h_addrtype; ! address.sin_port = port; ! ! /* Emulate HAVE_GETADDRINFO for the loop over `res' below. */ ! ai.ai_family = host_info_ptr->h_addrtype; ! ai.ai_socktype = SOCK_STREAM; ! ai.ai_protocol = 0; ! ai.ai_addr = (struct sockaddr *) &address; ! ai.ai_addrlen = sizeof address; ! ai.ai_next = NULL; ! res = &ai; #endif /* not HAVE_GETADDRINFO */ /* Do this in case we never enter the for-loop below. */ count1 = specpdl_ptr - specpdl; s = -1; --- 2365,2677 ---- struct _emacs_addrinfo *ai_next; } ai, *res, *lres; #endif /* HAVE_GETADDRINFO */ + struct sockaddr *sa = 0; + struct sockaddr_in address_in; + #ifdef AF_LOCAL + struct sockaddr_un address_un; + #endif + int port; int ret = 0; int xerrno = 0; int s = -1, outch, inch; ! struct gcpro gcpro1; int retry = 0; int count = specpdl_ptr - specpdl; int count1; ! Lisp_Object QCaddress; /* one of QClocal or QCremote */ ! Lisp_Object tem; ! Lisp_Object name, buffer, host, service, address; ! Lisp_Object filter, sentinel; ! int is_non_blocking_client = 0; ! int is_server = 0; ! int socktype = SOCK_STREAM; ! int family = -1; ! ! if (nargs == 0) ! return Qnil; ! /* Handle :feature KEY VALUE query. */ ! if (EQ (args[0], QCfeature)) { ! if (nargs != 3) ! return Qnil; ! return network_process_featurep (args[1], args[2]) ? Qt : Qnil; } + /* Save arguments for process-contact and clone-process. */ + contact = Flist (nargs, args); + GCPRO1 (contact); + #ifdef WINDOWSNT /* Ensure socket support is loaded if available. */ init_winsock (TRUE); #endif ! /* :datagram BOOL */ ! tem = Fplist_get (contact, QCdatagram); ! if (!NILP (tem)) ! { ! #ifndef DATAGRAM_SOCKETS ! error ("Datagram connections not supported"); ! #else ! socktype = SOCK_DGRAM; ! #endif ! } ! /* :server BOOL */ ! tem = Fplist_get (contact, QCserver); ! if (!NILP (tem)) { ! #ifdef TERM ! error ("Network servers not supported"); ! #else ! is_server = 1; ! #endif } ! ! /* Make QCaddress an alias for :local (server) or :remote (client). */ ! QCaddress = is_server ? QClocal : QCremote; ! ! /* :wait BOOL */ ! if (!is_server && socktype == SOCK_STREAM ! && (tem = Fplist_get (contact, QCnowait), !NILP (tem))) { ! #ifndef NON_BLOCKING_CONNECT ! error ("Non-blocking connect not supported"); ! #else ! is_non_blocking_client = 1; ! #endif } ! ! name = Fplist_get (contact, QCname); ! buffer = Fplist_get (contact, QCbuffer); ! filter = Fplist_get (contact, QCfilter); ! sentinel = Fplist_get (contact, QCsentinel); ! ! CHECK_STRING (name); ! ! #ifdef TERM ! /* Let's handle TERM before things get complicated ... */ ! host = Fplist_get (contact, QChost); ! CHECK_STRING (host); ! ! service = Fplist_get (contact, QCservice); if (INTEGERP (service)) port = htons ((unsigned short) XINT (service)); else { + struct servent *svc_info; CHECK_STRING (service); svc_info = getservbyname (XSTRING (service)->data, "tcp"); if (svc_info == 0) ! error ("Unknown service: %s", XSTRING (service)->data); port = svc_info->s_port; } + s = connect_server (0); + if (s < 0) + report_file_error ("error creating socket", Fcons (name, Qnil)); + send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port)); + send_command (s, C_DUMB, 1, 0); + + #else /* not TERM */ + + /* Initialize addrinfo structure in case we don't use getaddrinfo. */ + ai.ai_socktype = socktype; + ai.ai_protocol = 0; + ai.ai_next = NULL; + res = &ai; + + /* :local ADDRESS or :remote ADDRESS */ + address = Fplist_get (contact, QCaddress); + if (!NILP (address)) + { + host = service = Qnil; + + if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family))) + error ("Malformed :address"); + ai.ai_family = family; + ai.ai_addr = alloca (ai.ai_addrlen); + conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen); + goto open_socket; + } + + /* :family FAMILY -- nil (for Inet), local, or integer. */ + tem = Fplist_get (contact, QCfamily); + if (INTEGERP (tem)) + family = XINT (tem); + else + { + if (NILP (tem)) + family = AF_INET; + #ifdef AF_LOCAL + else if (EQ (tem, Qlocal)) + family = AF_LOCAL; + #endif + } + if (family < 0) + error ("Unknown address family"); + ai.ai_family = family; + + /* :service SERVICE -- string, integer (port number), or t (random port). */ + service = Fplist_get (contact, QCservice); + + #ifdef AF_LOCAL + if (family == AF_LOCAL) + { + /* Host is not used. */ + host = Qnil; + CHECK_STRING (service); + bzero (&address_un, sizeof address_un); + address_un.sun_family = AF_LOCAL; + strncpy (address_un.sun_path, XSTRING (service)->data, sizeof address_un.sun_path); + ai.ai_addr = (struct sockaddr *) &address_un; + ai.ai_addrlen = sizeof address_un; + goto open_socket; + } + #endif + + /* :host HOST -- hostname, ip address, or 'local for localhost. */ + host = Fplist_get (contact, QChost); + if (!NILP (host)) + { + if (EQ (host, Qlocal)) + host = build_string ("localhost"); + CHECK_STRING (host); + } /* Slow down polling to every ten seconds. Some kernels have a bug which causes retrying connect to fail after a connect. Polling can interfere with gethostbyname too. */ #ifdef POLL_FOR_INPUT ! if (socktype == SOCK_STREAM) ! { ! record_unwind_protect (unwind_stop_other_atimers, Qnil); ! bind_polling_period (10); ! } #endif #ifdef HAVE_GETADDRINFO ! /* If we have a host, use getaddrinfo to resolve both host and service. ! Otherwise, use getservbyname to lookup the service. */ ! if (!NILP (host)) ! { ! ! /* SERVICE can either be a string or int. ! Convert to a C string for later use by getaddrinfo. */ ! if (EQ (service, Qt)) ! portstring = "0"; ! else if (INTEGERP (service)) ! { ! sprintf (portbuf, "%ld", (long) XINT (service)); ! portstring = portbuf; ! } ! else ! { ! CHECK_STRING (service); ! portstring = XSTRING (service)->data; ! } ! ! immediate_quit = 1; ! QUIT; ! memset (&hints, 0, sizeof (hints)); ! hints.ai_flags = 0; ! hints.ai_family = NILP (Fplist_member (QCfamily)) ? AF_UNSPEC : family; ! hints.ai_socktype = socktype; ! hints.ai_protocol = 0; ! ret = getaddrinfo (XSTRING (host)->data, portstring, &hints, &res); ! if (ret) #ifdef HAVE_GAI_STRERROR ! error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret)); #else ! error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret); #endif ! immediate_quit = 0; ! ! goto open_socket; ! } ! #endif /* HAVE_GETADDRINFO */ ! /* We end up here if getaddrinfo is not defined, or in case no hostname ! has been specified (e.g. for a local server process). */ ! if (EQ (service, Qt)) ! port = 0; ! else if (INTEGERP (service)) ! port = htons ((unsigned short) XINT (service)); ! else { ! struct servent *svc_info; ! CHECK_STRING (service); ! svc_info = getservbyname (XSTRING (service)->data, ! (socktype == SOCK_DGRAM ? "udp" : "tcp")); ! if (svc_info == 0) ! error ("Unknown service: %s", XSTRING (service)->data); ! port = svc_info->s_port; ! } ! ! bzero (&address_in, sizeof address_in); ! address_in.sin_family = family; ! address_in.sin_addr.s_addr = INADDR_ANY; ! address_in.sin_port = port; ! ! #ifndef HAVE_GETADDRINFO ! if (!NILP (host)) ! { ! struct hostent *host_info_ptr; ! ! /* gethostbyname may fail with TRY_AGAIN, but we don't honour that, ! as it may `hang' emacs for a very long time. */ immediate_quit = 1; QUIT; host_info_ptr = gethostbyname (XSTRING (host)->data); immediate_quit = 0; ! if (host_info_ptr) ! { ! bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr, ! host_info_ptr->h_length); ! family = host_info_ptr->h_addrtype; ! address_in.sin_family = family; ! } ! else ! /* Attempt to interpret host as numeric inet address */ ! { ! IN_ADDR numeric_addr; ! numeric_addr = inet_addr ((char *) XSTRING (host)->data); ! if (NUMERIC_ADDR_ERROR) ! error ("Unknown host \"%s\"", XSTRING (host)->data); ! ! bcopy ((char *)&numeric_addr, (char *) &address_in.sin_addr, ! sizeof (address_in.sin_addr)); ! } ! ! } #endif /* not HAVE_GETADDRINFO */ + ai.ai_family = family; + ai.ai_addr = (struct sockaddr *) &address_in; + ai.ai_addrlen = sizeof address_in; + + open_socket: + + /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) + when connect is interrupted. So let's not let it get interrupted. + Note we do not turn off polling, because polling is only used + when not interrupt_input, and thus not normally used on the systems + which have this bug. On systems which use polling, there's no way + to quit if polling is turned off. */ + if (interrupt_input + && !is_server && socktype == SOCK_STREAM) + { + /* Comment from KFS: The original open-network-stream code + didn't unwind protect this, but it seems like the proper + thing to do. In any case, I don't see how it could harm to + do this -- and it makes cleanup (using unbind_to) easier. */ + record_unwind_protect (unwind_request_sigio, Qnil); + unrequest_sigio (); + } + /* Do this in case we never enter the for-loop below. */ count1 = specpdl_ptr - specpdl; s = -1; *************** *** 1991,1998 **** continue; } #ifdef NON_BLOCKING_CONNECT ! if (is_non_blocking) { #ifdef O_NONBLOCK ret = fcntl (s, F_SETFL, O_NONBLOCK); --- 2685,2697 ---- continue; } + #ifdef DATAGRAM_SOCKETS + if (!is_server && socktype == SOCK_DGRAM) + break; + #endif /* DATAGRAM_SOCKETS */ + #ifdef NON_BLOCKING_CONNECT ! if (is_non_blocking_client) { #ifdef O_NONBLOCK ret = fcntl (s, F_SETFL, O_NONBLOCK); *************** *** 2008,2028 **** } } #endif ! ! /* Kernel bugs (on Ultrix at least) cause lossage (not just EINTR) ! when connect is interrupted. So let's not let it get interrupted. ! Note we do not turn off polling, because polling is only used ! when not interrupt_input, and thus not normally used on the systems ! which have this bug. On systems which use polling, there's no way ! to quit if polling is turned off. */ ! if (interrupt_input) ! unrequest_sigio (); ! /* Make us close S if quit. */ - count1 = specpdl_ptr - specpdl; record_unwind_protect (close_file_unwind, make_number (s)); ! loop: immediate_quit = 1; QUIT; --- 2707,2752 ---- } } #endif ! /* Make us close S if quit. */ record_unwind_protect (close_file_unwind, make_number (s)); ! if (is_server) ! { ! /* Configure as a server socket. */ ! #ifdef AF_LOCAL ! if (family != AF_LOCAL) ! #endif ! { ! int optval = 1; ! if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval)) ! report_file_error ("Cannot set reuse option on server socket.", Qnil); ! } ! ! if (bind (s, lres->ai_addr, lres->ai_addrlen)) ! report_file_error ("Cannot bind server socket", Qnil); ! ! #ifdef HAVE_GETSOCKNAME ! if (EQ (service, Qt)) ! { ! struct sockaddr_in sa1; ! int len1 = sizeof (sa1); ! if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0) ! { ! ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port; ! service = make_number (sa1.sin_port); ! contact = Fplist_put (contact, QCservice, service); ! } ! } ! #endif ! ! if (socktype == SOCK_STREAM && listen (s, 5)) ! report_file_error ("Cannot listen on server socket", Qnil); ! ! break; ! } ! ! retry_connect: immediate_quit = 1; QUIT; *************** *** 2046,2052 **** if (ret == 0 || xerrno == EISCONN) { - is_non_blocking = 0; /* The unwind-protect will be discarded afterwards. Likewise for immediate_quit. */ break; --- 2770,2775 ---- *************** *** 2054,2064 **** #ifdef NON_BLOCKING_CONNECT #ifdef EINPROGRESS ! if (is_non_blocking && xerrno == EINPROGRESS) break; #else #ifdef EWOULDBLOCK ! if (is_non_blocking && xerrno == EWOULDBLOCK) break; #endif #endif --- 2777,2787 ---- #ifdef NON_BLOCKING_CONNECT #ifdef EINPROGRESS ! if (is_non_blocking_client && xerrno == EINPROGRESS) break; #else #ifdef EWOULDBLOCK ! if (is_non_blocking_client && xerrno == EWOULDBLOCK) break; #endif #endif *************** *** 2067,2073 **** immediate_quit = 0; if (xerrno == EINTR) ! goto loop; if (xerrno == EADDRINUSE && retry < 20) { /* A delay here is needed on some FreeBSD systems, --- 2790,2796 ---- immediate_quit = 0; if (xerrno == EINTR) ! goto retry_connect; if (xerrno == EADDRINUSE && retry < 20) { /* A delay here is needed on some FreeBSD systems, *************** *** 2075,2136 **** and should be infrequent. */ Fsleep_for (make_number (1), Qnil); retry++; ! goto loop; } /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count1; - count1 = specpdl_ptr - specpdl; - emacs_close (s); s = -1; } #ifdef HAVE_GETADDRINFO ! freeaddrinfo (res); #endif if (s < 0) { - if (interrupt_input) - request_sigio (); - /* If non-blocking got this far - and failed - assume non-blocking is not supported after all. This is probably a wrong assumption, but ! the normal blocking calls to open-network-stream handles this error ! better. */ ! if (is_non_blocking) ! { ! #ifdef POLL_FOR_INPUT ! unbind_to (count, Qnil); ! #endif return Qnil; - } errno = xerrno; ! report_file_error ("connection failed", ! Fcons (host, Fcons (name, Qnil))); } - - immediate_quit = 0; - - /* Discard the unwind protect, if any. */ - specpdl_ptr = specpdl + count1; - - #ifdef POLL_FOR_INPUT - unbind_to (count, Qnil); - #endif ! if (interrupt_input) ! request_sigio (); ! ! #else /* TERM */ ! s = connect_server (0); ! if (s < 0) ! report_file_error ("error creating socket", Fcons (name, Qnil)); ! send_command (s, C_PORT, 0, "%s:%d", XSTRING (host)->data, ntohs (port)); ! send_command (s, C_DUMB, 1, 0); ! #endif /* TERM */ inch = s; outch = s; --- 2798,2861 ---- and should be infrequent. */ Fsleep_for (make_number (1), Qnil); retry++; ! goto retry_connect; } /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count1; emacs_close (s); s = -1; } + if (s >= 0) + { + #ifdef DATAGRAM_SOCKETS + if (socktype == SOCK_DGRAM) + { + if (datagram_address[s].sa) + abort (); + datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen); + datagram_address[s].len = lres->ai_addrlen; + if (is_server) + bzero (datagram_address[s].sa, lres->ai_addrlen); + else + bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen); + } + #endif + contact = Fplist_put (contact, QCaddress, + conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen)); + } + #ifdef HAVE_GETADDRINFO ! if (res != &ai) ! freeaddrinfo (res); #endif + immediate_quit = 0; + + /* Discard the unwind protect for closing S, if any. */ + specpdl_ptr = specpdl + count1; + + /* Unwind bind_polling_period and request_sigio. */ + unbind_to (count, Qnil); + if (s < 0) { /* If non-blocking got this far - and failed - assume non-blocking is not supported after all. This is probably a wrong assumption, but ! the normal blocking calls to open-network-stream handles this error ! better. */ ! if (is_non_blocking_client) return Qnil; errno = xerrno; ! if (is_server) ! report_file_error ("make server process failed", contact); ! else ! report_file_error ("make client process failed", contact); } ! #endif /* not TERM */ inch = s; outch = s; *************** *** 2149,2172 **** #endif #endif ! XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil)); ! XPROCESS (proc)->command_channel_p = Qnil; ! XPROCESS (proc)->buffer = buffer; ! XPROCESS (proc)->sentinel = sentinel; ! XPROCESS (proc)->filter = filter; ! XPROCESS (proc)->command = Qnil; ! XPROCESS (proc)->pid = Qnil; ! XSETINT (XPROCESS (proc)->infd, inch); ! XSETINT (XPROCESS (proc)->outfd, outch); ! XPROCESS (proc)->status = Qrun; #ifdef NON_BLOCKING_CONNECT ! if (!NILP (non_blocking)) { /* We may get here if connect did succeed immediately. However, in that case, we still need to signal this like a non-blocking connection. */ ! XPROCESS (proc)->status = Qconnect; if (!FD_ISSET (inch, &connect_wait_mask)) { FD_SET (inch, &connect_wait_mask); --- 2874,2903 ---- #endif #endif ! p = XPROCESS (proc); ! ! p->childp = contact; ! p->buffer = buffer; ! p->sentinel = sentinel; ! p->filter = filter; ! p->log = Fplist_get (contact, QClog); ! if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) ! p->kill_without_query = Qt; ! if ((tem = Fplist_get (contact, QCstop), !NILP (tem))) ! p->command = Qt; ! p->pid = Qnil; ! XSETINT (p->infd, inch); ! XSETINT (p->outfd, outch); ! if (is_server && socktype == SOCK_STREAM) ! p->status = Qlisten; #ifdef NON_BLOCKING_CONNECT ! if (is_non_blocking_client) { /* We may get here if connect did succeed immediately. However, in that case, we still need to signal this like a non-blocking connection. */ ! p->status = Qconnect; if (!FD_ISSET (inch, &connect_wait_mask)) { FD_SET (inch, &connect_wait_mask); *************** *** 2175,2181 **** } else #endif ! if (!EQ (XPROCESS (proc)->filter, Qt)) { FD_SET (inch, &input_wait_mask); FD_SET (inch, &non_keyboard_wait_mask); --- 2906,2915 ---- } else #endif ! /* A server may have a client filter setting of Qt, but it must ! still listen for incoming connects unless it is stopped. */ ! if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt)) ! || (EQ (p->status, Qlisten) && NILP (p->command))) { FD_SET (inch, &input_wait_mask); FD_SET (inch, &non_keyboard_wait_mask); *************** *** 2214,2220 **** else val = Qnil; } ! XPROCESS (proc)->decode_coding_system = val; if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; --- 2948,2954 ---- else val = Qnil; } ! p->decode_coding_system = val; if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; *************** *** 2237,2262 **** else val = Qnil; } ! XPROCESS (proc)->encode_coding_system = val; } if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); ! setup_coding_system (XPROCESS (proc)->decode_coding_system, proc_decode_coding_system[inch]); if (!proc_encode_coding_system[outch]) proc_encode_coding_system[outch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); ! setup_coding_system (XPROCESS (proc)->encode_coding_system, proc_encode_coding_system[outch]); ! XPROCESS (proc)->decoding_buf = make_uninit_string (0); ! XPROCESS (proc)->decoding_carryover = make_number (0); ! XPROCESS (proc)->encoding_buf = make_uninit_string (0); ! XPROCESS (proc)->encoding_carryover = make_number (0); ! XPROCESS (proc)->inherit_coding_system_flag = (NILP (buffer) || !inherit_process_coding_system ? Qnil : Qt); --- 2971,2996 ---- else val = Qnil; } ! p->encode_coding_system = val; } if (!proc_decode_coding_system[inch]) proc_decode_coding_system[inch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); ! setup_coding_system (p->decode_coding_system, proc_decode_coding_system[inch]); if (!proc_encode_coding_system[outch]) proc_encode_coding_system[outch] = (struct coding_system *) xmalloc (sizeof (struct coding_system)); ! setup_coding_system (p->encode_coding_system, proc_encode_coding_system[outch]); ! p->decoding_buf = make_uninit_string (0); ! p->decoding_carryover = make_number (0); ! p->encoding_buf = make_uninit_string (0); ! p->encoding_carryover = make_number (0); ! p->inherit_coding_system_flag = (NILP (buffer) || !inherit_process_coding_system ? Qnil : Qt); *************** *** 2295,2300 **** --- 3029,3042 ---- XSETINT (p->infd, -1); XSETINT (p->outfd, -1); + #ifdef DATAGRAM_SOCKETS + if (DATAGRAM_CHAN_P (inchannel)) + { + xfree (datagram_address[inchannel].sa); + datagram_address[inchannel].sa = 0; + datagram_address[inchannel].len = 0; + } + #endif chan_process[inchannel] = Qnil; FD_CLR (inchannel, &input_wait_mask); FD_CLR (inchannel, &non_keyboard_wait_mask); *************** *** 2411,2416 **** --- 3153,3353 ---- ? Qt : Qnil); } + /* Accept a connection for server process SERVER on CHANNEL. */ + + static int connect_counter = 0; + + static void + server_accept_connection (server, channel) + Lisp_Object server; + int channel; + { + Lisp_Object proc, caller, name, buffer; + Lisp_Object contact, host, service; + struct Lisp_Process *ps= XPROCESS (server); + struct Lisp_Process *p; + int s; + union u_sockaddr { + struct sockaddr sa; + struct sockaddr_in in; + #ifdef AF_LOCAL + struct sockaddr_un un; + #endif + } saddr; + int len = sizeof saddr; + + s = accept (channel, &saddr.sa, &len); + + if (s < 0) + { + int code = errno; + + if (code == EAGAIN) + return; + #ifdef EWOULDBLOCK + if (code == EWOULDBLOCK) + return; + #endif + + if (!NILP (ps->log)) + call3 (ps->log, server, Qnil, + concat3 (build_string ("accept failed with code"), + Fnumber_to_string (make_number (code)), + build_string ("\n"))); + return; + } + + connect_counter++; + + /* Setup a new process to handle the connection. */ + + /* Generate a unique identification of the caller, and build contact + information for this process. */ + host = Qt; + service = Qnil; + switch (saddr.sa.sa_family) + { + case AF_INET: + { + Lisp_Object args[5]; + unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr; + args[0] = build_string ("%d.%d.%d.%d"); + args[1] = make_number (*ip++); + args[2] = make_number (*ip++); + args[3] = make_number (*ip++); + args[4] = make_number (*ip++); + host = Fformat (5, args); + service = make_number (ntohs (saddr.in.sin_port)); + + args[0] = build_string (" <%s:%d>"); + args[1] = host; + args[2] = service; + caller = Fformat (3, args); + } + break; + + #ifdef AF_LOCAL + case AF_LOCAL: + #endif + default: + caller = Fnumber_to_string (make_number (connect_counter)); + caller = concat3 (build_string (" <*"), caller, build_string ("*>")); + break; + } + + /* Create a new buffer name for this process if it doesn't have a + filter. The new buffer name is based on the buffer name or + process name of the server process concatenated with the caller + identification. */ + + if (!NILP (ps->filter) && !EQ (ps->filter, Qt)) + buffer = Qnil; + else + { + buffer = ps->buffer; + if (!NILP (buffer)) + buffer = Fbuffer_name (buffer); + else + buffer = ps->name; + if (!NILP (buffer)) + { + buffer = concat2 (buffer, caller); + buffer = Fget_buffer_create (buffer); + } + } + + /* Generate a unique name for the new server process. Combine the + server process name with the caller identification. */ + + name = concat2 (ps->name, caller); + proc = make_process (name); + + chan_process[s] = proc; + + #ifdef O_NONBLOCK + fcntl (s, F_SETFL, O_NONBLOCK); + #else + #ifdef O_NDELAY + fcntl (s, F_SETFL, O_NDELAY); + #endif + #endif + + p = XPROCESS (proc); + + /* Build new contact information for this setup. */ + contact = Fcopy_sequence (ps->childp); + contact = Fplist_put (contact, QChost, host); + if (!NILP (service)) + contact = Fplist_put (contact, QCservice, service); + contact = Fplist_put (contact, QCremote, + conv_sockaddr_to_lisp (&saddr.sa, len)); + #ifdef HAVE_GETSOCKNAME + len = sizeof saddr; + if (getsockname (channel, &saddr.sa, &len) == 0) + contact = Fplist_put (contact, QClocal, + conv_sockaddr_to_lisp (&saddr.sa, len)); + #endif + + p->childp = contact; + p->buffer = buffer; + p->sentinel = ps->sentinel; + p->filter = ps->filter; + p->command = Qnil; + p->pid = Qnil; + XSETINT (p->infd, s); + XSETINT (p->outfd, s); + p->status = Qrun; + + /* Client processes for accepted connections are not stopped initially. */ + if (!EQ (p->filter, Qt)) + { + FD_SET (s, &input_wait_mask); + FD_SET (s, &non_keyboard_wait_mask); + } + + if (s > max_process_desc) + max_process_desc = s; + + /* Setup coding system for new process based on server process. + This seems to be the proper thing to do, as the coding system + of the new process should reflect the settings at the time the + server socket was opened; not the current settings. */ + + p->decode_coding_system = ps->decode_coding_system; + p->encode_coding_system = ps->encode_coding_system; + + if (!proc_decode_coding_system[s]) + proc_decode_coding_system[s] + = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + setup_coding_system (p->decode_coding_system, + proc_decode_coding_system[s]); + if (!proc_encode_coding_system[s]) + proc_encode_coding_system[s] + = (struct coding_system *) xmalloc (sizeof (struct coding_system)); + setup_coding_system (p->encode_coding_system, + proc_encode_coding_system[s]); + + p->decoding_buf = make_uninit_string (0); + p->decoding_carryover = make_number (0); + p->encoding_buf = make_uninit_string (0); + p->encoding_carryover = make_number (0); + + p->inherit_coding_system_flag + = (NILP (buffer) ? Qnil : ps->inherit_coding_system_flag); + + if (!NILP (ps->log)) + call3 (ps->log, server, proc, + concat3 (build_string ("accept from "), + (STRINGP (host) ? host : build_string ("-")), + build_string ("\n"))); + + if (p->sentinel) + exec_sentinel (proc, + concat3 (build_string ("open from "), + (STRINGP (host) ? host : build_string ("-")), + build_string ("\n"))); + } + /* This variable is different from waiting_for_input in keyboard.c. It is used to communicate to a lisp process-filter/sentinel (via the function Fwaiting_for_user_input_p below) whether emacs was waiting *************** *** 2909,2914 **** --- 3846,3858 ---- if (NILP (proc)) continue; + /* If this is a server stream socket, accept connection. */ + if (EQ (XPROCESS (proc)->status, Qlisten)) + { + server_accept_connection (proc, channel); + continue; + } + /* Read data from the process, starting with our buffered-ahead character if we have one. */ *************** *** 2983,2989 **** { struct Lisp_Process *p; struct sockaddr pname; ! socklen_t pnamelen = sizeof(pname); FD_CLR (channel, &connect_wait_mask); if (--num_pending_connects < 0) --- 3927,3933 ---- { struct Lisp_Process *p; struct sockaddr pname; ! int pnamelen = sizeof(pname); FD_CLR (channel, &connect_wait_mask); if (--num_pending_connects < 0) *************** *** 2999,3005 **** /* getsockopt(,,SO_ERROR,,) is said to hang on some systems. So only use it on systems where it is known to work. */ { ! socklen_t xlen = sizeof(xerrno); if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen)) xerrno = errno; } --- 3943,3949 ---- /* getsockopt(,,SO_ERROR,,) is said to hang on some systems. So only use it on systems where it is known to work. */ { ! int xlen = sizeof(xerrno); if (getsockopt(channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen)) xerrno = errno; } *************** *** 3028,3034 **** status_notify to do it later, it will read input from the process before calling the sentinel. */ exec_sentinel (proc, build_string ("open\n")); ! if (!EQ (p->filter, Qt)) { FD_SET (XINT (p->infd), &input_wait_mask); FD_SET (XINT (p->infd), &non_keyboard_wait_mask); --- 3972,3978 ---- status_notify to do it later, it will read input from the process before calling the sentinel. */ exec_sentinel (proc, build_string ("open\n")); ! if (!EQ (p->filter, Qt) && !EQ (p->command, Qt)) { FD_SET (XINT (p->infd), &input_wait_mask); FD_SET (XINT (p->infd), &non_keyboard_wait_mask); *************** *** 3106,3111 **** --- 4050,4056 ---- register int opoint; struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = XINT (p->decoding_carryover); + int readmax = 1024; #ifdef VMS VMS_PROC_STUFF *vs, *get_vms_process_pointer(); *************** *** 3137,3154 **** bcopy (vs->inputBuffer, chars + carryover, nbytes); } #else /* not VMS */ ! chars = (char *) alloca (carryover + 1024); if (carryover) /* See the comment above. */ bcopy (XSTRING (p->decoding_buf)->data, chars, carryover); if (proc_buffered_char[channel] < 0) ! nbytes = emacs_read (channel, chars + carryover, 1024 - carryover); else { chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; ! nbytes = emacs_read (channel, chars + carryover + 1, 1023 - carryover); if (nbytes < 0) nbytes = 1; else --- 4082,4120 ---- bcopy (vs->inputBuffer, chars + carryover, nbytes); } #else /* not VMS */ ! ! #ifdef DATAGRAM_SOCKETS ! /* A datagram is one packet; allow at least 1500+ bytes of data ! corresponding to the typical Ethernet frame size. */ ! if (DATAGRAM_CHAN_P (channel)) ! { ! /* carryover = 0; */ /* Does carryover make sense for datagrams? */ ! readmax += 1024; ! } ! #endif ! ! chars = (char *) alloca (carryover + readmax); if (carryover) /* See the comment above. */ bcopy (XSTRING (p->decoding_buf)->data, chars, carryover); + #ifdef DATAGRAM_SOCKETS + /* We have a working select, so proc_buffered_char is always -1. */ + if (DATAGRAM_CHAN_P (channel)) + { + int len = datagram_address[channel].len; + nbytes = recvfrom (channel, chars + carryover, readmax - carryover, + 0, datagram_address[channel].sa, &len); + } + else + #endif if (proc_buffered_char[channel] < 0) ! nbytes = emacs_read (channel, chars + carryover, readmax - carryover); else { chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; ! nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover); if (nbytes < 0) nbytes = 1; else *************** *** 3614,3622 **** /* Send this batch, using one or more write calls. */ while (this > 0) { old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); ! rv = emacs_write (XINT (XPROCESS (proc)->outfd), ! (char *) buf, this); signal (SIGPIPE, old_sigpipe); if (rv < 0) --- 4580,4599 ---- /* Send this batch, using one or more write calls. */ while (this > 0) { + int outfd = XINT (XPROCESS (proc)->outfd); old_sigpipe = (SIGTYPE (*) ()) signal (SIGPIPE, send_process_trap); ! #ifdef DATAGRAM_SOCKETS ! if (DATAGRAM_CHAN_P (outfd)) ! { ! rv = sendto (outfd, (char *) buf, this, ! 0, datagram_address[outfd].sa, ! datagram_address[outfd].len); ! if (rv < 0 && errno == EMSGSIZE) ! report_file_error ("sending datagram", Fcons (proc, Qnil)); ! } ! else ! #endif ! rv = emacs_write (outfd, (char *) buf, this); signal (SIGPIPE, old_sigpipe); if (rv < 0) *************** *** 4071,4080 **** DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, doc: /* Stop process PROCESS. May be process or name of one. ! See function `interrupt-process' for more details on usage. */) (process, current_group) Lisp_Object process, current_group; { #ifndef SIGTSTP error ("no SIGTSTP support"); #else --- 5048,5074 ---- DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, doc: /* Stop process PROCESS. May be process or name of one. ! See function `interrupt-process' for more details on usage. ! If PROCESS is a network process, inhibit handling of incoming traffic. */) (process, current_group) Lisp_Object process, current_group; { + #ifdef HAVE_SOCKETS + if (PROCESSP (process) && NETCONN_P (process)) + { + struct Lisp_Process *p; + + p = XPROCESS (process); + if (NILP (p->command) + && XINT (p->infd) >= 0) + { + FD_CLR (XINT (p->infd), &input_wait_mask); + FD_CLR (XINT (p->infd), &non_keyboard_wait_mask); + } + p->command = Qt; + return process; + } + #endif #ifndef SIGTSTP error ("no SIGTSTP support"); #else *************** *** 4085,4094 **** DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, doc: /* Continue process PROCESS. May be process or name of one. ! See function `interrupt-process' for more details on usage. */) (process, current_group) Lisp_Object process, current_group; { #ifdef SIGCONT process_send_signal (process, SIGCONT, current_group, 0); #else --- 5079,5106 ---- DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, doc: /* Continue process PROCESS. May be process or name of one. ! See function `interrupt-process' for more details on usage. ! If PROCESS is a network process, resume handling of incoming traffic. */) (process, current_group) Lisp_Object process, current_group; { + #ifdef HAVE_SOCKETS + if (PROCESSP (process) && NETCONN_P (process)) + { + struct Lisp_Process *p; + + p = XPROCESS (process); + if (EQ (p->command, Qt) + && XINT (p->infd) >= 0 + && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten))) + { + FD_SET (XINT (p->infd), &input_wait_mask); + FD_SET (XINT (p->infd), &non_keyboard_wait_mask); + } + p->command = Qnil; + return process; + } + #endif #ifdef SIGCONT process_send_signal (process, SIGCONT, current_group, 0); #else *************** *** 4235,4240 **** --- 5247,5255 ---- Lisp_Object proc; struct coding_system *coding; + if (DATAGRAM_CONN_P (process)) + return process; + proc = get_process (process); coding = proc_encode_coding_system[XINT (XPROCESS (proc)->outfd)]; *************** *** 4619,4624 **** --- 5634,5641 ---- /* If process is still active, read any output that remains. */ while (! EQ (p->filter, Qt) && ! EQ (p->status, Qconnect) + && ! EQ (p->status, Qlisten) + && ! EQ (p->command, Qt) /* Network process not stopped. */ && XINT (p->infd) >= 0 && read_process_output (proc, XINT (p->infd)) > 0); *************** *** 4829,4834 **** --- 5846,5854 ---- } bzero (proc_decode_coding_system, sizeof proc_decode_coding_system); bzero (proc_encode_coding_system, sizeof proc_encode_coding_system); + #ifdef DATAGRAM_SOCKETS + bzero (datagram_address, sizeof datagram_address); + #endif } void *************** *** 4857,4863 **** staticpro (&Qconnect); Qfailed = intern ("failed"); staticpro (&Qfailed); ! Qlast_nonmenu_event = intern ("last-nonmenu-event"); staticpro (&Qlast_nonmenu_event); --- 5877,5920 ---- staticpro (&Qconnect); Qfailed = intern ("failed"); staticpro (&Qfailed); ! Qlisten = intern ("listen"); ! staticpro (&Qlisten); ! Qlocal = intern ("local"); ! staticpro (&Qlocal); ! ! QCname = intern (":name"); ! staticpro (&QCname); ! QCbuffer = intern (":buffer"); ! staticpro (&QCbuffer); ! QChost = intern (":host"); ! staticpro (&QChost); ! QCservice = intern (":service"); ! staticpro (&QCservice); ! QCfamily = intern (":family"); ! staticpro (&QCfamily); ! QClocal = intern (":local"); ! staticpro (&QClocal); ! QCremote = intern (":remote"); ! staticpro (&QCremote); ! QCserver = intern (":server"); ! staticpro (&QCserver); ! QCdatagram = intern (":datagram"); ! staticpro (&QCdatagram); ! QCnowait = intern (":nowait"); ! staticpro (&QCnowait); ! QCfilter = intern (":filter"); ! staticpro (&QCfilter); ! QCsentinel = intern (":sentinel"); ! staticpro (&QCsentinel); ! QClog = intern (":log"); ! staticpro (&QClog); ! QCnoquery = intern (":noquery"); ! staticpro (&QCnoquery); ! QCstop = intern (":stop"); ! staticpro (&QCstop); ! QCfeature = intern (":feature"); ! staticpro (&QCfeature); ! Qlast_nonmenu_event = intern ("last-nonmenu-event"); staticpro (&Qlast_nonmenu_event); *************** *** 4897,4910 **** defsubr (&Sset_process_window_size); defsubr (&Sset_process_inherit_coding_system_flag); defsubr (&Sprocess_inherit_coding_system_flag); ! defsubr (&Sprocess_kill_without_query); defsubr (&Sprocess_contact); defsubr (&Slist_processes); defsubr (&Sprocess_list); defsubr (&Sstart_process); #ifdef HAVE_SOCKETS ! defsubr (&Sopen_network_stream); #endif /* HAVE_SOCKETS */ defsubr (&Saccept_process_output); defsubr (&Sprocess_send_region); defsubr (&Sprocess_send_string); --- 5954,5972 ---- defsubr (&Sset_process_window_size); defsubr (&Sset_process_inherit_coding_system_flag); defsubr (&Sprocess_inherit_coding_system_flag); ! defsubr (&Sset_process_query_on_exit_flag); ! defsubr (&Sprocess_query_on_exit_flag); defsubr (&Sprocess_contact); defsubr (&Slist_processes); defsubr (&Sprocess_list); defsubr (&Sstart_process); #ifdef HAVE_SOCKETS ! defsubr (&Smake_network_process); #endif /* HAVE_SOCKETS */ + #ifdef DATAGRAM_SOCKETS + defsubr (&Sprocess_datagram_address); + defsubr (&Sset_process_datagram_address); + #endif defsubr (&Saccept_process_output); defsubr (&Sprocess_send_region); defsubr (&Sprocess_send_string); Index: lisp/ChangeLog =================================================================== RCS file: /cvs/emacs/lisp/ChangeLog,v retrieving revision 1.3574 diff -c -r1.3574 ChangeLog *** lisp/ChangeLog 13 Mar 2002 17:41:53 -0000 1.3574 --- lisp/ChangeLog 13 Mar 2002 23:14:01 -0000 *************** *** 1,3 **** --- 1,24 ---- + 2002-03-13 Kim F. Storm + + The following changes are related to the enhanced network process + support. + + * simple.el (clone-process): Use make-network-process to clone + network processes. Get command list via (process-contact ... t). + Use set-process-query-on-exit-flag and process-query-on-exit-flag + instead of process-kill-without-query. + (open-network-stream): Replaces C-version from process.c. + (open-network-stream-nowait, open-network-stream-server): New + functions. + (process-kill-without-query): Replaces C-version from process.c. + + * files.el (save-buffers-kill-emacs): Also check for active server + processes. Use process-query-on-exit-flag. Only list processes + which has the query-on-exit flag set in connection with user query. + + * shadowfile.el (shadow-save-buffers-kill-emacs): Also check for + active server processes. Use process-query-on-exit-flag. + 2002-03-13 Francesco Potorti` * progmodes/etags.el (tag-exact-file-name-match-p) Index: lisp/simple.el =================================================================== RCS file: /cvs/emacs/lisp/simple.el,v retrieving revision 1.524 diff -c -r1.524 simple.el *** lisp/simple.el 9 Mar 2002 09:05:08 -0000 1.524 --- lisp/simple.el 13 Mar 2002 23:14:03 -0000 *************** *** 3932,3948 **** (setq newname (substring newname 0 (match-beginning 0)))) (when (memq (process-status process) '(run stop open)) (let* ((process-connection-type (process-tty-name process)) - (old-kwoq (process-kill-without-query process nil)) (new-process (if (memq (process-status process) '(open)) ! (apply 'open-network-stream newname ! (if (process-buffer process) (current-buffer)) ! (process-contact process)) (apply 'start-process newname (if (process-buffer process) (current-buffer)) (process-command process))))) ! (process-kill-without-query new-process old-kwoq) ! (process-kill-without-query process old-kwoq) (set-process-inherit-coding-system-flag new-process (process-inherit-coding-system-flag process)) (set-process-filter new-process (process-filter process)) --- 3932,3949 ---- (setq newname (substring newname 0 (match-beginning 0)))) (when (memq (process-status process) '(run stop open)) (let* ((process-connection-type (process-tty-name process)) (new-process (if (memq (process-status process) '(open)) ! (let ((args (process-contact process t))) ! (setq args (plist-put args :name newname)) ! (setq args (plist-put args :buffer ! (if (process-buffer process) (current-buffer)))) ! (apply 'make-network-process args)) (apply 'start-process newname (if (process-buffer process) (current-buffer)) (process-command process))))) ! (set-process-query-on-exit-flag ! new-process (process-query-on-exit-flag process)) (set-process-inherit-coding-system-flag new-process (process-inherit-coding-system-flag process)) (set-process-filter new-process (process-filter process)) *************** *** 4202,4207 **** --- 4203,4290 ---- (message "Delete key deletes %s" (if normal-erase-is-backspace "forward" "backward")))) + + ;;; make-network-process wrappers + + (if (fboundp 'make-network-process) + (progn + + (defun open-network-stream (name buffer host service) + "Open a TCP connection for a service to a host. + Returns a subprocess-object to represent the connection. + Input and output work as for subprocesses; `delete-process' closes it. + Args are NAME BUFFER HOST SERVICE. + NAME is name for process. It is modified if necessary to make it unique. + BUFFER is the buffer (or buffer-name) to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer + Third arg is name of the host to connect to, or its IP address. + Fourth arg SERVICE is name of the service desired, or an integer + specifying a port number to connect to." + (make-network-process :name name :buffer buffer + :host host :service service)) + + (defun open-network-stream-nowait (name buffer host service &optional sentinel filter) + "Initiate connection to a TCP connection for a service to a host. + It returns nil if non-blocking connects are not supported; otherwise, + it returns a subprocess-object to represent the connection. + + This function is similar to `open-network-stream', except that this + function returns before the connection is established. When the + connection is completed, the sentinel function will be called with + second arg matching `open' (if successful) or `failed' (on error). + + Args are NAME BUFFER HOST SERVICE SENTINEL FILTER. + NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'. + Optional args, SENTINEL and FILTER specifies the sentinel and filter + functions to be used for this network stream." + (if (make-network-process :feature :nowait t) + (make-network-process :name name :buffer buffer :nowait t + :host host :service service + :filter filter :sentinel sentinel))) + + (defun open-network-stream-server (name buffer service &optional sentinel filter) + "Create a network server process for a TCP service. + It returns nil if server processes are not supported; otherwise, + it returns a subprocess-object to represent the server. + + When a client connects to the specified service, a new subprocess + is created to handle the new connection, and the sentinel function + is called for the new process. + + Args are NAME BUFFER SERVICE SENTINEL FILTER. + NAME is name for the server process. Client processes are named by + appending the ip-address and port number of the client to NAME. + BUFFER is the buffer (or buffer-name) to associate with the server + process. Client processes will not get a buffer if a process filter + is specified or BUFFER is nil; otherwise, a new buffer is created for + the client process. The name is similar to the process name. + Third arg SERVICE is name of the service desired, or an integer + specifying a port number to connect to. It may also be t to selected + an unused port number for the server. + Optional args, SENTINEL and FILTER specifies the sentinel and filter + functions to be used for the client processes; the server process + does not use these function." + (if (make-network-process :feature :server t) + (make-network-process :name name :buffer buffer + :service service :server t :noquery t))) + + )) ;; (fboundp 'make-network-process) + + + ;; compatibility + + (defun process-kill-without-query (process &optional flag) + "Say no query needed if PROCESS is running when Emacs is exited. + Optional second argument if non-nil says to require a query. + Value is t if a query was formerly required. + New code should not use this function; use `process-query-on-exit-flag' + or `set-process-query-on-exit-flag' instead." + (let ((old (process-query-on-exit-flag process))) + (set-process-query-on-exit-flag process nil) + old)) ;;; Misc Index: lisp/files.el =================================================================== RCS file: /cvs/emacs/lisp/files.el,v retrieving revision 1.552 diff -c -r1.552 files.el *** lisp/files.el 6 Mar 2002 18:19:43 -0000 1.552 --- lisp/files.el 13 Mar 2002 23:14:04 -0000 *************** *** 3808,3821 **** (let ((processes (process-list)) active) (while processes ! (and (memq (process-status (car processes)) '(run stop open)) ! (let ((val (process-kill-without-query (car processes)))) ! (process-kill-without-query (car processes) val) ! val) (setq active t)) (setq processes (cdr processes))) (or (not active) ! (list-processes) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) ;; Query the user for other things, perhaps. (run-hook-with-args-until-failure 'kill-emacs-query-functions) --- 3808,3819 ---- (let ((processes (process-list)) active) (while processes ! (and (memq (process-status (car processes)) '(run stop open listen)) ! (process-query-on-exit-flag (car processes)) (setq active t)) (setq processes (cdr processes))) (or (not active) ! (list-processes t) (yes-or-no-p "Active processes exist; kill them and exit anyway? ")))) ;; Query the user for other things, perhaps. (run-hook-with-args-until-failure 'kill-emacs-query-functions) Index: lisp/shadowfile.el =================================================================== RCS file: /cvs/emacs/lisp/shadowfile.el,v retrieving revision 1.17 diff -c -r1.17 shadowfile.el *** lisp/shadowfile.el 16 Jul 2001 12:22:59 -0000 1.17 --- lisp/shadowfile.el 13 Mar 2002 23:14:05 -0000 *************** *** 775,784 **** (let ((processes (process-list)) active) (while processes ! (and (memq (process-status (car processes)) '(run stop open)) ! (let ((val (process-kill-without-query (car processes)))) ! (process-kill-without-query (car processes) val) ! val) (setq active t)) (setq processes (cdr processes))) (or (not active) --- 775,782 ---- (let ((processes (process-list)) active) (while processes ! (and (memq (process-status (car processes)) '(run stop open listen)) ! (process-query-on-exit-flag (car processes)) (setq active t)) (setq processes (cdr processes))) (or (not active) -- Kim F. Storm http://www.cua.dk _______________________________________________ Emacs-devel mailing list Emacs-devel@gnu.org http://mail.gnu.org/mailman/listinfo/emacs-devel