process.c

/* Asynchronous subprocess control for GNU Emacs.

Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2017 Free Software
Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>

#include <stdio.h>
#include <stdlib.h>
#include <errno.h>
#include <sys/types.h>		/* Some typedefs are used in sys/file.h.  */
#include <sys/file.h>
#include <sys/stat.h>
#include <unistd.h>
#include <fcntl.h>

#include "lisp.h"

/* Only MS-DOS does not define `subprocesses'.  */
#ifdef subprocesses

#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>

#ifdef HAVE_SETRLIMIT
# include <sys/resource.h>

/* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
   NOFILE_LIMIT is the initial limit on the number of open files,
   which should be restored in child processes.  */
static struct rlimit nofile_limit;
#endif

/* Are local (unix) sockets supported?  */
#if defined (HAVE_SYS_UN_H)
#if !defined (AF_LOCAL) && defined (AF_UNIX)
#define AF_LOCAL AF_UNIX
#endif
#ifdef AF_LOCAL
#define HAVE_LOCAL_SOCKETS
#include <sys/un.h>
#endif
#endif

#include <sys/ioctl.h>
#if defined (HAVE_NET_IF_H)
#include <net/if.h>
#endif /* HAVE_NET_IF_H */

#if defined (HAVE_IFADDRS_H)
/* Must be after net/if.h */
#include <ifaddrs.h>

/* We only use structs from this header when we use getifaddrs.  */
#if defined (HAVE_NET_IF_DL_H)
#include <net/if_dl.h>
#endif

#endif

#ifdef NEED_BSDTTY
#include <bsdtty.h>
#endif

#ifdef USG5_4
# include <sys/stream.h>
# include <sys/stropts.h>
#endif

#ifdef HAVE_UTIL_H
#include <util.h>
#endif

#ifdef HAVE_PTY_H
#include <pty.h>
#endif

#include <c-ctype.h>
#include <flexmember.h>
#include <sig2str.h>
#include <verify.h>

#endif	/* subprocesses */

#include "systime.h"
#include "systty.h"

#include "window.h"
#include "character.h"
#include "buffer.h"
#include "coding.h"
#include "process.h"
#include "frame.h"
#include "termopts.h"
#include "keyboard.h"
#include "blockinput.h"
#include "atimer.h"
#include "sysselect.h"
#include "syssignal.h"
#include "syswait.h"
#ifdef HAVE_GNUTLS
#include "gnutls.h"
#endif

#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */

#ifdef HAVE_GLIB
#include "xgselect.h"
#ifndef WINDOWSNT
#include <glib.h>
#endif
#endif

#if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
/* This is 0.1s in nanoseconds. */
#define ASYNC_RETRY_NSEC 100000000
#endif

#ifdef WINDOWSNT
extern int sys_select (int, fd_set *, fd_set *, fd_set *,
                       const struct timespec *, const sigset_t *);
#endif

/* Work around GCC 4.3.0 bug with strict overflow checking; see
   <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
   This bug appears to be fixed in GCC 5.1, so don't work around it there.  */
#if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
# pragma GCC diagnostic ignored "-Wstrict-overflow"
#endif

/* True if keyboard input is on hold, zero otherwise.  */

static bool kbd_is_on_hold;

/* Nonzero means don't run process sentinels.  This is used
   when exiting.  */
bool inhibit_sentinels;

#ifdef subprocesses

#ifndef SOCK_CLOEXEC
# define SOCK_CLOEXEC 0
#endif
#ifndef SOCK_NONBLOCK
# define SOCK_NONBLOCK 0
#endif

/* True if ERRNUM represents an error where the system call would
   block if a blocking variant were used.  */
static bool
would_block (int errnum)
{
#ifdef EWOULDBLOCK
  if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
    return true;
#endif
  return errnum == EAGAIN;
}

#ifndef HAVE_ACCEPT4

/* Emulate GNU/Linux accept4 and socket well enough for this module.  */

static int
close_on_exec (int fd)
{
  if (0 <= fd)
    fcntl (fd, F_SETFD, FD_CLOEXEC);
  return fd;
}

# undef accept4
# define accept4(sockfd, addr, addrlen, flags) \
    process_accept4 (sockfd, addr, addrlen, flags)
