doc/lispref/frames.texi (Font and Color Parameters): Add @pxref.
[bpt/emacs.git] / src / process.c
CommitLineData
d0d6b7c5 1/* Asynchronous subprocess control for GNU Emacs.
95df8112
GM
2
3Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2011
4 Free Software Foundation, Inc.
d0d6b7c5
JB
5
6This file is part of GNU Emacs.
7
9ec0b715 8GNU Emacs is free software: you can redistribute it and/or modify
d0d6b7c5 9it under the terms of the GNU General Public License as published by
9ec0b715
GM
10the Free Software Foundation, either version 3 of the License, or
11(at your option) any later version.
d0d6b7c5
JB
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
9ec0b715 19along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
d0d6b7c5
JB
20
21
18160b98 22#include <config.h>
68c45bf0 23#include <signal.h>
d0d6b7c5
JB
24#include <stdio.h>
25#include <errno.h>
26#include <setjmp.h>
6c60eb9f 27#include <sys/types.h> /* Some typedefs are used in sys/file.h. */
d0d6b7c5
JB
28#include <sys/file.h>
29#include <sys/stat.h>
d7306fe6 30#include <setjmp.h>
934e2a68 31
93b4f699 32#include <unistd.h>
e98d950b 33#include <fcntl.h>
e98d950b 34
0898ca10
JB
35#include "lisp.h"
36
f388c88a
EZ
37/* Only MS-DOS does not define `subprocesses'. */
38#ifdef subprocesses
39
d0d6b7c5
JB
40#include <sys/socket.h>
41#include <netdb.h>
42#include <netinet/in.h>
43#include <arpa/inet.h>
e690ca94
KS
44
45/* Are local (unix) sockets supported? */
4624371d 46#if defined (HAVE_SYS_UN_H)
e690ca94
KS
47#if !defined (AF_LOCAL) && defined (AF_UNIX)
48#define AF_LOCAL AF_UNIX
49#endif
50#ifdef AF_LOCAL
51#define HAVE_LOCAL_SOCKETS
52#include <sys/un.h>
53#endif
54#endif
d0d6b7c5 55
d0d6b7c5 56#include <sys/ioctl.h>
5e617bc2 57#if defined (HAVE_NET_IF_H)
32bc6709
DN
58#include <net/if.h>
59#endif /* HAVE_NET_IF_H */
d0d6b7c5 60
5e617bc2 61#if defined (HAVE_IFADDRS_H)
377538cb
JD
62/* Must be after net/if.h */
63#include <ifaddrs.h>
64
65/* We only use structs from this header when we use getifaddrs. */
5e617bc2 66#if defined (HAVE_NET_IF_DL_H)
377538cb
JD
67#include <net/if_dl.h>
68#endif
69
70#endif
71
d0d6b7c5
JB
72#ifdef NEED_BSDTTY
73#include <bsdtty.h>
74#endif
75
08116b48
CY
76#ifdef HAVE_RES_INIT
77#include <netinet/in.h>
78#include <arpa/nameser.h>
79#include <resolv.h>
80#endif
81
3d608a86
J
82#ifdef HAVE_UTIL_H
83#include <util.h>
84#endif
85
9bf58201
DN
86#ifdef HAVE_PTY_H
87#include <pty.h>
88#endif
89
f388c88a
EZ
90#endif /* subprocesses */
91
d0d6b7c5 92#include "systime.h"
36ebaafa 93#include "systty.h"
d0d6b7c5 94
d0d6b7c5
JB
95#include "window.h"
96#include "buffer.h"
5bbf78c1 97#include "character.h"
0fa1789e 98#include "coding.h"
d0d6b7c5 99#include "process.h"
428a555e 100#include "frame.h"
d0d6b7c5
JB
101#include "termhooks.h"
102#include "termopts.h"
103#include "commands.h"
3ec68006 104#include "keyboard.h"
ececcbec 105#include "blockinput.h"
dfcf069d 106#include "dispextern.h"
e0016554 107#include "composite.h"
30904ab7 108#include "atimer.h"
f388c88a
EZ
109#include "sysselect.h"
110#include "syssignal.h"
111#include "syswait.h"
8af55556
TZ
112#ifdef HAVE_GNUTLS
113#include "gnutls.h"
114#endif
d0d6b7c5 115
0949d2b6 116#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
872870b2 117#include "xgselect.h"
0949d2b6 118#endif
3d608a86
J
119#ifdef HAVE_NS
120#include "nsterm.h"
121#endif
57507bf8 122
fdb183d6
DN
123Lisp_Object Qeuid, Qegid, Qcomm, Qstate, Qppid, Qpgrp, Qsess, Qttname, Qtpgid;
124Lisp_Object Qminflt, Qmajflt, Qcminflt, Qcmajflt, Qutime, Qstime, Qcstime;
125Lisp_Object Qcutime, Qpri, Qnice, Qthcount, Qstart, Qvsize, Qrss, Qargs;
126Lisp_Object Quser, Qgroup, Qetime, Qpcpu, Qpmem, Qtime, Qctime;
127Lisp_Object QCname, QCtype;
128\f
129/* Non-zero if keyboard input is on hold, zero otherwise. */
130
131static int kbd_is_on_hold;
132
fdb183d6
DN
133/* Nonzero means don't run process sentinels. This is used
134 when exiting. */
135int inhibit_sentinels;
136
f388c88a
EZ
137#ifdef subprocesses
138
dd2281ae 139Lisp_Object Qprocessp;
955cbe7b
PE
140static Lisp_Object Qrun, Qstop, Qsignal;
141static Lisp_Object Qopen, Qclosed, Qconnect, Qfailed, Qlisten;
142Lisp_Object Qlocal;
143static Lisp_Object Qipv4, Qdatagram, Qseqpacket;
144static Lisp_Object Qreal, Qnetwork, Qserial;
e1652a86 145#ifdef AF_INET6
955cbe7b 146static Lisp_Object Qipv6;
e1652a86 147#endif
955cbe7b
PE
148static Lisp_Object QCport, QCprocess;
149Lisp_Object QCspeed;
d888760c
GM
150Lisp_Object QCbytesize, QCstopbits, QCparity, Qodd, Qeven;
151Lisp_Object QCflowcontrol, Qhw, Qsw, QCsummary;
955cbe7b
PE
152static Lisp_Object QCbuffer, QChost, QCservice;
153static Lisp_Object QClocal, QCremote, QCcoding;
154static Lisp_Object QCserver, QCnowait, QCnoquery, QCstop;
155static Lisp_Object QCsentinel, QClog, QCoptions, QCplist;
156static Lisp_Object Qlast_nonmenu_event;
3635ecad
JR
157/* QCfamily is declared and initialized in xfaces.c,
158 QCfilter in keyboard.c. */
159extern Lisp_Object QCfamily, QCfilter;
160
d0d6b7c5
JB
161/* Qexit is declared and initialized in eval.c. */
162
e0f712ba
AC
163/* QCfamily is defined in xfaces.c. */
164extern Lisp_Object QCfamily;
165/* QCfilter is defined in keyboard.c. */
166extern Lisp_Object QCfilter;
167
d888760c
GM
168#define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
169#define NETCONN1_P(p) (EQ ((p)->type, Qnetwork))
170#define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
171#define SERIALCONN1_P(p) (EQ ((p)->type, Qserial))
d0d6b7c5 172
5f0929a7
RS
173#ifndef HAVE_H_ERRNO
174extern int h_errno;
175#endif
176
d0d6b7c5 177/* Number of events of change of status of a process. */
40ccffa6 178static int process_tick;
d0d6b7c5 179/* Number of events for which the user or sentinel has been notified. */
40ccffa6 180static int update_tick;
d0d6b7c5 181
dd2a17ab
KS
182/* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */
183
82d6e50b 184/* Only W32 has this, it really means that select can't take write mask. */
dd2a17ab
KS
185#ifdef BROKEN_NON_BLOCKING_CONNECT
186#undef NON_BLOCKING_CONNECT
82d6e50b 187#define SELECT_CANT_DO_WRITE_MASK
dd2a17ab
KS
188#else
189#ifndef NON_BLOCKING_CONNECT
dd2a17ab
KS
190#ifdef HAVE_SELECT
191#if defined (HAVE_GETPEERNAME) || defined (GNU_LINUX)
192#if defined (O_NONBLOCK) || defined (O_NDELAY)
193#if defined (EWOULDBLOCK) || defined (EINPROGRESS)
194#define NON_BLOCKING_CONNECT
195#endif /* EWOULDBLOCK || EINPROGRESS */
196#endif /* O_NONBLOCK || O_NDELAY */
197#endif /* HAVE_GETPEERNAME || GNU_LINUX */
198#endif /* HAVE_SELECT */
dd2a17ab
KS
199#endif /* NON_BLOCKING_CONNECT */
200#endif /* BROKEN_NON_BLOCKING_CONNECT */
201
e690ca94
KS
202/* Define DATAGRAM_SOCKETS if datagrams can be used safely on
203 this system. We need to read full packets, so we need a
204 "non-destructive" select. So we require either native select,
205 or emulation of select using FIONREAD. */
206
e690ca94
KS
207#ifdef BROKEN_DATAGRAM_SOCKETS
208#undef DATAGRAM_SOCKETS
209#else
210#ifndef DATAGRAM_SOCKETS
e690ca94
KS
211#if defined (HAVE_SELECT) || defined (FIONREAD)
212#if defined (HAVE_SENDTO) && defined (HAVE_RECVFROM) && defined (EMSGSIZE)
213#define DATAGRAM_SOCKETS
214#endif /* HAVE_SENDTO && HAVE_RECVFROM && EMSGSIZE */
215#endif /* HAVE_SELECT || FIONREAD */
e690ca94
KS
216#endif /* DATAGRAM_SOCKETS */
217#endif /* BROKEN_DATAGRAM_SOCKETS */
218
f00c449b
SM
219#if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
220# define HAVE_SEQPACKET
221#endif
222
6b61353c
KH
223#if !defined (ADAPTIVE_READ_BUFFERING) && !defined (NO_ADAPTIVE_READ_BUFFERING)
224#ifdef EMACS_HAS_USECS
225#define ADAPTIVE_READ_BUFFERING
226#endif
227#endif
228
229#ifdef ADAPTIVE_READ_BUFFERING
230#define READ_OUTPUT_DELAY_INCREMENT 10000
231#define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
232#define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
233
db853b7a
KS
234/* Number of processes which have a non-zero read_output_delay,
235 and therefore might be delayed for adaptive read buffering. */
6b61353c
KH
236
237static int process_output_delay_count;
238
db853b7a 239/* Non-zero if any process has non-nil read_output_skip. */
6b61353c
KH
240
241static int process_output_skip;
242
6b61353c
KH
243#else
244#define process_output_delay_count 0
245#endif
246
cd64ea1d 247static Lisp_Object Fget_process (Lisp_Object);
40ccffa6 248static void create_process (Lisp_Object, char **, Lisp_Object);
006c5daa 249#ifdef SIGIO
f57e2426 250static int keyboard_bit_set (SELECT_TYPE *);
006c5daa 251#endif
f57e2426
J
252static void deactivate_process (Lisp_Object);
253static void status_notify (struct Lisp_Process *);
254static int read_process_output (Lisp_Object, int);
255static void create_pty (Lisp_Object);
41d03b9a 256
583dcae4 257/* If we support a window system, turn on the code to poll periodically
44ade2e9 258 to detect C-g. It isn't actually used when doing interrupt input. */
5e617bc2 259#if defined (HAVE_WINDOW_SYSTEM) && !defined (USE_ASYNC_EVENTS)
44ade2e9
RS
260#define POLL_FOR_INPUT
261#endif
262
d3da34e0
JB
263static Lisp_Object get_process (register Lisp_Object name);
264static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
84af9896 265
f388c88a
EZ
266/* Mask of bits indicating the descriptors that we wait for input on. */
267
268static SELECT_TYPE input_wait_mask;
269
994d9841 270/* Mask that excludes keyboard input descriptor(s). */
a69281ff
RS
271
272static SELECT_TYPE non_keyboard_wait_mask;
273
994d9841 274/* Mask that excludes process input descriptor(s). */
b5dc1c83
RS
275
276static SELECT_TYPE non_process_wait_mask;
277
3fad2ad2 278/* Mask for selecting for write. */
994d9841 279
3fad2ad2 280static SELECT_TYPE write_mask;
994d9841 281
bad49fc7 282#ifdef NON_BLOCKING_CONNECT
dd2a17ab
KS
283/* Mask of bits indicating the descriptors that we wait for connect to
284 complete on. Once they complete, they are removed from this mask
285 and added to the input_wait_mask and non_keyboard_wait_mask. */
286
287static SELECT_TYPE connect_wait_mask;
288
289/* Number of bits set in connect_wait_mask. */
290static int num_pending_connects;
f388c88a 291#endif /* NON_BLOCKING_CONNECT */
bad49fc7 292
7d0e672e
RS
293/* The largest descriptor currently in use for a process object. */
294static int max_process_desc;
295
3fad2ad2
J
296/* The largest descriptor currently in use for input. */
297static int max_input_desc;
994d9841 298
d0d6b7c5 299/* Indexed by descriptor, gives the process (if any) for that descriptor */
40ccffa6 300static Lisp_Object chan_process[MAXDESC];
d0d6b7c5
JB
301
302/* Alist of elements (NAME . PROCESS) */
40ccffa6 303static Lisp_Object Vprocess_alist;
d0d6b7c5
JB
304
305/* Buffered-ahead input char from process, indexed by channel.
306 -1 means empty (no char is buffered).
307 Used on sys V where the only way to tell if there is any
308 output from the process is to read at least one char.
309 Always -1 on systems that support FIONREAD. */
310
40ccffa6 311static int proc_buffered_char[MAXDESC];
dd2281ae 312
0fa1789e 313/* Table of `struct coding-system' for each process. */
c7580538
KH
314static struct coding_system *proc_decode_coding_system[MAXDESC];
315static struct coding_system *proc_encode_coding_system[MAXDESC];
0fa1789e 316
e690ca94
KS
317#ifdef DATAGRAM_SOCKETS
318/* Table of `partner address' for datagram sockets. */
40ccffa6 319static struct sockaddr_and_len {
e690ca94
KS
320 struct sockaddr *sa;
321 int len;
322} datagram_address[MAXDESC];
323#define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
60f0fb11 324#define DATAGRAM_CONN_P(proc) (PROCESSP (proc) && datagram_address[XPROCESS (proc)->infd].sa != 0)
e690ca94
KS
325#else
326#define DATAGRAM_CHAN_P(chan) (0)
327#define DATAGRAM_CONN_P(proc) (0)
328#endif
329
93b4f699
RS
330/* Maximum number of bytes to send to a pty without an eof. */
331static int pty_max_bytes;
3b9a3dfa 332
d0d6b7c5 333\f
3fad2ad2 334
40ccffa6 335static struct fd_callback_data
3fad2ad2
J
336{
337 fd_callback func;
338 void *data;
339#define FOR_READ 1
340#define FOR_WRITE 2
341 int condition; /* mask of the defines above. */
342} fd_callback_info[MAXDESC];
343
344
345/* Add a file descriptor FD to be monitored for when read is possible.
346 When read is possible, call FUNC with argument DATA. */
347
348void
349add_read_fd (int fd, fd_callback func, void *data)
350{
351 xassert (fd < MAXDESC);
352 add_keyboard_wait_descriptor (fd);
353
354 fd_callback_info[fd].func = func;
355 fd_callback_info[fd].data = data;
356 fd_callback_info[fd].condition |= FOR_READ;
357}
358
359/* Stop monitoring file descriptor FD for when read is possible. */
360
361void
362delete_read_fd (int fd)
363{
364 xassert (fd < MAXDESC);
365 delete_keyboard_wait_descriptor (fd);
366
367 fd_callback_info[fd].condition &= ~FOR_READ;
368 if (fd_callback_info[fd].condition == 0)
369 {
370 fd_callback_info[fd].func = 0;
371 fd_callback_info[fd].data = 0;
372 }
373}
374
375/* Add a file descriptor FD to be monitored for when write is possible.
376 When write is possible, call FUNC with argument DATA. */
377
378void
379add_write_fd (int fd, fd_callback func, void *data)
380{
381 xassert (fd < MAXDESC);
382 FD_SET (fd, &write_mask);
383 if (fd > max_input_desc)
384 max_input_desc = fd;
385
386 fd_callback_info[fd].func = func;
387 fd_callback_info[fd].data = data;
388 fd_callback_info[fd].condition |= FOR_WRITE;
389}
390
391/* Stop monitoring file descriptor FD for when write is possible. */
392
393void
394delete_write_fd (int fd)
395{
396 int lim = max_input_desc;
397
398 xassert (fd < MAXDESC);
399 FD_CLR (fd, &write_mask);
400 fd_callback_info[fd].condition &= ~FOR_WRITE;
401 if (fd_callback_info[fd].condition == 0)
402 {
403 fd_callback_info[fd].func = 0;
404 fd_callback_info[fd].data = 0;
405
406 if (fd == max_input_desc)
407 for (fd = lim; fd >= 0; fd--)
408 if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
409 {
410 max_input_desc = fd;
411 break;
412 }
51b59d79 413
3fad2ad2
J
414 }
415}
416
417\f
d0d6b7c5
JB
418/* Compute the Lisp form of the process status, p->status, from
419 the numeric status that was returned by `wait'. */
420
bba104c1 421static Lisp_Object status_convert (int);
f9738840 422
ff6daed3 423static void
d3da34e0 424update_status (struct Lisp_Process *p)
d0d6b7c5 425{
6bfd98e7 426 eassert (p->raw_status_new);
bba104c1 427 p->status = status_convert (p->raw_status);
6bfd98e7 428 p->raw_status_new = 0;
d0d6b7c5
JB
429}
430
177c0ea7 431/* Convert a process status word in Unix format to
d0d6b7c5
JB
432 the list that we use internally. */
433
ff6daed3 434static Lisp_Object
bba104c1 435status_convert (int w)
d0d6b7c5
JB
436{
437 if (WIFSTOPPED (w))
438 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
439 else if (WIFEXITED (w))
440 return Fcons (Qexit, Fcons (make_number (WRETCODE (w)),
441 WCOREDUMP (w) ? Qt : Qnil));
442 else if (WIFSIGNALED (w))
443 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
444 WCOREDUMP (w) ? Qt : Qnil));
445 else
446 return Qrun;
447}
448
449/* Given a status-list, extract the three pieces of information
450 and store them individually through the three pointers. */
451
ff6daed3 452static void
d3da34e0 453decode_status (Lisp_Object l, Lisp_Object *symbol, int *code, int *coredump)
d0d6b7c5
JB
454{
455 Lisp_Object tem;
456
bcd69aea 457 if (SYMBOLP (l))
d0d6b7c5
JB
458 {
459 *symbol = l;
460 *code = 0;
461 *coredump = 0;
462 }
463 else
464 {
70949dac
KR
465 *symbol = XCAR (l);
466 tem = XCDR (l);
467 *code = XFASTINT (XCAR (tem));
468 tem = XCDR (tem);
d0d6b7c5
JB
469 *coredump = !NILP (tem);
470 }
471}
472
473/* Return a string describing a process status list. */
474
116c423c 475static Lisp_Object
d3da34e0 476status_message (struct Lisp_Process *p)
d0d6b7c5 477{
116c423c 478 Lisp_Object status = p->status;
d0d6b7c5
JB
479 Lisp_Object symbol;
480 int code, coredump;
481 Lisp_Object string, string2;
482
483 decode_status (status, &symbol, &code, &coredump);
484
485 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
486 {
68c45bf0 487 char *signame;
ca9c0567 488 synchronize_system_messages_locale ();
68c45bf0 489 signame = strsignal (code);
b97ad9ea 490 if (signame == 0)
66bd43d1
KH
491 string = build_string ("unknown");
492 else
493 {
494 int c1, c2;
495
496 string = make_unibyte_string (signame, strlen (signame));
497 if (! NILP (Vlocale_coding_system))
498 string = (code_convert_string_norecord
499 (string, Vlocale_coding_system, 0));
42a5b22f 500 c1 = STRING_CHAR (SDATA (string));
5da9919f 501 c2 = downcase (c1);
66bd43d1 502 if (c1 != c2)
4735b74e 503 Faset (string, make_number (0), make_number (c2));
66bd43d1 504 }
d0d6b7c5 505 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
d0d6b7c5
JB
506 return concat2 (string, string2);
507 }
508 else if (EQ (symbol, Qexit))
509 {
116c423c
KS
510 if (NETCONN1_P (p))
511 return build_string (code == 0 ? "deleted\n" : "connection broken by remote peer\n");
d0d6b7c5
JB
512 if (code == 0)
513 return build_string ("finished\n");
f2980264 514 string = Fnumber_to_string (make_number (code));
d0d6b7c5 515 string2 = build_string (coredump ? " (core dumped)\n" : "\n");
e690ca94
KS
516 return concat3 (build_string ("exited abnormally with code "),
517 string, string2);
d0d6b7c5 518 }
dd2a17ab
KS
519 else if (EQ (symbol, Qfailed))
520 {
521 string = Fnumber_to_string (make_number (code));
522 string2 = build_string ("\n");
e690ca94
KS
523 return concat3 (build_string ("failed with code "),
524 string, string2);
dd2a17ab 525 }
d0d6b7c5
JB
526 else
527 return Fcopy_sequence (Fsymbol_name (symbol));
528}
529\f
530#ifdef HAVE_PTYS
d0d6b7c5 531
9bf58201
DN
532/* The file name of the pty opened by allocate_pty. */
533static char pty_name[24];
534
875e6b94
KH
535/* Open an available pty, returning a file descriptor.
536 Return -1 on failure.
537 The file name of the terminal corresponding to the pty
538 is left in the variable pty_name. */
539
ff6daed3 540static int
d3da34e0 541allocate_pty (void)
d0d6b7c5 542{
d0d6b7c5
JB
543 int fd;
544
545#ifdef PTY_ITERATION
546 PTY_ITERATION
547#else
be02381c 548 register int c, i;
d0d6b7c5
JB
549 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
550 for (i = 0; i < 16; i++)
551#endif
552 {
553#ifdef PTY_NAME_SPRINTF
554 PTY_NAME_SPRINTF
d0d6b7c5
JB
555#else
556 sprintf (pty_name, "/dev/pty%c%x", c, i);
d0d6b7c5
JB
557#endif /* no PTY_NAME_SPRINTF */
558
4d7c105e
RS
559#ifdef PTY_OPEN
560 PTY_OPEN;
561#else /* no PTY_OPEN */
34967d0f 562 {
34967d0f
SM
563 { /* Some systems name their pseudoterminals so that there are gaps in
564 the usual sequence - for example, on HP9000/S700 systems, there
565 are no pseudoterminals with names ending in 'f'. So we wait for
566 three failures in a row before deciding that we've reached the
567 end of the ptys. */
568 int failed_count = 0;
57048744 569 struct stat stb;
f3d9532b 570
34967d0f
SM
571 if (stat (pty_name, &stb) < 0)
572 {
573 failed_count++;
574 if (failed_count >= 3)
575 return -1;
576 }
577 else
578 failed_count = 0;
32676c08 579 }
34967d0f
SM
580# ifdef O_NONBLOCK
581 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
582# else
583 fd = emacs_open (pty_name, O_RDWR | O_NDELAY, 0);
584# endif
34967d0f 585 }
4d7c105e 586#endif /* no PTY_OPEN */
d0d6b7c5
JB
587
588 if (fd >= 0)
589 {
590 /* check to make certain that both sides are available
591 this avoids a nasty yet stupid bug in rlogins */
592#ifdef PTY_TTY_NAME_SPRINTF
593 PTY_TTY_NAME_SPRINTF
d0d6b7c5 594#else
63136da6 595 sprintf (pty_name, "/dev/tty%c%x", c, i);
d0d6b7c5 596#endif /* no PTY_TTY_NAME_SPRINTF */
d0d6b7c5
JB
597 if (access (pty_name, 6) != 0)
598 {
68c45bf0 599 emacs_close (fd);
132d0475 600# ifndef __sgi
d0d6b7c5 601 continue;
34967d0f 602# else
d0d6b7c5 603 return -1;
132d0475 604# endif /* __sgi */
d0d6b7c5 605 }
d0d6b7c5
JB
606 setup_pty (fd);
607 return fd;
608 }
609 }
610 return -1;
611}
612#endif /* HAVE_PTYS */
613\f
ff6daed3 614static Lisp_Object
d3da34e0 615make_process (Lisp_Object name)
d0d6b7c5
JB
616{
617 register Lisp_Object val, tem, name1;
618 register struct Lisp_Process *p;
31c286f7
PE
619 char suffix[sizeof "<>" + INT_STRLEN_BOUND (printmax_t)];
620 printmax_t i;
d0d6b7c5 621
98423852 622 p = allocate_process ();
23d6bb9c 623
60f0fb11
SM
624 p->infd = -1;
625 p->outfd = -1;
626 p->tick = 0;
627 p->update_tick = 0;
6bfd98e7 628 p->pid = 0;
fd41ad98 629 p->pty_flag = 0;
6bfd98e7 630 p->raw_status_new = 0;
d0d6b7c5
JB
631 p->status = Qrun;
632 p->mark = Fmake_marker ();
847c048e 633 p->kill_without_query = 0;
d0d6b7c5 634
6b61353c 635#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11
SM
636 p->adaptive_read_buffering = 0;
637 p->read_output_delay = 0;
638 p->read_output_skip = 0;
6b61353c
KH
639#endif
640
8af55556
TZ
641#ifdef HAVE_GNUTLS
642 p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
8ed70bf3 643 p->gnutls_log_level = 0;
df7fcaff 644 p->gnutls_p = 0;
435c1d67 645 p->gnutls_state = NULL;
9c6c6f49
CY
646 p->gnutls_x509_cred = NULL;
647 p->gnutls_anon_cred = NULL;
8af55556
TZ
648#endif
649
d0d6b7c5
JB
650 /* If name is already in use, modify it until it is unused. */
651
652 name1 = name;
653 for (i = 1; ; i++)
654 {
655 tem = Fget_process (name1);
656 if (NILP (tem)) break;
31c286f7 657 sprintf (suffix, "<%"pMd">", i);
d0d6b7c5
JB
658 name1 = concat2 (name, build_string (suffix));
659 }
660 name = name1;
661 p->name = name;
23d6bb9c 662 XSETPROCESS (val, p);
d0d6b7c5
JB
663 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
664 return val;
665}
666
ff6daed3 667static void
d3da34e0 668remove_process (register Lisp_Object proc)
d0d6b7c5
JB
669{
670 register Lisp_Object pair;
671
672 pair = Frassq (proc, Vprocess_alist);
673 Vprocess_alist = Fdelq (pair, Vprocess_alist);
d0d6b7c5
JB
674
675 deactivate_process (proc);
676}
03f04413 677
d0d6b7c5
JB
678\f
679DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
fdb82f93 680 doc: /* Return t if OBJECT is a process. */)
5842a27b 681 (Lisp_Object object)
d0d6b7c5 682{
4ee3e309 683 return PROCESSP (object) ? Qt : Qnil;
d0d6b7c5
JB
684}
685
686DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
fdb82f93 687 doc: /* Return the process named NAME, or nil if there is none. */)
5842a27b 688 (register Lisp_Object name)
d0d6b7c5 689{
bcd69aea 690 if (PROCESSP (name))
d0d6b7c5 691 return name;
b7826503 692 CHECK_STRING (name);
d0d6b7c5
JB
693 return Fcdr (Fassoc (name, Vprocess_alist));
694}
695
ebb9e16f
JB
696/* This is how commands for the user decode process arguments. It
697 accepts a process, a process name, a buffer, a buffer name, or nil.
698 Buffers denote the first process in the buffer, and nil denotes the
699 current buffer. */
d0d6b7c5 700
77b221b1 701static Lisp_Object
d3da34e0 702get_process (register Lisp_Object name)
d0d6b7c5 703{
1619761d
KH
704 register Lisp_Object proc, obj;
705 if (STRINGP (name))
706 {
707 obj = Fget_process (name);
708 if (NILP (obj))
709 obj = Fget_buffer (name);
710 if (NILP (obj))
d5db4077 711 error ("Process %s does not exist", SDATA (name));
1619761d
KH
712 }
713 else if (NILP (name))
714 obj = Fcurrent_buffer ();
d0d6b7c5 715 else
1619761d
KH
716 obj = name;
717
718 /* Now obj should be either a buffer object or a process object.
719 */
720 if (BUFFERP (obj))
d0d6b7c5 721 {
1619761d 722 proc = Fget_buffer_process (obj);
d0d6b7c5 723 if (NILP (proc))
4b4deea2 724 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
d0d6b7c5 725 }
d0d6b7c5 726 else
1619761d 727 {
b7826503 728 CHECK_PROCESS (obj);
1619761d
KH
729 proc = obj;
730 }
731 return proc;
d0d6b7c5
JB
732}
733
a5cfdda8
KS
734
735#ifdef SIGCHLD
736/* Fdelete_process promises to immediately forget about the process, but in
737 reality, Emacs needs to remember those processes until they have been
738 treated by sigchld_handler; otherwise this handler would consider the
739 process as being synchronous and say that the synchronous process is
740 dead. */
741static Lisp_Object deleted_pid_list;
742#endif
743
d0d6b7c5 744DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
fdb82f93
PJ
745 doc: /* Delete PROCESS: kill it and forget about it immediately.
746PROCESS may be a process, a buffer, the name of a process or buffer, or
747nil, indicating the current buffer's process. */)
5842a27b 748 (register Lisp_Object process)
d0d6b7c5 749{
ff6daed3
KS
750 register struct Lisp_Process *p;
751
4ee3e309 752 process = get_process (process);
ff6daed3
KS
753 p = XPROCESS (process);
754
6bfd98e7 755 p->raw_status_new = 0;
d888760c 756 if (NETCONN1_P (p) || SERIALCONN1_P (p))
d0d6b7c5 757 {
ff6daed3 758 p->status = Fcons (Qexit, Fcons (make_number (0), Qnil));
60f0fb11 759 p->tick = ++process_tick;
ff6daed3 760 status_notify (p);
e42bdf01 761 redisplay_preserve_echo_area (13);
d0d6b7c5 762 }
60f0fb11 763 else if (p->infd >= 0)
d0d6b7c5 764 {
a5cfdda8
KS
765#ifdef SIGCHLD
766 Lisp_Object symbol;
d30fe779
EZ
767 /* Assignment to EMACS_INT stops GCC whining about limited range
768 of data type. */
29ed4d51 769 EMACS_INT pid = p->pid;
a5cfdda8
KS
770
771 /* No problem storing the pid here, as it is still in Vprocess_alist. */
d30fe779 772 deleted_pid_list = Fcons (make_fixnum_or_float (pid),
a5cfdda8
KS
773 /* GC treated elements set to nil. */
774 Fdelq (Qnil, deleted_pid_list));
775 /* If the process has already signaled, remove it from the list. */
776 if (p->raw_status_new)
777 update_status (p);
778 symbol = p->status;
779 if (CONSP (p->status))
780 symbol = XCAR (p->status);
781 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit))
29ed4d51
CY
782 deleted_pid_list
783 = Fdelete (make_fixnum_or_float (pid), deleted_pid_list);
a5cfdda8
KS
784 else
785#endif
786 {
787 Fkill_process (process, Qnil);
788 /* Do this now, since remove_process will make sigchld_handler do nothing. */
789 p->status
790 = Fcons (Qsignal, Fcons (make_number (SIGKILL), Qnil));
60f0fb11 791 p->tick = ++process_tick;
a5cfdda8 792 status_notify (p);
e42bdf01 793 redisplay_preserve_echo_area (13);
a5cfdda8 794 }
d0d6b7c5 795 }
4ee3e309 796 remove_process (process);
d0d6b7c5
JB
797 return Qnil;
798}
799\f
800DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
fdb82f93
PJ
801 doc: /* Return the status of PROCESS.
802The returned value is one of the following symbols:
803run -- for a process that is running.
804stop -- for a process stopped but continuable.
805exit -- for a process that has exited.
806signal -- for a process that has got a fatal signal.
807open -- for a network stream connection that is open.
e690ca94 808listen -- for a network stream server that is listening.
fdb82f93 809closed -- for a network stream connection that is closed.
e4984112
KS
810connect -- when waiting for a non-blocking connection to complete.
811failed -- when a non-blocking connection has failed.
fdb82f93
PJ
812nil -- if arg is a process name and no such process exists.
813PROCESS may be a process, a buffer, the name of a process, or
814nil, indicating the current buffer's process. */)
5842a27b 815 (register Lisp_Object process)
d0d6b7c5
JB
816{
817 register struct Lisp_Process *p;
818 register Lisp_Object status;
343f4114 819
4ee3e309
EN
820 if (STRINGP (process))
821 process = Fget_process (process);
343f4114 822 else
4ee3e309 823 process = get_process (process);
343f4114 824
4ee3e309
EN
825 if (NILP (process))
826 return process;
343f4114 827
4ee3e309 828 p = XPROCESS (process);
6bfd98e7 829 if (p->raw_status_new)
d0d6b7c5
JB
830 update_status (p);
831 status = p->status;
bcd69aea 832 if (CONSP (status))
70949dac 833 status = XCAR (status);
d888760c 834 if (NETCONN1_P (p) || SERIALCONN1_P (p))
d0d6b7c5 835 {
e690ca94 836 if (EQ (status, Qexit))
d0d6b7c5 837 status = Qclosed;
e690ca94
KS
838 else if (EQ (p->command, Qt))
839 status = Qstop;
840 else if (EQ (status, Qrun))
841 status = Qopen;
d0d6b7c5
JB
842 }
843 return status;
844}
845
846DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
847 1, 1, 0,
fdb82f93
PJ
848 doc: /* Return the exit status of PROCESS or the signal number that killed it.
849If PROCESS has not yet exited or died, return 0. */)
5842a27b 850 (register Lisp_Object process)
d0d6b7c5 851{
b7826503 852 CHECK_PROCESS (process);
6bfd98e7 853 if (XPROCESS (process)->raw_status_new)
4ee3e309
EN
854 update_status (XPROCESS (process));
855 if (CONSP (XPROCESS (process)->status))
70949dac 856 return XCAR (XCDR (XPROCESS (process)->status));
d0d6b7c5
JB
857 return make_number (0);
858}
859
860DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
fdb82f93 861 doc: /* Return the process id of PROCESS.
f3d9532b 862This is the pid of the external process which PROCESS uses or talks to.
fdb82f93 863For a network connection, this value is nil. */)
5842a27b 864 (register Lisp_Object process)
d0d6b7c5 865{
d30fe779
EZ
866 /* Assignment to EMACS_INT stops GCC whining about limited range of
867 data type. */
868 EMACS_INT pid;
869
b7826503 870 CHECK_PROCESS (process);
d30fe779
EZ
871 pid = XPROCESS (process)->pid;
872 return (pid ? make_fixnum_or_float (pid) : Qnil);
d0d6b7c5
JB
873}
874
875DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
fdb82f93
PJ
876 doc: /* Return the name of PROCESS, as a string.
877This is the name of the program invoked in PROCESS,
878possibly modified to make it unique among process names. */)
5842a27b 879 (register Lisp_Object process)
d0d6b7c5 880{
b7826503 881 CHECK_PROCESS (process);
4ee3e309 882 return XPROCESS (process)->name;
d0d6b7c5
JB
883}
884
885DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
fdb82f93
PJ
886 doc: /* Return the command that was executed to start PROCESS.
887This is a list of strings, the first string being the program executed
888and the rest of the strings being the arguments given to it.
d888760c
GM
889For a network or serial process, this is nil (process is running) or t
890\(process is stopped). */)
5842a27b 891 (register Lisp_Object process)
d0d6b7c5 892{
b7826503 893 CHECK_PROCESS (process);
4ee3e309 894 return XPROCESS (process)->command;
d0d6b7c5
JB
895}
896
3b9a3dfa 897DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
fdb82f93
PJ
898 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
899This is the terminal that the process itself reads and writes on,
900not the name of the pty that Emacs uses to talk with that terminal. */)
5842a27b 901 (register Lisp_Object process)
3b9a3dfa 902{
b7826503 903 CHECK_PROCESS (process);
4ee3e309 904 return XPROCESS (process)->tty_name;
3b9a3dfa
RS
905}
906
d0d6b7c5 907DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
fdb82f93 908 2, 2, 0,
76147d94
DD
909 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
910Return BUFFER. */)
5842a27b 911 (register Lisp_Object process, Lisp_Object buffer)
d0d6b7c5 912{
e690ca94
KS
913 struct Lisp_Process *p;
914
b7826503 915 CHECK_PROCESS (process);
d0d6b7c5 916 if (!NILP (buffer))
b7826503 917 CHECK_BUFFER (buffer);
e690ca94
KS
918 p = XPROCESS (process);
919 p->buffer = buffer;
d888760c 920 if (NETCONN1_P (p) || SERIALCONN1_P (p))
e690ca94 921 p->childp = Fplist_put (p->childp, QCbuffer, buffer);
03f04413 922 setup_process_coding_systems (process);
d0d6b7c5
JB
923 return buffer;
924}
925
926DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
fdb82f93
PJ
927 1, 1, 0,
928 doc: /* Return the buffer PROCESS is associated with.
929Output from PROCESS is inserted in this buffer unless PROCESS has a filter. */)
5842a27b 930 (register Lisp_Object process)
d0d6b7c5 931{
b7826503 932 CHECK_PROCESS (process);
4ee3e309 933 return XPROCESS (process)->buffer;
d0d6b7c5
JB
934}
935
936DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
fdb82f93
PJ
937 1, 1, 0,
938 doc: /* Return the marker for the end of the last output from PROCESS. */)
5842a27b 939 (register Lisp_Object process)
d0d6b7c5 940{
b7826503 941 CHECK_PROCESS (process);
4ee3e309 942 return XPROCESS (process)->mark;
d0d6b7c5
JB
943}
944
945DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
fdb82f93
PJ
946 2, 2, 0,
947 doc: /* Give PROCESS the filter function FILTER; nil means no filter.
7b82c3b6 948A value of t means stop accepting output from the process.
3452df9e
KS
949
950When a process has a filter, its buffer is not used for output.
951Instead, each time it does output, the entire string of output is
177c0ea7 952passed to the filter.
3452df9e 953
fdb82f93 954The filter gets two arguments: the process and the string of output.
3452df9e
KS
955The string argument is normally a multibyte string, except:
956- if the process' input coding system is no-conversion or raw-text,
957 it is a unibyte string (the non-converted input), or else
958- if `default-enable-multibyte-characters' is nil, it is a unibyte
959 string (the result of converting the decoded input multibyte
960 string to unibyte with `string-make-unibyte'). */)
5842a27b 961 (register Lisp_Object process, Lisp_Object filter)
d0d6b7c5 962{
471f86b9 963 struct Lisp_Process *p;
177c0ea7 964
b7826503 965 CHECK_PROCESS (process);
471f86b9
GM
966 p = XPROCESS (process);
967
968 /* Don't signal an error if the process' input file descriptor
969 is closed. This could make debugging Lisp more difficult,
970 for example when doing something like
971
972 (setq process (start-process ...))
973 (debug)
974 (set-process-filter process ...) */
177c0ea7 975
60f0fb11 976 if (p->infd >= 0)
a69281ff 977 {
e690ca94 978 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
471f86b9 979 {
60f0fb11
SM
980 FD_CLR (p->infd, &input_wait_mask);
981 FD_CLR (p->infd, &non_keyboard_wait_mask);
471f86b9 982 }
e690ca94 983 else if (EQ (p->filter, Qt)
d888760c
GM
984 /* Network or serial process not stopped: */
985 && !EQ (p->command, Qt))
471f86b9 986 {
60f0fb11
SM
987 FD_SET (p->infd, &input_wait_mask);
988 FD_SET (p->infd, &non_keyboard_wait_mask);
471f86b9 989 }
a69281ff 990 }
177c0ea7 991
471f86b9 992 p->filter = filter;
d888760c 993 if (NETCONN1_P (p) || SERIALCONN1_P (p))
e690ca94 994 p->childp = Fplist_put (p->childp, QCfilter, filter);
03f04413 995 setup_process_coding_systems (process);
d0d6b7c5
JB
996 return filter;
997}
998
999DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
fdb82f93
PJ
1000 1, 1, 0,
1001 doc: /* Returns the filter function of PROCESS; nil if none.
1002See `set-process-filter' for more info on filter functions. */)
5842a27b 1003 (register Lisp_Object process)
d0d6b7c5 1004{
b7826503 1005 CHECK_PROCESS (process);
4ee3e309 1006 return XPROCESS (process)->filter;
d0d6b7c5
JB
1007}
1008
1009DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
fdb82f93
PJ
1010 2, 2, 0,
1011 doc: /* Give PROCESS the sentinel SENTINEL; nil for none.
1012The sentinel is called as a function when the process changes state.
1013It gets two arguments: the process, and a string describing the change. */)
5842a27b 1014 (register Lisp_Object process, Lisp_Object sentinel)
d0d6b7c5 1015{
6b61353c
KH
1016 struct Lisp_Process *p;
1017
b7826503 1018 CHECK_PROCESS (process);
6b61353c
KH
1019 p = XPROCESS (process);
1020
1021 p->sentinel = sentinel;
d888760c 1022 if (NETCONN1_P (p) || SERIALCONN1_P (p))
6b61353c 1023 p->childp = Fplist_put (p->childp, QCsentinel, sentinel);
d0d6b7c5
JB
1024 return sentinel;
1025}
1026
1027DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
fdb82f93
PJ
1028 1, 1, 0,
1029 doc: /* Return the sentinel of PROCESS; nil if none.
1030See `set-process-sentinel' for more info on sentinels. */)
5842a27b 1031 (register Lisp_Object process)
d0d6b7c5 1032{
b7826503 1033 CHECK_PROCESS (process);
4ee3e309 1034 return XPROCESS (process)->sentinel;
d0d6b7c5
JB
1035}
1036
396df322 1037DEFUN ("set-process-window-size", Fset_process_window_size,
fdb82f93
PJ
1038 Sset_process_window_size, 3, 3, 0,
1039 doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
5842a27b 1040 (register Lisp_Object process, Lisp_Object height, Lisp_Object width)
396df322 1041{
b7826503
PJ
1042 CHECK_PROCESS (process);
1043 CHECK_NATNUM (height);
1044 CHECK_NATNUM (width);
177c0ea7 1045
60f0fb11
SM
1046 if (XPROCESS (process)->infd < 0
1047 || set_window_size (XPROCESS (process)->infd,
471f86b9 1048 XINT (height), XINT (width)) <= 0)
396df322
RS
1049 return Qnil;
1050 else
1051 return Qt;
1052}
1053
52a1b894 1054DEFUN ("set-process-inherit-coding-system-flag",
fdb82f93
PJ
1055 Fset_process_inherit_coding_system_flag,
1056 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1057 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1058If the second argument FLAG is non-nil, then the variable
1059`buffer-file-coding-system' of the buffer associated with PROCESS
1060will be bound to the value of the coding system used to decode
1061the process output.
1062
1063This is useful when the coding system specified for the process buffer
1064leaves either the character code conversion or the end-of-line conversion
1065unspecified, or if the coding system used to decode the process output
1066is more appropriate for saving the process buffer.
1067
1068Binding the variable `inherit-process-coding-system' to non-nil before
1069starting the process is an alternative way of setting the inherit flag
1070for the process which will run. */)
5842a27b 1071 (register Lisp_Object process, Lisp_Object flag)
52a1b894 1072{
b7826503 1073 CHECK_PROCESS (process);
60f0fb11 1074 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
52a1b894
EZ
1075 return flag;
1076}
1077
e690ca94
KS
1078DEFUN ("set-process-query-on-exit-flag",
1079 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1080 2, 2, 0,
1081 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
f3d9532b 1082If the second argument FLAG is non-nil, Emacs will query the user before
10be7e0d 1083exiting or killing a buffer if PROCESS is running. */)
5842a27b 1084 (register Lisp_Object process, Lisp_Object flag)
d0d6b7c5 1085{
b7826503 1086 CHECK_PROCESS (process);
60f0fb11 1087 XPROCESS (process)->kill_without_query = NILP (flag);
e690ca94 1088 return flag;
d0d6b7c5 1089}
312c9964 1090
e690ca94
KS
1091DEFUN ("process-query-on-exit-flag",
1092 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
fdb82f93 1093 1, 1, 0,
f3d9532b 1094 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
5842a27b 1095 (register Lisp_Object process)
de282a05 1096{
b7826503 1097 CHECK_PROCESS (process);
60f0fb11 1098 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
e690ca94
KS
1099}
1100
1101#ifdef DATAGRAM_SOCKETS
cd64ea1d 1102static Lisp_Object Fprocess_datagram_address (Lisp_Object);
e690ca94
KS
1103#endif
1104
1105DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1106 1, 2, 0,
1107 doc: /* Return the contact info of PROCESS; t for a real child.
d888760c
GM
1108For a network or serial connection, the value depends on the optional
1109KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1110SERVICE) for a network connection or (PORT SPEED) for a serial
1111connection. If KEY is t, the complete contact information for the
1112connection is returned, else the specific value for the keyword KEY is
1113returned. See `make-network-process' or `make-serial-process' for a
1114list of keywords. */)
5842a27b 1115 (register Lisp_Object process, Lisp_Object key)
e690ca94
KS
1116{
1117 Lisp_Object contact;
1118
1119 CHECK_PROCESS (process);
1120 contact = XPROCESS (process)->childp;
1121
1122#ifdef DATAGRAM_SOCKETS
1123 if (DATAGRAM_CONN_P (process)
1124 && (EQ (key, Qt) || EQ (key, QCremote)))
177c0ea7 1125 contact = Fplist_put (contact, QCremote,
e690ca94
KS
1126 Fprocess_datagram_address (process));
1127#endif
1128
d888760c 1129 if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt))
e690ca94 1130 return contact;
d888760c 1131 if (NILP (key) && NETCONN_P (process))
e690ca94
KS
1132 return Fcons (Fplist_get (contact, QChost),
1133 Fcons (Fplist_get (contact, QCservice), Qnil));
d888760c
GM
1134 if (NILP (key) && SERIALCONN_P (process))
1135 return Fcons (Fplist_get (contact, QCport),
1136 Fcons (Fplist_get (contact, QCspeed), Qnil));
e690ca94 1137 return Fplist_get (contact, key);
de282a05
RS
1138}
1139
faa7db08
KS
1140DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1141 1, 1, 0,
1142 doc: /* Return the plist of PROCESS. */)
5842a27b 1143 (register Lisp_Object process)
365aee82 1144{
ac4a7584 1145 CHECK_PROCESS (process);
faa7db08 1146 return XPROCESS (process)->plist;
ac4a7584 1147}
365aee82 1148
faa7db08
KS
1149DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1150 2, 2, 0,
26a086c6 1151 doc: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
5842a27b 1152 (register Lisp_Object process, Lisp_Object plist)
ac4a7584 1153{
365aee82 1154 CHECK_PROCESS (process);
faa7db08 1155 CHECK_LIST (plist);
365aee82 1156
faa7db08 1157 XPROCESS (process)->plist = plist;
26a086c6 1158 return plist;
365aee82
KS
1159}
1160
312c9964
RS
1161#if 0 /* Turned off because we don't currently record this info
1162 in the process. Perhaps add it. */
1163DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
fdb82f93
PJ
1164 doc: /* Return the connection type of PROCESS.
1165The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1166a socket connection. */)
5842a27b 1167 (Lisp_Object process)
312c9964
RS
1168{
1169 return XPROCESS (process)->type;
1170}
1171#endif
2a7bb882 1172
d888760c
GM
1173DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1174 doc: /* Return the connection type of PROCESS.
1175The value is either the symbol `real', `network', or `serial'.
1176PROCESS may be a process, a buffer, the name of a process or buffer, or
1177nil, indicating the current buffer's process. */)
5842a27b 1178 (Lisp_Object process)
d888760c
GM
1179{
1180 Lisp_Object proc;
1181 proc = get_process (process);
1182 return XPROCESS (proc)->type;
1183}
991234f0 1184
991234f0 1185DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
0dccee41 1186 1, 2, 0,
991234f0 1187 doc: /* Convert network ADDRESS from internal format to a string.
e1652a86
KS
1188A 4 or 5 element vector represents an IPv4 address (with port number).
1189An 8 or 9 element vector represents an IPv6 address (with port number).
0dccee41 1190If optional second argument OMIT-PORT is non-nil, don't include a port
e1652a86
KS
1191number in the string, even when present in ADDRESS.
1192Returns nil if format of ADDRESS is invalid. */)
5842a27b 1193 (Lisp_Object address, Lisp_Object omit_port)
991234f0 1194{
991234f0
KS
1195 if (NILP (address))
1196 return Qnil;
1197
1198 if (STRINGP (address)) /* AF_LOCAL */
1199 return address;
1200
e1652a86 1201 if (VECTORP (address)) /* AF_INET or AF_INET6 */
991234f0
KS
1202 {
1203 register struct Lisp_Vector *p = XVECTOR (address);
3d1e65a1 1204 EMACS_INT size = p->header.size;
ded83665 1205 Lisp_Object args[10];
0dccee41 1206 int nargs, i;
991234f0 1207
eab3844f 1208 if (size == 4 || (size == 5 && !NILP (omit_port)))
0dccee41
KS
1209 {
1210 args[0] = build_string ("%d.%d.%d.%d");
1211 nargs = 4;
1212 }
eab3844f 1213 else if (size == 5)
0dccee41
KS
1214 {
1215 args[0] = build_string ("%d.%d.%d.%d:%d");
1216 nargs = 5;
1217 }
eab3844f 1218 else if (size == 8 || (size == 9 && !NILP (omit_port)))
e1652a86
KS
1219 {
1220 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
1221 nargs = 8;
1222 }
eab3844f 1223 else if (size == 9)
e1652a86
KS
1224 {
1225 args[0] = build_string ("[%x:%x:%x:%x:%x:%x:%x:%x]:%d");
1226 nargs = 9;
1227 }
0dccee41 1228 else
991234f0
KS
1229 return Qnil;
1230
0dccee41 1231 for (i = 0; i < nargs; i++)
cbf23adb
JB
1232 {
1233 EMACS_INT element = XINT (p->contents[i]);
1234
1235 if (element < 0 || element > 65535)
1236 return Qnil;
1237
1238 if (nargs <= 5 /* IPv4 */
1239 && i < 4 /* host, not port */
1240 && element > 255)
1241 return Qnil;
1242
1243 args[i+1] = p->contents[i];
1244 }
1245
0dccee41 1246 return Fformat (nargs+1, args);
991234f0
KS
1247 }
1248
1249 if (CONSP (address))
1250 {
1251 Lisp_Object args[2];
1252 args[0] = build_string ("<Family %d>");
8d2ff840 1253 args[1] = Fcar (address);
991234f0 1254 return Fformat (2, args);
991234f0
KS
1255 }
1256
1257 return Qnil;
1258}
d0d6b7c5
JB
1259
1260DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
fdb82f93 1261 doc: /* Return a list of all processes. */)
5842a27b 1262 (void)
d0d6b7c5
JB
1263{
1264 return Fmapcar (Qcdr, Vprocess_alist);
1265}
1266\f
b0310da4
JB
1267/* Starting asynchronous inferior processes. */
1268
d3da34e0 1269static Lisp_Object start_process_unwind (Lisp_Object proc);
b0310da4 1270
d0d6b7c5 1271DEFUN ("start-process", Fstart_process, Sstart_process, 3, MANY, 0,
fdb82f93
PJ
1272 doc: /* Start a program in a subprocess. Return the process object for it.
1273NAME is name for process. It is modified if necessary to make it unique.
553acde5 1274BUFFER is the buffer (or buffer name) to associate with the process.
4b6c5eee
EZ
1275
1276Process output (both standard output and standard error streams) goes
1277at end of BUFFER, unless you specify an output stream or filter
1278function to handle the output. BUFFER may also be nil, meaning that
16fdeb17
RS
1279this process is not associated with any buffer.
1280
6b8bc570
CY
1281PROGRAM is the program file name. It is searched for in `exec-path'
1282(which see). If nil, just associate a pty with the buffer. Remaining
1283arguments are strings to give program as arguments.
320aebc9 1284
4b6c5eee
EZ
1285If you want to separate standard output from standard error, invoke
1286the command through a shell and redirect one of them using the shell
1287syntax.
320aebc9 1288
3ecdf100 1289usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */)
f66c7cf8 1290 (ptrdiff_t nargs, Lisp_Object *args)
d0d6b7c5 1291{
1e30af70 1292 Lisp_Object buffer, name, program, proc, current_dir, tem;
d0d6b7c5 1293 register unsigned char **new_argv;
f66c7cf8 1294 ptrdiff_t i;
aed13378 1295 int count = SPECPDL_INDEX ();
d0d6b7c5
JB
1296
1297 buffer = args[1];
1298 if (!NILP (buffer))
1299 buffer = Fget_buffer_create (buffer);
1300
1e30af70
JB
1301 /* Make sure that the child will be able to chdir to the current
1302 buffer's current directory, or its unhandled equivalent. We
1303 can't just have the child check for an error when it does the
1304 chdir, since it's in a vfork.
1305
1306 We have to GCPRO around this because Fexpand_file_name and
1307 Funhandled_file_name_directory might call a file name handling
1308 function. The argument list is protected by the caller, so all
1309 we really have to worry about is buffer. */
1310 {
1311 struct gcpro gcpro1, gcpro2;
1312
4b4deea2 1313 current_dir = BVAR (current_buffer, directory);
1e30af70
JB
1314
1315 GCPRO2 (buffer, current_dir);
1316
ca319910
SM
1317 current_dir = Funhandled_file_name_directory (current_dir);
1318 if (NILP (current_dir))
1319 /* If the file name handler says that current_dir is unreachable, use
1320 a sensible default. */
1321 current_dir = build_string ("~/");
1322 current_dir = expand_and_dir_to_file (current_dir, Qnil);
1e30af70
JB
1323 if (NILP (Ffile_accessible_directory_p (current_dir)))
1324 report_file_error ("Setting current directory",
4b4deea2 1325 Fcons (BVAR (current_buffer, directory), Qnil));
1e30af70
JB
1326
1327 UNGCPRO;
1328 }
1329
d0d6b7c5 1330 name = args[0];
b7826503 1331 CHECK_STRING (name);
d0d6b7c5
JB
1332
1333 program = args[2];
1334
850d0752
NR
1335 if (!NILP (program))
1336 CHECK_STRING (program);
d0d6b7c5 1337
d0d6b7c5 1338 proc = make_process (name);
b0310da4
JB
1339 /* If an error occurs and we can't start the process, we want to
1340 remove it from the process list. This means that each error
1341 check in create_process doesn't need to call remove_process
1342 itself; it's all taken care of here. */
1343 record_unwind_protect (start_process_unwind, proc);
d0d6b7c5
JB
1344
1345 XPROCESS (proc)->childp = Qt;
faa7db08 1346 XPROCESS (proc)->plist = Qnil;
d888760c 1347 XPROCESS (proc)->type = Qreal;
d0d6b7c5
JB
1348 XPROCESS (proc)->buffer = buffer;
1349 XPROCESS (proc)->sentinel = Qnil;
1350 XPROCESS (proc)->filter = Qnil;
1351 XPROCESS (proc)->command = Flist (nargs - 2, args + 2);
1352
8af55556
TZ
1353#ifdef HAVE_GNUTLS
1354 /* AKA GNUTLS_INITSTAGE(proc). */
1355 XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY;
1356 XPROCESS (proc)->gnutls_cred_type = Qnil;
1357#endif
1358
6b61353c 1359#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11
SM
1360 XPROCESS (proc)->adaptive_read_buffering
1361 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1362 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
6b61353c
KH
1363#endif
1364
7af71e17 1365 /* Make the process marker point into the process buffer (if any). */
f523e0c3 1366 if (BUFFERP (buffer))
d8a2934e
RS
1367 set_marker_both (XPROCESS (proc)->mark, buffer,
1368 BUF_ZV (XBUFFER (buffer)),
1369 BUF_ZV_BYTE (XBUFFER (buffer)));
7af71e17 1370
67918941 1371 {
d5d4ae71
KH
1372 /* Decide coding systems for communicating with the process. Here
1373 we don't setup the structure coding_system nor pay attention to
1374 unibyte mode. They are done in create_process. */
1375
67918941
RS
1376 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1377 Lisp_Object coding_systems = Qt;
1378 Lisp_Object val, *args2;
a4a37e65 1379 struct gcpro gcpro1, gcpro2;
67918941 1380
d5d4ae71
KH
1381 val = Vcoding_system_for_read;
1382 if (NILP (val))
67918941
RS
1383 {
1384 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
1385 args2[0] = Qstart_process;
1386 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
a4a37e65 1387 GCPRO2 (proc, current_dir);
850d0752
NR
1388 if (!NILP (program))
1389 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
67918941
RS
1390 UNGCPRO;
1391 if (CONSP (coding_systems))
70949dac 1392 val = XCAR (coding_systems);
67918941 1393 else if (CONSP (Vdefault_process_coding_system))
70949dac 1394 val = XCAR (Vdefault_process_coding_system);
67918941
RS
1395 }
1396 XPROCESS (proc)->decode_coding_system = val;
1397
d5d4ae71
KH
1398 val = Vcoding_system_for_write;
1399 if (NILP (val))
67918941
RS
1400 {
1401 if (EQ (coding_systems, Qt))
1402 {
dd5963ea 1403 args2 = (Lisp_Object *) alloca ((nargs + 1) * sizeof *args2);
67918941
RS
1404 args2[0] = Qstart_process;
1405 for (i = 0; i < nargs; i++) args2[i + 1] = args[i];
a4a37e65 1406 GCPRO2 (proc, current_dir);
850d0752
NR
1407 if (!NILP (program))
1408 coding_systems = Ffind_operation_coding_system (nargs + 1, args2);
67918941
RS
1409 UNGCPRO;
1410 }
1411 if (CONSP (coding_systems))
70949dac 1412 val = XCDR (coding_systems);
67918941 1413 else if (CONSP (Vdefault_process_coding_system))
70949dac 1414 val = XCDR (Vdefault_process_coding_system);
67918941
RS
1415 }
1416 XPROCESS (proc)->encode_coding_system = val;
e1dbe924 1417 /* Note: At this moment, the above coding system may leave
fcaf8878
KH
1418 text-conversion or eol-conversion unspecified. They will be
1419 decided after we read output from the process and decode it by
1420 some coding system, or just before we actually send a text to
1421 the process. */
67918941 1422 }
0fa1789e 1423
a4a37e65 1424
cbe81f1d 1425 XPROCESS (proc)->decoding_buf = empty_unibyte_string;
850d0752 1426 XPROCESS (proc)->decoding_carryover = 0;
cbe81f1d 1427 XPROCESS (proc)->encoding_buf = empty_unibyte_string;
ed30cf85 1428
850d0752
NR
1429 XPROCESS (proc)->inherit_coding_system_flag
1430 = !(NILP (buffer) || !inherit_process_coding_system);
77bf07e1 1431
850d0752
NR
1432 if (!NILP (program))
1433 {
1434 /* If program file name is not absolute, search our path for it.
1435 Put the name we will really use in TEM. */
1436 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1437 && !(SCHARS (program) > 1
1438 && IS_DEVICE_SEP (SREF (program, 1))))
1439 {
1440 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1441
1442 tem = Qnil;
1443 GCPRO4 (name, program, buffer, current_dir);
1444 openp (Vexec_path, program, Vexec_suffixes, &tem, make_number (X_OK));
1445 UNGCPRO;
1446 if (NILP (tem))
1447 report_file_error ("Searching for program", Fcons (program, Qnil));
1448 tem = Fexpand_file_name (tem, Qnil);
1449 }
1450 else
1451 {
1452 if (!NILP (Ffile_directory_p (program)))
1453 error ("Specified program for new process is a directory");
1454 tem = program;
1455 }
ed30cf85 1456
850d0752
NR
1457 /* If program file name starts with /: for quoting a magic name,
1458 discard that. */
1459 if (SBYTES (tem) > 2 && SREF (tem, 0) == '/'
1460 && SREF (tem, 1) == ':')
1461 tem = Fsubstring (tem, make_number (2), Qnil);
77bf07e1 1462
77bf07e1 1463 {
fcaf8878 1464 Lisp_Object arg_encoding = Qnil;
850d0752
NR
1465 struct gcpro gcpro1;
1466 GCPRO1 (tem);
a4a37e65 1467
850d0752
NR
1468 /* Encode the file name and put it in NEW_ARGV.
1469 That's where the child will use it to execute the program. */
1470 tem = Fcons (ENCODE_FILE (tem), Qnil);
77bf07e1 1471
850d0752
NR
1472 /* Here we encode arguments by the coding system used for sending
1473 data to the process. We don't support using different coding
1474 systems for encoding arguments and for encoding data sent to the
1475 process. */
77bf07e1 1476
850d0752
NR
1477 for (i = 3; i < nargs; i++)
1478 {
1479 tem = Fcons (args[i], tem);
1480 CHECK_STRING (XCAR (tem));
1481 if (STRING_MULTIBYTE (XCAR (tem)))
fcaf8878
KH
1482 {
1483 if (NILP (arg_encoding))
1484 arg_encoding = (complement_process_encoding_system
1485 (XPROCESS (proc)->encode_coding_system));
1486 XSETCAR (tem,
1487 code_convert_string_norecord
1488 (XCAR (tem), arg_encoding, 1));
1489 }
850d0752 1490 }
a4a37e65 1491
850d0752
NR
1492 UNGCPRO;
1493 }
0fa1789e 1494
850d0752
NR
1495 /* Now that everything is encoded we can collect the strings into
1496 NEW_ARGV. */
1497 new_argv = (unsigned char **) alloca ((nargs - 1) * sizeof (char *));
1498 new_argv[nargs - 2] = 0;
52a1b894 1499
c5101a77 1500 for (i = nargs - 2; i-- != 0; )
850d0752
NR
1501 {
1502 new_argv[i] = SDATA (XCAR (tem));
1503 tem = XCDR (tem);
1504 }
1505
1506 create_process (proc, (char **) new_argv, current_dir);
1507 }
1508 else
1509 create_pty (proc);
d0d6b7c5 1510
b0310da4 1511 return unbind_to (count, proc);
d0d6b7c5
JB
1512}
1513
b0310da4 1514/* This function is the unwind_protect form for Fstart_process. If
8e6208c5 1515 PROC doesn't have its pid set, then we know someone has signaled
b0310da4
JB
1516 an error and the process wasn't started successfully, so we should
1517 remove it from the process list. */
1518static Lisp_Object
d3da34e0 1519start_process_unwind (Lisp_Object proc)
b0310da4 1520{
bcd69aea 1521 if (!PROCESSP (proc))
b0310da4
JB
1522 abort ();
1523
2bf26180
GM
1524 /* Was PROC started successfully?
1525 -2 is used for a pty with no process, eg for gdb. */
1526 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
b0310da4
JB
1527 remove_process (proc);
1528
1529 return Qnil;
1530}
1531
ff6daed3 1532static void
d3da34e0 1533create_process_1 (struct atimer *timer)
d0d6b7c5 1534{
30904ab7 1535 /* Nothing to do. */
d0d6b7c5
JB
1536}
1537
30904ab7 1538
40ccffa6 1539static void
d3da34e0 1540create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
d0d6b7c5 1541{
29ed4d51
CY
1542 int inchannel, outchannel;
1543 pid_t pid;
d0d6b7c5 1544 int sv[2];
2c4df143
YM
1545#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1546 int wait_child_setup[2];
1547#endif
0dc70c33
KH
1548 sigset_t procmask;
1549 sigset_t blocked;
1550 struct sigaction sigint_action;
1551 struct sigaction sigquit_action;
c0ad4ea5 1552 struct sigaction sigpipe_action;
0dc70c33
KH
1553#ifdef AIX
1554 struct sigaction sighup_action;
1555#endif
ecd1f654
KH
1556 /* Use volatile to protect variables from being clobbered by longjmp. */
1557 volatile int forkin, forkout;
1558 volatile int pty_flag = 0;
3ec68006 1559#ifndef USE_CRT_DLL
d0d6b7c5 1560 extern char **environ;
3ec68006 1561#endif
d0d6b7c5 1562
d0d6b7c5
JB
1563 inchannel = outchannel = -1;
1564
1565#ifdef HAVE_PTYS
fe45da4e 1566 if (!NILP (Vprocess_connection_type))
d0d6b7c5
JB
1567 outchannel = inchannel = allocate_pty ();
1568
d0d6b7c5
JB
1569 if (inchannel >= 0)
1570 {
2af70a0c
RS
1571#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1572 /* On most USG systems it does not work to open the pty's tty here,
1573 then close it and reopen it in the child. */
d0d6b7c5
JB
1574#ifdef O_NOCTTY
1575 /* Don't let this terminal become our controlling terminal
1576 (in case we don't have one). */
68c45bf0 1577 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
d0d6b7c5 1578#else
68c45bf0 1579 forkout = forkin = emacs_open (pty_name, O_RDWR, 0);
d0d6b7c5
JB
1580#endif
1581 if (forkin < 0)
1582 report_file_error ("Opening pty", Qnil);
1583#else
1584 forkin = forkout = -1;
2af70a0c 1585#endif /* not USG, or USG_SUBTTY_WORKS */
d0d6b7c5
JB
1586 pty_flag = 1;
1587 }
1588 else
1589#endif /* HAVE_PTYS */
d0d6b7c5 1590 {
fc14013c
KH
1591 int tem;
1592 tem = pipe (sv);
1593 if (tem < 0)
1594 report_file_error ("Creating pipe", Qnil);
d0d6b7c5
JB
1595 inchannel = sv[0];
1596 forkout = sv[1];
fc14013c
KH
1597 tem = pipe (sv);
1598 if (tem < 0)
1599 {
68c45bf0
PE
1600 emacs_close (inchannel);
1601 emacs_close (forkout);
fc14013c
KH
1602 report_file_error ("Creating pipe", Qnil);
1603 }
d0d6b7c5
JB
1604 outchannel = sv[1];
1605 forkin = sv[0];
1606 }
d0d6b7c5 1607
2c4df143
YM
1608#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1609 {
1610 int tem;
1611
1612 tem = pipe (wait_child_setup);
1613 if (tem < 0)
1614 report_file_error ("Creating pipe", Qnil);
1615 tem = fcntl (wait_child_setup[1], F_GETFD, 0);
1616 if (tem >= 0)
1617 tem = fcntl (wait_child_setup[1], F_SETFD, tem | FD_CLOEXEC);
1618 if (tem < 0)
1619 {
1620 emacs_close (wait_child_setup[0]);
1621 emacs_close (wait_child_setup[1]);
1622 report_file_error ("Setting file descriptor flags", Qnil);
1623 }
1624 }
1625#endif
1626
d0d6b7c5
JB
1627#ifdef O_NONBLOCK
1628 fcntl (inchannel, F_SETFL, O_NONBLOCK);
03832893 1629 fcntl (outchannel, F_SETFL, O_NONBLOCK);
d0d6b7c5
JB
1630#else
1631#ifdef O_NDELAY
1632 fcntl (inchannel, F_SETFL, O_NDELAY);
03832893 1633 fcntl (outchannel, F_SETFL, O_NDELAY);
d0d6b7c5
JB
1634#endif
1635#endif
1636
1637 /* Record this as an active process, with its channels.
1638 As a result, child_setup will close Emacs's side of the pipes. */
1639 chan_process[inchannel] = process;
60f0fb11
SM
1640 XPROCESS (process)->infd = inchannel;
1641 XPROCESS (process)->outfd = outchannel;
16782258
JD
1642
1643 /* Previously we recorded the tty descriptor used in the subprocess.
1644 It was only used for getting the foreground tty process, so now
1645 we just reopen the device (see emacs_get_tty_pgrp) as this is
1646 more portable (see USG_SUBTTY_WORKS above). */
1647
60f0fb11 1648 XPROCESS (process)->pty_flag = pty_flag;
d0d6b7c5
JB
1649 XPROCESS (process)->status = Qrun;
1650
1651 /* Delay interrupts until we have a chance to store
1652 the new fork's pid in its process structure */
0dc70c33
KH
1653 sigemptyset (&blocked);
1654#ifdef SIGCHLD
1655 sigaddset (&blocked, SIGCHLD);
1656#endif
351e611f 1657#ifdef HAVE_WORKING_VFORK
0dc70c33
KH
1658 /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal',
1659 this sets the parent's signal handlers as well as the child's.
1660 So delay all interrupts whose handlers the child might munge,
1661 and record the current handlers so they can be restored later. */
1662 sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action );
1663 sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action);
c0ad4ea5 1664 sigaddset (&blocked, SIGPIPE); sigaction (SIGPIPE, 0, &sigpipe_action);
0dc70c33
KH
1665#ifdef AIX
1666 sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action );
1667#endif
351e611f 1668#endif /* HAVE_WORKING_VFORK */
123403e4 1669 pthread_sigmask (SIG_BLOCK, &blocked, &procmask);
d0d6b7c5 1670
3081bf8d 1671 FD_SET (inchannel, &input_wait_mask);
a69281ff 1672 FD_SET (inchannel, &non_keyboard_wait_mask);
3081bf8d
KH
1673 if (inchannel > max_process_desc)
1674 max_process_desc = inchannel;
1675
d0d6b7c5
JB
1676 /* Until we store the proper pid, enable sigchld_handler
1677 to recognize an unknown pid as standing for this process.
1678 It is very important not to let this `marker' value stay
1679 in the table after this function has returned; if it does
1680 it might cause call-process to hang and subsequent asynchronous
1681 processes to get their return values scrambled. */
6bfd98e7 1682 XPROCESS (process)->pid = -1;
d0d6b7c5 1683
5cf2b69b
KH
1684 /* This must be called after the above line because it may signal an
1685 error. */
1686 setup_process_coding_systems (process);
1687
ececcbec 1688 BLOCK_INPUT;
177c0ea7 1689
d0d6b7c5
JB
1690 {
1691 /* child_setup must clobber environ on systems with true vfork.
1692 Protect it from permanent change. */
1693 char **save_environ = environ;
12d8b6ab 1694 volatile Lisp_Object encoded_current_dir = ENCODE_FILE (current_dir);
a932f187 1695
e98d950b 1696#ifndef WINDOWSNT
d0d6b7c5
JB
1697 pid = vfork ();
1698 if (pid == 0)
e98d950b 1699#endif /* not WINDOWSNT */
d0d6b7c5
JB
1700 {
1701 int xforkin = forkin;
1702 int xforkout = forkout;
1703
1704#if 0 /* This was probably a mistake--it duplicates code later on,
1705 but fails to handle all the cases. */
1706 /* Make sure SIGCHLD is not blocked in the child. */
1707 sigsetmask (SIGEMPTYMASK);
1708#endif
1709
1710 /* Make the pty be the controlling terminal of the process. */
1711#ifdef HAVE_PTYS
1712 /* First, disconnect its current controlling terminal. */
1713#ifdef HAVE_SETSID
7ce48618
RS
1714 /* We tried doing setsid only if pty_flag, but it caused
1715 process_set_signal to fail on SGI when using a pipe. */
1716 setsid ();
ce4c9c90 1717 /* Make the pty's terminal the controlling terminal. */
ce8f5a9a 1718 if (pty_flag && xforkin >= 0)
39e9ebcd 1719 {
39e9ebcd
RS
1720#ifdef TIOCSCTTY
1721 /* We ignore the return value
1722 because faith@cs.unc.edu says that is necessary on Linux. */
1723 ioctl (xforkin, TIOCSCTTY, 0);
ce4c9c90 1724#endif
39e9ebcd 1725 }
d0d6b7c5 1726#else /* not HAVE_SETSID */
c14e53a4 1727#ifdef USG
000ab717 1728 /* It's very important to call setpgrp here and no time
d0d6b7c5
JB
1729 afterwards. Otherwise, we lose our controlling tty which
1730 is set when we open the pty. */
1731 setpgrp ();
1732#endif /* USG */
1733#endif /* not HAVE_SETSID */
a7ebc409 1734#if defined (LDISC1)
9bcf8ec6
KH
1735 if (pty_flag && xforkin >= 0)
1736 {
1737 struct termios t;
1738 tcgetattr (xforkin, &t);
1739 t.c_lflag = LDISC1;
1740 if (tcsetattr (xforkin, TCSANOW, &t) < 0)
68c45bf0 1741 emacs_write (1, "create_process/tcsetattr LDISC1 failed\n", 39);
9bcf8ec6
KH
1742 }
1743#else
aafadd9f 1744#if defined (NTTYDISC) && defined (TIOCSETD)
ff773a4e 1745 if (pty_flag && xforkin >= 0)
afc549fd
RS
1746 {
1747 /* Use new line discipline. */
1748 int ldisc = NTTYDISC;
4458f555 1749 ioctl (xforkin, TIOCSETD, &ldisc);
afc549fd 1750 }
000ab717 1751#endif
9bcf8ec6 1752#endif
177c0ea7 1753#ifdef TIOCNOTTY
d0d6b7c5
JB
1754 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1755 can do TIOCSPGRP only to the process's controlling tty. */
1756 if (pty_flag)
1757 {
177c0ea7 1758 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
d0d6b7c5 1759 I can't test it since I don't have 4.3. */
68c45bf0 1760 int j = emacs_open ("/dev/tty", O_RDWR, 0);
ce8f5a9a
AS
1761 if (j >= 0)
1762 {
1763 ioctl (j, TIOCNOTTY, 0);
1764 emacs_close (j);
1765 }
5a570e37 1766#ifndef USG
d0d6b7c5
JB
1767 /* In order to get a controlling terminal on some versions
1768 of BSD, it is necessary to put the process in pgrp 0
1769 before it opens the terminal. */
99c1aeca 1770#ifdef HAVE_SETPGID
3ea1d291
RS
1771 setpgid (0, 0);
1772#else
d0d6b7c5 1773 setpgrp (0, 0);
3ea1d291 1774#endif
d0d6b7c5
JB
1775#endif
1776 }
1777#endif /* TIOCNOTTY */
1778
e39a993c 1779#if !defined (DONT_REOPEN_PTY)
d0d6b7c5 1780/*** There is a suggestion that this ought to be a
99153b9e
RS
1781 conditional on TIOCSPGRP,
1782 or !(defined (HAVE_SETSID) && defined (TIOCSCTTY)).
1783 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1784 that system does seem to need this code, even though
1785 both HAVE_SETSID and TIOCSCTTY are defined. */
d0d6b7c5
JB
1786 /* Now close the pty (if we had it open) and reopen it.
1787 This makes the pty the controlling terminal of the subprocess. */
1788 if (pty_flag)
1789 {
99e3d726 1790
68c45bf0
PE
1791 /* I wonder if emacs_close (emacs_open (pty_name, ...))
1792 would work? */
d0d6b7c5 1793 if (xforkin >= 0)
68c45bf0
PE
1794 emacs_close (xforkin);
1795 xforkout = xforkin = emacs_open (pty_name, O_RDWR, 0);
d0d6b7c5 1796
4aa54ba8
RS
1797 if (xforkin < 0)
1798 {
68c45bf0
PE
1799 emacs_write (1, "Couldn't open the pty terminal ", 31);
1800 emacs_write (1, pty_name, strlen (pty_name));
1801 emacs_write (1, "\n", 1);
4aa54ba8
RS
1802 _exit (1);
1803 }
1804
d0d6b7c5 1805 }
e39a993c 1806#endif /* not DONT_REOPEN_PTY */
e9bf058b 1807
d0d6b7c5 1808#ifdef SETUP_SLAVE_PTY
13a72104
RS
1809 if (pty_flag)
1810 {
1811 SETUP_SLAVE_PTY;
1812 }
d0d6b7c5
JB
1813#endif /* SETUP_SLAVE_PTY */
1814#ifdef AIX
1815 /* On AIX, we've disabled SIGHUP above once we start a child on a pty.
1816 Now reenable it in the child, so it will die when we want it to. */
1817 if (pty_flag)
1818 signal (SIGHUP, SIG_DFL);
1819#endif
1820#endif /* HAVE_PTYS */
1821
0dc70c33
KH
1822 signal (SIGINT, SIG_DFL);
1823 signal (SIGQUIT, SIG_DFL);
2f9a22e2 1824 /* GConf causes us to ignore SIGPIPE, make sure it is restored
c0ad4ea5
AS
1825 in the child. */
1826 signal (SIGPIPE, SIG_DFL);
0dc70c33
KH
1827
1828 /* Stop blocking signals in the child. */
123403e4 1829 pthread_sigmask (SIG_SETMASK, &procmask, 0);
5e7e1da2 1830
ab01d0a8
RS
1831 if (pty_flag)
1832 child_setup_tty (xforkout);
e98d950b
RS
1833#ifdef WINDOWSNT
1834 pid = child_setup (xforkin, xforkout, xforkout,
12d8b6ab 1835 new_argv, 1, encoded_current_dir);
177c0ea7 1836#else /* not WINDOWSNT */
2c4df143
YM
1837#ifdef FD_CLOEXEC
1838 emacs_close (wait_child_setup[0]);
1839#endif
d0d6b7c5 1840 child_setup (xforkin, xforkout, xforkout,
12d8b6ab 1841 new_argv, 1, encoded_current_dir);
e98d950b 1842#endif /* not WINDOWSNT */
d0d6b7c5
JB
1843 }
1844 environ = save_environ;
1845 }
1846
ececcbec
RS
1847 UNBLOCK_INPUT;
1848
4a127b3b 1849 /* This runs in the Emacs process. */
d0d6b7c5 1850 if (pid < 0)
6311cf58
RS
1851 {
1852 if (forkin >= 0)
68c45bf0 1853 emacs_close (forkin);
6311cf58 1854 if (forkin != forkout && forkout >= 0)
68c45bf0 1855 emacs_close (forkout);
6311cf58 1856 }
4a127b3b
KH
1857 else
1858 {
1859 /* vfork succeeded. */
6bfd98e7 1860 XPROCESS (process)->pid = pid;
d0d6b7c5 1861
e98d950b 1862#ifdef WINDOWSNT
4a127b3b 1863 register_child (pid, inchannel);
e98d950b
RS
1864#endif /* WINDOWSNT */
1865
4a127b3b
KH
1866 /* If the subfork execv fails, and it exits,
1867 this close hangs. I don't know why.
1868 So have an interrupt jar it loose. */
30904ab7
GM
1869 {
1870 struct atimer *timer;
1871 EMACS_TIME offset;
177c0ea7 1872
30904ab7
GM
1873 stop_polling ();
1874 EMACS_SET_SECS_USECS (offset, 1, 0);
1875 timer = start_atimer (ATIMER_RELATIVE, offset, create_process_1, 0);
177c0ea7 1876
30904ab7
GM
1877 if (forkin >= 0)
1878 emacs_close (forkin);
1879
1880 cancel_atimer (timer);
1881 start_polling ();
1882 }
177c0ea7 1883
4a127b3b 1884 if (forkin != forkout && forkout >= 0)
68c45bf0 1885 emacs_close (forkout);
d0d6b7c5 1886
875e6b94 1887#ifdef HAVE_PTYS
4a127b3b
KH
1888 if (pty_flag)
1889 XPROCESS (process)->tty_name = build_string (pty_name);
1890 else
875e6b94 1891#endif
4a127b3b 1892 XPROCESS (process)->tty_name = Qnil;
2c4df143
YM
1893
1894#if !defined (WINDOWSNT) && defined (FD_CLOEXEC)
1895 /* Wait for child_setup to complete in case that vfork is
1896 actually defined as fork. The descriptor wait_child_setup[1]
1897 of a pipe is closed at the child side either by close-on-exec
1898 on successful execvp or the _exit call in child_setup. */
1899 {
1900 char dummy;
1901
1902 emacs_close (wait_child_setup[1]);
1903 emacs_read (wait_child_setup[0], &dummy, 1);
1904 emacs_close (wait_child_setup[0]);
1905 }
1906#endif
4a127b3b 1907 }
3b9a3dfa 1908
4a127b3b
KH
1909 /* Restore the signal state whether vfork succeeded or not.
1910 (We will signal an error, below, if it failed.) */
351e611f 1911#ifdef HAVE_WORKING_VFORK
0dc70c33
KH
1912 /* Restore the parent's signal handlers. */
1913 sigaction (SIGINT, &sigint_action, 0);
1914 sigaction (SIGQUIT, &sigquit_action, 0);
c0ad4ea5 1915 sigaction (SIGPIPE, &sigpipe_action, 0);
0dc70c33
KH
1916#ifdef AIX
1917 sigaction (SIGHUP, &sighup_action, 0);
1918#endif
351e611f 1919#endif /* HAVE_WORKING_VFORK */
0dc70c33 1920 /* Stop blocking signals in the parent. */
123403e4 1921 pthread_sigmask (SIG_SETMASK, &procmask, 0);
4a127b3b
KH
1922
1923 /* Now generate the error if vfork failed. */
1924 if (pid < 0)
1925 report_file_error ("Doing vfork", Qnil);
d0d6b7c5 1926}
d0d6b7c5 1927
850d0752 1928void
d3da34e0 1929create_pty (Lisp_Object process)
850d0752
NR
1930{
1931 int inchannel, outchannel;
afd4052b 1932 int pty_flag = 0;
850d0752
NR
1933
1934 inchannel = outchannel = -1;
1935
1936#ifdef HAVE_PTYS
1937 if (!NILP (Vprocess_connection_type))
1938 outchannel = inchannel = allocate_pty ();
1939
1940 if (inchannel >= 0)
1941 {
1942#if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1943 /* On most USG systems it does not work to open the pty's tty here,
1944 then close it and reopen it in the child. */
1945#ifdef O_NOCTTY
1946 /* Don't let this terminal become our controlling terminal
1947 (in case we don't have one). */
afd4052b 1948 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
850d0752 1949#else
afd4052b 1950 int forkout = emacs_open (pty_name, O_RDWR, 0);
850d0752 1951#endif
aba7731a 1952 if (forkout < 0)
850d0752 1953 report_file_error ("Opening pty", Qnil);
019d2c4c 1954#if defined (DONT_REOPEN_PTY)
850d0752
NR
1955 /* In the case that vfork is defined as fork, the parent process
1956 (Emacs) may send some data before the child process completes
1957 tty options setup. So we setup tty before forking. */
1958 child_setup_tty (forkout);
019d2c4c 1959#endif /* DONT_REOPEN_PTY */
850d0752
NR
1960#endif /* not USG, or USG_SUBTTY_WORKS */
1961 pty_flag = 1;
1962 }
1963#endif /* HAVE_PTYS */
1964
1965#ifdef O_NONBLOCK
1966 fcntl (inchannel, F_SETFL, O_NONBLOCK);
1967 fcntl (outchannel, F_SETFL, O_NONBLOCK);
1968#else
1969#ifdef O_NDELAY
1970 fcntl (inchannel, F_SETFL, O_NDELAY);
1971 fcntl (outchannel, F_SETFL, O_NDELAY);
1972#endif
1973#endif
1974
1975 /* Record this as an active process, with its channels.
1976 As a result, child_setup will close Emacs's side of the pipes. */
1977 chan_process[inchannel] = process;
1978 XPROCESS (process)->infd = inchannel;
1979 XPROCESS (process)->outfd = outchannel;
1980
1981 /* Previously we recorded the tty descriptor used in the subprocess.
1982 It was only used for getting the foreground tty process, so now
1983 we just reopen the device (see emacs_get_tty_pgrp) as this is
1984 more portable (see USG_SUBTTY_WORKS above). */
1985
1986 XPROCESS (process)->pty_flag = pty_flag;
1987 XPROCESS (process)->status = Qrun;
1988 setup_process_coding_systems (process);
1989
1990 FD_SET (inchannel, &input_wait_mask);
1991 FD_SET (inchannel, &non_keyboard_wait_mask);
1992 if (inchannel > max_process_desc)
1993 max_process_desc = inchannel;
1994
1995 XPROCESS (process)->pid = -2;
8b9fc636
EZ
1996#ifdef HAVE_PTYS
1997 if (pty_flag)
1998 XPROCESS (process)->tty_name = build_string (pty_name);
1999 else
2000#endif
2001 XPROCESS (process)->tty_name = Qnil;
850d0752
NR
2002}
2003
e690ca94 2004\f
e690ca94
KS
2005/* Convert an internal struct sockaddr to a lisp object (vector or string).
2006 The address family of sa is not included in the result. */
2007
2008static Lisp_Object
d3da34e0 2009conv_sockaddr_to_lisp (struct sockaddr *sa, int len)
e690ca94
KS
2010{
2011 Lisp_Object address;
2012 int i;
2013 unsigned char *cp;
2014 register struct Lisp_Vector *p;
2015
63136da6
AS
2016 /* Workaround for a bug in getsockname on BSD: Names bound to
2017 sockets in the UNIX domain are inaccessible; getsockname returns
2018 a zero length name. */
89887d67 2019 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
fff4e459 2020 return empty_unibyte_string;
63136da6 2021
e690ca94
KS
2022 switch (sa->sa_family)
2023 {
2024 case AF_INET:
2025 {
2026 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2027 len = sizeof (sin->sin_addr) + 1;
2028 address = Fmake_vector (make_number (len), Qnil);
2029 p = XVECTOR (address);
2030 p->contents[--len] = make_number (ntohs (sin->sin_port));
63136da6 2031 cp = (unsigned char *) &sin->sin_addr;
e690ca94
KS
2032 break;
2033 }
e1652a86
KS
2034#ifdef AF_INET6
2035 case AF_INET6:
2036 {
2037 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
63136da6 2038 uint16_t *ip6 = (uint16_t *) &sin6->sin6_addr;
e1652a86
KS
2039 len = sizeof (sin6->sin6_addr)/2 + 1;
2040 address = Fmake_vector (make_number (len), Qnil);
2041 p = XVECTOR (address);
2042 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2043 for (i = 0; i < len; i++)
2044 p->contents[i] = make_number (ntohs (ip6[i]));
2045 return address;
2046 }
2047#endif
e690ca94
KS
2048#ifdef HAVE_LOCAL_SOCKETS
2049 case AF_LOCAL:
2050 {
fb23673a
EZ
2051 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
2052 for (i = 0; i < sizeof (sockun->sun_path); i++)
2053 if (sockun->sun_path[i] == 0)
e690ca94 2054 break;
fb23673a 2055 return make_unibyte_string (sockun->sun_path, i);
e690ca94
KS
2056 }
2057#endif
2058 default:
89887d67 2059 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
e690ca94
KS
2060 address = Fcons (make_number (sa->sa_family),
2061 Fmake_vector (make_number (len), Qnil));
2062 p = XVECTOR (XCDR (address));
63136da6 2063 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
e690ca94
KS
2064 break;
2065 }
2066
2067 i = 0;
2068 while (i < len)
2069 p->contents[i++] = make_number (*cp++);
2070
2071 return address;
2072}
2073
2074
2075/* Get family and required size for sockaddr structure to hold ADDRESS. */
2076
2077static int
d3da34e0 2078get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
e690ca94
KS
2079{
2080 register struct Lisp_Vector *p;
2081
2082 if (VECTORP (address))
2083 {
2084 p = XVECTOR (address);
eab3844f 2085 if (p->header.size == 5)
e690ca94
KS
2086 {
2087 *familyp = AF_INET;
2088 return sizeof (struct sockaddr_in);
2089 }
e1652a86 2090#ifdef AF_INET6
eab3844f 2091 else if (p->header.size == 9)
e1652a86
KS
2092 {
2093 *familyp = AF_INET6;
2094 return sizeof (struct sockaddr_in6);
2095 }
2096#endif
e690ca94
KS
2097 }
2098#ifdef HAVE_LOCAL_SOCKETS
2099 else if (STRINGP (address))
2100 {
2101 *familyp = AF_LOCAL;
2102 return sizeof (struct sockaddr_un);
2103 }
2104#endif
2105 else if (CONSP (address) && INTEGERP (XCAR (address)) && VECTORP (XCDR (address)))
2106 {
2107 struct sockaddr *sa;
2108 *familyp = XINT (XCAR (address));
2109 p = XVECTOR (XCDR (address));
eab3844f 2110 return p->header.size + sizeof (sa->sa_family);
e690ca94
KS
2111 }
2112 return 0;
2113}
2114
2115/* Convert an address object (vector or string) to an internal sockaddr.
9d1a8e5d
RS
2116
2117 The address format has been basically validated by
2118 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2119 it could have come from user data. So if FAMILY is not valid,
2120 we return after zeroing *SA. */
e690ca94
KS
2121
2122static void
d3da34e0 2123conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
e690ca94
KS
2124{
2125 register struct Lisp_Vector *p;
34967d0f 2126 register unsigned char *cp = NULL;
e690ca94
KS
2127 register int i;
2128
72af86bd 2129 memset (sa, 0, len);
e690ca94
KS
2130
2131 if (VECTORP (address))
2132 {
2133 p = XVECTOR (address);
2134 if (family == AF_INET)
2135 {
2136 struct sockaddr_in *sin = (struct sockaddr_in *) sa;
2137 len = sizeof (sin->sin_addr) + 1;
2138 i = XINT (p->contents[--len]);
2139 sin->sin_port = htons (i);
2140 cp = (unsigned char *)&sin->sin_addr;
9d1a8e5d 2141 sa->sa_family = family;
e690ca94 2142 }
e1652a86
KS
2143#ifdef AF_INET6
2144 else if (family == AF_INET6)
2145 {
2146 struct sockaddr_in6 *sin6 = (struct sockaddr_in6 *) sa;
2147 uint16_t *ip6 = (uint16_t *)&sin6->sin6_addr;
2148 len = sizeof (sin6->sin6_addr) + 1;
2149 i = XINT (p->contents[--len]);
2150 sin6->sin6_port = htons (i);
2151 for (i = 0; i < len; i++)
2152 if (INTEGERP (p->contents[i]))
2153 {
2154 int j = XFASTINT (p->contents[i]) & 0xffff;
2155 ip6[i] = ntohs (j);
2156 }
9d1a8e5d 2157 sa->sa_family = family;
0eb7675e 2158 return;
e1652a86
KS
2159 }
2160#endif
0eb7675e
AS
2161 else
2162 return;
e690ca94
KS
2163 }
2164 else if (STRINGP (address))
2165 {
2166#ifdef HAVE_LOCAL_SOCKETS
2167 if (family == AF_LOCAL)
2168 {
fb23673a 2169 struct sockaddr_un *sockun = (struct sockaddr_un *) sa;
d5db4077 2170 cp = SDATA (address);
fb23673a
EZ
2171 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2172 sockun->sun_path[i] = *cp++;
9d1a8e5d 2173 sa->sa_family = family;
e690ca94
KS
2174 }
2175#endif
2176 return;
2177 }
2178 else
2179 {
2180 p = XVECTOR (XCDR (address));
2181 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2182 }
2183
2184 for (i = 0; i < len; i++)
2185 if (INTEGERP (p->contents[i]))
2186 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2187}
2188
2189#ifdef DATAGRAM_SOCKETS
2190DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2191 1, 1, 0,
2192 doc: /* Get the current datagram address associated with PROCESS. */)
5842a27b 2193 (Lisp_Object process)
e690ca94
KS
2194{
2195 int channel;
2196
2197 CHECK_PROCESS (process);
2198
2199 if (!DATAGRAM_CONN_P (process))
2200 return Qnil;
2201
60f0fb11 2202 channel = XPROCESS (process)->infd;
e690ca94
KS
2203 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2204 datagram_address[channel].len);
2205}
2206
2207DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2208 2, 2, 0,
2209 doc: /* Set the datagram address for PROCESS to ADDRESS.
2210Returns nil upon error setting address, ADDRESS otherwise. */)
5842a27b 2211 (Lisp_Object process, Lisp_Object address)
e690ca94
KS
2212{
2213 int channel;
2214 int family, len;
2215
2216 CHECK_PROCESS (process);
2217
2218 if (!DATAGRAM_CONN_P (process))
2219 return Qnil;
2220
60f0fb11 2221 channel = XPROCESS (process)->infd;
e690ca94
KS
2222
2223 len = get_lisp_to_sockaddr_size (address, &family);
2224 if (datagram_address[channel].len != len)
2225 return Qnil;
2226 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2227 return address;
2228}
2229#endif
2230\f
2231
5e2327cf 2232static const struct socket_options {
e690ca94 2233 /* The name of this option. Should be lowercase version of option
177c0ea7 2234 name without SO_ prefix. */
fce70521 2235 const char *name;
e690ca94
KS
2236 /* Option level SOL_... */
2237 int optlevel;
2238 /* Option number SO_... */
2239 int optnum;
6b61353c
KH
2240 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2241 enum { OPIX_NONE=0, OPIX_MISC=1, OPIX_REUSEADDR=2 } optbit;
e690ca94
KS
2242} socket_options[] =
2243 {
2244#ifdef SO_BINDTODEVICE
6b61353c 2245 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
e690ca94
KS
2246#endif
2247#ifdef SO_BROADCAST
6b61353c 2248 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
e690ca94
KS
2249#endif
2250#ifdef SO_DONTROUTE
6b61353c 2251 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
e690ca94
KS
2252#endif
2253#ifdef SO_KEEPALIVE
6b61353c 2254 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
e690ca94
KS
2255#endif
2256#ifdef SO_LINGER
6b61353c 2257 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
e690ca94
KS
2258#endif
2259#ifdef SO_OOBINLINE
6b61353c 2260 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
e690ca94
KS
2261#endif
2262#ifdef SO_PRIORITY
6b61353c 2263 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
e690ca94
KS
2264#endif
2265#ifdef SO_REUSEADDR
6b61353c 2266 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
e690ca94 2267#endif
6b61353c 2268 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
e690ca94
KS
2269 };
2270
6b61353c 2271/* Set option OPT to value VAL on socket S.
e690ca94 2272
6b61353c
KH
2273 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2274 Signals an error if setting a known option fails.
2275*/
e690ca94
KS
2276
2277static int
d3da34e0 2278set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
e690ca94 2279{
6b61353c 2280 char *name;
5e2327cf 2281 const struct socket_options *sopt;
6b61353c 2282 int ret = 0;
e690ca94 2283
6b61353c 2284 CHECK_SYMBOL (opt);
e690ca94 2285
51b59d79 2286 name = SSDATA (SYMBOL_NAME (opt));
6b61353c
KH
2287 for (sopt = socket_options; sopt->name; sopt++)
2288 if (strcmp (name, sopt->name) == 0)
2289 break;
e690ca94 2290
6b61353c
KH
2291 switch (sopt->opttype)
2292 {
2293 case SOPT_BOOL:
2294 {
2295 int optval;
2296 optval = NILP (val) ? 0 : 1;
2297 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2298 &optval, sizeof (optval));
2299 break;
2300 }
e690ca94 2301
6b61353c
KH
2302 case SOPT_INT:
2303 {
2304 int optval;
2305 if (INTEGERP (val))
2306 optval = XINT (val);
2307 else
2308 error ("Bad option value for %s", name);
2309 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2310 &optval, sizeof (optval));
2311 break;
2312 }
e690ca94 2313
6b61353c
KH
2314#ifdef SO_BINDTODEVICE
2315 case SOPT_IFNAME:
2316 {
2317 char devname[IFNAMSIZ+1];
e690ca94 2318
6b61353c
KH
2319 /* This is broken, at least in the Linux 2.4 kernel.
2320 To unbind, the arg must be a zero integer, not the empty string.
2321 This should work on all systems. KFS. 2003-09-23. */
72af86bd 2322 memset (devname, 0, sizeof devname);
6b61353c 2323 if (STRINGP (val))
e690ca94 2324 {
51b59d79 2325 char *arg = SSDATA (val);
6b61353c 2326 int len = min (strlen (arg), IFNAMSIZ);
72af86bd 2327 memcpy (devname, arg, len);
e690ca94 2328 }
6b61353c
KH
2329 else if (!NILP (val))
2330 error ("Bad option value for %s", name);
2331 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2332 devname, IFNAMSIZ);
2333 break;
2334 }
2335#endif
e690ca94 2336
177c0ea7 2337#ifdef SO_LINGER
6b61353c
KH
2338 case SOPT_LINGER:
2339 {
2340 struct linger linger;
e690ca94 2341
6b61353c
KH
2342 linger.l_onoff = 1;
2343 linger.l_linger = 0;
2344 if (INTEGERP (val))
2345 linger.l_linger = XINT (val);
2346 else
2347 linger.l_onoff = NILP (val) ? 0 : 1;
2348 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2349 &linger, sizeof (linger));
2350 break;
2351 }
e690ca94 2352#endif
6b61353c
KH
2353
2354 default:
2355 return 0;
e690ca94 2356 }
6b61353c
KH
2357
2358 if (ret < 0)
2359 report_file_error ("Cannot set network option",
2360 Fcons (opt, Fcons (val, Qnil)));
2361 return (1 << sopt->optbit);
e690ca94
KS
2362}
2363
6b61353c
KH
2364
2365DEFUN ("set-network-process-option",
2366 Fset_network_process_option, Sset_network_process_option,
2367 3, 4, 0,
2368 doc: /* For network process PROCESS set option OPTION to value VALUE.
2369See `make-network-process' for a list of options and values.
2370If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2371OPTION is not a supported option, return nil instead; otherwise return t. */)
5842a27b 2372 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
e690ca94 2373{
6b61353c
KH
2374 int s;
2375 struct Lisp_Process *p;
e690ca94 2376
e690ca94 2377 CHECK_PROCESS (process);
6b61353c
KH
2378 p = XPROCESS (process);
2379 if (!NETCONN1_P (p))
2380 error ("Process is not a network process");
2381
60f0fb11 2382 s = p->infd;
6b61353c
KH
2383 if (s < 0)
2384 error ("Process is not running");
2385
2386 if (set_socket_option (s, option, value))
e690ca94 2387 {
6b61353c
KH
2388 p->childp = Fplist_put (p->childp, option, value);
2389 return Qt;
e690ca94 2390 }
6b61353c
KH
2391
2392 if (NILP (no_error))
2393 error ("Unknown or unsupported option");
2394
2395 return Qnil;
e690ca94 2396}
6b61353c 2397
e690ca94 2398\f
d888760c
GM
2399DEFUN ("serial-process-configure",
2400 Fserial_process_configure,
2401 Sserial_process_configure,
2402 0, MANY, 0,
2403 doc: /* Configure speed, bytesize, etc. of a serial process.
2404
2405Arguments are specified as keyword/argument pairs. Attributes that
2406are not given are re-initialized from the process's current
2407configuration (available via the function `process-contact') or set to
2408reasonable default values. The following arguments are defined:
2409
2410:process PROCESS
2411:name NAME
2412:buffer BUFFER
2413:port PORT
2414-- Any of these arguments can be given to identify the process that is
2415to be configured. If none of these arguments is given, the current
2416buffer's process is used.
2417
2418:speed SPEED -- SPEED is the speed of the serial port in bits per
2419second, also called baud rate. Any value can be given for SPEED, but
2420most serial ports work only at a few defined values between 1200 and
2421115200, with 9600 being the most common value. If SPEED is nil, the
2422serial port is not configured any further, i.e., all other arguments
2423are ignored. This may be useful for special serial ports such as
2424Bluetooth-to-serial converters which can only be configured through AT
2425commands. A value of nil for SPEED can be used only when passed
2426through `make-serial-process' or `serial-term'.
2427
2428:bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2429can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2430
2431:parity PARITY -- PARITY can be nil (don't use parity), the symbol
2432`odd' (use odd parity), or the symbol `even' (use even parity). If
2433PARITY is not given, no parity is used.
2434
2435:stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2436terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2437is not given or nil, 1 stopbit is used.
2438
2439:flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2440flowcontrol to be used, which is either nil (don't use flowcontrol),
2441the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2442\(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2443flowcontrol is used.
2444
2445`serial-process-configure' is called by `make-serial-process' for the
2446initial configuration of the serial port.
2447
2448Examples:
2449
2450\(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2451
2452\(serial-process-configure
2453 :buffer "COM1" :stopbits 1 :parity 'odd :flowcontrol 'hw)
2454
2455\(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2456
2457usage: (serial-process-configure &rest ARGS) */)
f66c7cf8 2458 (ptrdiff_t nargs, Lisp_Object *args)
d888760c
GM
2459{
2460 struct Lisp_Process *p;
2461 Lisp_Object contact = Qnil;
2462 Lisp_Object proc = Qnil;
2463 struct gcpro gcpro1;
2464
2465 contact = Flist (nargs, args);
2466 GCPRO1 (contact);
2467
2468 proc = Fplist_get (contact, QCprocess);
2469 if (NILP (proc))
2470 proc = Fplist_get (contact, QCname);
2471 if (NILP (proc))
2472 proc = Fplist_get (contact, QCbuffer);
2473 if (NILP (proc))
2474 proc = Fplist_get (contact, QCport);
2475 proc = get_process (proc);
2476 p = XPROCESS (proc);
a879ee6f 2477 if (!EQ (p->type, Qserial))
d888760c
GM
2478 error ("Not a serial process");
2479
2480 if (NILP (Fplist_get (p->childp, QCspeed)))
2481 {
2482 UNGCPRO;
2483 return Qnil;
2484 }
2485
2486 serial_configure (p, contact);
2487
2488 UNGCPRO;
2489 return Qnil;
2490}
d888760c 2491
d888760c 2492/* Used by make-serial-process to recover from errors. */
b766f867
PE
2493static Lisp_Object
2494make_serial_process_unwind (Lisp_Object proc)
d888760c
GM
2495{
2496 if (!PROCESSP (proc))
2497 abort ();
2498 remove_process (proc);
2499 return Qnil;
2500}
d888760c 2501
d888760c
GM
2502DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2503 0, MANY, 0,
2504 doc: /* Create and return a serial port process.
2505
2506In Emacs, serial port connections are represented by process objects,
2507so input and output work as for subprocesses, and `delete-process'
2508closes a serial port connection. However, a serial process has no
2509process id, it cannot be signaled, and the status codes are different
2510from normal processes.
2511
2512`make-serial-process' creates a process and a buffer, on which you
2513probably want to use `process-send-string'. Try \\[serial-term] for
2514an interactive terminal. See below for examples.
2515
2516Arguments are specified as keyword/argument pairs. The following
2517arguments are defined:
2518
2519:port PORT -- (mandatory) PORT is the path or name of the serial port.
2520For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2521could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2522the backslashes in strings).
2523
2524:speed SPEED -- (mandatory) is handled by `serial-process-configure',
2525which is called by `make-serial-process'.
2526
2527:name NAME -- NAME is the name of the process. If NAME is not given,
2528the value of PORT is used.
2529
2530:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2531with the process. Process output goes at the end of that buffer,
2532unless you specify an output stream or filter function to handle the
2533output. If BUFFER is not given, the value of NAME is used.
2534
2535:coding CODING -- If CODING is a symbol, it specifies the coding
2536system used for both reading and writing for this process. If CODING
2537is a cons (DECODING . ENCODING), DECODING is used for reading, and
2538ENCODING is used for writing.
2539
2540:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2541the process is running. If BOOL is not given, query before exiting.
2542
2543:stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2544In the stopped state, a serial process does not accept incoming data,
2545but you can send outgoing data. The stopped state is cleared by
2546`continue-process' and set by `stop-process'.
2547
2548:filter FILTER -- Install FILTER as the process filter.
2549
2550:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2551
2552:plist PLIST -- Install PLIST as the initial plist of the process.
2553
2554:speed
2555:bytesize
2556:parity
2557:stopbits
2558:flowcontrol
2559-- These arguments are handled by `serial-process-configure', which is
2560called by `make-serial-process'.
2561
2562The original argument list, possibly modified by later configuration,
2563is available via the function `process-contact'.
2564
2565Examples:
2566
2567\(make-serial-process :port "/dev/ttyS0" :speed 9600)
2568
2569\(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2570
2571\(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity 'odd)
2572
2573\(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2574
2575usage: (make-serial-process &rest ARGS) */)
f66c7cf8 2576 (ptrdiff_t nargs, Lisp_Object *args)
d888760c
GM
2577{
2578 int fd = -1;
2579 Lisp_Object proc, contact, port;
2580 struct Lisp_Process *p;
2581 struct gcpro gcpro1;
2582 Lisp_Object name, buffer;
2583 Lisp_Object tem, val;
2584 int specpdl_count = -1;
2585
2586 if (nargs == 0)
2587 return Qnil;
2588
2589 contact = Flist (nargs, args);
2590 GCPRO1 (contact);
2591
2592 port = Fplist_get (contact, QCport);
2593 if (NILP (port))
2594 error ("No port specified");
2595 CHECK_STRING (port);
2596
2597 if (NILP (Fplist_member (contact, QCspeed)))
2598 error (":speed not specified");
2599 if (!NILP (Fplist_get (contact, QCspeed)))
2600 CHECK_NUMBER (Fplist_get (contact, QCspeed));
2601
2602 name = Fplist_get (contact, QCname);
2603 if (NILP (name))
2604 name = port;
2605 CHECK_STRING (name);
2606 proc = make_process (name);
2607 specpdl_count = SPECPDL_INDEX ();
2608 record_unwind_protect (make_serial_process_unwind, proc);
2609 p = XPROCESS (proc);
2610
51b59d79 2611 fd = serial_open (SSDATA (port));
d888760c
GM
2612 p->infd = fd;
2613 p->outfd = fd;
2614 if (fd > max_process_desc)
2615 max_process_desc = fd;
2616 chan_process[fd] = proc;
2617
2618 buffer = Fplist_get (contact, QCbuffer);
2619 if (NILP (buffer))
2620 buffer = name;
2621 buffer = Fget_buffer_create (buffer);
2622 p->buffer = buffer;
2623
2624 p->childp = contact;
2625 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
2626 p->type = Qserial;
2627 p->sentinel = Fplist_get (contact, QCsentinel);
2628 p->filter = Fplist_get (contact, QCfilter);
2629 p->log = Qnil;
2630 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2631 p->kill_without_query = 1;
2632 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2633 p->command = Qt;
2634 p->pty_flag = 0;
2635
2636 if (!EQ (p->command, Qt))
2637 {
2638 FD_SET (fd, &input_wait_mask);
2639 FD_SET (fd, &non_keyboard_wait_mask);
2640 }
2641
2642 if (BUFFERP (buffer))
2643 {
2644 set_marker_both (p->mark, buffer,
2645 BUF_ZV (XBUFFER (buffer)),
2646 BUF_ZV_BYTE (XBUFFER (buffer)));
2647 }
2648
2649 tem = Fplist_member (contact, QCcoding);
2650 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
2651 tem = Qnil;
2652
2653 val = Qnil;
2654 if (!NILP (tem))
2655 {
2656 val = XCAR (XCDR (tem));
2657 if (CONSP (val))
2658 val = XCAR (val);
2659 }
2660 else if (!NILP (Vcoding_system_for_read))
2661 val = Vcoding_system_for_read;
4b4deea2
TT
2662 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2663 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
d888760c
GM
2664 val = Qnil;
2665 p->decode_coding_system = val;
2666
2667 val = Qnil;
2668 if (!NILP (tem))
2669 {
2670 val = XCAR (XCDR (tem));
2671 if (CONSP (val))
2672 val = XCDR (val);
2673 }
2674 else if (!NILP (Vcoding_system_for_write))
2675 val = Vcoding_system_for_write;
4b4deea2
TT
2676 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2677 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
d888760c
GM
2678 val = Qnil;
2679 p->encode_coding_system = val;
2680
2681 setup_process_coding_systems (proc);
cbe81f1d 2682 p->decoding_buf = empty_unibyte_string;
d888760c 2683 p->decoding_carryover = 0;
cbe81f1d 2684 p->encoding_buf = empty_unibyte_string;
d888760c
GM
2685 p->inherit_coding_system_flag
2686 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
2687
ed3751c8 2688 Fserial_process_configure (nargs, args);
d888760c
GM
2689
2690 specpdl_ptr = specpdl + specpdl_count;
2691
2692 UNGCPRO;
2693 return proc;
2694}
d888760c 2695
e690ca94
KS
2696/* Create a network stream/datagram client/server process. Treated
2697 exactly like a normal process when reading and writing. Primary
d0d6b7c5
JB
2698 differences are in status display and process deletion. A network
2699 connection has no PID; you cannot signal it. All you can do is
e690ca94
KS
2700 stop/continue it and deactivate/close it via delete-process */
2701
177c0ea7
JB
2702DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
2703 0, MANY, 0,
e690ca94
KS
2704 doc: /* Create and return a network server or client process.
2705
fa9d4315 2706In Emacs, network connections are represented by process objects, so
e690ca94
KS
2707input and output work as for subprocesses and `delete-process' closes
2708a network connection. However, a network process has no process id,
d22426e1 2709it cannot be signaled, and the status codes are different from normal
e690ca94
KS
2710processes.
2711
2712Arguments are specified as keyword/argument pairs. The following
2713arguments are defined:
2714
2715:name NAME -- NAME is name for process. It is modified if necessary
2716to make it unique.
2717
2718:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2719with the process. Process output goes at end of that buffer, unless
2720you specify an output stream or filter function to handle the output.
2721BUFFER may be also nil, meaning that this process is not associated
2722with any buffer.
2723
2724:host HOST -- HOST is name of the host to connect to, or its IP
2725address. The symbol `local' specifies the local host. If specified
2726for a server process, it must be a valid name or address for the local
2727host, and only clients connecting to that address will be accepted.
2728
2729:service SERVICE -- SERVICE is name of the service desired, or an
2730integer specifying a port number to connect to. If SERVICE is t,
eba25e7c
GM
2731a random port number is selected for the server. (If Emacs was
2732compiled with getaddrinfo, a port number can also be specified as a
2733string, e.g. "80", as well as an integer. This is not portable.)
e690ca94 2734
9057ff80 2735:type TYPE -- TYPE is the type of connection. The default (nil) is a
f00c449b
SM
2736stream type connection, `datagram' creates a datagram type connection,
2737`seqpacket' creates a reliable datagram connection.
9057ff80 2738
e690ca94 2739:family FAMILY -- FAMILY is the address (and protocol) family for the
e1652a86
KS
2740service specified by HOST and SERVICE. The default (nil) is to use
2741whatever address family (IPv4 or IPv6) that is defined for the host
2742and port number specified by HOST and SERVICE. Other address families
2743supported are:
e690ca94 2744 local -- for a local (i.e. UNIX) address specified by SERVICE.
e1652a86
KS
2745 ipv4 -- use IPv4 address family only.
2746 ipv6 -- use IPv6 address family only.
e690ca94
KS
2747
2748:local ADDRESS -- ADDRESS is the local address used for the connection.
2749This parameter is ignored when opening a client process. When specified
2750for a server process, the FAMILY, HOST and SERVICE args are ignored.
2751
2752:remote ADDRESS -- ADDRESS is the remote partner's address for the
2753connection. This parameter is ignored when opening a stream server
2754process. For a datagram server process, it specifies the initial
2755setting of the remote datagram address. When specified for a client
2756process, the FAMILY, HOST, and SERVICE args are ignored.
2757
2758The format of ADDRESS depends on the address family:
2759- An IPv4 address is represented as an vector of integers [A B C D P]
2760corresponding to numeric IP address A.B.C.D and port number P.
2761- A local address is represented as a string with the address in the
2762local address space.
2763- An "unsupported family" address is represented by a cons (F . AV)
2764where F is the family number and AV is a vector containing the socket
2765address data with one element per address data byte. Do not rely on
2766this format in portable code, as it may depend on implementation
2767defined constants, data sizes, and data structure alignment.
2768
6b61353c
KH
2769:coding CODING -- If CODING is a symbol, it specifies the coding
2770system used for both reading and writing for this process. If CODING
2771is a cons (DECODING . ENCODING), DECODING is used for reading, and
2772ENCODING is used for writing.
e690ca94
KS
2773
2774:nowait BOOL -- If BOOL is non-nil for a stream type client process,
2775return without waiting for the connection to complete; instead, the
2776sentinel function will be called with second arg matching "open" (if
2777successful) or "failed" when the connect completes. Default is to use
2778a blocking connect (i.e. wait) for stream type connections.
2779
2780:noquery BOOL -- Query the user unless BOOL is non-nil, and process is
f3d9532b 2781running when Emacs is exited.
e690ca94
KS
2782
2783:stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2784In the stopped state, a server process does not accept new
2785connections, and a client process does not handle incoming traffic.
2786The stopped state is cleared by `continue-process' and set by
2787`stop-process'.
2788
2789:filter FILTER -- Install FILTER as the process filter.
2790
7392e23c
KS
2791:filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
2792process filter are multibyte, otherwise they are unibyte.
e0f24100 2793If this keyword is not specified, the strings are multibyte if
03f04413
KH
2794`default-enable-multibyte-characters' is non-nil.
2795
e690ca94
KS
2796:sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2797
2798:log LOG -- Install LOG as the server process log function. This
991234f0 2799function is called when the server accepts a network connection from a
e690ca94
KS
2800client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
2801is the server process, CLIENT is the new process for the connection,
2802and MESSAGE is a string.
2803
faa7db08 2804:plist PLIST -- Install PLIST as the new process' initial plist.
177c0ea7 2805
6b61353c 2806:server QLEN -- if QLEN is non-nil, create a server process for the
e690ca94 2807specified FAMILY, SERVICE, and connection type (stream or datagram).
6b61353c
KH
2808If QLEN is an integer, it is used as the max. length of the server's
2809pending connection queue (also known as the backlog); the default
2810queue length is 5. Default is to create a client process.
2811
2812The following network options can be specified for this connection:
2813
2814:broadcast BOOL -- Allow send and receive of datagram broadcasts.
2815:dontroute BOOL -- Only send to directly connected hosts.
2816:keepalive BOOL -- Send keep-alive messages on network stream.
2817:linger BOOL or TIMEOUT -- Send queued messages before closing.
2818:oobinline BOOL -- Place out-of-band data in receive data stream.
2819:priority INT -- Set protocol defined priority for sent packets.
2820:reuseaddr BOOL -- Allow reusing a recently used local address
2821 (this is allowed by default for a server process).
2822:bindtodevice NAME -- bind to interface NAME. Using this may require
2823 special privileges on some systems.
2824
2825Consult the relevant system programmer's manual pages for more
2826information on using these options.
2827
2828
2829A server process will listen for and accept connections from clients.
2830When a client connection is accepted, a new network process is created
2831for the connection with the following parameters:
e690ca94 2832
e690ca94
KS
2833- The client's process name is constructed by concatenating the server
2834process' NAME and a client identification string.
2835- If the FILTER argument is non-nil, the client process will not get a
2836separate process buffer; otherwise, the client's process buffer is a newly
2837created buffer named after the server process' BUFFER name or process
177c0ea7 2838NAME concatenated with the client identification string.
e690ca94
KS
2839- The connection type and the process filter and sentinel parameters are
2840inherited from the server process' TYPE, FILTER and SENTINEL.
2841- The client process' contact info is set according to the client's
2842addressing information (typically an IP address and a port number).
faa7db08 2843- The client process' plist is initialized from the server's plist.
e690ca94
KS
2844
2845Notice that the FILTER and SENTINEL args are never used directly by
2846the server process. Also, the BUFFER argument is not used directly by
9e9a5792
KS
2847the server process, but via the optional :log function, accepted (and
2848failed) connections may be logged in the server process' buffer.
e690ca94 2849
365aee82
KS
2850The original argument list, modified with the actual connection
2851information, is available via the `process-contact' function.
365aee82 2852
fa9d4315 2853usage: (make-network-process &rest ARGS) */)
f66c7cf8 2854 (ptrdiff_t nargs, Lisp_Object *args)
d0d6b7c5
JB
2855{
2856 Lisp_Object proc;
e690ca94
KS
2857 Lisp_Object contact;
2858 struct Lisp_Process *p;
70dbdb36 2859#ifdef HAVE_GETADDRINFO
e690ca94 2860 struct addrinfo ai, *res, *lres;
e1652a86 2861 struct addrinfo hints;
8ea90aa3
DN
2862 const char *portstring;
2863 char portbuf[128];
70dbdb36 2864#else /* HAVE_GETADDRINFO */
dd2a17ab
KS
2865 struct _emacs_addrinfo
2866 {
2867 int ai_family;
2868 int ai_socktype;
2869 int ai_protocol;
2870 int ai_addrlen;
2871 struct sockaddr *ai_addr;
2872 struct _emacs_addrinfo *ai_next;
2873 } ai, *res, *lres;
418b48fd 2874#endif /* HAVE_GETADDRINFO */
e690ca94
KS
2875 struct sockaddr_in address_in;
2876#ifdef HAVE_LOCAL_SOCKETS
2877 struct sockaddr_un address_un;
2878#endif
2879 int port;
dd2a17ab
KS
2880 int ret = 0;
2881 int xerrno = 0;
418b48fd 2882 int s = -1, outch, inch;
e690ca94 2883 struct gcpro gcpro1;
aed13378 2884 int count = SPECPDL_INDEX ();
5684cd6e 2885 int count1;
e690ca94
KS
2886 Lisp_Object QCaddress; /* one of QClocal or QCremote */
2887 Lisp_Object tem;
2888 Lisp_Object name, buffer, host, service, address;
2889 Lisp_Object filter, sentinel;
2890 int is_non_blocking_client = 0;
6b61353c 2891 int is_server = 0, backlog = 5;
9057ff80 2892 int socktype;
e690ca94
KS
2893 int family = -1;
2894
2895 if (nargs == 0)
2896 return Qnil;
dd2a17ab 2897
e690ca94
KS
2898 /* Save arguments for process-contact and clone-process. */
2899 contact = Flist (nargs, args);
2900 GCPRO1 (contact);
2901
bff3ed0a
RS
2902#ifdef WINDOWSNT
2903 /* Ensure socket support is loaded if available. */
2904 init_winsock (TRUE);
2905#endif
2906
9057ff80
KS
2907 /* :type TYPE (nil: stream, datagram */
2908 tem = Fplist_get (contact, QCtype);
2909 if (NILP (tem))
2910 socktype = SOCK_STREAM;
2911#ifdef DATAGRAM_SOCKETS
2912 else if (EQ (tem, Qdatagram))
2913 socktype = SOCK_DGRAM;
f00c449b
SM
2914#endif
2915#ifdef HAVE_SEQPACKET
2916 else if (EQ (tem, Qseqpacket))
2917 socktype = SOCK_SEQPACKET;
e690ca94 2918#endif
9057ff80
KS
2919 else
2920 error ("Unsupported connection type");
e690ca94
KS
2921
2922 /* :server BOOL */
2923 tem = Fplist_get (contact, QCserver);
2924 if (!NILP (tem))
2925 {
75728599
JR
2926 /* Don't support network sockets when non-blocking mode is
2927 not available, since a blocked Emacs is not useful. */
5e617bc2 2928#if !defined (O_NONBLOCK) && !defined (O_NDELAY)
e690ca94
KS
2929 error ("Network servers not supported");
2930#else
2931 is_server = 1;
6b61353c
KH
2932 if (INTEGERP (tem))
2933 backlog = XINT (tem);
e690ca94
KS
2934#endif
2935 }
2936
2937 /* Make QCaddress an alias for :local (server) or :remote (client). */
2938 QCaddress = is_server ? QClocal : QCremote;
2939
d7e344cd 2940 /* :nowait BOOL */
84b31826 2941 if (!is_server && socktype != SOCK_DGRAM
e690ca94
KS
2942 && (tem = Fplist_get (contact, QCnowait), !NILP (tem)))
2943 {
2944#ifndef NON_BLOCKING_CONNECT
2945 error ("Non-blocking connect not supported");
2946#else
2947 is_non_blocking_client = 1;
2948#endif
2949 }
2950
2951 name = Fplist_get (contact, QCname);
2952 buffer = Fplist_get (contact, QCbuffer);
2953 filter = Fplist_get (contact, QCfilter);
2954 sentinel = Fplist_get (contact, QCsentinel);
2955
b7826503 2956 CHECK_STRING (name);
e690ca94 2957
e690ca94
KS
2958 /* Initialize addrinfo structure in case we don't use getaddrinfo. */
2959 ai.ai_socktype = socktype;
2960 ai.ai_protocol = 0;
2961 ai.ai_next = NULL;
2962 res = &ai;
a319f7c1 2963
e690ca94
KS
2964 /* :local ADDRESS or :remote ADDRESS */
2965 address = Fplist_get (contact, QCaddress);
2966 if (!NILP (address))
a319f7c1 2967 {
e690ca94
KS
2968 host = service = Qnil;
2969
2970 if (!(ai.ai_addrlen = get_lisp_to_sockaddr_size (address, &family)))
2971 error ("Malformed :address");
2972 ai.ai_family = family;
2973 ai.ai_addr = alloca (ai.ai_addrlen);
2974 conv_lisp_to_sockaddr (family, address, ai.ai_addr, ai.ai_addrlen);
2975 goto open_socket;
a319f7c1 2976 }
e690ca94
KS
2977
2978 /* :family FAMILY -- nil (for Inet), local, or integer. */
2979 tem = Fplist_get (contact, QCfamily);
e1652a86 2980 if (NILP (tem))
a319f7c1 2981 {
5e617bc2 2982#if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
e1652a86
KS
2983 family = AF_UNSPEC;
2984#else
2985 family = AF_INET;
e690ca94 2986#endif
a319f7c1 2987 }
e1652a86
KS
2988#ifdef HAVE_LOCAL_SOCKETS
2989 else if (EQ (tem, Qlocal))
2990 family = AF_LOCAL;
2991#endif
2992#ifdef AF_INET6
2993 else if (EQ (tem, Qipv6))
2994 family = AF_INET6;
2995#endif
2996 else if (EQ (tem, Qipv4))
2997 family = AF_INET;
2998 else if (INTEGERP (tem))
2999 family = XINT (tem);
3000 else
e690ca94 3001 error ("Unknown address family");
e1652a86 3002
e690ca94
KS
3003 ai.ai_family = family;
3004
3005 /* :service SERVICE -- string, integer (port number), or t (random port). */
3006 service = Fplist_get (contact, QCservice);
3007
66a9f7f4
SM
3008 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3009 host = Fplist_get (contact, QChost);
3010 if (!NILP (host))
3011 {
3012 if (EQ (host, Qlocal))
ba3033ee
JB
3013 /* Depending on setup, "localhost" may map to different IPv4 and/or
3014 IPv6 addresses, so it's better to be explicit. (Bug#6781) */
3015 host = build_string ("127.0.0.1");
66a9f7f4
SM
3016 CHECK_STRING (host);
3017 }
3018
e690ca94
KS
3019#ifdef HAVE_LOCAL_SOCKETS
3020 if (family == AF_LOCAL)
d0d6b7c5 3021 {
66a9f7f4
SM
3022 if (!NILP (host))
3023 {
3024 message (":family local ignores the :host \"%s\" property",
3025 SDATA (host));
3026 contact = Fplist_put (contact, QChost, Qnil);
3027 host = Qnil;
3028 }
b7826503 3029 CHECK_STRING (service);
72af86bd 3030 memset (&address_un, 0, sizeof address_un);
e690ca94 3031 address_un.sun_family = AF_LOCAL;
42a5b22f 3032 strncpy (address_un.sun_path, SSDATA (service), sizeof address_un.sun_path);
e690ca94
KS
3033 ai.ai_addr = (struct sockaddr *) &address_un;
3034 ai.ai_addrlen = sizeof address_un;
3035 goto open_socket;
d0d6b7c5 3036 }
e690ca94 3037#endif
a319f7c1 3038
798b64bb
KH
3039 /* Slow down polling to every ten seconds.
3040 Some kernels have a bug which causes retrying connect to fail
3041 after a connect. Polling can interfere with gethostbyname too. */
3042#ifdef POLL_FOR_INPUT
84b31826 3043 if (socktype != SOCK_DGRAM)
e690ca94
KS
3044 {
3045 record_unwind_protect (unwind_stop_other_atimers, Qnil);
3046 bind_polling_period (10);
3047 }
798b64bb
KH
3048#endif
3049
a319f7c1 3050#ifdef HAVE_GETADDRINFO
e690ca94
KS
3051 /* If we have a host, use getaddrinfo to resolve both host and service.
3052 Otherwise, use getservbyname to lookup the service. */
3053 if (!NILP (host))
3054 {
3055
3056 /* SERVICE can either be a string or int.
3057 Convert to a C string for later use by getaddrinfo. */
3058 if (EQ (service, Qt))
3059 portstring = "0";
3060 else if (INTEGERP (service))
3061 {
c2982e87 3062 sprintf (portbuf, "%"pI"d", XINT (service));
e690ca94
KS
3063 portstring = portbuf;
3064 }
3065 else
3066 {
3067 CHECK_STRING (service);
42a5b22f 3068 portstring = SSDATA (service);
e690ca94
KS
3069 }
3070
3071 immediate_quit = 1;
3072 QUIT;
3073 memset (&hints, 0, sizeof (hints));
3074 hints.ai_flags = 0;
e1652a86 3075 hints.ai_family = family;
e690ca94
KS
3076 hints.ai_socktype = socktype;
3077 hints.ai_protocol = 0;
08116b48
CY
3078
3079#ifdef HAVE_RES_INIT
3080 res_init ();
3081#endif
3082
42a5b22f 3083 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
e690ca94 3084 if (ret)
f6270f62 3085#ifdef HAVE_GAI_STRERROR
42a5b22f 3086 error ("%s/%s %s", SSDATA (host), portstring, gai_strerror (ret));
f6270f62 3087#else
42a5b22f 3088 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
f6270f62 3089#endif
e690ca94 3090 immediate_quit = 0;
a319f7c1 3091
e690ca94
KS
3092 goto open_socket;
3093 }
3094#endif /* HAVE_GETADDRINFO */
a319f7c1 3095
e690ca94
KS
3096 /* We end up here if getaddrinfo is not defined, or in case no hostname
3097 has been specified (e.g. for a local server process). */
3098
3099 if (EQ (service, Qt))
3100 port = 0;
3101 else if (INTEGERP (service))
3102 port = htons ((unsigned short) XINT (service));
3103 else
616da37c 3104 {
e690ca94
KS
3105 struct servent *svc_info;
3106 CHECK_STRING (service);
42a5b22f 3107 svc_info = getservbyname (SSDATA (service),
e690ca94
KS
3108 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
3109 if (svc_info == 0)
d5db4077 3110 error ("Unknown service: %s", SDATA (service));
e690ca94
KS
3111 port = svc_info->s_port;
3112 }
3113
72af86bd 3114 memset (&address_in, 0, sizeof address_in);
e690ca94
KS
3115 address_in.sin_family = family;
3116 address_in.sin_addr.s_addr = INADDR_ANY;
3117 address_in.sin_port = port;
3118
3119#ifndef HAVE_GETADDRINFO
3120 if (!NILP (host))
3121 {
3122 struct hostent *host_info_ptr;
3123
c5e87d10 3124 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
f3d9532b 3125 as it may `hang' Emacs for a very long time. */
5d6c2aa3
RS
3126 immediate_quit = 1;
3127 QUIT;
08116b48
CY
3128
3129#ifdef HAVE_RES_INIT
3130 res_init ();
3131#endif
3132
d5db4077 3133 host_info_ptr = gethostbyname (SDATA (host));
5d6c2aa3 3134 immediate_quit = 0;
177c0ea7 3135
e690ca94
KS
3136 if (host_info_ptr)
3137 {
72af86bd
AS
3138 memcpy (&address_in.sin_addr, host_info_ptr->h_addr,
3139 host_info_ptr->h_length);
e690ca94
KS
3140 family = host_info_ptr->h_addrtype;
3141 address_in.sin_family = family;
3142 }
3143 else
3144 /* Attempt to interpret host as numeric inet address */
3145 {
4624371d 3146 unsigned long numeric_addr;
51b59d79 3147 numeric_addr = inet_addr (SSDATA (host));
4624371d 3148 if (numeric_addr == -1)
d5db4077 3149 error ("Unknown host \"%s\"", SDATA (host));
d0d6b7c5 3150
72af86bd
AS
3151 memcpy (&address_in.sin_addr, &numeric_addr,
3152 sizeof (address_in.sin_addr));
e690ca94 3153 }
d0d6b7c5 3154
e690ca94 3155 }
dd2a17ab 3156#endif /* not HAVE_GETADDRINFO */
d0d6b7c5 3157
e690ca94
KS
3158 ai.ai_family = family;
3159 ai.ai_addr = (struct sockaddr *) &address_in;
3160 ai.ai_addrlen = sizeof address_in;
3161
3162 open_socket:
3163
dd2a17ab 3164 /* Do this in case we never enter the for-loop below. */
aed13378 3165 count1 = SPECPDL_INDEX ();
dd2a17ab 3166 s = -1;
457a9bee 3167
dd2a17ab
KS
3168 for (lres = res; lres; lres = lres->ai_next)
3169 {
f66c7cf8 3170 ptrdiff_t optn;
c5101a77 3171 int optbits;
6b61353c 3172
4dc343ee 3173#ifdef WINDOWSNT
649dbf36 3174 retry_connect:
4dc343ee 3175#endif
649dbf36 3176
dd2a17ab
KS
3177 s = socket (lres->ai_family, lres->ai_socktype, lres->ai_protocol);
3178 if (s < 0)
3179 {
3180 xerrno = errno;
3181 continue;
3182 }
0f2ee0c1 3183
e690ca94
KS
3184#ifdef DATAGRAM_SOCKETS
3185 if (!is_server && socktype == SOCK_DGRAM)
3186 break;
3187#endif /* DATAGRAM_SOCKETS */
3188
dd2a17ab 3189#ifdef NON_BLOCKING_CONNECT
e690ca94 3190 if (is_non_blocking_client)
dd2a17ab
KS
3191 {
3192#ifdef O_NONBLOCK
3193 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3194#else
3195 ret = fcntl (s, F_SETFL, O_NDELAY);
3196#endif
3197 if (ret < 0)
3198 {
3199 xerrno = errno;
3200 emacs_close (s);
3201 s = -1;
3202 continue;
3203 }
3204 }
3205#endif
177c0ea7 3206
dd2a17ab 3207 /* Make us close S if quit. */
dd2a17ab
KS
3208 record_unwind_protect (close_file_unwind, make_number (s));
3209
6b61353c
KH
3210 /* Parse network options in the arg list.
3211 We simply ignore anything which isn't a known option (including other keywords).
63136da6 3212 An error is signaled if setting a known option fails. */
6b61353c
KH
3213 for (optn = optbits = 0; optn < nargs-1; optn += 2)
3214 optbits |= set_socket_option (s, args[optn], args[optn+1]);
3215
e690ca94
KS
3216 if (is_server)
3217 {
3218 /* Configure as a server socket. */
6b61353c
KH
3219
3220 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3221 explicit :reuseaddr key to override this. */
e690ca94
KS
3222#ifdef HAVE_LOCAL_SOCKETS
3223 if (family != AF_LOCAL)
3224#endif
6b61353c
KH
3225 if (!(optbits & (1 << OPIX_REUSEADDR)))
3226 {
3227 int optval = 1;
3228 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3229 report_file_error ("Cannot set reuse option on server socket", Qnil);
3230 }
177c0ea7 3231
e690ca94
KS
3232 if (bind (s, lres->ai_addr, lres->ai_addrlen))
3233 report_file_error ("Cannot bind server socket", Qnil);
3234
3235#ifdef HAVE_GETSOCKNAME
3236 if (EQ (service, Qt))
3237 {
3238 struct sockaddr_in sa1;
401bf9b4 3239 socklen_t len1 = sizeof (sa1);
e690ca94
KS
3240 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3241 {
3242 ((struct sockaddr_in *)(lres->ai_addr))->sin_port = sa1.sin_port;
21bd170d 3243 service = make_number (ntohs (sa1.sin_port));
e690ca94
KS
3244 contact = Fplist_put (contact, QCservice, service);
3245 }
3246 }
3247#endif
3248
84b31826 3249 if (socktype != SOCK_DGRAM && listen (s, backlog))
e690ca94
KS
3250 report_file_error ("Cannot listen on server socket", Qnil);
3251
3252 break;
3253 }
3254
dd2a17ab
KS
3255 immediate_quit = 1;
3256 QUIT;
3257
dd2a17ab
KS
3258 ret = connect (s, lres->ai_addr, lres->ai_addrlen);
3259 xerrno = errno;
3260
dd2a17ab
KS
3261 if (ret == 0 || xerrno == EISCONN)
3262 {
dd2a17ab
KS
3263 /* The unwind-protect will be discarded afterwards.
3264 Likewise for immediate_quit. */
3265 break;
3266 }
3267
3268#ifdef NON_BLOCKING_CONNECT
3269#ifdef EINPROGRESS
e690ca94 3270 if (is_non_blocking_client && xerrno == EINPROGRESS)
dd2a17ab
KS
3271 break;
3272#else
3273#ifdef EWOULDBLOCK
e690ca94 3274 if (is_non_blocking_client && xerrno == EWOULDBLOCK)
dd2a17ab
KS
3275 break;
3276#endif
3277#endif
3278#endif
649dbf36
CY
3279
3280#ifndef WINDOWSNT
cd591dbc
HE
3281 if (xerrno == EINTR)
3282 {
3283 /* Unlike most other syscalls connect() cannot be called
3284 again. (That would return EALREADY.) The proper way to
3285 wait for completion is select(). */
401bf9b4
PE
3286 int sc;
3287 socklen_t len;
cd591dbc
HE
3288 SELECT_TYPE fdset;
3289 retry_select:
3290 FD_ZERO (&fdset);
3291 FD_SET (s, &fdset);
3292 QUIT;
3293 sc = select (s + 1, (SELECT_TYPE *)0, &fdset, (SELECT_TYPE *)0,
3294 (EMACS_TIME *)0);
3295 if (sc == -1)
3296 {
649dbf36 3297 if (errno == EINTR)
cd591dbc 3298 goto retry_select;
649dbf36 3299 else
cd591dbc
HE
3300 report_file_error ("select failed", Qnil);
3301 }
3302 eassert (sc > 0);
649dbf36
CY
3303
3304 len = sizeof xerrno;
3305 eassert (FD_ISSET (s, &fdset));
3306 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) == -1)
3307 report_file_error ("getsockopt failed", Qnil);
3308 if (xerrno)
3309 errno = xerrno, report_file_error ("error during connect", Qnil);
3310 else
3311 break;
cd591dbc 3312 }
649dbf36 3313#endif /* !WINDOWSNT */
e333e864 3314
0f2ee0c1
RS
3315 immediate_quit = 0;
3316
dd2a17ab 3317 /* Discard the unwind protect closing S. */
5684cd6e 3318 specpdl_ptr = specpdl + count1;
68c45bf0 3319 emacs_close (s);
dd2a17ab 3320 s = -1;
649dbf36
CY
3321
3322#ifdef WINDOWSNT
3323 if (xerrno == EINTR)
3324 goto retry_connect;
3325#endif
dd2a17ab 3326 }
457a9bee 3327
e690ca94
KS
3328 if (s >= 0)
3329 {
3330#ifdef DATAGRAM_SOCKETS
3331 if (socktype == SOCK_DGRAM)
3332 {
3333 if (datagram_address[s].sa)
3334 abort ();
3335 datagram_address[s].sa = (struct sockaddr *) xmalloc (lres->ai_addrlen);
3336 datagram_address[s].len = lres->ai_addrlen;
3337 if (is_server)
3338 {
3339 Lisp_Object remote;
72af86bd 3340 memset (datagram_address[s].sa, 0, lres->ai_addrlen);
e690ca94
KS
3341 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3342 {
3343 int rfamily, rlen;
3344 rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3345 if (rfamily == lres->ai_family && rlen == lres->ai_addrlen)
3346 conv_lisp_to_sockaddr (rfamily, remote,
3347 datagram_address[s].sa, rlen);
3348 }
3349 }
3350 else
72af86bd 3351 memcpy (datagram_address[s].sa, lres->ai_addr, lres->ai_addrlen);
e690ca94
KS
3352 }
3353#endif
177c0ea7 3354 contact = Fplist_put (contact, QCaddress,
e690ca94 3355 conv_sockaddr_to_lisp (lres->ai_addr, lres->ai_addrlen));
2185db04
KS
3356#ifdef HAVE_GETSOCKNAME
3357 if (!is_server)
3358 {
3359 struct sockaddr_in sa1;
401bf9b4 3360 socklen_t len1 = sizeof (sa1);
2185db04
KS
3361 if (getsockname (s, (struct sockaddr *)&sa1, &len1) == 0)
3362 contact = Fplist_put (contact, QClocal,
d3da34e0 3363 conv_sockaddr_to_lisp ((struct sockaddr *)&sa1, len1));
2185db04
KS
3364 }
3365#endif
e690ca94
KS
3366 }
3367
54b3b62f
YM
3368 immediate_quit = 0;
3369
dd2a17ab 3370#ifdef HAVE_GETADDRINFO
e690ca94 3371 if (res != &ai)
54b3b62f
YM
3372 {
3373 BLOCK_INPUT;
3374 freeaddrinfo (res);
3375 UNBLOCK_INPUT;
3376 }
dd2a17ab
KS
3377#endif
3378
e690ca94
KS
3379 /* Discard the unwind protect for closing S, if any. */
3380 specpdl_ptr = specpdl + count1;
3381
3382 /* Unwind bind_polling_period and request_sigio. */
3383 unbind_to (count, Qnil);
3384
dd2a17ab
KS
3385 if (s < 0)
3386 {
dd2a17ab
KS
3387 /* If non-blocking got this far - and failed - assume non-blocking is
3388 not supported after all. This is probably a wrong assumption, but
e690ca94
KS
3389 the normal blocking calls to open-network-stream handles this error
3390 better. */
3391 if (is_non_blocking_client)
dd2a17ab 3392 return Qnil;
dd2a17ab 3393
d0d6b7c5 3394 errno = xerrno;
e690ca94
KS
3395 if (is_server)
3396 report_file_error ("make server process failed", contact);
3397 else
3398 report_file_error ("make client process failed", contact);
d0d6b7c5 3399 }
44ade2e9 3400
d0d6b7c5 3401 inch = s;
59f23005 3402 outch = s;
d0d6b7c5
JB
3403
3404 if (!NILP (buffer))
3405 buffer = Fget_buffer_create (buffer);
3406 proc = make_process (name);
3407
3408 chan_process[inch] = proc;
3409
3410#ifdef O_NONBLOCK
3411 fcntl (inch, F_SETFL, O_NONBLOCK);
3412#else
3413#ifdef O_NDELAY
3414 fcntl (inch, F_SETFL, O_NDELAY);
3415#endif
3416#endif
3417
e690ca94
KS
3418 p = XPROCESS (proc);
3419
3420 p->childp = contact;
faa7db08 3421 p->plist = Fcopy_sequence (Fplist_get (contact, QCplist));
d888760c 3422 p->type = Qnetwork;
177c0ea7 3423
e690ca94
KS
3424 p->buffer = buffer;
3425 p->sentinel = sentinel;
3426 p->filter = filter;
3427 p->log = Fplist_get (contact, QClog);
3428 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
60f0fb11 3429 p->kill_without_query = 1;
e690ca94
KS
3430 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
3431 p->command = Qt;
6bfd98e7 3432 p->pid = 0;
60f0fb11
SM
3433 p->infd = inch;
3434 p->outfd = outch;
84b31826 3435 if (is_server && socktype != SOCK_DGRAM)
e690ca94 3436 p->status = Qlisten;
dd2a17ab 3437
f523e0c3
SM
3438 /* Make the process marker point into the process buffer (if any). */
3439 if (BUFFERP (buffer))
3440 set_marker_both (p->mark, buffer,
3441 BUF_ZV (XBUFFER (buffer)),
3442 BUF_ZV_BYTE (XBUFFER (buffer)));
3443
dd2a17ab 3444#ifdef NON_BLOCKING_CONNECT
e690ca94 3445 if (is_non_blocking_client)
dd2a17ab
KS
3446 {
3447 /* We may get here if connect did succeed immediately. However,
3448 in that case, we still need to signal this like a non-blocking
3449 connection. */
e690ca94 3450 p->status = Qconnect;
dd2a17ab
KS
3451 if (!FD_ISSET (inch, &connect_wait_mask))
3452 {
3453 FD_SET (inch, &connect_wait_mask);
3fad2ad2 3454 FD_SET (inch, &write_mask);
dd2a17ab
KS
3455 num_pending_connects++;
3456 }
3457 }
3458 else
3459#endif
e690ca94
KS
3460 /* A server may have a client filter setting of Qt, but it must
3461 still listen for incoming connects unless it is stopped. */
3462 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3463 || (EQ (p->status, Qlisten) && NILP (p->command)))
dd2a17ab
KS
3464 {
3465 FD_SET (inch, &input_wait_mask);
3466 FD_SET (inch, &non_keyboard_wait_mask);
3467 }
3468
7d0e672e
RS
3469 if (inch > max_process_desc)
3470 max_process_desc = inch;
d0d6b7c5 3471
e690ca94
KS
3472 tem = Fplist_member (contact, QCcoding);
3473 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3474 tem = Qnil; /* No error message (too late!). */
3475
67918941
RS
3476 {
3477 /* Setup coding systems for communicating with the network stream. */
dbf31225 3478 struct gcpro gcpro1;
67918941
RS
3479 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3480 Lisp_Object coding_systems = Qt;
b93aacde 3481 Lisp_Object fargs[5], val;
67918941 3482
e690ca94 3483 if (!NILP (tem))
6b61353c
KH
3484 {
3485 val = XCAR (XCDR (tem));
3486 if (CONSP (val))
3487 val = XCAR (val);
3488 }
e690ca94 3489 else if (!NILP (Vcoding_system_for_read))
67918941 3490 val = Vcoding_system_for_read;
4b4deea2
TT
3491 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3492 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
67918941
RS
3493 /* We dare not decode end-of-line format by setting VAL to
3494 Qraw_text, because the existing Emacs Lisp libraries
3495 assume that they receive bare code including a sequene of
3496 CR LF. */
3497 val = Qnil;
3498 else
3499 {
991234f0
KS
3500 if (NILP (host) || NILP (service))
3501 coding_systems = Qnil;
3502 else
3503 {
b93aacde
PE
3504 fargs[0] = Qopen_network_stream, fargs[1] = name,
3505 fargs[2] = buffer, fargs[3] = host, fargs[4] = service;
dbf31225 3506 GCPRO1 (proc);
b93aacde 3507 coding_systems = Ffind_operation_coding_system (5, fargs);
dbf31225 3508 UNGCPRO;
991234f0 3509 }
67918941 3510 if (CONSP (coding_systems))
70949dac 3511 val = XCAR (coding_systems);
67918941 3512 else if (CONSP (Vdefault_process_coding_system))
70949dac 3513 val = XCAR (Vdefault_process_coding_system);
67918941
RS
3514 else
3515 val = Qnil;
3516 }
e690ca94 3517 p->decode_coding_system = val;
0fa1789e 3518
e690ca94 3519 if (!NILP (tem))
6b61353c
KH
3520 {
3521 val = XCAR (XCDR (tem));
3522 if (CONSP (val))
3523 val = XCDR (val);
3524 }
e690ca94 3525 else if (!NILP (Vcoding_system_for_write))
67918941 3526 val = Vcoding_system_for_write;
4b4deea2 3527 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
67918941
RS
3528 val = Qnil;
3529 else
3530 {
3531 if (EQ (coding_systems, Qt))
3532 {
991234f0
KS
3533 if (NILP (host) || NILP (service))
3534 coding_systems = Qnil;
3535 else
3536 {
b93aacde
PE
3537 fargs[0] = Qopen_network_stream, fargs[1] = name,
3538 fargs[2] = buffer, fargs[3] = host, fargs[4] = service;
dbf31225 3539 GCPRO1 (proc);
b93aacde 3540 coding_systems = Ffind_operation_coding_system (5, fargs);
dbf31225 3541 UNGCPRO;
991234f0 3542 }
67918941
RS
3543 }
3544 if (CONSP (coding_systems))
70949dac 3545 val = XCDR (coding_systems);
67918941 3546 else if (CONSP (Vdefault_process_coding_system))
70949dac 3547 val = XCDR (Vdefault_process_coding_system);
67918941
RS
3548 else
3549 val = Qnil;
3550 }
e690ca94 3551 p->encode_coding_system = val;
67918941 3552 }
03f04413 3553 setup_process_coding_systems (proc);
0fa1789e 3554
cbe81f1d 3555 p->decoding_buf = empty_unibyte_string;
60f0fb11 3556 p->decoding_carryover = 0;
cbe81f1d 3557 p->encoding_buf = empty_unibyte_string;
0fa1789e 3558
e690ca94 3559 p->inherit_coding_system_flag
e6fca843 3560 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
52a1b894 3561
d0d6b7c5
JB
3562 UNGCPRO;
3563 return proc;
3564}
d0d6b7c5 3565
6b61353c 3566\f
5e617bc2 3567#if defined (HAVE_NET_IF_H)
6b61353c
KH
3568
3569#ifdef SIOCGIFCONF
3570DEFUN ("network-interface-list", Fnetwork_interface_list, Snetwork_interface_list, 0, 0, 0,
3571 doc: /* Return an alist of all network interfaces and their network address.
3572Each element is a cons, the car of which is a string containing the
3573interface name, and the cdr is the network address in internal
3574format; see the description of ADDRESS in `make-network-process'. */)
5842a27b 3575 (void)
6b61353c
KH
3576{
3577 struct ifconf ifconf;
377538cb
JD
3578 struct ifreq *ifreq;
3579 void *buf = NULL;
70c60eb2
PE
3580 ptrdiff_t buf_size = 512;
3581 int s, i;
6b61353c
KH
3582 Lisp_Object res;
3583
3584 s = socket (AF_INET, SOCK_STREAM, 0);
3585 if (s < 0)
3586 return Qnil;
3587
76667214 3588 do
6b61353c 3589 {
76667214
PE
3590 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
3591 ifconf.ifc_buf = buf;
3592 ifconf.ifc_len = buf_size;
156bffbe
AS
3593 if (ioctl (s, SIOCGIFCONF, &ifconf))
3594 {
3595 close (s);
76667214 3596 xfree (buf);
156bffbe
AS
3597 return Qnil;
3598 }
6b61353c 3599 }
76667214 3600 while (ifconf.ifc_len == buf_size);
6b61353c
KH
3601
3602 close (s);
6b61353c
KH
3603
3604 res = Qnil;
156bffbe
AS
3605 ifreq = ifconf.ifc_req;
3606 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
6b61353c 3607 {
377538cb
JD
3608 struct ifreq *ifq = ifreq;
3609#ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
156bffbe
AS
3610#define SIZEOF_IFREQ(sif) \
3611 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3612 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
377538cb
JD
3613
3614 int len = SIZEOF_IFREQ (ifq);
3615#else
3616 int len = sizeof (*ifreq);
3617#endif
6b61353c 3618 char namebuf[sizeof (ifq->ifr_name) + 1];
377538cb 3619 i += len;
156bffbe 3620 ifreq = (struct ifreq *) ((char *) ifreq + len);
377538cb 3621
6b61353c
KH
3622 if (ifq->ifr_addr.sa_family != AF_INET)
3623 continue;
377538cb 3624
72af86bd 3625 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
6b61353c
KH
3626 namebuf[sizeof (ifq->ifr_name)] = 0;
3627 res = Fcons (Fcons (build_string (namebuf),
3628 conv_sockaddr_to_lisp (&ifq->ifr_addr,
3629 sizeof (struct sockaddr))),
3630 res);
3631 }
3632
377538cb 3633 xfree (buf);
6b61353c
KH
3634 return res;
3635}
3636#endif /* SIOCGIFCONF */
3637
5e617bc2 3638#if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
6b61353c
KH
3639
3640struct ifflag_def {
3641 int flag_bit;
91433552 3642 const char *flag_sym;
6b61353c
KH
3643};
3644
91433552 3645static const struct ifflag_def ifflag_table[] = {
6b61353c
KH
3646#ifdef IFF_UP
3647 { IFF_UP, "up" },
3648#endif
3649#ifdef IFF_BROADCAST
3650 { IFF_BROADCAST, "broadcast" },
3651#endif
3652#ifdef IFF_DEBUG
3653 { IFF_DEBUG, "debug" },
3654#endif
3655#ifdef IFF_LOOPBACK
3656 { IFF_LOOPBACK, "loopback" },
3657#endif
3658#ifdef IFF_POINTOPOINT
3659 { IFF_POINTOPOINT, "pointopoint" },
3660#endif
3661#ifdef IFF_RUNNING
3662 { IFF_RUNNING, "running" },
3663#endif
3664#ifdef IFF_NOARP
3665 { IFF_NOARP, "noarp" },
3666#endif
3667#ifdef IFF_PROMISC
3668 { IFF_PROMISC, "promisc" },
3669#endif
3670#ifdef IFF_NOTRAILERS
377538cb
JD
3671#ifdef NS_IMPL_COCOA
3672 /* Really means smart, notrailers is obsolete */
3673 { IFF_NOTRAILERS, "smart" },
3674#else
6b61353c
KH
3675 { IFF_NOTRAILERS, "notrailers" },
3676#endif
377538cb 3677#endif
6b61353c
KH
3678#ifdef IFF_ALLMULTI
3679 { IFF_ALLMULTI, "allmulti" },
3680#endif
3681#ifdef IFF_MASTER
3682 { IFF_MASTER, "master" },
3683#endif
3684#ifdef IFF_SLAVE
3685 { IFF_SLAVE, "slave" },
3686#endif
3687#ifdef IFF_MULTICAST
3688 { IFF_MULTICAST, "multicast" },
3689#endif
3690#ifdef IFF_PORTSEL
3691 { IFF_PORTSEL, "portsel" },
3692#endif
3693#ifdef IFF_AUTOMEDIA
3694 { IFF_AUTOMEDIA, "automedia" },
3695#endif
3696#ifdef IFF_DYNAMIC
3697 { IFF_DYNAMIC, "dynamic" },
e1652a86 3698#endif
2026418c
YM
3699#ifdef IFF_OACTIVE
3700 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress */
e1652a86
KS
3701#endif
3702#ifdef IFF_SIMPLEX
3703 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions */
3704#endif
3705#ifdef IFF_LINK0
3706 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit */
3707#endif
3708#ifdef IFF_LINK1
3709 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit */
3710#endif
3711#ifdef IFF_LINK2
3712 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit */
6b61353c
KH
3713#endif
3714 { 0, 0 }
3715};
3716
3717DEFUN ("network-interface-info", Fnetwork_interface_info, Snetwork_interface_info, 1, 1, 0,
3718 doc: /* Return information about network interface named IFNAME.
3719The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
3720where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
e4920bc9 3721NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
6b61353c 3722FLAGS is the current flags of the interface. */)
5842a27b 3723 (Lisp_Object ifname)
6b61353c
KH
3724{
3725 struct ifreq rq;
3726 Lisp_Object res = Qnil;
3727 Lisp_Object elt;
3728 int s;
3729 int any = 0;
0a0d27fb
PE
3730#if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
3731 && defined HAVE_GETIFADDRS && defined LLADDR)
377538cb
JD
3732 struct ifaddrs *ifap;
3733#endif
6b61353c
KH
3734
3735 CHECK_STRING (ifname);
3736
72af86bd 3737 memset (rq.ifr_name, 0, sizeof rq.ifr_name);
0da49335 3738 strncpy (rq.ifr_name, SSDATA (ifname), sizeof (rq.ifr_name));
6b61353c
KH
3739
3740 s = socket (AF_INET, SOCK_STREAM, 0);
3741 if (s < 0)
3742 return Qnil;
3743
3744 elt = Qnil;
5e617bc2 3745#if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
6b61353c
KH
3746 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
3747 {
3748 int flags = rq.ifr_flags;
91433552 3749 const struct ifflag_def *fp;
6b61353c
KH
3750 int fnum;
3751
377538cb
JD
3752 /* If flags is smaller than int (i.e. short) it may have the high bit set
3753 due to IFF_MULTICAST. In that case, sign extending it into
3754 an int is wrong. */
3755 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
3756 flags = (unsigned short) rq.ifr_flags;
3757
bc57d757 3758 any = 1;
82a80058 3759 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
6b61353c
KH
3760 {
3761 if (flags & fp->flag_bit)
3762 {
3763 elt = Fcons (intern (fp->flag_sym), elt);
3764 flags -= fp->flag_bit;
3765 }
3766 }
fa3c87e1 3767 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
6b61353c 3768 {
fa3c87e1 3769 if (flags & 1)
6b61353c
KH
3770 {
3771 elt = Fcons (make_number (fnum), elt);
3772 }
3773 }
3774 }
3775#endif
3776 res = Fcons (elt, res);
3777
3778 elt = Qnil;
5e617bc2 3779#if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
6b61353c
KH
3780 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
3781 {
3782 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
3783 register struct Lisp_Vector *p = XVECTOR (hwaddr);
3784 int n;
3785
bc57d757 3786 any = 1;
6b61353c
KH
3787 for (n = 0; n < 6; n++)
3788 p->contents[n] = make_number (((unsigned char *)&rq.ifr_hwaddr.sa_data[0])[n]);
3789 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
3790 }
5e617bc2 3791#elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
377538cb
JD
3792 if (getifaddrs (&ifap) != -1)
3793 {
3794 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
3795 register struct Lisp_Vector *p = XVECTOR (hwaddr);
3796 struct ifaddrs *it;
3797
3798 for (it = ifap; it != NULL; it = it->ifa_next)
3799 {
3800 struct sockaddr_dl *sdl = (struct sockaddr_dl*) it->ifa_addr;
3801 unsigned char linkaddr[6];
3802 int n;
3803
3804 if (it->ifa_addr->sa_family != AF_LINK
3805 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
3806 || sdl->sdl_alen != 6)
3807 continue;
3808
5e617bc2 3809 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
377538cb
JD
3810 for (n = 0; n < 6; n++)
3811 p->contents[n] = make_number (linkaddr[n]);
3812
3813 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
3814 break;
3815 }
3816 }
3817#ifdef HAVE_FREEIFADDRS
3818 freeifaddrs (ifap);
6b61353c 3819#endif
377538cb
JD
3820
3821#endif /* HAVE_GETIFADDRS && LLADDR */
3822
6b61353c
KH
3823 res = Fcons (elt, res);
3824
3825 elt = Qnil;
5e617bc2 3826#if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
6b61353c
KH
3827 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
3828 {
bc57d757 3829 any = 1;
2026418c 3830#ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
6b61353c 3831 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
2026418c
YM
3832#else
3833 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3834#endif
6b61353c
KH
3835 }
3836#endif
3837 res = Fcons (elt, res);
3838
3839 elt = Qnil;
5e617bc2 3840#if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
6b61353c
KH
3841 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
3842 {
bc57d757 3843 any = 1;
6b61353c
KH
3844 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
3845 }
3846#endif
3847 res = Fcons (elt, res);
3848
3849 elt = Qnil;
5e617bc2 3850#if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
6b61353c
KH
3851 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
3852 {
bc57d757 3853 any = 1;
6b61353c
KH
3854 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
3855 }
3856#endif
3857 res = Fcons (elt, res);
3858
3859 close (s);
3860
3861 return any ? res : Qnil;
3862}
3863#endif
5e617bc2 3864#endif /* defined (HAVE_NET_IF_H) */
6b61353c 3865
04391069
RS
3866/* Turn off input and output for process PROC. */
3867
40ccffa6 3868static void
d3da34e0 3869deactivate_process (Lisp_Object proc)
d0d6b7c5
JB
3870{
3871 register int inchannel, outchannel;
3872 register struct Lisp_Process *p = XPROCESS (proc);
3873
9c6c6f49
CY
3874#ifdef HAVE_GNUTLS
3875 /* Delete GnuTLS structures in PROC, if any. */
3876 emacs_gnutls_deinit (proc);
3877#endif /* HAVE_GNUTLS */
3878
60f0fb11
SM
3879 inchannel = p->infd;
3880 outchannel = p->outfd;
d0d6b7c5 3881
6b61353c 3882#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11 3883 if (p->read_output_delay > 0)
6b61353c
KH
3884 {
3885 if (--process_output_delay_count < 0)
3886 process_output_delay_count = 0;
60f0fb11
SM
3887 p->read_output_delay = 0;
3888 p->read_output_skip = 0;
6b61353c
KH
3889 }
3890#endif
f3d9532b 3891
a9f2c884 3892 if (inchannel >= 0)
d0d6b7c5
JB
3893 {
3894 /* Beware SIGCHLD hereabouts. */
3895 flush_pending_output (inchannel);
68c45bf0 3896 emacs_close (inchannel);
a9f2c884 3897 if (outchannel >= 0 && outchannel != inchannel)
68c45bf0 3898 emacs_close (outchannel);
d0d6b7c5 3899
60f0fb11
SM
3900 p->infd = -1;
3901 p->outfd = -1;
e690ca94
KS
3902#ifdef DATAGRAM_SOCKETS
3903 if (DATAGRAM_CHAN_P (inchannel))
3904 {
3905 xfree (datagram_address[inchannel].sa);
3906 datagram_address[inchannel].sa = 0;
3907 datagram_address[inchannel].len = 0;
3908 }
3909#endif
d0d6b7c5
JB
3910 chan_process[inchannel] = Qnil;
3911 FD_CLR (inchannel, &input_wait_mask);
a69281ff 3912 FD_CLR (inchannel, &non_keyboard_wait_mask);
bad49fc7 3913#ifdef NON_BLOCKING_CONNECT
dd2a17ab
KS
3914 if (FD_ISSET (inchannel, &connect_wait_mask))
3915 {
3916 FD_CLR (inchannel, &connect_wait_mask);
3fad2ad2 3917 FD_CLR (inchannel, &write_mask);
dd2a17ab
KS
3918 if (--num_pending_connects < 0)
3919 abort ();
3920 }
bad49fc7 3921#endif
7d0e672e
RS
3922 if (inchannel == max_process_desc)
3923 {
3924 int i;
3925 /* We just closed the highest-numbered process input descriptor,
3926 so recompute the highest-numbered one now. */
3927 max_process_desc = 0;
3928 for (i = 0; i < MAXDESC; i++)
3929 if (!NILP (chan_process[i]))
3930 max_process_desc = i;
3931 }
d0d6b7c5
JB
3932 }
3933}
3934
d0d6b7c5
JB
3935\f
3936DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
107ed38d 3937 0, 4, 0,
fdb82f93
PJ
3938 doc: /* Allow any pending output from subprocesses to be read by Emacs.
3939It is read into the process' buffers or given to their filter functions.
3940Non-nil arg PROCESS means do not return until some output has been received
3941from PROCESS.
5088da42 3942
2a7bb882
MR
3943Non-nil second arg SECONDS and third arg MILLISEC are number of seconds
3944and milliseconds to wait; return after that much time whether or not
3945there is any subprocess output. If SECONDS is a floating point number,
5088da42 3946it specifies a fractional number of seconds to wait.
891bd142 3947The MILLISEC argument is obsolete and should be avoided.
5088da42 3948
107ed38d
KS
3949If optional fourth arg JUST-THIS-ONE is non-nil, only accept output
3950from PROCESS, suspending reading output from other processes.
3951If JUST-THIS-ONE is an integer, don't run any timers either.
e0f24100 3952Return non-nil if we received any output before the timeout expired. */)
5842a27b 3953 (register Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec, Lisp_Object just_this_one)
d0d6b7c5 3954{
5088da42 3955 int secs, usecs = 0;
d0d6b7c5 3956
0748d150 3957 if (! NILP (process))
b7826503 3958 CHECK_PROCESS (process);
107ed38d
KS
3959 else
3960 just_this_one = Qnil;
0748d150 3961
891bd142
SM
3962 if (!NILP (millisec))
3963 { /* Obsolete calling convention using integers rather than floats. */
3964 CHECK_NUMBER (millisec);
3965 if (NILP (seconds))
3966 seconds = make_float (XINT (millisec) / 1000.0);
3967 else
3968 {
3969 CHECK_NUMBER (seconds);
3970 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
3971 }
3972 }
3973
5088da42 3974 if (!NILP (seconds))
d0d6b7c5 3975 {
5088da42
KS
3976 if (INTEGERP (seconds))
3977 secs = XINT (seconds);
3978 else if (FLOATP (seconds))
3979 {
3980 double timeout = XFLOAT_DATA (seconds);
3981 secs = (int) timeout;
3982 usecs = (int) ((timeout - (double) secs) * 1000000);
3983 }
3984 else
3985 wrong_type_argument (Qnumberp, seconds);
d0d6b7c5 3986
5088da42
KS
3987 if (secs < 0 || (secs == 0 && usecs == 0))
3988 secs = -1, usecs = 0;
d0d6b7c5
JB
3989 }
3990 else
5088da42 3991 secs = NILP (process) ? -1 : 0;
d0d6b7c5
JB
3992
3993 return
5088da42 3994 (wait_reading_process_output (secs, usecs, 0, 0,
214d6069
KS
3995 Qnil,
3996 !NILP (process) ? XPROCESS (process) : NULL,
3997 NILP (just_this_one) ? 0 :
3998 !INTEGERP (just_this_one) ? 1 : -1)
d0d6b7c5
JB
3999 ? Qt : Qnil);
4000}
4001
e690ca94
KS
4002/* Accept a connection for server process SERVER on CHANNEL. */
4003
4004static int connect_counter = 0;
4005
4006static void
d3da34e0 4007server_accept_connection (Lisp_Object server, int channel)
e690ca94
KS
4008{
4009 Lisp_Object proc, caller, name, buffer;
4010 Lisp_Object contact, host, service;
4011 struct Lisp_Process *ps= XPROCESS (server);
4012 struct Lisp_Process *p;
4013 int s;
4014 union u_sockaddr {
4015 struct sockaddr sa;
4016 struct sockaddr_in in;
e1652a86
KS
4017#ifdef AF_INET6
4018 struct sockaddr_in6 in6;
4019#endif
e690ca94
KS
4020#ifdef HAVE_LOCAL_SOCKETS
4021 struct sockaddr_un un;
4022#endif
4023 } saddr;
401bf9b4 4024 socklen_t len = sizeof saddr;
e690ca94
KS
4025
4026 s = accept (channel, &saddr.sa, &len);
4027
4028 if (s < 0)
4029 {
4030 int code = errno;
4031
4032 if (code == EAGAIN)
4033 return;
4034#ifdef EWOULDBLOCK
4035 if (code == EWOULDBLOCK)
4036 return;
4037#endif
4038
4039 if (!NILP (ps->log))
4040 call3 (ps->log, server, Qnil,
4041 concat3 (build_string ("accept failed with code"),
4042 Fnumber_to_string (make_number (code)),
4043 build_string ("\n")));
4044 return;
4045 }
4046
4047 connect_counter++;
4048
4049 /* Setup a new process to handle the connection. */
4050
4051 /* Generate a unique identification of the caller, and build contact
4052 information for this process. */
4053 host = Qt;
4054 service = Qnil;
4055 switch (saddr.sa.sa_family)
4056 {
4057 case AF_INET:
4058 {
4059 Lisp_Object args[5];
4060 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4061 args[0] = build_string ("%d.%d.%d.%d");
4062 args[1] = make_number (*ip++);
4063 args[2] = make_number (*ip++);
4064 args[3] = make_number (*ip++);
4065 args[4] = make_number (*ip++);
4066 host = Fformat (5, args);
4067 service = make_number (ntohs (saddr.in.sin_port));
4068
4069 args[0] = build_string (" <%s:%d>");
4070 args[1] = host;
4071 args[2] = service;
4072 caller = Fformat (3, args);
4073 }
4074 break;
4075
e1652a86
KS
4076#ifdef AF_INET6
4077 case AF_INET6:
4078 {
4079 Lisp_Object args[9];
4080 uint16_t *ip6 = (uint16_t *)&saddr.in6.sin6_addr;
4081 int i;
4082 args[0] = build_string ("%x:%x:%x:%x:%x:%x:%x:%x");
4083 for (i = 0; i < 8; i++)
ed3751c8 4084 args[i+1] = make_number (ntohs (ip6[i]));
e1652a86
KS
4085 host = Fformat (9, args);
4086 service = make_number (ntohs (saddr.in.sin_port));
4087
4088 args[0] = build_string (" <[%s]:%d>");
4089 args[1] = host;
4090 args[2] = service;
4091 caller = Fformat (3, args);
4092 }
4093 break;
4094#endif
4095
e690ca94
KS
4096#ifdef HAVE_LOCAL_SOCKETS
4097 case AF_LOCAL:
4098#endif
4099 default:
4100 caller = Fnumber_to_string (make_number (connect_counter));
eef60308 4101 caller = concat3 (build_string (" <"), caller, build_string (">"));
e690ca94
KS
4102 break;
4103 }
4104
4105 /* Create a new buffer name for this process if it doesn't have a
4106 filter. The new buffer name is based on the buffer name or
4107 process name of the server process concatenated with the caller
4108 identification. */
4109
4110 if (!NILP (ps->filter) && !EQ (ps->filter, Qt))
4111 buffer = Qnil;
4112 else
4113 {
4114 buffer = ps->buffer;
4115 if (!NILP (buffer))
4116 buffer = Fbuffer_name (buffer);
4117 else
4118 buffer = ps->name;
4119 if (!NILP (buffer))
4120 {
4121 buffer = concat2 (buffer, caller);
4122 buffer = Fget_buffer_create (buffer);
4123 }
4124 }
4125
4126 /* Generate a unique name for the new server process. Combine the
4127 server process name with the caller identification. */
4128
4129 name = concat2 (ps->name, caller);
4130 proc = make_process (name);
4131
4132 chan_process[s] = proc;
4133
4134#ifdef O_NONBLOCK
4135 fcntl (s, F_SETFL, O_NONBLOCK);
4136#else
4137#ifdef O_NDELAY
4138 fcntl (s, F_SETFL, O_NDELAY);
4139#endif
4140#endif
4141
4142 p = XPROCESS (proc);
4143
4144 /* Build new contact information for this setup. */
4145 contact = Fcopy_sequence (ps->childp);
4146 contact = Fplist_put (contact, QCserver, Qnil);
4147 contact = Fplist_put (contact, QChost, host);
4148 if (!NILP (service))
4149 contact = Fplist_put (contact, QCservice, service);
177c0ea7 4150 contact = Fplist_put (contact, QCremote,
e690ca94
KS
4151 conv_sockaddr_to_lisp (&saddr.sa, len));
4152#ifdef HAVE_GETSOCKNAME
4153 len = sizeof saddr;
2185db04 4154 if (getsockname (s, &saddr.sa, &len) == 0)
177c0ea7 4155 contact = Fplist_put (contact, QClocal,
e690ca94
KS
4156 conv_sockaddr_to_lisp (&saddr.sa, len));
4157#endif
4158
4159 p->childp = contact;
faa7db08 4160 p->plist = Fcopy_sequence (ps->plist);
d888760c 4161 p->type = Qnetwork;
ac4a7584 4162
e690ca94
KS
4163 p->buffer = buffer;
4164 p->sentinel = ps->sentinel;
4165 p->filter = ps->filter;
4166 p->command = Qnil;
6bfd98e7 4167 p->pid = 0;
60f0fb11
SM
4168 p->infd = s;
4169 p->outfd = s;
e690ca94
KS
4170 p->status = Qrun;
4171
4172 /* Client processes for accepted connections are not stopped initially. */
4173 if (!EQ (p->filter, Qt))
4174 {
4175 FD_SET (s, &input_wait_mask);
4176 FD_SET (s, &non_keyboard_wait_mask);
4177 }
4178
4179 if (s > max_process_desc)
4180 max_process_desc = s;
4181
177c0ea7 4182 /* Setup coding system for new process based on server process.
e690ca94
KS
4183 This seems to be the proper thing to do, as the coding system
4184 of the new process should reflect the settings at the time the
4185 server socket was opened; not the current settings. */
4186
4187 p->decode_coding_system = ps->decode_coding_system;
4188 p->encode_coding_system = ps->encode_coding_system;
03f04413 4189 setup_process_coding_systems (proc);
e690ca94 4190
cbe81f1d 4191 p->decoding_buf = empty_unibyte_string;
60f0fb11 4192 p->decoding_carryover = 0;
cbe81f1d 4193 p->encoding_buf = empty_unibyte_string;
e690ca94
KS
4194
4195 p->inherit_coding_system_flag
60f0fb11 4196 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
e690ca94
KS
4197
4198 if (!NILP (ps->log))
4199 call3 (ps->log, server, proc,
4200 concat3 (build_string ("accept from "),
4201 (STRINGP (host) ? host : build_string ("-")),
4202 build_string ("\n")));
4203
bed9664a 4204 if (!NILP (p->sentinel))
177c0ea7 4205 exec_sentinel (proc,
e690ca94
KS
4206 concat3 (build_string ("open from "),
4207 (STRINGP (host) ? host : build_string ("-")),
4208 build_string ("\n")));
4209}
4210
d0d6b7c5
JB
4211/* This variable is different from waiting_for_input in keyboard.c.
4212 It is used to communicate to a lisp process-filter/sentinel (via the
f3d9532b 4213 function Fwaiting_for_user_input_p below) whether Emacs was waiting
d0d6b7c5
JB
4214 for user-input when that process-filter was called.
4215 waiting_for_input cannot be used as that is by definition 0 when
d430ee71
RS
4216 lisp code is being evalled.
4217 This is also used in record_asynch_buffer_change.
4218 For that purpose, this must be 0
214d6069 4219 when not inside wait_reading_process_output. */
d0d6b7c5
JB
4220static int waiting_for_user_input_p;
4221
2beb96f9 4222static Lisp_Object
d3da34e0 4223wait_reading_process_output_unwind (Lisp_Object data)
2beb96f9
KS
4224{
4225 waiting_for_user_input_p = XINT (data);
4226 return Qnil;
4227}
4228
c573ae8e 4229/* This is here so breakpoints can be put on it. */
dfcf069d 4230static void
d3da34e0 4231wait_reading_process_output_1 (void)
c573ae8e
RS
4232{
4233}
4234
e1e541bd 4235/* Use a wrapper around select to work around a bug in gdb 5.3.
96c834b6 4236 Normally, the wrapper is optimized away by inlining.
e1e541bd
KS
4237
4238 If emacs is stopped inside select, the gdb backtrace doesn't
4239 show the function which called select, so it is practically
4240 impossible to step through wait_reading_process_output. */
4241
4242#ifndef select
55d4c1b2 4243static inline int
d3da34e0 4244select_wrapper (int n, fd_set *rfd, fd_set *wfd, fd_set *xfd, struct timeval *tmo)
e1e541bd
KS
4245{
4246 return select (n, rfd, wfd, xfd, tmo);
4247}
4248#define select select_wrapper
4249#endif
4250
d0d6b7c5
JB
4251/* Read and dispose of subprocess output while waiting for timeout to
4252 elapse and/or keyboard input to be available.
4253
de6fd4b9 4254 TIME_LIMIT is:
d0d6b7c5
JB
4255 timeout in seconds, or
4256 zero for no limit, or
4257 -1 means gobble data immediately available but don't wait for any.
4258
de6fd4b9
RS
4259 MICROSECS is:
4260 an additional duration to wait, measured in microseconds.
4261 If this is nonzero and time_limit is 0, then the timeout
4262 consists of MICROSECS only.
6e4f3667 4263
de6fd4b9 4264 READ_KBD is a lisp value:
d0d6b7c5
JB
4265 0 to ignore keyboard input, or
4266 1 to return when input is available, or
84aa3ace 4267 -1 meaning caller will actually read the input, so don't throw to
d0d6b7c5 4268 the quit handler, or
d0d6b7c5 4269
de6fd4b9 4270 DO_DISPLAY != 0 means redisplay should be done to show subprocess
107ed38d 4271 output that arrives.
d0d6b7c5 4272
b89a415a
KS
4273 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4274 (and gobble terminal input into the buffer if any arrives).
d0d6b7c5 4275
b89a415a 4276 If WAIT_PROC is specified, wait until something arrives from that
e0f24100 4277 process. The return value is true if we read some input from
b89a415a
KS
4278 that process.
4279
4280 If JUST_WAIT_PROC is non-nil, handle only output from WAIT_PROC
4281 (suspending output from other processes). A negative value
4282 means don't run any timers either.
4283
e0f24100 4284 If WAIT_PROC is specified, then the function returns true if we
b89a415a 4285 received input from that process before the timeout elapsed.
e0f24100 4286 Otherwise, return true if we received input from any process. */
d0d6b7c5 4287
dfcf069d 4288int
d5a3eaaf
AS
4289wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
4290 int do_display,
4291 Lisp_Object wait_for_cell,
4292 struct Lisp_Process *wait_proc, int just_wait_proc)
d0d6b7c5 4293{
41d03b9a 4294 register int channel, nfds;
855448dc 4295 SELECT_TYPE Available;
3fad2ad2
J
4296 SELECT_TYPE Writeok;
4297 int check_write;
bad49fc7 4298 int check_delay, no_avail;
d0d6b7c5
JB
4299 int xerrno;
4300 Lisp_Object proc;
41d03b9a 4301 EMACS_TIME timeout, end_time;
a9f2c884 4302 int wait_channel = -1;
d0d6b7c5 4303 int got_some_input = 0;
2beb96f9 4304 int count = SPECPDL_INDEX ();
d0d6b7c5
JB
4305
4306 FD_ZERO (&Available);
3fad2ad2 4307 FD_ZERO (&Writeok);
d0d6b7c5 4308
283357a7 4309 if (time_limit == 0 && microsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
2b0a91e7
SM
4310 && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit)))
4311 message ("Blocking call to accept-process-output with quit inhibited!!");
4312
b89a415a
KS
4313 /* If wait_proc is a process to watch, set wait_channel accordingly. */
4314 if (wait_proc != NULL)
60f0fb11 4315 wait_channel = wait_proc->infd;
84aa3ace 4316
2beb96f9
KS
4317 record_unwind_protect (wait_reading_process_output_unwind,
4318 make_number (waiting_for_user_input_p));
b89a415a 4319 waiting_for_user_input_p = read_kbd;
d0d6b7c5
JB
4320
4321 /* Since we may need to wait several times,
4322 compute the absolute time to return at. */
4323 if (time_limit || microsecs)
4324 {
4325 EMACS_GET_TIME (end_time);
4326 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
4327 EMACS_ADD_TIME (end_time, end_time, timeout);
4328 }
4329
d0d6b7c5
JB
4330 while (1)
4331 {
c0239a0b
RS
4332 int timeout_reduced_for_timers = 0;
4333
d0d6b7c5
JB
4334 /* If calling from keyboard input, do not quit
4335 since we want to return C-g as an input character.
4336 Otherwise, do pending quit if requested. */
b89a415a 4337 if (read_kbd >= 0)
d0d6b7c5 4338 QUIT;
6b61353c 4339#ifdef SYNC_INPUT
ef5eb925 4340 else
c3eff1b0 4341 process_pending_signals ();
6b61353c 4342#endif
d0d6b7c5 4343
889255b4 4344 /* Exit now if the cell we're waiting for became non-nil. */
f3fbd155 4345 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
889255b4
RS
4346 break;
4347
d0d6b7c5
JB
4348 /* Compute time from now till when time limit is up */
4349 /* Exit if already run out */
4350 if (time_limit == -1)
4351 {
4352 /* -1 specified for timeout means
4353 gobble output available now
4354 but don't wait at all. */
4355
4356 EMACS_SET_SECS_USECS (timeout, 0, 0);
4357 }
4358 else if (time_limit || microsecs)
4359 {
4360 EMACS_GET_TIME (timeout);
4361 EMACS_SUB_TIME (timeout, end_time, timeout);
4362 if (EMACS_TIME_NEG_P (timeout))
4363 break;
4364 }
4365 else
4366 {
4367 EMACS_SET_SECS_USECS (timeout, 100000, 0);
4368 }
4369
f854a00b
RS
4370 /* Normally we run timers here.
4371 But not if wait_for_cell; in those cases,
4372 the wait is supposed to be short,
4373 and those callers cannot handle running arbitrary Lisp code here. */
107ed38d 4374 if (NILP (wait_for_cell)
b89a415a 4375 && just_wait_proc >= 0)
fb4c3627 4376 {
c0239a0b 4377 EMACS_TIME timer_delay;
c573ae8e 4378
9baacf76 4379 do
c573ae8e 4380 {
9baacf76 4381 int old_timers_run = timers_run;
c88164fe 4382 struct buffer *old_buffer = current_buffer;
70bb1e5f 4383 Lisp_Object old_window = selected_window;
177c0ea7 4384
f868cd8a 4385 timer_delay = timer_check ();
a2fab450
GM
4386
4387 /* If a timer has run, this might have changed buffers
4388 an alike. Make read_key_sequence aware of that. */
4389 if (timers_run != old_timers_run
70bb1e5f
CY
4390 && (old_buffer != current_buffer
4391 || !EQ (old_window, selected_window))
a2fab450
GM
4392 && waiting_for_user_input_p == -1)
4393 record_asynch_buffer_change ();
177c0ea7 4394
9baacf76
GM
4395 if (timers_run != old_timers_run && do_display)
4396 /* We must retry, since a timer may have requeued itself
4397 and that could alter the time_delay. */
3007ebfb 4398 redisplay_preserve_echo_area (9);
9baacf76
GM
4399 else
4400 break;
c573ae8e 4401 }
9baacf76 4402 while (!detect_input_pending ());
c573ae8e 4403
69645afc 4404 /* If there is unread keyboard input, also return. */
b89a415a 4405 if (read_kbd != 0
69645afc
RS
4406 && requeued_events_pending_p ())
4407 break;
4408
c0239a0b 4409 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
fb4c3627
RS
4410 {
4411 EMACS_TIME difference;
4412 EMACS_SUB_TIME (difference, timer_delay, timeout);
4413 if (EMACS_TIME_NEG_P (difference))
c0239a0b
RS
4414 {
4415 timeout = timer_delay;
4416 timeout_reduced_for_timers = 1;
4417 }
fb4c3627 4418 }
4abca5e7
RS
4419 /* If time_limit is -1, we are not going to wait at all. */
4420 else if (time_limit != -1)
c573ae8e
RS
4421 {
4422 /* This is so a breakpoint can be put here. */
214d6069 4423 wait_reading_process_output_1 ();
c573ae8e 4424 }
fb4c3627
RS
4425 }
4426
90ab1a81
JB
4427 /* Cause C-g and alarm signals to take immediate action,
4428 and cause input available signals to zero out timeout.
4429
4430 It is important that we do this before checking for process
4431 activity. If we get a SIGCHLD after the explicit checks for
4432 process activity, timeout is the only way we will know. */
b89a415a 4433 if (read_kbd < 0)
90ab1a81
JB
4434 set_waiting_for_input (&timeout);
4435
6be429b1
JB
4436 /* If status of something has changed, and no input is
4437 available, notify the user of the change right away. After
4438 this explicit check, we'll let the SIGCHLD handler zap
e42bdf01
CY
4439 timeout to get our attention. */
4440 if (update_tick != process_tick)
6be429b1 4441 {
bad49fc7 4442 SELECT_TYPE Atemp;
bad49fc7 4443 SELECT_TYPE Ctemp;
dd2a17ab 4444
cb768704
J
4445 if (kbd_on_hold_p ())
4446 FD_ZERO (&Atemp);
4447 else
4448 Atemp = input_wait_mask;
3fad2ad2 4449 Ctemp = write_mask;
bad49fc7 4450
6be429b1 4451 EMACS_SET_SECS_USECS (timeout, 0, 0);
3fad2ad2 4452 if ((select (max (max_process_desc, max_input_desc) + 1,
177c0ea7 4453 &Atemp,
bad49fc7 4454#ifdef NON_BLOCKING_CONNECT
dd2a17ab 4455 (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0),
bad49fc7
KS
4456#else
4457 (SELECT_TYPE *)0,
4458#endif
dd2a17ab 4459 (SELECT_TYPE *)0, &timeout)
ecd1f654 4460 <= 0))
90ab1a81
JB
4461 {
4462 /* It's okay for us to do this and then continue with
a0e4d3f3 4463 the loop, since timeout has already been zeroed out. */
90ab1a81 4464 clear_waiting_for_input ();
ff6daed3 4465 status_notify (NULL);
e42bdf01 4466 if (do_display) redisplay_preserve_echo_area (13);
90ab1a81 4467 }
6be429b1
JB
4468 }
4469
dd2a17ab 4470 /* Don't wait for output from a non-running process. Just
63136da6 4471 read whatever data has already been received. */
6bfd98e7 4472 if (wait_proc && wait_proc->raw_status_new)
6be429b1 4473 update_status (wait_proc);
6bfd98e7 4474 if (wait_proc
dd2a17ab
KS
4475 && ! EQ (wait_proc->status, Qrun)
4476 && ! EQ (wait_proc->status, Qconnect))
9aa2a7f4 4477 {
215b45e9 4478 int nread, total_nread = 0;
7ce63188 4479
9aa2a7f4 4480 clear_waiting_for_input ();
7ce63188
RS
4481 XSETPROCESS (proc, wait_proc);
4482
4483 /* Read data from the process, until we exhaust it. */
60f0fb11 4484 while (wait_proc->infd >= 0)
215b45e9 4485 {
60f0fb11 4486 nread = read_process_output (proc, wait_proc->infd);
e1b37c34
GM
4487
4488 if (nread == 0)
4489 break;
4490
63136da6
AS
4491 if (0 < nread)
4492 {
891bd142
SM
4493 total_nread += nread;
4494 got_some_input = 1;
4495 }
215b45e9
RS
4496#ifdef EIO
4497 else if (nread == -1 && EIO == errno)
63136da6 4498 break;
e1b37c34
GM
4499#endif
4500#ifdef EAGAIN
4501 else if (nread == -1 && EAGAIN == errno)
63136da6 4502 break;
e1b37c34
GM
4503#endif
4504#ifdef EWOULDBLOCK
4505 else if (nread == -1 && EWOULDBLOCK == errno)
63136da6 4506 break;
215b45e9
RS
4507#endif
4508 }
7ce63188 4509 if (total_nread > 0 && do_display)
3007ebfb 4510 redisplay_preserve_echo_area (10);
7ce63188 4511
9aa2a7f4
JB
4512 break;
4513 }
6be429b1 4514
d0d6b7c5
JB
4515 /* Wait till there is something to do */
4516
b89a415a 4517 if (wait_proc && just_wait_proc)
107ed38d 4518 {
60f0fb11 4519 if (wait_proc->infd < 0) /* Terminated */
b89a415a 4520 break;
60f0fb11 4521 FD_SET (wait_proc->infd, &Available);
bad49fc7 4522 check_delay = 0;
3fad2ad2 4523 check_write = 0;
107ed38d
KS
4524 }
4525 else if (!NILP (wait_for_cell))
dd2a17ab
KS
4526 {
4527 Available = non_process_wait_mask;
bad49fc7 4528 check_delay = 0;
3fad2ad2 4529 check_write = 0;
dd2a17ab 4530 }
a69281ff 4531 else
dd2a17ab 4532 {
b89a415a 4533 if (! read_kbd)
dd2a17ab
KS
4534 Available = non_keyboard_wait_mask;
4535 else
4536 Available = input_wait_mask;
3fad2ad2 4537 Writeok = write_mask;
82d6e50b
J
4538#ifdef SELECT_CANT_DO_WRITE_MASK
4539 check_write = 0;
4540#else
3fad2ad2 4541 check_write = 1;
82d6e50b 4542#endif
6b61353c 4543 check_delay = wait_channel >= 0 ? 0 : process_output_delay_count;
dd2a17ab 4544 }
d0d6b7c5 4545
ff11dfa1 4546 /* If frame size has changed or the window is newly mapped,
ffd56f97
JB
4547 redisplay now, before we start to wait. There is a race
4548 condition here; if a SIGIO arrives between now and the select
016899c0
JB
4549 and indicates that a frame is trashed, the select may block
4550 displaying a trashed screen. */
5164ee8e 4551 if (frame_garbaged && do_display)
7286affd
RS
4552 {
4553 clear_waiting_for_input ();
3007ebfb 4554 redisplay_preserve_echo_area (11);
b89a415a 4555 if (read_kbd < 0)
7efe788e 4556 set_waiting_for_input (&timeout);
7286affd 4557 }
ffd56f97 4558
029529ac
CY
4559 /* Skip the `select' call if input is available and we're
4560 waiting for keyboard input or a cell change (which can be
4561 triggered by processing X events). In the latter case, set
4562 nfds to 1 to avoid breaking the loop. */
dd2a17ab 4563 no_avail = 0;
029529ac
CY
4564 if ((read_kbd || !NILP (wait_for_cell))
4565 && detect_input_pending ())
0a65b032 4566 {
029529ac 4567 nfds = read_kbd ? 0 : 1;
dd2a17ab 4568 no_avail = 1;
0a65b032 4569 }
029529ac
CY
4570
4571 if (!no_avail)
dd2a17ab 4572 {
6b61353c
KH
4573
4574#ifdef ADAPTIVE_READ_BUFFERING
db853b7a 4575 /* Set the timeout for adaptive read buffering if any
60f0fb11 4576 process has non-zero read_output_skip and non-zero
db853b7a
KS
4577 read_output_delay, and we are not reading output for a
4578 specific wait_channel. It is not executed if
4579 Vprocess_adaptive_read_buffering is nil. */
6b61353c
KH
4580 if (process_output_skip && check_delay > 0)
4581 {
4582 int usecs = EMACS_USECS (timeout);
4583 if (EMACS_SECS (timeout) > 0 || usecs > READ_OUTPUT_DELAY_MAX)
4584 usecs = READ_OUTPUT_DELAY_MAX;
4585 for (channel = 0; check_delay > 0 && channel <= max_process_desc; channel++)
4586 {
4587 proc = chan_process[channel];
4588 if (NILP (proc))
4589 continue;
db853b7a 4590 /* Find minimum non-zero read_output_delay among the
60f0fb11
SM
4591 processes with non-zero read_output_skip. */
4592 if (XPROCESS (proc)->read_output_delay > 0)
6b61353c
KH
4593 {
4594 check_delay--;
60f0fb11 4595 if (!XPROCESS (proc)->read_output_skip)
6b61353c
KH
4596 continue;
4597 FD_CLR (channel, &Available);
60f0fb11
SM
4598 XPROCESS (proc)->read_output_skip = 0;
4599 if (XPROCESS (proc)->read_output_delay < usecs)
4600 usecs = XPROCESS (proc)->read_output_delay;
6b61353c
KH
4601 }
4602 }
4603 EMACS_SET_SECS_USECS (timeout, 0, usecs);
4604 process_output_skip = 0;
4605 }
4606#endif
0949d2b6 4607#if defined (USE_GTK) || defined (HAVE_GCONF) || defined (HAVE_GSETTINGS)
872870b2
JD
4608 nfds = xg_select
4609#elif defined (HAVE_NS)
63136da6 4610 nfds = ns_select
edfda783 4611#else
63136da6 4612 nfds = select
edfda783 4613#endif
3fad2ad2
J
4614 (max (max_process_desc, max_input_desc) + 1,
4615 &Available,
4616 (check_write ? &Writeok : (SELECT_TYPE *)0),
4617 (SELECT_TYPE *)0, &timeout);
e061a11b
TZ
4618
4619#ifdef HAVE_GNUTLS
4620 /* GnuTLS buffers data internally. In lowat mode it leaves
4621 some data in the TCP buffers so that select works, but
4622 with custom pull/push functions we need to check if some
4623 data is available in the buffers manually. */
261b6fd4
LMI
4624 if (nfds == 0)
4625 {
4626 if (! wait_proc)
4627 {
4628 /* We're not waiting on a specific process, so loop
16c1ad08
LMI
4629 through all the channels and check for data.
4630 This is a workaround needed for some versions of
4631 the gnutls library -- 2.12.14 has been confirmed
4632 to need it. See
4633 http://comments.gmane.org/gmane.emacs.devel/145074 */
261b6fd4 4634 for (channel = 0; channel < MAXDESC; ++channel)
5b76caa4
PE
4635 if (! NILP (chan_process[channel]))
4636 {
4637 struct Lisp_Process *p =
4638 XPROCESS (chan_process[channel]);
4639 if (p && p->gnutls_p && p->infd
4640 && ((emacs_gnutls_record_check_pending
4641 (p->gnutls_state))
4642 > 0))
4643 {
4644 nfds++;
4645 FD_SET (p->infd, &Available);
4646 }
4647 }
261b6fd4
LMI
4648 }
4649 else
4650 {
4651 /* Check this specific channel. */
5b76caa4 4652 if (wait_proc->gnutls_p /* Check for valid process. */
261b6fd4 4653 /* Do we have pending data? */
5b76caa4
PE
4654 && ((emacs_gnutls_record_check_pending
4655 (wait_proc->gnutls_state))
4656 > 0))
261b6fd4
LMI
4657 {
4658 nfds = 1;
4659 /* Set to Available. */
4660 FD_SET (wait_proc->infd, &Available);
4661 }
4662 }
4663 }
e061a11b 4664#endif
dd2a17ab 4665 }
6720a7fb 4666
d0d6b7c5
JB
4667 xerrno = errno;
4668
4669 /* Make C-g and alarm signals set flags again */
4670 clear_waiting_for_input ();
4671
4672 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 4673 do_pending_window_change (0);
d0d6b7c5 4674
c0239a0b
RS
4675 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4676 /* We wanted the full specified time, so return now. */
d0d6b7c5
JB
4677 break;
4678 if (nfds < 0)
4679 {
4680 if (xerrno == EINTR)
dd2a17ab 4681 no_avail = 1;
d0d6b7c5
JB
4682 else if (xerrno == EBADF)
4683 {
4684#ifdef AIX
4685 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4686 the child's closure of the pts gives the parent a SIGHUP, and
4687 the ptc file descriptor is automatically closed,
4688 yielding EBADF here or at select() call above.
4689 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
a0e4d3f3 4690 in m/ibmrt-aix.h), and here we just ignore the select error.
d0d6b7c5 4691 Cleanup occurs c/o status_notify after SIGCLD. */
dd2a17ab 4692 no_avail = 1; /* Cannot depend on values returned */
d0d6b7c5
JB
4693#else
4694 abort ();
4695#endif
4696 }
4697 else
68c45bf0 4698 error ("select error: %s", emacs_strerror (xerrno));
d0d6b7c5 4699 }
dd2a17ab
KS
4700
4701 if (no_avail)
4702 {
4703 FD_ZERO (&Available);
3fad2ad2 4704 check_write = 0;
dd2a17ab
KS
4705 }
4706
5d5beb62
RS
4707#if 0 /* When polling is used, interrupt_input is 0,
4708 so get_input_pending should read the input.
4709 So this should not be needed. */
4710 /* If we are using polling for input,
4711 and we see input available, make it get read now.
4712 Otherwise it might not actually get read for a second.
214d6069 4713 And on hpux, since we turn off polling in wait_reading_process_output,
5d5beb62 4714 it might never get read at all if we don't spend much time
214d6069 4715 outside of wait_reading_process_output. */
b89a415a 4716 if (read_kbd && interrupt_input
5d5beb62
RS
4717 && keyboard_bit_set (&Available)
4718 && input_polling_used ())
4719 kill (getpid (), SIGALRM);
4720#endif
4721
d0d6b7c5
JB
4722 /* Check for keyboard input */
4723 /* If there is any, return immediately
4724 to give it higher priority than subprocesses */
4725
b89a415a 4726 if (read_kbd != 0)
6ed6233b 4727 {
a2fab450 4728 int old_timers_run = timers_run;
c88164fe 4729 struct buffer *old_buffer = current_buffer;
c0323133 4730 Lisp_Object old_window = selected_window;
a2fab450 4731 int leave = 0;
177c0ea7 4732
5d6c2aa3 4733 if (detect_input_pending_run_timers (do_display))
a2fab450
GM
4734 {
4735 swallow_events (do_display);
4736 if (detect_input_pending_run_timers (do_display))
4737 leave = 1;
4738 }
6ed6233b 4739
a2fab450
GM
4740 /* If a timer has run, this might have changed buffers
4741 an alike. Make read_key_sequence aware of that. */
4742 if (timers_run != old_timers_run
c88164fe 4743 && waiting_for_user_input_p == -1
c0323133
GM
4744 && (old_buffer != current_buffer
4745 || !EQ (old_window, selected_window)))
a2fab450
GM
4746 record_asynch_buffer_change ();
4747
4748 if (leave)
4749 break;
177c0ea7
JB
4750 }
4751
69645afc 4752 /* If there is unread keyboard input, also return. */
b89a415a 4753 if (read_kbd != 0
69645afc
RS
4754 && requeued_events_pending_p ())
4755 break;
4756
77e1b3d4
RS
4757 /* If we are not checking for keyboard input now,
4758 do process events (but don't run any timers).
4759 This is so that X events will be processed.
0c9960e9 4760 Otherwise they may have to wait until polling takes place.
77e1b3d4
RS
4761 That would causes delays in pasting selections, for example.
4762
4763 (We used to do this only if wait_for_cell.) */
b89a415a 4764 if (read_kbd == 0 && detect_input_pending ())
f854a00b
RS
4765 {
4766 swallow_events (do_display);
0c9960e9 4767#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
f854a00b
RS
4768 if (detect_input_pending ())
4769 break;
5d5beb62 4770#endif
0c9960e9 4771 }
f854a00b 4772
84aa3ace 4773 /* Exit now if the cell we're waiting for became non-nil. */
f3fbd155 4774 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
84aa3ace
RS
4775 break;
4776
4746118a 4777#ifdef SIGIO
5d5beb62 4778 /* If we think we have keyboard input waiting, but didn't get SIGIO,
d0d6b7c5
JB
4779 go read it. This can happen with X on BSD after logging out.
4780 In that case, there really is no input and no SIGIO,
4781 but select says there is input. */
4782
b89a415a 4783 if (read_kbd && interrupt_input
2601f59e 4784 && keyboard_bit_set (&Available) && ! noninteractive)
e643c5be 4785 kill (getpid (), SIGIO);
4746118a 4786#endif
d0d6b7c5 4787
d0d6b7c5
JB
4788 if (! wait_proc)
4789 got_some_input |= nfds > 0;
4790
32676c08
JB
4791 /* If checking input just got us a size-change event from X,
4792 obey it now if we should. */
b89a415a 4793 if (read_kbd || ! NILP (wait_for_cell))
2b653806 4794 do_pending_window_change (0);
32676c08 4795
a9f2c884 4796 /* Check for data from a process. */
dd2a17ab
KS
4797 if (no_avail || nfds == 0)
4798 continue;
4799
3fad2ad2
J
4800 for (channel = 0; channel <= max_input_desc; ++channel)
4801 {
4802 struct fd_callback_data *d = &fd_callback_info[channel];
4803 if (FD_ISSET (channel, &Available)
4804 && d->func != 0
4805 && (d->condition & FOR_READ) != 0)
4806 d->func (channel, d->data, 1);
4807 if (FD_ISSET (channel, &write_mask)
4808 && d->func != 0
4809 && (d->condition & FOR_WRITE) != 0)
4810 d->func (channel, d->data, 0);
4811 }
4812
a69281ff 4813 for (channel = 0; channel <= max_process_desc; channel++)
d0d6b7c5 4814 {
a69281ff 4815 if (FD_ISSET (channel, &Available)
3fad2ad2
J
4816 && FD_ISSET (channel, &non_keyboard_wait_mask)
4817 && !FD_ISSET (channel, &non_process_wait_mask))
d0d6b7c5
JB
4818 {
4819 int nread;
4820
4821 /* If waiting for this channel, arrange to return as
4822 soon as no more input to be processed. No more
4823 waiting. */
4824 if (wait_channel == channel)
4825 {
a9f2c884 4826 wait_channel = -1;
d0d6b7c5
JB
4827 time_limit = -1;
4828 got_some_input = 1;
4829 }
4830 proc = chan_process[channel];
4831 if (NILP (proc))
4832 continue;
4833
e690ca94
KS
4834 /* If this is a server stream socket, accept connection. */
4835 if (EQ (XPROCESS (proc)->status, Qlisten))
4836 {
4837 server_accept_connection (proc, channel);
4838 continue;
4839 }
4840
d0d6b7c5
JB
4841 /* Read data from the process, starting with our
4842 buffered-ahead character if we have one. */
4843
4844 nread = read_process_output (proc, channel);
4845 if (nread > 0)
4846 {
4847 /* Since read_process_output can run a filter,
4848 which can call accept-process-output,
4849 don't try to read from any other processes
4850 before doing the select again. */
4851 FD_ZERO (&Available);
4852
4853 if (do_display)
3007ebfb 4854 redisplay_preserve_echo_area (12);
d0d6b7c5
JB
4855 }
4856#ifdef EWOULDBLOCK
4857 else if (nread == -1 && errno == EWOULDBLOCK)
4858 ;
0b75e9a4 4859#endif
89d7280d
RS
4860 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4861 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
d0d6b7c5
JB
4862#ifdef O_NONBLOCK
4863 else if (nread == -1 && errno == EAGAIN)
4864 ;
4865#else
4866#ifdef O_NDELAY
4867 else if (nread == -1 && errno == EAGAIN)
4868 ;
4869 /* Note that we cannot distinguish between no input
4870 available now and a closed pipe.
4871 With luck, a closed pipe will be accompanied by
4872 subprocess termination and SIGCHLD. */
d888760c 4873 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
d0d6b7c5 4874 ;
4740825c
KS
4875#endif /* O_NDELAY */
4876#endif /* O_NONBLOCK */
d0d6b7c5
JB
4877#ifdef HAVE_PTYS
4878 /* On some OSs with ptys, when the process on one end of
4879 a pty exits, the other end gets an error reading with
4880 errno = EIO instead of getting an EOF (0 bytes read).
4881 Therefore, if we get an error reading and errno =
4882 EIO, just continue, because the child process has
4883 exited and should clean itself up soon (e.g. when we
5651af6d
RS
4884 get a SIGCHLD).
4885
4886 However, it has been known to happen that the SIGCHLD
4740825c 4887 got lost. So raise the signal again just in case.
5651af6d 4888 It can't hurt. */
d0d6b7c5 4889 else if (nread == -1 && errno == EIO)
4740825c 4890 {
83ed7b5c
GM
4891 /* Clear the descriptor now, so we only raise the signal once. */
4892 FD_CLR (channel, &input_wait_mask);
4893 FD_CLR (channel, &non_keyboard_wait_mask);
4740825c 4894
83ed7b5c 4895 kill (getpid (), SIGCHLD);
4740825c
KS
4896 }
4897#endif /* HAVE_PTYS */
ffd56f97
JB
4898 /* If we can detect process termination, don't consider the process
4899 gone just because its pipe is closed. */
d0d6b7c5 4900#ifdef SIGCHLD
d888760c 4901 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
d0d6b7c5
JB
4902 ;
4903#endif
4904 else
4905 {
4906 /* Preserve status of processes already terminated. */
60f0fb11 4907 XPROCESS (proc)->tick = ++process_tick;
d0d6b7c5 4908 deactivate_process (proc);
6bfd98e7 4909 if (XPROCESS (proc)->raw_status_new)
d0d6b7c5
JB
4910 update_status (XPROCESS (proc));
4911 if (EQ (XPROCESS (proc)->status, Qrun))
4912 XPROCESS (proc)->status
4913 = Fcons (Qexit, Fcons (make_number (256), Qnil));
4914 }
4915 }
177c0ea7 4916#ifdef NON_BLOCKING_CONNECT
3fad2ad2 4917 if (FD_ISSET (channel, &Writeok)
1566f511 4918 && FD_ISSET (channel, &connect_wait_mask))
dd2a17ab
KS
4919 {
4920 struct Lisp_Process *p;
dd2a17ab
KS
4921
4922 FD_CLR (channel, &connect_wait_mask);
d8a4b27a 4923 FD_CLR (channel, &write_mask);
dd2a17ab
KS
4924 if (--num_pending_connects < 0)
4925 abort ();
4926
4927 proc = chan_process[channel];
4928 if (NILP (proc))
4929 continue;
4930
4931 p = XPROCESS (proc);
4932
4933#ifdef GNU_LINUX
4934 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
63136da6 4935 So only use it on systems where it is known to work. */
dd2a17ab 4936 {
401bf9b4 4937 socklen_t xlen = sizeof (xerrno);
ed3751c8 4938 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
dd2a17ab
KS
4939 xerrno = errno;
4940 }
4941#else
44c887be
PJ
4942 {
4943 struct sockaddr pname;
ed3751c8 4944 int pnamelen = sizeof (pname);
44c887be
PJ
4945
4946 /* If connection failed, getpeername will fail. */
4947 xerrno = 0;
ed3751c8 4948 if (getpeername (channel, &pname, &pnamelen) < 0)
44c887be
PJ
4949 {
4950 /* Obtain connect failure code through error slippage. */
4951 char dummy;
dd2a17ab 4952 xerrno = errno;
ed3751c8 4953 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
44c887be
PJ
4954 xerrno = errno;
4955 }
4956 }
dd2a17ab
KS
4957#endif
4958 if (xerrno)
4959 {
60f0fb11 4960 p->tick = ++process_tick;
dd2a17ab
KS
4961 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
4962 deactivate_process (proc);
4963 }
4964 else
4965 {
4966 p->status = Qrun;
4967 /* Execute the sentinel here. If we had relied on
4968 status_notify to do it later, it will read input
4969 from the process before calling the sentinel. */
4970 exec_sentinel (proc, build_string ("open\n"));
e690ca94 4971 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
dd2a17ab 4972 {
60f0fb11
SM
4973 FD_SET (p->infd, &input_wait_mask);
4974 FD_SET (p->infd, &non_keyboard_wait_mask);
dd2a17ab
KS
4975 }
4976 }
4977 }
4978#endif /* NON_BLOCKING_CONNECT */
ffd56f97
JB
4979 } /* end for each file descriptor */
4980 } /* end while exit conditions not met */
d0d6b7c5 4981
2beb96f9 4982 unbind_to (count, Qnil);
d430ee71 4983
ffd56f97
JB
4984 /* If calling from keyboard input, do not quit
4985 since we want to return C-g as an input character.
4986 Otherwise, do pending quit if requested. */
b89a415a 4987 if (read_kbd >= 0)
ffd56f97
JB
4988 {
4989 /* Prevent input_pending from remaining set if we quit. */
4990 clear_input_pending ();
4991 QUIT;
4992 }
efa2a55c 4993
d0d6b7c5
JB
4994 return got_some_input;
4995}
4996\f
3b9a3dfa
RS
4997/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4998
4999static Lisp_Object
d3da34e0 5000read_process_output_call (Lisp_Object fun_and_args)
3b9a3dfa 5001{
70949dac 5002 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
3b9a3dfa
RS
5003}
5004
5005static Lisp_Object
b93aacde 5006read_process_output_error_handler (Lisp_Object error_val)
3b9a3dfa 5007{
b93aacde 5008 cmd_error_internal (error_val, "error in process filter: ");
3b9a3dfa
RS
5009 Vinhibit_quit = Qt;
5010 update_echo_area ();
833ba342 5011 Fsleep_for (make_number (2), Qnil);
8c983bf2 5012 return Qt;
3b9a3dfa
RS
5013}
5014
d0d6b7c5
JB
5015/* Read pending output from the process channel,
5016 starting with our buffered-ahead character if we have one.
0fa1789e 5017 Yield number of decoded characters read.
d0d6b7c5 5018
116c423c 5019 This function reads at most 4096 characters.
d0d6b7c5 5020 If you want to read all available subprocess output,
0fa1789e
KH
5021 you must call it repeatedly until it returns zero.
5022
5023 The characters read are decoded according to PROC's coding-system
5024 for decoding. */
d0d6b7c5 5025
ff6daed3 5026static int
d3da34e0 5027read_process_output (Lisp_Object proc, register int channel)
d0d6b7c5 5028{
368f4090 5029 register ssize_t nbytes;
d0d6b7c5 5030 char *chars;
d0d6b7c5 5031 register Lisp_Object outstream;
d0d6b7c5 5032 register struct Lisp_Process *p = XPROCESS (proc);
f877c546 5033 register EMACS_INT opoint;
c7580538 5034 struct coding_system *coding = proc_decode_coding_system[channel];
60f0fb11 5035 int carryover = p->decoding_carryover;
116c423c 5036 int readmax = 4096;
3a4fa2f2
SM
5037 int count = SPECPDL_INDEX ();
5038 Lisp_Object odeactivate;
d0d6b7c5 5039
e690ca94 5040 chars = (char *) alloca (carryover + readmax);
e7fbaa65
KH
5041 if (carryover)
5042 /* See the comment above. */
72af86bd 5043 memcpy (chars, SDATA (p->decoding_buf), carryover);
0fa1789e 5044
e690ca94
KS
5045#ifdef DATAGRAM_SOCKETS
5046 /* We have a working select, so proc_buffered_char is always -1. */
5047 if (DATAGRAM_CHAN_P (channel))
5048 {
401bf9b4 5049 socklen_t len = datagram_address[channel].len;
39b1da20 5050 nbytes = recvfrom (channel, chars + carryover, readmax,
e690ca94
KS
5051 0, datagram_address[channel].sa, &len);
5052 }
5053 else
5054#endif
6b61353c 5055 {
82eaa333
PE
5056 int buffered = 0 <= proc_buffered_char[channel];
5057 if (buffered)
5058 {
5059 chars[carryover] = proc_buffered_char[channel];
5060 proc_buffered_char[channel] = -1;
5061 }
8af55556 5062#ifdef HAVE_GNUTLS
df7fcaff 5063 if (XPROCESS (proc)->gnutls_p)
e968f4f3 5064 nbytes = emacs_gnutls_read (XPROCESS (proc),
82eaa333
PE
5065 chars + carryover + buffered,
5066 readmax - buffered);
8af55556
TZ
5067 else
5068#endif
82eaa333
PE
5069 nbytes = emacs_read (channel, chars + carryover + buffered,
5070 readmax - buffered);
6b61353c 5071#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11 5072 if (nbytes > 0 && p->adaptive_read_buffering)
6b61353c 5073 {
60f0fb11 5074 int delay = p->read_output_delay;
6b61353c
KH
5075 if (nbytes < 256)
5076 {
5077 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5078 {
5079 if (delay == 0)
5080 process_output_delay_count++;
5081 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5082 }
5083 }
82eaa333 5084 else if (delay > 0 && nbytes == readmax - buffered)
6b61353c
KH
5085 {
5086 delay -= READ_OUTPUT_DELAY_INCREMENT;
5087 if (delay == 0)
5088 process_output_delay_count--;
5089 }
60f0fb11 5090 p->read_output_delay = delay;
6b61353c
KH
5091 if (delay)
5092 {
60f0fb11 5093 p->read_output_skip = 1;
6b61353c
KH
5094 process_output_skip = 1;
5095 }
5096 }
5097#endif
fe07cdfa
PE
5098 nbytes += buffered;
5099 nbytes += buffered && nbytes <= 0;
d0d6b7c5 5100 }
d0d6b7c5 5101
60f0fb11 5102 p->decoding_carryover = 0;
ca65341e 5103
ed7a4b2d 5104 /* At this point, NBYTES holds number of bytes just received
0fa1789e 5105 (including the one in proc_buffered_char[channel]). */
de7fbd09
KH
5106 if (nbytes <= 0)
5107 {
5108 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5109 return nbytes;
5110 coding->mode |= CODING_MODE_LAST_BLOCK;
5111 }
d0d6b7c5 5112
1d2fc612 5113 /* Now set NBYTES how many bytes we must decode. */
e7fbaa65 5114 nbytes += carryover;
0fa1789e 5115
3a4fa2f2
SM
5116 odeactivate = Vdeactivate_mark;
5117 /* There's no good reason to let process filters change the current
5118 buffer, and many callers of accept-process-output, sit-for, and
5119 friends don't expect current-buffer to be changed from under them. */
d2630aef 5120 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
3a4fa2f2 5121
1d2fc612 5122 /* Read and dispose of the process output. */
d0d6b7c5
JB
5123 outstream = p->filter;
5124 if (!NILP (outstream))
5125 {
1d2fc612 5126 Lisp_Object text;
4da2f5be 5127 int outer_running_asynch_code = running_asynch_code;
bbce7d72 5128 int waiting = waiting_for_user_input_p;
30c78175 5129
dfc21838
RS
5130 /* No need to gcpro these, because all we do with them later
5131 is test them for EQness, and none of them should be a string. */
aba7731a
PE
5132#if 0
5133 Lisp_Object obuffer, okeymap;
dfc21838 5134 XSETBUFFER (obuffer, current_buffer);
4b4deea2 5135 okeymap = BVAR (current_buffer, keymap);
aba7731a 5136#endif
30c78175 5137
3a4fa2f2
SM
5138 /* We inhibit quit here instead of just catching it so that
5139 hitting ^G when a filter happens to be running won't screw
5140 it up. */
d0d6b7c5 5141 specbind (Qinhibit_quit, Qt);
6545aada 5142 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 5143
4da2f5be
RS
5144 /* In case we get recursively called,
5145 and we already saved the match data nonrecursively,
5146 save the same match data in safely recursive fashion. */
5147 if (outer_running_asynch_code)
5148 {
5149 Lisp_Object tem;
5150 /* Don't clobber the CURRENT match data, either! */
89f2614d
KS
5151 tem = Fmatch_data (Qnil, Qnil, Qnil);
5152 restore_search_regs ();
5153 record_unwind_save_match_data ();
5154 Fset_match_data (tem, Qt);
4da2f5be
RS
5155 }
5156
5157 /* For speed, if a search happens within this code,
5158 save the match data in a special nonrecursive fashion. */
7074fde6 5159 running_asynch_code = 1;
4da2f5be 5160
400a67ff 5161 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5bbf78c1 5162 text = coding->dst_object;
5bbf78c1 5163 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
ed7a4b2d 5164 /* A new coding system might be found. */
5bbf78c1 5165 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
ed7a4b2d 5166 {
5bbf78c1 5167 p->decode_coding_system = Vlast_coding_system_used;
ed7a4b2d
KH
5168
5169 /* Don't call setup_coding_system for
5170 proc_decode_coding_system[channel] here. It is done in
5171 detect_coding called via decode_coding above. */
5172
5173 /* If a coding system for encoding is not yet decided, we set
5174 it as the same as coding-system for decoding.
5175
5176 But, before doing that we must check if
5177 proc_encode_coding_system[p->outfd] surely points to a
5178 valid memory because p->outfd will be changed once EOF is
5179 sent to the process. */
5180 if (NILP (p->encode_coding_system)
60f0fb11 5181 && proc_encode_coding_system[p->outfd])
ed7a4b2d 5182 {
76d812bb
KH
5183 p->encode_coding_system
5184 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5bbf78c1 5185 setup_coding_system (p->encode_coding_system,
60f0fb11 5186 proc_encode_coding_system[p->outfd]);
ed7a4b2d
KH
5187 }
5188 }
51c6067d 5189
dd8c7a53
KH
5190 if (coding->carryover_bytes > 0)
5191 {
04961398
KH
5192 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5193 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
72af86bd
AS
5194 memcpy (SDATA (p->decoding_buf), coding->carryover,
5195 coding->carryover_bytes);
8c406a9b 5196 p->decoding_carryover = coding->carryover_bytes;
dd8c7a53 5197 }
e430e5ba 5198 if (SBYTES (text) > 0)
963b492b
SM
5199 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5200 sometimes it's simply wrong to wrap (e.g. when called from
5201 accept-process-output). */
dd97db06
KH
5202 internal_condition_case_1 (read_process_output_call,
5203 Fcons (outstream,
5204 Fcons (proc, Fcons (text, Qnil))),
5205 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5206 read_process_output_error_handler);
4da2f5be
RS
5207
5208 /* If we saved the match data nonrecursively, restore it now. */
89f2614d 5209 restore_search_regs ();
4da2f5be 5210 running_asynch_code = outer_running_asynch_code;
d0d6b7c5 5211
bbce7d72
RS
5212 /* Restore waiting_for_user_input_p as it was
5213 when we were called, in case the filter clobbered it. */
5214 waiting_for_user_input_p = waiting;
5215
7973cfa8
RS
5216#if 0 /* Call record_asynch_buffer_change unconditionally,
5217 because we might have changed minor modes or other things
5218 that affect key bindings. */
dfc21838
RS
5219 if (! EQ (Fcurrent_buffer (), obuffer)
5220 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 5221#endif
927e08be
RS
5222 /* But do it only if the caller is actually going to read events.
5223 Otherwise there's no need to make him wake up, and it could
7157b8fe 5224 cause trouble (for example it would make sit_for return). */
927e08be
RS
5225 if (waiting_for_user_input_p == -1)
5226 record_asynch_buffer_change ();
d0d6b7c5
JB
5227 }
5228
5229 /* If no filter, write into buffer if it isn't dead. */
4b4deea2 5230 else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name)))
d0d6b7c5 5231 {
b0310da4 5232 Lisp_Object old_read_only;
f877c546
EZ
5233 EMACS_INT old_begv, old_zv;
5234 EMACS_INT old_begv_byte, old_zv_byte;
5235 EMACS_INT before, before_byte;
5236 EMACS_INT opoint_byte;
ed7a4b2d 5237 Lisp_Object text;
926b7e5e 5238 struct buffer *b;
30c78175 5239
d0d6b7c5 5240 Fset_buffer (p->buffer);
6ec8bbd2 5241 opoint = PT;
d8a2934e 5242 opoint_byte = PT_BYTE;
4b4deea2 5243 old_read_only = BVAR (current_buffer, read_only);
12ca5cdf
RS
5244 old_begv = BEGV;
5245 old_zv = ZV;
d8a2934e
RS
5246 old_begv_byte = BEGV_BYTE;
5247 old_zv_byte = ZV_BYTE;
b0310da4 5248
4b4deea2 5249 BVAR (current_buffer, read_only) = Qnil;
d0d6b7c5
JB
5250
5251 /* Insert new output into buffer
5252 at the current end-of-output marker,
5253 thus preserving logical ordering of input and output. */
5254 if (XMARKER (p->mark)->buffer)
d8a2934e
RS
5255 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
5256 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
5257 ZV_BYTE));
d0d6b7c5 5258 else
d8a2934e 5259 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf 5260 before = PT;
d8a2934e 5261 before_byte = PT_BYTE;
b0310da4
JB
5262
5263 /* If the output marker is outside of the visible region, save
5264 the restriction and widen. */
6ec8bbd2 5265 if (! (BEGV <= PT && PT <= ZV))
b0310da4
JB
5266 Fwiden ();
5267
400a67ff 5268 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5bbf78c1
KH
5269 text = coding->dst_object;
5270 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
ed7a4b2d
KH
5271 /* A new coding system might be found. See the comment in the
5272 similar code in the previous `if' block. */
5bbf78c1 5273 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
ed7a4b2d 5274 {
5bbf78c1 5275 p->decode_coding_system = Vlast_coding_system_used;
ed7a4b2d 5276 if (NILP (p->encode_coding_system)
60f0fb11 5277 && proc_encode_coding_system[p->outfd])
ed7a4b2d 5278 {
76d812bb
KH
5279 p->encode_coding_system
5280 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5bbf78c1 5281 setup_coding_system (p->encode_coding_system,
60f0fb11 5282 proc_encode_coding_system[p->outfd]);
ed7a4b2d
KH
5283 }
5284 }
dd8c7a53
KH
5285 if (coding->carryover_bytes > 0)
5286 {
04961398
KH
5287 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5288 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
72af86bd
AS
5289 memcpy (SDATA (p->decoding_buf), coding->carryover,
5290 coding->carryover_bytes);
8c406a9b 5291 p->decoding_carryover = coding->carryover_bytes;
dd8c7a53 5292 }
d69864bf 5293 /* Adjust the multibyteness of TEXT to that of the buffer. */
4b4deea2 5294 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
d69864bf
KH
5295 != ! STRING_MULTIBYTE (text))
5296 text = (STRING_MULTIBYTE (text)
57bb5c37 5297 ? Fstring_as_unibyte (text)
03f04413 5298 : Fstring_to_multibyte (text));
57bb5c37
KH
5299 /* Insert before markers in case we are inserting where
5300 the buffer's mark is, and the user's next command is Meta-y. */
e430e5ba
KH
5301 insert_from_string_before_markers (text, 0, 0,
5302 SCHARS (text), SBYTES (text), 0);
0d023da1 5303
926b7e5e
GM
5304 /* Make sure the process marker's position is valid when the
5305 process buffer is changed in the signal_after_change above.
5306 W3 is known to do that. */
5307 if (BUFFERP (p->buffer)
5308 && (b = XBUFFER (p->buffer), b != current_buffer))
5309 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
5310 else
5311 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
b0310da4 5312
d0d6b7c5
JB
5313 update_mode_lines++;
5314
12ca5cdf
RS
5315 /* Make sure opoint and the old restrictions
5316 float ahead of any new text just as point would. */
5317 if (opoint >= before)
d8a2934e
RS
5318 {
5319 opoint += PT - before;
5320 opoint_byte += PT_BYTE - before_byte;
5321 }
12ca5cdf 5322 if (old_begv > before)
d8a2934e
RS
5323 {
5324 old_begv += PT - before;
5325 old_begv_byte += PT_BYTE - before_byte;
5326 }
12ca5cdf 5327 if (old_zv >= before)
d8a2934e
RS
5328 {
5329 old_zv += PT - before;
5330 old_zv_byte += PT_BYTE - before_byte;
5331 }
12ca5cdf 5332
b0310da4 5333 /* If the restriction isn't what it should be, set it. */
12ca5cdf
RS
5334 if (old_begv != BEGV || old_zv != ZV)
5335 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
b0310da4 5336
30c78175 5337
4b4deea2 5338 BVAR (current_buffer, read_only) = old_read_only;
d8a2934e 5339 SET_PT_BOTH (opoint, opoint_byte);
d0d6b7c5 5340 }
3a4fa2f2
SM
5341 /* Handling the process output should not deactivate the mark. */
5342 Vdeactivate_mark = odeactivate;
5343
5344 unbind_to (count, Qnil);
1d2fc612 5345 return nbytes;
d0d6b7c5 5346}
d0d6b7c5
JB
5347\f
5348/* Sending data to subprocess */
5349
40ccffa6
PE
5350static jmp_buf send_process_frame;
5351static Lisp_Object process_sent_to;
d0d6b7c5 5352
006c5daa
PE
5353#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
5354static void send_process_trap (int) NO_RETURN;
5355#endif
5356
9af30bdf 5357static void
d3da34e0 5358send_process_trap (int ignore)
d0d6b7c5 5359{
333f1b6f 5360 SIGNAL_THREAD_CHECK (SIGPIPE);
c8f44005 5361 sigunblock (sigmask (SIGPIPE));
d0d6b7c5
JB
5362 longjmp (send_process_frame, 1);
5363}
5364
4556b700
RS
5365/* Send some data to process PROC.
5366 BUF is the beginning of the data; LEN is the number of characters.
a92e4183
KH
5367 OBJECT is the Lisp object that the data comes from. If OBJECT is
5368 nil or t, it means that the data comes from C string.
0fa1789e 5369
a92e4183
KH
5370 If OBJECT is not nil, the data is encoded by PROC's coding-system
5371 for encoding before it is sent.
1fb0098c
GM
5372
5373 This function can evaluate Lisp code and can garbage collect. */
4556b700 5374
ff6daed3 5375static void
400a67ff 5376send_process (volatile Lisp_Object proc, const char *volatile buf,
f877c546 5377 volatile EMACS_INT len, volatile Lisp_Object object)
d0d6b7c5 5378{
ecd1f654 5379 /* Use volatile to protect variables from being clobbered by longjmp. */
6b61353c 5380 struct Lisp_Process *p = XPROCESS (proc);
368f4090 5381 ssize_t rv;
0fa1789e 5382 struct coding_system *coding;
347f3cd3 5383 struct gcpro gcpro1;
9af30bdf 5384 void (*volatile old_sigpipe) (int);
6044e593 5385
347f3cd3 5386 GCPRO1 (object);
d0d6b7c5 5387
6bfd98e7 5388 if (p->raw_status_new)
6b61353c
KH
5389 update_status (p);
5390 if (! EQ (p->status, Qrun))
5391 error ("Process %s not running", SDATA (p->name));
60f0fb11 5392 if (p->outfd < 0)
6b61353c 5393 error ("Output file descriptor of %s is closed", SDATA (p->name));
0fa1789e 5394
60f0fb11 5395 coding = proc_encode_coding_system[p->outfd];
5bbf78c1 5396 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
486b111b 5397
ed7a4b2d
KH
5398 if ((STRINGP (object) && STRING_MULTIBYTE (object))
5399 || (BUFFERP (object)
4b4deea2 5400 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
a92e4183 5401 || EQ (object, Qt))
278bfdd6 5402 {
fcaf8878
KH
5403 p->encode_coding_system
5404 = complement_process_encoding_system (p->encode_coding_system);
6b61353c 5405 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
fcaf8878
KH
5406 {
5407 /* The coding system for encoding was changed to raw-text
5408 because we sent a unibyte text previously. Now we are
5409 sending a multibyte text, thus we must encode it by the
5410 original coding system specified for the current process.
5411
da6062e6
PE
5412 Another reason we come here is that the coding system
5413 was just complemented and a new one was returned by
fcaf8878
KH
5414 complement_process_encoding_system. */
5415 setup_coding_system (p->encode_coding_system, coding);
5416 Vlast_coding_system_used = p->encode_coding_system;
5417 }
e08bbb84 5418 coding->src_multibyte = 1;
278bfdd6
KH
5419 }
5420 else
5421 {
a0241d01 5422 coding->src_multibyte = 0;
a92e4183
KH
5423 /* For sending a unibyte text, character code conversion should
5424 not take place but EOL conversion should. So, setup raw-text
5425 or one of the subsidiary if we have not yet done it. */
5bbf78c1 5426 if (CODING_REQUIRE_ENCODING (coding))
a92e4183
KH
5427 {
5428 if (CODING_REQUIRE_FLUSHING (coding))
5429 {
5430 /* But, before changing the coding, we must flush out data. */
5431 coding->mode |= CODING_MODE_LAST_BLOCK;
5432 send_process (proc, "", 0, Qt);
8f924df7 5433 coding->mode &= CODING_MODE_LAST_BLOCK;
a92e4183 5434 }
5bbf78c1
KH
5435 setup_coding_system (raw_text_coding_system
5436 (Vlast_coding_system_used),
5437 coding);
e08bbb84 5438 coding->src_multibyte = 0;
a92e4183 5439 }
278bfdd6 5440 }
a4a37e65
KH
5441 coding->dst_multibyte = 0;
5442
ed7a4b2d 5443 if (CODING_REQUIRE_ENCODING (coding))
0fa1789e 5444 {
5bbf78c1 5445 coding->dst_object = Qt;
ed7a4b2d 5446 if (BUFFERP (object))
0fa1789e 5447 {
f877c546
EZ
5448 EMACS_INT from_byte, from, to;
5449 EMACS_INT save_pt, save_pt_byte;
5bbf78c1
KH
5450 struct buffer *cur = current_buffer;
5451
5452 set_buffer_internal (XBUFFER (object));
5453 save_pt = PT, save_pt_byte = PT_BYTE;
5454
400a67ff 5455 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
5bbf78c1
KH
5456 from = BYTE_TO_CHAR (from_byte);
5457 to = BYTE_TO_CHAR (from_byte + len);
5458 TEMP_SET_PT_BOTH (from, from_byte);
5459 encode_coding_object (coding, object, from, from_byte,
5460 to, from_byte + len, Qt);
5461 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
5462 set_buffer_internal (cur);
ed7a4b2d
KH
5463 }
5464 else if (STRINGP (object))
5465 {
550c8289
KH
5466 encode_coding_object (coding, object, 0, 0, SCHARS (object),
5467 SBYTES (object), Qt);
0fa1789e 5468 }
5bbf78c1 5469 else
452294c2 5470 {
5bbf78c1
KH
5471 coding->dst_object = make_unibyte_string (buf, len);
5472 coding->produced = len;
452294c2 5473 }
ed7a4b2d 5474
e7fbaa65 5475 len = coding->produced;
347f3cd3 5476 object = coding->dst_object;
400a67ff 5477 buf = SSDATA (object);
0fa1789e 5478 }
d0d6b7c5 5479
4556b700
RS
5480 if (pty_max_bytes == 0)
5481 {
5482#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
60f0fb11 5483 pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
4556b700
RS
5484 if (pty_max_bytes < 0)
5485 pty_max_bytes = 250;
5486#else
5487 pty_max_bytes = 250;
5488#endif
5489 /* Deduct one, to leave space for the eof. */
5490 pty_max_bytes--;
5491 }
5492
0daad115
GM
5493 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5494 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5495 when returning with longjmp despite being declared volatile. */
d0d6b7c5 5496 if (!setjmp (send_process_frame))
0daad115 5497 {
006c5daa
PE
5498 p = XPROCESS (proc); /* Repair any setjmp clobbering. */
5499
0daad115
GM
5500 process_sent_to = proc;
5501 while (len > 0)
5502 {
f877c546 5503 EMACS_INT this = len;
93b4f699 5504
0daad115
GM
5505 /* Send this batch, using one or more write calls. */
5506 while (this > 0)
5507 {
85de1881 5508 EMACS_INT written = 0;
60f0fb11 5509 int outfd = p->outfd;
9af30bdf 5510 old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
e690ca94
KS
5511#ifdef DATAGRAM_SOCKETS
5512 if (DATAGRAM_CHAN_P (outfd))
5513 {
400a67ff 5514 rv = sendto (outfd, buf, this,
e690ca94
KS
5515 0, datagram_address[outfd].sa,
5516 datagram_address[outfd].len);
273a5f82
PE
5517 if (0 <= rv)
5518 written = rv;
5519 else if (errno == EMSGSIZE)
c8f44005
RS
5520 {
5521 signal (SIGPIPE, old_sigpipe);
5522 report_file_error ("sending datagram",
5523 Fcons (proc, Qnil));
5524 }
e690ca94
KS
5525 }
5526 else
5527#endif
6b61353c 5528 {
8af55556 5529#ifdef HAVE_GNUTLS
df7fcaff 5530 if (XPROCESS (proc)->gnutls_p)
e968f4f3
JB
5531 written = emacs_gnutls_write (XPROCESS (proc),
5532 buf, this);
8af55556
TZ
5533 else
5534#endif
273a5f82 5535 written = emacs_write (outfd, buf, this);
086e8c47 5536 rv = (written ? 0 : -1);
6b61353c 5537#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11
SM
5538 if (p->read_output_delay > 0
5539 && p->adaptive_read_buffering == 1)
6b61353c 5540 {
60f0fb11 5541 p->read_output_delay = 0;
6b61353c 5542 process_output_delay_count--;
60f0fb11 5543 p->read_output_skip = 0;
6b61353c
KH
5544 }
5545#endif
5546 }
0daad115 5547 signal (SIGPIPE, old_sigpipe);
4556b700 5548
0daad115
GM
5549 if (rv < 0)
5550 {
5551 if (0
d0d6b7c5 5552#ifdef EWOULDBLOCK
0daad115 5553 || errno == EWOULDBLOCK
d0d6b7c5
JB
5554#endif
5555#ifdef EAGAIN
0daad115 5556 || errno == EAGAIN
d0d6b7c5 5557#endif
0daad115 5558 )
177c0ea7 5559 /* Buffer is full. Wait, accepting input;
0daad115
GM
5560 that may allow the program
5561 to finish doing output and read more. */
5562 {
3d6c2543 5563 EMACS_INT offset = 0;
4556b700 5564
3433b6bd 5565#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
0daad115
GM
5566 /* A gross hack to work around a bug in FreeBSD.
5567 In the following sequence, read(2) returns
5568 bogus data:
5569
5570 write(2) 1022 bytes
5571 write(2) 954 bytes, get EAGAIN
5572 read(2) 1024 bytes in process_read_output
5573 read(2) 11 bytes in process_read_output
5574
5575 That is, read(2) returns more bytes than have
5576 ever been written successfully. The 1033 bytes
5577 read are the 1022 bytes written successfully
5578 after processing (for example with CRs added if
5579 the terminal is set up that way which it is
5580 here). The same bytes will be seen again in a
5581 later read(2), without the CRs. */
177c0ea7 5582
0daad115
GM
5583 if (errno == EAGAIN)
5584 {
5585 int flags = FWRITE;
60f0fb11 5586 ioctl (p->outfd, TIOCFLUSH, &flags);
0daad115 5587 }
3433b6bd 5588#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
177c0ea7 5589
0daad115
GM
5590 /* Running filters might relocate buffers or strings.
5591 Arrange to relocate BUF. */
347f3cd3 5592 if (BUFFERP (object))
400a67ff
PE
5593 offset = BUF_PTR_BYTE_POS (XBUFFER (object),
5594 (unsigned char *) buf);
0daad115 5595 else if (STRINGP (object))
400a67ff 5596 offset = buf - SSDATA (object);
0daad115 5597
f3e6605c 5598#ifdef EMACS_HAS_USECS
214d6069 5599 wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
f3e6605c 5600#else
214d6069 5601 wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
f3e6605c 5602#endif
4556b700 5603
347f3cd3 5604 if (BUFFERP (object))
400a67ff
PE
5605 buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
5606 offset);
0daad115 5607 else if (STRINGP (object))
400a67ff 5608 buf = offset + SSDATA (object);
0daad115
GM
5609 }
5610 else
5611 /* This is a real error. */
5612 report_file_error ("writing to process", Fcons (proc, Qnil));
5613 }
273a5f82
PE
5614 buf += written;
5615 len -= written;
5616 this -= written;
0daad115 5617 }
0daad115
GM
5618 }
5619 }
d0d6b7c5
JB
5620 else
5621 {
0ff69270 5622 signal (SIGPIPE, old_sigpipe);
0daad115 5623 proc = process_sent_to;
6b61353c 5624 p = XPROCESS (proc);
6bfd98e7 5625 p->raw_status_new = 0;
6b61353c 5626 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
60f0fb11 5627 p->tick = ++process_tick;
d0d6b7c5 5628 deactivate_process (proc);
6b61353c 5629 error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
d0d6b7c5 5630 }
6044e593
RS
5631
5632 UNGCPRO;
d0d6b7c5
JB
5633}
5634
5635DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
fdb82f93
PJ
5636 3, 3, 0,
5637 doc: /* Send current contents of region as input to PROCESS.
5638PROCESS may be a process, a buffer, the name of a process or buffer, or
5639nil, indicating the current buffer's process.
5640Called from program, takes three arguments, PROCESS, START and END.
5641If the region is more than 500 characters long,
5642it is sent in several bunches. This may happen even for shorter regions.
5643Output from processes can arrive in between bunches. */)
5842a27b 5644 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
d0d6b7c5
JB
5645{
5646 Lisp_Object proc;
f877c546 5647 EMACS_INT start1, end1;
d0d6b7c5
JB
5648
5649 proc = get_process (process);
5650 validate_region (&start, &end);
1b234f64
KH
5651
5652 if (XINT (start) < GPT && XINT (end) > GPT)
5653 move_gap (XINT (start));
5654
5655 start1 = CHAR_TO_BYTE (XINT (start));
5656 end1 = CHAR_TO_BYTE (XINT (end));
400a67ff 5657 send_process (proc, (char *) BYTE_POS_ADDR (start1), end1 - start1,
1b234f64
KH
5658 Fcurrent_buffer ());
5659
d0d6b7c5
JB
5660 return Qnil;
5661}
5662
5663DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
fdb82f93
PJ
5664 2, 2, 0,
5665 doc: /* Send PROCESS the contents of STRING as input.
5666PROCESS may be a process, a buffer, the name of a process or buffer, or
5667nil, indicating the current buffer's process.
5668If STRING is more than 500 characters long,
5669it is sent in several bunches. This may happen even for shorter strings.
5670Output from processes can arrive in between bunches. */)
5842a27b 5671 (Lisp_Object process, Lisp_Object string)
d0d6b7c5
JB
5672{
5673 Lisp_Object proc;
b7826503 5674 CHECK_STRING (string);
d0d6b7c5 5675 proc = get_process (process);
400a67ff 5676 send_process (proc, SSDATA (string),
1b234f64 5677 SBYTES (string), string);
d0d6b7c5
JB
5678 return Qnil;
5679}
5680\f
16782258
JD
5681/* Return the foreground process group for the tty/pty that
5682 the process P uses. */
5683static int
d3da34e0 5684emacs_get_tty_pgrp (struct Lisp_Process *p)
16782258
JD
5685{
5686 int gid = -1;
5687
f3d9532b 5688#ifdef TIOCGPGRP
60f0fb11 5689 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
16782258
JD
5690 {
5691 int fd;
5692 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5693 master side. Try the slave side. */
42a5b22f 5694 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
16782258
JD
5695
5696 if (fd != -1)
5697 {
5698 ioctl (fd, TIOCGPGRP, &gid);
5699 emacs_close (fd);
5700 }
5701 }
5702#endif /* defined (TIOCGPGRP ) */
5703
5704 return gid;
5705}
5706
b81ea5ef
RS
5707DEFUN ("process-running-child-p", Fprocess_running_child_p,
5708 Sprocess_running_child_p, 0, 1, 0,
fdb82f93
PJ
5709 doc: /* Return t if PROCESS has given the terminal to a child.
5710If the operating system does not make it possible to find out,
5711return t unconditionally. */)
5842a27b 5712 (Lisp_Object process)
b81ea5ef
RS
5713{
5714 /* Initialize in case ioctl doesn't exist or gives an error,
5715 in a way that will cause returning t. */
16782258 5716 int gid;
b81ea5ef
RS
5717 Lisp_Object proc;
5718 struct Lisp_Process *p;
5719
5720 proc = get_process (process);
5721 p = XPROCESS (proc);
5722
d888760c 5723 if (!EQ (p->type, Qreal))
b81ea5ef 5724 error ("Process %s is not a subprocess",
d5db4077 5725 SDATA (p->name));
60f0fb11 5726 if (p->infd < 0)
b81ea5ef 5727 error ("Process %s is not active",
d5db4077 5728 SDATA (p->name));
b81ea5ef 5729
16782258 5730 gid = emacs_get_tty_pgrp (p);
b81ea5ef 5731
6bfd98e7 5732 if (gid == p->pid)
b81ea5ef
RS
5733 return Qnil;
5734 return Qt;
5735}
5736\f
d0d6b7c5 5737/* send a signal number SIGNO to PROCESS.
b81ea5ef
RS
5738 If CURRENT_GROUP is t, that means send to the process group
5739 that currently owns the terminal being used to communicate with PROCESS.
d0d6b7c5 5740 This is used for various commands in shell mode.
b81ea5ef
RS
5741 If CURRENT_GROUP is lambda, that means send to the process group
5742 that currently owns the terminal, but only if it is NOT the shell itself.
5743
d0d6b7c5 5744 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
5745 right away.
5746
5747 If we can, we try to signal PROCESS by sending control characters
e333e864 5748 down the pty. This allows us to signal inferiors who have changed
b0310da4 5749 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 5750
f9738840 5751static void
d3da34e0
JB
5752process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
5753 int nomsg)
d0d6b7c5
JB
5754{
5755 Lisp_Object proc;
5756 register struct Lisp_Process *p;
5757 int gid;
5758 int no_pgrp = 0;
5759
5760 proc = get_process (process);
5761 p = XPROCESS (proc);
5762
d888760c 5763 if (!EQ (p->type, Qreal))
d0d6b7c5 5764 error ("Process %s is not a subprocess",
d5db4077 5765 SDATA (p->name));
60f0fb11 5766 if (p->infd < 0)
d0d6b7c5 5767 error ("Process %s is not active",
d5db4077 5768 SDATA (p->name));
d0d6b7c5 5769
60f0fb11 5770 if (!p->pty_flag)
d0d6b7c5
JB
5771 current_group = Qnil;
5772
d0d6b7c5 5773 /* If we are using pgrps, get a pgrp number and make it negative. */
2af70a0c
RS
5774 if (NILP (current_group))
5775 /* Send the signal to the shell's process group. */
6bfd98e7 5776 gid = p->pid;
2af70a0c 5777 else
d0d6b7c5 5778 {
b0310da4 5779#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
5780 /* If possible, send signals to the entire pgrp
5781 by sending an input character to it. */
b0310da4 5782
6be429b1 5783 struct termios t;
7f916a36
RS
5784 cc_t *sig_char = NULL;
5785
60f0fb11 5786 tcgetattr (p->infd, &t);
6be429b1
JB
5787
5788 switch (signo)
5789 {
5790 case SIGINT:
7f916a36
RS
5791 sig_char = &t.c_cc[VINTR];
5792 break;
6be429b1
JB
5793
5794 case SIGQUIT:
7f916a36
RS
5795 sig_char = &t.c_cc[VQUIT];
5796 break;
6be429b1
JB
5797
5798 case SIGTSTP:
d0adf46f 5799#if defined (VSWTCH) && !defined (PREFER_VSUSP)
7f916a36 5800 sig_char = &t.c_cc[VSWTCH];
6be429b1 5801#else
7f916a36 5802 sig_char = &t.c_cc[VSUSP];
6be429b1 5803#endif
7f916a36 5804 break;
6be429b1
JB
5805 }
5806
ca4313d5 5807 if (sig_char && *sig_char != CDISABLE)
f1c206fc 5808 {
f990b4e5 5809 send_process (proc, (char *) sig_char, 1, Qnil);
f1c206fc
RS
5810 return;
5811 }
5812 /* If we can't send the signal with a character,
5813 fall through and send it another way. */
f1c206fc
RS
5814
5815 /* The code above may fall through if it can't
5816 handle the signal. */
20505336 5817#endif /* defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 5818
177c0ea7 5819#ifdef TIOCGPGRP
2af70a0c 5820 /* Get the current pgrp using the tty itself, if we have that.
d0d6b7c5
JB
5821 Otherwise, use the pty to get the pgrp.
5822 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
5823 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5824 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
5825 His patch indicates that if TIOCGPGRP returns an error, then
5826 we should just assume that p->pid is also the process group id. */
d0d6b7c5 5827
16782258 5828 gid = emacs_get_tty_pgrp (p);
f3d9532b 5829
16782258
JD
5830 if (gid == -1)
5831 /* If we can't get the information, assume
5832 the shell owns the tty. */
6bfd98e7 5833 gid = p->pid;
2af70a0c
RS
5834
5835 /* It is not clear whether anything really can set GID to -1.
5836 Perhaps on some system one of those ioctls can or could do so.
5837 Or perhaps this is vestigial. */
d0d6b7c5
JB
5838 if (gid == -1)
5839 no_pgrp = 1;
b0310da4 5840#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
5841 /* Can't select pgrps on this system, so we know that
5842 the child itself heads the pgrp. */
6bfd98e7 5843 gid = p->pid;
301c3fe4 5844#endif /* ! defined (TIOCGPGRP ) */
b81ea5ef
RS
5845
5846 /* If current_group is lambda, and the shell owns the terminal,
5847 don't send any signal. */
6bfd98e7 5848 if (EQ (current_group, Qlambda) && gid == p->pid)
b81ea5ef 5849 return;
d0d6b7c5 5850 }
d0d6b7c5
JB
5851
5852 switch (signo)
5853 {
5854#ifdef SIGCONT
5855 case SIGCONT:
6bfd98e7 5856 p->raw_status_new = 0;
d0d6b7c5 5857 p->status = Qrun;
60f0fb11 5858 p->tick = ++process_tick;
d0d6b7c5 5859 if (!nomsg)
e42bdf01
CY
5860 {
5861 status_notify (NULL);
5862 redisplay_preserve_echo_area (13);
5863 }
d0d6b7c5 5864 break;
301c3fe4 5865#endif /* ! defined (SIGCONT) */
d0d6b7c5 5866 case SIGINT:
d0d6b7c5 5867 case SIGQUIT:
d0d6b7c5 5868 case SIGKILL:
60f0fb11 5869 flush_pending_output (p->infd);
d0d6b7c5
JB
5870 break;
5871 }
5872
5873 /* If we don't have process groups, send the signal to the immediate
5874 subprocess. That isn't really right, but it's better than any
5875 obvious alternative. */
5876 if (no_pgrp)
5877 {
6bfd98e7 5878 kill (p->pid, signo);
d0d6b7c5
JB
5879 return;
5880 }
5881
5882 /* gid may be a pid, or minus a pgrp's number */
5883#ifdef TIOCSIGSEND
5884 if (!NILP (current_group))
16782258 5885 {
60f0fb11 5886 if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
16782258
JD
5887 EMACS_KILLPG (gid, signo);
5888 }
d0d6b7c5
JB
5889 else
5890 {
6bfd98e7 5891 gid = - p->pid;
d0d6b7c5
JB
5892 kill (gid, signo);
5893 }
301c3fe4 5894#else /* ! defined (TIOCSIGSEND) */
2af70a0c 5895 EMACS_KILLPG (gid, signo);
301c3fe4 5896#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
5897}
5898
5899DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
fdb82f93
PJ
5900 doc: /* Interrupt process PROCESS.
5901PROCESS may be a process, a buffer, or the name of a process or buffer.
f3d9532b 5902No arg or nil means current buffer's process.
fdb82f93
PJ
5903Second arg CURRENT-GROUP non-nil means send signal to
5904the current process-group of the process's controlling terminal
5905rather than to the process's own process group.
5906If the process is a shell, this means interrupt current subjob
5907rather than the shell.
5908
5909If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5910don't send the signal. */)
5842a27b 5911 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5912{
5913 process_send_signal (process, SIGINT, current_group, 0);
5914 return process;
5915}
5916
5917DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
fdb82f93
PJ
5918 doc: /* Kill process PROCESS. May be process or name of one.
5919See function `interrupt-process' for more details on usage. */)
5842a27b 5920 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5921{
5922 process_send_signal (process, SIGKILL, current_group, 0);
5923 return process;
5924}
5925
5926DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
fdb82f93
PJ
5927 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
5928See function `interrupt-process' for more details on usage. */)
5842a27b 5929 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5930{
5931 process_send_signal (process, SIGQUIT, current_group, 0);
5932 return process;
5933}
5934
5935DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
fdb82f93 5936 doc: /* Stop process PROCESS. May be process or name of one.
177c0ea7 5937See function `interrupt-process' for more details on usage.
d888760c
GM
5938If PROCESS is a network or serial process, inhibit handling of incoming
5939traffic. */)
5842a27b 5940 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5 5941{
d888760c 5942 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
e690ca94
KS
5943 {
5944 struct Lisp_Process *p;
177c0ea7 5945
e690ca94
KS
5946 p = XPROCESS (process);
5947 if (NILP (p->command)
60f0fb11 5948 && p->infd >= 0)
e690ca94 5949 {
60f0fb11
SM
5950 FD_CLR (p->infd, &input_wait_mask);
5951 FD_CLR (p->infd, &non_keyboard_wait_mask);
e690ca94
KS
5952 }
5953 p->command = Qt;
5954 return process;
5955 }
d0d6b7c5 5956#ifndef SIGTSTP
a9a73d6c 5957 error ("No SIGTSTP support");
d0d6b7c5
JB
5958#else
5959 process_send_signal (process, SIGTSTP, current_group, 0);
5960#endif
5961 return process;
5962}
5963
5964DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
fdb82f93 5965 doc: /* Continue process PROCESS. May be process or name of one.
177c0ea7 5966See function `interrupt-process' for more details on usage.
d888760c
GM
5967If PROCESS is a network or serial process, resume handling of incoming
5968traffic. */)
5842a27b 5969 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5 5970{
d888760c 5971 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
e690ca94
KS
5972 {
5973 struct Lisp_Process *p;
5974
5975 p = XPROCESS (process);
5976 if (EQ (p->command, Qt)
60f0fb11 5977 && p->infd >= 0
e690ca94
KS
5978 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5979 {
60f0fb11
SM
5980 FD_SET (p->infd, &input_wait_mask);
5981 FD_SET (p->infd, &non_keyboard_wait_mask);
d888760c
GM
5982#ifdef WINDOWSNT
5983 if (fd_info[ p->infd ].flags & FILE_SERIAL)
5984 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
a7ebc409 5985#else /* not WINDOWSNT */
d888760c 5986 tcflush (p->infd, TCIFLUSH);
a7ebc409 5987#endif /* not WINDOWSNT */
e690ca94
KS
5988 }
5989 p->command = Qnil;
5990 return process;
5991 }
d0d6b7c5
JB
5992#ifdef SIGCONT
5993 process_send_signal (process, SIGCONT, current_group, 0);
5994#else
a9a73d6c 5995 error ("No SIGCONT support");
d0d6b7c5
JB
5996#endif
5997 return process;
5998}
5999
6000DEFUN ("signal-process", Fsignal_process, Ssignal_process,
cdd5ea86
KS
6001 2, 2, "sProcess (name or number): \nnSignal code: ",
6002 doc: /* Send PROCESS the signal with code SIGCODE.
648f6edf 6003PROCESS may also be a number specifying the process id of the
cdd5ea86
KS
6004process to signal; in this case, the process need not be a child of
6005this Emacs.
fdb82f93 6006SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5842a27b 6007 (Lisp_Object process, Lisp_Object sigcode)
d0d6b7c5 6008{
6bfd98e7 6009 pid_t pid;
cdd5ea86
KS
6010
6011 if (INTEGERP (process))
6012 {
6bfd98e7
SM
6013 pid = XINT (process);
6014 goto got_it;
6015 }
6016
6017 if (FLOATP (process))
6018 {
648f6edf 6019 pid = (pid_t) XFLOAT_DATA (process);
cdd5ea86
KS
6020 goto got_it;
6021 }
6022
6023 if (STRINGP (process))
6024 {
6025 Lisp_Object tem;
6026 if (tem = Fget_process (process), NILP (tem))
6027 {
6bfd98e7
SM
6028 pid = XINT (Fstring_to_number (process, make_number (10)));
6029 if (pid > 0)
cdd5ea86
KS
6030 goto got_it;
6031 }
6032 process = tem;
6033 }
6034 else
6035 process = get_process (process);
177c0ea7 6036
cdd5ea86
KS
6037 if (NILP (process))
6038 return process;
6039
6040 CHECK_PROCESS (process);
6041 pid = XPROCESS (process)->pid;
6bfd98e7 6042 if (pid <= 0)
cdd5ea86
KS
6043 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6044
6045 got_it:
4766242d 6046
59324b1d 6047#define parse_signal(NAME, VALUE) \
05131107 6048 else if (!xstrcasecmp (name, NAME)) \
4766242d
RS
6049 XSETINT (sigcode, VALUE)
6050
6051 if (INTEGERP (sigcode))
6052 ;
6053 else
6054 {
25a48bd0 6055 char *name;
4766242d 6056
b7826503 6057 CHECK_SYMBOL (sigcode);
25a48bd0 6058 name = SSDATA (SYMBOL_NAME (sigcode));
4766242d 6059
ed3751c8 6060 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
675984ed
KS
6061 name += 3;
6062
4766242d
RS
6063 if (0)
6064 ;
59324b1d
KS
6065#ifdef SIGUSR1
6066 parse_signal ("usr1", SIGUSR1);
6067#endif
6068#ifdef SIGUSR2
6069 parse_signal ("usr2", SIGUSR2);
6070#endif
6071#ifdef SIGTERM
6072 parse_signal ("term", SIGTERM);
6073#endif
4766242d 6074#ifdef SIGHUP
59324b1d 6075 parse_signal ("hup", SIGHUP);
4766242d
RS
6076#endif
6077#ifdef SIGINT
59324b1d 6078 parse_signal ("int", SIGINT);
4766242d
RS
6079#endif
6080#ifdef SIGQUIT
59324b1d 6081 parse_signal ("quit", SIGQUIT);
4766242d
RS
6082#endif
6083#ifdef SIGILL
59324b1d 6084 parse_signal ("ill", SIGILL);
4766242d
RS
6085#endif
6086#ifdef SIGABRT
59324b1d 6087 parse_signal ("abrt", SIGABRT);
4766242d
RS
6088#endif
6089#ifdef SIGEMT
59324b1d 6090 parse_signal ("emt", SIGEMT);
4766242d
RS
6091#endif
6092#ifdef SIGKILL
59324b1d 6093 parse_signal ("kill", SIGKILL);
4766242d
RS
6094#endif
6095#ifdef SIGFPE
59324b1d 6096 parse_signal ("fpe", SIGFPE);
4766242d
RS
6097#endif
6098#ifdef SIGBUS
59324b1d 6099 parse_signal ("bus", SIGBUS);
4766242d
RS
6100#endif
6101#ifdef SIGSEGV
59324b1d 6102 parse_signal ("segv", SIGSEGV);
4766242d
RS
6103#endif
6104#ifdef SIGSYS
59324b1d 6105 parse_signal ("sys", SIGSYS);
4766242d
RS
6106#endif
6107#ifdef SIGPIPE
59324b1d 6108 parse_signal ("pipe", SIGPIPE);
4766242d
RS
6109#endif
6110#ifdef SIGALRM
59324b1d 6111 parse_signal ("alrm", SIGALRM);
4766242d
RS
6112#endif
6113#ifdef SIGURG
59324b1d 6114 parse_signal ("urg", SIGURG);
4766242d
RS
6115#endif
6116#ifdef SIGSTOP
59324b1d 6117 parse_signal ("stop", SIGSTOP);
4766242d
RS
6118#endif
6119#ifdef SIGTSTP
59324b1d 6120 parse_signal ("tstp", SIGTSTP);
4766242d
RS
6121#endif
6122#ifdef SIGCONT
59324b1d 6123 parse_signal ("cont", SIGCONT);
4766242d
RS
6124#endif
6125#ifdef SIGCHLD
59324b1d 6126 parse_signal ("chld", SIGCHLD);
4766242d
RS
6127#endif
6128#ifdef SIGTTIN
59324b1d 6129 parse_signal ("ttin", SIGTTIN);
4766242d
RS
6130#endif
6131#ifdef SIGTTOU
59324b1d 6132 parse_signal ("ttou", SIGTTOU);
4766242d
RS
6133#endif
6134#ifdef SIGIO
59324b1d 6135 parse_signal ("io", SIGIO);
4766242d
RS
6136#endif
6137#ifdef SIGXCPU
59324b1d 6138 parse_signal ("xcpu", SIGXCPU);
4766242d
RS
6139#endif
6140#ifdef SIGXFSZ
59324b1d 6141 parse_signal ("xfsz", SIGXFSZ);
4766242d
RS
6142#endif
6143#ifdef SIGVTALRM
59324b1d 6144 parse_signal ("vtalrm", SIGVTALRM);
4766242d
RS
6145#endif
6146#ifdef SIGPROF
59324b1d 6147 parse_signal ("prof", SIGPROF);
4766242d
RS
6148#endif
6149#ifdef SIGWINCH
59324b1d 6150 parse_signal ("winch", SIGWINCH);
4766242d
RS
6151#endif
6152#ifdef SIGINFO
59324b1d 6153 parse_signal ("info", SIGINFO);
4766242d
RS
6154#endif
6155 else
9fa195a2 6156 error ("Undefined signal name %s", name);
4766242d
RS
6157 }
6158
59324b1d 6159#undef parse_signal
4766242d 6160
6bfd98e7 6161 return make_number (kill (pid, XINT (sigcode)));
d0d6b7c5
JB
6162}
6163
6164DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
fdb82f93
PJ
6165 doc: /* Make PROCESS see end-of-file in its input.
6166EOF comes after any text already sent to it.
6167PROCESS may be a process, a buffer, the name of a process or buffer, or
6168nil, indicating the current buffer's process.
6169If PROCESS is a network connection, or is a process communicating
6170through a pipe (as opposed to a pty), then you cannot send any more
d888760c
GM
6171text to PROCESS after you call this function.
6172If PROCESS is a serial process, wait until all output written to the
6173process has been transmitted to the serial port. */)
5842a27b 6174 (Lisp_Object process)
d0d6b7c5
JB
6175{
6176 Lisp_Object proc;
de7fbd09 6177 struct coding_system *coding;
d0d6b7c5 6178
e690ca94
KS
6179 if (DATAGRAM_CONN_P (process))
6180 return process;
6181
d0d6b7c5 6182 proc = get_process (process);
60f0fb11 6183 coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
577d03d5
RS
6184
6185 /* Make sure the process is really alive. */
6bfd98e7 6186 if (XPROCESS (proc)->raw_status_new)
577d03d5
RS
6187 update_status (XPROCESS (proc));
6188 if (! EQ (XPROCESS (proc)->status, Qrun))
d5db4077 6189 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
577d03d5 6190
de7fbd09
KH
6191 if (CODING_REQUIRE_FLUSHING (coding))
6192 {
6193 coding->mode |= CODING_MODE_LAST_BLOCK;
6194 send_process (proc, "", 0, Qnil);
6195 }
6196
60f0fb11 6197 if (XPROCESS (proc)->pty_flag)
4556b700 6198 send_process (proc, "\004", 1, Qnil);
a879ee6f 6199 else if (EQ (XPROCESS (proc)->type, Qserial))
d888760c 6200 {
a7ebc409 6201#ifndef WINDOWSNT
d888760c
GM
6202 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6203 error ("tcdrain() failed: %s", emacs_strerror (errno));
a7ebc409 6204#endif /* not WINDOWSNT */
d888760c
GM
6205 /* Do nothing on Windows because writes are blocking. */
6206 }
d0d6b7c5
JB
6207 else
6208 {
4525f571
RS
6209 int old_outfd, new_outfd;
6210
93853f3d 6211#ifdef HAVE_SHUTDOWN
02f55c4b
RS
6212 /* If this is a network connection, or socketpair is used
6213 for communication with the subprocess, call shutdown to cause EOF.
6214 (In some old system, shutdown to socketpair doesn't work.
6215 Then we just can't win.) */
a879ee6f 6216 if (EQ (XPROCESS (proc)->type, Qnetwork)
60f0fb11
SM
6217 || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
6218 shutdown (XPROCESS (proc)->outfd, 1);
02f55c4b 6219 /* In case of socketpair, outfd == infd, so don't close it. */
60f0fb11
SM
6220 if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
6221 emacs_close (XPROCESS (proc)->outfd);
93853f3d 6222#else /* not HAVE_SHUTDOWN */
60f0fb11 6223 emacs_close (XPROCESS (proc)->outfd);
93853f3d 6224#endif /* not HAVE_SHUTDOWN */
68c45bf0 6225 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
27448380
RS
6226 if (new_outfd < 0)
6227 abort ();
60f0fb11 6228 old_outfd = XPROCESS (proc)->outfd;
4525f571
RS
6229
6230 if (!proc_encode_coding_system[new_outfd])
6231 proc_encode_coding_system[new_outfd]
6232 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
72af86bd
AS
6233 memcpy (proc_encode_coding_system[new_outfd],
6234 proc_encode_coding_system[old_outfd],
6235 sizeof (struct coding_system));
6236 memset (proc_encode_coding_system[old_outfd], 0,
6237 sizeof (struct coding_system));
4525f571 6238
60f0fb11 6239 XPROCESS (proc)->outfd = new_outfd;
d0d6b7c5 6240 }
d0d6b7c5
JB
6241 return process;
6242}
d0d6b7c5 6243\f
3fed8ad5
GM
6244/* On receipt of a signal that a child status has changed, loop asking
6245 about children with changed statuses until the system says there
6246 are no more.
177c0ea7 6247
3fed8ad5
GM
6248 All we do is change the status; we do not run sentinels or print
6249 notifications. That is saved for the next time keyboard input is
6250 done, in order to avoid timing errors.
6251
6252 ** WARNING: this can be called during garbage collection.
6253 Therefore, it must not be fooled by the presence of mark bits in
6254 Lisp objects.
6255
6256 ** USG WARNING: Although it is not obvious from the documentation
6257 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6258 signal() before executing at least one wait(), otherwise the
6259 handler will be called again, resulting in an infinite loop. The
6260 relevant portion of the documentation reads "SIGCLD signals will be
6261 queued and the signal-catching function will be continually
6262 reentered until the queue is empty". Invoking signal() causes the
6263 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6b61353c
KH
6264 Inc.
6265
6266 ** Malloc WARNING: This should never call malloc either directly or
6267 indirectly; if it does, that is a bug */
d0d6b7c5 6268
a5cfdda8 6269#ifdef SIGCHLD
9af30bdf 6270static void
d3da34e0 6271sigchld_handler (int signo)
d0d6b7c5
JB
6272{
6273 int old_errno = errno;
6274 Lisp_Object proc;
97ec208f 6275 struct Lisp_Process *p;
d0d6b7c5 6276
333f1b6f
JD
6277 SIGNAL_THREAD_CHECK (signo);
6278
d0d6b7c5
JB
6279 while (1)
6280 {
8e050977 6281 pid_t pid;
bba104c1 6282 int w;
d0d6b7c5
JB
6283 Lisp_Object tail;
6284
6285#ifdef WNOHANG
6286#ifndef WUNTRACED
6287#define WUNTRACED 0
6288#endif /* no WUNTRACED */
6289 /* Keep trying to get a status until we get a definitive result. */
e7d4a904 6290 do
63136da6 6291 {
29ed4d51
CY
6292 errno = 0;
6293 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
29ed4d51 6294 }
e7d4a904 6295 while (pid < 0 && errno == EINTR);
d0d6b7c5
JB
6296
6297 if (pid <= 0)
6298 {
3fed8ad5
GM
6299 /* PID == 0 means no processes found, PID == -1 means a real
6300 failure. We have done all our job, so return. */
d0d6b7c5 6301
d0d6b7c5
JB
6302 errno = old_errno;
6303 return;
6304 }
6305#else
6306 pid = wait (&w);
6307#endif /* no WNOHANG */
6308
6309 /* Find the process that signaled us, and record its status. */
6310
a5cfdda8 6311 /* The process can have been deleted by Fdelete_process. */
8e50cc2d 6312 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
a5cfdda8 6313 {
8e050977 6314 Lisp_Object xpid = XCAR (tail);
8e50cc2d
SM
6315 if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
6316 || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
8e050977
CY
6317 {
6318 XSETCAR (tail, Qnil);
6319 goto sigchld_end_of_loop;
6320 }
a5cfdda8
KS
6321 }
6322
6323 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
d0d6b7c5 6324 p = 0;
8e50cc2d 6325 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6326 {
70949dac 6327 proc = XCDR (XCAR (tail));
d0d6b7c5 6328 p = XPROCESS (proc);
d888760c 6329 if (EQ (p->type, Qreal) && p->pid == pid)
d0d6b7c5
JB
6330 break;
6331 p = 0;
6332 }
6333
6334 /* Look for an asynchronous process whose pid hasn't been filled
6335 in yet. */
6336 if (p == 0)
8e50cc2d 6337 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6338 {
70949dac 6339 proc = XCDR (XCAR (tail));
d0d6b7c5 6340 p = XPROCESS (proc);
6bfd98e7 6341 if (p->pid == -1)
d0d6b7c5
JB
6342 break;
6343 p = 0;
6344 }
177c0ea7 6345
d0d6b7c5
JB
6346 /* Change the status of the process that was found. */
6347 if (p != 0)
6348 {
e98d950b 6349 int clear_desc_flag = 0;
177c0ea7 6350
60f0fb11 6351 p->tick = ++process_tick;
bba104c1 6352 p->raw_status = w;
6bfd98e7 6353 p->raw_status_new = 1;
177c0ea7 6354
d0d6b7c5 6355 /* If process has terminated, stop waiting for its output. */
e98d950b 6356 if ((WIFSIGNALED (w) || WIFEXITED (w))
60f0fb11 6357 && p->infd >= 0)
e98d950b
RS
6358 clear_desc_flag = 1;
6359
6360 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6361 if (clear_desc_flag)
6362 {
60f0fb11
SM
6363 FD_CLR (p->infd, &input_wait_mask);
6364 FD_CLR (p->infd, &non_keyboard_wait_mask);
e98d950b 6365 }
6be429b1 6366
214d6069 6367 /* Tell wait_reading_process_output that it needs to wake up and
6be429b1
JB
6368 look around. */
6369 if (input_available_clear_time)
6370 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
6371 }
6372
a5cfdda8
KS
6373 /* There was no asynchronous process found for that pid: we have
6374 a synchronous process. */
d0d6b7c5
JB
6375 else
6376 {
6377 synch_process_alive = 0;
6378
6379 /* Report the status of the synchronous process. */
6380 if (WIFEXITED (w))
6381 synch_process_retcode = WRETCODE (w);
6382 else if (WIFSIGNALED (w))
63136da6 6383 synch_process_termsig = WTERMSIG (w);
6be429b1 6384
214d6069 6385 /* Tell wait_reading_process_output that it needs to wake up and
6be429b1
JB
6386 look around. */
6387 if (input_available_clear_time)
6388 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
6389 }
6390
a5cfdda8
KS
6391 sigchld_end_of_loop:
6392 ;
6393
d0d6b7c5
JB
6394 /* On some systems, we must return right away.
6395 If any more processes want to signal us, we will
6396 get another signal.
6397 Otherwise (on systems that have WNOHANG), loop around
6398 to use up all the processes that have something to tell us. */
4e6277d8 6399#if (defined WINDOWSNT \
8a2a6032 6400 || (defined USG && !defined GNU_LINUX \
63136da6 6401 && !(defined HPUX && defined WNOHANG)))
d0d6b7c5
JB
6402 errno = old_errno;
6403 return;
6404#endif /* USG, but not HPUX with WNOHANG */
6405 }
6406}
a5cfdda8 6407#endif /* SIGCHLD */
d0d6b7c5
JB
6408\f
6409
6410static Lisp_Object
d3da34e0 6411exec_sentinel_unwind (Lisp_Object data)
d0d6b7c5 6412{
70949dac 6413 XPROCESS (XCAR (data))->sentinel = XCDR (data);
d0d6b7c5
JB
6414 return Qnil;
6415}
6416
3b9a3dfa 6417static Lisp_Object
b93aacde 6418exec_sentinel_error_handler (Lisp_Object error_val)
3b9a3dfa 6419{
b93aacde 6420 cmd_error_internal (error_val, "error in process sentinel: ");
3b9a3dfa
RS
6421 Vinhibit_quit = Qt;
6422 update_echo_area ();
833ba342 6423 Fsleep_for (make_number (2), Qnil);
8c983bf2 6424 return Qt;
3b9a3dfa
RS
6425}
6426
d0d6b7c5 6427static void
d3da34e0 6428exec_sentinel (Lisp_Object proc, Lisp_Object reason)
d0d6b7c5 6429{
aba7731a 6430 Lisp_Object sentinel, odeactivate;
d0d6b7c5 6431 register struct Lisp_Process *p = XPROCESS (proc);
aed13378 6432 int count = SPECPDL_INDEX ();
4da2f5be 6433 int outer_running_asynch_code = running_asynch_code;
bbce7d72 6434 int waiting = waiting_for_user_input_p;
d0d6b7c5 6435
84af9896
RS
6436 if (inhibit_sentinels)
6437 return;
6438
dfc21838
RS
6439 /* No need to gcpro these, because all we do with them later
6440 is test them for EQness, and none of them should be a string. */
8fb3cf64 6441 odeactivate = Vdeactivate_mark;
aba7731a
PE
6442#if 0
6443 Lisp_Object obuffer, okeymap;
dfc21838 6444 XSETBUFFER (obuffer, current_buffer);
4b4deea2 6445 okeymap = BVAR (current_buffer, keymap);
aba7731a 6446#endif
dfc21838 6447
97e53006
SM
6448 /* There's no good reason to let sentinels change the current
6449 buffer, and many callers of accept-process-output, sit-for, and
6450 friends don't expect current-buffer to be changed from under them. */
d2630aef 6451 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
97e53006 6452
d0d6b7c5
JB
6453 sentinel = p->sentinel;
6454 if (NILP (sentinel))
6455 return;
6456
6457 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6458 assure that it gets restored no matter how the sentinel exits. */
6459 p->sentinel = Qnil;
6460 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
6461 /* Inhibit quit so that random quits don't screw up a running filter. */
6462 specbind (Qinhibit_quit, Qt);
f00c449b 6463 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
3b9a3dfa 6464
4da2f5be
RS
6465 /* In case we get recursively called,
6466 and we already saved the match data nonrecursively,
6467 save the same match data in safely recursive fashion. */
6468 if (outer_running_asynch_code)
6469 {
6470 Lisp_Object tem;
89f2614d
KS
6471 tem = Fmatch_data (Qnil, Qnil, Qnil);
6472 restore_search_regs ();
6473 record_unwind_save_match_data ();
6474 Fset_match_data (tem, Qt);
4da2f5be
RS
6475 }
6476
6477 /* For speed, if a search happens within this code,
6478 save the match data in a special nonrecursive fashion. */
7074fde6 6479 running_asynch_code = 1;
4da2f5be 6480
3b9a3dfa
RS
6481 internal_condition_case_1 (read_process_output_call,
6482 Fcons (sentinel,
6483 Fcons (proc, Fcons (reason, Qnil))),
6484 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6485 exec_sentinel_error_handler);
4da2f5be
RS
6486
6487 /* If we saved the match data nonrecursively, restore it now. */
89f2614d 6488 restore_search_regs ();
4da2f5be 6489 running_asynch_code = outer_running_asynch_code;
8fb3cf64
KH
6490
6491 Vdeactivate_mark = odeactivate;
bbce7d72
RS
6492
6493 /* Restore waiting_for_user_input_p as it was
6494 when we were called, in case the filter clobbered it. */
6495 waiting_for_user_input_p = waiting;
6496
7973cfa8 6497#if 0
dfc21838
RS
6498 if (! EQ (Fcurrent_buffer (), obuffer)
6499 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 6500#endif
927e08be
RS
6501 /* But do it only if the caller is actually going to read events.
6502 Otherwise there's no need to make him wake up, and it could
7157b8fe 6503 cause trouble (for example it would make sit_for return). */
927e08be
RS
6504 if (waiting_for_user_input_p == -1)
6505 record_asynch_buffer_change ();
8fb3cf64 6506
2ea6d561 6507 unbind_to (count, Qnil);
d0d6b7c5
JB
6508}
6509
6510/* Report all recent events of a change in process status
6511 (either run the sentinel or output a message).
b50fe468
RS
6512 This is usually done while Emacs is waiting for keyboard input
6513 but can be done at other times. */
d0d6b7c5 6514
ff6daed3 6515static void
d3da34e0 6516status_notify (struct Lisp_Process *deleting_process)
d0d6b7c5
JB
6517{
6518 register Lisp_Object proc, buffer;
2e4149a8 6519 Lisp_Object tail, msg;
d0d6b7c5
JB
6520 struct gcpro gcpro1, gcpro2;
6521
2e4149a8
KH
6522 tail = Qnil;
6523 msg = Qnil;
d0d6b7c5
JB
6524 /* We need to gcpro tail; if read_process_output calls a filter
6525 which deletes a process and removes the cons to which tail points
6526 from Vprocess_alist, and then causes a GC, tail is an unprotected
6527 reference. */
6528 GCPRO2 (tail, msg);
6529
30623085
RS
6530 /* Set this now, so that if new processes are created by sentinels
6531 that we run, we get called again to handle their status changes. */
6532 update_tick = process_tick;
6533
99784d63 6534 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6535 {
30623085
RS
6536 Lisp_Object symbol;
6537 register struct Lisp_Process *p;
6538
99784d63 6539 proc = Fcdr (XCAR (tail));
30623085
RS
6540 p = XPROCESS (proc);
6541
60f0fb11 6542 if (p->tick != p->update_tick)
d0d6b7c5 6543 {
60f0fb11 6544 p->update_tick = p->tick;
d0d6b7c5 6545
30623085 6546 /* If process is still active, read any output that remains. */
4da2f5be 6547 while (! EQ (p->filter, Qt)
dd2a17ab 6548 && ! EQ (p->status, Qconnect)
e690ca94 6549 && ! EQ (p->status, Qlisten)
d888760c
GM
6550 /* Network or serial process not stopped: */
6551 && ! EQ (p->command, Qt)
60f0fb11 6552 && p->infd >= 0
ff6daed3 6553 && p != deleting_process
60f0fb11 6554 && read_process_output (proc, p->infd) > 0);
d0d6b7c5 6555
30623085 6556 buffer = p->buffer;
d0d6b7c5 6557
30623085 6558 /* Get the text to use for the message. */
6bfd98e7 6559 if (p->raw_status_new)
30623085 6560 update_status (p);
116c423c 6561 msg = status_message (p);
d0d6b7c5 6562
30623085
RS
6563 /* If process is terminated, deactivate it or delete it. */
6564 symbol = p->status;
6565 if (CONSP (p->status))
70949dac 6566 symbol = XCAR (p->status);
d0d6b7c5 6567
30623085
RS
6568 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6569 || EQ (symbol, Qclosed))
6570 {
6571 if (delete_exited_processes)
6572 remove_process (proc);
6573 else
6574 deactivate_process (proc);
6575 }
d0d6b7c5 6576
0ad61fe7
RS
6577 /* The actions above may have further incremented p->tick.
6578 So set p->update_tick again
6579 so that an error in the sentinel will not cause
6580 this code to be run again. */
60f0fb11 6581 p->update_tick = p->tick;
30623085
RS
6582 /* Now output the message suitably. */
6583 if (!NILP (p->sentinel))
6584 exec_sentinel (proc, msg);
6585 /* Don't bother with a message in the buffer
6586 when a process becomes runnable. */
6587 else if (!EQ (symbol, Qrun) && !NILP (buffer))
6588 {
01f5787b 6589 Lisp_Object tem;
30623085 6590 struct buffer *old = current_buffer;
f877c546
EZ
6591 EMACS_INT opoint, opoint_byte;
6592 EMACS_INT before, before_byte;
2e4149a8 6593
30623085
RS
6594 /* Avoid error if buffer is deleted
6595 (probably that's why the process is dead, too) */
4b4deea2 6596 if (NILP (BVAR (XBUFFER (buffer), name)))
30623085
RS
6597 continue;
6598 Fset_buffer (buffer);
12ca5cdf 6599
6ec8bbd2 6600 opoint = PT;
d8a2934e 6601 opoint_byte = PT_BYTE;
30623085
RS
6602 /* Insert new output into buffer
6603 at the current end-of-output marker,
6604 thus preserving logical ordering of input and output. */
6605 if (XMARKER (p->mark)->buffer)
d8a2934e 6606 Fgoto_char (p->mark);
30623085 6607 else
d8a2934e 6608 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf
RS
6609
6610 before = PT;
d8a2934e 6611 before_byte = PT_BYTE;
30623085 6612
4b4deea2
TT
6613 tem = BVAR (current_buffer, read_only);
6614 BVAR (current_buffer, read_only) = Qnil;
30623085
RS
6615 insert_string ("\nProcess ");
6616 Finsert (1, &p->name);
6617 insert_string (" ");
6618 Finsert (1, &msg);
4b4deea2 6619 BVAR (current_buffer, read_only) = tem;
d8a2934e 6620 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
30623085 6621
12ca5cdf 6622 if (opoint >= before)
d8a2934e
RS
6623 SET_PT_BOTH (opoint + (PT - before),
6624 opoint_byte + (PT_BYTE - before_byte));
12ca5cdf 6625 else
d8a2934e 6626 SET_PT_BOTH (opoint, opoint_byte);
12ca5cdf 6627
30623085 6628 set_buffer_internal (old);
d0d6b7c5 6629 }
30623085
RS
6630 }
6631 } /* end for */
d0d6b7c5
JB
6632
6633 update_mode_lines++; /* in case buffers use %s in mode-line-format */
d0d6b7c5
JB
6634 UNGCPRO;
6635}
0fa1789e
KH
6636
6637\f
6638DEFUN ("set-process-coding-system", Fset_process_coding_system,
6639 Sset_process_coding_system, 1, 3, 0,
fdb82f93
PJ
6640 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
6641DECODING will be used to decode subprocess output and ENCODING to
6642encode subprocess input. */)
5842a27b 6643 (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
0fa1789e
KH
6644{
6645 register struct Lisp_Process *p;
6646
f3d9532b
JB
6647 CHECK_PROCESS (process);
6648 p = XPROCESS (process);
60f0fb11 6649 if (p->infd < 0)
d5db4077 6650 error ("Input file descriptor of %s closed", SDATA (p->name));
60f0fb11 6651 if (p->outfd < 0)
d5db4077 6652 error ("Output file descriptor of %s closed", SDATA (p->name));
03f04413
KH
6653 Fcheck_coding_system (decoding);
6654 Fcheck_coding_system (encoding);
76d812bb 6655 encoding = coding_inherit_eol_type (encoding, Qnil);
03f04413
KH
6656 p->decode_coding_system = decoding;
6657 p->encode_coding_system = encoding;
f3d9532b 6658 setup_process_coding_systems (process);
0fa1789e
KH
6659
6660 return Qnil;
6661}
6662
6663DEFUN ("process-coding-system",
6664 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
fdb82f93 6665 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
5842a27b 6666 (register Lisp_Object process)
0fa1789e 6667{
f3d9532b
JB
6668 CHECK_PROCESS (process);
6669 return Fcons (XPROCESS (process)->decode_coding_system,
6670 XPROCESS (process)->encode_coding_system);
0fa1789e 6671}
03f04413
KH
6672
6673DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
6674 Sset_process_filter_multibyte, 2, 2, 0,
7392e23c
KS
6675 doc: /* Set multibyteness of the strings given to PROCESS's filter.
6676If FLAG is non-nil, the filter is given multibyte strings.
6677If FLAG is nil, the filter is given unibyte strings. In this case,
03f04413
KH
6678all character code conversion except for end-of-line conversion is
6679suppressed. */)
5842a27b 6680 (Lisp_Object process, Lisp_Object flag)
03f04413
KH
6681{
6682 register struct Lisp_Process *p;
6683
f3d9532b
JB
6684 CHECK_PROCESS (process);
6685 p = XPROCESS (process);
5431bd6a
SM
6686 if (NILP (flag))
6687 p->decode_coding_system = raw_text_coding_system (p->decode_coding_system);
f3d9532b 6688 setup_process_coding_systems (process);
03f04413
KH
6689
6690 return Qnil;
6691}
6692
6693DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6694 Sprocess_filter_multibyte_p, 1, 1, 0,
6695 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
5842a27b 6696 (Lisp_Object process)
03f04413
KH
6697{
6698 register struct Lisp_Process *p;
5431bd6a 6699 struct coding_system *coding;
03f04413 6700
f3d9532b
JB
6701 CHECK_PROCESS (process);
6702 p = XPROCESS (process);
5431bd6a
SM
6703 coding = proc_decode_coding_system[p->infd];
6704 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
03f04413
KH
6705}
6706
6707
d0d6b7c5 6708\f
cb768704 6709
4475bec4
PE
6710# ifdef HAVE_GPM
6711
994d9841 6712void
d3da34e0 6713add_gpm_wait_descriptor (int desc)
994d9841 6714{
3fad2ad2 6715 add_keyboard_wait_descriptor (desc);
994d9841
NR
6716}
6717
994d9841 6718void
d3da34e0 6719delete_gpm_wait_descriptor (int desc)
994d9841 6720{
3fad2ad2 6721 delete_keyboard_wait_descriptor (desc);
994d9841
NR
6722}
6723
4475bec4
PE
6724# endif
6725
006c5daa
PE
6726# ifdef SIGIO
6727
a69281ff
RS
6728/* Return nonzero if *MASK has a bit set
6729 that corresponds to one of the keyboard input descriptors. */
6730
ff6daed3 6731static int
d3da34e0 6732keyboard_bit_set (fd_set *mask)
a69281ff
RS
6733{
6734 int fd;
6735
3fad2ad2 6736 for (fd = 0; fd <= max_input_desc; fd++)
a69281ff
RS
6737 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
6738 && !FD_ISSET (fd, &non_keyboard_wait_mask))
6739 return 1;
6740
6741 return 0;
6742}
006c5daa 6743# endif
934e2a68 6744
f388c88a 6745#else /* not subprocesses */
934e2a68 6746
f388c88a
EZ
6747/* Defined on msdos.c. */
6748extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
6749 EMACS_TIME *);
934e2a68 6750
f388c88a
EZ
6751/* Implementation of wait_reading_process_output, assuming that there
6752 are no subprocesses. Used only by the MS-DOS build.
934e2a68 6753
f388c88a 6754 Wait for timeout to elapse and/or keyboard input to be available.
934e2a68 6755
f388c88a
EZ
6756 time_limit is:
6757 timeout in seconds, or
6758 zero for no limit, or
6759 -1 means gobble data immediately available but don't wait for any.
934e2a68 6760
f388c88a
EZ
6761 read_kbd is a Lisp_Object:
6762 0 to ignore keyboard input, or
6763 1 to return when input is available, or
6764 -1 means caller will actually read the input, so don't throw to
6765 the quit handler.
934e2a68 6766
f388c88a
EZ
6767 see full version for other parameters. We know that wait_proc will
6768 always be NULL, since `subprocesses' isn't defined.
934e2a68 6769
f388c88a
EZ
6770 do_display != 0 means redisplay should be done to show subprocess
6771 output that arrives.
934e2a68 6772
f388c88a
EZ
6773 Return true if we received input from any process. */
6774
6775int
1408902e
EZ
6776wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
6777 int do_display,
6778 Lisp_Object wait_for_cell,
6779 struct Lisp_Process *wait_proc, int just_wait_proc)
d0d6b7c5 6780{
f388c88a
EZ
6781 register int nfds;
6782 EMACS_TIME end_time, timeout;
6783 SELECT_TYPE waitchannels;
6784 int xerrno;
d0d6b7c5 6785
f388c88a
EZ
6786 /* What does time_limit really mean? */
6787 if (time_limit || microsecs)
6788 {
6789 EMACS_GET_TIME (end_time);
6790 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
6791 EMACS_ADD_TIME (end_time, end_time, timeout);
6792 }
84af9896 6793
f388c88a
EZ
6794 /* Turn off periodic alarms (in case they are in use)
6795 and then turn off any other atimers,
6796 because the select emulator uses alarms. */
6797 stop_polling ();
6798 turn_on_atimers (0);
d0d6b7c5 6799
f388c88a
EZ
6800 while (1)
6801 {
6802 int timeout_reduced_for_timers = 0;
dd2281ae 6803
f388c88a
EZ
6804 /* If calling from keyboard input, do not quit
6805 since we want to return C-g as an input character.
6806 Otherwise, do pending quit if requested. */
6807 if (read_kbd >= 0)
6808 QUIT;
bad49fc7 6809
f388c88a
EZ
6810 /* Exit now if the cell we're waiting for became non-nil. */
6811 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6812 break;
0a65b032 6813
bae8d137
RS
6814 /* Compute time from now till when time limit is up */
6815 /* Exit if already run out */
52fd88d3
EZ
6816 if (time_limit == -1)
6817 {
6818 /* -1 specified for timeout means
6819 gobble output available now
6820 but don't wait at all. */
6821
6822 EMACS_SET_SECS_USECS (timeout, 0, 0);
6823 }
6824 else if (time_limit || microsecs)
6720a7fb 6825 {
f694e5d2
KH
6826 EMACS_GET_TIME (timeout);
6827 EMACS_SUB_TIME (timeout, end_time, timeout);
6828 if (EMACS_TIME_NEG_P (timeout))
6720a7fb
JB
6829 break;
6830 }
52fd88d3
EZ
6831 else
6832 {
6833 EMACS_SET_SECS_USECS (timeout, 100000, 0);
6834 }
6720a7fb 6835
bae8d137
RS
6836 /* If our caller will not immediately handle keyboard events,
6837 run timer events directly.
6838 (Callers that will immediately read keyboard events
6839 call timer_delay on their own.) */
f3fbd155 6840 if (NILP (wait_for_cell))
bae8d137
RS
6841 {
6842 EMACS_TIME timer_delay;
0a65b032 6843
9baacf76 6844 do
0a65b032 6845 {
9baacf76 6846 int old_timers_run = timers_run;
f868cd8a 6847 timer_delay = timer_check ();
9baacf76
GM
6848 if (timers_run != old_timers_run && do_display)
6849 /* We must retry, since a timer may have requeued itself
6850 and that could alter the time delay. */
3007ebfb 6851 redisplay_preserve_echo_area (14);
9baacf76
GM
6852 else
6853 break;
0a65b032 6854 }
9baacf76 6855 while (!detect_input_pending ());
0a65b032 6856
52fd88d3 6857 /* If there is unread keyboard input, also return. */
b89a415a 6858 if (read_kbd != 0
52fd88d3
EZ
6859 && requeued_events_pending_p ())
6860 break;
6861
f694e5d2 6862 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
bae8d137
RS
6863 {
6864 EMACS_TIME difference;
f694e5d2 6865 EMACS_SUB_TIME (difference, timer_delay, timeout);
bae8d137
RS
6866 if (EMACS_TIME_NEG_P (difference))
6867 {
f694e5d2 6868 timeout = timer_delay;
bae8d137
RS
6869 timeout_reduced_for_timers = 1;
6870 }
6871 }
6872 }
6873
6720a7fb
JB
6874 /* Cause C-g and alarm signals to take immediate action,
6875 and cause input available signals to zero out timeout. */
b89a415a 6876 if (read_kbd < 0)
6720a7fb
JB
6877 set_waiting_for_input (&timeout);
6878
0a65b032
RS
6879 /* Wait till there is something to do. */
6880
b89a415a 6881 if (! read_kbd && NILP (wait_for_cell))
0a65b032
RS
6882 FD_ZERO (&waitchannels);
6883 else
6884 FD_SET (0, &waitchannels);
6885
ff11dfa1 6886 /* If a frame has been newly mapped and needs updating,
6720a7fb 6887 reprocess its display stuff. */
5164ee8e 6888 if (frame_garbaged && do_display)
0a65b032
RS
6889 {
6890 clear_waiting_for_input ();
3007ebfb 6891 redisplay_preserve_echo_area (15);
b89a415a 6892 if (read_kbd < 0)
0a65b032
RS
6893 set_waiting_for_input (&timeout);
6894 }
6720a7fb 6895
b89a415a 6896 if (read_kbd && detect_input_pending ())
1861b214
RS
6897 {
6898 nfds = 0;
6899 FD_ZERO (&waitchannels);
6900 }
6901 else
6902 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
6903 &timeout);
f694e5d2
KH
6904
6905 xerrno = errno;
6720a7fb
JB
6906
6907 /* Make C-g and alarm signals set flags again */
6908 clear_waiting_for_input ();
6909
6910 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 6911 do_pending_window_change (0);
6720a7fb 6912
f694e5d2
KH
6913 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
6914 /* We waited the full specified time, so return now. */
6915 break;
6916
6720a7fb
JB
6917 if (nfds == -1)
6918 {
6919 /* If the system call was interrupted, then go around the
6920 loop again. */
f694e5d2 6921 if (xerrno == EINTR)
8db121c4 6922 FD_ZERO (&waitchannels);
f694e5d2 6923 else
68c45bf0 6924 error ("select error: %s", emacs_strerror (xerrno));
6720a7fb 6925 }
6720a7fb 6926
f694e5d2
KH
6927 /* Check for keyboard input */
6928
b89a415a 6929 if (read_kbd
78c1afb6 6930 && detect_input_pending_run_timers (do_display))
f694e5d2 6931 {
78c1afb6 6932 swallow_events (do_display);
f694e5d2 6933 if (detect_input_pending_run_timers (do_display))
a2fab450 6934 break;
78c1afb6
EZ
6935 }
6936
52fd88d3 6937 /* If there is unread keyboard input, also return. */
b89a415a 6938 if (read_kbd
52fd88d3
EZ
6939 && requeued_events_pending_p ())
6940 break;
6941
f854a00b
RS
6942 /* If wait_for_cell. check for keyboard input
6943 but don't run any timers.
6944 ??? (It seems wrong to me to check for keyboard
6945 input at all when wait_for_cell, but the code
6946 has been this way since July 1994.
6947 Try changing this after version 19.31.) */
f3fbd155 6948 if (! NILP (wait_for_cell)
f854a00b
RS
6949 && detect_input_pending ())
6950 {
6951 swallow_events (do_display);
6952 if (detect_input_pending ())
6953 break;
6954 }
6955
0a65b032 6956 /* Exit now if the cell we're waiting for became non-nil. */
f3fbd155 6957 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
0a65b032 6958 break;
6720a7fb
JB
6959 }
6960
a87b802f
JB
6961 start_polling ();
6962
6720a7fb
JB
6963 return 0;
6964}
6965
f388c88a
EZ
6966#endif /* not subprocesses */
6967
6968/* The following functions are needed even if async subprocesses are
6969 not supported. Some of them are no-op stubs in that case. */
6720a7fb 6970
01faa934
DN
6971/* Add DESC to the set of keyboard input descriptors. */
6972
6973void
6974add_keyboard_wait_descriptor (int desc)
6975{
bf05eed6 6976#ifdef subprocesses /* actually means "not MSDOS" */
01faa934
DN
6977 FD_SET (desc, &input_wait_mask);
6978 FD_SET (desc, &non_process_wait_mask);
3fad2ad2
J
6979 if (desc > max_input_desc)
6980 max_input_desc = desc;
bf05eed6 6981#endif
01faa934
DN
6982}
6983
6984/* From now on, do not expect DESC to give keyboard input. */
6985
6986void
6987delete_keyboard_wait_descriptor (int desc)
6988{
bf05eed6 6989#ifdef subprocesses
01faa934 6990 int fd;
3fad2ad2 6991 int lim = max_input_desc;
01faa934
DN
6992
6993 FD_CLR (desc, &input_wait_mask);
6994 FD_CLR (desc, &non_process_wait_mask);
6995
3fad2ad2 6996 if (desc == max_input_desc)
01faa934 6997 for (fd = 0; fd < lim; fd++)
3fad2ad2
J
6998 if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
6999 max_input_desc = fd;
bf05eed6 7000#endif
01faa934
DN
7001}
7002
fc549af9
EZ
7003/* Setup coding systems of PROCESS. */
7004
7005void
7006setup_process_coding_systems (Lisp_Object process)
7007{
7008#ifdef subprocesses
7009 struct Lisp_Process *p = XPROCESS (process);
7010 int inch = p->infd;
7011 int outch = p->outfd;
7012 Lisp_Object coding_system;
7013
7014 if (inch < 0 || outch < 0)
7015 return;
7016
7017 if (!proc_decode_coding_system[inch])
7018 proc_decode_coding_system[inch]
7019 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
7020 coding_system = p->decode_coding_system;
7021 if (! NILP (p->filter))
7022 ;
7023 else if (BUFFERP (p->buffer))
7024 {
4b4deea2 7025 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
fc549af9
EZ
7026 coding_system = raw_text_coding_system (coding_system);
7027 }
7028 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7029
7030 if (!proc_encode_coding_system[outch])
7031 proc_encode_coding_system[outch]
7032 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
7033 setup_coding_system (p->encode_coding_system,
7034 proc_encode_coding_system[outch]);
7035#endif
7036}
7037
7038/* Close all descriptors currently in use for communication
7039 with subprocess. This is used in a newly-forked subprocess
7040 to get rid of irrelevant descriptors. */
7041
7042void
7043close_process_descs (void)
7044{
7045#ifndef DOS_NT
7046 int i;
7047 for (i = 0; i < MAXDESC; i++)
7048 {
7049 Lisp_Object process;
7050 process = chan_process[i];
7051 if (!NILP (process))
7052 {
7053 int in = XPROCESS (process)->infd;
7054 int out = XPROCESS (process)->outfd;
7055 if (in >= 0)
7056 emacs_close (in);
7057 if (out >= 0 && in != out)
7058 emacs_close (out);
7059 }
7060 }
7061#endif
7062}
7063
6720a7fb 7064DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
f388c88a
EZ
7065 doc: /* Return the (or a) process associated with BUFFER.
7066BUFFER may be a buffer or the name of one. */)
7067 (register Lisp_Object buffer)
6720a7fb 7068{
f388c88a
EZ
7069#ifdef subprocesses
7070 register Lisp_Object buf, tail, proc;
7071
7072 if (NILP (buffer)) return Qnil;
7073 buf = Fget_buffer (buffer);
7074 if (NILP (buf)) return Qnil;
7075
7076 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
7077 {
7078 proc = Fcdr (XCAR (tail));
7079 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
7080 return proc;
7081 }
7082#endif /* subprocesses */
6720a7fb
JB
7083 return Qnil;
7084}
7085
52a1b894 7086DEFUN ("process-inherit-coding-system-flag",
fdb82f93
PJ
7087 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7088 1, 1, 0,
f388c88a
EZ
7089 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7090If this flag is t, `buffer-file-coding-system' of the buffer
7091associated with PROCESS will inherit the coding system used to decode
7092the process output. */)
5842a27b 7093 (register Lisp_Object process)
52a1b894 7094{
f388c88a
EZ
7095#ifdef subprocesses
7096 CHECK_PROCESS (process);
7097 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7098#else
52a1b894
EZ
7099 /* Ignore the argument and return the value of
7100 inherit-process-coding-system. */
7101 return inherit_process_coding_system ? Qt : Qnil;
f388c88a 7102#endif
52a1b894
EZ
7103}
7104
6720a7fb 7105/* Kill all processes associated with `buffer'.
f388c88a 7106 If `buffer' is nil, kill all processes */
6720a7fb 7107
d9bb0c32 7108void
f388c88a 7109kill_buffer_processes (Lisp_Object buffer)
6720a7fb 7110{
f388c88a
EZ
7111#ifdef subprocesses
7112 Lisp_Object tail, proc;
7113
7114 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
7115 {
7116 proc = XCDR (XCAR (tail));
7117 if (PROCESSP (proc)
7118 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
7119 {
7120 if (NETCONN_P (proc) || SERIALCONN_P (proc))
7121 Fdelete_process (proc);
7122 else if (XPROCESS (proc)->infd >= 0)
7123 process_send_signal (proc, SIGHUP, Qnil, 1);
7124 }
7125 }
7126#else /* subprocesses */
7127 /* Since we have no subprocesses, this does nothing. */
7128#endif /* subprocesses */
6720a7fb
JB
7129}
7130
a7ca3326 7131DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
16a97296 7132 Swaiting_for_user_input_p, 0, 0, 0,
77defa9a
EZ
7133 doc: /* Returns non-nil if Emacs is waiting for input from the user.
7134This is intended for use by asynchronous process output filters and sentinels. */)
7135 (void)
7136{
7137#ifdef subprocesses
7138 return (waiting_for_user_input_p ? Qt : Qnil);
7139#else
7140 return Qnil;
7141#endif
7142}
7143
d568829b
EZ
7144/* Stop reading input from keyboard sources. */
7145
7146void
7147hold_keyboard_input (void)
7148{
7149 kbd_is_on_hold = 1;
7150}
7151
7152/* Resume reading input from keyboard sources. */
7153
7154void
7155unhold_keyboard_input (void)
7156{
7157 kbd_is_on_hold = 0;
7158}
7159
7160/* Return non-zero if keyboard input is on hold, zero otherwise. */
7161
7162int
7163kbd_on_hold_p (void)
7164{
7165 return kbd_is_on_hold;
7166}
7167
f388c88a
EZ
7168\f
7169/* Enumeration of and access to system processes a-la ps(1). */
7170
934e2a68
EZ
7171DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7172 0, 0, 0,
7173 doc: /* Return a list of numerical process IDs of all running processes.
7174If this functionality is unsupported, return nil.
7175
f388c88a
EZ
7176See `process-attributes' for getting attributes of a process given its ID. */)
7177 (void)
7178{
7179 return list_system_processes ();
7180}
7181
7182DEFUN ("process-attributes", Fprocess_attributes,
7183 Sprocess_attributes, 1, 1, 0,
7184 doc: /* Return attributes of the process given by its PID, a number.
7185
7186Value is an alist where each element is a cons cell of the form
7187
7188 \(KEY . VALUE)
7189
7190If this functionality is unsupported, the value is nil.
7191
7192See `list-system-processes' for getting a list of all process IDs.
7193
7194The KEYs of the attributes that this function may return are listed
7195below, together with the type of the associated VALUE (in parentheses).
7196Not all platforms support all of these attributes; unsupported
7197attributes will not appear in the returned alist.
7198Unless explicitly indicated otherwise, numbers can have either
7199integer or floating point values.
7200
7201 euid -- Effective user User ID of the process (number)
7202 user -- User name corresponding to euid (string)
7203 egid -- Effective user Group ID of the process (number)
7204 group -- Group name corresponding to egid (string)
7205 comm -- Command name (executable name only) (string)
7206 state -- Process state code, such as "S", "R", or "T" (string)
7207 ppid -- Parent process ID (number)
7208 pgrp -- Process group ID (number)
7209 sess -- Session ID, i.e. process ID of session leader (number)
7210 ttname -- Controlling tty name (string)
7211 tpgid -- ID of foreground process group on the process's tty (number)
7212 minflt -- number of minor page faults (number)
7213 majflt -- number of major page faults (number)
7214 cminflt -- cumulative number of minor page faults (number)
7215 cmajflt -- cumulative number of major page faults (number)
7216 utime -- user time used by the process, in the (HIGH LOW USEC) format
7217 stime -- system time used by the process, in the (HIGH LOW USEC) format
7218 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7219 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7220 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7221 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7222 pri -- priority of the process (number)
7223 nice -- nice value of the process (number)
7224 thcount -- process thread count (number)
7225 start -- time the process started, in the (HIGH LOW USEC) format
7226 vsize -- virtual memory size of the process in KB's (number)
7227 rss -- resident set size of the process in KB's (number)
7228 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7229 pcpu -- percents of CPU time used by the process (floating-point number)
7230 pmem -- percents of total physical memory used by process's resident set
7231 (floating-point number)
7232 args -- command line which invoked the process (string). */)
7233 ( Lisp_Object pid)
7234{
7235 return system_process_attributes (pid);
7236}
7237
7238\f
7239void
7240init_process (void)
7241{
7242#ifdef subprocesses
7243 register int i;
7244
7245 inhibit_sentinels = 0;
7246
7247#ifdef SIGCHLD
7248#ifndef CANNOT_DUMP
7249 if (! noninteractive || initialized)
7250#endif
7251 signal (SIGCHLD, sigchld_handler);
7252#endif
7253
7254 FD_ZERO (&input_wait_mask);
7255 FD_ZERO (&non_keyboard_wait_mask);
7256 FD_ZERO (&non_process_wait_mask);
3fad2ad2 7257 FD_ZERO (&write_mask);
f388c88a 7258 max_process_desc = 0;
3fad2ad2 7259 memset (fd_callback_info, 0, sizeof (fd_callback_info));
f388c88a
EZ
7260
7261#ifdef NON_BLOCKING_CONNECT
7262 FD_ZERO (&connect_wait_mask);
7263 num_pending_connects = 0;
7264#endif
7265
7266#ifdef ADAPTIVE_READ_BUFFERING
7267 process_output_delay_count = 0;
7268 process_output_skip = 0;
7269#endif
7270
7271 /* Don't do this, it caused infinite select loops. The display
7272 method should call add_keyboard_wait_descriptor on stdin if it
7273 needs that. */
7274#if 0
7275 FD_SET (0, &input_wait_mask);
7276#endif
7277
7278 Vprocess_alist = Qnil;
7279#ifdef SIGCHLD
7280 deleted_pid_list = Qnil;
7281#endif
7282 for (i = 0; i < MAXDESC; i++)
7283 {
7284 chan_process[i] = Qnil;
7285 proc_buffered_char[i] = -1;
7286 }
7287 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
7288 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
7289#ifdef DATAGRAM_SOCKETS
7290 memset (datagram_address, 0, sizeof datagram_address);
7291#endif
7292
f388c88a
EZ
7293 {
7294 Lisp_Object subfeatures = Qnil;
7295 const struct socket_options *sopt;
7296
7297#define ADD_SUBFEATURE(key, val) \
7298 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7299
7300#ifdef NON_BLOCKING_CONNECT
7301 ADD_SUBFEATURE (QCnowait, Qt);
7302#endif
7303#ifdef DATAGRAM_SOCKETS
7304 ADD_SUBFEATURE (QCtype, Qdatagram);
7305#endif
7306#ifdef HAVE_SEQPACKET
7307 ADD_SUBFEATURE (QCtype, Qseqpacket);
7308#endif
7309#ifdef HAVE_LOCAL_SOCKETS
7310 ADD_SUBFEATURE (QCfamily, Qlocal);
7311#endif
7312 ADD_SUBFEATURE (QCfamily, Qipv4);
7313#ifdef AF_INET6
7314 ADD_SUBFEATURE (QCfamily, Qipv6);
7315#endif
7316#ifdef HAVE_GETSOCKNAME
7317 ADD_SUBFEATURE (QCservice, Qt);
7318#endif
5e617bc2 7319#if defined (O_NONBLOCK) || defined (O_NDELAY)
f388c88a
EZ
7320 ADD_SUBFEATURE (QCserver, Qt);
7321#endif
7322
7323 for (sopt = socket_options; sopt->name; sopt++)
7324 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
7325
7326 Fprovide (intern_c_string ("make-network-process"), subfeatures);
7327 }
f388c88a
EZ
7328
7329#if defined (DARWIN_OS)
7330 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7331 processes. As such, we only change the default value. */
7332 if (initialized)
7333 {
f44bd759
PE
7334 char const *release = (STRINGP (Voperating_system_release)
7335 ? SSDATA (Voperating_system_release)
7336 : 0);
f388c88a
EZ
7337 if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
7338 && release[1] == '.')) {
7339 Vprocess_connection_type = Qnil;
7340 }
7341 }
7342#endif
7343#endif /* subprocesses */
7344 kbd_is_on_hold = 0;
7345}
7346
7347void
7348syms_of_process (void)
7349{
7350#ifdef subprocesses
7351
cd3520a4
JB
7352 DEFSYM (Qprocessp, "processp");
7353 DEFSYM (Qrun, "run");
7354 DEFSYM (Qstop, "stop");
7355 DEFSYM (Qsignal, "signal");
f388c88a
EZ
7356
7357 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7358 here again.
934e2a68 7359
f388c88a
EZ
7360 Qexit = intern_c_string ("exit");
7361 staticpro (&Qexit); */
934e2a68 7362
cd3520a4
JB
7363 DEFSYM (Qopen, "open");
7364 DEFSYM (Qclosed, "closed");
7365 DEFSYM (Qconnect, "connect");
7366 DEFSYM (Qfailed, "failed");
7367 DEFSYM (Qlisten, "listen");
7368 DEFSYM (Qlocal, "local");
7369 DEFSYM (Qipv4, "ipv4");
f388c88a 7370#ifdef AF_INET6
cd3520a4
JB
7371 DEFSYM (Qipv6, "ipv6");
7372#endif
7373 DEFSYM (Qdatagram, "datagram");
7374 DEFSYM (Qseqpacket, "seqpacket");
7375
7376 DEFSYM (QCport, ":port");
7377 DEFSYM (QCspeed, ":speed");
7378 DEFSYM (QCprocess, ":process");
7379
7380 DEFSYM (QCbytesize, ":bytesize");
7381 DEFSYM (QCstopbits, ":stopbits");
7382 DEFSYM (QCparity, ":parity");
7383 DEFSYM (Qodd, "odd");
7384 DEFSYM (Qeven, "even");
7385 DEFSYM (QCflowcontrol, ":flowcontrol");
7386 DEFSYM (Qhw, "hw");
7387 DEFSYM (Qsw, "sw");
7388 DEFSYM (QCsummary, ":summary");
7389
7390 DEFSYM (Qreal, "real");
7391 DEFSYM (Qnetwork, "network");
7392 DEFSYM (Qserial, "serial");
7393 DEFSYM (QCbuffer, ":buffer");
7394 DEFSYM (QChost, ":host");
7395 DEFSYM (QCservice, ":service");
7396 DEFSYM (QClocal, ":local");
7397 DEFSYM (QCremote, ":remote");
7398 DEFSYM (QCcoding, ":coding");
7399 DEFSYM (QCserver, ":server");
7400 DEFSYM (QCnowait, ":nowait");
7401 DEFSYM (QCsentinel, ":sentinel");
7402 DEFSYM (QClog, ":log");
7403 DEFSYM (QCnoquery, ":noquery");
7404 DEFSYM (QCstop, ":stop");
7405 DEFSYM (QCoptions, ":options");
7406 DEFSYM (QCplist, ":plist");
7407
7408 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
934e2a68 7409
f388c88a
EZ
7410 staticpro (&Vprocess_alist);
7411#ifdef SIGCHLD
7412 staticpro (&deleted_pid_list);
7413#endif
934e2a68 7414
f388c88a 7415#endif /* subprocesses */
6720a7fb 7416
cd3520a4
JB
7417 DEFSYM (QCname, ":name");
7418 DEFSYM (QCtype, ":type");
7419
7420 DEFSYM (Qeuid, "euid");
7421 DEFSYM (Qegid, "egid");
7422 DEFSYM (Quser, "user");
7423 DEFSYM (Qgroup, "group");
7424 DEFSYM (Qcomm, "comm");
7425 DEFSYM (Qstate, "state");
7426 DEFSYM (Qppid, "ppid");
7427 DEFSYM (Qpgrp, "pgrp");
7428 DEFSYM (Qsess, "sess");
7429 DEFSYM (Qttname, "ttname");
7430 DEFSYM (Qtpgid, "tpgid");
7431 DEFSYM (Qminflt, "minflt");
7432 DEFSYM (Qmajflt, "majflt");
7433 DEFSYM (Qcminflt, "cminflt");
7434 DEFSYM (Qcmajflt, "cmajflt");
7435 DEFSYM (Qutime, "utime");
7436 DEFSYM (Qstime, "stime");
7437 DEFSYM (Qtime, "time");
7438 DEFSYM (Qcutime, "cutime");
7439 DEFSYM (Qcstime, "cstime");
7440 DEFSYM (Qctime, "ctime");
7441 DEFSYM (Qpri, "pri");
7442 DEFSYM (Qnice, "nice");
7443 DEFSYM (Qthcount, "thcount");
7444 DEFSYM (Qstart, "start");
7445 DEFSYM (Qvsize, "vsize");
7446 DEFSYM (Qrss, "rss");
7447 DEFSYM (Qetime, "etime");
7448 DEFSYM (Qpcpu, "pcpu");
7449 DEFSYM (Qpmem, "pmem");
7450 DEFSYM (Qargs, "args");
9057ff80 7451
29208e82 7452 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
f388c88a
EZ
7453 doc: /* *Non-nil means delete processes immediately when they exit.
7454A value of nil means don't delete them until `list-processes' is run. */);
7455
7456 delete_exited_processes = 1;
7457
462aa963 7458#ifdef subprocesses
29208e82 7459 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
f388c88a
EZ
7460 doc: /* Control type of device used to communicate with subprocesses.
7461Values are nil to use a pipe, or t or `pty' to use a pty.
7462The value has no effect if the system has no ptys or if all ptys are busy:
7463then a pipe is used in any case.
7464The value takes effect when `start-process' is called. */);
7465 Vprocess_connection_type = Qt;
7466
7467#ifdef ADAPTIVE_READ_BUFFERING
29208e82 7468 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
f388c88a
EZ
7469 doc: /* If non-nil, improve receive buffering by delaying after short reads.
7470On some systems, when Emacs reads the output from a subprocess, the output data
7471is read in very small blocks, potentially resulting in very poor performance.
7472This behavior can be remedied to some extent by setting this variable to a
7473non-nil value, as it will automatically delay reading from such processes, to
7474allow them to produce more output before Emacs tries to read it.
7475If the value is t, the delay is reset after each write to the process; any other
7476non-nil value means that the delay is not reset on write.
7477The variable takes effect when `start-process' is called. */);
7478 Vprocess_adaptive_read_buffering = Qt;
7479#endif
7480
7481 defsubr (&Sprocessp);
7482 defsubr (&Sget_process);
7483 defsubr (&Sdelete_process);
7484 defsubr (&Sprocess_status);
7485 defsubr (&Sprocess_exit_status);
7486 defsubr (&Sprocess_id);
7487 defsubr (&Sprocess_name);
7488 defsubr (&Sprocess_tty_name);
7489 defsubr (&Sprocess_command);
7490 defsubr (&Sset_process_buffer);
7491 defsubr (&Sprocess_buffer);
7492 defsubr (&Sprocess_mark);
7493 defsubr (&Sset_process_filter);
7494 defsubr (&Sprocess_filter);
7495 defsubr (&Sset_process_sentinel);
7496 defsubr (&Sprocess_sentinel);
7497 defsubr (&Sset_process_window_size);
7498 defsubr (&Sset_process_inherit_coding_system_flag);
7499 defsubr (&Sset_process_query_on_exit_flag);
7500 defsubr (&Sprocess_query_on_exit_flag);
7501 defsubr (&Sprocess_contact);
7502 defsubr (&Sprocess_plist);
7503 defsubr (&Sset_process_plist);
f388c88a
EZ
7504 defsubr (&Sprocess_list);
7505 defsubr (&Sstart_process);
f388c88a
EZ
7506 defsubr (&Sserial_process_configure);
7507 defsubr (&Smake_serial_process);
f388c88a
EZ
7508 defsubr (&Sset_network_process_option);
7509 defsubr (&Smake_network_process);
7510 defsubr (&Sformat_network_address);
5e617bc2 7511#if defined (HAVE_NET_IF_H)
f388c88a
EZ
7512#ifdef SIOCGIFCONF
7513 defsubr (&Snetwork_interface_list);
7514#endif
5e617bc2 7515#if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
f388c88a
EZ
7516 defsubr (&Snetwork_interface_info);
7517#endif
5e617bc2 7518#endif /* defined (HAVE_NET_IF_H) */
f388c88a
EZ
7519#ifdef DATAGRAM_SOCKETS
7520 defsubr (&Sprocess_datagram_address);
7521 defsubr (&Sset_process_datagram_address);
7522#endif
7523 defsubr (&Saccept_process_output);
7524 defsubr (&Sprocess_send_region);
7525 defsubr (&Sprocess_send_string);
7526 defsubr (&Sinterrupt_process);
7527 defsubr (&Skill_process);
7528 defsubr (&Squit_process);
7529 defsubr (&Sstop_process);
7530 defsubr (&Scontinue_process);
7531 defsubr (&Sprocess_running_child_p);
7532 defsubr (&Sprocess_send_eof);
7533 defsubr (&Ssignal_process);
7534 defsubr (&Swaiting_for_user_input_p);
7535 defsubr (&Sprocess_type);
7536 defsubr (&Sset_process_coding_system);
7537 defsubr (&Sprocess_coding_system);
7538 defsubr (&Sset_process_filter_multibyte);
7539 defsubr (&Sprocess_filter_multibyte_p);
7540
7541#endif /* subprocesses */
7542
6720a7fb 7543 defsubr (&Sget_buffer_process);
52a1b894 7544 defsubr (&Sprocess_inherit_coding_system_flag);
934e2a68 7545 defsubr (&Slist_system_processes);
a20878b6 7546 defsubr (&Sprocess_attributes);
6720a7fb 7547}