comparison src/process.c @ 109353:d43e7dfda4f1

merge trunk

109352:2803d726899d

along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>
#include <signal.h>

/* This file is split into two parts by the following preprocessor
   conditional.  The 'then' clause contains all of the support for
   asynchronous subprocesses.  The 'else' clause contains stub
   versions of some of the asynchronous subprocess routines that are
   often called elsewhere in Emacs, so we don't have to #ifdef the
   sections that call them.  */


#ifdef subprocesses

#include <stdio.h>
#include <errno.h>
#include <setjmp.h>
#include <sys/types.h>		/* some typedefs are used in sys/file.h */
#include <sys/file.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <fcntl.h>

#ifdef HAVE_SOCKETS	/* TCP connection support, if kernel can do it */
#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>

#ifdef HAVE_RES_INIT
#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>
#endif

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

#include "keyboard.h"
#include "blockinput.h"
#include "dispextern.h"
#include "composite.h"
#include "atimer.h"

#if defined (USE_GTK) || defined (HAVE_GCONF)
#include "xgselect.h"
#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */

Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Lisp_Object Qlocal, Qipv4, Qdatagram, Qseqpacket;

Lisp_Object Qipv6;
#endif
Lisp_Object QCport, QCspeed, QCprocess;
Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
Lisp_Object QCname, QCbuffer, QChost, QCservice, QCtype;
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
Lisp_Object Qlast_nonmenu_event;
/* QCfamily is declared and initialized in xfaces.c,

/* QCfamily is defined in xfaces.c.  */
extern Lisp_Object QCfamily;
/* QCfilter is defined in keyboard.c.  */
extern Lisp_Object QCfilter;

Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;

#ifdef HAVE_SOCKETS
#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))

   testing SIGCHLD.  */

#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif /* SIGCLD */

#include "syssignal.h"

#include "syswait.h"

extern char *get_operating_system_release (void);

/* Serial processes require termios or Windows.  */
#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)

static Lisp_Object Vprocess_adaptive_read_buffering;
#else
#define process_output_delay_count 0
#endif


#include "sysselect.h"

static int keyboard_bit_set (SELECT_TYPE *);
static void deactivate_process (Lisp_Object);
static void status_notify (struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
static void create_pty (Lisp_Object);

#endif

static Lisp_Object get_process (register Lisp_Object name);
static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);

extern int timers_run;

/* Mask of bits indicating the descriptors that we wait for input on.  */

static SELECT_TYPE input_wait_mask;

/* Non-zero if keyboard input is on hold, zero otherwise.  */

static int kbd_is_on_hold;

/* Mask that excludes keyboard input descriptor(s).  */

static SELECT_TYPE non_keyboard_wait_mask;

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

#define IF_NON_BLOCKING_CONNECT(s) s
#else
#define IF_NON_BLOCKING_CONNECT(s)
#endif

/* The largest descriptor currently in use for a process object.  */
static int max_process_desc;

/* The largest descriptor currently in use for keyboard input.  */
static int max_keyboard_desc;

/* The largest descriptor currently in use for gpm mouse input.  */
static int max_gpm_desc;

/* Nonzero means delete a process right away if it exits.  */
static int delete_exited_processes;

/* Indexed by descriptor, gives the process (if any) for that descriptor */
Lisp_Object chan_process[MAXDESC];

/* Alist of elements (NAME . PROCESS) */

    return name;
  CHECK_STRING (name);
  return Fcdr (Fassoc (name, Vprocess_alist));
}

DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
       doc: /* Return the (or a) process associated with BUFFER.
BUFFER may be a buffer or the name of one.  */)
  (register Lisp_Object buffer)
{
  register Lisp_Object buf, tail, proc;

  if (NILP (buffer)) return Qnil;
  buf = Fget_buffer (buffer);
  if (NILP (buf)) return Qnil;

  for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
    {
      proc = Fcdr (XCAR (tail));
      if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
	return proc;
    }
  return Qnil;
}

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

  (register Lisp_Object process, Lisp_Object flag)
{
  CHECK_PROCESS (process);
  XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
  return flag;
}

DEFUN ("process-inherit-coding-system-flag",
       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.  */)
  (register Lisp_Object process)
{
  CHECK_PROCESS (process);
  return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
}

DEFUN ("set-process-query-on-exit-flag",
       Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
       2, 2, 0,

  register struct Lisp_Vector *p;

  /* Workaround for a bug in getsockname on BSD: Names bound to
     sockets in the UNIX domain are inaccessible; getsockname returns
     a zero length name.  */
  if (len < OFFSETOF (struct sockaddr, sa_family) + sizeof (sa->sa_family))
    return empty_unibyte_string;

  switch (sa->sa_family)
    {
    case AF_INET:

	    break;
	return make_unibyte_string (sockun->sun_path, i);
      }
#endif
    default:
      len -= OFFSETOF (struct sockaddr, sa_family) + 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->sa_family + sizeof (sa->sa_family);
      break;

      XPROCESS (proc)->outfd = new_outfd;
    }
  return process;
}

