process.c 218 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Asynchronous subprocess control for GNU Emacs.
2
   Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3
		 1996, 1998, 1999, 2001, 2002, 2003, 2004,
Glenn Morris's avatar
Glenn Morris committed
4
		 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

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
19
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20 21


22
#include <config.h>
23
#include <signal.h>
Jim Blandy's avatar
Jim Blandy committed
24 25 26 27 28 29
#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>
#include <sys/stat.h>
30
#include <setjmp.h>
31 32 33
#ifdef HAVE_INTTYPES_H
#include <inttypes.h>
#endif
34 35 36
#ifdef STDC_HEADERS
#include <stdlib.h>
#endif
37

Richard M. Stallman's avatar
Richard M. Stallman committed
38 39 40
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
41 42
#include <fcntl.h>

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

Jim Blandy's avatar
Jim Blandy committed
46 47 48 49
#include <sys/socket.h>
#include <netdb.h>
#include <netinet/in.h>
#include <arpa/inet.h>
50 51

/* Are local (unix) sockets supported?  */
52
#if defined (HAVE_SYS_UN_H)
53 54 55 56 57 58 59 60
#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
Jim Blandy's avatar
Jim Blandy committed
61

Dan Nicolaescu's avatar
Dan Nicolaescu committed
62
#if defined(HAVE_SYS_IOCTL_H)
Jim Blandy's avatar
Jim Blandy committed
63
#include <sys/ioctl.h>
64
#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5)
Jim Blandy's avatar
Jim Blandy committed
65 66
#include <fcntl.h>
#endif /* HAVE_PTYS and no O_NDELAY */
67 68 69
#if defined(HAVE_NET_IF_H)
#include <net/if.h>
#endif /* HAVE_NET_IF_H */
Dan Nicolaescu's avatar
Dan Nicolaescu committed
70
#endif /* HAVE_SYS_IOCTL_H */
Jim Blandy's avatar
Jim Blandy committed
71 72 73 74 75

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

Dave Love's avatar
Dave Love committed
76 77 78
#ifdef HAVE_SYS_WAIT
#include <sys/wait.h>
#endif
Jim Blandy's avatar
Jim Blandy committed
79

80 81 82 83 84 85
#ifdef HAVE_RES_INIT
#include <netinet/in.h>
#include <arpa/nameser.h>
#include <resolv.h>
#endif

86 87 88 89
#ifdef HAVE_UTIL_H
#include <util.h>
#endif

90 91
#endif	/* subprocesses */

92
#include "lisp.h"
Jim Blandy's avatar
Jim Blandy committed
93
#include "systime.h"
94
#include "systty.h"
Jim Blandy's avatar
Jim Blandy committed
95 96 97

#include "window.h"
#include "buffer.h"
98
#include "character.h"
Karl Heuer's avatar
Karl Heuer committed
99
#include "coding.h"
Jim Blandy's avatar
Jim Blandy committed
100
#include "process.h"
101
#include "frame.h"
Jim Blandy's avatar
Jim Blandy committed
102 103 104
#include "termhooks.h"
#include "termopts.h"
#include "commands.h"
105
#include "keyboard.h"
Richard M. Stallman's avatar
Richard M. Stallman committed
106
#include "blockinput.h"
Andreas Schwab's avatar
Andreas Schwab committed
107
#include "dispextern.h"
Kenichi Handa's avatar
Kenichi Handa committed
108
#include "composite.h"
Gerd Moellmann's avatar
Gerd Moellmann committed
109
#include "atimer.h"
110 111 112
#include "sysselect.h"
#include "syssignal.h"
#include "syswait.h"
Jim Blandy's avatar
Jim Blandy committed
113

114 115 116
#if defined (USE_GTK) || defined (HAVE_GCONF)
#include "xgselect.h"
#endif /* defined (USE_GTK) || defined (HAVE_GCONF) */
117 118 119
#ifdef HAVE_NS
#include "nsterm.h"
#endif
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
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;

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

139 140
#ifdef subprocesses

141
Lisp_Object Qprocessp;
Kim F. Storm's avatar
Kim F. Storm committed
142
Lisp_Object Qrun, Qstop, Qsignal;
143
Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
Stefan Monnier's avatar
Stefan Monnier committed
144
Lisp_Object Qlocal, Qipv4, Qdatagram, Qseqpacket;
145
Lisp_Object Qreal, Qnetwork, Qserial;
Kim F. Storm's avatar
Kim F. Storm committed
146 147 148
#ifdef AF_INET6
Lisp_Object Qipv6;
#endif
149 150 151
Lisp_Object QCport, QCspeed, QCprocess;
Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
152
Lisp_Object QCbuffer, QChost, QCservice;
153
Lisp_Object QClocal, QCremote, QCcoding;
154
Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
155
Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
156
Lisp_Object Qlast_nonmenu_event;
157 158 159 160
/* QCfamily is declared and initialized in xfaces.c,
   QCfilter in keyboard.c.  */
