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