static int
accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
{
  return close_on_exec (accept (sockfd, addr, addrlen));
}

static int
process_socket (int domain, int type, int protocol)
{
  return close_on_exec (socket (domain, type, protocol));
}
# undef socket
# define socket(domain, type, protocol) process_socket (domain, type, protocol)
#endif

#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
#define NETCONN1_P(p) (EQ (p->type, Qnetwork))
#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
#define SERIALCONN1_P(p) (EQ (p->type, Qserial))
#define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
#define PIPECONN1_P(p) (EQ (p->type, Qpipe))

/* Number of events of change of status of a process.  */
static EMACS_INT process_tick;
/* Number of events for which the user or sentinel has been notified.  */
static EMACS_INT update_tick;

/* 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.  */

#ifndef BROKEN_DATAGRAM_SOCKETS
# if defined HAVE_SELECT || defined USABLE_FIONREAD
#  if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
#   define DATAGRAM_SOCKETS
#  endif
# endif
#endif

#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
# define HAVE_SEQPACKET
#endif

#define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
#define READ_OUTPUT_DELAY_MAX       (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX   (READ_OUTPUT_DELAY_INCREMENT * 7)

/* Number of processes which have a non-zero read_output_delay,
   and therefore might be delayed for adaptive read buffering.  */

static int process_output_delay_count;

/* True if any process has non-nil read_output_skip.  */

static bool process_output_skip;

static void start_process_unwind (Lisp_Object);
static void create_process (Lisp_Object, char **, Lisp_Object);
#ifdef USABLE_SIGIO
static bool keyboard_bit_set (fd_set *);
#endif
static void deactivate_process (Lisp_Object);
static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
static void create_pty (Lisp_Object);
static void exec_sentinel (Lisp_Object, Lisp_Object);

/* Number of bits set in connect_wait_mask.  */
static int num_pending_connects;

/* The largest descriptor currently in use; -1 if none.  */
static int max_desc;

/* Set the external socket descriptor for Emacs to use when
   `make-network-process' is called with a non-nil
   `:use-external-socket' option.  The value should be either -1, or
   the file descriptor of a socket that is already bound.  */
static int external_sock_fd;

/* Indexed by descriptor, gives the process (if any) for that descriptor.  */
static Lisp_Object chan_process[FD_SETSIZE];
static void wait_for_socket_fds (Lisp_Object, char const *);

/* Alist of elements (NAME . PROCESS).  */
static Lisp_Object Vprocess_alist;

/* Buffered-ahead input char from process, indexed by channel.
   -1 means empty (no char is buffered).
   Used on sys V where the only way to tell if there is any
   output from the process is to read at least one char.
   Always -1 on systems that support FIONREAD.  */

static int proc_buffered_char[FD_SETSIZE];

/* Table of `struct coding-system' for each process.  */
static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
static struct coding_system *proc_encode_coding_system[FD_SETSIZE];

#ifdef DATAGRAM_SOCKETS
/* Table of `partner address' for datagram sockets.  */
static struct sockaddr_and_len {
  struct sockaddr *sa;
  ptrdiff_t len;
} datagram_address[FD_SETSIZE];
#define DATAGRAM_CHAN_P(chan)	(datagram_address[chan].sa != 0)
#define DATAGRAM_CONN_P(proc)                                           \
  (PROCESSP (proc) &&                                                   \
   XPROCESS (proc)->infd >= 0 &&                                        \
   datagram_address[XPROCESS (proc)->infd].sa != 0)
#else
#define DATAGRAM_CONN_P(proc)	(0)
#endif

/* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
   a `for' loop which iterates over processes from Vprocess_alist.  */

#define FOR_EACH_PROCESS(list_var, proc_var)			\
  FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)