/* Kill all processes associated with `buffer'.
   If `buffer' is nil, kill all processes  */

void
kill_buffer_processes (Lisp_Object buffer)
{
  Lisp_Object tail, proc;

  for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
    {
      proc = XCDR (XCAR (tail));
      if (PROCESSP (proc)
	  && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
	{
	  if (NETCONN_P (proc) || SERIALCONN_P (proc))
	    Fdelete_process (proc);
	  else if (XPROCESS (proc)->infd >= 0)
	    process_send_signal (proc, SIGHUP, Qnil, 1);
	}
    }
}

/* 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.

  return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
}



/* Stop reading input from keyboard sources.  */

void
hold_keyboard_input (void)
{
  kbd_is_on_hold = 1;
}

/* Resume reading input from keyboard sources.  */

void
unhold_keyboard_input (void)
{
  kbd_is_on_hold = 0;
}

/* Return non-zero if keyboard input is on hold, zero otherwise.  */

int
kbd_on_hold_p (void)
{
  return kbd_is_on_hold;
}

/* Add DESC to the set of keyboard input descriptors.  */

void
add_keyboard_wait_descriptor (int desc)

	&& !FD_ISSET (fd, &non_keyboard_wait_mask))
      return 1;

  return 0;
}

/* Enumeration of and access to system processes a-la ps(1).  */

DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
       0, 0, 0,

 args    -- command line which invoked the process (string).  */)
  ( Lisp_Object pid)
{
  return system_process_attributes (pid);
}

void
init_process (void)
{
  register int i;

  inhibit_sentinels = 0;

#ifdef SIGCHLD

				    && release[1] == '.')) {
      Vprocess_connection_type = Qnil;
    }
  }
#endif
}

void
syms_of_process (void)
{
  Qprocessp = intern_c_string ("processp");
  staticpro (&Qprocessp);
  Qrun = intern_c_string ("run");
  staticpro (&Qrun);
  Qstop = intern_c_string ("stop");

  staticpro (&Qreal);
  Qnetwork = intern_c_string ("network");
  staticpro (&Qnetwork);
  Qserial = intern_c_string ("serial");
  staticpro (&Qserial);

  QCname = intern_c_string (":name");
  staticpro (&QCname);
  QCbuffer = intern_c_string (":buffer");
  staticpro (&QCbuffer);
  QChost = intern_c_string (":host");
  staticpro (&QChost);
  QCservice = intern_c_string (":service");
  staticpro (&QCservice);
  QCtype = intern_c_string (":type");
  staticpro (&QCtype);
  QClocal = intern_c_string (":local");
  staticpro (&QClocal);
  QCremote = intern_c_string (":remote");
  staticpro (&QCremote);
  QCcoding = intern_c_string (":coding");

  staticpro (&Vprocess_alist);
#ifdef SIGCHLD
  staticpro (&deleted_pid_list);
#endif

  Qeuid = intern_c_string ("euid");
  staticpro (&Qeuid);
  Qegid = intern_c_string ("egid");
  staticpro (&Qegid);

	       doc: /* *Non-nil means delete processes immediately when they exit.
A value of nil means don't delete them until `list-processes' is run.  */);

  delete_exited_processes = 1;

  DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
	       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.

  Vprocess_adaptive_read_buffering = Qt;
#endif

  defsubr (&Sprocessp);
  defsubr (&Sget_process);
  defsubr (&Sget_buffer_process);
  defsubr (&Sdelete_process);
  defsubr (&Sprocess_status);
  defsubr (&Sprocess_exit_status);
  defsubr (&Sprocess_id);
  defsubr (&Sprocess_name);

  defsubr (&Sprocess_filter);
  defsubr (&Sset_process_sentinel);
  defsubr (&Sprocess_sentinel);
  defsubr (&Sset_process_window_size);
  defsubr (&Sset_process_inherit_coding_system_flag);
  defsubr (&Sprocess_inherit_coding_system_flag);
  defsubr (&Sset_process_query_on_exit_flag);
  defsubr (&Sprocess_query_on_exit_flag);
  defsubr (&Sprocess_contact);
  defsubr (&Sprocess_plist);
  defsubr (&Sset_process_plist);

  defsubr (&Sprocess_type);
  defsubr (&Sset_process_coding_system);
  defsubr (&Sprocess_coding_system);
  defsubr (&Sset_process_filter_multibyte);
  defsubr (&Sprocess_filter_multibyte_p);
  defsubr (&Slist_system_processes);
  defsubr (&Sprocess_attributes);
}


#else /* not subprocesses */

#include <sys/types.h>
#include <errno.h>
#include <sys/stat.h>
#include <stdlib.h>
#include <fcntl.h>
#include <setjmp.h>
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif

