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