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