#include "lisp.h"
#include "systime.h"
#include "character.h"
#include "coding.h"
#include "termopts.h"
#include "sysselect.h"

extern int frame_garbaged;

extern EMACS_TIME timer_check ();
extern int timers_run;

Lisp_Object QCtype, QCname;

Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;

/* Non-zero if keyboard input is on hold, zero otherwise.  */
static int kbd_is_on_hold;

/* As described above, except assuming that there are no subprocesses:

   Wait for timeout to elapse and/or keyboard input to be available.

   time_limit is:
     timeout in seconds, or
     zero for no limit, or
     -1 means gobble data immediately available but don't wait for any.

   read_kbd is a Lisp_Object:
     0 to ignore keyboard input, or
     1 to return when input is available, or
     -1 means caller will actually read the input, so don't throw to
       the quit handler.

   see full version for other parameters. We know that wait_proc will
     always be NULL, since `subprocesses' isn't defined.

   do_display != 0 means redisplay should be done to show subprocess
   output that arrives.

   Return true if we received input from any process.  */

int
wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
			     wait_for_cell, wait_proc, just_wait_proc)
     int time_limit, microsecs, read_kbd, do_display;
     Lisp_Object wait_for_cell;
     struct Lisp_Process *wait_proc;
     int just_wait_proc;
{
  register int nfds;
  EMACS_TIME end_time, timeout;
  SELECT_TYPE waitchannels;
  int xerrno;

  /* What does time_limit really mean?  */
  if (time_limit || microsecs)
    {
      EMACS_GET_TIME (end_time);
      EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
      EMACS_ADD_TIME (end_time, end_time, timeout);
    }

  /* 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)
    {
      int timeout_reduced_for_timers = 0;

      /* If calling from keyboard input, do not quit
	 since we want to return C-g as an input character.
	 Otherwise, do pending quit if requested.  */
      if (read_kbd >= 0)
	QUIT;

      /* Exit now if the cell we're waiting for became non-nil.  */
      if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
	break;

      /* Compute time from now till when time limit is up */
      /* Exit if already run out */
      if (time_limit == -1)
	{
	  /* -1 specified for timeout means
	     gobble output available now
	     but don't wait at all. */

	  EMACS_SET_SECS_USECS (timeout, 0, 0);
	}
      else if (time_limit || microsecs)
	{
	  EMACS_GET_TIME (timeout);
	  EMACS_SUB_TIME (timeout, end_time, timeout);
	  if (EMACS_TIME_NEG_P (timeout))
	    break;
	}
      else
	{
	  EMACS_SET_SECS_USECS (timeout, 100000, 0);
	}

      /* If our caller will not immediately handle keyboard events,
	 run timer events directly.
	 (Callers that will immediately read keyboard events
	 call timer_delay on their own.)  */
      if (NILP (wait_for_cell))
	{
	  EMACS_TIME timer_delay;

	  do
	    {
	      int old_timers_run = timers_run;
	      timer_delay = timer_check (1);
	      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.  */
		redisplay_preserve_echo_area (14);
	      else
		break;
	    }
	  while (!detect_input_pending ());

	  /* If there is unread keyboard input, also return.  */
	  if (read_kbd != 0
	      && requeued_events_pending_p ())
	    break;

	  if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
	    {
	      EMACS_TIME difference;
	      EMACS_SUB_TIME (difference, timer_delay, timeout);
	      if (EMACS_TIME_NEG_P (difference))
		{
		  timeout = timer_delay;
		  timeout_reduced_for_timers = 1;
		}
	    }
	}

      /* Cause C-g and alarm signals to take immediate action,
	 and cause input available signals to zero out timeout.  */
      if (read_kbd < 0)
	set_waiting_for_input (&timeout);

      /* Wait till there is something to do.  */

      if (! read_kbd && NILP (wait_for_cell))
	FD_ZERO (&waitchannels);
      else
	FD_SET (0, &waitchannels);

      /* If a frame has been newly mapped and needs updating,
	 reprocess its display stuff.  */
      if (frame_garbaged && do_display)
	{
	  clear_waiting_for_input ();
	  redisplay_preserve_echo_area (15);
	  if (read_kbd < 0)
	    set_waiting_for_input (&timeout);
	}

      if (read_kbd && detect_input_pending ())
	{
	  nfds = 0;
	  FD_ZERO (&waitchannels);
	}
      else
	nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
		       &timeout);

      xerrno = errno;

      /* Make C-g and alarm signals set flags again */
      clear_waiting_for_input ();

      /*  If we woke up due to SIGWINCH, actually change size now.  */
      do_pending_window_change (0);

      if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
	/* We waited the full specified time, so return now.  */
	break;

      if (nfds == -1)
	{
	  /* If the system call was interrupted, then go around the
	     loop again.  */
	  if (xerrno == EINTR)
	    FD_ZERO (&waitchannels);
	  else
	    error ("select error: %s", emacs_strerror (xerrno));
	}
