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