extern Lisp_Object QCfamily, QCfilter;

Jim Blandy's avatar
Jim Blandy committed
161 162
/* Qexit is declared and initialized in eval.c.  */

163 164 165 166 167
/* QCfamily is defined in xfaces.c.  */
extern Lisp_Object QCfamily;
/* QCfilter is defined in keyboard.c.  */
extern Lisp_Object QCfilter;

168 169 170 171
#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))
Jim Blandy's avatar
Jim Blandy committed
172 173 174 175 176 177 178 179 180 181 182

/* Define first descriptor number available for subprocesses.  */
#define FIRST_PROC_DESC 3

/* Define SIGCHLD as an alias for SIGCLD.  There are many conditionals
   testing SIGCHLD.  */

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

183
extern char *get_operating_system_release (void);
184

185 186 187 188 189 190 191 192 193 194 195
/* Serial processes require termios or Windows.  */
#if defined (HAVE_TERMIOS) || defined (WINDOWSNT)
#define HAVE_SERIAL
#endif

#ifdef HAVE_SERIAL
/* From sysdep.c or w32.c  */
extern int serial_open (char *port);
extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact);
#endif

196 197 198 199
#ifndef HAVE_H_ERRNO
extern int h_errno;
#endif

Jim Blandy's avatar
Jim Blandy committed
200 201
/* t means use pty, nil means use a pipe,
   maybe other values to come.  */
202
static Lisp_Object Vprocess_connection_type;
Jim Blandy's avatar
Jim Blandy committed
203

204 205
/* These next two vars are non-static since sysdep.c uses them in the
   emulation of `select'.  */
Jim Blandy's avatar
Jim Blandy committed
206
/* Number of events of change of status of a process.  */
207
int process_tick;
Jim Blandy's avatar
Jim Blandy committed
208
/* Number of events for which the user or sentinel has been notified.  */
209
int update_tick;
Jim Blandy's avatar
Jim Blandy committed
210

211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228
/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.  */

#ifdef BROKEN_NON_BLOCKING_CONNECT
#undef NON_BLOCKING_CONNECT
#else
#ifndef NON_BLOCKING_CONNECT
#ifdef HAVE_SELECT
#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
#if defined (O_NONBLOCK) || defined (O_NDELAY)
#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
#define NON_BLOCKING_CONNECT
#endif /* EWOULDBLOCK || EINPROGRESS */
#endif /* O_NONBLOCK || O_NDELAY */
#endif /* HAVE_GETPEERNAME || GNU_LINUX */
#endif /* HAVE_SELECT */
#endif /* NON_BLOCKING_CONNECT */
#endif /* BROKEN_NON_BLOCKING_CONNECT */

229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
   this system.  We need to read full packets, so we need a
   "non-destructive" select.  So we require either native select,
   or emulation of select using FIONREAD.  */

#ifdef BROKEN_DATAGRAM_SOCKETS
#undef DATAGRAM_SOCKETS
#else
#ifndef DATAGRAM_SOCKETS
#if defined (HAVE_SELECT) || defined (FIONREAD)
#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
#define DATAGRAM_SOCKETS
#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
#endif /* HAVE_SELECT || FIONREAD */
#endif /* DATAGRAM_SOCKETS */
#endif /* BROKEN_DATAGRAM_SOCKETS */

Stefan Monnier's avatar
Stefan Monnier committed
246 247 248 249
#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
# define HAVE_SEQPACKET
#endif

Kenichi Handa's avatar
Kenichi Handa committed
250 251 252 253 254 255 256 257 258 259 260
#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
#ifdef EMACS_HAS_USECS
#define ADAPTIVE_READ_BUFFERING
#endif
#endif

#ifdef ADAPTIVE_READ_BUFFERING
#define READ_OUTPUT_DELAY_INCREMENT 10000
#define READ_OUTPUT_DELAY_MAX       (READ_OUTPUT_DELAY_INCREMENT * 5)
#define READ_OUTPUT_DELAY_MAX_MAX   (READ_OUTPUT_DELAY_INCREMENT * 7)

261 262
/* Number of processes which have a non-zero read_output_delay,
   and therefore might be delayed for adaptive read buffering.  */
Kenichi Handa's avatar
Kenichi Handa committed
263 264 265

static int process_output_delay_count;

266
/* Non-zero if any process has non-nil read_output_skip.  */
Kenichi Handa's avatar
Kenichi Handa committed
267 268 269 270 271

static int process_output_skip;

/* Non-nil means to delay reading process output to improve buffering.
   A value of t means that delay is reset after each send, any other
272 273
   non-nil value does not reset the delay.  A value of nil disables
   adaptive read buffering completely.  */
