X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/c88164fe6b832249d756929837acf949de6f8a8c..e0f712ba55fa0d073f6ab93606e428f61fc7caf2:/src/process.c diff --git a/src/process.c b/src/process.c index 20edc9d85a..a62b13c3f3 100644 --- a/src/process.c +++ b/src/process.c @@ -1,6 +1,6 @@ /* Asynchronous subprocess control for GNU Emacs. - Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999, + 2001, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -57,6 +57,17 @@ Boston, MA 02111-1307, USA. */ #ifdef NEED_NET_ERRNO_H #include #endif /* NEED_NET_ERRNO_H */ + +/* Are local (unix) sockets supported? */ +#if defined (HAVE_SYS_UN_H) && !defined (NO_SOCKETS_IN_FILE_SYSTEM) +#if !defined (AF_LOCAL) && defined (AF_UNIX) +#define AF_LOCAL AF_UNIX +#endif +#ifdef AF_LOCAL +#define HAVE_LOCAL_SOCKETS +#include +#endif +#endif #endif /* HAVE_SOCKETS */ /* TERM is a poor-man's SLIP, used on GNU/Linux. */ @@ -111,20 +122,35 @@ Boston, MA 02111-1307, USA. */ #include "composite.h" #include "atimer.h" -#define max(a, b) ((a) > (b) ? (a) : (b)) - Lisp_Object Qprocessp; -Lisp_Object Qrun, Qstop, Qsignal, Qopen, Qclosed; +Lisp_Object Qrun, Qstop, Qsignal; +Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten; +Lisp_Object Qlocal, Qdatagram; +Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype; +Lisp_Object QClocal, QCremote, QCcoding; +Lisp_Object QCserver, QCnowait, QCnoquery, QCstop; +Lisp_Object QCsentinel, QClog, QCoptions; Lisp_Object Qlast_nonmenu_event; +/* QCfamily is declared and initialized in xfaces.c, + QCfilter in keyboard.c. */ +extern Lisp_Object QCfamily, QCfilter; + /* Qexit is declared and initialized in eval.c. */ +/* QCfamily is defined in xfaces.c. */ +extern Lisp_Object QCfamily; +/* QCfilter is defined in keyboard.c. */ +extern Lisp_Object QCfilter; + /* a process object is a network connection when its childp field is neither Qt nor Qnil but is instead a cons cell (HOSTNAME PORTNUM). */ #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. */ @@ -175,6 +201,51 @@ int process_tick; /* Number of events for which the user or sentinel has been notified. */ int update_tick; +/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */ + +#ifdef BROKEN_NON_BLOCKING_CONNECT +#undef NON_BLOCKING_CONNECT +#else +#ifndef NON_BLOCKING_CONNECT +#ifdef HAVE_SOCKETS +#ifdef HAVE_SELECT +#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX) +#if defined (O_NONBLOCK) || defined (O_NDELAY) +#if defined (EWOULDBLOCK) || defined (EINPROGRESS) +#define NON_BLOCKING_CONNECT +#endif /* EWOULDBLOCK || EINPROGRESS */ +#endif /* O_NONBLOCK || O_NDELAY */ +#endif /* HAVE_GETPEERNAME || GNU_LINUX */ +#endif /* HAVE_SELECT */ +#endif /* HAVE_SOCKETS */ +#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 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 *)); @@ -197,6 +268,15 @@ static SELECT_TYPE non_keyboard_wait_mask; static SELECT_TYPE non_process_wait_mask; +/* Mask of bits indicating the descriptors that we wait for connect to + complete on. Once they complete, they are removed from this mask + and added to the input_wait_mask and non_keyboard_wait_mask. */ + +static SELECT_TYPE connect_wait_mask; + +/* Number of bits set in connect_wait_mask. */ +static int num_pending_connects; + /* The largest descriptor currently in use for a process object. */ static int max_process_desc; @@ -225,7 +305,21 @@ int proc_buffered_char[MAXDESC]; 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) (PROCESSP (proc) && datagram_address[XINT (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 (); extern EMACS_TIME timer_check (); extern int timers_run; @@ -334,8 +428,15 @@ status_message (status) 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)); + 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)); @@ -481,28 +582,28 @@ remove_process (proc) } DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0, - "Return t if OBJECT is a process.") - (object) + doc: /* Return t if OBJECT is a process. */) + (object) Lisp_Object object; { return PROCESSP (object) ? Qt : Qnil; } DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0, - "Return the process named NAME, or nil if there is none.") - (name) + doc: /* Return the process named NAME, or nil if there is none. */) + (name) register Lisp_Object name; { if (PROCESSP (name)) return name; - CHECK_STRING (name, 0); + CHECK_STRING (name); return Fcdr (Fassoc (name, Vprocess_alist)); } DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - "Return the (or a) process associated with BUFFER.\n\ -BUFFER may be a buffer or the name of one.") - (buffer) + doc: /* Return the (or a) process associated with BUFFER. +BUFFER may be a buffer or the name of one. */) + (buffer) register Lisp_Object buffer; { register Lisp_Object buf, tail, proc; @@ -553,17 +654,17 @@ get_process (name) } else { - CHECK_PROCESS (obj, 0); + CHECK_PROCESS (obj); proc = obj; } return proc; } DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0, - "Delete PROCESS: kill it and forget about it immediately.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.") - (process) + doc: /* Delete PROCESS: kill it and forget about it immediately. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. */) + (process) register Lisp_Object process; { process = get_process (process); @@ -588,18 +689,21 @@ nil, indicating the current buffer's process.") } DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0, - "Return the status of PROCESS.\n\ -The returned value is one of the following symbols:\n\ -run -- for a process that is running.\n\ -stop -- for a process stopped but continuable.\n\ -exit -- for a process that has exited.\n\ -signal -- for a process that has got a fatal signal.\n\ -open -- for a network stream connection that is open.\n\ -closed -- for a network stream connection that is closed.\n\ -nil -- if arg is a process name and no such process exists.\n\ -PROCESS may be a process, a buffer, the name of a process, or\n\ -nil, indicating the current buffer's process.") - (process) + doc: /* Return the status of PROCESS. +The returned value is one of the following symbols: +run -- for a process that is running. +stop -- for a process stopped but continuable. +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. +nil -- if arg is a process name and no such process exists. +PROCESS may be a process, a buffer, the name of a process, or +nil, indicating the current buffer's process. */) + (process) register Lisp_Object process; { register struct Lisp_Process *p; @@ -619,24 +723,26 @@ nil, indicating the current buffer's process.") status = p->status; if (CONSP (status)) status = XCAR (status); - if (NETCONN_P (process)) + if (NETCONN1_P (p)) { - if (EQ (status, Qrun)) - status = Qopen; - else if (EQ (status, Qexit)) + if (EQ (status, Qexit)) status = Qclosed; + else if (EQ (p->command, Qt)) + status = Qstop; + else if (EQ (status, Qrun)) + status = Qopen; } return status; } DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status, 1, 1, 0, - "Return the exit status of PROCESS or the signal number that killed it.\n\ -If PROCESS has not yet exited or died, return 0.") - (process) + doc: /* Return the exit status of PROCESS or the signal number that killed it. +If PROCESS has not yet exited or died, return 0. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); if (!NILP (XPROCESS (process)->raw_status_low)) update_status (XPROCESS (process)); if (CONSP (XPROCESS (process)->status)) @@ -645,98 +751,103 @@ If PROCESS has not yet exited or died, return 0.") } DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0, - "Return the process id of PROCESS.\n\ -This is the pid of the Unix process which PROCESS uses or talks to.\n\ -For a network connection, this value is nil.") - (process) + doc: /* Return the process id of PROCESS. +This is the pid of the Unix process which PROCESS uses or talks to. +For a network connection, this value is nil. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->pid; } DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0, - "Return the name of PROCESS, as a string.\n\ -This is the name of the program invoked in PROCESS,\n\ -possibly modified to make it unique among process names.") - (process) + doc: /* Return the name of PROCESS, as a string. +This is the name of the program invoked in PROCESS, +possibly modified to make it unique among process names. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->name; } DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0, - "Return the command that was executed to start PROCESS.\n\ -This is a list of strings, the first string being the program executed\n\ -and the rest of the strings being the arguments given to it.\n\ -For a non-child channel, this is nil.") - (process) + doc: /* Return the command that was executed to start PROCESS. +This is a list of strings, the first string being the program executed +and the rest of the strings being the arguments given to it. +For a non-child channel, this is nil. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->command; } DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0, - "Return the name of the terminal PROCESS uses, or nil if none.\n\ -This is the terminal that the process itself reads and writes on,\n\ -not the name of the pty that Emacs uses to talk with that terminal.") - (process) + doc: /* Return the name of the terminal PROCESS uses, or nil if none. +This is the terminal that the process itself reads and writes on, +not the name of the pty that Emacs uses to talk with that terminal. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->tty_name; } DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer, - 2, 2, 0, - "Set buffer associated with PROCESS to BUFFER (a buffer, or nil).") - (process, buffer) + 2, 2, 0, + doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil). */) + (process, buffer) register Lisp_Object process, buffer; { - CHECK_PROCESS (process, 0); + struct Lisp_Process *p; + + CHECK_PROCESS (process); if (!NILP (buffer)) - CHECK_BUFFER (buffer, 1); - XPROCESS (process)->buffer = buffer; + CHECK_BUFFER (buffer); + p = XPROCESS (process); + p->buffer = buffer; + if (NETCONN1_P (p)) + p->childp = Fplist_put (p->childp, QCbuffer, buffer); return buffer; } DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer, - 1, 1, 0, - "Return the buffer PROCESS is associated with.\n\ -Output from PROCESS is inserted in this buffer unless PROCESS has a filter.") - (process) + 1, 1, 0, + doc: /* Return the buffer PROCESS is associated with. +Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->buffer; } DEFUN ("process-mark", Fprocess_mark, Sprocess_mark, - 1, 1, 0, - "Return the marker for the end of the last output from PROCESS.") - (process) + 1, 1, 0, + doc: /* Return the marker for the end of the last output from PROCESS. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->mark; } DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter, - 2, 2, 0, - "Give PROCESS the filter function FILTER; nil means no filter.\n\ -t means stop accepting output from the process.\n\ -When a process has a filter, each time it does output\n\ -the entire string of output is passed to the filter.\n\ -The filter gets two arguments: the process and the string of output.\n\ -If the process has a filter, its buffer is not used for output.") - (process, filter) + 2, 2, 0, + doc: /* Give PROCESS the filter function FILTER; nil means no filter. +t means stop accepting output from the process. +When a process has a filter, each time it does output +the entire string of output is passed to the filter. +The filter gets two arguments: the process and the string of output. +If the process has a filter, its buffer is not used for output. */) + (process, filter) register Lisp_Object process, filter; { struct Lisp_Process *p; - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); p = XPROCESS (process); /* Don't signal an error if the process' input file descriptor @@ -749,12 +860,13 @@ If the process has a filter, its buffer is not used for output.") if (XINT (p->infd) >= 0) { - if (EQ (filter, Qt)) + 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 (XPROCESS (process)->filter, Qt)) + 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); @@ -762,53 +874,55 @@ If the process has a filter, its buffer is not used for output.") } p->filter = filter; + if (NETCONN1_P (p)) + p->childp = Fplist_put (p->childp, QCfilter, filter); return filter; } DEFUN ("process-filter", Fprocess_filter, Sprocess_filter, - 1, 1, 0, - "Returns the filter function of PROCESS; nil if none.\n\ -See `set-process-filter' for more info on filter functions.") - (process) + 1, 1, 0, + doc: /* Returns the filter function of PROCESS; nil if none. +See `set-process-filter' for more info on filter functions. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->filter; } DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel, - 2, 2, 0, - "Give PROCESS the sentinel SENTINEL; nil for none.\n\ -The sentinel is called as a function when the process changes state.\n\ -It gets two arguments: the process, and a string describing the change.") - (process, sentinel) + 2, 2, 0, + doc: /* Give PROCESS the sentinel SENTINEL; nil for none. +The sentinel is called as a function when the process changes state. +It gets two arguments: the process, and a string describing the change. */) + (process, sentinel) register Lisp_Object process, sentinel; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); XPROCESS (process)->sentinel = sentinel; return sentinel; } DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel, - 1, 1, 0, - "Return the sentinel of PROCESS; nil if none.\n\ -See `set-process-sentinel' for more info on sentinels.") - (process) + 1, 1, 0, + doc: /* Return the sentinel of PROCESS; nil if none. +See `set-process-sentinel' for more info on sentinels. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->sentinel; } DEFUN ("set-process-window-size", Fset_process_window_size, - Sset_process_window_size, 3, 3, 0, - "Tell PROCESS that it has logical window size HEIGHT and WIDTH.") - (process, height, width) + Sset_process_window_size, 3, 3, 0, + doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */) + (process, height, width) register Lisp_Object process, height, width; { - CHECK_PROCESS (process, 0); - CHECK_NATNUM (height, 0); - CHECK_NATNUM (width, 0); + CHECK_PROCESS (process); + CHECK_NATNUM (height); + CHECK_NATNUM (width); if (XINT (XPROCESS (process)->infd) < 0 || set_window_size (XINT (XPROCESS (process)->infd), @@ -819,79 +933,111 @@ DEFUN ("set-process-window-size", Fset_process_window_size, } DEFUN ("set-process-inherit-coding-system-flag", - Fset_process_inherit_coding_system_flag, - Sset_process_inherit_coding_system_flag, 2, 2, 0, - "Determine whether buffer of PROCESS will inherit coding-system.\n\ -If the second argument FLAG is non-nil, then the variable\n\ -`buffer-file-coding-system' of the buffer associated with PROCESS\n\ -will be bound to the value of the coding system used to decode\n\ -the process output.\n\ -\n\ -This is useful when the coding system specified for the process buffer\n\ -leaves either the character code conversion or the end-of-line conversion\n\ -unspecified, or if the coding system used to decode the process output\n\ -is more appropriate for saving the process buffer.\n\ -\n\ -Binding the variable `inherit-process-coding-system' to non-nil before\n\ -starting the process is an alternative way of setting the inherit flag\n\ -for the process which will run.") - (process, flag) + Fset_process_inherit_coding_system_flag, + Sset_process_inherit_coding_system_flag, 2, 2, 0, + doc: /* Determine whether buffer of PROCESS will inherit coding-system. +If the second argument FLAG is non-nil, then the variable +`buffer-file-coding-system' of the buffer associated with PROCESS +will be bound to the value of the coding system used to decode +the process output. + +This is useful when the coding system specified for the process buffer +leaves either the character code conversion or the end-of-line conversion +unspecified, or if the coding system used to decode the process output +is more appropriate for saving the process buffer. + +Binding the variable `inherit-process-coding-system' to non-nil before +starting the process is an alternative way of setting the inherit flag +for the process which will run. */) + (process, flag) register Lisp_Object process, flag; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); XPROCESS (process)->inherit_coding_system_flag = flag; return flag; } DEFUN ("process-inherit-coding-system-flag", - Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, - 1, 1, 0, - "Return the value of inherit-coding-system flag for PROCESS.\n\ -If this flag is t, `buffer-file-coding-system' of the buffer\n\ -associated with PROCESS will inherit the coding system used to decode\n\ -the process output.") - (process) + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + doc: /* Return the value of inherit-coding-system flag for PROCESS. +If this flag is t, `buffer-file-coding-system' of the buffer +associated with PROCESS will inherit the coding system used to decode +the process output. */) + (process) register Lisp_Object process; { - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); return XPROCESS (process)->inherit_coding_system_flag; } -DEFUN ("process-kill-without-query", Fprocess_kill_without_query, - Sprocess_kill_without_query, 1, 2, 0, - "Say no query needed if PROCESS is running when Emacs is exited.\n\ -Optional second argument if non-nil says to require a query.\n\ -Value is t if a query was formerly required.") - (process, value) - register Lisp_Object process, value; +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; { - Lisp_Object tem; - - CHECK_PROCESS (process, 0); - tem = XPROCESS (process)->kill_without_query; - XPROCESS (process)->kill_without_query = Fnull (value); + CHECK_PROCESS (process); + XPROCESS (process)->kill_without_query = Fnull (flag); + return flag; +} - return Fnull (tem); +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, 1, 0, - "Return the contact info of PROCESS; t for a real child.\n\ -For a net connection, the value is a cons cell of the form (HOST SERVICE).") - (process) - register Lisp_Object process; + 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; { - CHECK_PROCESS (process, 0); - return XPROCESS (process)->childp; + 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 in the process. Perhaps add it. */ DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0, - "Return the connection type of PROCESS.\n\ -The value is nil for a pipe, t or `pty' for a pty, or `stream' for\n\ -a socket connection.") - (process) + doc: /* Return the connection type of PROCESS. +The value is nil for a pipe, t or `pty' for a pty, or `stream' for +a socket connection. */) + (process) Lisp_Object process; { return XPROCESS (process)->type; @@ -899,12 +1045,55 @@ a socket connection.") #endif Lisp_Object -list_processes_1 () +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[80]; + 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); @@ -913,9 +1102,25 @@ list_processes_1 () current_buffer->truncate_lines = Qt; - write_string ("\ -Proc Status Buffer Tty Command\n\ ----- ------ ------ --- -------\n", -1); + 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)) { @@ -925,9 +1130,11 @@ Proc Status Buffer Tty Command\n\ p = XPROCESS (proc); if (NILP (p->childp)) continue; + if (!NILP (query_only) && !NILP (p->kill_without_query)) + continue; Finsert (1, &p->name); - Findent_to (make_number (13), minspace); + Findent_to (i_status, minspace); if (!NILP (p->raw_status_low)) update_status (p); @@ -947,12 +1154,14 @@ Proc Status Buffer Tty Command\n\ #endif Fprinc (symbol, Qnil); } - else if (NETCONN_P (proc)) + else if (NETCONN1_P (p)) { - if (EQ (symbol, Qrun)) - write_string ("open", -1); - else if (EQ (symbol, Qexit)) + 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); } @@ -973,7 +1182,7 @@ Proc Status Buffer Tty Command\n\ if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)) remove_process (proc); - Findent_to (make_number (22), minspace); + Findent_to (i_buffer, minspace); if (NILP (p->buffer)) insert_string ("(none)"); else if (NILP (XBUFFER (p->buffer)->name)) @@ -981,19 +1190,39 @@ Proc Status Buffer Tty Command\n\ 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)"); + if (!NILP (i_tty)) + { + Findent_to (i_tty, minspace); + if (STRINGP (p->tty_name)) + Finsert (1, &p->tty_name); + } - Findent_to (make_number (49), minspace); + Findent_to (i_command, minspace); - if (NETCONN_P (proc)) + 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 (XINT (p->infd)) ? "datagram" : "stream"), + XSTRING (port)->data); + insert_string (tembuf); + } + else if (NETCONN1_P (p)) { - sprintf (tembuf, "(network stream connection to %s)\n", - XSTRING (XCAR (p->childp))->data); + /* 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 (XINT (p->infd)) ? "datagram" : "stream"), + XSTRING (host)->data); insert_string (tembuf); } else @@ -1014,20 +1243,23 @@ Proc Status Buffer Tty Command\n\ return Qnil; } -DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 0, "", - "Display a list of all processes.\n\ -Any process listed as exited or signaled is actually eliminated\n\ -after the listing is made.") - () +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, Qnil); + list_processes_1, query_only); return Qnil; } DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, - "Return a list of all processes.") - () + doc: /* Return a list of all processes. */) + () { return Fmapcar (Qcdr, Vprocess_alist); } @@ -1037,16 +1269,18 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0, static Lisp_Object start_process_unwind (); DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0, - "Start a program in a subprocess. Return the process object for it.\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer or (buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer.\n\ -Third arg is program file name. It is searched for in PATH.\n\ -Remaining arguments are strings to give program as arguments.") - (nargs, args) + doc: /* Start a program in a subprocess. Return the process object for it. +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 program file name. It is searched for in PATH. +Remaining arguments are strings to give program as arguments. + +usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) + (nargs, args) int nargs; register Lisp_Object *args; { @@ -1091,11 +1325,11 @@ Remaining arguments are strings to give program as arguments.") } name = args[0]; - CHECK_STRING (name, 0); + CHECK_STRING (name); program = args[2]; - CHECK_STRING (program, 2); + CHECK_STRING (program); proc = make_process (name); /* If an error occurs and we can't start the process, we want to @@ -1170,7 +1404,7 @@ Remaining arguments are strings to give program as arguments.") for (i = 3; i < nargs; i++) { tem = args[i]; - CHECK_STRING (tem, i); + CHECK_STRING (tem); len += STRING_BYTES (XSTRING (tem)) + 1; /* count the blank */ } new_argv = (unsigned char *) alloca (len); @@ -1178,7 +1412,7 @@ Remaining arguments are strings to give program as arguments.") for (i = 3; i < nargs; i++) { tem = args[i]; - CHECK_STRING (tem, i); + CHECK_STRING (tem); strcat (new_argv, " "); strcat (new_argv, XSTRING (tem)->data); } @@ -1196,7 +1430,7 @@ Remaining arguments are strings to give program as arguments.") tem = Qnil; GCPRO4 (name, program, buffer, current_dir); - openp (Vexec_path, program, EXEC_SUFFIXES, &tem, 1); + openp (Vexec_path, program, Vexec_suffixes, &tem, 1); UNGCPRO; if (NILP (tem)) report_file_error ("Searching for program", Fcons (program, Qnil)); @@ -1221,7 +1455,7 @@ Remaining arguments are strings to give program as arguments.") for (i = 3; i < nargs; i++) { tem = args[i]; - CHECK_STRING (tem, i); + CHECK_STRING (tem); if (STRING_MULTIBYTE (tem)) tem = (code_convert_string_norecord (tem, XPROCESS (proc)->encode_coding_system, 1)); @@ -1319,7 +1553,6 @@ create_process (process, new_argv, current_dir) #ifndef USE_CRT_DLL extern char **environ; #endif - Lisp_Object buffer = XPROCESS (process)->buffer; inchannel = outchannel = -1; @@ -1430,7 +1663,7 @@ create_process (process, new_argv, current_dir) #ifdef SIGCHLD sigaddset (&blocked, SIGCHLD); #endif -#ifdef HAVE_VFORK +#ifdef HAVE_WORKING_VFORK /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal', this sets the parent's signal handlers as well as the child's. So delay all interrupts whose handlers the child might munge, @@ -1440,7 +1673,7 @@ create_process (process, new_argv, current_dir) #ifdef AIX sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action ); #endif -#endif /* HAVE_VFORK */ +#endif /* HAVE_WORKING_VFORK */ sigprocmask (SIG_BLOCK, &blocked, &procmask); #else /* !POSIX_SIGNALS */ #ifdef SIGCHLD @@ -1698,14 +1931,14 @@ create_process (process, new_argv, current_dir) /* Restore the signal state whether vfork succeeded or not. (We will signal an error, below, if it failed.) */ #ifdef POSIX_SIGNALS -#ifdef HAVE_VFORK +#ifdef HAVE_WORKING_VFORK /* Restore the parent's signal handlers. */ sigaction (SIGINT, &sigint_action, 0); sigaction (SIGQUIT, &sigquit_action, 0); #ifdef AIX sigaction (SIGHUP, &sighup_action, 0); #endif -#endif /* HAVE_VFORK */ +#endif /* HAVE_WORKING_VFORK */ /* Stop blocking signals in the parent. */ sigprocmask (SIG_SETMASK, &procmask, 0); #else /* !POSIX_SIGNALS */ @@ -1734,114 +1967,878 @@ create_process (process, new_argv, current_dir) } #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 +/* 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 HAVE_LOCAL_SOCKETS + case AF_LOCAL: + { + struct sockaddr_un *sockun = (struct sockaddr_un *) sa; + for (i = 0; i < sizeof (sockun->sun_path); i++) + if (sockun->sun_path[i] == 0) + break; + return make_unibyte_string (sockun->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 HAVE_LOCAL_SOCKETS + 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 HAVE_LOCAL_SOCKETS + if (family == AF_LOCAL) + { + struct sockaddr_un *sockun = (struct sockaddr_un *) sa; + cp = XSTRING (address)->data; + for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++) + sockun->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 = XINT (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 = XINT (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 + + +static struct socket_options { + /* The name of this option. Should be lowercase version of option + name without SO_ prefix. */ + char *name; + /* Length of name. */ + int nlen; + /* Option level SOL_... */ + int optlevel; + /* Option number SO_... */ + int optnum; + enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_STR, SOPT_LINGER } opttype; +} socket_options[] = + { +#ifdef SO_BINDTODEVICE + { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR }, +#endif +#ifdef SO_BROADCAST + { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL }, +#endif +#ifdef SO_DONTROUTE + { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL }, +#endif +#ifdef SO_KEEPALIVE + { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL }, +#endif +#ifdef SO_LINGER + { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER }, +#endif +#ifdef SO_OOBINLINE + { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL }, +#endif +#ifdef SO_PRIORITY + { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT }, +#endif +#ifdef SO_REUSEADDR + { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL }, +#endif + { 0, 0, 0, 0, SOPT_UNKNOWN } + }; + +/* Process list of socket options OPTS on socket S. + Only check if options are supported is S < 0. + If NO_ERROR is non-zero, continue silently if an option + cannot be set. + + Each element specifies one option. An element is either a string + "OPTION=VALUE" or a cons (OPTION . VALUE) where OPTION is a string + or a symbol. */ + +static int +set_socket_options (s, opts, no_error) + int s; + Lisp_Object opts; + int no_error; +{ + if (!CONSP (opts)) + opts = Fcons (opts, Qnil); + + while (CONSP (opts)) + { + Lisp_Object opt; + Lisp_Object val; + char *name, *arg; + struct socket_options *sopt; + int ret = 0; + + opt = XCAR (opts); + opts = XCDR (opts); + + name = 0; + val = Qt; + if (CONSP (opt)) + { + val = XCDR (opt); + opt = XCAR (opt); + } + if (STRINGP (opt)) + name = (char *) XSTRING (opt)->data; + else if (SYMBOLP (opt)) + name = (char *) XSYMBOL (opt)->name->data; + else { + error ("Mal-formed option list"); + return 0; + } + + if (strncmp (name, "no", 2) == 0) + { + val = Qnil; + name += 2; + } + + arg = 0; + for (sopt = socket_options; sopt->name; sopt++) + if (strncmp (name, sopt->name, sopt->nlen) == 0) + { + if (name[sopt->nlen] == 0) + break; + if (name[sopt->nlen] == '=') + { + arg = name + sopt->nlen + 1; + break; + } + } + + switch (sopt->opttype) + { + case SOPT_BOOL: + { + int optval; + if (s < 0) + return 1; + if (arg) + optval = (*arg == '0' || *arg == 'n') ? 0 : 1; + else if (INTEGERP (val)) + optval = XINT (val) == 0 ? 0 : 1; + else + optval = NILP (val) ? 0 : 1; + ret = setsockopt (s, sopt->optlevel, sopt->optnum, + &optval, sizeof (optval)); + break; + } + + case SOPT_INT: + { + int optval; + if (arg) + optval = atoi(arg); + else if (INTEGERP (val)) + optval = XINT (val); + else + error ("Bad option argument for %s", name); + if (s < 0) + return 1; + ret = setsockopt (s, sopt->optlevel, sopt->optnum, + &optval, sizeof (optval)); + break; + } + + case SOPT_STR: + { + if (!arg) + { + if (NILP (val)) + arg = ""; + else if (STRINGP (val)) + arg = (char *) XSTRING (val)->data; + else if (XSYMBOL (val)) + arg = (char *) XSYMBOL (val)->name->data; + else + error ("Invalid argument to %s option", name); + } + ret = setsockopt (s, sopt->optlevel, sopt->optnum, + arg, strlen (arg)); + } + +#ifdef SO_LINGER + case SOPT_LINGER: + { + struct linger linger; + + linger.l_onoff = 1; + linger.l_linger = 0; + + if (s < 0) + return 1; + + if (arg) + { + if (*arg == 'n' || *arg == 't' || *arg == 'y') + linger.l_onoff = (*arg == 'n') ? 0 : 1; + else + linger.l_linger = atoi(arg); + } + else if (INTEGERP (val)) + linger.l_linger = XINT (val); + else + linger.l_onoff = NILP (val) ? 0 : 1; + ret = setsockopt (s, sopt->optlevel, sopt->optnum, + &linger, sizeof (linger)); + break; + } +#endif + default: + if (s < 0) + return 0; + if (no_error) + continue; + error ("Unsupported option: %s", name); + } + if (ret < 0 && ! no_error) + report_file_error ("Cannot set network option: %s", opt); + } + return 1; +} + +DEFUN ("set-network-process-options", + Fset_network_process_options, Sset_network_process_options, + 1, MANY, 0, + doc: /* Set one or more options for network process PROCESS. +Each option is either a string "OPT=VALUE" or a cons (OPT . VALUE). +A boolean value is false if it either zero or nil, true otherwise. + +The following options are known. Consult the relevant system manual +pages for more information. + +bindtodevice=NAME -- bind to interface NAME, or remove binding if nil. +broadcast=BOOL -- Allow send and receive of datagram broadcasts. +dontroute=BOOL -- Only send to directly connected hosts. +keepalive=BOOL -- Send keep-alive messages on network stream. +linger=BOOL or TIMEOUT -- Send queued messages before closing. +oobinline=BOOL -- Place out-of-band data in receive data stream. +priority=INT -- Set protocol defined priority for sent packets. +reuseaddr=BOOL -- Allow reusing a recently used address. + +usage: (set-network-process-options PROCESS &rest OPTIONS) */) + (nargs, args) + int nargs; + Lisp_Object *args; +{ + Lisp_Object process; + Lisp_Object opts; + + process = args[0]; + CHECK_PROCESS (process); + if (nargs > 1 && XINT (XPROCESS (process)->infd) >= 0) + { + opts = Flist (nargs, args); + set_socket_options (XINT (XPROCESS (process)->infd), opts, 0); + } + return process; +} + +/* 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 - deactivate and close it via delete-process */ - -DEFUN ("open-network-stream", Fopen_network_stream, Sopen_network_stream, - 4, 4, 0, - "Open a TCP connection for a service to a host.\n\ -Returns a subprocess-object to represent the connection.\n\ -Input and output work as for subprocesses; `delete-process' closes it.\n\ -Args are NAME BUFFER HOST SERVICE.\n\ -NAME is name for process. It is modified if necessary to make it unique.\n\ -BUFFER is the buffer (or buffer-name) to associate with the process.\n\ - Process output goes at end of that buffer, unless you specify\n\ - an output stream or filter function to handle the output.\n\ - BUFFER may be also nil, meaning that this process is not associated\n\ - with any buffer\n\ -Third arg is name of the host to connect to, or its IP address.\n\ -Fourth arg SERVICE is name of the service desired, or an integer\n\ - specifying a port number to connect to.") - (name, buffer, host, service) - Lisp_Object name, buffer, host, service; + 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. + +In Emacs, network connections are represented by process objects, so +input and output work as for subprocesses and `delete-process' closes +a network connection. However, a network process has no process id, +it cannot be signalled, and the status codes are different from normal +processes. + +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. The symbol `local' specifies the local host. If specified +for a server process, it must be a valid name or address for the local +host, and only clients connecting to that address will be accepted. + +: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. + +:type TYPE -- TYPE is the type of connection. The default (nil) is a +stream type connection, `datagram' creates a datagram type connection. + +: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. + +: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 FAMILY, HOST and SERVICE args are ignored. + +:remote ADDRESS -- ADDRESS is the remote partner's address for the +connection. This parameter is ignored when opening a stream server +process. For a datagram server process, it specifies the initial +setting of the remote datagram address. When specified for a client +process, the FAMILY, HOST, and SERVICE args are ignored. + +The format of ADDRESS depends on the address family: +- An IPv4 address is represented as an vector of integers [A B C D P] +corresponding to numeric IP address A.B.C.D and port number P. +- A local address is represented as a string with the address in the +local address space. +- An "unsupported family" address is represented by a cons (F . AV) +where F is the family number and AV is a vector containing the socket +address data with one element per address data byte. Do not rely on +this format in portable code, as it may depend on implementation +defined constants, data sizes, and data structure alignment. + +:coding CODING -- CODING is coding system for this process. + +:options OPTIONS -- Set the specified options for the network process. +See `set-network-process-options' for details. + +: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. + +usage: (make-network-process &rest ARGS) */) + (nargs, args) + int nargs; + Lisp_Object *args; { Lisp_Object proc; + Lisp_Object contact; + struct Lisp_Process *p; #ifdef HAVE_GETADDRINFO - struct addrinfo hints, *res, *lres; - int ret = 0; - int xerrno = 0; - char *portstring, portbuf[128]; + struct addrinfo ai, *res, *lres; + struct addrinfo hints; + 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; + int ai_socktype; + int ai_protocol; + int ai_addrlen; + struct sockaddr *ai_addr; + struct _emacs_addrinfo *ai_next; + } ai, *res, *lres; #endif /* HAVE_GETADDRINFO */ + struct sockaddr_in address_in; +#ifdef HAVE_LOCAL_SOCKETS + struct sockaddr_un address_un; +#endif + int port; + int ret = 0; + int xerrno = 0; int s = -1, outch, inch; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; + 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; + int family = -1; + + if (nargs == 0) + return 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 - GCPRO4 (name, buffer, host, service); - CHECK_STRING (name, 0); - CHECK_STRING (host, 0); + /* :type TYPE (nil: stream, datagram */ + tem = Fplist_get (contact, QCtype); + if (NILP (tem)) + socktype = SOCK_STREAM; +#ifdef DATAGRAM_SOCKETS + else if (EQ (tem, Qdatagram)) + socktype = SOCK_DGRAM; +#endif + else + error ("Unsupported connection type"); -#ifdef HAVE_GETADDRINFO - /* SERVICE can either be a string or int. - Convert to a C string for later use by getaddrinfo. */ - if (INTEGERP (service)) + /* :server BOOL */ + tem = Fplist_get (contact, QCserver); + if (!NILP (tem)) { - sprintf (portbuf, "%ld", (long) XINT (service)); - portstring = portbuf; +#ifdef TERM + error ("Network servers not supported"); +#else + is_server = 1; +#endif } - else + + /* 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))) { - CHECK_STRING (service, 0); - portstring = XSTRING (service)->data; +#ifndef NON_BLOCKING_CONNECT + error ("Non-blocking connect not supported"); +#else + is_non_blocking_client = 1; +#endif } -#else /* HAVE_GETADDRINFO */ + + 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 { - CHECK_STRING (service, 0); + 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); + error ("Unknown service: %s", XSTRING (service)->data); port = svc_info->s_port; } -#endif /* HAVE_GETADDRINFO */ + 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 HAVE_LOCAL_SOCKETS + 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 HAVE_LOCAL_SOCKETS + 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 - record_unwind_protect (unwind_stop_other_atimers, Qnil); - bind_polling_period (10); + if (socktype == SOCK_STREAM) + { + 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) + /* 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 (contact, 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)); + error ("%s/%s %s", XSTRING (host)->data, portstring, gai_strerror(ret)); #else - error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, - ret); + error ("%s/%s getaddrinfo error %d", XSTRING (host)->data, portstring, ret); #endif - immediate_quit = 0; + 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; @@ -1856,20 +2853,68 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ continue; } - /* 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 (); +#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); +#else + ret = fcntl (s, F_SETFL, O_NDELAY); +#endif + if (ret < 0) + { + xerrno = errno; + emacs_close (s); + s = -1; + continue; + } + } +#endif + /* Make us close S if quit. */ - count1 = specpdl_ptr - specpdl; record_unwind_protect (close_file_unwind, make_number (s)); - loop: + if (is_server) + { + /* Configure as a server socket. */ +#ifdef HAVE_LOCAL_SOCKETS + 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; @@ -1880,175 +2925,120 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ set. It'd be nice to be able to control the connect timeout - though. Would non-blocking connect calls be portable? */ - turn_on_atimers (0); - ret = connect (s, lres->ai_addr, lres->ai_addrlen); - xerrno = errno; - turn_on_atimers (1); - - if (ret == 0 || xerrno == EISCONN) - /* The unwind-protect will be discarded afterwards. - Likewise for immediate_quit. */ - break; + though. Would non-blocking connect calls be portable? - immediate_quit = 0; + This used to be conditioned by HAVE_GETADDRINFO. Why? */ - if (xerrno == EINTR) - goto loop; - if (xerrno == EADDRINUSE && retry < 20) - { - /* A delay here is needed on some FreeBSD systems, - and it is harmless, since this retrying takes time anyway - 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; - } - - freeaddrinfo (res); - if (s < 0) - { - if (interrupt_input) - request_sigio (); - - errno = xerrno; - report_file_error ("connection failed", - Fcons (host, Fcons (name, Qnil))); - } - -#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; - - s = socket (host_info_ptr->h_addrtype, SOCK_STREAM, 0); - if (s < 0) - report_file_error ("error creating socket", Fcons (name, Qnil)); - - count1 = specpdl_ptr - specpdl; - record_unwind_protect (close_file_unwind, make_number (s)); + turn_on_atimers (0); - /* 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 (); + ret = connect (s, lres->ai_addr, lres->ai_addrlen); + xerrno = errno; - loop: + turn_on_atimers (1); - immediate_quit = 1; - QUIT; + if (ret == 0 || xerrno == EISCONN) + { + /* The unwind-protect will be discarded afterwards. + Likewise for immediate_quit. */ + break; + } - if (connect (s, (struct sockaddr *) &address, sizeof address) == -1 - && errno != EISCONN) - { - int xerrno = errno; +#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 +#endif immediate_quit = 0; - if (errno == EINTR) - goto loop; - if (errno == EADDRINUSE && retry < 20) + if (xerrno == EINTR) + goto retry_connect; + if (xerrno == EADDRINUSE && retry < 20) { /* A delay here is needed on some FreeBSD systems, and it is harmless, since this retrying takes time anyway and should be infrequent. */ Fsleep_for (make_number (1), Qnil); retry++; - goto loop; + goto retry_connect; } - /* Discard the unwind protect. */ + /* Discard the unwind protect closing S. */ specpdl_ptr = specpdl + count1; - emacs_close (s); + s = -1; + } - if (interrupt_input) - request_sigio (); - - errno = xerrno; - report_file_error ("connection failed", - Fcons (host, Fcons (name, Qnil))); + 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) + { + Lisp_Object remote; + bzero (datagram_address[s].sa, lres->ai_addrlen); + if (remote = Fplist_get (contact, QCremote), !NILP (remote)) + { + int rfamily, rlen; + rlen = get_lisp_to_sockaddr_size (remote, &rfamily); + if (rfamily == lres->ai_family && rlen == lres->ai_addrlen) + conv_lisp_to_sockaddr (rfamily, remote, + datagram_address[s].sa, rlen); + } + } + 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)); } - -#endif /* not HAVE_GETADDRINFO */ + +#ifdef HAVE_GETADDRINFO + if (res != &ai) + freeaddrinfo (res); +#endif immediate_quit = 0; - /* Discard the unwind protect, if any. */ + /* Discard the unwind protect for closing S, if any. */ specpdl_ptr = specpdl + count1; -#ifdef POLL_FOR_INPUT + /* Unwind bind_polling_period and request_sigio. */ 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 */ + { + /* 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); + } + + tem = Fplist_get (contact, QCoptions); + if (!NILP (tem)) + set_socket_options (s, tem, 1); + +#endif /* not TERM */ inch = s; outch = s; @@ -2067,21 +3057,54 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ #endif #endif - XPROCESS (proc)->childp = Fcons (host, Fcons (service, Qnil)); - XPROCESS (proc)->command_channel_p = Qnil; - XPROCESS (proc)->buffer = buffer; - XPROCESS (proc)->sentinel = Qnil; - XPROCESS (proc)->filter = Qnil; - XPROCESS (proc)->command = Qnil; - XPROCESS (proc)->pid = Qnil; - XSETINT (XPROCESS (proc)->infd, inch); - XSETINT (XPROCESS (proc)->outfd, outch); - XPROCESS (proc)->status = Qrun; - FD_SET (inch, &input_wait_mask); - FD_SET (inch, &non_keyboard_wait_mask); + 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); + num_pending_connects++; + } + } + 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); + } + if (inch > max_process_desc) max_process_desc = inch; + tem = Fplist_member (contact, QCcoding); + if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) + tem = Qnil; /* No error message (too late!). */ + { /* Setup coding systems for communicating with the network stream. */ struct gcpro gcpro1; @@ -2089,7 +3112,9 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ Lisp_Object coding_systems = Qt; Lisp_Object args[5], val; - if (!NILP (Vcoding_system_for_read)) + if (!NILP (tem)) + val = XCAR (XCDR (tem)); + else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) @@ -2112,9 +3137,11 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ else val = Qnil; } - XPROCESS (proc)->decode_coding_system = val; + p->decode_coding_system = val; - if (!NILP (Vcoding_system_for_write)) + if (!NILP (tem)) + val = XCAR (XCDR (tem)); + else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; else if (NILP (current_buffer->enable_multibyte_characters)) val = Qnil; @@ -2135,27 +3162,27 @@ Fourth arg SERVICE is name of the service desired, or an integer\n\ else val = Qnil; } - XPROCESS (proc)->encode_coding_system = val; + 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 (XPROCESS (proc)->decode_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 (XPROCESS (proc)->encode_coding_system, + setup_coding_system (p->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); + 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); - XPROCESS (proc)->inherit_coding_system_flag - = (NILP (buffer) || !inherit_process_coding_system + p->inherit_coding_system_flag + = (!NILP (tem) || NILP (buffer) || !inherit_process_coding_system ? Qnil : Qt); UNGCPRO; @@ -2193,9 +3220,23 @@ deactivate_process (proc) 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); + if (FD_ISSET (inchannel, &connect_wait_mask)) + { + FD_CLR (inchannel, &connect_wait_mask); + if (--num_pending_connects < 0) + abort (); + } if (inchannel == max_process_desc) { int i; @@ -2236,27 +3277,27 @@ close_process_descs () } DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output, - 0, 3, 0, - "Allow any pending output from subprocesses to be read by Emacs.\n\ -It is read into the process' buffers or given to their filter functions.\n\ -Non-nil arg PROCESS means do not return until some output has been received\n\ -from PROCESS.\n\ -Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of\n\ -seconds and microseconds to wait; return after that much time whether\n\ -or not there is input.\n\ -Return non-nil iff we received any output before the timeout expired.") - (process, timeout, timeout_msecs) + 0, 3, 0, + doc: /* Allow any pending output from subprocesses to be read by Emacs. +It is read into the process' buffers or given to their filter functions. +Non-nil arg PROCESS means do not return until some output has been received +from PROCESS. +Non-nil second arg TIMEOUT and third arg TIMEOUT-MSECS are number of +seconds and microseconds to wait; return after that much time whether +or not there is input. +Return non-nil iff we received any output before the timeout expired. */) + (process, timeout, timeout_msecs) register Lisp_Object process, timeout, timeout_msecs; { int seconds; int useconds; if (! NILP (process)) - CHECK_PROCESS (process, 0); + CHECK_PROCESS (process); if (! NILP (timeout_msecs)) { - CHECK_NUMBER (timeout_msecs, 2); + CHECK_NUMBER (timeout_msecs); useconds = XINT (timeout_msecs); if (!INTEGERP (timeout)) XSETINT (timeout, 0); @@ -2282,7 +3323,7 @@ Return non-nil iff we received any output before the timeout expired.") if (! NILP (timeout)) { - CHECK_NUMBER (timeout, 1); + CHECK_NUMBER (timeout); seconds = XINT (timeout); if (seconds < 0 || (seconds == 0 && useconds == 0)) seconds = -1; @@ -2303,6 +3344,202 @@ Return non-nil iff we received any output before the timeout expired.") ? 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 HAVE_LOCAL_SOCKETS + 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 HAVE_LOCAL_SOCKETS + 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, QCserver, Qnil); + 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 (!NILP (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 @@ -2360,16 +3597,20 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) { register int channel, nfds; static SELECT_TYPE Available; + static SELECT_TYPE Connecting; + int check_connect, no_avail; int xerrno; Lisp_Object proc; EMACS_TIME timeout, end_time; - SELECT_TYPE Atemp; int wait_channel = -1; struct Lisp_Process *wait_proc = 0; int got_some_input = 0; - Lisp_Object *wait_for_cell = 0; + /* Either nil or a cons cell, the car of which is of interest and + may be changed outside of this routine. */ + Lisp_Object wait_for_cell = Qnil; FD_ZERO (&Available); + FD_ZERO (&Connecting); /* If read_kbd is a process to watch, set wait_proc and wait_channel accordingly. */ @@ -2383,7 +3624,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If waiting for non-nil in a cell, record where. */ if (CONSP (read_kbd)) { - wait_for_cell = &XCAR (read_kbd); + wait_for_cell = read_kbd; XSETFASTINT (read_kbd, 0); } @@ -2417,7 +3658,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) QUIT; /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; /* Compute time from now till when time limit is up */ @@ -2446,7 +3687,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) But not if wait_for_cell; in those cases, the wait is supposed to be short, and those callers cannot handle running arbitrary Lisp code here. */ - if (! wait_for_cell) + if (NILP (wait_for_cell)) { EMACS_TIME timer_delay; @@ -2511,11 +3752,23 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) timeout to get our attention. */ if (update_tick != process_tick && do_display) { + SELECT_TYPE Atemp, Ctemp; + Atemp = input_wait_mask; +#ifdef MAC_OSX + /* On Mac OS X, the SELECT system call always says input is + present (for reading) at stdin, even when none is. This + causes the the call to SELECT below to return 1 and + status_notify not to be called. As a result output of + subprocesses are incorrectly discarded. */ + FD_CLR (0, &Atemp); +#endif + Ctemp = connect_wait_mask; EMACS_SET_SECS_USECS (timeout, 0, 0); if ((select (max (max_process_desc, max_keyboard_desc) + 1, - &Atemp, (SELECT_TYPE *)0, (SELECT_TYPE *)0, - &timeout) + &Atemp, + (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), + (SELECT_TYPE *)0, &timeout) <= 0)) { /* It's okay for us to do this and then continue with @@ -2525,11 +3778,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } } - /* Don't wait for output from a non-running process. */ + /* Don't wait for output from a non-running process. Just + read whatever data has already been received. */ if (wait_proc != 0 && !NILP (wait_proc->raw_status_low)) update_status (wait_proc); if (wait_proc != 0 - && ! EQ (wait_proc->status, Qrun)) + && ! EQ (wait_proc->status, Qrun) + && ! EQ (wait_proc->status, Qconnect)) { int nread, total_nread = 0; @@ -2567,12 +3822,19 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Wait till there is something to do */ - if (wait_for_cell) - Available = non_process_wait_mask; - else if (! XINT (read_kbd)) - Available = non_keyboard_wait_mask; + if (!NILP (wait_for_cell)) + { + Available = non_process_wait_mask; + check_connect = 0; + } else - Available = input_wait_mask; + { + if (! XINT (read_kbd)) + Available = non_keyboard_wait_mask; + else + Available = input_wait_mask; + check_connect = (num_pending_connects > 0); + } /* If frame size has changed or the window is newly mapped, redisplay now, before we start to wait. There is a race @@ -2587,15 +3849,21 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) set_waiting_for_input (&timeout); } + no_avail = 0; if (XINT (read_kbd) && detect_input_pending ()) { nfds = 0; - FD_ZERO (&Available); + no_avail = 1; } else - nfds = select (max (max_process_desc, max_keyboard_desc) + 1, - &Available, (SELECT_TYPE *)0, (SELECT_TYPE *)0, - &timeout); + { + if (check_connect) + Connecting = connect_wait_mask; + nfds = select (max (max_process_desc, max_keyboard_desc) + 1, + &Available, + (check_connect ? &Connecting : (SELECT_TYPE *)0), + (SELECT_TYPE *)0, &timeout); + } xerrno = errno; @@ -2611,7 +3879,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) if (nfds < 0) { if (xerrno == EINTR) - FD_ZERO (&Available); + no_avail = 1; #ifdef ultrix /* Ultrix select seems to return ENOMEM when it is interrupted. Treat it just like EINTR. Bleah. Note @@ -2619,13 +3887,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) "__ultrix__"; the latter is only defined under GCC, but not by DEC's bundled CC. -JimB */ else if (xerrno == ENOMEM) - FD_ZERO (&Available); + no_avail = 1; #endif #ifdef ALLIANT /* This happens for no known reason on ALLIANT. I am guessing that this is the right response. -- RMS. */ else if (xerrno == EFAULT) - FD_ZERO (&Available); + no_avail = 1; #endif else if (xerrno == EBADF) { @@ -2637,7 +3905,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF in m/ibmrt-aix.h), and here we just ignore the select error. Cleanup occurs c/o status_notify after SIGCLD. */ - FD_ZERO (&Available); /* Cannot depend on values returned */ + no_avail = 1; /* Cannot depend on values returned */ #else abort (); #endif @@ -2645,9 +3913,16 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) else error ("select error: %s", emacs_strerror (xerrno)); } + + if (no_avail) + { + FD_ZERO (&Available); + check_connect = 0; + } + #if defined(sun) && !defined(USG5_4) - else if (nfds > 0 && keyboard_bit_set (&Available) - && interrupt_input) + if (nfds > 0 && keyboard_bit_set (&Available) + && interrupt_input) /* System sometimes fails to deliver SIGIO. David J. Mackenzie says that Emacs doesn't compile under @@ -2723,7 +3998,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; #ifdef SIGIO @@ -2742,10 +4017,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* If checking input just got us a size-change event from X, obey it now if we should. */ - if (XINT (read_kbd) || wait_for_cell) + if (XINT (read_kbd) || ! NILP (wait_for_cell)) do_pending_window_change (0); /* Check for data from a process. */ + if (no_avail || nfds == 0) + continue; + /* Really FIRST_PROC_DESC should be 0 on Unix, but this is safer in the short run. */ for (channel = 0; channel <= max_process_desc; channel++) @@ -2768,6 +4046,13 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) 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. */ @@ -2837,6 +4122,67 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) = Fcons (Qexit, Fcons (make_number (256), Qnil)); } } +#ifdef NON_BLOCKING_CONNECT + if (check_connect && FD_ISSET (channel, &Connecting)) + { + struct Lisp_Process *p; + + FD_CLR (channel, &connect_wait_mask); + if (--num_pending_connects < 0) + abort (); + + proc = chan_process[channel]; + if (NILP (proc)) + continue; + + p = XPROCESS (proc); + +#ifdef GNU_LINUX + /* 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; + } +#else + { + struct sockaddr pname; + int pnamelen = sizeof(pname); + + /* If connection failed, getpeername will fail. */ + xerrno = 0; + if (getpeername(channel, &pname, &pnamelen) < 0) + { + /* Obtain connect failure code through error slippage. */ + char dummy; + xerrno = errno; + if (errno == ENOTCONN && read(channel, &dummy, 1) < 0) + xerrno = errno; + } + } +#endif + if (xerrno) + { + XSETINT (p->tick, ++process_tick); + p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil)); + deactivate_process (proc); + } + else + { + p->status = Qrun; + /* Execute the sentinel here. If we had relied on + 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); + } + } + } +#endif /* NON_BLOCKING_CONNECT */ } /* end for each file descriptor */ } /* end while exit conditions not met */ @@ -2907,6 +4253,7 @@ read_process_output (proc, channel) 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(); @@ -2938,18 +4285,39 @@ read_process_output (proc, channel) bcopy (vs->inputBuffer, chars + carryover, nbytes); } #else /* not VMS */ - chars = (char *) alloca (carryover + 1024); + +#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, 1024 - carryover); + 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, 1023 - carryover); + nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1 - carryover); if (nbytes < 0) nbytes = 1; else @@ -3159,8 +4527,6 @@ read_process_output (proc, channel) /* Insert before markers in case we are inserting where the buffer's mark is, and the user's next command is Meta-y. */ insert_from_string_before_markers (text, 0, 0, nchars, nbytes, 0); - signal_after_change (before, 0, PT - before); - update_compositions (before, PT, CHECK_BORDER); /* Make sure the process marker's position is valid when the process buffer is changed in the signal_after_change above. @@ -3210,9 +4576,9 @@ read_process_output (proc, channel) DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p, Swaiting_for_user_input_p, 0, 0, 0, - "Returns non-nil if emacs is waiting for input from the user.\n\ -This is intended for use by asynchronous process output filters and sentinels.") - () + doc: /* Returns non-nil if emacs is waiting for input from the user. +This is intended for use by asynchronous process output filters and sentinels. */) + () { return (waiting_for_user_input_p ? Qt : Qnil); } @@ -3278,15 +4644,17 @@ send_process (proc, buf, len, object) && !NILP (XBUFFER (object)->enable_multibyte_characters)) || EQ (object, Qt)) { - coding->src_multibyte = 1; if (!EQ (coding->symbol, XPROCESS (proc)->encode_coding_system)) /* The coding system for encoding was changed to raw-text because we sent a unibyte text previously. Now we are sending a multibyte text, thus we must encode it by the original coding system specified for the current process. */ - setup_coding_system (XPROCESS (proc)->encode_coding_system, - coding); + setup_coding_system (XPROCESS (proc)->encode_coding_system, coding); + /* src_multibyte should be set to 1 _after_ a call to + setup_coding_system, since it resets src_multibyte to + zero. */ + coding->src_multibyte = 1; } else { @@ -3326,8 +4694,13 @@ send_process (proc, buf, len, object) to = string_byte_to_char (object, from_byte + len); } - if (from_byte >= 0 && coding->composing != COMPOSITION_DISABLED) - coding_save_composition (coding, from, to, object); + if (coding->composing != COMPOSITION_DISABLED) + { + if (from_byte >= 0) + coding_save_composition (coding, from, to, object); + else + coding->composing = COMPOSITION_DISABLED; + } if (STRING_BYTES (XSTRING (XPROCESS (proc)->encoding_buf)) < require) XPROCESS (proc)->encoding_buf = make_uninit_string (require); @@ -3383,8 +4756,8 @@ send_process (proc, buf, len, object) Long lines need to be split into multiple batches. */ if (!NILP (XPROCESS (proc)->pty_flag)) { - /* Starting this at zero is always correct when not the first iteration - because the previous iteration ended by sending C-d. + /* Starting this at zero is always correct when not the first + iteration because the previous iteration ended by sending C-d. It may not be correct for the first iteration if a partial line was sent in a separate send_process call. If that proves worth handling, we need to save linepos @@ -3410,9 +4783,20 @@ send_process (proc, buf, len, object) /* 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); - rv = emacs_write (XINT (XPROCESS (proc)->outfd), - (char *) buf, this); +#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) @@ -3518,15 +4902,15 @@ send_process (proc, buf, len, object) } DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region, - 3, 3, 0, - "Send current contents of region as input to PROCESS.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -Called from program, takes three arguments, PROCESS, START and END.\n\ -If the region is more than 500 characters long,\n\ -it is sent in several bunches. This may happen even for shorter regions.\n\ -Output from processes can arrive in between bunches.") - (process, start, end) + 3, 3, 0, + doc: /* Send current contents of region as input to PROCESS. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +Called from program, takes three arguments, PROCESS, START and END. +If the region is more than 500 characters long, +it is sent in several bunches. This may happen even for shorter regions. +Output from processes can arrive in between bunches. */) + (process, start, end) Lisp_Object process, start, end; { Lisp_Object proc; @@ -3547,18 +4931,18 @@ Output from processes can arrive in between bunches.") } DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string, - 2, 2, 0, - "Send PROCESS the contents of STRING as input.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -If STRING is more than 500 characters long,\n\ -it is sent in several bunches. This may happen even for shorter strings.\n\ -Output from processes can arrive in between bunches.") - (process, string) + 2, 2, 0, + doc: /* Send PROCESS the contents of STRING as input. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +If STRING is more than 500 characters long, +it is sent in several bunches. This may happen even for shorter strings. +Output from processes can arrive in between bunches. */) + (process, string) Lisp_Object process, string; { Lisp_Object proc; - CHECK_STRING (string, 1); + CHECK_STRING (string); proc = get_process (process); send_process (proc, XSTRING (string)->data, STRING_BYTES (XSTRING (string)), string); @@ -3567,10 +4951,10 @@ Output from processes can arrive in between bunches.") DEFUN ("process-running-child-p", Fprocess_running_child_p, Sprocess_running_child_p, 0, 1, 0, - "Return t if PROCESS has given the terminal to a child.\n\ -If the operating system does not make it possible to find out,\n\ -return t unconditionally.") - (process) + doc: /* Return t if PROCESS has given the terminal to a child. +If the operating system does not make it possible to find out, +return t unconditionally. */) + (process) Lisp_Object process; { /* Initialize in case ioctl doesn't exist or gives an error, @@ -3827,18 +5211,18 @@ process_send_signal (process, signo, current_group, nomsg) } DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0, - "Interrupt process PROCESS.\n\ -PROCESS may be a process, a buffer, or the name of a process or buffer.\n\ -nil or no arg means current buffer's process.\n\ -Second arg CURRENT-GROUP non-nil means send signal to\n\ -the current process-group of the process's controlling terminal\n\ -rather than to the process's own process group.\n\ -If the process is a shell, this means interrupt current subjob\n\ -rather than the shell.\n\ -\n\ -If CURRENT-GROUP is `lambda', and if the shell owns the terminal,\n\ -don't send the signal.") - (process, current_group) + doc: /* Interrupt process PROCESS. +PROCESS may be a process, a buffer, or the name of a process or buffer. +nil or no arg means current buffer's process. +Second arg CURRENT-GROUP non-nil means send signal to +the current process-group of the process's controlling terminal +rather than to the process's own process group. +If the process is a shell, this means interrupt current subjob +rather than the shell. + +If CURRENT-GROUP is `lambda', and if the shell owns the terminal, +don't send the signal. */) + (process, current_group) Lisp_Object process, current_group; { process_send_signal (process, SIGINT, current_group, 0); @@ -3846,9 +5230,9 @@ don't send the signal.") } DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0, - "Kill process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Kill 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; { process_send_signal (process, SIGKILL, current_group, 0); @@ -3856,9 +5240,9 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0, - "Send QUIT signal to process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + doc: /* Send QUIT signal to 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; { process_send_signal (process, SIGQUIT, current_group, 0); @@ -3866,11 +5250,28 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0, - "Stop process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + 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 @@ -3880,11 +5281,29 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0, - "Continue process PROCESS. May be process or name of one.\n\ -See function `interrupt-process' for more details on usage.") - (process, current_group) + 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 @@ -3894,14 +5313,14 @@ See function `interrupt-process' for more details on usage.") } DEFUN ("signal-process", Fsignal_process, Ssignal_process, - 2, 2, "nProcess number: \nnSignal code: ", - "Send the process with process id PID the signal with code SIGCODE.\n\ -PID must be an integer. The process need not be a child of this Emacs.\n\ -SIGCODE may be an integer, or a symbol whose name is a signal name.") - (pid, sigcode) + 2, 2, "nProcess number: \nnSignal code: ", + doc: /* Send the process with process id PID the signal with code SIGCODE. +PID must be an integer. The process need not be a child of this Emacs. +SIGCODE may be an integer, or a symbol whose name is a signal name. */) + (pid, sigcode) Lisp_Object pid, sigcode; { - CHECK_NUMBER (pid, 0); + CHECK_NUMBER (pid); #define handle_signal(NAME, VALUE) \ else if (!strcmp (name, NAME)) \ @@ -3913,7 +5332,7 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.") { unsigned char *name; - CHECK_SYMBOL (sigcode, 1); + CHECK_SYMBOL (sigcode); name = XSYMBOL (sigcode)->name->data; if (0) @@ -4018,19 +5437,22 @@ SIGCODE may be an integer, or a symbol whose name is a signal name.") } DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0, - "Make PROCESS see end-of-file in its input.\n\ -EOF comes after any text already sent to it.\n\ -PROCESS may be a process, a buffer, the name of a process or buffer, or\n\ -nil, indicating the current buffer's process.\n\ -If PROCESS is a network connection, or is a process communicating\n\ -through a pipe (as opposed to a pty), then you cannot send any more\n\ -text to PROCESS after you call this function.") - (process) + doc: /* Make PROCESS see end-of-file in its input. +EOF comes after any text already sent to it. +PROCESS may be a process, a buffer, the name of a process or buffer, or +nil, indicating the current buffer's process. +If PROCESS is a network connection, or is a process communicating +through a pipe (as opposed to a pty), then you cannot send any more +text to PROCESS after you call this function. */) + (process) Lisp_Object process; { 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)]; @@ -4088,7 +5510,7 @@ text to PROCESS after you call this function.") } /* Kill all processes associated with `buffer'. - If `buffer' is nil, kill all processes */ + If `buffer' is nil, kill all processes */ void kill_buffer_processes (buffer) @@ -4110,26 +5532,27 @@ kill_buffer_processes (buffer) } } -/* On receipt of a signal that a child status has changed, - loop asking about children with changed statuses until - the system says there are no more. - All we do is change the status; - we do not run sentinels or print notifications. - That is saved for the next time keyboard input is done, - in order to avoid timing errors. */ - -/** WARNING: this can be called during garbage collection. - Therefore, it must not be fooled by the presence of mark bits in - Lisp objects. */ - -/** USG WARNING: Although it is not obvious from the documentation - in signal(2), on a USG system the SIGCLD handler MUST NOT call - signal() before executing at least one wait(), otherwise the handler - will be called again, resulting in an infinite loop. The relevant - portion of the documentation reads "SIGCLD signals will be queued - and the signal-catching function will be continually reentered until - the queue is empty". Invoking signal() causes the kernel to reexamine - the SIGCLD queue. Fred Fish, UniSoft Systems Inc. */ +/* On receipt of a signal that a child status has changed, loop asking + about children with changed statuses until the system says there + are no more. + + All we do is change the status; we do not run sentinels or print + notifications. That is saved for the next time keyboard input is + done, in order to avoid timing errors. + + ** WARNING: this can be called during garbage collection. + Therefore, it must not be fooled by the presence of mark bits in + Lisp objects. + + ** USG WARNING: Although it is not obvious from the documentation + in signal(2), on a USG system the SIGCLD handler MUST NOT call + signal() before executing at least one wait(), otherwise the + handler will be called again, resulting in an infinite loop. The + relevant portion of the documentation reads "SIGCLD signals will be + queued and the signal-catching function will be continually + reentered until the queue is empty". Invoking signal() causes the + kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems + Inc. */ SIGTYPE sigchld_handler (signo) @@ -4161,11 +5584,12 @@ sigchld_handler (signo) errno = 0; pid = wait3 (&w, WNOHANG | WUNTRACED, 0); } - while (pid <= 0 && errno == EINTR); + while (pid < 0 && errno == EINTR); if (pid <= 0) { - /* A real failure. We have done all our job, so return. */ + /* PID == 0 means no processes found, PID == -1 means a real + failure. We have done all our job, so return. */ /* USG systems forget handlers when they are used; must reestablish each time */ @@ -4186,11 +5610,11 @@ sigchld_handler (signo) /* Find the process that signaled us, and record its status. */ p = 0; - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (EQ (p->childp, Qt) && XFASTINT (p->pid) == pid) + if (GC_EQ (p->childp, Qt) && XINT (p->pid) == pid) break; p = 0; } @@ -4198,11 +5622,11 @@ sigchld_handler (signo) /* Look for an asynchronous process whose pid hasn't been filled in yet. */ if (p == 0) - for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = Vprocess_alist; GC_CONSP (tail); tail = XCDR (tail)) { proc = XCDR (XCAR (tail)); p = XPROCESS (proc); - if (INTEGERP (p->pid) && XINT (p->pid) == -1) + if (GC_INTEGERP (p->pid) && XINT (p->pid) == -1) break; p = 0; } @@ -4270,7 +5694,9 @@ sigchld_handler (signo) get another signal. Otherwise (on systems that have WNOHANG), loop around to use up all the processes that have something to tell us. */ -#if defined (USG) && ! (defined (HPUX) && defined (WNOHANG)) || defined (WINDOWSNT) +#if (defined WINDOWSNT \ + || (defined USG && !defined GNU_LINUX \ + && !(defined HPUX && defined WNOHANG))) #if defined (USG) && ! defined (POSIX_SIGNALS) signal (signo, sigchld_handler); #endif @@ -4375,7 +5801,8 @@ exec_sentinel (proc, reason) /* Report all recent events of a change in process status (either run the sentinel or output a message). - This is done while Emacs is waiting for keyboard input. */ + This is usually done while Emacs is waiting for keyboard input + but can be done at other times. */ void status_notify () @@ -4410,6 +5837,9 @@ status_notify () /* 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); @@ -4501,15 +5931,15 @@ status_notify () DEFUN ("set-process-coding-system", Fset_process_coding_system, Sset_process_coding_system, 1, 3, 0, - "Set coding systems of PROCESS to DECODING and ENCODING.\n\ -DECODING will be used to decode subprocess output and ENCODING to\n\ -encode subprocess input.") - (proc, decoding, encoding) + doc: /* Set coding systems of PROCESS to DECODING and ENCODING. +DECODING will be used to decode subprocess output and ENCODING to +encode subprocess input. */) + (proc, decoding, encoding) register Lisp_Object proc, decoding, encoding; { register struct Lisp_Process *p; - CHECK_PROCESS (proc, 0); + CHECK_PROCESS (proc); p = XPROCESS (proc); if (XINT (p->infd) < 0) error ("Input file descriptor of %s closed", XSTRING (p->name)->data); @@ -4528,11 +5958,11 @@ encode subprocess input.") DEFUN ("process-coding-system", Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0, - "Return a cons of coding systems for decoding and encoding of PROCESS.") - (proc) + doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */) + (proc) register Lisp_Object proc; { - CHECK_PROCESS (proc, 0); + CHECK_PROCESS (proc); return Fcons (XPROCESS (proc)->decode_coding_system, XPROCESS (proc)->encode_coding_system); } @@ -4620,6 +6050,58 @@ init_process () } 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 + +#ifdef HAVE_SOCKETS + { + Lisp_Object subfeatures = Qnil; +#define ADD_SUBFEATURE(key, val) \ + subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures) + +#ifdef NON_BLOCKING_CONNECT + ADD_SUBFEATURE (QCnowait, Qt); +#endif +#ifdef DATAGRAM_SOCKETS + ADD_SUBFEATURE (QCtype, Qdatagram); +#endif +#ifdef HAVE_LOCAL_SOCKETS + ADD_SUBFEATURE (QCfamily, Qlocal); +#endif +#ifdef HAVE_GETSOCKNAME + ADD_SUBFEATURE (QCservice, Qt); +#endif +#ifndef TERM + ADD_SUBFEATURE (QCserver, Qt); +#endif +#ifdef SO_BINDTODEVICE + ADD_SUBFEATURE (QCoptions, intern ("bindtodevice")); +#endif +#ifdef SO_BROADCAST + ADD_SUBFEATURE (QCoptions, intern ("broadcast")); +#endif +#ifdef SO_DONTROUTE + ADD_SUBFEATURE (QCoptions, intern ("dontroute")); +#endif +#ifdef SO_KEEPALIVE + ADD_SUBFEATURE (QCoptions, intern ("keepalive")); +#endif +#ifdef SO_LINGER + ADD_SUBFEATURE (QCoptions, intern ("linger")); +#endif +#ifdef SO_OOBINLINE + ADD_SUBFEATURE (QCoptions, intern ("oobinline")); +#endif +#ifdef SO_PRIORITY + ADD_SUBFEATURE (QCoptions, intern ("priority")); +#endif +#ifdef SO_REUSEADDR + ADD_SUBFEATURE (QCoptions, intern ("reuseaddr")); +#endif + Fprovide (intern ("make-network-process"), subfeatures); + } +#endif /* HAVE_SOCKETS */ } void @@ -4644,24 +6126,65 @@ syms_of_process () staticpro (&Qopen); Qclosed = intern ("closed"); staticpro (&Qclosed); - + Qconnect = intern ("connect"); + staticpro (&Qconnect); + Qfailed = intern ("failed"); + staticpro (&Qfailed); + Qlisten = intern ("listen"); + staticpro (&Qlisten); + Qlocal = intern ("local"); + staticpro (&Qlocal); + Qdatagram = intern ("datagram"); + staticpro (&Qdatagram); + + QCname = intern (":name"); + staticpro (&QCname); + QCbuffer = intern (":buffer"); + staticpro (&QCbuffer); + QChost = intern (":host"); + staticpro (&QChost); + QCservice = intern (":service"); + staticpro (&QCservice); + QCtype = intern (":type"); + staticpro (&QCtype); + QClocal = intern (":local"); + staticpro (&QClocal); + QCremote = intern (":remote"); + staticpro (&QCremote); + QCcoding = intern (":coding"); + staticpro (&QCcoding); + QCserver = intern (":server"); + staticpro (&QCserver); + QCnowait = intern (":nowait"); + staticpro (&QCnowait); + QCsentinel = intern (":sentinel"); + staticpro (&QCsentinel); + QClog = intern (":log"); + staticpro (&QClog); + QCnoquery = intern (":noquery"); + staticpro (&QCnoquery); + QCstop = intern (":stop"); + staticpro (&QCstop); + QCoptions = intern (":options"); + staticpro (&QCoptions); + Qlast_nonmenu_event = intern ("last-nonmenu-event"); staticpro (&Qlast_nonmenu_event); staticpro (&Vprocess_alist); DEFVAR_BOOL ("delete-exited-processes", &delete_exited_processes, - "*Non-nil means delete processes immediately when they exit.\n\ -nil means don't delete them until `list-processes' is run."); + doc: /* *Non-nil means delete processes immediately when they exit. +nil means don't delete them until `list-processes' is run. */); delete_exited_processes = 1; DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type, - "Control type of device used to communicate with subprocesses.\n\ -Values are nil to use a pipe, or t or `pty' to use a pty.\n\ -The value has no effect if the system has no ptys or if all ptys are busy:\n\ -then a pipe is used in any case.\n\ -The value takes effect when `start-process' is called."); + doc: /* Control type of device used to communicate with subprocesses. +Values are nil to use a pipe, or t or `pty' to use a pty. +The value has no effect if the system has no ptys or if all ptys are busy: +then a pipe is used in any case. +The value takes effect when `start-process' is called. */); Vprocess_connection_type = Qt; defsubr (&Sprocessp); @@ -4684,14 +6207,20 @@ The value takes effect when `start-process' is called."); defsubr (&Sset_process_window_size); defsubr (&Sset_process_inherit_coding_system_flag); defsubr (&Sprocess_inherit_coding_system_flag); - defsubr (&Sprocess_kill_without_query); + 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 (&Sopen_network_stream); + defsubr (&Sset_network_process_options); + 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); @@ -4727,6 +6256,8 @@ extern int frame_garbaged; extern EMACS_TIME timer_check (); extern int timers_run; +Lisp_Object QCtype; + /* As described above, except assuming that there are no subprocesses: Wait for timeout to elapse and/or keyboard input to be available. @@ -4761,12 +6292,14 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) EMACS_TIME end_time, timeout; SELECT_TYPE waitchannels; int xerrno; - Lisp_Object *wait_for_cell = 0; + /* Either nil or a cons cell, the car of which is of interest and + may be changed outside of this routine. */ + Lisp_Object wait_for_cell = Qnil; /* If waiting for non-nil in a cell, record where. */ if (CONSP (read_kbd)) { - wait_for_cell = &XCAR (read_kbd); + wait_for_cell = read_kbd; XSETFASTINT (read_kbd, 0); } @@ -4793,7 +6326,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) QUIT; /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; /* Compute time from now till when time limit is up */ @@ -4822,7 +6355,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) run timer events directly. (Callers that will immediately read keyboard events call timer_delay on their own.) */ - if (! wait_for_cell) + if (NILP (wait_for_cell)) { EMACS_TIME timer_delay; @@ -4863,7 +6396,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) /* Wait till there is something to do. */ - if (! XINT (read_kbd) && wait_for_cell == 0) + if (! XINT (read_kbd) && NILP (wait_for_cell)) FD_ZERO (&waitchannels); else FD_SET (0, &waitchannels); @@ -4939,7 +6472,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) input at all when wait_for_cell, but the code has been this way since July 1994. Try changing this after version 19.31.) */ - if (wait_for_cell + if (! NILP (wait_for_cell) && detect_input_pending ()) { swallow_events (do_display); @@ -4948,7 +6481,7 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } /* Exit now if the cell we're waiting for became non-nil. */ - if (wait_for_cell && ! NILP (*wait_for_cell)) + if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell))) break; } @@ -4958,23 +6491,23 @@ wait_reading_process_input (time_limit, microsecs, read_kbd, do_display) } +/* Don't confuse make-docfile by having two doc strings for this function. + make-docfile does not pay attention to #if, for good reason! */ DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0, - /* Don't confuse make-docfile by having two doc strings for this function. - make-docfile does not pay attention to #if, for good reason! */ - 0) - (name) + 0) + (name) register Lisp_Object name; { return Qnil; } -DEFUN ("process-inherit-coding-system-flag", - Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, - 1, 1, 0, /* Don't confuse make-docfile by having two doc strings for this function. make-docfile does not pay attention to #if, for good reason! */ - 0) - (process) +DEFUN ("process-inherit-coding-system-flag", + Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag, + 1, 1, 0, + 0) + (process) register Lisp_Object process; { /* Ignore the argument and return the value of @@ -5000,6 +6533,9 @@ init_process () void syms_of_process () { + QCtype = intern (":type"); + staticpro (&QCtype); + defsubr (&Sget_buffer_process); defsubr (&Sprocess_inherit_coding_system_flag); }