/* These setters are used only in this file, so they can be private.  */
static void
pset_buffer (struct Lisp_Process *p, Lisp_Object val)
{
  p->buffer = val;
}
static void
pset_command (struct Lisp_Process *p, Lisp_Object val)
{
  p->command = val;
}
static void
pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
{
  p->decode_coding_system = val;
}
static void
pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
{
  p->decoding_buf = val;
}
static void
pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
{
  p->encode_coding_system = val;
}
static void
pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
{
  p->encoding_buf = val;
}
static void
pset_filter (struct Lisp_Process *p, Lisp_Object val)
{
  p->filter = NILP (val) ? Qinternal_default_process_filter : val;
}
static void
pset_log (struct Lisp_Process *p, Lisp_Object val)
{
  p->log = val;
}
static void
pset_mark (struct Lisp_Process *p, Lisp_Object val)
{
  p->mark = val;
}
static void
pset_thread (struct Lisp_Process *p, Lisp_Object val)
{
  p->thread = val;
}
static void
pset_name (struct Lisp_Process *p, Lisp_Object val)
{
  p->name = val;
}
static void
pset_plist (struct Lisp_Process *p, Lisp_Object val)
{
  p->plist = val;
}
static void
pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
{
  p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
}
static void
pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
{
  p->tty_name = val;
}
static void
pset_type (struct Lisp_Process *p, Lisp_Object val)
{
  p->type = val;
}
static void
pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
{
  p->write_queue = val;
}
static void
pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
{
  p->stderrproc = val;
}


static Lisp_Object
make_lisp_proc (struct Lisp_Process *p)
{
  return make_lisp_ptr (p, Lisp_Vectorlike);
}

enum fd_bits
{
  /* Read from file descriptor.  */
  FOR_READ = 1,
  /* Write to file descriptor.  */
  FOR_WRITE = 2,
  /* This descriptor refers to a keyboard.  Only valid if FOR_READ is
     set.  */
  KEYBOARD_FD = 4,
  /* This descriptor refers to a process.  */
  PROCESS_FD = 8,
  /* A non-blocking connect.  Only valid if FOR_WRITE is set.  */
  NON_BLOCKING_CONNECT_FD = 16
};

static struct fd_callback_data
{
  fd_callback func;
  void *data;
  /* Flags from enum fd_bits.  */
  int flags;
  /* If this fd is locked to a certain thread, this points to it.
     Otherwise, this is NULL.  If an fd is locked to a thread, then
     only that thread is permitted to wait on it.  */
  struct thread_state *thread;
  /* If this fd is currently being selected on by a thread, this
     points to the thread.  Otherwise it is NULL.  */
  struct thread_state *waiting_thread;
} fd_callback_info[FD_SETSIZE];


/* Add a file descriptor FD to be monitored for when read is possible.
   When read is possible, call FUNC with argument DATA.  */

void
add_read_fd (int fd, fd_callback func, void *data)
{
  add_keyboard_wait_descriptor (fd);

  fd_callback_info[fd].func = func;
  fd_callback_info[fd].data = data;
}

static void
add_non_keyboard_read_fd (int fd)
{
  eassert (fd >= 0 && fd < FD_SETSIZE);
  eassert (fd_callback_info[fd].func == NULL);

  fd_callback_info[fd].flags &= ~KEYBOARD_FD;
  fd_callback_info[fd].flags |= FOR_READ;
  if (fd > max_desc)
    max_desc = fd;
}

static void
add_process_read_fd (int fd)
{
  add_non_keyboard_read_fd (fd);
  fd_callback_info[fd].flags |= PROCESS_FD;
}

/* Stop monitoring file descriptor FD for when read is possible.  */

void
delete_read_fd (int fd)
{
  delete_keyboard_wait_descriptor (fd);

  if (fd_callback_info[fd].flags == 0)
    {
      fd_callback_info[fd].func = 0;
      fd_callback_info[fd].data = 0;
    }
}

/* Add a file descriptor FD to be monitored for when write is possible.
   When write is possible, call FUNC with argument DATA.  */

void
add_write_fd (int fd, fd_callback func, void *data)
{
  eassert (fd >= 0 && fd < FD_SETSIZE);

  fd_callback_info[fd].func = func;
  fd_callback_info[fd].data = data;
  fd_callback_info[fd].flags |= FOR_WRITE;
  if (fd > max_desc)
    max_desc = fd;
}

static void
add_non_blocking_write_fd (int fd)
{
  eassert (fd >= 0 && fd < FD_SETSIZE);
  eassert (fd_callback_info[fd].func == NULL);

  fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
  if (fd > max_desc)
    max_desc = fd;
  ++num_pending_connects;
}