Kenichi Handa's avatar
Kenichi Handa committed
274 275 276 277 278
static Lisp_Object Vprocess_adaptive_read_buffering;
#else
#define process_output_delay_count 0
#endif

279 280 281 282 283
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);
284

285
/* If we support a window system, turn on the code to poll periodically
286
   to detect C-g.  It isn't actually used when doing interrupt input.  */
287
#ifdef HAVE_WINDOW_SYSTEM
288 289 290
#define POLL_FOR_INPUT
#endif

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

294 295 296 297
/* Mask of bits indicating the descriptors that we wait for input on.  */

static SELECT_TYPE input_wait_mask;

298
/* Mask that excludes keyboard input descriptor(s).  */
299 300 301

static SELECT_TYPE non_keyboard_wait_mask;

302
/* Mask that excludes process input descriptor(s).  */
303 304 305

static SELECT_TYPE non_process_wait_mask;

306 307 308 309
/* Mask for the gpm mouse input descriptor.  */

static SELECT_TYPE gpm_wait_mask;

310
#ifdef NON_BLOCKING_CONNECT
311 312 313 314 315 316 317 318 319
/* Mask of bits indicating the descriptors that we wait for connect to
   complete on.  Once they complete, they are removed from this mask
   and added to the input_wait_mask and non_keyboard_wait_mask.  */

static SELECT_TYPE connect_wait_mask;

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

320
#define IF_NON_BLOCKING_CONNECT(s) s
321
#else  /* NON_BLOCKING_CONNECT */
322
#define IF_NON_BLOCKING_CONNECT(s)
323
#endif	/* NON_BLOCKING_CONNECT */
324

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

328 329
/* The largest descriptor currently in use for keyboard input.  */
static int max_keyboard_desc;
Jim Blandy's avatar
Jim Blandy committed
330

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

Jim Blandy's avatar
Jim Blandy committed
334
/* Indexed by descriptor, gives the process (if any) for that descriptor */
335
Lisp_Object chan_process[MAXDESC];
Jim Blandy's avatar
Jim Blandy committed
336 337

/* Alist of elements (NAME . PROCESS) */
338
Lisp_Object Vprocess_alist;
Jim Blandy's avatar
Jim Blandy committed
339 340 341 342 343 344 345

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

346 347
/* Don't make static; need to access externally.  */
int proc_buffered_char[MAXDESC];
348

Karl Heuer's avatar
Karl Heuer committed
349
/* Table of `struct coding-system' for each process.  */
350 351
static struct coding_system *proc_decode_coding_system[MAXDESC];
static struct coding_system *proc_encode_coding_system[MAXDESC];
Karl Heuer's avatar
Karl Heuer committed
352

353 354 355 356 357 358 359
#ifdef DATAGRAM_SOCKETS
/* Table of `partner address' for datagram sockets.  */
struct sockaddr_and_len {
  struct sockaddr *sa;
  int len;
} datagram_address[MAXDESC];
#define DATAGRAM_CHAN_P(chan)	(datagram_address[chan].sa != 0)
360
#define DATAGRAM_CONN_P(proc)	(PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
361 362 363 364 365
#else
#define DATAGRAM_CHAN_P(chan)	(0)
#define DATAGRAM_CONN_P(proc)	(0)
#endif

Richard M. Stallman's avatar
Richard M. Stallman committed
366 367
/* Maximum number of bytes to send to a pty without an eof.  */
static int pty_max_bytes;
368

369
#ifdef HAVE_PTYS
Dave Love's avatar
Dave Love committed
370 371 372
#ifdef HAVE_PTY_H
#include <pty.h>
#endif
373
/* The file name of the pty opened by allocate_pty.  */
374 375

static char pty_name[24];
376
#endif
Jim Blandy's avatar
Jim Blandy committed
377 378 379 380

/* Compute the Lisp form of the process status, p->status, from
   the numeric status that was returned by `wait'.  */

381
static Lisp_Object status_convert (int);
382

383
static void
384
update_status (struct Lisp_Process *p)
Jim Blandy's avatar
Jim Blandy committed
385
{
386
  eassert (p->raw_status_new);
387
  p->status = status_convert (p->raw_status);
388
  p->raw_status_new = 0;
Jim Blandy's avatar
Jim Blandy committed
389 390
}

391
/*  Convert a process status word in Unix format to
Jim Blandy's avatar
Jim Blandy committed
392 393
    the list that we use internally.  */

394
static Lisp_Object
395
status_convert (int w)
Jim Blandy's avatar
Jim Blandy committed
396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411
{
  if (WIFSTOPPED (w))
    return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
  else if (WIFEXITED (w))
    return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
				WCOREDUMP (w) ? Qt : Qnil));
  else if (WIFSIGNALED (w))
    return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
				  WCOREDUMP (w) ? Qt : Qnil));
  else
    return Qrun;
}

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