#ifdef SOLARIS2
      else if (nfds > 0 && (waitchannels & 1)  && interrupt_input)
	/* System sometimes fails to deliver SIGIO.  */
	kill (getpid (), SIGIO);
#endif
#ifdef SIGIO
      if (read_kbd && interrupt_input && (waitchannels & 1))
	kill (getpid (), SIGIO);
#endif

      /* Check for keyboard input */

      if (read_kbd
	  && detect_input_pending_run_timers (do_display))
	{
	  swallow_events (do_display);
	  if (detect_input_pending_run_timers (do_display))
	    break;
	}

      /* If there is unread keyboard input, also return.  */
      if (read_kbd
	  && requeued_events_pending_p ())
	break;

      /* If wait_for_cell. check for keyboard input
	 but don't run any timers.
	 ??? (It seems wrong to me to check for keyboard
	 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 (! NILP (wait_for_cell)
	  && detect_input_pending ())
	{
	  swallow_events (do_display);
	  if (detect_input_pending ())
	    break;
	}

      /* Exit now if the cell we're waiting for became non-nil.  */
      if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
	break;
    }

  start_polling ();

  return 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!  */
DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
       0)
  (register Lisp_Object name)
{
  return Qnil;
}

  /* 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 ("process-inherit-coding-system-flag",
       Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
       1, 1, 0,
       0)
  (register Lisp_Object process)
{
  /* Ignore the argument and return the value of
     inherit-process-coding-system.  */
  return inherit_process_coding_system ? Qt : Qnil;
}

/* Kill all processes associated with `buffer'.
   If `buffer' is nil, kill all processes.
   Since we have no subprocesses, this does nothing.  */

void
kill_buffer_processes (buffer)
     Lisp_Object buffer;
{
}


/* Stop reading input from keyboard sources.  */

void
hold_keyboard_input (void)
{
  kbd_is_on_hold = 1;
}

/* Resume reading input from keyboard sources.  */

void
unhold_keyboard_input (void)
{
  kbd_is_on_hold = 0;
}

/* Return non-zero if keyboard input is on hold, zero otherwise.  */

int
kbd_on_hold_p (void)
{
  return kbd_is_on_hold;
}

DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
       0, 0, 0,
       doc: /* Return a list of numerical process IDs of all running processes.
If this functionality is unsupported, return nil.

See `process-attributes' for getting attributes of a process given its ID.  */)
  (void)
{
  return list_system_processes ();
}

DEFUN ("process-attributes", Fprocess_attributes,
       Sprocess_attributes, 1, 1, 0,
       doc: /* Return attributes of the process given by its PID, a number.

Value is an alist where each element is a cons cell of the form

    \(KEY . VALUE)

If this functionality is unsupported, the value is nil.

See `list-system-processes' for getting a list of all process IDs.

The KEYs of the attributes that this function may return are listed
below, together with the type of the associated VALUE (in parentheses).
Not all platforms support all of these attributes; unsupported
attributes will not appear in the returned alist.
Unless explicitly indicated otherwise, numbers can have either
integer or floating point values.

 euid    -- Effective user User ID of the process (number)
 user    -- User name corresponding to euid (string)
 egid    -- Effective user Group ID of the process (number)
 group   -- Group name corresponding to egid (string)
 comm    -- Command name (executable name only) (string)
 state   -- Process state code, such as "S", "R", or "T" (string)
 ppid    -- Parent process ID (number)
 pgrp    -- Process group ID (number)
 sess    -- Session ID, i.e. process ID of session leader (number)
 ttname  -- Controlling tty name (string)
 tpgid   -- ID of foreground process group on the process's tty (number)
 minflt  -- number of minor page faults (number)
 majflt  -- number of major page faults (number)
 cminflt -- cumulative number of minor page faults (number)
 cmajflt -- cumulative number of major page faults (number)
 utime   -- user time used by the process, in the (HIGH LOW USEC) format
 stime   -- system time used by the process, in the (HIGH LOW USEC) format
 time    -- sum of utime and stime, in the (HIGH LOW USEC) format
 cutime  -- user time used by the process and its children, (HIGH LOW USEC)
 cstime  -- system time used by the process and its children, (HIGH LOW USEC)
 ctime   -- sum of cutime and cstime, in the (HIGH LOW USEC) format
 pri     -- priority of the process (number)
 nice    -- nice value of the process (number)
 thcount -- process thread count (number)
 start   -- time the process started, in the (HIGH LOW USEC) format
 vsize   -- virtual memory size of the process in KB's (number)
 rss     -- resident set size of the process in KB's (number)
 etime   -- elapsed time the process is running, in (HIGH LOW USEC) format
 pcpu    -- percents of CPU time used by the process (floating-point number)
 pmem    -- percents of total physical memory used by process's resident set
              (floating-point number)
 args    -- command line which invoked the process (string).   */)
  ( Lisp_Object pid)
{
  return system_process_attributes (pid);
}