static void
recompute_max_desc (void)
{
  int fd;

  for (fd = max_desc; fd >= 0; --fd)
    {
      if (fd_callback_info[fd].flags != 0)
	{
	  max_desc = fd;
	  break;
	}
    }
}

/* Stop monitoring file descriptor FD for when write is possible.  */

void
delete_write_fd (int fd)
{
  if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
    {
      if (--num_pending_connects < 0)
	emacs_abort ();
    }
  fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
  if (fd_callback_info[fd].flags == 0)
    {
      fd_callback_info[fd].func = 0;
      fd_callback_info[fd].data = 0;

      if (fd == max_desc)
	recompute_max_desc ();
    }
}

static void
compute_input_wait_mask (fd_set *mask)
{
  int fd;

  FD_ZERO (mask);
  for (fd = 0; fd <= max_desc; ++fd)
    {
      if (fd_callback_info[fd].thread != NULL
	  && fd_callback_info[fd].thread != current_thread)
	continue;
      if (fd_callback_info[fd].waiting_thread != NULL
	  && fd_callback_info[fd].waiting_thread != current_thread)
	continue;
      if ((fd_callback_info[fd].flags & FOR_READ) != 0)
	{
	  FD_SET (fd, mask);
	  fd_callback_info[fd].waiting_thread = current_thread;
	}
    }
}

static void
compute_non_process_wait_mask (fd_set *mask)
{
  int fd;

  FD_ZERO (mask);
  for (fd = 0; fd <= max_desc; ++fd)
    {
      if (fd_callback_info[fd].thread != NULL
	  && fd_callback_info[fd].thread != current_thread)
	continue;
      if (fd_callback_info[fd].waiting_thread != NULL
	  && fd_callback_info[fd].waiting_thread != current_thread)
	continue;
      if ((fd_callback_info[fd].flags & FOR_READ) != 0
	  && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
	{
	  FD_SET (fd, mask);
	  fd_callback_info[fd].waiting_thread = current_thread;
	}
    }
}

static void
compute_non_keyboard_wait_mask (fd_set *mask)
{
  int fd;

  FD_ZERO (mask);
  for (fd = 0; fd <= max_desc; ++fd)
    {
      if (fd_callback_info[fd].thread != NULL
	  && fd_callback_info[fd].thread != current_thread)
	continue;
      if (fd_callback_info[fd].waiting_thread != NULL
	  && fd_callback_info[fd].waiting_thread != current_thread)
	continue;
      if ((fd_callback_info[fd].flags & FOR_READ) != 0
	  && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
	{
	  FD_SET (fd, mask);
	  fd_callback_info[fd].waiting_thread = current_thread;
	}
    }
}

static void
compute_write_mask (fd_set *mask)
{
  int fd;

  FD_ZERO (mask);
  for (fd = 0; fd <= max_desc; ++fd)
    {
      if (fd_callback_info[fd].thread != NULL
	  && fd_callback_info[fd].thread != current_thread)
	continue;
      if (fd_callback_info[fd].waiting_thread != NULL
	  && fd_callback_info[fd].waiting_thread != current_thread)
	continue;
      if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
	{
	  FD_SET (fd, mask);
	  fd_callback_info[fd].waiting_thread = current_thread;
	}
    }
}

static void
clear_waiting_thread_info (void)
{
  int fd;

  for (fd = 0; fd <= max_desc; ++fd)
    {
      if (fd_callback_info[fd].waiting_thread == current_thread)
	fd_callback_info[fd].waiting_thread = NULL;
    }
}


/* Compute the Lisp form of the process status, p->status, from
   the numeric status that was returned by `wait'.  */

static Lisp_Object status_convert (int);

static void
update_status (struct Lisp_Process *p)
{
  eassert (p->raw_status_new);
  pset_status (p, status_convert (p->raw_status));
  p->raw_status_new = 0;
}

/*  Convert a process status word in Unix format to
    the list that we use internally.  */

static Lisp_Object
status_convert (int w)
{
  if (WIFSTOPPED (w))
    return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
  else if (WIFEXITED (w))
    return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
				WCOREDUMP (w) ? Qt : Qnil));
  else if (WIFSIGNALED (w))
    return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
				  WCOREDUMP (w) ? Qt : Qnil));
  else
    return Qrun;
}