412
static void
413
decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, int *coredump)
Jim Blandy's avatar
Jim Blandy committed
414 415 416
{
  Lisp_Object tem;

417
  if (SYMBOLP (l))
Jim Blandy's avatar
Jim Blandy committed
418 419 420 421 422 423 424
    {
      *symbol = l;
      *code = 0;
      *coredump = 0;
    }
  else
    {
425 426 427 428
      *symbol = XCAR (l);
      tem = XCDR (l);
      *code = XFASTINT (XCAR (tem));
      tem = XCDR (tem);
Jim Blandy's avatar
Jim Blandy committed
429 430 431 432 433 434
      *coredump = !NILP (tem);
    }
}

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

435
static Lisp_Object
436
status_message (struct Lisp_Process *p)
Jim Blandy's avatar
Jim Blandy committed
437
{
438
  Lisp_Object status = p->status;
Jim Blandy's avatar
Jim Blandy committed
439 440 441 442 443 444 445 446
  Lisp_Object symbol;
  int code, coredump;
  Lisp_Object string, string2;

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

  if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
    {
447
      char *signame;
448
      synchronize_system_messages_locale ();
449
      signame = strsignal (code);
450
      if (signame == 0)
451 452 453 454 455 456 457 458 459
	string = build_string ("unknown");
      else
	{
	  int c1, c2;

	  string = make_unibyte_string (signame, strlen (signame));
	  if (! NILP (Vlocale_coding_system))
	    string = (code_convert_string_norecord
		      (string, Vlocale_coding_system, 0));
460
	  c1 = STRING_CHAR ((char *) SDATA (string));
461 462
	  c2 = DOWNCASE (c1);
	  if (c1 != c2)
463
	    Faset (string, make_number (0), make_number (c2));
464
	}
Jim Blandy's avatar
Jim Blandy committed
465 466 467 468 469
      string2 = build_string (coredump ? " (core dumped)\n" : "\n");
      return concat2 (string, string2);
    }
  else if (EQ (symbol, Qexit))
    {
470 471
      if (NETCONN1_P (p))
	return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
Jim Blandy's avatar
Jim Blandy committed
472 473
      if (code == 0)
	return build_string ("finished\n");
474
      string = Fnumber_to_string (make_number (code));
Jim Blandy's avatar
Jim Blandy committed
475
      string2 = build_string (coredump ? " (core dumped)\n" : "\n");
476 477
      return concat3 (build_string ("exited abnormally with code "),
		      string, string2);
Jim Blandy's avatar
Jim Blandy committed
478
    }
479 480 481 482
  else if (EQ (symbol, Qfailed))
    {
      string = Fnumber_to_string (make_number (code));
      string2 = build_string ("\n");
483 484
      return concat3 (build_string ("failed with code "),
		      string, string2);
485
    }
Jim Blandy's avatar
Jim Blandy committed
486 487 488 489 490 491
  else
    return Fcopy_sequence (Fsymbol_name (symbol));
}

#ifdef HAVE_PTYS

492 493 494 495 496
/* Open an available pty, returning a file descriptor.
   Return -1 on failure.
   The file name of the terminal corresponding to the pty
   is left in the variable pty_name.  */