void
init_process ()
{
  kbd_is_on_hold = 0;
}

void
syms_of_process ()
{
  QCtype = intern_c_string (":type");
  staticpro (&QCtype);
  QCname = intern_c_string (":name");
  staticpro (&QCname);
  QCtype = intern_c_string (":type");
  staticpro (&QCtype);
  QCname = intern_c_string (":name");
  staticpro (&QCname);
  Qeuid = intern_c_string ("euid");
  staticpro (&Qeuid);
  Qegid = intern_c_string ("egid");
  staticpro (&Qegid);
  Quser = intern_c_string ("user");
  staticpro (&Quser);
  Qgroup = intern_c_string ("group");
  staticpro (&Qgroup);
  Qcomm = intern_c_string ("comm");
  staticpro (&Qcomm);
  Qstate = intern_c_string ("state");
  staticpro (&Qstate);
  Qppid = intern_c_string ("ppid");
  staticpro (&Qppid);
  Qpgrp = intern_c_string ("pgrp");
  staticpro (&Qpgrp);
  Qsess = intern_c_string ("sess");
  staticpro (&Qsess);
  Qttname = intern_c_string ("ttname");
  staticpro (&Qttname);
  Qtpgid = intern_c_string ("tpgid");
  staticpro (&Qtpgid);
  Qminflt = intern_c_string ("minflt");
  staticpro (&Qminflt);
  Qmajflt = intern_c_string ("majflt");
  staticpro (&Qmajflt);
  Qcminflt = intern_c_string ("cminflt");
  staticpro (&Qcminflt);
  Qcmajflt = intern_c_string ("cmajflt");
  staticpro (&Qcmajflt);
  Qutime = intern_c_string ("utime");
  staticpro (&Qutime);
  Qstime = intern_c_string ("stime");
  staticpro (&Qstime);
  Qtime = intern_c_string ("time");
  staticpro (&Qtime);
  Qcutime = intern_c_string ("cutime");
  staticpro (&Qcutime);
  Qcstime = intern_c_string ("cstime");
  staticpro (&Qcstime);
  Qctime = intern_c_string ("ctime");
  staticpro (&Qctime);
  Qpri = intern_c_string ("pri");
  staticpro (&Qpri);
  Qnice = intern_c_string ("nice");
  staticpro (&Qnice);
  Qthcount = intern_c_string ("thcount");
  staticpro (&Qthcount);
  Qstart = intern_c_string ("start");
  staticpro (&Qstart);
  Qvsize = intern_c_string ("vsize");
  staticpro (&Qvsize);
  Qrss = intern_c_string ("rss");
  staticpro (&Qrss);
  Qetime = intern_c_string ("etime");
  staticpro (&Qetime);
  Qpcpu = intern_c_string ("pcpu");
  staticpro (&Qpcpu);
  Qpmem = intern_c_string ("pmem");
  staticpro (&Qpmem);
  Qargs = intern_c_string ("args");
  staticpro (&Qargs);

  defsubr (&Sget_buffer_process);
  defsubr (&Sprocess_inherit_coding_system_flag);
  defsubr (&Slist_system_processes);
  defsubr (&Sprocess_attributes);
}


#endif /* not subprocesses */

/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
   (do not change this comment) */

109353:d43e7dfda4f1

along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */


#include <config.h>
#include <signal.h>
#include <stdio.h>
#include <errno.h>
#include <setjmp.h>
#include <sys/types.h>		/* some typedefs are used in sys/file.h */
#include <sys/file.h>

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <fcntl.h>

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

#ifdef HAVE_SOCKETS	/* TCP connection support, if kernel can do it */
#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>

#ifdef HAVE_RES_INIT
#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>
#endif

#endif	/* subprocesses */

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

#include "keyboard.h"
#include "blockinput.h"
#include "dispextern.h"
#include "composite.h"
#include "atimer.h"
#include "sysselect.h"
#include "syssignal.h"
#include "syswait.h"

#if defined (USE_GTK) || defined (HAVE_GCONF)
#include "xgselect.h"
#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */

#ifdef subprocesses

Lisp_Object Qprocessp;
Lisp_Object Qrun, Qstop, Qsignal;
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Lisp_Object Qlocal, Qipv4, Qdatagram, Qseqpacket;

Lisp_Object Qipv6;
#endif
Lisp_Object QCport, QCspeed, QCprocess;
Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
Lisp_Object QCbuffer, QChost, QCservice;
Lisp_Object QClocal, QCremote, QCcoding;
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
Lisp_Object Qlast_nonmenu_event;
/* QCfamily is declared and initialized in xfaces.c,

/* QCfamily is defined in xfaces.c.  */
extern Lisp_Object QCfamily;
/* QCfilter is defined in keyboard.c.  */
extern Lisp_Object QCfilter;

