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