497
static int
498
allocate_pty (void)
Jim Blandy's avatar
Jim Blandy committed
499
{
Andreas Schwab's avatar
Andreas Schwab committed
500
  register int c, i;
Jim Blandy's avatar
Jim Blandy committed
501 502 503 504 505 506 507 508 509
  int fd;

#ifdef PTY_ITERATION
  PTY_ITERATION
#else
  for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
    for (i = 0; i < 16; i++)
#endif
      {
510
	struct stat stb;	/* Used in some PTY_OPEN.  */
Jim Blandy's avatar
Jim Blandy committed
511 512 513 514 515 516
#ifdef PTY_NAME_SPRINTF
	PTY_NAME_SPRINTF
#else
	sprintf (pty_name, "/dev/pty%c%x", c, i);
#endif /* no PTY_NAME_SPRINTF */

517 518 519
#ifdef PTY_OPEN
	PTY_OPEN;
#else /* no PTY_OPEN */
520 521 522 523 524 525 526
	{
	  { /* 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;
527

528 529 530 531 532 533 534 535
	    if (stat (pty_name, &stb) < 0)
	      {
		failed_count++;
		if (failed_count >= 3)
		  return -1;
	      }
	    else
	      failed_count = 0;
Jim Blandy's avatar
Jim Blandy committed
536
	  }
537 538 539 540 541 542
#  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
	}
543
#endif /* no PTY_OPEN */
Jim Blandy's avatar
Jim Blandy committed
544 545 546 547 548 549 550 551

	if (fd >= 0)
	  {
	    /* check to make certain that both sides are available
	       this avoids a nasty yet stupid bug in rlogins */
#ifdef PTY_TTY_NAME_SPRINTF
	    PTY_TTY_NAME_SPRINTF
#else
552
	    sprintf (pty_name, "/dev/tty%c%x", c, i);
Jim Blandy's avatar
Jim Blandy committed
553 554 555
#endif /* no PTY_TTY_NAME_SPRINTF */
	    if (access (pty_name, 6) != 0)
	      {
556
		emacs_close (fd);
557
# ifndef __sgi
Jim Blandy's avatar
Jim Blandy committed
558
		continue;
559
# else
Jim Blandy's avatar
Jim Blandy committed
560
		return -1;
561
# endif /* __sgi */
Jim Blandy's avatar
Jim Blandy committed
562 563 564 565 566 567 568 569 570
	      }
	    setup_pty (fd);
	    return fd;
	  }
      }
  return -1;
}
#endif /* HAVE_PTYS */

571
static Lisp_Object
572
make_process (Lisp_Object name)
Jim Blandy's avatar
Jim Blandy committed
573 574 575 576 577 578
{
  register Lisp_Object val, tem, name1;
  register struct Lisp_Process *p;
  char suffix[10];
  register int i;

579
  p = allocate_process ();
580

581 582 583 584
  p->infd = -1;
  p->outfd = -1;
  p->tick = 0;
  p->update_tick = 0;
585
  p->pid = 0;
Miles Bader's avatar
Miles Bader committed
586
  p->pty_flag = 0;
587
  p->raw_status_new = 0;
Jim Blandy's avatar
Jim Blandy committed
588 589
  p->status = Qrun;
  p->mark = Fmake_marker ();
590
  p->kill_without_query = 0;
Jim Blandy's avatar
Jim Blandy committed
591

Kenichi Handa's avatar
Kenichi Handa committed
592
#ifdef ADAPTIVE_READ_BUFFERING
593 594 595
  p->adaptive_read_buffering = 0;
  p->read_output_delay = 0;
  p->read_output_skip = 0;
Kenichi Handa's avatar
Kenichi Handa committed
596 597
#endif

Jim Blandy's avatar
Jim Blandy committed
598 599 600 601 602 603 604 605 606 607 608 609
  /* If name is already in use, modify it until it is unused.  */

  name1 = name;
  for (i = 1; ; i++)
    {
      tem = Fget_process (name1);
      if (NILP (tem)) break;
      sprintf (suffix, "<%d>", i);
      name1 = concat2 (name, build_string (suffix));
    }
  name = name1;
  p->name = name;
610
  XSETPROCESS (val, p);
Jim Blandy's avatar
Jim Blandy committed
611 612 613 614
  Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
  return val;
}

615
static void
616
remove_process (register Lisp_Object proc)
Jim Blandy's avatar
Jim Blandy committed
617 618 619 620 621 622 623 624
{
  register Lisp_Object pair;

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

  deactivate_process (proc);
}
625

Jim Blandy's avatar
Jim Blandy committed
626 627

DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
628
       doc: /* Return t if OBJECT is a process.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
629
  (Lisp_Object object)
Jim Blandy's avatar
Jim Blandy committed
630
{
631
  return PROCESSP (object) ? Qt : Qnil;
Jim Blandy's avatar
Jim Blandy committed
632 633 634
}

DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
635
       doc: /* Return the process named NAME, or nil if there is none.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
636
  (register Lisp_Object name)
Jim Blandy's avatar
Jim Blandy committed
637
{
638
  if (PROCESSP (name))
Jim Blandy's avatar
Jim Blandy committed
639
    return name;
640
  CHECK_STRING (name);
Jim Blandy's avatar
Jim Blandy committed
641 642 643
  return Fcdr (Fassoc (name, Vprocess_alist));
}

Jim Blandy's avatar
Jim Blandy committed
644 645 646 647
/* 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.  */
Jim Blandy's avatar
Jim Blandy committed
648

649
static Lisp_Object
650
get_process (register Lisp_Object name)
Jim Blandy's avatar
Jim Blandy committed
651
{
652 653 654 655 656 657 658
  register Lisp_Object proc, obj;
  if (STRINGP (name))
    {
      obj = Fget_process (name);
      if (NILP (obj))
	obj = Fget_buffer (name);
      if (NILP (obj))
659
	error ("Process %s does not exist", SDATA (name));
660 661 662
    }
  else if (NILP (name))
    obj = Fcurrent_buffer ();
Jim Blandy's avatar
Jim Blandy committed
663
  else
664 665 666 667 668
    obj = name;

  /* Now obj should be either a buffer object or a process object.
   */
  if (BUFFERP (obj))
Jim Blandy's avatar
Jim Blandy committed
669
    {
670
      proc = Fget_buffer_process (obj);
Jim Blandy's avatar
Jim Blandy committed
671
      if (NILP (proc))
672
	error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name));
Jim Blandy's avatar
Jim Blandy committed
673 674
    }
  else
675
    {
676
      CHECK_PROCESS (obj);
677 678 679
      proc = obj;
    }
  return proc;
Jim Blandy's avatar
Jim Blandy committed
680 681
}