/* True if STATUS is that of a process attempting connection.  */

static bool
connecting_status (Lisp_Object status)
{
  return CONSP (status) && EQ (XCAR (status), Qconnect);
}

/* Given a status-list, extract the three pieces of information
   and store them individually through the three pointers.  */

static void
decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
	       bool *coredump)
{
  Lisp_Object tem;

  if (connecting_status (l))
    l = XCAR (l);

  if (SYMBOLP (l))
    {
      *symbol = l;
      *code = make_number (0);
      *coredump = 0;
    }
  else
    {
      *symbol = XCAR (l);
      tem = XCDR (l);
      *code = XCAR (tem);
      tem = XCDR (tem);
      *coredump = !NILP (tem);
    }
}

/* Return a string describing a process status list.  */

static Lisp_Object
status_message (struct Lisp_Process *p)
{
  Lisp_Object status = p->status;
  Lisp_Object symbol, code;
  bool coredump;
  Lisp_Object string;

  decode_status (status, &symbol, &code, &coredump);

  if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
    {
      char const *signame;
      synchronize_system_messages_locale ();
      signame = strsignal (XFASTINT (code));
      if (signame == 0)
	string = build_string ("unknown");
      else
	{
	  int c1, c2;

	  string = build_unibyte_string (signame);
	  if (! NILP (Vlocale_coding_system))
	    string = (code_convert_string_norecord
		      (string, Vlocale_coding_system, 0));
	  c1 = STRING_CHAR (SDATA (string));
	  c2 = downcase (c1);
	  if (c1 != c2)
	    Faset (string, make_number (0), make_number (c2));
	}
      AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
      return concat2 (string, suffix);
    }
  else if (EQ (symbol, Qexit))
    {
      if (NETCONN1_P (p))
	return build_string (XFASTINT (code) == 0
			     ? "deleted\n"
			     : "connection broken by remote peer\n");
      if (XFASTINT (code) == 0)
	return build_string ("finished\n");
      AUTO_STRING (prefix, "exited abnormally with code ");
      string = Fnumber_to_string (code);
      AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
      return concat3 (prefix, string, suffix);
    }
  else if (EQ (symbol, Qfailed))
    {
      AUTO_STRING (format, "failed with code %s\n");
      return CALLN (Fformat, format, code);
    }
  else
    return Fcopy_sequence (Fsymbol_name (symbol));
}

enum { PTY_NAME_SIZE = 24 };

/* Open an available pty, returning a file descriptor.
   Store into PTY_NAME the file name of the terminal corresponding to the pty.
   Return -1 on failure.  */

static int
allocate_pty (char pty_name[PTY_NAME_SIZE])
{
#ifdef HAVE_PTYS
  int fd;

#ifdef PTY_ITERATION
  PTY_ITERATION
#else
  register int c, i;
  for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
    for (i = 0; i < 16; i++)
#endif
      {
#ifdef PTY_NAME_SPRINTF
	PTY_NAME_SPRINTF
#else
	sprintf (pty_name, "/dev/pty%c%x", c, i);
#endif /* no PTY_NAME_SPRINTF */

#ifdef PTY_OPEN
	PTY_OPEN;
#else /* no PTY_OPEN */
	fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
#endif /* no PTY_OPEN */

	if (fd >= 0)
	  {
#ifdef PTY_TTY_NAME_SPRINTF
	    PTY_TTY_NAME_SPRINTF
#else
	    sprintf (pty_name, "/dev/tty%c%x", c, i);
#endif /* no PTY_TTY_NAME_SPRINTF */

	    /* Set FD's close-on-exec flag.  This is needed even if
	       PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
	       doesn't require support for that combination.
	       Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
	       doesn't work if the close-on-exec flag is set (Bug#20555).
	       Multithreaded platforms where posix_openpt ignores
	       O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
	       have a race condition between the PTY_OPEN and here.  */
	    fcntl (fd, F_SETFD, FD_CLOEXEC);

	    /* Check to make certain that both sides are available.
	       This avoids a nasty yet stupid bug in rlogins.  */
	    if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
	      {
		emacs_close (fd);
		continue;
	      }
	    setup_pty (fd);
	    return fd;
	  }
      }
#endif /* HAVE_PTYS */
  return -1;
}