#ifdef HAVE_SOCKETS
#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))

   testing SIGCHLD.  */

#if !defined (SIGCHLD) && defined (SIGCLD)
#define SIGCHLD SIGCLD
#endif /* SIGCLD */

extern char *get_operating_system_release (void);

/* Serial processes require termios or Windows.  */
#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)

static Lisp_Object Vprocess_adaptive_read_buffering;
#else
#define process_output_delay_count 0
#endif

static int keyboard_bit_set (SELECT_TYPE *);
static void deactivate_process (Lisp_Object);
static void status_notify (struct Lisp_Process *);
static int read_process_output (Lisp_Object, int);
static void create_pty (Lisp_Object);

#endif

static Lisp_Object get_process (register Lisp_Object name);
static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);

#endif	/* subprocesses */

extern int timers_run;

Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
Lisp_Object QCname, QCtype;

/* Non-zero if keyboard input is on hold, zero otherwise.  */

static int kbd_is_on_hold;

/* Nonzero means delete a process right away if it exits.  */
static int delete_exited_processes;

#ifdef subprocesses

/* Mask of bits indicating the descriptors that we wait for input on.  */

static SELECT_TYPE input_wait_mask;

/* Mask that excludes keyboard input descriptor(s).  */

static SELECT_TYPE non_keyboard_wait_mask;

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

#define IF_NON_BLOCKING_CONNECT(s) s
#else  /* NON_BLOCKING_CONNECT */
#define IF_NON_BLOCKING_CONNECT(s)
#endif	/* NON_BLOCKING_CONNECT */

/* The largest descriptor currently in use for a process object.  */
static int max_process_desc;

/* The largest descriptor currently in use for keyboard input.  */
static int max_keyboard_desc;

/* The largest descriptor currently in use for gpm mouse input.  */
static int max_gpm_desc;

/* Indexed by descriptor, gives the process (if any) for that descriptor */
Lisp_Object chan_process[MAXDESC];

/* Alist of elements (NAME . PROCESS) */

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

  (register Lisp_Object process, Lisp_Object flag)
{
  CHECK_PROCESS (process);
  XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
  return flag;
}

DEFUN ("set-process-query-on-exit-flag",
       Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
       2, 2, 0,

  register struct Lisp_Vector *p;

  /* Workaround for a bug in getsockname on BSD: Names bound to
     sockets in the UNIX domain are inaccessible; getsockname returns
     a zero length name.  */
  if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
    return empty_unibyte_string;

  switch (sa->sa_family)
    {
    case AF_INET:

	    break;
	return make_unibyte_string (sockun->sun_path, i);
      }
#endif
    default:
      len -= offsetof (struct sockaddr, sa_family) + 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->sa_family + sizeof (sa->sa_family);
      break;

      XPROCESS (proc)->outfd = new_outfd;
    }
  return process;
}

/* 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.

  return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
}




/* Add DESC to the set of keyboard input descriptors.  */

void
add_keyboard_wait_descriptor (int desc)

	&& !FD_ISSET (fd, &non_keyboard_wait_mask))
      return 1;

  return 0;
}

#else  /* not subprocesses */

/* Defined on msdos.c.  */
extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
		       EMACS_TIME *);

/* Implementation of wait_reading_process_output, assuming that there
   are no subprocesses.  Used only by the MS-DOS build.

   Wait for timeout to elapse and/or keyboard input to be available.

   time_limit is:
     timeout in seconds, or
     zero for no limit, or
     -1 means gobble data immediately available but don't wait for any.

   read_kbd is a Lisp_Object:
     0 to ignore keyboard input, or
     1 to return when input is available, or
     -1 means caller will actually read the input, so don't throw to
       the quit handler.

   see full version for other parameters. We know that wait_proc will
     always be NULL, since `subprocesses' isn't defined.

   do_display != 0 means redisplay should be done to show subprocess
   output that arrives.

   Return true if we received input from any process.  */