682 683 684 685 686 687 688 689 690 691

#ifdef SIGCHLD
/* Fdelete_process promises to immediately forget about the process, but in
   reality, Emacs needs to remember those processes until they have been
   treated by sigchld_handler; otherwise this handler would consider the
   process as being synchronous and say that the synchronous process is
   dead.  */
static Lisp_Object deleted_pid_list;
#endif

Jim Blandy's avatar
Jim Blandy committed
692
DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
693 694 695
       doc: /* Delete PROCESS: kill it and forget about it immediately.
PROCESS may be a process, a buffer, the name of a process or buffer, or
nil, indicating the current buffer's process.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
696
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
697
{
698 699
  register struct Lisp_Process *p;

700
  process = get_process (process);
701 702
  p = XPROCESS (process);

703
  p->raw_status_new = 0;
704
  if (NETCONN1_P (p) || SERIALCONN1_P (p))
Jim Blandy's avatar
Jim Blandy committed
705
    {
706
      p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
707
      p->tick = ++process_tick;
708
      status_notify (p);
709
      redisplay_preserve_echo_area (13);
Jim Blandy's avatar
Jim Blandy committed
710
    }
711
  else if (p->infd >= 0)
Jim Blandy's avatar
Jim Blandy committed
712
    {
713 714
#ifdef SIGCHLD
      Lisp_Object symbol;
715 716
      /* Assignment to EMACS_INT stops GCC whining about limited range
	 of data type.  */
717
      EMACS_INT pid = p->pid;
718 719

      /* No problem storing the pid here, as it is still in Vprocess_alist.  */
720
      deleted_pid_list = Fcons (make_fixnum_or_float (pid),
721 722 723 724 725 726 727 728 729
				/* GC treated elements set to nil.  */
				Fdelq (Qnil, deleted_pid_list));
      /* If the process has already signaled, remove it from the list.  */
      if (p->raw_status_new)
	update_status (p);
      symbol = p->status;
      if (CONSP (p->status))
	symbol = XCAR (p->status);
      if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
730 731
	deleted_pid_list
	  = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
732 733 734 735 736 737 738
      else
#endif
	{
	  Fkill_process (process, Qnil);
	  /* Do this now, since remove_process will make sigchld_handler do nothing.  */
	  p->status
	    = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
739
	  p->tick = ++process_tick;
740
	  status_notify (p);
741
	  redisplay_preserve_echo_area (13);
742
	}
Jim Blandy's avatar
Jim Blandy committed
743
    }
744
  remove_process (process);
Jim Blandy's avatar
Jim Blandy committed
745 746 747 748
  return Qnil;
}

DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
749 750 751 752 753 754 755
       doc: /* Return the status of PROCESS.
The returned value is one of the following symbols:
run  -- for a process that is running.
stop -- for a process stopped but continuable.
exit -- for a process that has exited.
signal -- for a process that has got a fatal signal.
open -- for a network stream connection that is open.
756
listen -- for a network stream server that is listening.
757
closed -- for a network stream connection that is closed.
758 759
connect -- when waiting for a non-blocking connection to complete.
failed -- when a non-blocking connection has failed.
760 761 762
nil -- if arg is a process name and no such process exists.
PROCESS may be a process, a buffer, the name of a process, or
nil, indicating the current buffer's process.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
763
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
764 765 766
{
  register struct Lisp_Process *p;
  register Lisp_Object status;
767

768 769
  if (STRINGP (process))
    process = Fget_process (process);
770
  else
771
    process = get_process (process);
772

773 774
  if (NILP (process))
    return process;
775

776
  p = XPROCESS (process);
777
  if (p->raw_status_new)
Jim Blandy's avatar
Jim Blandy committed
778 779
    update_status (p);
  status = p->status;
780
  if (CONSP (status))
781
    status = XCAR (status);
782
  if (NETCONN1_P (p) || SERIALCONN1_P (p))
Jim Blandy's avatar
Jim Blandy committed
783
    {
784
      if (EQ (status, Qexit))
Jim Blandy's avatar
Jim Blandy committed
785
	status = Qclosed;
786 787 788 789
      else if (EQ (p->command, Qt))
	status = Qstop;
      else if (EQ (status, Qrun))
	status = Qopen;
Jim Blandy's avatar
Jim Blandy committed
790 791 792 793 794 795
    }
  return status;
}

DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
       1, 1, 0,
796 797
       doc: /* Return the exit status of PROCESS or the signal number that killed it.
If PROCESS has not yet exited or died, return 0.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
798
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
799
{
800
  CHECK_PROCESS (process);
801
  if (XPROCESS (process)->raw_status_new)
802 803
    update_status (XPROCESS (process));
  if (CONSP (XPROCESS (process)->status))
804
    return XCAR (XCDR (XPROCESS (process)->status));
Jim Blandy's avatar
Jim Blandy committed
805 806 807 808
  return make_number (0);
}

DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
809
       doc: /* Return the process id of PROCESS.
810
This is the pid of the external process which PROCESS uses or talks to.
811
For a network connection, this value is nil.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
812
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
813
{
814 815 816 817
  /* Assignment to EMACS_INT stops GCC whining about limited range of
     data type.  */
  EMACS_INT pid;