/* Allocate basically initialized process.  */

static struct Lisp_Process *
allocate_process (void)
{
  return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
}

static Lisp_Object
make_process (Lisp_Object name)
{
  struct Lisp_Process *p = allocate_process ();
  /* Initialize Lisp data.  Note that allocate_process initializes all
     Lisp data to nil, so do it only for slots which should not be nil.  */
  pset_status (p, Qrun);
  pset_mark (p, Fmake_marker ());
  pset_thread (p, Fcurrent_thread ());

  /* Initialize non-Lisp data.  Note that allocate_process zeroes out all
     non-Lisp data, so do it only for slots which should not be zero.  */
  p->infd = -1;
  p->outfd = -1;
  for (int i = 0; i < PROCESS_OPEN_FDS; i++)
    p->open_fd[i] = -1;

#ifdef HAVE_GNUTLS
  verify (GNUTLS_STAGE_EMPTY == 0);
  eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
  eassert (NILP (p->gnutls_boot_parameters));
#endif

  /* If name is already in use, modify it until it is unused.  */

  Lisp_Object name1 = name;
  for (printmax_t i = 1; ; i++)
    {
      Lisp_Object tem = Fget_process (name1);
      if (NILP (tem))
	break;
      char const suffix_fmt[] = "<%"pMd">";
      char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
      AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
      name1 = concat2 (name, lsuffix);
    }
  name = name1;
  pset_name (p, name);
  pset_sentinel (p, Qinternal_default_process_sentinel);
  pset_filter (p, Qinternal_default_process_filter);
  Lisp_Object val;
  XSETPROCESS (val, p);
  Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
  return val;
}

static void
remove_process (register Lisp_Object proc)
{
  register Lisp_Object pair;

  pair = Frassq (proc, Vprocess_alist);
  Vprocess_alist = Fdelq (pair, Vprocess_alist);

  deactivate_process (proc);
}

void
update_processes_for_thread_death (Lisp_Object dying_thread)
{
  Lisp_Object pair;

  for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
    {
      Lisp_Object process = XCDR (XCAR (pair));
      if (EQ (XPROCESS (process)->thread, dying_thread))
	{
	  struct Lisp_Process *proc = XPROCESS (process);

	  pset_thread (proc, Qnil);
	  if (proc->infd >= 0)
	    fd_callback_info[proc->infd].thread = NULL;
	  if (proc->outfd >= 0)
	    fd_callback_info[proc->outfd].thread = NULL;
	}
    }
}

#ifdef HAVE_GETADDRINFO_A
static void
free_dns_request (Lisp_Object proc)
{
  struct Lisp_Process *p = XPROCESS (proc);

  if (p->dns_request->ar_result)
    freeaddrinfo (p->dns_request->ar_result);
  xfree (p->dns_request);
  p->dns_request = NULL;
}
#endif


DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
       doc: /* Return t if OBJECT is a process.  */)
  (Lisp_Object object)
{
  return PROCESSP (object) ? Qt : Qnil;
}

DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
       doc: /* Return the process named NAME, or nil if there is none.  */)
  (register Lisp_Object name)
{
  if (PROCESSP (name))
    return name;
  CHECK_STRING (name);
  return Fcdr (Fassoc (name, Vprocess_alist));
}

/* This is how commands for the user decode process arguments.  It
   accepts a process, a process name, a buffer, a buffer name, or nil.
   Buffers denote the first process in the buffer, and nil denotes the
   current buffer.  */

static Lisp_Object
get_process (register Lisp_Object name)
{
  register Lisp_Object proc, obj;
  if (STRINGP (name))
    {
      obj = Fget_process (name);
      if (NILP (obj))
	obj = Fget_buffer (name);
      if (NILP (obj))
	error ("Process %s does not exist", SDATA (name));
    }
  else if (NILP (name))
    obj = Fcurrent_buffer ();
  else
    obj = name;

  /* Now obj should be either a buffer object or a process object.  */
  if (BUFFERP (obj))
    {
      if (NILP (BVAR (XBUFFER (obj), name)))
        error ("Attempt to get process for a dead buffer");
      proc = Fget_buffer_process (obj);
      if (NILP (proc))