int
wait_reading_process_output (time_limit, microsecs, read_kbd, do_display,
			     wait_for_cell, wait_proc, just_wait_proc)
     int time_limit, microsecs, read_kbd, do_display;
     Lisp_Object wait_for_cell;
     struct Lisp_Process *wait_proc;
     int just_wait_proc;
{
  register int nfds;
  EMACS_TIME end_time, timeout;
  SELECT_TYPE waitchannels;
  int xerrno;

  /* What does time_limit really mean?  */
  if (time_limit || microsecs)
    {
      EMACS_GET_TIME (end_time);
      EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
      EMACS_ADD_TIME (end_time, end_time, timeout);
    }

  /* 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)
    {
      int timeout_reduced_for_timers = 0;

      /* If calling from keyboard input, do not quit
	 since we want to return C-g as an input character.
	 Otherwise, do pending quit if requested.  */
      if (read_kbd >= 0)
	QUIT;

      /* Exit now if the cell we're waiting for became non-nil.  */
      if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
	break;

      /* Compute time from now till when time limit is up */
      /* Exit if already run out */
      if (time_limit == -1)
	{
	  /* -1 specified for timeout means
	     gobble output available now
	     but don't wait at all. */

	  EMACS_SET_SECS_USECS (timeout, 0, 0);
	}
      else if (time_limit || microsecs)
	{
	  EMACS_GET_TIME (timeout);
	  EMACS_SUB_TIME (timeout, end_time, timeout);
	  if (EMACS_TIME_NEG_P (timeout))
	    break;
	}
      else
	{
	  EMACS_SET_SECS_USECS (timeout, 100000, 0);
	}

      /* If our caller will not immediately handle keyboard events,
	 run timer events directly.
	 (Callers that will immediately read keyboard events
	 call timer_delay on their own.)  */
      if (NILP (wait_for_cell))
	{
	  EMACS_TIME timer_delay;

	  do
	    {
	      int old_timers_run = timers_run;
	      timer_delay = timer_check (1);
	      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.  */
		redisplay_preserve_echo_area (14);
	      else
		break;
	    }
	  while (!detect_input_pending ());

	  /* If there is unread keyboard input, also return.  */
	  if (read_kbd != 0
	      && requeued_events_pending_p ())
	    break;

	  if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
	    {
	      EMACS_TIME difference;
	      EMACS_SUB_TIME (difference, timer_delay, timeout);
	      if (EMACS_TIME_NEG_P (difference))
		{
		  timeout = timer_delay;
		  timeout_reduced_for_timers = 1;
		}
	    }
	}

      /* Cause C-g and alarm signals to take immediate action,
	 and cause input available signals to zero out timeout.  */
      if (read_kbd < 0)
	set_waiting_for_input (&timeout);

      /* Wait till there is something to do.  */

      if (! read_kbd && NILP (wait_for_cell))
	FD_ZERO (&waitchannels);
      else
	FD_SET (0, &waitchannels);

      /* If a frame has been newly mapped and needs updating,
	 reprocess its display stuff.  */
      if (frame_garbaged && do_display)
	{
	  clear_waiting_for_input ();
	  redisplay_preserve_echo_area (15);
	  if (read_kbd < 0)
	    set_waiting_for_input (&timeout);
	}

      if (read_kbd && detect_input_pending ())
	{
	  nfds = 0;
	  FD_ZERO (&waitchannels);
	}
      else
	nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
		       &timeout);

      xerrno = errno;

      /* Make C-g and alarm signals set flags again */
      clear_waiting_for_input ();

      /*  If we woke up due to SIGWINCH, actually change size now.  */
      do_pending_window_change (0);

      if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
	/* We waited the full specified time, so return now.  */
	break;

      if (nfds == -1)
	{
	  /* If the system call was interrupted, then go around the
	     loop again.  */
	  if (xerrno == EINTR)
	    FD_ZERO (&waitchannels);
	  else
	    error ("select error: %s", emacs_strerror (xerrno));
	}

      /* Check for keyboard input */

      if (read_kbd
	  && detect_input_pending_run_timers (do_display))
	{
	  swallow_events (do_display);
	  if (detect_input_pending_run_timers (do_display))
	    break;
	}

      /* If there is unread keyboard input, also return.  */
      if (read_kbd
	  && requeued_events_pending_p ())
	break;

      /* If wait_for_cell. check for keyboard input
	 but don't run any timers.
	 ??? (It seems wrong to me to check for keyboard
	 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 (! NILP (wait_for_cell)
	  && detect_input_pending ())
	{
	  swallow_events (do_display);
	  if (detect_input_pending ())
	    break;
	}

      /* Exit now if the cell we're waiting for became non-nil.  */
      if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
	break;
    }

  start_polling ();

  return 0;
}

#endif	/* not subprocesses */

/* The following functions are needed even if async subprocesses are
   not supported.  Some of them are no-op stubs in that case.  */

DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
       doc: /* Return the (or a) process associated with BUFFER.
BUFFER may be a buffer or the name of one.  */)
  (register Lisp_Object buffer)
{
#ifdef subprocesses
  register Lisp_Object buf, tail, proc;

  if (NILP (buffer)) return Qnil;
  buf = Fget_buffer (buffer);
  if (NILP (buf)) return Qnil;

  for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
    {
      proc = Fcdr (XCAR (tail));
      if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
	return proc;
    }
#endif	/* subprocesses */
  return Qnil;
}

DEFUN ("process-inherit-coding-system-flag",
       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.  */)
  (register Lisp_Object process)
{
#ifdef subprocesses
  CHECK_PROCESS (process);
  return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
#else
  /* Ignore the argument and return the value of
     inherit-process-coding-system.  */
  return inherit_process_coding_system ? Qt : Qnil;
#endif
}