818
  CHECK_PROCESS (process);
819 820
  pid = XPROCESS (process)->pid;
  return (pid ? make_fixnum_or_float (pid) : Qnil);
Jim Blandy's avatar
Jim Blandy committed
821 822 823
}

DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
824 825 826
       doc: /* Return the name of PROCESS, as a string.
This is the name of the program invoked in PROCESS,
possibly modified to make it unique among process names.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
827
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
828
{
829
  CHECK_PROCESS (process);
830
  return XPROCESS (process)->name;
Jim Blandy's avatar
Jim Blandy committed
831 832 833
}

DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
834 835 836
       doc: /* Return the command that was executed to start PROCESS.
This is a list of strings, the first string being the program executed
and the rest of the strings being the arguments given to it.
837 838
For a network or serial process, this is nil (process is running) or t
\(process is stopped).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
839
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
840
{
841
  CHECK_PROCESS (process);
842
  return XPROCESS (process)->command;
Jim Blandy's avatar
Jim Blandy committed
843 844
}

845
DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
846 847 848
       doc: /* Return the name of the terminal PROCESS uses, or nil if none.
This is the terminal that the process itself reads and writes on,
not the name of the pty that Emacs uses to talk with that terminal.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
849
  (register Lisp_Object process)
850
{
851
  CHECK_PROCESS (process);
852
  return XPROCESS (process)->tty_name;
853 854
}

Jim Blandy's avatar
Jim Blandy committed
855
DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
856 857
       2, 2, 0,
       doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
858
  (register Lisp_Object process, Lisp_Object buffer)
Jim Blandy's avatar
Jim Blandy committed
859
{
860 861
  struct Lisp_Process *p;

862
  CHECK_PROCESS (process);
Jim Blandy's avatar
Jim Blandy committed
863
  if (!NILP (buffer))
864
    CHECK_BUFFER (buffer);
865 866
  p = XPROCESS (process);
  p->buffer = buffer;
867
  if (NETCONN1_P (p) || SERIALCONN1_P (p))
868
    p->childp = Fplist_put (p->childp, QCbuffer, buffer);
869
  setup_process_coding_systems (process);
Jim Blandy's avatar
Jim Blandy committed
870 871 872 873
  return buffer;
}

DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
874 875 876
       1, 1, 0,
       doc: /* Return the buffer PROCESS is associated with.
Output from PROCESS is inserted in this buffer unless PROCESS has a filter.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
877
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
878
{
879
  CHECK_PROCESS (process);
880
  return XPROCESS (process)->buffer;
Jim Blandy's avatar
Jim Blandy committed
881 882 883
}

DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
884 885
       1, 1, 0,
       doc: /* Return the marker for the end of the last output from PROCESS.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
886
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
887
{
888
  CHECK_PROCESS (process);
889
  return XPROCESS (process)->mark;
Jim Blandy's avatar
Jim Blandy committed
890 891 892
}

DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
893 894
       2, 2, 0,
       doc: /* Give PROCESS the filter function FILTER; nil means no filter.
895
A value of t means stop accepting output from the process.
896 897 898

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
899
passed to the filter.
900

901
The filter gets two arguments: the process and the string of output.
902 903 904 905 906 907
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').  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
908
  (register Lisp_Object process, Lisp_Object filter)
Jim Blandy's avatar
Jim Blandy committed
909
{
910
  struct Lisp_Process *p;
911

912
  CHECK_PROCESS (process);
913 914 915 916 917 918 919 920 921
  p = XPROCESS (process);

  /* Don't signal an error if the process' input file descriptor
     is closed.  This could make debugging Lisp more difficult,
     for example when doing something like

     (setq process (start-process ...))
     (debug)
     (set-process-filter process ...)  */
