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