/* Kill all processes associated with `buffer'.
   If `buffer' is nil, kill all processes  */

void
kill_buffer_processes (Lisp_Object buffer)
{
#ifdef subprocesses
  Lisp_Object tail, proc;

  for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
    {
      proc = XCDR (XCAR (tail));
      if (PROCESSP (proc)
	  && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
	{
	  if (NETCONN_P (proc) || SERIALCONN_P (proc))
	    Fdelete_process (proc);
	  else if (XPROCESS (proc)->infd >= 0)
	    process_send_signal (proc, SIGHUP, Qnil, 1);
	}
    }
#else  /* subprocesses */
  /* Since we have no subprocesses, this does nothing.  */
#endif /* subprocesses */
}

/* Stop reading input from keyboard sources.  */

void
hold_keyboard_input (void)
{
  kbd_is_on_hold = 1;
}

/* Resume reading input from keyboard sources.  */

void
unhold_keyboard_input (void)
{
  kbd_is_on_hold = 0;
}

/* Return non-zero if keyboard input is on hold, zero otherwise.  */

int
kbd_on_hold_p (void)
{
  return kbd_is_on_hold;
}


/* Enumeration of and access to system processes a-la ps(1).  */

DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
       0, 0, 0,

 args    -- command line which invoked the process (string).  */)
  ( Lisp_Object pid)
{
  return system_process_attributes (pid);
}


void
init_process (void)
{
#ifdef subprocesses
  register int i;

  inhibit_sentinels = 0;

#ifdef SIGCHLD

				    && release[1] == '.')) {
      Vprocess_connection_type = Qnil;
    }
  }
#endif
#endif	/* subprocesses */
  kbd_is_on_hold = 0;
}

void
syms_of_process (void)
{
#ifdef subprocesses

  Qprocessp = intern_c_string ("processp");
  staticpro (&Qprocessp);
  Qrun = intern_c_string ("run");
  staticpro (&Qrun);
  Qstop = intern_c_string ("stop");

  staticpro (&Qreal);
  Qnetwork = intern_c_string ("network");
  staticpro (&Qnetwork);
  Qserial = intern_c_string ("serial");
  staticpro (&Qserial);
  QCbuffer = intern_c_string (":buffer");
  staticpro (&QCbuffer);
  QChost = intern_c_string (":host");
  staticpro (&QChost);
  QCservice = intern_c_string (":service");
  staticpro (&QCservice);
  QClocal = intern_c_string (":local");
  staticpro (&QClocal);
  QCremote = intern_c_string (":remote");
  staticpro (&QCremote);
  QCcoding = intern_c_string (":coding");

  staticpro (&Vprocess_alist);
#ifdef SIGCHLD
  staticpro (&deleted_pid_list);
#endif

#endif	/* subprocesses */

  QCname = intern_c_string (":name");
  staticpro (&QCname);
  QCtype = intern_c_string (":type");
  staticpro (&QCtype);

  Qeuid = intern_c_string ("euid");
  staticpro (&Qeuid);
  Qegid = intern_c_string ("egid");
  staticpro (&Qegid);

	       doc: /* *Non-nil means delete processes immediately when they exit.
A value of nil means don't delete them until `list-processes' is run.  */);

  delete_exited_processes = 1;

#ifdef subprocesses
  DEFVAR_LISP ("process-connection-type", &Vprocess_connection_type,
	       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.

  Vprocess_adaptive_read_buffering = Qt;
#endif

  defsubr (&Sprocessp);
  defsubr (&Sget_process);
  defsubr (&Sdelete_process);
  defsubr (&Sprocess_status);
  defsubr (&Sprocess_exit_status);
  defsubr (&Sprocess_id);
  defsubr (&Sprocess_name);

  defsubr (&Sprocess_filter);
  defsubr (&Sset_process_sentinel);
  defsubr (&Sprocess_sentinel);
  defsubr (&Sset_process_window_size);
  defsubr (&Sset_process_inherit_coding_system_flag);
  defsubr (&Sset_process_query_on_exit_flag);
  defsubr (&Sprocess_query_on_exit_flag);
  defsubr (&Sprocess_contact);
  defsubr (&Sprocess_plist);
  defsubr (&Sset_process_plist);

  defsubr (&Sprocess_type);
  defsubr (&Sset_process_coding_system);
  defsubr (&Sprocess_coding_system);
  defsubr (&Sset_process_filter_multibyte);
  defsubr (&Sprocess_filter_multibyte_p);

#endif	/* subprocesses */

  defsubr (&Sget_buffer_process);
  defsubr (&Sprocess_inherit_coding_system_flag);
  defsubr (&Slist_system_processes);
  defsubr (&Sprocess_attributes);
}

/* arch-tag: 3706c011-7b9a-4117-bd4f-59e7f701a4c4
   (do not change this comment) */