922

923
  if (p->infd >= 0)
924
    {
925
      if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
926
	{
927 928
	  FD_CLR (p->infd, &input_wait_mask);
	  FD_CLR (p->infd, &non_keyboard_wait_mask);
929
	}
930
      else if (EQ (p->filter, Qt)
931 932
	       /* Network or serial process not stopped:  */
	       && !EQ (p->command, Qt))
933
	{
934 935
	  FD_SET (p->infd, &input_wait_mask);
	  FD_SET (p->infd, &non_keyboard_wait_mask);
936
	}
937
    }
938

939
  p->filter = filter;
940
  if (NETCONN1_P (p) || SERIALCONN1_P (p))
941
    p->childp = Fplist_put (p->childp, QCfilter, filter);
942
  setup_process_coding_systems (process);
Jim Blandy's avatar
Jim Blandy committed
943 944 945 946
  return filter;
}

DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
947 948 949
       1, 1, 0,
       doc: /* Returns the filter function of PROCESS; nil if none.
See `set-process-filter' for more info on filter functions.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
950
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
951
{
952
  CHECK_PROCESS (process);
953
  return XPROCESS (process)->filter;
Jim Blandy's avatar
Jim Blandy committed
954 955 956
}

DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
957 958 959 960
       2, 2, 0,
       doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
The sentinel is called as a function when the process changes state.
It gets two arguments: the process, and a string describing the change.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
961
  (register Lisp_Object process, Lisp_Object sentinel)
Jim Blandy's avatar
Jim Blandy committed
962
{
Kenichi Handa's avatar
Kenichi Handa committed
963 964
  struct Lisp_Process *p;

965
  CHECK_PROCESS (process);
Kenichi Handa's avatar
Kenichi Handa committed
966 967 968
  p = XPROCESS (process);

  p->sentinel = sentinel;
969
  if (NETCONN1_P (p) || SERIALCONN1_P (p))
Kenichi Handa's avatar
Kenichi Handa committed
970
    p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
Jim Blandy's avatar
Jim Blandy committed
971 972 973 974
  return sentinel;
}

DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
975 976 977
       1, 1, 0,
       doc: /* Return the sentinel of PROCESS; nil if none.
See `set-process-sentinel' for more info on sentinels.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
978
  (register Lisp_Object process)
Jim Blandy's avatar
Jim Blandy committed
979
{
980
  CHECK_PROCESS (process);
981
  return XPROCESS (process)->sentinel;
Jim Blandy's avatar
Jim Blandy committed
982 983
}

984
DEFUN ("set-process-window-size", Fset_process_window_size,
985 986
       Sset_process_window_size, 3, 3, 0,
       doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
987
  (register Lisp_Object process, Lisp_Object height, Lisp_Object width)
988
{
989 990 991
  CHECK_PROCESS (process);
  CHECK_NATNUM (height);
  CHECK_NATNUM (width);
992

993 994
  if (XPROCESS (process)->infd < 0
      || set_window_size (XPROCESS (process)->infd,
995
			  XINT (height), XINT (width)) <= 0)
996 997 998 999 1000
    return Qnil;
  else
    return Qt;
}

1001
DEFUN ("set-process-inherit-coding-system-flag",
1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017
       Fset_process_inherit_coding_system_flag,
       Sset_process_inherit_coding_system_flag, 2, 2, 0,
       doc: /* Determine whether buffer of PROCESS will inherit coding-system.
If the second argument FLAG is non-nil, then the variable
`buffer-file-coding-system' of the buffer associated with PROCESS
will be bound to the value of the coding system used to decode
the process output.

This is useful when the coding system specified for the process buffer
leaves either the character code conversion or the end-of-line conversion
unspecified, or if the coding system used to decode the process output
is more appropriate for saving the process buffer.

Binding the variable `inherit-process-coding-system' to non-nil before
starting the process is an alternative way of setting the inherit flag
for the process which will run.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1018
  (register Lisp_Object process, Lisp_Object flag)
1019
{
1020
  CHECK_PROCESS (process);
1021
  XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1022 1023 1024
  return flag;
}

1025 1026 1027 1028
DEFUN ("set-process-query-on-exit-flag",
       Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
       2, 2, 0,
       doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1029
If the second argument FLAG is non-nil, Emacs will query the user before
1030
exiting or killing a buffer if PROCESS is running.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1031
  (register Lisp_Object process, Lisp_Object flag)
Jim Blandy's avatar
Jim Blandy committed
1032
{
1033
  CHECK_PROCESS (process);
1034
  XPROCESS (process)->kill_without_query = NILP (flag);
1035
  return flag;
Jim Blandy's avatar
Jim Blandy committed
1036
}
1037

Kim F. Storm's avatar