/* Asynchronous subprocess control for GNU Emacs.
Copyright (C) 1985, 86, 87, 88, 93, 94, 95, 96, 98, 1999,
- 2001, 2002 Free Software Foundation, Inc.
+ 2001, 2002, 2003 Free Software Foundation, Inc.
This file is part of GNU Emacs.
Boston, MA 02111-1307, USA. */
-#define _GNU_SOURCE /* to get strsignal declared with glibc 2 */
#include <config.h>
#include <signal.h>
#include <bsdtty.h>
#endif
+/* Can we use SIOCGIFCONF and/or SIOCGIFADDR */
+#ifdef HAVE_SOCKETS
+#if defined(HAVE_SYS_IOCTL_H) && defined(HAVE_NET_IF_H)
+/* sys/ioctl.h may have been included already */
+#ifndef SIOCGIFADDR
+#include <sys/ioctl.h>
+#endif
+#include <net/if.h>
+#endif
+#endif
+
#ifdef IRIS
#include <sys/sysmacros.h> /* for "minor" */
#endif /* not IRIS */
+#ifdef HAVE_SYS_WAIT
+#include <sys/wait.h>
+#endif
+
#include "systime.h"
#include "systty.h"
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 QCsentinel, QClog, QCoptions, QCplist;
+Lisp_Object QCfilter_multibyte;
Lisp_Object Qlast_nonmenu_event;
/* QCfamily is declared and initialized in xfaces.c,
QCfilter 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). */
+ Qt nor Qnil but is instead a property list (KEY VAL ...). */
#ifdef HAVE_SOCKETS
#define NETCONN_P(p) (GC_CONSP (XPROCESS (p)->childp))
extern Lisp_Object Vfile_name_coding_system, Vdefault_file_name_coding_system;
#ifdef HAVE_PTYS
+#ifdef HAVE_PTY_H
+#include <pty.h>
+#endif
/* The file name of the pty opened by allocate_pty. */
static char pty_name[24];
p->raw_status_high = Qnil;
}
-/* Convert a process status word in Unix format to
+/* Convert a process status word in Unix format to
the list that we use internally. */
Lisp_Object
/* Return a string describing a process status list. */
-Lisp_Object
+Lisp_Object
status_message (status)
Lisp_Object status;
{
int
allocate_pty ()
{
- struct stat stb;
register int c, i;
int fd;
- /* Some systems name their pseudoterminals so that there are gaps in
- the usual sequence - for example, on HP9000/S700 systems, there
- are no pseudoterminals with names ending in 'f'. So we wait for
- three failures in a row before deciding that we've reached the
- end of the ptys. */
- int failed_count = 0;
-
#ifdef PTY_ITERATION
PTY_ITERATION
#else
for (i = 0; i < 16; i++)
#endif
{
+ struct stat stb; /* Used in some PTY_OPEN. */
#ifdef PTY_NAME_SPRINTF
PTY_NAME_SPRINTF
#else
#ifdef PTY_OPEN
PTY_OPEN;
#else /* no PTY_OPEN */
-#ifdef IRIS
- /* Unusual IRIS code */
- *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
- if (fd < 0)
- return -1;
- if (fstat (fd, &stb) < 0)
- return -1;
-#else /* not IRIS */
- if (stat (pty_name, &stb) < 0)
- {
- failed_count++;
- if (failed_count >= 3)
- return -1;
+ {
+# ifdef IRIS
+ /* Unusual IRIS code */
+ *ptyv = emacs_open ("/dev/ptc", O_RDWR | O_NDELAY, 0);
+ if (fd < 0)
+ return -1;
+ if (fstat (fd, &stb) < 0)
+ return -1;
+# else /* not IRIS */
+ { /* Some systems name their pseudoterminals so that there are gaps in
+ the usual sequence - for example, on HP9000/S700 systems, there
+ are no pseudoterminals with names ending in 'f'. So we wait for
+ three failures in a row before deciding that we've reached the
+ end of the ptys. */
+ int failed_count = 0;
+
+ if (stat (pty_name, &stb) < 0)
+ {
+ failed_count++;
+ if (failed_count >= 3)
+ return -1;
+ }
+ else
+ failed_count = 0;
}
- else
- failed_count = 0;
-#ifdef O_NONBLOCK
- fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
-#else
- fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
-#endif
-#endif /* not IRIS */
+# ifdef O_NONBLOCK
+ fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
+# else
+ fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
+# endif
+# endif /* not IRIS */
+ }
#endif /* no PTY_OPEN */
if (fd >= 0)
if (access (pty_name, 6) != 0)
{
emacs_close (fd);
-#if !defined(IRIS) && !defined(__sgi)
+# if !defined(IRIS) && !defined(__sgi)
continue;
-#else
+# else
return -1;
-#endif /* IRIS */
+# endif /* IRIS */
}
#endif /* not UNIPLUS */
setup_pty (fd);
deactivate_process (proc);
}
+
+/* Setup coding systems of PROCESS. */
+
+void
+setup_process_coding_systems (process)
+ Lisp_Object process;
+{
+ struct Lisp_Process *p = XPROCESS (process);
+ int inch = XINT (p->infd);
+ int outch = XINT (p->outfd);
+
+ if (inch < 0 || outch < 0)
+ return;
+
+ if (!proc_decode_coding_system[inch])
+ proc_decode_coding_system[inch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->decode_coding_system,
+ proc_decode_coding_system[inch]);
+ if (! NILP (p->filter))
+ {
+ if (NILP (p->filter_multibyte))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+ else if (BUFFERP (p->buffer))
+ {
+ if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters))
+ setup_raw_text_coding_system (proc_decode_coding_system[inch]);
+ }
+
+ if (!proc_encode_coding_system[outch])
+ proc_encode_coding_system[outch]
+ = (struct coding_system *) xmalloc (sizeof (struct coding_system));
+ setup_coding_system (p->encode_coding_system,
+ proc_encode_coding_system[outch]);
+}
\f
DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
doc: /* Return t if OBJECT is a process. */)
{
Fkill_process (process, Qnil);
/* Do this now, since remove_process will make sigchld_handler do nothing. */
- XPROCESS (process)->status
+ XPROCESS (process)->status
= Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
XSETINT (XPROCESS (process)->tick, ++process_tick);
status_notify ();
p->buffer = buffer;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCbuffer, buffer);
+ setup_process_coding_systems (process);
return buffer;
}
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.
+
+When a process has a filter, its buffer is not used for output.
+Instead, 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. */)
+The string argument is normally a multibyte string, except:
+- if the process' input coding system is no-conversion or raw-text,
+ it is a unibyte string (the non-converted input), or else
+- if `default-enable-multibyte-characters' is nil, it is a unibyte
+ string (the result of converting the decoded input multibyte
+ string to unibyte with `string-make-unibyte'). */)
(process, filter)
register Lisp_Object process, filter;
{
struct Lisp_Process *p;
-
+
CHECK_PROCESS (process);
p = XPROCESS (process);
(setq process (start-process ...))
(debug)
(set-process-filter process ...) */
-
+
if (XINT (p->infd) >= 0)
{
if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
FD_SET (XINT (p->infd), &non_keyboard_wait_mask);
}
}
-
+
p->filter = filter;
if (NETCONN1_P (p))
p->childp = Fplist_put (p->childp, QCfilter, filter);
+ setup_process_coding_systems (process);
return filter;
}
(process, sentinel)
register Lisp_Object process, sentinel;
{
+ struct Lisp_Process *p;
+
CHECK_PROCESS (process);
- XPROCESS (process)->sentinel = sentinel;
+ p = XPROCESS (process);
+
+ p->sentinel = sentinel;
+ if (NETCONN1_P (p))
+ p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
return sentinel;
}
CHECK_PROCESS (process);
CHECK_NATNUM (height);
CHECK_NATNUM (width);
-
+
if (XINT (XPROCESS (process)->infd) < 0
|| set_window_size (XINT (XPROCESS (process)->infd),
XINT (height), XINT (width)) <= 0)
#ifdef DATAGRAM_SOCKETS
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
- contact = Fplist_put (contact, QCremote,
+ contact = Fplist_put (contact, QCremote,
Fprocess_datagram_address (process));
#endif
return Fplist_get (contact, key);
}
+DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
+ 1, 1, 0,
+ doc: /* Return the plist of PROCESS. */)
+ (process)
+ register Lisp_Object process;
+{
+ CHECK_PROCESS (process);
+ return XPROCESS (process)->plist;
+}
+
+DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
+ 2, 2, 0,
+ doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
+ (process, plist)
+ register Lisp_Object process, plist;
+{
+ CHECK_PROCESS (process);
+ CHECK_LIST (plist);
+
+ XPROCESS (process)->plist = plist;
+ return plist;
+}
+
#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 XPROCESS (process)->type;
}
#endif
+
+#ifdef HAVE_SOCKETS
+DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
+ 1, 2, 0,
+ doc: /* Convert network ADDRESS from internal format to a string.
+If optional second argument OMIT-PORT is non-nil, don't include a port
+number in the string; in this case, interpret a 4 element vector as an
+IP address. Returns nil if format of ADDRESS is invalid. */)
+ (address, omit_port)
+ Lisp_Object address, omit_port;
+{
+ if (NILP (address))
+ return Qnil;
+
+ if (STRINGP (address)) /* AF_LOCAL */
+ return address;
+
+ if (VECTORP (address)) /* AF_INET */
+ {
+ register struct Lisp_Vector *p = XVECTOR (address);
+ Lisp_Object args[6];
+ int nargs, i;
+
+ if (!NILP (omit_port) && (p->size == 4 || p->size == 5))
+ {
+ args[0] = build_string ("%d.%d.%d.%d");
+ nargs = 4;
+ }
+ else if (p->size == 5)
+ {
+ args[0] = build_string ("%d.%d.%d.%d:%d");
+ nargs = 5;
+ }
+ else
+ return Qnil;
+
+ for (i = 0; i < nargs; i++)
+ args[i+1] = p->contents[i];
+ return Fformat (nargs+1, args);
+ }
+
+ if (CONSP (address))
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("<Family %d>");
+ args[1] = Fcar (address);
+ return Fformat (2, args);
+
+ }
+
+ return Qnil;
+}
+#endif
\f
Lisp_Object
list_processes_1 (query_only)
if (CONSP (p->status))
symbol = XCAR (p->status);
-
+
if (EQ (symbol, Qsignal))
{
Lisp_Object tem;
Lisp_Object port = Fplist_get (p->childp, QCservice);
if (INTEGERP (port))
port = Fnumber_to_string (port);
+ if (NILP (port))
+ port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
sprintf (tembuf, "(network %s server on %s)\n",
(DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
- SDATA (port));
+ (STRINGP (port) ? (char *)SDATA (port) : "?"));
insert_string (tembuf);
}
else if (NETCONN1_P (p))
if (INTEGERP (host))
host = Fnumber_to_string (host);
}
+ if (NILP (host))
+ host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
sprintf (tembuf, "(network %s connection to %s)\n",
(DATAGRAM_CHAN_P (XINT (p->infd)) ? "datagram" : "stream"),
- SDATA (host));
+ (STRINGP (host) ? (char *)SDATA (host) : "?"));
insert_string (tembuf);
}
- else
+ else
{
tem = p->command;
while (1)
GCPRO2 (buffer, current_dir);
- current_dir
+ current_dir
= expand_and_dir_to_file (Funhandled_file_name_directory (current_dir),
Qnil);
if (NILP (Ffile_accessible_directory_p (current_dir)))
record_unwind_protect (start_process_unwind, proc);
XPROCESS (proc)->childp = Qt;
+ XPROCESS (proc)->plist = Qnil;
XPROCESS (proc)->command_channel_p = Qnil;
XPROCESS (proc)->buffer = buffer;
XPROCESS (proc)->sentinel = Qnil;
XPROCESS (proc)->filter = Qnil;
+ XPROCESS (proc)->filter_multibyte
+ = buffer_defaults.enable_multibyte_characters;
XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
/* Make the process marker point into the process buffer (if any). */
strcat (new_argv, SDATA (tem));
}
/* Need to add code here to check for program existence on VMS */
-
+
#else /* not VMS */
new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
chan_process[inchannel] = process;
XSETINT (XPROCESS (process)->infd, inchannel);
XSETINT (XPROCESS (process)->outfd, outchannel);
- /* Record the tty descriptor used in the subprocess. */
- if (forkin < 0)
- XPROCESS (process)->subtty = Qnil;
- else
- XSETFASTINT (XPROCESS (process)->subtty, forkin);
+
+ /* Previously we recorded the tty descriptor used in the subprocess.
+ It was only used for getting the foreground tty process, so now
+ we just reopen the device (see emacs_get_tty_pgrp) as this is
+ more portable (see USG_SUBTTY_WORKS above). */
+
XPROCESS (process)->pty_flag = (pty_flag ? Qt : Qnil);
XPROCESS (process)->status = Qrun;
- if (!proc_decode_coding_system[inchannel])
- proc_decode_coding_system[inchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->decode_coding_system,
- proc_decode_coding_system[inchannel]);
- if (!proc_encode_coding_system[outchannel])
- proc_encode_coding_system[outchannel]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (XPROCESS (process)->encode_coding_system,
- proc_encode_coding_system[outchannel]);
+ setup_process_coding_systems (process);
/* Delay interrupts until we have a chance to store
the new fork's pid in its process structure */
XSETINT (XPROCESS (process)->pid, -1);
BLOCK_INPUT;
-
+
{
/* child_setup must clobber environ on systems with true vfork.
Protect it from permanent change. */
}
#endif
#endif
-#ifdef TIOCNOTTY
+#ifdef TIOCNOTTY
/* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
can do TIOCSPGRP only to the process's controlling tty. */
if (pty_flag)
{
- /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
+ /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
I can't test it since I don't have 4.3. */
int j = emacs_open ("/dev/tty", O_RDWR, 0);
ioctl (j, TIOCNOTTY, 0);
#ifdef WINDOWSNT
pid = child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
-#else /* not WINDOWSNT */
+#else /* not WINDOWSNT */
child_setup (xforkin, xforkout, xforkout,
new_argv, 1, current_dir);
#endif /* not WINDOWSNT */
{
struct atimer *timer;
EMACS_TIME offset;
-
+
stop_polling ();
EMACS_SET_SECS_USECS (offset, 1, 0);
timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
-
- XPROCESS (process)->subtty = Qnil;
+
if (forkin >= 0)
emacs_close (forkin);
cancel_atimer (timer);
start_polling ();
}
-
+
if (forkin != forkout && forkout >= 0)
emacs_close (forkout);
int len;
{
register struct Lisp_Vector *p;
- register unsigned char *cp;
+ register unsigned char *cp = NULL;
register int i;
bzero (sa, len);
static struct socket_options {
/* The name of this option. Should be lowercase version of option
- name without SO_ prefix. */
+ 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;
+ enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
} socket_options[] =
{
#ifdef SO_BINDTODEVICE
- { "bindtodevice", 12, SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR },
+ { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_STR, OPIX_MISC },
#endif
#ifdef SO_BROADCAST
- { "broadcast", 9, SOL_SOCKET, SO_BROADCAST, SOPT_BOOL },
+ { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_DONTROUTE
- { "dontroute", 9, SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL },
+ { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_KEEPALIVE
- { "keepalive", 9, SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL },
+ { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_LINGER
- { "linger", 6, SOL_SOCKET, SO_LINGER, SOPT_LINGER },
+ { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
#endif
#ifdef SO_OOBINLINE
- { "oobinline", 9, SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL },
+ { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
#endif
#ifdef SO_PRIORITY
- { "priority", 8, SOL_SOCKET, SO_PRIORITY, SOPT_INT },
+ { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
#endif
#ifdef SO_REUSEADDR
- { "reuseaddr", 9, SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL },
+ { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
#endif
- { 0, 0, 0, 0, SOPT_UNKNOWN }
+ { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
};
-/* 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.
+/* Set option OPT to value VAL on socket S.
- 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. */
+ Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
+ Signals an error if setting a known option fails.
+*/
static int
-set_socket_options (s, opts, no_error)
+set_socket_option (s, opt, val)
int s;
- Lisp_Object opts;
- int no_error;
+ Lisp_Object opt, val;
{
- 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 *) SDATA (opt);
- else if (SYMBOLP (opt))
- name = (char *) SDATA (SYMBOL_NAME (opt));
- 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;
- }
- }
+ char *name;
+ struct socket_options *sopt;
+ int ret = 0;
- 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;
- }
+ CHECK_SYMBOL (opt);
- 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;
- }
+ name = (char *) SDATA (SYMBOL_NAME (opt));
+ for (sopt = socket_options; sopt->name; sopt++)
+ if (strcmp (name, sopt->name) == 0)
+ break;
- case SOPT_STR:
- {
- if (!arg)
- {
- if (NILP (val))
- arg = "";
- else if (STRINGP (val))
- arg = (char *) SDATA (val);
- else if (XSYMBOL (val))
- arg = (char *) SDATA (SYMBOL_NAME (val));
- else
- error ("Invalid argument to %s option", name);
- }
- ret = setsockopt (s, sopt->optlevel, sopt->optnum,
- arg, strlen (arg));
- }
+ switch (sopt->opttype)
+ {
+ case SOPT_BOOL:
+ {
+ int optval;
+ optval = NILP (val) ? 0 : 1;
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
-#ifdef SO_LINGER
- case SOPT_LINGER:
- {
- struct linger linger;
+ case SOPT_INT:
+ {
+ int optval;
+ if (INTEGERP (val))
+ optval = XINT (val);
+ else
+ error ("Bad option value for %s", name);
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ &optval, sizeof (optval));
+ break;
+ }
- linger.l_onoff = 1;
- linger.l_linger = 0;
+ case SOPT_STR:
+ {
+ char *arg;
+
+ if (NILP (val))
+ arg = "";
+ else if (STRINGP (val))
+ arg = (char *) SDATA (val);
+ else if (XSYMBOL (val))
+ arg = (char *) SDATA (SYMBOL_NAME (val));
+ else
+ error ("Bad option value for %s", name);
+ ret = setsockopt (s, sopt->optlevel, sopt->optnum,
+ arg, strlen (arg));
+ }
- if (s < 0)
- return 1;
+#ifdef SO_LINGER
+ case SOPT_LINGER:
+ {
+ struct linger linger;
- 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;
- }
+ linger.l_onoff = 1;
+ linger.l_linger = 0;
+ 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);
+
+ default:
+ return 0;
}
- return 1;
+
+ if (ret < 0)
+ report_file_error ("Cannot set network option",
+ Fcons (opt, Fcons (val, Qnil)));
+ return (1 << sopt->optbit);
}
-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;
+
+DEFUN ("set-network-process-option",
+ Fset_network_process_option, Sset_network_process_option,
+ 3, 4, 0,
+ doc: /* For network process PROCESS set option OPTION to value VALUE.
+See `make-network-process' for a list of options and values.
+If optional fourth arg NO-ERROR is non-nil, don't signal an error if
+OPTION is not a supported option, return nil instead; otherwise return t. */)
+ (process, option, value, no_error)
+ Lisp_Object process, option, value;
+ Lisp_Object no_error;
{
- Lisp_Object process;
- Lisp_Object opts;
+ int s;
- 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;
+
+ s = XINT (XPROCESS (process)->infd);
+ if (s < 0)
+ error ("Process is not running");
+
+ if (set_socket_option (s, option, value))
+ return Qt;
+
+ if (NILP (no_error))
+ error ("Unknown or unsupported option");
+
+ return Qnil;
}
+
\f
/* A version of request_sigio suitable for a record_unwind_protect. */
connection has no PID; you cannot signal it. All you can do is
stop/continue it and deactivate/close it via delete-process */
-DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
- 0, MANY, 0,
+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
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.
+:coding CODING -- If CODING is a symbol, it specifies the coding
+system used for both reading and writing for this process. If CODING
+is a cons (DECODING . ENCODING), DECODING is used for reading, and
+ENCODING is used for writing.
:nowait BOOL -- If BOOL is non-nil for a stream type client process,
return without waiting for the connection to complete; instead, the
:filter FILTER -- Install FILTER as the process filter.
+:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
+process filter are multibyte, otherwise they are unibyte.
+If this keyword is not specified, the strings are multibyte iff
+`default-enable-multibyte-characters' is non-nil.
+
: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
+function is called 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
+:plist PLIST -- Install PLIST as the new process' initial plist.
+
+:server QLEN -- if QLEN is non-nil, create a server process for the
specified FAMILY, SERVICE, and connection type (stream or datagram).
-Default is a client process.
+If QLEN is an integer, it is used as the max. length of the server's
+pending connection queue (also known as the backlog); the default
+queue length is 5. Default is to create a client process.
+
+The following network options can be specified for this connection:
+
+:bindtodevice NAME -- bind to interface NAME.
+: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 local address
+ (this is allowed by default for a server process).
+
+Consult the relevant system programmer's manual pages for more
+information on using these options.
+
+
+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:
-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.
+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).
+- The client process' plist is initialized from the server's plist.
Notice that the FILTER and SENTINEL args are never used directly by
the server process. Also, the BUFFER argument is not used directly by
-the server process, but via `network-server-log-function' hook, a log
-of the accepted (and failed) connections may be recorded in the server
-process' buffer.
+the server process, but via the optional :log function, accepted (and
+failed) connections may be logged in the server process' buffer.
+
+The original argument list, modified with the actual connection
+information, is available via the `process-contact' function.
usage: (make-network-process &rest ARGS) */)
(nargs, args)
Lisp_Object name, buffer, host, service, address;
Lisp_Object filter, sentinel;
int is_non_blocking_client = 0;
- int is_server = 0;
+ int is_server = 0, backlog = 5;
int socktype;
int family = -1;
error ("Network servers not supported");
#else
is_server = 1;
+ if (INTEGERP (tem))
+ backlog = XINT (tem);
#endif
}
/* 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));
{
struct servent *svc_info;
CHECK_STRING (service);
- svc_info = getservbyname (SDATA (service),
+ svc_info = getservbyname (SDATA (service),
(socktype == SOCK_DGRAM ? "udp" : "tcp"));
if (svc_info == 0)
error ("Unknown service: %s", SDATA (service));
QUIT;
host_info_ptr = gethostbyname (SDATA (host));
immediate_quit = 0;
-
+
if (host_info_ptr)
{
bcopy (host_info_ptr->h_addr, (char *) &address_in.sin_addr,
for (lres = res; lres; lres = lres->ai_next)
{
+ int optn, optbits;
+
s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
if (s < 0)
{
}
}
#endif
-
+
/* Make us close S if quit. */
record_unwind_protect (close_file_unwind, make_number (s));
+ /* Parse network options in the arg list.
+ We simply ignore anything which isn't a known option (including other keywords).
+ An error is signalled if setting a known option fails. */
+ for (optn = optbits = 0; optn < nargs-1; optn += 2)
+ optbits |= set_socket_option (s, args[optn], args[optn+1]);
+
if (is_server)
{
/* Configure as a server socket. */
+
+ /* SO_REUSEADDR = 1 is default for server sockets; must specify
+ explicit :reuseaddr key to override this. */
#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 (!(optbits & (1 << OPIX_REUSEADDR)))
+ {
+ 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);
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);
+ service = make_number (ntohs (sa1.sin_port));
contact = Fplist_put (contact, QCservice, service);
}
}
#endif
- if (socktype == SOCK_STREAM && listen (s, 5))
+ if (socktype == SOCK_STREAM && listen (s, backlog))
report_file_error ("Cannot listen on server socket", Qnil);
break;
set.
It'd be nice to be able to control the connect timeout
- though. Would non-blocking connect calls be portable?
+ though. Would non-blocking connect calls be portable?
This used to be conditioned by HAVE_GETADDRINFO. Why? */
bcopy (lres->ai_addr, datagram_address[s].sa, lres->ai_addrlen);
}
#endif
- contact = Fplist_put (contact, QCaddress,
+ contact = Fplist_put (contact, QCaddress,
conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
+#ifdef HAVE_GETSOCKNAME
+ if (!is_server)
+ {
+ struct sockaddr_in sa1;
+ int len1 = sizeof (sa1);
+ if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
+ contact = Fplist_put (contact, QClocal,
+ conv_sockaddr_to_lisp (&sa1, len1));
+ }
+#endif
}
#ifdef HAVE_GETADDRINFO
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;
p = XPROCESS (proc);
p->childp = contact;
+ p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
+
p->buffer = buffer;
p->sentinel = sentinel;
p->filter = filter;
+ p->filter_multibyte = buffer_defaults.enable_multibyte_characters;
+ /* Override the above only if :filter-multibyte is specified. */
+ if (! NILP (Fplist_member (contact, QCfilter_multibyte)))
+ p->filter_multibyte = Fplist_get (contact, QCfilter_multibyte);
p->log = Fplist_get (contact, QClog);
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = Qt;
Lisp_Object args[5], val;
if (!NILP (tem))
- val = XCAR (XCDR (tem));
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCAR (val);
+ }
else if (!NILP (Vcoding_system_for_read))
val = Vcoding_system_for_read;
else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters))
val = Qnil;
else
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
if (CONSP (coding_systems))
val = XCAR (coding_systems);
else if (CONSP (Vdefault_process_coding_system))
p->decode_coding_system = val;
if (!NILP (tem))
- val = XCAR (XCDR (tem));
+ {
+ val = XCAR (XCDR (tem));
+ if (CONSP (val))
+ val = XCDR (val);
+ }
else if (!NILP (Vcoding_system_for_write))
val = Vcoding_system_for_write;
else if (NILP (current_buffer->enable_multibyte_characters))
{
if (EQ (coding_systems, Qt))
{
- args[0] = Qopen_network_stream, args[1] = name,
- args[2] = buffer, args[3] = host, args[4] = service;
- GCPRO1 (proc);
- coding_systems = Ffind_operation_coding_system (5, args);
- UNGCPRO;
+ if (NILP (host) || NILP (service))
+ coding_systems = Qnil;
+ else
+ {
+ args[0] = Qopen_network_stream, args[1] = name,
+ args[2] = buffer, args[3] = host, args[4] = service;
+ GCPRO1 (proc);
+ coding_systems = Ffind_operation_coding_system (5, args);
+ UNGCPRO;
+ }
}
if (CONSP (coding_systems))
val = XCDR (coding_systems);
}
p->encode_coding_system = val;
}
-
- if (!proc_decode_coding_system[inch])
- proc_decode_coding_system[inch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->decode_coding_system,
- proc_decode_coding_system[inch]);
- if (!proc_encode_coding_system[outch])
- proc_encode_coding_system[outch]
- = (struct coding_system *) xmalloc (sizeof (struct coding_system));
- setup_coding_system (p->encode_coding_system,
- proc_encode_coding_system[outch]);
+ setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
}
#endif /* HAVE_SOCKETS */
+\f
+#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
+
+#ifdef SIOCGIFCONF
+DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
+ doc: /* Return an alist of all network interfaces and their network address.
+Each element is a cons, the car of which is a string containing the
+interface name, and the cdr is the network address in internal
+format; see the description of ADDRESS in `make-network-process'. */)
+ ()
+{
+ struct ifconf ifconf;
+ struct ifreq *ifreqs = NULL;
+ int ifaces = 0;
+ int buf_size, s;
+ Lisp_Object res;
+
+ s = socket (AF_INET, SOCK_STREAM, 0);
+ if (s < 0)
+ return Qnil;
+
+ again:
+ ifaces += 25;
+ buf_size = ifaces * sizeof(ifreqs[0]);
+ ifreqs = (struct ifreq *)xrealloc(ifreqs, buf_size);
+ if (!ifreqs)
+ {
+ close (s);
+ return Qnil;
+ }
+
+ ifconf.ifc_len = buf_size;
+ ifconf.ifc_req = ifreqs;
+ if (ioctl (s, SIOCGIFCONF, &ifconf))
+ {
+ close (s);
+ return Qnil;
+ }
+
+ if (ifconf.ifc_len == buf_size)
+ goto again;
+
+ close (s);
+ ifaces = ifconf.ifc_len / sizeof (ifreqs[0]);
+
+ res = Qnil;
+ while (--ifaces >= 0)
+ {
+ struct ifreq *ifq = &ifreqs[ifaces];
+ char namebuf[sizeof (ifq->ifr_name) + 1];
+ if (ifq->ifr_addr.sa_family != AF_INET)
+ continue;
+ bcopy (ifq->ifr_name, namebuf, sizeof (ifq->ifr_name));
+ namebuf[sizeof (ifq->ifr_name)] = 0;
+ res = Fcons (Fcons (build_string (namebuf),
+ conv_sockaddr_to_lisp (&ifq->ifr_addr,
+ sizeof (struct sockaddr))),
+ res);
+ }
+
+ return res;
+}
+#endif /* SIOCGIFCONF */
+
+#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
+
+struct ifflag_def {
+ int flag_bit;
+ char *flag_sym;
+};
+
+static struct ifflag_def ifflag_table[] = {
+#ifdef IFF_UP
+ { IFF_UP, "up" },
+#endif
+#ifdef IFF_BROADCAST
+ { IFF_BROADCAST, "broadcast" },
+#endif
+#ifdef IFF_DEBUG
+ { IFF_DEBUG, "debug" },
+#endif
+#ifdef IFF_LOOPBACK
+ { IFF_LOOPBACK, "loopback" },
+#endif
+#ifdef IFF_POINTOPOINT
+ { IFF_POINTOPOINT, "pointopoint" },
+#endif
+#ifdef IFF_RUNNING
+ { IFF_RUNNING, "running" },
+#endif
+#ifdef IFF_NOARP
+ { IFF_NOARP, "noarp" },
+#endif
+#ifdef IFF_PROMISC
+ { IFF_PROMISC, "promisc" },
+#endif
+#ifdef IFF_NOTRAILERS
+ { IFF_NOTRAILERS, "notrailers" },
+#endif
+#ifdef IFF_ALLMULTI
+ { IFF_ALLMULTI, "allmulti" },
+#endif
+#ifdef IFF_MASTER
+ { IFF_MASTER, "master" },
+#endif
+#ifdef IFF_SLAVE
+ { IFF_SLAVE, "slave" },
+#endif
+#ifdef IFF_MULTICAST
+ { IFF_MULTICAST, "multicast" },
+#endif
+#ifdef IFF_PORTSEL
+ { IFF_PORTSEL, "portsel" },
+#endif
+#ifdef IFF_AUTOMEDIA
+ { IFF_AUTOMEDIA, "automedia" },
+#endif
+#ifdef IFF_DYNAMIC
+ { IFF_DYNAMIC, "dynamic" },
+#endif
+ { 0, 0 }
+};
+
+DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
+ doc: /* Return information about network interface named IFNAME.
+The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
+where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
+NETMASK is the layer 3 network mask, HWADDR is the layer 2 addres, and
+FLAGS is the current flags of the interface. */)
+ (ifname)
+ Lisp_Object ifname;
+{
+ struct ifreq rq;
+ Lisp_Object res = Qnil;
+ Lisp_Object elt;
+ int s;
+ int any = 0;
+
+ CHECK_STRING (ifname);
+
+ bzero (rq.ifr_name, sizeof rq.ifr_name);
+ strncpy (rq.ifr_name, SDATA (ifname), sizeof (rq.ifr_name));
+
+ s = socket (AF_INET, SOCK_STREAM, 0);
+ if (s < 0)
+ return Qnil;
+
+ elt = Qnil;
+#if defined(SIOCGIFFLAGS) && defined(ifr_flags)
+ if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
+ {
+ int flags = rq.ifr_flags;
+ struct ifflag_def *fp;
+ int fnum;
+
+ any++;
+ for (fp = ifflag_table; flags != 0 && fp; fp++)
+ {
+ if (flags & fp->flag_bit)
+ {
+ elt = Fcons (intern (fp->flag_sym), elt);
+ flags -= fp->flag_bit;
+ }
+ }
+ for (fnum = 0; flags && fnum < 32; fnum++)
+ {
+ if (flags & (1 << fnum))
+ {
+ elt = Fcons (make_number (fnum), elt);
+ }
+ }
+ }
+#endif
+ res = Fcons (elt, res);
+
+ elt = Qnil;
+#if defined(SIOCGIFHWADDR) && defined(ifr_hwaddr)
+ if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
+ {
+ Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
+ register struct Lisp_Vector *p = XVECTOR (hwaddr);
+ int n;
+
+ any++;
+ for (n = 0; n < 6; n++)
+ p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
+ elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
+ }
+#endif
+ res = Fcons (elt, res);
+
+ elt = Qnil;
+#if defined(SIOCGIFNETMASK) && defined(ifr_netmask)
+ if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
+ {
+ any++;
+ elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
+ }
+#endif
+ res = Fcons (elt, res);
+
+ elt = Qnil;
+#if defined(SIOCGIFBRDADDR) && defined(ifr_broadaddr)
+ if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
+ {
+ any++;
+ elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
+ }
+#endif
+ res = Fcons (elt, res);
+
+ elt = Qnil;
+#if defined(SIOCGIFADDR) && defined(ifr_addr)
+ if (ioctl (s, SIOCGIFADDR, &rq) == 0)
+ {
+ any++;
+ elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
+ }
+#endif
+ res = Fcons (elt, res);
+
+ close (s);
+
+ return any ? res : Qnil;
+}
+#endif
+#endif /* HAVE_SOCKETS */
+
void
deactivate_process (proc)
Lisp_Object proc;
seconds = -1;
}
else
- {
- if (NILP (process))
- seconds = -1;
- else
- seconds = 0;
- }
+ seconds = NILP (process) ? -1 : 0;
if (NILP (process))
XSETFASTINT (process, 0);
contact = Fplist_put (contact, QChost, host);
if (!NILP (service))
contact = Fplist_put (contact, QCservice, service);
- contact = Fplist_put (contact, QCremote,
+ 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,
+ if (getsockname (s, &saddr.sa, &len) == 0)
+ contact = Fplist_put (contact, QClocal,
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
p->childp = contact;
+ p->plist = Fcopy_sequence (ps->plist);
+
p->buffer = buffer;
p->sentinel = ps->sentinel;
p->filter = ps->filter;
if (s > max_process_desc)
max_process_desc = s;
- /* Setup coding system for new process based on server process.
+ /* 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]);
+ setup_process_coding_systems (proc);
p->decoding_buf = make_uninit_string (0);
p->decoding_carryover = make_number (0);
build_string ("\n")));
if (!NILP (p->sentinel))
- exec_sentinel (proc,
+ exec_sentinel (proc,
concat3 (build_string ("open from "),
(STRINGP (host) ? host : build_string ("-")),
build_string ("\n")));
EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
EMACS_ADD_TIME (end_time, end_time, timeout);
}
-#ifdef hpux
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seem to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
- Turn off periodic alarms (in case they are in use) */
+ Turn off periodic alarms (in case they are in use),
+ and then turn off any other atimers. */
+ stop_polling ();
turn_on_atimers (0);
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
while (1)
{
{
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
-
+
timer_delay = timer_check (1);
/* If a timer has run, this might have changed buffers
&& old_buffer != current_buffer
&& waiting_for_user_input_p == -1)
record_asynch_buffer_change ();
-
+
if (timers_run != old_timers_run && do_display)
/* We must retry, since a timer may have requeued itself
and that could alter the time_delay. */
Ctemp = connect_wait_mask;
EMACS_SET_SECS_USECS (timeout, 0, 0);
if ((select (max (max_process_desc, max_keyboard_desc) + 1,
- &Atemp,
+ &Atemp,
(num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
(SELECT_TYPE *)0, &timeout)
<= 0))
if (nread == 0)
break;
- if (0 < nread)
+ if (0 < nread)
total_nread += nread;
#ifdef EIO
else if (nread == -1 && EIO == errno)
if (check_connect)
Connecting = connect_wait_mask;
nfds = select (max (max_process_desc, max_keyboard_desc) + 1,
- &Available,
+ &Available,
(check_connect ? &Connecting : (SELECT_TYPE *)0),
(SELECT_TYPE *)0, &timeout);
}
int old_timers_run = timers_run;
struct buffer *old_buffer = current_buffer;
int leave = 0;
-
+
if (detect_input_pending_run_timers (do_display))
{
swallow_events (do_display);
if (leave)
break;
- }
-
+ }
+
/* If there is unread keyboard input, also return. */
if (XINT (read_kbd) != 0
&& requeued_events_pending_p ())
but select says there is input. */
if (XINT (read_kbd) && interrupt_input
- && keyboard_bit_set (&Available))
+ && keyboard_bit_set (&Available) && ! noninteractive)
kill (getpid (), SIGIO);
#endif
= Fcons (Qexit, Fcons (make_number (256), Qnil));
}
}
-#ifdef NON_BLOCKING_CONNECT
+#ifdef NON_BLOCKING_CONNECT
if (check_connect && FD_ISSET (channel, &Connecting))
{
struct Lisp_Process *p;
clear_input_pending ();
QUIT;
}
-#ifdef hpux
+#ifdef POLL_INTERRUPTED_SYS_CALL
/* AlainF 5-Jul-1996
HP-UX 10.10 seems to have problems with signals coming in
Causes "poll: interrupted system call" messages when Emacs is run
in an X window
Turn periodic alarms back on */
start_polling ();
-#endif
+#endif /* POLL_INTERRUPTED_SYS_CALL */
return got_some_input;
}
Lisp_Object proc;
register int channel;
{
- register int nchars, nbytes;
+ register int nbytes;
char *chars;
register Lisp_Object outstream;
register struct buffer *old = current_buffer;
outstream = p->filter;
if (!NILP (outstream))
{
- /* We inhibit quit here instead of just catching it so that
+ /* We inhibit quit here instead of just catching it so that
hitting ^G when a filter happens to be running won't screw
it up. */
int count = SPECPDL_INDEX ();
text = decode_coding_string (make_unibyte_string (chars, nbytes),
coding, 0);
- if (NILP (buffer_defaults.enable_multibyte_characters))
- /* We had better return unibyte string. */
- text = string_make_unibyte (text);
-
Vlast_coding_system_used = coding->symbol;
/* A new coding system might be found. */
if (!EQ (p->decode_coding_system, coding->symbol))
bcopy (chars + coding->consumed, SDATA (p->decoding_buf),
carryover);
XSETINT (p->decoding_carryover, carryover);
- nbytes = SBYTES (text);
- nchars = SCHARS (text);
- if (nbytes > 0)
+ /* Adjust the multibyteness of TEXT to that of the filter. */
+ if (NILP (p->filter_multibyte) != ! STRING_MULTIBYTE (text))
+ text = (STRING_MULTIBYTE (text)
+ ? Fstring_as_unibyte (text)
+ : Fstring_to_multibyte (text));
+ if (SBYTES (text) > 0)
internal_condition_case_1 (read_process_output_call,
Fcons (outstream,
Fcons (proc, Fcons (text, Qnil))),
start_vms_process_read (vs);
#endif
unbind_to (count, Qnil);
- return nchars;
+ return nbytes;
}
/* If no filter, write into buffer if it isn't dead. */
!= ! STRING_MULTIBYTE (text))
text = (STRING_MULTIBYTE (text)
? Fstring_as_unibyte (text)
- : Fstring_as_multibyte (text));
- nbytes = SBYTES (text);
- nchars = SCHARS (text);
+ : Fstring_to_multibyte (text));
/* 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);
+ insert_from_string_before_markers (text, 0, 0,
+ SCHARS (text), SBYTES (text), 0);
/* Make sure the process marker's position is valid when the
process buffer is changed in the signal_after_change above.
|| errno == EAGAIN
#endif
)
- /* Buffer is full. Wait, accepting input;
+ /* Buffer is full. Wait, accepting input;
that may allow the program
to finish doing output and read more. */
{
the terminal is set up that way which it is
here). The same bytes will be seen again in a
later read(2), without the CRs. */
-
+
if (errno == EAGAIN)
{
int flags = FWRITE;
&flags);
}
#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
-
+
/* Running filters might relocate buffers or strings.
Arrange to relocate BUF. */
if (BUFFERP (object))
XSETINT (XPROCESS (proc)->tick, ++process_tick);
deactivate_process (proc);
#ifdef VMS
- error ("Error writing to process %s; closed it",
+ error ("Error writing to process %s; closed it",
SDATA (XPROCESS (proc)->name));
#else
error ("SIGPIPE raised on process %s; closed it",
return Qnil;
}
\f
+/* Return the foreground process group for the tty/pty that
+ the process P uses. */
+static int
+emacs_get_tty_pgrp (p)
+ struct Lisp_Process *p;
+{
+ int gid = -1;
+
+#ifdef TIOCGPGRP
+ if (ioctl (XINT (p->infd), TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
+ {
+ int fd;
+ /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
+ master side. Try the slave side. */
+ fd = emacs_open (XSTRING (p->tty_name)->data, O_RDONLY, 0);
+
+ if (fd != -1)
+ {
+ ioctl (fd, TIOCGPGRP, &gid);
+ emacs_close (fd);
+ }
+ }
+#endif /* defined (TIOCGPGRP ) */
+
+ return gid;
+}
+
DEFUN ("process-running-child-p", Fprocess_running_child_p,
Sprocess_running_child_p, 0, 1, 0,
doc: /* Return t if PROCESS has given the terminal to a child.
{
/* Initialize in case ioctl doesn't exist or gives an error,
in a way that will cause returning t. */
- int gid = 0;
+ int gid;
Lisp_Object proc;
struct Lisp_Process *p;
error ("Process %s is not active",
SDATA (p->name));
-#ifdef TIOCGPGRP
- if (!NILP (p->subtty))
- ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-#endif /* defined (TIOCGPGRP ) */
+ gid = emacs_get_tty_pgrp (p);
if (gid == XFASTINT (p->pid))
return Qnil;
/* The code above always returns from the function. */
#endif /* defined (SIGNALS_VIA_CHARACTERS) */
-#ifdef TIOCGPGRP
+#ifdef TIOCGPGRP
/* Get the current pgrp using the tty itself, if we have that.
Otherwise, use the pty to get the pgrp.
On pfa systems, saka@pfu.fujitsu.co.JP writes:
But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
His patch indicates that if TIOCGPGRP returns an error, then
we should just assume that p->pid is also the process group id. */
- {
- int err;
- if (!NILP (p->subtty))
- err = ioctl (XFASTINT (p->subtty), TIOCGPGRP, &gid);
- else
- err = ioctl (XINT (p->infd), TIOCGPGRP, &gid);
-
- if (err == -1)
- /* If we can't get the information, assume
- the shell owns the tty. */
- gid = XFASTINT (p->pid);
- }
+ gid = emacs_get_tty_pgrp (p);
+
+ if (gid == -1)
+ /* If we can't get the information, assume
+ the shell owns the tty. */
+ gid = XFASTINT (p->pid);
/* It is not clear whether anything really can set GID to -1.
Perhaps on some system one of those ioctls can or could do so.
/* gid may be a pid, or minus a pgrp's number */
#ifdef TIOCSIGSEND
if (!NILP (current_group))
- ioctl (XINT (p->infd), TIOCSIGSEND, signo);
+ {
+ if (ioctl (XINT (p->infd), TIOCSIGSEND, signo) == -1)
+ EMACS_KILLPG (gid, signo);
+ }
else
{
gid = - XFASTINT (p->pid);
DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
doc: /* Stop process PROCESS. May be process or name of one.
-See function `interrupt-process' for more details on usage.
+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;
if (PROCESSP (process) && NETCONN_P (process))
{
struct Lisp_Process *p;
-
+
p = XPROCESS (process);
if (NILP (p->command)
&& XINT (p->infd) >= 0)
DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
doc: /* Continue process PROCESS. May be process or name of one.
-See function `interrupt-process' for more details on usage.
+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;
}
DEFUN ("signal-process", Fsignal_process, Ssignal_process,
- 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.
+ 2, 2, "sProcess (name or number): \nnSignal code: ",
+ doc: /* Send PROCESS the signal with code SIGCODE.
+PROCESS may also be an integer specifying the process id of the
+process to signal; in this case, 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;
+ (process, sigcode)
+ Lisp_Object process, sigcode;
{
- CHECK_NUMBER (pid);
+ Lisp_Object pid;
+
+ if (INTEGERP (process))
+ {
+ pid = process;
+ goto got_it;
+ }
+
+ if (STRINGP (process))
+ {
+ Lisp_Object tem;
+ if (tem = Fget_process (process), NILP (tem))
+ {
+ pid = Fstring_to_number (process, make_number (10));
+ if (XINT (pid) != 0)
+ goto got_it;
+ }
+ process = tem;
+ }
+ else
+ process = get_process (process);
+
+ if (NILP (process))
+ return process;
+
+ CHECK_PROCESS (process);
+ pid = XPROCESS (process)->pid;
+ if (!INTEGERP (pid) || XINT (pid) <= 0)
+ error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
+
+ got_it:
#define handle_signal(NAME, VALUE) \
else if (!strcmp (name, NAME)) \
/* 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.
#define WUNTRACED 0
#endif /* no WUNTRACED */
/* Keep trying to get a status until we get a definitive result. */
- do
+ do
{
errno = 0;
pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
break;
p = 0;
}
-
+
/* Change the status of the process that was found. */
if (p != 0)
{
union { int i; WAITTYPE wt; } u;
int clear_desc_flag = 0;
-
+
XSETINT (p->tick, ++process_tick);
u.wt = w;
XSETINT (p->raw_status_low, u.i & 0xffff);
XSETINT (p->raw_status_high, u.i >> 16);
-
+
/* If process has terminated, stop waiting for its output. */
if ((WIFSIGNALED (w) || WIFEXITED (w))
&& XINT (p->infd) >= 0)
error ("Input file descriptor of %s closed", SDATA (p->name));
if (XINT (p->outfd) < 0)
error ("Output file descriptor of %s closed", SDATA (p->name));
+ Fcheck_coding_system (decoding);
+ Fcheck_coding_system (encoding);
- p->decode_coding_system = Fcheck_coding_system (decoding);
- p->encode_coding_system = Fcheck_coding_system (encoding);
- setup_coding_system (decoding,
- proc_decode_coding_system[XINT (p->infd)]);
- setup_coding_system (encoding,
- proc_encode_coding_system[XINT (p->outfd)]);
+ p->decode_coding_system = decoding;
+ p->encode_coding_system = encoding;
+ setup_process_coding_systems (proc);
return Qnil;
}
return Fcons (XPROCESS (proc)->decode_coding_system,
XPROCESS (proc)->encode_coding_system);
}
+
+DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
+ Sset_process_filter_multibyte, 2, 2, 0,
+ doc: /* Set multibyteness of the strings given to PROCESS's filter.
+If FLAG is non-nil, the filter is given multibyte strings.
+If FLAG is nil, the filter is given unibyte strings. In this case,
+all character code conversion except for end-of-line conversion is
+suppressed. */)
+ (proc, flag)
+ Lisp_Object proc, flag;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+ p->filter_multibyte = flag;
+ setup_process_coding_systems (proc);
+
+ return Qnil;
+}
+
+DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
+ Sprocess_filter_multibyte_p, 1, 1, 0,
+ doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
+ (proc)
+ Lisp_Object proc;
+{
+ register struct Lisp_Process *p;
+
+ CHECK_PROCESS (proc);
+ p = XPROCESS (proc);
+
+ return (NILP (p->filter_multibyte) ? Qnil : Qt);
+}
+
+
\f
/* The first time this is called, assume keyboard input comes from DESC
instead of from where we used to expect it.
#ifdef HAVE_SOCKETS
{
Lisp_Object subfeatures = Qnil;
+ struct socket_options *sopt;
+
#define ADD_SUBFEATURE(key, val) \
subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
#if !defined(TERM) && (defined(O_NONBLOCK) || defined(O_NDELAY))
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
+
+ for (sopt = socket_options; sopt->name; sopt++)
+ subfeatures = Fcons (intern (sopt->name), subfeatures);
+
Fprovide (intern ("make-network-process"), subfeatures);
}
#endif /* HAVE_SOCKETS */
staticpro (&QCstop);
QCoptions = intern (":options");
staticpro (&QCoptions);
-
+ QCplist = intern (":plist");
+ staticpro (&QCplist);
+ QCfilter_multibyte = intern (":filter-multibyte");
+ staticpro (&QCfilter_multibyte);
+
Qlast_nonmenu_event = intern ("last-nonmenu-event");
staticpro (&Qlast_nonmenu_event);
defsubr (&Sset_process_query_on_exit_flag);
defsubr (&Sprocess_query_on_exit_flag);
defsubr (&Sprocess_contact);
+ defsubr (&Sprocess_plist);
+ defsubr (&Sset_process_plist);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
#ifdef HAVE_SOCKETS
- defsubr (&Sset_network_process_options);
+ defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
+ defsubr (&Sformat_network_address);
#endif /* HAVE_SOCKETS */
+#if defined(HAVE_SOCKETS) && defined(HAVE_NET_IF_H) && defined(HAVE_SYS_IOCTL_H)
+#ifdef SIOCGIFCONF
+ defsubr (&Snetwork_interface_list);
+#endif
+#if defined(SIOCGIFADDR) || defined(SIOCGIFHWADDR) || defined(SIOCGIFFLAGS)
+ defsubr (&Snetwork_interface_info);
+#endif
+#endif /* HAVE_SOCKETS ... */
#ifdef DATAGRAM_SOCKETS
defsubr (&Sprocess_datagram_address);
defsubr (&Sset_process_datagram_address);
/* defsubr (&Sprocess_connection); */
defsubr (&Sset_process_coding_system);
defsubr (&Sprocess_coding_system);
+ defsubr (&Sset_process_filter_multibyte);
+ defsubr (&Sprocess_filter_multibyte_p);
}
\f
int xerrno;
/* 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;
+ Lisp_Object wait_for_cell;
+
+ wait_for_cell = Qnil;
/* If waiting for non-nil in a cell, record where. */
if (CONSP (read_kbd))
}
/* Turn off periodic alarms (in case they are in use)
+ and then turn off any other atimers,
because the select emulator uses alarms. */
+ stop_polling ();
turn_on_atimers (0);
while (1)
\f
#endif /* not subprocesses */
+
+/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
+ (do not change this comment) */