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