Rename locals to avoid shadowing.
[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,
e4920bc9 3720NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
6b61353c 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
16c1ad08
LMI
4628 through all the channels and check for data.
4629 This is a workaround needed for some versions of
4630 the gnutls library -- 2.12.14 has been confirmed
4631 to need it. See
4632 http://comments.gmane.org/gmane.emacs.devel/145074 */
261b6fd4 4633 for (channel = 0; channel < MAXDESC; ++channel)
5b76caa4
PE
4634 if (! NILP (chan_process[channel]))
4635 {
4636 struct Lisp_Process *p =
4637 XPROCESS (chan_process[channel]);
4638 if (p && p->gnutls_p && p->infd
4639 && ((emacs_gnutls_record_check_pending
4640 (p->gnutls_state))
4641 > 0))
4642 {
4643 nfds++;
4644 FD_SET (p->infd, &Available);
4645 }
4646 }
261b6fd4
LMI
4647 }
4648 else
4649 {
4650 /* Check this specific channel. */
5b76caa4 4651 if (wait_proc->gnutls_p /* Check for valid process. */
261b6fd4 4652 /* Do we have pending data? */
5b76caa4
PE
4653 && ((emacs_gnutls_record_check_pending
4654 (wait_proc->gnutls_state))
4655 > 0))
261b6fd4
LMI
4656 {
4657 nfds = 1;
4658 /* Set to Available. */
4659 FD_SET (wait_proc->infd, &Available);
4660 }
4661 }
4662 }
e061a11b 4663#endif
dd2a17ab 4664 }
6720a7fb 4665
d0d6b7c5
JB
4666 xerrno = errno;
4667
4668 /* Make C-g and alarm signals set flags again */
4669 clear_waiting_for_input ();
4670
4671 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 4672 do_pending_window_change (0);
d0d6b7c5 4673
c0239a0b
RS
4674 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
4675 /* We wanted the full specified time, so return now. */
d0d6b7c5
JB
4676 break;
4677 if (nfds < 0)
4678 {
4679 if (xerrno == EINTR)
dd2a17ab 4680 no_avail = 1;
d0d6b7c5
JB
4681 else if (xerrno == EBADF)
4682 {
4683#ifdef AIX
4684 /* AIX doesn't handle PTY closure the same way BSD does. On AIX,
4685 the child's closure of the pts gives the parent a SIGHUP, and
4686 the ptc file descriptor is automatically closed,
4687 yielding EBADF here or at select() call above.
4688 So, SIGHUP is ignored (see def of PTY_TTY_NAME_SPRINTF
a0e4d3f3 4689 in m/ibmrt-aix.h), and here we just ignore the select error.
d0d6b7c5 4690 Cleanup occurs c/o status_notify after SIGCLD. */
dd2a17ab 4691 no_avail = 1; /* Cannot depend on values returned */
d0d6b7c5
JB
4692#else
4693 abort ();
4694#endif
4695 }
4696 else
68c45bf0 4697 error ("select error: %s", emacs_strerror (xerrno));
d0d6b7c5 4698 }
dd2a17ab
KS
4699
4700 if (no_avail)
4701 {
4702 FD_ZERO (&Available);
3fad2ad2 4703 check_write = 0;
dd2a17ab
KS
4704 }
4705
5d5beb62
RS
4706#if 0 /* When polling is used, interrupt_input is 0,
4707 so get_input_pending should read the input.
4708 So this should not be needed. */
4709 /* If we are using polling for input,
4710 and we see input available, make it get read now.
4711 Otherwise it might not actually get read for a second.
214d6069 4712 And on hpux, since we turn off polling in wait_reading_process_output,
5d5beb62 4713 it might never get read at all if we don't spend much time
214d6069 4714 outside of wait_reading_process_output. */
b89a415a 4715 if (read_kbd && interrupt_input
5d5beb62
RS
4716 && keyboard_bit_set (&Available)
4717 && input_polling_used ())
4718 kill (getpid (), SIGALRM);
4719#endif
4720
d0d6b7c5
JB
4721 /* Check for keyboard input */
4722 /* If there is any, return immediately
4723 to give it higher priority than subprocesses */
4724
b89a415a 4725 if (read_kbd != 0)
6ed6233b 4726 {
a2fab450 4727 int old_timers_run = timers_run;
c88164fe 4728 struct buffer *old_buffer = current_buffer;
c0323133 4729 Lisp_Object old_window = selected_window;
a2fab450 4730 int leave = 0;
177c0ea7 4731
5d6c2aa3 4732 if (detect_input_pending_run_timers (do_display))
a2fab450
GM
4733 {
4734 swallow_events (do_display);
4735 if (detect_input_pending_run_timers (do_display))
4736 leave = 1;
4737 }
6ed6233b 4738
a2fab450
GM
4739 /* If a timer has run, this might have changed buffers
4740 an alike. Make read_key_sequence aware of that. */
4741 if (timers_run != old_timers_run
c88164fe 4742 && waiting_for_user_input_p == -1
c0323133
GM
4743 && (old_buffer != current_buffer
4744 || !EQ (old_window, selected_window)))
a2fab450
GM
4745 record_asynch_buffer_change ();
4746
4747 if (leave)
4748 break;
177c0ea7
JB
4749 }
4750
69645afc 4751 /* If there is unread keyboard input, also return. */
b89a415a 4752 if (read_kbd != 0
69645afc
RS
4753 && requeued_events_pending_p ())
4754 break;
4755
77e1b3d4
RS
4756 /* If we are not checking for keyboard input now,
4757 do process events (but don't run any timers).
4758 This is so that X events will be processed.
0c9960e9 4759 Otherwise they may have to wait until polling takes place.
77e1b3d4
RS
4760 That would causes delays in pasting selections, for example.
4761
4762 (We used to do this only if wait_for_cell.) */
b89a415a 4763 if (read_kbd == 0 && detect_input_pending ())
f854a00b
RS
4764 {
4765 swallow_events (do_display);
0c9960e9 4766#if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
f854a00b
RS
4767 if (detect_input_pending ())
4768 break;
5d5beb62 4769#endif
0c9960e9 4770 }
f854a00b 4771
84aa3ace 4772 /* Exit now if the cell we're waiting for became non-nil. */
f3fbd155 4773 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
84aa3ace
RS
4774 break;
4775
4746118a 4776#ifdef SIGIO
5d5beb62 4777 /* If we think we have keyboard input waiting, but didn't get SIGIO,
d0d6b7c5
JB
4778 go read it. This can happen with X on BSD after logging out.
4779 In that case, there really is no input and no SIGIO,
4780 but select says there is input. */
4781
b89a415a 4782 if (read_kbd && interrupt_input
2601f59e 4783 && keyboard_bit_set (&Available) && ! noninteractive)
e643c5be 4784 kill (getpid (), SIGIO);
4746118a 4785#endif
d0d6b7c5 4786
d0d6b7c5
JB
4787 if (! wait_proc)
4788 got_some_input |= nfds > 0;
4789
32676c08
JB
4790 /* If checking input just got us a size-change event from X,
4791 obey it now if we should. */
b89a415a 4792 if (read_kbd || ! NILP (wait_for_cell))
2b653806 4793 do_pending_window_change (0);
32676c08 4794
a9f2c884 4795 /* Check for data from a process. */
dd2a17ab
KS
4796 if (no_avail || nfds == 0)
4797 continue;
4798
3fad2ad2
J
4799 for (channel = 0; channel <= max_input_desc; ++channel)
4800 {
4801 struct fd_callback_data *d = &fd_callback_info[channel];
4802 if (FD_ISSET (channel, &Available)
4803 && d->func != 0
4804 && (d->condition & FOR_READ) != 0)
4805 d->func (channel, d->data, 1);
4806 if (FD_ISSET (channel, &write_mask)
4807 && d->func != 0
4808 && (d->condition & FOR_WRITE) != 0)
4809 d->func (channel, d->data, 0);
4810 }
4811
a69281ff 4812 for (channel = 0; channel <= max_process_desc; channel++)
d0d6b7c5 4813 {
a69281ff 4814 if (FD_ISSET (channel, &Available)
3fad2ad2
J
4815 && FD_ISSET (channel, &non_keyboard_wait_mask)
4816 && !FD_ISSET (channel, &non_process_wait_mask))
d0d6b7c5
JB
4817 {
4818 int nread;
4819
4820 /* If waiting for this channel, arrange to return as
4821 soon as no more input to be processed. No more
4822 waiting. */
4823 if (wait_channel == channel)
4824 {
a9f2c884 4825 wait_channel = -1;
d0d6b7c5
JB
4826 time_limit = -1;
4827 got_some_input = 1;
4828 }
4829 proc = chan_process[channel];
4830 if (NILP (proc))
4831 continue;
4832
e690ca94
KS
4833 /* If this is a server stream socket, accept connection. */
4834 if (EQ (XPROCESS (proc)->status, Qlisten))
4835 {
4836 server_accept_connection (proc, channel);
4837 continue;
4838 }
4839
d0d6b7c5
JB
4840 /* Read data from the process, starting with our
4841 buffered-ahead character if we have one. */
4842
4843 nread = read_process_output (proc, channel);
4844 if (nread > 0)
4845 {
4846 /* Since read_process_output can run a filter,
4847 which can call accept-process-output,
4848 don't try to read from any other processes
4849 before doing the select again. */
4850 FD_ZERO (&Available);
4851
4852 if (do_display)
3007ebfb 4853 redisplay_preserve_echo_area (12);
d0d6b7c5
JB
4854 }
4855#ifdef EWOULDBLOCK
4856 else if (nread == -1 && errno == EWOULDBLOCK)
4857 ;
0b75e9a4 4858#endif
89d7280d
RS
4859 /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK,
4860 and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */
d0d6b7c5
JB
4861#ifdef O_NONBLOCK
4862 else if (nread == -1 && errno == EAGAIN)
4863 ;
4864#else
4865#ifdef O_NDELAY
4866 else if (nread == -1 && errno == EAGAIN)
4867 ;
4868 /* Note that we cannot distinguish between no input
4869 available now and a closed pipe.
4870 With luck, a closed pipe will be accompanied by
4871 subprocess termination and SIGCHLD. */
d888760c 4872 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
d0d6b7c5 4873 ;
4740825c
KS
4874#endif /* O_NDELAY */
4875#endif /* O_NONBLOCK */
d0d6b7c5
JB
4876#ifdef HAVE_PTYS
4877 /* On some OSs with ptys, when the process on one end of
4878 a pty exits, the other end gets an error reading with
4879 errno = EIO instead of getting an EOF (0 bytes read).
4880 Therefore, if we get an error reading and errno =
4881 EIO, just continue, because the child process has
4882 exited and should clean itself up soon (e.g. when we
5651af6d
RS
4883 get a SIGCHLD).
4884
4885 However, it has been known to happen that the SIGCHLD
4740825c 4886 got lost. So raise the signal again just in case.
5651af6d 4887 It can't hurt. */
d0d6b7c5 4888 else if (nread == -1 && errno == EIO)
4740825c 4889 {
83ed7b5c
GM
4890 /* Clear the descriptor now, so we only raise the signal once. */
4891 FD_CLR (channel, &input_wait_mask);
4892 FD_CLR (channel, &non_keyboard_wait_mask);
4740825c 4893
83ed7b5c 4894 kill (getpid (), SIGCHLD);
4740825c
KS
4895 }
4896#endif /* HAVE_PTYS */
ffd56f97
JB
4897 /* If we can detect process termination, don't consider the process
4898 gone just because its pipe is closed. */
d0d6b7c5 4899#ifdef SIGCHLD
d888760c 4900 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc))
d0d6b7c5
JB
4901 ;
4902#endif
4903 else
4904 {
4905 /* Preserve status of processes already terminated. */
60f0fb11 4906 XPROCESS (proc)->tick = ++process_tick;
d0d6b7c5 4907 deactivate_process (proc);
6bfd98e7 4908 if (XPROCESS (proc)->raw_status_new)
d0d6b7c5
JB
4909 update_status (XPROCESS (proc));
4910 if (EQ (XPROCESS (proc)->status, Qrun))
4911 XPROCESS (proc)->status
4912 = Fcons (Qexit, Fcons (make_number (256), Qnil));
4913 }
4914 }
177c0ea7 4915#ifdef NON_BLOCKING_CONNECT
3fad2ad2 4916 if (FD_ISSET (channel, &Writeok)
1566f511 4917 && FD_ISSET (channel, &connect_wait_mask))
dd2a17ab
KS
4918 {
4919 struct Lisp_Process *p;
dd2a17ab
KS
4920
4921 FD_CLR (channel, &connect_wait_mask);
d8a4b27a 4922 FD_CLR (channel, &write_mask);
dd2a17ab
KS
4923 if (--num_pending_connects < 0)
4924 abort ();
4925
4926 proc = chan_process[channel];
4927 if (NILP (proc))
4928 continue;
4929
4930 p = XPROCESS (proc);
4931
4932#ifdef GNU_LINUX
4933 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
63136da6 4934 So only use it on systems where it is known to work. */
dd2a17ab 4935 {
401bf9b4 4936 socklen_t xlen = sizeof (xerrno);
ed3751c8 4937 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
dd2a17ab
KS
4938 xerrno = errno;
4939 }
4940#else
44c887be
PJ
4941 {
4942 struct sockaddr pname;
ed3751c8 4943 int pnamelen = sizeof (pname);
44c887be
PJ
4944
4945 /* If connection failed, getpeername will fail. */
4946 xerrno = 0;
ed3751c8 4947 if (getpeername (channel, &pname, &pnamelen) < 0)
44c887be
PJ
4948 {
4949 /* Obtain connect failure code through error slippage. */
4950 char dummy;
dd2a17ab 4951 xerrno = errno;
ed3751c8 4952 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
44c887be
PJ
4953 xerrno = errno;
4954 }
4955 }
dd2a17ab
KS
4956#endif
4957 if (xerrno)
4958 {
60f0fb11 4959 p->tick = ++process_tick;
dd2a17ab
KS
4960 p->status = Fcons (Qfailed, Fcons (make_number (xerrno), Qnil));
4961 deactivate_process (proc);
4962 }
4963 else
4964 {
4965 p->status = Qrun;
4966 /* Execute the sentinel here. If we had relied on
4967 status_notify to do it later, it will read input
4968 from the process before calling the sentinel. */
4969 exec_sentinel (proc, build_string ("open\n"));
e690ca94 4970 if (!EQ (p->filter, Qt) && !EQ (p->command, Qt))
dd2a17ab 4971 {
60f0fb11
SM
4972 FD_SET (p->infd, &input_wait_mask);
4973 FD_SET (p->infd, &non_keyboard_wait_mask);
dd2a17ab
KS
4974 }
4975 }
4976 }
4977#endif /* NON_BLOCKING_CONNECT */
ffd56f97
JB
4978 } /* end for each file descriptor */
4979 } /* end while exit conditions not met */
d0d6b7c5 4980
2beb96f9 4981 unbind_to (count, Qnil);
d430ee71 4982
ffd56f97
JB
4983 /* If calling from keyboard input, do not quit
4984 since we want to return C-g as an input character.
4985 Otherwise, do pending quit if requested. */
b89a415a 4986 if (read_kbd >= 0)
ffd56f97
JB
4987 {
4988 /* Prevent input_pending from remaining set if we quit. */
4989 clear_input_pending ();
4990 QUIT;
4991 }
efa2a55c 4992
d0d6b7c5
JB
4993 return got_some_input;
4994}
4995\f
3b9a3dfa
RS
4996/* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
4997
4998static Lisp_Object
d3da34e0 4999read_process_output_call (Lisp_Object fun_and_args)
3b9a3dfa 5000{
70949dac 5001 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
3b9a3dfa
RS
5002}
5003
5004static Lisp_Object
b93aacde 5005read_process_output_error_handler (Lisp_Object error_val)
3b9a3dfa 5006{
b93aacde 5007 cmd_error_internal (error_val, "error in process filter: ");
3b9a3dfa
RS
5008 Vinhibit_quit = Qt;
5009 update_echo_area ();
833ba342 5010 Fsleep_for (make_number (2), Qnil);
8c983bf2 5011 return Qt;
3b9a3dfa
RS
5012}
5013
d0d6b7c5
JB
5014/* Read pending output from the process channel,
5015 starting with our buffered-ahead character if we have one.
0fa1789e 5016 Yield number of decoded characters read.
d0d6b7c5 5017
116c423c 5018 This function reads at most 4096 characters.
d0d6b7c5 5019 If you want to read all available subprocess output,
0fa1789e
KH
5020 you must call it repeatedly until it returns zero.
5021
5022 The characters read are decoded according to PROC's coding-system
5023 for decoding. */
d0d6b7c5 5024
ff6daed3 5025static int
d3da34e0 5026read_process_output (Lisp_Object proc, register int channel)
d0d6b7c5 5027{
368f4090 5028 register ssize_t nbytes;
d0d6b7c5 5029 char *chars;
d0d6b7c5 5030 register Lisp_Object outstream;
d0d6b7c5 5031 register struct Lisp_Process *p = XPROCESS (proc);
f877c546 5032 register EMACS_INT opoint;
c7580538 5033 struct coding_system *coding = proc_decode_coding_system[channel];
60f0fb11 5034 int carryover = p->decoding_carryover;
116c423c 5035 int readmax = 4096;
3a4fa2f2
SM
5036 int count = SPECPDL_INDEX ();
5037 Lisp_Object odeactivate;
d0d6b7c5 5038
e690ca94 5039 chars = (char *) alloca (carryover + readmax);
e7fbaa65
KH
5040 if (carryover)
5041 /* See the comment above. */
72af86bd 5042 memcpy (chars, SDATA (p->decoding_buf), carryover);
0fa1789e 5043
e690ca94
KS
5044#ifdef DATAGRAM_SOCKETS
5045 /* We have a working select, so proc_buffered_char is always -1. */
5046 if (DATAGRAM_CHAN_P (channel))
5047 {
401bf9b4 5048 socklen_t len = datagram_address[channel].len;
39b1da20 5049 nbytes = recvfrom (channel, chars + carryover, readmax,
e690ca94
KS
5050 0, datagram_address[channel].sa, &len);
5051 }
5052 else
5053#endif
6b61353c 5054 {
82eaa333
PE
5055 int buffered = 0 <= proc_buffered_char[channel];
5056 if (buffered)
5057 {
5058 chars[carryover] = proc_buffered_char[channel];
5059 proc_buffered_char[channel] = -1;
5060 }
8af55556 5061#ifdef HAVE_GNUTLS
df7fcaff 5062 if (XPROCESS (proc)->gnutls_p)
e968f4f3 5063 nbytes = emacs_gnutls_read (XPROCESS (proc),
82eaa333
PE
5064 chars + carryover + buffered,
5065 readmax - buffered);
8af55556
TZ
5066 else
5067#endif
82eaa333
PE
5068 nbytes = emacs_read (channel, chars + carryover + buffered,
5069 readmax - buffered);
6b61353c 5070#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11 5071 if (nbytes > 0 && p->adaptive_read_buffering)
6b61353c 5072 {
60f0fb11 5073 int delay = p->read_output_delay;
6b61353c
KH
5074 if (nbytes < 256)
5075 {
5076 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5077 {
5078 if (delay == 0)
5079 process_output_delay_count++;
5080 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5081 }
5082 }
82eaa333 5083 else if (delay > 0 && nbytes == readmax - buffered)
6b61353c
KH
5084 {
5085 delay -= READ_OUTPUT_DELAY_INCREMENT;
5086 if (delay == 0)
5087 process_output_delay_count--;
5088 }
60f0fb11 5089 p->read_output_delay = delay;
6b61353c
KH
5090 if (delay)
5091 {
60f0fb11 5092 p->read_output_skip = 1;
6b61353c
KH
5093 process_output_skip = 1;
5094 }
5095 }
5096#endif
fe07cdfa
PE
5097 nbytes += buffered;
5098 nbytes += buffered && nbytes <= 0;
d0d6b7c5 5099 }
d0d6b7c5 5100
60f0fb11 5101 p->decoding_carryover = 0;
ca65341e 5102
ed7a4b2d 5103 /* At this point, NBYTES holds number of bytes just received
0fa1789e 5104 (including the one in proc_buffered_char[channel]). */
de7fbd09
KH
5105 if (nbytes <= 0)
5106 {
5107 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5108 return nbytes;
5109 coding->mode |= CODING_MODE_LAST_BLOCK;
5110 }
d0d6b7c5 5111
1d2fc612 5112 /* Now set NBYTES how many bytes we must decode. */
e7fbaa65 5113 nbytes += carryover;
0fa1789e 5114
3a4fa2f2
SM
5115 odeactivate = Vdeactivate_mark;
5116 /* There's no good reason to let process filters change the current
5117 buffer, and many callers of accept-process-output, sit-for, and
5118 friends don't expect current-buffer to be changed from under them. */
d2630aef 5119 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
3a4fa2f2 5120
1d2fc612 5121 /* Read and dispose of the process output. */
d0d6b7c5
JB
5122 outstream = p->filter;
5123 if (!NILP (outstream))
5124 {
1d2fc612 5125 Lisp_Object text;
4da2f5be 5126 int outer_running_asynch_code = running_asynch_code;
bbce7d72 5127 int waiting = waiting_for_user_input_p;
30c78175 5128
dfc21838
RS
5129 /* No need to gcpro these, because all we do with them later
5130 is test them for EQness, and none of them should be a string. */
aba7731a
PE
5131#if 0
5132 Lisp_Object obuffer, okeymap;
dfc21838 5133 XSETBUFFER (obuffer, current_buffer);
4b4deea2 5134 okeymap = BVAR (current_buffer, keymap);
aba7731a 5135#endif
30c78175 5136
3a4fa2f2
SM
5137 /* We inhibit quit here instead of just catching it so that
5138 hitting ^G when a filter happens to be running won't screw
5139 it up. */
d0d6b7c5 5140 specbind (Qinhibit_quit, Qt);
6545aada 5141 specbind (Qlast_nonmenu_event, Qt);
3b9a3dfa 5142
4da2f5be
RS
5143 /* In case we get recursively called,
5144 and we already saved the match data nonrecursively,
5145 save the same match data in safely recursive fashion. */
5146 if (outer_running_asynch_code)
5147 {
5148 Lisp_Object tem;
5149 /* Don't clobber the CURRENT match data, either! */
89f2614d
KS
5150 tem = Fmatch_data (Qnil, Qnil, Qnil);
5151 restore_search_regs ();
5152 record_unwind_save_match_data ();
5153 Fset_match_data (tem, Qt);
4da2f5be
RS
5154 }
5155
5156 /* For speed, if a search happens within this code,
5157 save the match data in a special nonrecursive fashion. */
7074fde6 5158 running_asynch_code = 1;
4da2f5be 5159
400a67ff 5160 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5bbf78c1 5161 text = coding->dst_object;
5bbf78c1 5162 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
ed7a4b2d 5163 /* A new coding system might be found. */
5bbf78c1 5164 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
ed7a4b2d 5165 {
5bbf78c1 5166 p->decode_coding_system = Vlast_coding_system_used;
ed7a4b2d
KH
5167
5168 /* Don't call setup_coding_system for
5169 proc_decode_coding_system[channel] here. It is done in
5170 detect_coding called via decode_coding above. */
5171
5172 /* If a coding system for encoding is not yet decided, we set
5173 it as the same as coding-system for decoding.
5174
5175 But, before doing that we must check if
5176 proc_encode_coding_system[p->outfd] surely points to a
5177 valid memory because p->outfd will be changed once EOF is
5178 sent to the process. */
5179 if (NILP (p->encode_coding_system)
60f0fb11 5180 && proc_encode_coding_system[p->outfd])
ed7a4b2d 5181 {
76d812bb
KH
5182 p->encode_coding_system
5183 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5bbf78c1 5184 setup_coding_system (p->encode_coding_system,
60f0fb11 5185 proc_encode_coding_system[p->outfd]);
ed7a4b2d
KH
5186 }
5187 }
51c6067d 5188
dd8c7a53
KH
5189 if (coding->carryover_bytes > 0)
5190 {
04961398
KH
5191 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5192 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
72af86bd
AS
5193 memcpy (SDATA (p->decoding_buf), coding->carryover,
5194 coding->carryover_bytes);
8c406a9b 5195 p->decoding_carryover = coding->carryover_bytes;
dd8c7a53 5196 }
e430e5ba 5197 if (SBYTES (text) > 0)
963b492b
SM
5198 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5199 sometimes it's simply wrong to wrap (e.g. when called from
5200 accept-process-output). */
dd97db06
KH
5201 internal_condition_case_1 (read_process_output_call,
5202 Fcons (outstream,
5203 Fcons (proc, Fcons (text, Qnil))),
5204 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5205 read_process_output_error_handler);
4da2f5be
RS
5206
5207 /* If we saved the match data nonrecursively, restore it now. */
89f2614d 5208 restore_search_regs ();
4da2f5be 5209 running_asynch_code = outer_running_asynch_code;
d0d6b7c5 5210
bbce7d72
RS
5211 /* Restore waiting_for_user_input_p as it was
5212 when we were called, in case the filter clobbered it. */
5213 waiting_for_user_input_p = waiting;
5214
7973cfa8
RS
5215#if 0 /* Call record_asynch_buffer_change unconditionally,
5216 because we might have changed minor modes or other things
5217 that affect key bindings. */
dfc21838
RS
5218 if (! EQ (Fcurrent_buffer (), obuffer)
5219 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 5220#endif
927e08be
RS
5221 /* But do it only if the caller is actually going to read events.
5222 Otherwise there's no need to make him wake up, and it could
7157b8fe 5223 cause trouble (for example it would make sit_for return). */
927e08be
RS
5224 if (waiting_for_user_input_p == -1)
5225 record_asynch_buffer_change ();
d0d6b7c5
JB
5226 }
5227
5228 /* If no filter, write into buffer if it isn't dead. */
4b4deea2 5229 else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name)))
d0d6b7c5 5230 {
b0310da4 5231 Lisp_Object old_read_only;
f877c546
EZ
5232 EMACS_INT old_begv, old_zv;
5233 EMACS_INT old_begv_byte, old_zv_byte;
5234 EMACS_INT before, before_byte;
5235 EMACS_INT opoint_byte;
ed7a4b2d 5236 Lisp_Object text;
926b7e5e 5237 struct buffer *b;
30c78175 5238
d0d6b7c5 5239 Fset_buffer (p->buffer);
6ec8bbd2 5240 opoint = PT;
d8a2934e 5241 opoint_byte = PT_BYTE;
4b4deea2 5242 old_read_only = BVAR (current_buffer, read_only);
12ca5cdf
RS
5243 old_begv = BEGV;
5244 old_zv = ZV;
d8a2934e
RS
5245 old_begv_byte = BEGV_BYTE;
5246 old_zv_byte = ZV_BYTE;
b0310da4 5247
4b4deea2 5248 BVAR (current_buffer, read_only) = Qnil;
d0d6b7c5
JB
5249
5250 /* Insert new output into buffer
5251 at the current end-of-output marker,
5252 thus preserving logical ordering of input and output. */
5253 if (XMARKER (p->mark)->buffer)
d8a2934e
RS
5254 SET_PT_BOTH (clip_to_bounds (BEGV, marker_position (p->mark), ZV),
5255 clip_to_bounds (BEGV_BYTE, marker_byte_position (p->mark),
5256 ZV_BYTE));
d0d6b7c5 5257 else
d8a2934e 5258 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf 5259 before = PT;
d8a2934e 5260 before_byte = PT_BYTE;
b0310da4
JB
5261
5262 /* If the output marker is outside of the visible region, save
5263 the restriction and widen. */
6ec8bbd2 5264 if (! (BEGV <= PT && PT <= ZV))
b0310da4
JB
5265 Fwiden ();
5266
400a67ff 5267 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5bbf78c1
KH
5268 text = coding->dst_object;
5269 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
ed7a4b2d
KH
5270 /* A new coding system might be found. See the comment in the
5271 similar code in the previous `if' block. */
5bbf78c1 5272 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
ed7a4b2d 5273 {
5bbf78c1 5274 p->decode_coding_system = Vlast_coding_system_used;
ed7a4b2d 5275 if (NILP (p->encode_coding_system)
60f0fb11 5276 && proc_encode_coding_system[p->outfd])
ed7a4b2d 5277 {
76d812bb
KH
5278 p->encode_coding_system
5279 = coding_inherit_eol_type (Vlast_coding_system_used, Qnil);
5bbf78c1 5280 setup_coding_system (p->encode_coding_system,
60f0fb11 5281 proc_encode_coding_system[p->outfd]);
ed7a4b2d
KH
5282 }
5283 }
dd8c7a53
KH
5284 if (coding->carryover_bytes > 0)
5285 {
04961398
KH
5286 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5287 p->decoding_buf = make_uninit_string (coding->carryover_bytes);
72af86bd
AS
5288 memcpy (SDATA (p->decoding_buf), coding->carryover,
5289 coding->carryover_bytes);
8c406a9b 5290 p->decoding_carryover = coding->carryover_bytes;
dd8c7a53 5291 }
d69864bf 5292 /* Adjust the multibyteness of TEXT to that of the buffer. */
4b4deea2 5293 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
d69864bf
KH
5294 != ! STRING_MULTIBYTE (text))
5295 text = (STRING_MULTIBYTE (text)
57bb5c37 5296 ? Fstring_as_unibyte (text)
03f04413 5297 : Fstring_to_multibyte (text));
57bb5c37
KH
5298 /* Insert before markers in case we are inserting where
5299 the buffer's mark is, and the user's next command is Meta-y. */
e430e5ba
KH
5300 insert_from_string_before_markers (text, 0, 0,
5301 SCHARS (text), SBYTES (text), 0);
0d023da1 5302
926b7e5e
GM
5303 /* Make sure the process marker's position is valid when the
5304 process buffer is changed in the signal_after_change above.
5305 W3 is known to do that. */
5306 if (BUFFERP (p->buffer)
5307 && (b = XBUFFER (p->buffer), b != current_buffer))
5308 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
5309 else
5310 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
b0310da4 5311
d0d6b7c5
JB
5312 update_mode_lines++;
5313
12ca5cdf
RS
5314 /* Make sure opoint and the old restrictions
5315 float ahead of any new text just as point would. */
5316 if (opoint >= before)
d8a2934e
RS
5317 {
5318 opoint += PT - before;
5319 opoint_byte += PT_BYTE - before_byte;
5320 }
12ca5cdf 5321 if (old_begv > before)
d8a2934e
RS
5322 {
5323 old_begv += PT - before;
5324 old_begv_byte += PT_BYTE - before_byte;
5325 }
12ca5cdf 5326 if (old_zv >= before)
d8a2934e
RS
5327 {
5328 old_zv += PT - before;
5329 old_zv_byte += PT_BYTE - before_byte;
5330 }
12ca5cdf 5331
b0310da4 5332 /* If the restriction isn't what it should be, set it. */
12ca5cdf
RS
5333 if (old_begv != BEGV || old_zv != ZV)
5334 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
b0310da4 5335
30c78175 5336
4b4deea2 5337 BVAR (current_buffer, read_only) = old_read_only;
d8a2934e 5338 SET_PT_BOTH (opoint, opoint_byte);
d0d6b7c5 5339 }
3a4fa2f2
SM
5340 /* Handling the process output should not deactivate the mark. */
5341 Vdeactivate_mark = odeactivate;
5342
5343 unbind_to (count, Qnil);
1d2fc612 5344 return nbytes;
d0d6b7c5 5345}
d0d6b7c5
JB
5346\f
5347/* Sending data to subprocess */
5348
40ccffa6
PE
5349static jmp_buf send_process_frame;
5350static Lisp_Object process_sent_to;
d0d6b7c5 5351
006c5daa
PE
5352#ifndef FORWARD_SIGNAL_TO_MAIN_THREAD
5353static void send_process_trap (int) NO_RETURN;
5354#endif
5355
9af30bdf 5356static void
d3da34e0 5357send_process_trap (int ignore)
d0d6b7c5 5358{
333f1b6f 5359 SIGNAL_THREAD_CHECK (SIGPIPE);
c8f44005 5360 sigunblock (sigmask (SIGPIPE));
d0d6b7c5
JB
5361 longjmp (send_process_frame, 1);
5362}
5363
4556b700
RS
5364/* Send some data to process PROC.
5365 BUF is the beginning of the data; LEN is the number of characters.
a92e4183
KH
5366 OBJECT is the Lisp object that the data comes from. If OBJECT is
5367 nil or t, it means that the data comes from C string.
0fa1789e 5368
a92e4183
KH
5369 If OBJECT is not nil, the data is encoded by PROC's coding-system
5370 for encoding before it is sent.
1fb0098c
GM
5371
5372 This function can evaluate Lisp code and can garbage collect. */
4556b700 5373
ff6daed3 5374static void
400a67ff 5375send_process (volatile Lisp_Object proc, const char *volatile buf,
f877c546 5376 volatile EMACS_INT len, volatile Lisp_Object object)
d0d6b7c5 5377{
ecd1f654 5378 /* Use volatile to protect variables from being clobbered by longjmp. */
6b61353c 5379 struct Lisp_Process *p = XPROCESS (proc);
368f4090 5380 ssize_t rv;
0fa1789e 5381 struct coding_system *coding;
347f3cd3 5382 struct gcpro gcpro1;
9af30bdf 5383 void (*volatile old_sigpipe) (int);
6044e593 5384
347f3cd3 5385 GCPRO1 (object);
d0d6b7c5 5386
6bfd98e7 5387 if (p->raw_status_new)
6b61353c
KH
5388 update_status (p);
5389 if (! EQ (p->status, Qrun))
5390 error ("Process %s not running", SDATA (p->name));
60f0fb11 5391 if (p->outfd < 0)
6b61353c 5392 error ("Output file descriptor of %s is closed", SDATA (p->name));
0fa1789e 5393
60f0fb11 5394 coding = proc_encode_coding_system[p->outfd];
5bbf78c1 5395 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
486b111b 5396
ed7a4b2d
KH
5397 if ((STRINGP (object) && STRING_MULTIBYTE (object))
5398 || (BUFFERP (object)
4b4deea2 5399 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
a92e4183 5400 || EQ (object, Qt))
278bfdd6 5401 {
fcaf8878
KH
5402 p->encode_coding_system
5403 = complement_process_encoding_system (p->encode_coding_system);
6b61353c 5404 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
fcaf8878
KH
5405 {
5406 /* The coding system for encoding was changed to raw-text
5407 because we sent a unibyte text previously. Now we are
5408 sending a multibyte text, thus we must encode it by the
5409 original coding system specified for the current process.
5410
da6062e6
PE
5411 Another reason we come here is that the coding system
5412 was just complemented and a new one was returned by
fcaf8878
KH
5413 complement_process_encoding_system. */
5414 setup_coding_system (p->encode_coding_system, coding);
5415 Vlast_coding_system_used = p->encode_coding_system;
5416 }
e08bbb84 5417 coding->src_multibyte = 1;
278bfdd6
KH
5418 }
5419 else
5420 {
a0241d01 5421 coding->src_multibyte = 0;
a92e4183
KH
5422 /* For sending a unibyte text, character code conversion should
5423 not take place but EOL conversion should. So, setup raw-text
5424 or one of the subsidiary if we have not yet done it. */
5bbf78c1 5425 if (CODING_REQUIRE_ENCODING (coding))
a92e4183
KH
5426 {
5427 if (CODING_REQUIRE_FLUSHING (coding))
5428 {
5429 /* But, before changing the coding, we must flush out data. */
5430 coding->mode |= CODING_MODE_LAST_BLOCK;
5431 send_process (proc, "", 0, Qt);
8f924df7 5432 coding->mode &= CODING_MODE_LAST_BLOCK;
a92e4183 5433 }
5bbf78c1
KH
5434 setup_coding_system (raw_text_coding_system
5435 (Vlast_coding_system_used),
5436 coding);
e08bbb84 5437 coding->src_multibyte = 0;
a92e4183 5438 }
278bfdd6 5439 }
a4a37e65
KH
5440 coding->dst_multibyte = 0;
5441
ed7a4b2d 5442 if (CODING_REQUIRE_ENCODING (coding))
0fa1789e 5443 {
5bbf78c1 5444 coding->dst_object = Qt;
ed7a4b2d 5445 if (BUFFERP (object))
0fa1789e 5446 {
f877c546
EZ
5447 EMACS_INT from_byte, from, to;
5448 EMACS_INT save_pt, save_pt_byte;
5bbf78c1
KH
5449 struct buffer *cur = current_buffer;
5450
5451 set_buffer_internal (XBUFFER (object));
5452 save_pt = PT, save_pt_byte = PT_BYTE;
5453
400a67ff 5454 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
5bbf78c1
KH
5455 from = BYTE_TO_CHAR (from_byte);
5456 to = BYTE_TO_CHAR (from_byte + len);
5457 TEMP_SET_PT_BOTH (from, from_byte);
5458 encode_coding_object (coding, object, from, from_byte,
5459 to, from_byte + len, Qt);
5460 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
5461 set_buffer_internal (cur);
ed7a4b2d
KH
5462 }
5463 else if (STRINGP (object))
5464 {
550c8289
KH
5465 encode_coding_object (coding, object, 0, 0, SCHARS (object),
5466 SBYTES (object), Qt);
0fa1789e 5467 }
5bbf78c1 5468 else
452294c2 5469 {
5bbf78c1
KH
5470 coding->dst_object = make_unibyte_string (buf, len);
5471 coding->produced = len;
452294c2 5472 }
ed7a4b2d 5473
e7fbaa65 5474 len = coding->produced;
347f3cd3 5475 object = coding->dst_object;
400a67ff 5476 buf = SSDATA (object);
0fa1789e 5477 }
d0d6b7c5 5478
4556b700
RS
5479 if (pty_max_bytes == 0)
5480 {
5481#if defined (HAVE_FPATHCONF) && defined (_PC_MAX_CANON)
60f0fb11 5482 pty_max_bytes = fpathconf (p->outfd, _PC_MAX_CANON);
4556b700
RS
5483 if (pty_max_bytes < 0)
5484 pty_max_bytes = 250;
5485#else
5486 pty_max_bytes = 250;
5487#endif
5488 /* Deduct one, to leave space for the eof. */
5489 pty_max_bytes--;
5490 }
5491
0daad115
GM
5492 /* 2000-09-21: Emacs 20.7, sparc-sun-solaris-2.6, GCC 2.95.2,
5493 CFLAGS="-g -O": The value of the parameter `proc' is clobbered
5494 when returning with longjmp despite being declared volatile. */
d0d6b7c5 5495 if (!setjmp (send_process_frame))
0daad115 5496 {
006c5daa
PE
5497 p = XPROCESS (proc); /* Repair any setjmp clobbering. */
5498
0daad115
GM
5499 process_sent_to = proc;
5500 while (len > 0)
5501 {
f877c546 5502 EMACS_INT this = len;
93b4f699 5503
0daad115
GM
5504 /* Send this batch, using one or more write calls. */
5505 while (this > 0)
5506 {
85de1881 5507 EMACS_INT written = 0;
60f0fb11 5508 int outfd = p->outfd;
9af30bdf 5509 old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
e690ca94
KS
5510#ifdef DATAGRAM_SOCKETS
5511 if (DATAGRAM_CHAN_P (outfd))
5512 {
400a67ff 5513 rv = sendto (outfd, buf, this,
e690ca94
KS
5514 0, datagram_address[outfd].sa,
5515 datagram_address[outfd].len);
273a5f82
PE
5516 if (0 <= rv)
5517 written = rv;
5518 else if (errno == EMSGSIZE)
c8f44005
RS
5519 {
5520 signal (SIGPIPE, old_sigpipe);
5521 report_file_error ("sending datagram",
5522 Fcons (proc, Qnil));
5523 }
e690ca94
KS
5524 }
5525 else
5526#endif
6b61353c 5527 {
8af55556 5528#ifdef HAVE_GNUTLS
df7fcaff 5529 if (XPROCESS (proc)->gnutls_p)
e968f4f3
JB
5530 written = emacs_gnutls_write (XPROCESS (proc),
5531 buf, this);
8af55556
TZ
5532 else
5533#endif
273a5f82 5534 written = emacs_write (outfd, buf, this);
086e8c47 5535 rv = (written ? 0 : -1);
6b61353c 5536#ifdef ADAPTIVE_READ_BUFFERING
60f0fb11
SM
5537 if (p->read_output_delay > 0
5538 && p->adaptive_read_buffering == 1)
6b61353c 5539 {
60f0fb11 5540 p->read_output_delay = 0;
6b61353c 5541 process_output_delay_count--;
60f0fb11 5542 p->read_output_skip = 0;
6b61353c
KH
5543 }
5544#endif
5545 }
0daad115 5546 signal (SIGPIPE, old_sigpipe);
4556b700 5547
0daad115
GM
5548 if (rv < 0)
5549 {
5550 if (0
d0d6b7c5 5551#ifdef EWOULDBLOCK
0daad115 5552 || errno == EWOULDBLOCK
d0d6b7c5
JB
5553#endif
5554#ifdef EAGAIN
0daad115 5555 || errno == EAGAIN
d0d6b7c5 5556#endif
0daad115 5557 )
177c0ea7 5558 /* Buffer is full. Wait, accepting input;
0daad115
GM
5559 that may allow the program
5560 to finish doing output and read more. */
5561 {
3d6c2543 5562 EMACS_INT offset = 0;
4556b700 5563
3433b6bd 5564#ifdef BROKEN_PTY_READ_AFTER_EAGAIN
0daad115
GM
5565 /* A gross hack to work around a bug in FreeBSD.
5566 In the following sequence, read(2) returns
5567 bogus data:
5568
5569 write(2) 1022 bytes
5570 write(2) 954 bytes, get EAGAIN
5571 read(2) 1024 bytes in process_read_output
5572 read(2) 11 bytes in process_read_output
5573
5574 That is, read(2) returns more bytes than have
5575 ever been written successfully. The 1033 bytes
5576 read are the 1022 bytes written successfully
5577 after processing (for example with CRs added if
5578 the terminal is set up that way which it is
5579 here). The same bytes will be seen again in a
5580 later read(2), without the CRs. */
177c0ea7 5581
0daad115
GM
5582 if (errno == EAGAIN)
5583 {
5584 int flags = FWRITE;
60f0fb11 5585 ioctl (p->outfd, TIOCFLUSH, &flags);
0daad115 5586 }
3433b6bd 5587#endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
177c0ea7 5588
0daad115
GM
5589 /* Running filters might relocate buffers or strings.
5590 Arrange to relocate BUF. */
347f3cd3 5591 if (BUFFERP (object))
400a67ff
PE
5592 offset = BUF_PTR_BYTE_POS (XBUFFER (object),
5593 (unsigned char *) buf);
0daad115 5594 else if (STRINGP (object))
400a67ff 5595 offset = buf - SSDATA (object);
0daad115 5596
f3e6605c 5597#ifdef EMACS_HAS_USECS
214d6069 5598 wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
f3e6605c 5599#else
214d6069 5600 wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
f3e6605c 5601#endif
4556b700 5602
347f3cd3 5603 if (BUFFERP (object))
400a67ff
PE
5604 buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
5605 offset);
0daad115 5606 else if (STRINGP (object))
400a67ff 5607 buf = offset + SSDATA (object);
0daad115
GM
5608 }
5609 else
5610 /* This is a real error. */
5611 report_file_error ("writing to process", Fcons (proc, Qnil));
5612 }
273a5f82
PE
5613 buf += written;
5614 len -= written;
5615 this -= written;
0daad115 5616 }
0daad115
GM
5617 }
5618 }
d0d6b7c5
JB
5619 else
5620 {
0ff69270 5621 signal (SIGPIPE, old_sigpipe);
0daad115 5622 proc = process_sent_to;
6b61353c 5623 p = XPROCESS (proc);
6bfd98e7 5624 p->raw_status_new = 0;
6b61353c 5625 p->status = Fcons (Qexit, Fcons (make_number (256), Qnil));
60f0fb11 5626 p->tick = ++process_tick;
d0d6b7c5 5627 deactivate_process (proc);
6b61353c 5628 error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
d0d6b7c5 5629 }
6044e593
RS
5630
5631 UNGCPRO;
d0d6b7c5
JB
5632}
5633
5634DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
fdb82f93
PJ
5635 3, 3, 0,
5636 doc: /* Send current contents of region as input to PROCESS.
5637PROCESS may be a process, a buffer, the name of a process or buffer, or
5638nil, indicating the current buffer's process.
5639Called from program, takes three arguments, PROCESS, START and END.
5640If the region is more than 500 characters long,
5641it is sent in several bunches. This may happen even for shorter regions.
5642Output from processes can arrive in between bunches. */)
5842a27b 5643 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
d0d6b7c5
JB
5644{
5645 Lisp_Object proc;
f877c546 5646 EMACS_INT start1, end1;
d0d6b7c5
JB
5647
5648 proc = get_process (process);
5649 validate_region (&start, &end);
1b234f64
KH
5650
5651 if (XINT (start) < GPT && XINT (end) > GPT)
5652 move_gap (XINT (start));
5653
5654 start1 = CHAR_TO_BYTE (XINT (start));
5655 end1 = CHAR_TO_BYTE (XINT (end));
400a67ff 5656 send_process (proc, (char *) BYTE_POS_ADDR (start1), end1 - start1,
1b234f64
KH
5657 Fcurrent_buffer ());
5658
d0d6b7c5
JB
5659 return Qnil;
5660}
5661
5662DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
fdb82f93
PJ
5663 2, 2, 0,
5664 doc: /* Send PROCESS the contents of STRING as input.
5665PROCESS may be a process, a buffer, the name of a process or buffer, or
5666nil, indicating the current buffer's process.
5667If STRING is more than 500 characters long,
5668it is sent in several bunches. This may happen even for shorter strings.
5669Output from processes can arrive in between bunches. */)
5842a27b 5670 (Lisp_Object process, Lisp_Object string)
d0d6b7c5
JB
5671{
5672 Lisp_Object proc;
b7826503 5673 CHECK_STRING (string);
d0d6b7c5 5674 proc = get_process (process);
400a67ff 5675 send_process (proc, SSDATA (string),
1b234f64 5676 SBYTES (string), string);
d0d6b7c5
JB
5677 return Qnil;
5678}
5679\f
16782258
JD
5680/* Return the foreground process group for the tty/pty that
5681 the process P uses. */
5682static int
d3da34e0 5683emacs_get_tty_pgrp (struct Lisp_Process *p)
16782258
JD
5684{
5685 int gid = -1;
5686
f3d9532b 5687#ifdef TIOCGPGRP
60f0fb11 5688 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
16782258
JD
5689 {
5690 int fd;
5691 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
5692 master side. Try the slave side. */
42a5b22f 5693 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
16782258
JD
5694
5695 if (fd != -1)
5696 {
5697 ioctl (fd, TIOCGPGRP, &gid);
5698 emacs_close (fd);
5699 }
5700 }
5701#endif /* defined (TIOCGPGRP ) */
5702
5703 return gid;
5704}
5705
b81ea5ef
RS
5706DEFUN ("process-running-child-p", Fprocess_running_child_p,
5707 Sprocess_running_child_p, 0, 1, 0,
fdb82f93
PJ
5708 doc: /* Return t if PROCESS has given the terminal to a child.
5709If the operating system does not make it possible to find out,
5710return t unconditionally. */)
5842a27b 5711 (Lisp_Object process)
b81ea5ef
RS
5712{
5713 /* Initialize in case ioctl doesn't exist or gives an error,
5714 in a way that will cause returning t. */
16782258 5715 int gid;
b81ea5ef
RS
5716 Lisp_Object proc;
5717 struct Lisp_Process *p;
5718
5719 proc = get_process (process);
5720 p = XPROCESS (proc);
5721
d888760c 5722 if (!EQ (p->type, Qreal))
b81ea5ef 5723 error ("Process %s is not a subprocess",
d5db4077 5724 SDATA (p->name));
60f0fb11 5725 if (p->infd < 0)
b81ea5ef 5726 error ("Process %s is not active",
d5db4077 5727 SDATA (p->name));
b81ea5ef 5728
16782258 5729 gid = emacs_get_tty_pgrp (p);
b81ea5ef 5730
6bfd98e7 5731 if (gid == p->pid)
b81ea5ef
RS
5732 return Qnil;
5733 return Qt;
5734}
5735\f
d0d6b7c5 5736/* send a signal number SIGNO to PROCESS.
b81ea5ef
RS
5737 If CURRENT_GROUP is t, that means send to the process group
5738 that currently owns the terminal being used to communicate with PROCESS.
d0d6b7c5 5739 This is used for various commands in shell mode.
b81ea5ef
RS
5740 If CURRENT_GROUP is lambda, that means send to the process group
5741 that currently owns the terminal, but only if it is NOT the shell itself.
5742
d0d6b7c5 5743 If NOMSG is zero, insert signal-announcements into process's buffers
b0310da4
JB
5744 right away.
5745
5746 If we can, we try to signal PROCESS by sending control characters
e333e864 5747 down the pty. This allows us to signal inferiors who have changed
b0310da4 5748 their uid, for which killpg would return an EPERM error. */
d0d6b7c5 5749
f9738840 5750static void
d3da34e0
JB
5751process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
5752 int nomsg)
d0d6b7c5
JB
5753{
5754 Lisp_Object proc;
5755 register struct Lisp_Process *p;
5756 int gid;
5757 int no_pgrp = 0;
5758
5759 proc = get_process (process);
5760 p = XPROCESS (proc);
5761
d888760c 5762 if (!EQ (p->type, Qreal))
d0d6b7c5 5763 error ("Process %s is not a subprocess",
d5db4077 5764 SDATA (p->name));
60f0fb11 5765 if (p->infd < 0)
d0d6b7c5 5766 error ("Process %s is not active",
d5db4077 5767 SDATA (p->name));
d0d6b7c5 5768
60f0fb11 5769 if (!p->pty_flag)
d0d6b7c5
JB
5770 current_group = Qnil;
5771
d0d6b7c5 5772 /* If we are using pgrps, get a pgrp number and make it negative. */
2af70a0c
RS
5773 if (NILP (current_group))
5774 /* Send the signal to the shell's process group. */
6bfd98e7 5775 gid = p->pid;
2af70a0c 5776 else
d0d6b7c5 5777 {
b0310da4 5778#ifdef SIGNALS_VIA_CHARACTERS
d0d6b7c5
JB
5779 /* If possible, send signals to the entire pgrp
5780 by sending an input character to it. */
b0310da4 5781
6be429b1 5782 struct termios t;
7f916a36
RS
5783 cc_t *sig_char = NULL;
5784
60f0fb11 5785 tcgetattr (p->infd, &t);
6be429b1
JB
5786
5787 switch (signo)
5788 {
5789 case SIGINT:
7f916a36
RS
5790 sig_char = &t.c_cc[VINTR];
5791 break;
6be429b1
JB
5792
5793 case SIGQUIT:
7f916a36
RS
5794 sig_char = &t.c_cc[VQUIT];
5795 break;
6be429b1
JB
5796
5797 case SIGTSTP:
d0adf46f 5798#if defined (VSWTCH) && !defined (PREFER_VSUSP)
7f916a36 5799 sig_char = &t.c_cc[VSWTCH];
6be429b1 5800#else
7f916a36 5801 sig_char = &t.c_cc[VSUSP];
6be429b1 5802#endif
7f916a36 5803 break;
6be429b1
JB
5804 }
5805
ca4313d5 5806 if (sig_char && *sig_char != CDISABLE)
f1c206fc 5807 {
f990b4e5 5808 send_process (proc, (char *) sig_char, 1, Qnil);
f1c206fc
RS
5809 return;
5810 }
5811 /* If we can't send the signal with a character,
5812 fall through and send it another way. */
f1c206fc
RS
5813
5814 /* The code above may fall through if it can't
5815 handle the signal. */
20505336 5816#endif /* defined (SIGNALS_VIA_CHARACTERS) */
d0d6b7c5 5817
177c0ea7 5818#ifdef TIOCGPGRP
2af70a0c 5819 /* Get the current pgrp using the tty itself, if we have that.
d0d6b7c5
JB
5820 Otherwise, use the pty to get the pgrp.
5821 On pfa systems, saka@pfu.fujitsu.co.JP writes:
b0310da4
JB
5822 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
5823 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
d0d6b7c5
JB
5824 His patch indicates that if TIOCGPGRP returns an error, then
5825 we should just assume that p->pid is also the process group id. */
d0d6b7c5 5826
16782258 5827 gid = emacs_get_tty_pgrp (p);
f3d9532b 5828
16782258
JD
5829 if (gid == -1)
5830 /* If we can't get the information, assume
5831 the shell owns the tty. */
6bfd98e7 5832 gid = p->pid;
2af70a0c
RS
5833
5834 /* It is not clear whether anything really can set GID to -1.
5835 Perhaps on some system one of those ioctls can or could do so.
5836 Or perhaps this is vestigial. */
d0d6b7c5
JB
5837 if (gid == -1)
5838 no_pgrp = 1;
b0310da4 5839#else /* ! defined (TIOCGPGRP ) */
301c3fe4
JB
5840 /* Can't select pgrps on this system, so we know that
5841 the child itself heads the pgrp. */
6bfd98e7 5842 gid = p->pid;
301c3fe4 5843#endif /* ! defined (TIOCGPGRP ) */
b81ea5ef
RS
5844
5845 /* If current_group is lambda, and the shell owns the terminal,
5846 don't send any signal. */
6bfd98e7 5847 if (EQ (current_group, Qlambda) && gid == p->pid)
b81ea5ef 5848 return;
d0d6b7c5 5849 }
d0d6b7c5
JB
5850
5851 switch (signo)
5852 {
5853#ifdef SIGCONT
5854 case SIGCONT:
6bfd98e7 5855 p->raw_status_new = 0;
d0d6b7c5 5856 p->status = Qrun;
60f0fb11 5857 p->tick = ++process_tick;
d0d6b7c5 5858 if (!nomsg)
e42bdf01
CY
5859 {
5860 status_notify (NULL);
5861 redisplay_preserve_echo_area (13);
5862 }
d0d6b7c5 5863 break;
301c3fe4 5864#endif /* ! defined (SIGCONT) */
d0d6b7c5 5865 case SIGINT:
d0d6b7c5 5866 case SIGQUIT:
d0d6b7c5 5867 case SIGKILL:
60f0fb11 5868 flush_pending_output (p->infd);
d0d6b7c5
JB
5869 break;
5870 }
5871
5872 /* If we don't have process groups, send the signal to the immediate
5873 subprocess. That isn't really right, but it's better than any
5874 obvious alternative. */
5875 if (no_pgrp)
5876 {
6bfd98e7 5877 kill (p->pid, signo);
d0d6b7c5
JB
5878 return;
5879 }
5880
5881 /* gid may be a pid, or minus a pgrp's number */
5882#ifdef TIOCSIGSEND
5883 if (!NILP (current_group))
16782258 5884 {
60f0fb11 5885 if (ioctl (p->infd, TIOCSIGSEND, signo) == -1)
16782258
JD
5886 EMACS_KILLPG (gid, signo);
5887 }
d0d6b7c5
JB
5888 else
5889 {
6bfd98e7 5890 gid = - p->pid;
d0d6b7c5
JB
5891 kill (gid, signo);
5892 }
301c3fe4 5893#else /* ! defined (TIOCSIGSEND) */
2af70a0c 5894 EMACS_KILLPG (gid, signo);
301c3fe4 5895#endif /* ! defined (TIOCSIGSEND) */
d0d6b7c5
JB
5896}
5897
5898DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
fdb82f93
PJ
5899 doc: /* Interrupt process PROCESS.
5900PROCESS may be a process, a buffer, or the name of a process or buffer.
f3d9532b 5901No arg or nil means current buffer's process.
fdb82f93
PJ
5902Second arg CURRENT-GROUP non-nil means send signal to
5903the current process-group of the process's controlling terminal
5904rather than to the process's own process group.
5905If the process is a shell, this means interrupt current subjob
5906rather than the shell.
5907
5908If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
5909don't send the signal. */)
5842a27b 5910 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5911{
5912 process_send_signal (process, SIGINT, current_group, 0);
5913 return process;
5914}
5915
5916DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
fdb82f93
PJ
5917 doc: /* Kill process PROCESS. May be process or name of one.
5918See function `interrupt-process' for more details on usage. */)
5842a27b 5919 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5920{
5921 process_send_signal (process, SIGKILL, current_group, 0);
5922 return process;
5923}
5924
5925DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
fdb82f93
PJ
5926 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
5927See function `interrupt-process' for more details on usage. */)
5842a27b 5928 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5
JB
5929{
5930 process_send_signal (process, SIGQUIT, current_group, 0);
5931 return process;
5932}
5933
5934DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
fdb82f93 5935 doc: /* Stop process PROCESS. May be process or name of one.
177c0ea7 5936See function `interrupt-process' for more details on usage.
d888760c
GM
5937If PROCESS is a network or serial process, inhibit handling of incoming
5938traffic. */)
5842a27b 5939 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5 5940{
d888760c 5941 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
e690ca94
KS
5942 {
5943 struct Lisp_Process *p;
177c0ea7 5944
e690ca94
KS
5945 p = XPROCESS (process);
5946 if (NILP (p->command)
60f0fb11 5947 && p->infd >= 0)
e690ca94 5948 {
60f0fb11
SM
5949 FD_CLR (p->infd, &input_wait_mask);
5950 FD_CLR (p->infd, &non_keyboard_wait_mask);
e690ca94
KS
5951 }
5952 p->command = Qt;
5953 return process;
5954 }
d0d6b7c5 5955#ifndef SIGTSTP
a9a73d6c 5956 error ("No SIGTSTP support");
d0d6b7c5
JB
5957#else
5958 process_send_signal (process, SIGTSTP, current_group, 0);
5959#endif
5960 return process;
5961}
5962
5963DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
fdb82f93 5964 doc: /* Continue process PROCESS. May be process or name of one.
177c0ea7 5965See function `interrupt-process' for more details on usage.
d888760c
GM
5966If PROCESS is a network or serial process, resume handling of incoming
5967traffic. */)
5842a27b 5968 (Lisp_Object process, Lisp_Object current_group)
d0d6b7c5 5969{
d888760c 5970 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)))
e690ca94
KS
5971 {
5972 struct Lisp_Process *p;
5973
5974 p = XPROCESS (process);
5975 if (EQ (p->command, Qt)
60f0fb11 5976 && p->infd >= 0
e690ca94
KS
5977 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
5978 {
60f0fb11
SM
5979 FD_SET (p->infd, &input_wait_mask);
5980 FD_SET (p->infd, &non_keyboard_wait_mask);
d888760c
GM
5981#ifdef WINDOWSNT
5982 if (fd_info[ p->infd ].flags & FILE_SERIAL)
5983 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
a7ebc409 5984#else /* not WINDOWSNT */
d888760c 5985 tcflush (p->infd, TCIFLUSH);
a7ebc409 5986#endif /* not WINDOWSNT */
e690ca94
KS
5987 }
5988 p->command = Qnil;
5989 return process;
5990 }
d0d6b7c5
JB
5991#ifdef SIGCONT
5992 process_send_signal (process, SIGCONT, current_group, 0);
5993#else
a9a73d6c 5994 error ("No SIGCONT support");
d0d6b7c5
JB
5995#endif
5996 return process;
5997}
5998
5999DEFUN ("signal-process", Fsignal_process, Ssignal_process,
cdd5ea86
KS
6000 2, 2, "sProcess (name or number): \nnSignal code: ",
6001 doc: /* Send PROCESS the signal with code SIGCODE.
648f6edf 6002PROCESS may also be a number specifying the process id of the
cdd5ea86
KS
6003process to signal; in this case, the process need not be a child of
6004this Emacs.
fdb82f93 6005SIGCODE may be an integer, or a symbol whose name is a signal name. */)
5842a27b 6006 (Lisp_Object process, Lisp_Object sigcode)
d0d6b7c5 6007{
6bfd98e7 6008 pid_t pid;
cdd5ea86
KS
6009
6010 if (INTEGERP (process))
6011 {
6bfd98e7
SM
6012 pid = XINT (process);
6013 goto got_it;
6014 }
6015
6016 if (FLOATP (process))
6017 {
648f6edf 6018 pid = (pid_t) XFLOAT_DATA (process);
cdd5ea86
KS
6019 goto got_it;
6020 }
6021
6022 if (STRINGP (process))
6023 {
6024 Lisp_Object tem;
6025 if (tem = Fget_process (process), NILP (tem))
6026 {
6bfd98e7
SM
6027 pid = XINT (Fstring_to_number (process, make_number (10)));
6028 if (pid > 0)
cdd5ea86
KS
6029 goto got_it;
6030 }
6031 process = tem;
6032 }
6033 else
6034 process = get_process (process);
177c0ea7 6035
cdd5ea86
KS
6036 if (NILP (process))
6037 return process;
6038
6039 CHECK_PROCESS (process);
6040 pid = XPROCESS (process)->pid;
6bfd98e7 6041 if (pid <= 0)
cdd5ea86
KS
6042 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6043
6044 got_it:
4766242d 6045
59324b1d 6046#define parse_signal(NAME, VALUE) \
05131107 6047 else if (!xstrcasecmp (name, NAME)) \
4766242d
RS
6048 XSETINT (sigcode, VALUE)
6049
6050 if (INTEGERP (sigcode))
6051 ;
6052 else
6053 {
25a48bd0 6054 char *name;
4766242d 6055
b7826503 6056 CHECK_SYMBOL (sigcode);
25a48bd0 6057 name = SSDATA (SYMBOL_NAME (sigcode));
4766242d 6058
ed3751c8 6059 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
675984ed
KS
6060 name += 3;
6061
4766242d
RS
6062 if (0)
6063 ;
59324b1d
KS
6064#ifdef SIGUSR1
6065 parse_signal ("usr1", SIGUSR1);
6066#endif
6067#ifdef SIGUSR2
6068 parse_signal ("usr2", SIGUSR2);
6069#endif
6070#ifdef SIGTERM
6071 parse_signal ("term", SIGTERM);
6072#endif
4766242d 6073#ifdef SIGHUP
59324b1d 6074 parse_signal ("hup", SIGHUP);
4766242d
RS
6075#endif
6076#ifdef SIGINT
59324b1d 6077 parse_signal ("int", SIGINT);
4766242d
RS
6078#endif
6079#ifdef SIGQUIT
59324b1d 6080 parse_signal ("quit", SIGQUIT);
4766242d
RS
6081#endif
6082#ifdef SIGILL
59324b1d 6083 parse_signal ("ill", SIGILL);
4766242d
RS
6084#endif
6085#ifdef SIGABRT
59324b1d 6086 parse_signal ("abrt", SIGABRT);
4766242d
RS
6087#endif
6088#ifdef SIGEMT
59324b1d 6089 parse_signal ("emt", SIGEMT);
4766242d
RS
6090#endif
6091#ifdef SIGKILL
59324b1d 6092 parse_signal ("kill", SIGKILL);
4766242d
RS
6093#endif
6094#ifdef SIGFPE
59324b1d 6095 parse_signal ("fpe", SIGFPE);
4766242d
RS
6096#endif
6097#ifdef SIGBUS
59324b1d 6098 parse_signal ("bus", SIGBUS);
4766242d
RS
6099#endif
6100#ifdef SIGSEGV
59324b1d 6101 parse_signal ("segv", SIGSEGV);
4766242d
RS
6102#endif
6103#ifdef SIGSYS
59324b1d 6104 parse_signal ("sys", SIGSYS);
4766242d
RS
6105#endif
6106#ifdef SIGPIPE
59324b1d 6107 parse_signal ("pipe", SIGPIPE);
4766242d
RS
6108#endif
6109#ifdef SIGALRM
59324b1d 6110 parse_signal ("alrm", SIGALRM);
4766242d
RS
6111#endif
6112#ifdef SIGURG
59324b1d 6113 parse_signal ("urg", SIGURG);
4766242d
RS
6114#endif
6115#ifdef SIGSTOP
59324b1d 6116 parse_signal ("stop", SIGSTOP);
4766242d
RS
6117#endif
6118#ifdef SIGTSTP
59324b1d 6119 parse_signal ("tstp", SIGTSTP);
4766242d
RS
6120#endif
6121#ifdef SIGCONT
59324b1d 6122 parse_signal ("cont", SIGCONT);
4766242d
RS
6123#endif
6124#ifdef SIGCHLD
59324b1d 6125 parse_signal ("chld", SIGCHLD);
4766242d
RS
6126#endif
6127#ifdef SIGTTIN
59324b1d 6128 parse_signal ("ttin", SIGTTIN);
4766242d
RS
6129#endif
6130#ifdef SIGTTOU
59324b1d 6131 parse_signal ("ttou", SIGTTOU);
4766242d
RS
6132#endif
6133#ifdef SIGIO
59324b1d 6134 parse_signal ("io", SIGIO);
4766242d
RS
6135#endif
6136#ifdef SIGXCPU
59324b1d 6137 parse_signal ("xcpu", SIGXCPU);
4766242d
RS
6138#endif
6139#ifdef SIGXFSZ
59324b1d 6140 parse_signal ("xfsz", SIGXFSZ);
4766242d
RS
6141#endif
6142#ifdef SIGVTALRM
59324b1d 6143 parse_signal ("vtalrm", SIGVTALRM);
4766242d
RS
6144#endif
6145#ifdef SIGPROF
59324b1d 6146 parse_signal ("prof", SIGPROF);
4766242d
RS
6147#endif
6148#ifdef SIGWINCH
59324b1d 6149 parse_signal ("winch", SIGWINCH);
4766242d
RS
6150#endif
6151#ifdef SIGINFO
59324b1d 6152 parse_signal ("info", SIGINFO);
4766242d
RS
6153#endif
6154 else
9fa195a2 6155 error ("Undefined signal name %s", name);
4766242d
RS
6156 }
6157
59324b1d 6158#undef parse_signal
4766242d 6159
6bfd98e7 6160 return make_number (kill (pid, XINT (sigcode)));
d0d6b7c5
JB
6161}
6162
6163DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
fdb82f93
PJ
6164 doc: /* Make PROCESS see end-of-file in its input.
6165EOF comes after any text already sent to it.
6166PROCESS may be a process, a buffer, the name of a process or buffer, or
6167nil, indicating the current buffer's process.
6168If PROCESS is a network connection, or is a process communicating
6169through a pipe (as opposed to a pty), then you cannot send any more
d888760c
GM
6170text to PROCESS after you call this function.
6171If PROCESS is a serial process, wait until all output written to the
6172process has been transmitted to the serial port. */)
5842a27b 6173 (Lisp_Object process)
d0d6b7c5
JB
6174{
6175 Lisp_Object proc;
de7fbd09 6176 struct coding_system *coding;
d0d6b7c5 6177
e690ca94
KS
6178 if (DATAGRAM_CONN_P (process))
6179 return process;
6180
d0d6b7c5 6181 proc = get_process (process);
60f0fb11 6182 coding = proc_encode_coding_system[XPROCESS (proc)->outfd];
577d03d5
RS
6183
6184 /* Make sure the process is really alive. */
6bfd98e7 6185 if (XPROCESS (proc)->raw_status_new)
577d03d5
RS
6186 update_status (XPROCESS (proc));
6187 if (! EQ (XPROCESS (proc)->status, Qrun))
d5db4077 6188 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
577d03d5 6189
de7fbd09
KH
6190 if (CODING_REQUIRE_FLUSHING (coding))
6191 {
6192 coding->mode |= CODING_MODE_LAST_BLOCK;
6193 send_process (proc, "", 0, Qnil);
6194 }
6195
60f0fb11 6196 if (XPROCESS (proc)->pty_flag)
4556b700 6197 send_process (proc, "\004", 1, Qnil);
a879ee6f 6198 else if (EQ (XPROCESS (proc)->type, Qserial))
d888760c 6199 {
a7ebc409 6200#ifndef WINDOWSNT
d888760c
GM
6201 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6202 error ("tcdrain() failed: %s", emacs_strerror (errno));
a7ebc409 6203#endif /* not WINDOWSNT */
d888760c
GM
6204 /* Do nothing on Windows because writes are blocking. */
6205 }
d0d6b7c5
JB
6206 else
6207 {
4525f571
RS
6208 int old_outfd, new_outfd;
6209
93853f3d 6210#ifdef HAVE_SHUTDOWN
02f55c4b
RS
6211 /* If this is a network connection, or socketpair is used
6212 for communication with the subprocess, call shutdown to cause EOF.
6213 (In some old system, shutdown to socketpair doesn't work.
6214 Then we just can't win.) */
a879ee6f 6215 if (EQ (XPROCESS (proc)->type, Qnetwork)
60f0fb11
SM
6216 || XPROCESS (proc)->outfd == XPROCESS (proc)->infd)
6217 shutdown (XPROCESS (proc)->outfd, 1);
02f55c4b 6218 /* In case of socketpair, outfd == infd, so don't close it. */
60f0fb11
SM
6219 if (XPROCESS (proc)->outfd != XPROCESS (proc)->infd)
6220 emacs_close (XPROCESS (proc)->outfd);
93853f3d 6221#else /* not HAVE_SHUTDOWN */
60f0fb11 6222 emacs_close (XPROCESS (proc)->outfd);
93853f3d 6223#endif /* not HAVE_SHUTDOWN */
68c45bf0 6224 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
27448380
RS
6225 if (new_outfd < 0)
6226 abort ();
60f0fb11 6227 old_outfd = XPROCESS (proc)->outfd;
4525f571
RS
6228
6229 if (!proc_encode_coding_system[new_outfd])
6230 proc_encode_coding_system[new_outfd]
6231 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
72af86bd
AS
6232 memcpy (proc_encode_coding_system[new_outfd],
6233 proc_encode_coding_system[old_outfd],
6234 sizeof (struct coding_system));
6235 memset (proc_encode_coding_system[old_outfd], 0,
6236 sizeof (struct coding_system));
4525f571 6237
60f0fb11 6238 XPROCESS (proc)->outfd = new_outfd;
d0d6b7c5 6239 }
d0d6b7c5
JB
6240 return process;
6241}
d0d6b7c5 6242\f
3fed8ad5
GM
6243/* On receipt of a signal that a child status has changed, loop asking
6244 about children with changed statuses until the system says there
6245 are no more.
177c0ea7 6246
3fed8ad5
GM
6247 All we do is change the status; we do not run sentinels or print
6248 notifications. That is saved for the next time keyboard input is
6249 done, in order to avoid timing errors.
6250
6251 ** WARNING: this can be called during garbage collection.
6252 Therefore, it must not be fooled by the presence of mark bits in
6253 Lisp objects.
6254
6255 ** USG WARNING: Although it is not obvious from the documentation
6256 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6257 signal() before executing at least one wait(), otherwise the
6258 handler will be called again, resulting in an infinite loop. The
6259 relevant portion of the documentation reads "SIGCLD signals will be
6260 queued and the signal-catching function will be continually
6261 reentered until the queue is empty". Invoking signal() causes the
6262 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6b61353c
KH
6263 Inc.
6264
6265 ** Malloc WARNING: This should never call malloc either directly or
6266 indirectly; if it does, that is a bug */
d0d6b7c5 6267
a5cfdda8 6268#ifdef SIGCHLD
9af30bdf 6269static void
d3da34e0 6270sigchld_handler (int signo)
d0d6b7c5
JB
6271{
6272 int old_errno = errno;
6273 Lisp_Object proc;
97ec208f 6274 struct Lisp_Process *p;
d0d6b7c5 6275
333f1b6f
JD
6276 SIGNAL_THREAD_CHECK (signo);
6277
d0d6b7c5
JB
6278 while (1)
6279 {
8e050977 6280 pid_t pid;
bba104c1 6281 int w;
d0d6b7c5
JB
6282 Lisp_Object tail;
6283
6284#ifdef WNOHANG
6285#ifndef WUNTRACED
6286#define WUNTRACED 0
6287#endif /* no WUNTRACED */
6288 /* Keep trying to get a status until we get a definitive result. */
e7d4a904 6289 do
63136da6 6290 {
29ed4d51
CY
6291 errno = 0;
6292 pid = wait3 (&w, WNOHANG | WUNTRACED, 0);
29ed4d51 6293 }
e7d4a904 6294 while (pid < 0 && errno == EINTR);
d0d6b7c5
JB
6295
6296 if (pid <= 0)
6297 {
3fed8ad5
GM
6298 /* PID == 0 means no processes found, PID == -1 means a real
6299 failure. We have done all our job, so return. */
d0d6b7c5 6300
d0d6b7c5
JB
6301 errno = old_errno;
6302 return;
6303 }
6304#else
6305 pid = wait (&w);
6306#endif /* no WNOHANG */
6307
6308 /* Find the process that signaled us, and record its status. */
6309
a5cfdda8 6310 /* The process can have been deleted by Fdelete_process. */
8e50cc2d 6311 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
a5cfdda8 6312 {
8e050977 6313 Lisp_Object xpid = XCAR (tail);
8e50cc2d
SM
6314 if ((INTEGERP (xpid) && pid == (pid_t) XINT (xpid))
6315 || (FLOATP (xpid) && pid == (pid_t) XFLOAT_DATA (xpid)))
8e050977
CY
6316 {
6317 XSETCAR (tail, Qnil);
6318 goto sigchld_end_of_loop;
6319 }
a5cfdda8
KS
6320 }
6321
6322 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
d0d6b7c5 6323 p = 0;
8e50cc2d 6324 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6325 {
70949dac 6326 proc = XCDR (XCAR (tail));
d0d6b7c5 6327 p = XPROCESS (proc);
d888760c 6328 if (EQ (p->type, Qreal) && p->pid == pid)
d0d6b7c5
JB
6329 break;
6330 p = 0;
6331 }
6332
6333 /* Look for an asynchronous process whose pid hasn't been filled
6334 in yet. */
6335 if (p == 0)
8e50cc2d 6336 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6337 {
70949dac 6338 proc = XCDR (XCAR (tail));
d0d6b7c5 6339 p = XPROCESS (proc);
6bfd98e7 6340 if (p->pid == -1)
d0d6b7c5
JB
6341 break;
6342 p = 0;
6343 }
177c0ea7 6344
d0d6b7c5
JB
6345 /* Change the status of the process that was found. */
6346 if (p != 0)
6347 {
e98d950b 6348 int clear_desc_flag = 0;
177c0ea7 6349
60f0fb11 6350 p->tick = ++process_tick;
bba104c1 6351 p->raw_status = w;
6bfd98e7 6352 p->raw_status_new = 1;
177c0ea7 6353
d0d6b7c5 6354 /* If process has terminated, stop waiting for its output. */
e98d950b 6355 if ((WIFSIGNALED (w) || WIFEXITED (w))
60f0fb11 6356 && p->infd >= 0)
e98d950b
RS
6357 clear_desc_flag = 1;
6358
6359 /* We use clear_desc_flag to avoid a compiler bug in Microsoft C. */
6360 if (clear_desc_flag)
6361 {
60f0fb11
SM
6362 FD_CLR (p->infd, &input_wait_mask);
6363 FD_CLR (p->infd, &non_keyboard_wait_mask);
e98d950b 6364 }
6be429b1 6365
214d6069 6366 /* Tell wait_reading_process_output that it needs to wake up and
6be429b1
JB
6367 look around. */
6368 if (input_available_clear_time)
6369 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
6370 }
6371
a5cfdda8
KS
6372 /* There was no asynchronous process found for that pid: we have
6373 a synchronous process. */
d0d6b7c5
JB
6374 else
6375 {
6376 synch_process_alive = 0;
6377
6378 /* Report the status of the synchronous process. */
6379 if (WIFEXITED (w))
6380 synch_process_retcode = WRETCODE (w);
6381 else if (WIFSIGNALED (w))
63136da6 6382 synch_process_termsig = WTERMSIG (w);
6be429b1 6383
214d6069 6384 /* Tell wait_reading_process_output that it needs to wake up and
6be429b1
JB
6385 look around. */
6386 if (input_available_clear_time)
6387 EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
d0d6b7c5
JB
6388 }
6389
a5cfdda8
KS
6390 sigchld_end_of_loop:
6391 ;
6392
d0d6b7c5
JB
6393 /* On some systems, we must return right away.
6394 If any more processes want to signal us, we will
6395 get another signal.
6396 Otherwise (on systems that have WNOHANG), loop around
6397 to use up all the processes that have something to tell us. */
4e6277d8 6398#if (defined WINDOWSNT \
8a2a6032 6399 || (defined USG && !defined GNU_LINUX \
63136da6 6400 && !(defined HPUX && defined WNOHANG)))
d0d6b7c5
JB
6401 errno = old_errno;
6402 return;
6403#endif /* USG, but not HPUX with WNOHANG */
6404 }
6405}
a5cfdda8 6406#endif /* SIGCHLD */
d0d6b7c5
JB
6407\f
6408
6409static Lisp_Object
d3da34e0 6410exec_sentinel_unwind (Lisp_Object data)
d0d6b7c5 6411{
70949dac 6412 XPROCESS (XCAR (data))->sentinel = XCDR (data);
d0d6b7c5
JB
6413 return Qnil;
6414}
6415
3b9a3dfa 6416static Lisp_Object
b93aacde 6417exec_sentinel_error_handler (Lisp_Object error_val)
3b9a3dfa 6418{
b93aacde 6419 cmd_error_internal (error_val, "error in process sentinel: ");
3b9a3dfa
RS
6420 Vinhibit_quit = Qt;
6421 update_echo_area ();
833ba342 6422 Fsleep_for (make_number (2), Qnil);
8c983bf2 6423 return Qt;
3b9a3dfa
RS
6424}
6425
d0d6b7c5 6426static void
d3da34e0 6427exec_sentinel (Lisp_Object proc, Lisp_Object reason)
d0d6b7c5 6428{
aba7731a 6429 Lisp_Object sentinel, odeactivate;
d0d6b7c5 6430 register struct Lisp_Process *p = XPROCESS (proc);
aed13378 6431 int count = SPECPDL_INDEX ();
4da2f5be 6432 int outer_running_asynch_code = running_asynch_code;
bbce7d72 6433 int waiting = waiting_for_user_input_p;
d0d6b7c5 6434
84af9896
RS
6435 if (inhibit_sentinels)
6436 return;
6437
dfc21838
RS
6438 /* No need to gcpro these, because all we do with them later
6439 is test them for EQness, and none of them should be a string. */
8fb3cf64 6440 odeactivate = Vdeactivate_mark;
aba7731a
PE
6441#if 0
6442 Lisp_Object obuffer, okeymap;
dfc21838 6443 XSETBUFFER (obuffer, current_buffer);
4b4deea2 6444 okeymap = BVAR (current_buffer, keymap);
aba7731a 6445#endif
dfc21838 6446
97e53006
SM
6447 /* There's no good reason to let sentinels change the current
6448 buffer, and many callers of accept-process-output, sit-for, and
6449 friends don't expect current-buffer to be changed from under them. */
d2630aef 6450 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
97e53006 6451
d0d6b7c5
JB
6452 sentinel = p->sentinel;
6453 if (NILP (sentinel))
6454 return;
6455
6456 /* Zilch the sentinel while it's running, to avoid recursive invocations;
6457 assure that it gets restored no matter how the sentinel exits. */
6458 p->sentinel = Qnil;
6459 record_unwind_protect (exec_sentinel_unwind, Fcons (proc, sentinel));
6460 /* Inhibit quit so that random quits don't screw up a running filter. */
6461 specbind (Qinhibit_quit, Qt);
f00c449b 6462 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
3b9a3dfa 6463
4da2f5be
RS
6464 /* In case we get recursively called,
6465 and we already saved the match data nonrecursively,
6466 save the same match data in safely recursive fashion. */
6467 if (outer_running_asynch_code)
6468 {
6469 Lisp_Object tem;
89f2614d
KS
6470 tem = Fmatch_data (Qnil, Qnil, Qnil);
6471 restore_search_regs ();
6472 record_unwind_save_match_data ();
6473 Fset_match_data (tem, Qt);
4da2f5be
RS
6474 }
6475
6476 /* For speed, if a search happens within this code,
6477 save the match data in a special nonrecursive fashion. */
7074fde6 6478 running_asynch_code = 1;
4da2f5be 6479
3b9a3dfa
RS
6480 internal_condition_case_1 (read_process_output_call,
6481 Fcons (sentinel,
6482 Fcons (proc, Fcons (reason, Qnil))),
6483 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6484 exec_sentinel_error_handler);
4da2f5be
RS
6485
6486 /* If we saved the match data nonrecursively, restore it now. */
89f2614d 6487 restore_search_regs ();
4da2f5be 6488 running_asynch_code = outer_running_asynch_code;
8fb3cf64
KH
6489
6490 Vdeactivate_mark = odeactivate;
bbce7d72
RS
6491
6492 /* Restore waiting_for_user_input_p as it was
6493 when we were called, in case the filter clobbered it. */
6494 waiting_for_user_input_p = waiting;
6495
7973cfa8 6496#if 0
dfc21838
RS
6497 if (! EQ (Fcurrent_buffer (), obuffer)
6498 || ! EQ (current_buffer->keymap, okeymap))
7973cfa8 6499#endif
927e08be
RS
6500 /* But do it only if the caller is actually going to read events.
6501 Otherwise there's no need to make him wake up, and it could
7157b8fe 6502 cause trouble (for example it would make sit_for return). */
927e08be
RS
6503 if (waiting_for_user_input_p == -1)
6504 record_asynch_buffer_change ();
8fb3cf64 6505
2ea6d561 6506 unbind_to (count, Qnil);
d0d6b7c5
JB
6507}
6508
6509/* Report all recent events of a change in process status
6510 (either run the sentinel or output a message).
b50fe468
RS
6511 This is usually done while Emacs is waiting for keyboard input
6512 but can be done at other times. */
d0d6b7c5 6513
ff6daed3 6514static void
d3da34e0 6515status_notify (struct Lisp_Process *deleting_process)
d0d6b7c5
JB
6516{
6517 register Lisp_Object proc, buffer;
2e4149a8 6518 Lisp_Object tail, msg;
d0d6b7c5
JB
6519 struct gcpro gcpro1, gcpro2;
6520
2e4149a8
KH
6521 tail = Qnil;
6522 msg = Qnil;
d0d6b7c5
JB
6523 /* We need to gcpro tail; if read_process_output calls a filter
6524 which deletes a process and removes the cons to which tail points
6525 from Vprocess_alist, and then causes a GC, tail is an unprotected
6526 reference. */
6527 GCPRO2 (tail, msg);
6528
30623085
RS
6529 /* Set this now, so that if new processes are created by sentinels
6530 that we run, we get called again to handle their status changes. */
6531 update_tick = process_tick;
6532
99784d63 6533 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
d0d6b7c5 6534 {
30623085
RS
6535 Lisp_Object symbol;
6536 register struct Lisp_Process *p;
6537
99784d63 6538 proc = Fcdr (XCAR (tail));
30623085
RS
6539 p = XPROCESS (proc);
6540
60f0fb11 6541 if (p->tick != p->update_tick)
d0d6b7c5 6542 {
60f0fb11 6543 p->update_tick = p->tick;
d0d6b7c5 6544
30623085 6545 /* If process is still active, read any output that remains. */
4da2f5be 6546 while (! EQ (p->filter, Qt)
dd2a17ab 6547 && ! EQ (p->status, Qconnect)
e690ca94 6548 && ! EQ (p->status, Qlisten)
d888760c
GM
6549 /* Network or serial process not stopped: */
6550 && ! EQ (p->command, Qt)
60f0fb11 6551 && p->infd >= 0
ff6daed3 6552 && p != deleting_process
60f0fb11 6553 && read_process_output (proc, p->infd) > 0);
d0d6b7c5 6554
30623085 6555 buffer = p->buffer;
d0d6b7c5 6556
30623085 6557 /* Get the text to use for the message. */
6bfd98e7 6558 if (p->raw_status_new)
30623085 6559 update_status (p);
116c423c 6560 msg = status_message (p);
d0d6b7c5 6561
30623085
RS
6562 /* If process is terminated, deactivate it or delete it. */
6563 symbol = p->status;
6564 if (CONSP (p->status))
70949dac 6565 symbol = XCAR (p->status);
d0d6b7c5 6566
30623085
RS
6567 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
6568 || EQ (symbol, Qclosed))
6569 {
6570 if (delete_exited_processes)
6571 remove_process (proc);
6572 else
6573 deactivate_process (proc);
6574 }
d0d6b7c5 6575
0ad61fe7
RS
6576 /* The actions above may have further incremented p->tick.
6577 So set p->update_tick again
6578 so that an error in the sentinel will not cause
6579 this code to be run again. */
60f0fb11 6580 p->update_tick = p->tick;
30623085
RS
6581 /* Now output the message suitably. */
6582 if (!NILP (p->sentinel))
6583 exec_sentinel (proc, msg);
6584 /* Don't bother with a message in the buffer
6585 when a process becomes runnable. */
6586 else if (!EQ (symbol, Qrun) && !NILP (buffer))
6587 {
01f5787b 6588 Lisp_Object tem;
30623085 6589 struct buffer *old = current_buffer;
f877c546
EZ
6590 EMACS_INT opoint, opoint_byte;
6591 EMACS_INT before, before_byte;
2e4149a8 6592
30623085
RS
6593 /* Avoid error if buffer is deleted
6594 (probably that's why the process is dead, too) */
4b4deea2 6595 if (NILP (BVAR (XBUFFER (buffer), name)))
30623085
RS
6596 continue;
6597 Fset_buffer (buffer);
12ca5cdf 6598
6ec8bbd2 6599 opoint = PT;
d8a2934e 6600 opoint_byte = PT_BYTE;
30623085
RS
6601 /* Insert new output into buffer
6602 at the current end-of-output marker,
6603 thus preserving logical ordering of input and output. */
6604 if (XMARKER (p->mark)->buffer)
d8a2934e 6605 Fgoto_char (p->mark);
30623085 6606 else
d8a2934e 6607 SET_PT_BOTH (ZV, ZV_BYTE);
12ca5cdf
RS
6608
6609 before = PT;
d8a2934e 6610 before_byte = PT_BYTE;
30623085 6611
4b4deea2
TT
6612 tem = BVAR (current_buffer, read_only);
6613 BVAR (current_buffer, read_only) = Qnil;
30623085
RS
6614 insert_string ("\nProcess ");
6615 Finsert (1, &p->name);
6616 insert_string (" ");
6617 Finsert (1, &msg);
4b4deea2 6618 BVAR (current_buffer, read_only) = tem;
d8a2934e 6619 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
30623085 6620
12ca5cdf 6621 if (opoint >= before)
d8a2934e
RS
6622 SET_PT_BOTH (opoint + (PT - before),
6623 opoint_byte + (PT_BYTE - before_byte));
12ca5cdf 6624 else
d8a2934e 6625 SET_PT_BOTH (opoint, opoint_byte);
12ca5cdf 6626
30623085 6627 set_buffer_internal (old);
d0d6b7c5 6628 }
30623085
RS
6629 }
6630 } /* end for */
d0d6b7c5
JB
6631
6632 update_mode_lines++; /* in case buffers use %s in mode-line-format */
d0d6b7c5
JB
6633 UNGCPRO;
6634}
0fa1789e
KH
6635
6636\f
6637DEFUN ("set-process-coding-system", Fset_process_coding_system,
6638 Sset_process_coding_system, 1, 3, 0,
fdb82f93
PJ
6639 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
6640DECODING will be used to decode subprocess output and ENCODING to
6641encode subprocess input. */)
5842a27b 6642 (register Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
0fa1789e
KH
6643{
6644 register struct Lisp_Process *p;
6645
f3d9532b
JB
6646 CHECK_PROCESS (process);
6647 p = XPROCESS (process);
60f0fb11 6648 if (p->infd < 0)
d5db4077 6649 error ("Input file descriptor of %s closed", SDATA (p->name));
60f0fb11 6650 if (p->outfd < 0)
d5db4077 6651 error ("Output file descriptor of %s closed", SDATA (p->name));
03f04413
KH
6652 Fcheck_coding_system (decoding);
6653 Fcheck_coding_system (encoding);
76d812bb 6654 encoding = coding_inherit_eol_type (encoding, Qnil);
03f04413
KH
6655 p->decode_coding_system = decoding;
6656 p->encode_coding_system = encoding;
f3d9532b 6657 setup_process_coding_systems (process);
0fa1789e
KH
6658
6659 return Qnil;
6660}
6661
6662DEFUN ("process-coding-system",
6663 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
fdb82f93 6664 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
5842a27b 6665 (register Lisp_Object process)
0fa1789e 6666{
f3d9532b
JB
6667 CHECK_PROCESS (process);
6668 return Fcons (XPROCESS (process)->decode_coding_system,
6669 XPROCESS (process)->encode_coding_system);
0fa1789e 6670}
03f04413
KH
6671
6672DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
6673 Sset_process_filter_multibyte, 2, 2, 0,
7392e23c
KS
6674 doc: /* Set multibyteness of the strings given to PROCESS's filter.
6675If FLAG is non-nil, the filter is given multibyte strings.
6676If FLAG is nil, the filter is given unibyte strings. In this case,
03f04413
KH
6677all character code conversion except for end-of-line conversion is
6678suppressed. */)
5842a27b 6679 (Lisp_Object process, Lisp_Object flag)
03f04413
KH
6680{
6681 register struct Lisp_Process *p;
6682
f3d9532b
JB
6683 CHECK_PROCESS (process);
6684 p = XPROCESS (process);
5431bd6a
SM
6685 if (NILP (flag))
6686 p->decode_coding_system = raw_text_coding_system (p->decode_coding_system);
f3d9532b 6687 setup_process_coding_systems (process);
03f04413
KH
6688
6689 return Qnil;
6690}
6691
6692DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
6693 Sprocess_filter_multibyte_p, 1, 1, 0,
6694 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
5842a27b 6695 (Lisp_Object process)
03f04413
KH
6696{
6697 register struct Lisp_Process *p;
5431bd6a 6698 struct coding_system *coding;
03f04413 6699
f3d9532b
JB
6700 CHECK_PROCESS (process);
6701 p = XPROCESS (process);
5431bd6a
SM
6702 coding = proc_decode_coding_system[p->infd];
6703 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
03f04413
KH
6704}
6705
6706
d0d6b7c5 6707\f
cb768704 6708
4475bec4
PE
6709# ifdef HAVE_GPM
6710
994d9841 6711void
d3da34e0 6712add_gpm_wait_descriptor (int desc)
994d9841 6713{
3fad2ad2 6714 add_keyboard_wait_descriptor (desc);
994d9841
NR
6715}
6716
994d9841 6717void
d3da34e0 6718delete_gpm_wait_descriptor (int desc)
994d9841 6719{
3fad2ad2 6720 delete_keyboard_wait_descriptor (desc);
994d9841
NR
6721}
6722
4475bec4
PE
6723# endif
6724
006c5daa
PE
6725# ifdef SIGIO
6726
a69281ff
RS
6727/* Return nonzero if *MASK has a bit set
6728 that corresponds to one of the keyboard input descriptors. */
6729
ff6daed3 6730static int
d3da34e0 6731keyboard_bit_set (fd_set *mask)
a69281ff
RS
6732{
6733 int fd;
6734
3fad2ad2 6735 for (fd = 0; fd <= max_input_desc; fd++)
a69281ff
RS
6736 if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask)
6737 && !FD_ISSET (fd, &non_keyboard_wait_mask))
6738 return 1;
6739
6740 return 0;
6741}
006c5daa 6742# endif
934e2a68 6743
f388c88a 6744#else /* not subprocesses */
934e2a68 6745
f388c88a
EZ
6746/* Defined on msdos.c. */
6747extern int sys_select (int, SELECT_TYPE *, SELECT_TYPE *, SELECT_TYPE *,
6748 EMACS_TIME *);
934e2a68 6749
f388c88a
EZ
6750/* Implementation of wait_reading_process_output, assuming that there
6751 are no subprocesses. Used only by the MS-DOS build.
934e2a68 6752
f388c88a 6753 Wait for timeout to elapse and/or keyboard input to be available.
934e2a68 6754
f388c88a
EZ
6755 time_limit is:
6756 timeout in seconds, or
6757 zero for no limit, or
6758 -1 means gobble data immediately available but don't wait for any.
934e2a68 6759
f388c88a
EZ
6760 read_kbd is a Lisp_Object:
6761 0 to ignore keyboard input, or
6762 1 to return when input is available, or
6763 -1 means caller will actually read the input, so don't throw to
6764 the quit handler.
934e2a68 6765
f388c88a
EZ
6766 see full version for other parameters. We know that wait_proc will
6767 always be NULL, since `subprocesses' isn't defined.
934e2a68 6768
f388c88a
EZ
6769 do_display != 0 means redisplay should be done to show subprocess
6770 output that arrives.
934e2a68 6771
f388c88a
EZ
6772 Return true if we received input from any process. */
6773
6774int
1408902e
EZ
6775wait_reading_process_output (int time_limit, int microsecs, int read_kbd,
6776 int do_display,
6777 Lisp_Object wait_for_cell,
6778 struct Lisp_Process *wait_proc, int just_wait_proc)
d0d6b7c5 6779{
f388c88a
EZ
6780 register int nfds;
6781 EMACS_TIME end_time, timeout;
6782 SELECT_TYPE waitchannels;
6783 int xerrno;
d0d6b7c5 6784
f388c88a
EZ
6785 /* What does time_limit really mean? */
6786 if (time_limit || microsecs)
6787 {
6788 EMACS_GET_TIME (end_time);
6789 EMACS_SET_SECS_USECS (timeout, time_limit, microsecs);
6790 EMACS_ADD_TIME (end_time, end_time, timeout);
6791 }
84af9896 6792
f388c88a
EZ
6793 /* Turn off periodic alarms (in case they are in use)
6794 and then turn off any other atimers,
6795 because the select emulator uses alarms. */
6796 stop_polling ();
6797 turn_on_atimers (0);
d0d6b7c5 6798
f388c88a
EZ
6799 while (1)
6800 {
6801 int timeout_reduced_for_timers = 0;
dd2281ae 6802
f388c88a
EZ
6803 /* If calling from keyboard input, do not quit
6804 since we want to return C-g as an input character.
6805 Otherwise, do pending quit if requested. */
6806 if (read_kbd >= 0)
6807 QUIT;
bad49fc7 6808
f388c88a
EZ
6809 /* Exit now if the cell we're waiting for became non-nil. */
6810 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
6811 break;
0a65b032 6812
bae8d137
RS
6813 /* Compute time from now till when time limit is up */
6814 /* Exit if already run out */
52fd88d3
EZ
6815 if (time_limit == -1)
6816 {
6817 /* -1 specified for timeout means
6818 gobble output available now
6819 but don't wait at all. */
6820
6821 EMACS_SET_SECS_USECS (timeout, 0, 0);
6822 }
6823 else if (time_limit || microsecs)
6720a7fb 6824 {
f694e5d2
KH
6825 EMACS_GET_TIME (timeout);
6826 EMACS_SUB_TIME (timeout, end_time, timeout);
6827 if (EMACS_TIME_NEG_P (timeout))
6720a7fb
JB
6828 break;
6829 }
52fd88d3
EZ
6830 else
6831 {
6832 EMACS_SET_SECS_USECS (timeout, 100000, 0);
6833 }
6720a7fb 6834
bae8d137
RS
6835 /* If our caller will not immediately handle keyboard events,
6836 run timer events directly.
6837 (Callers that will immediately read keyboard events
6838 call timer_delay on their own.) */
f3fbd155 6839 if (NILP (wait_for_cell))
bae8d137
RS
6840 {
6841 EMACS_TIME timer_delay;
0a65b032 6842
9baacf76 6843 do
0a65b032 6844 {
9baacf76 6845 int old_timers_run = timers_run;
f868cd8a 6846 timer_delay = timer_check ();
9baacf76
GM
6847 if (timers_run != old_timers_run && do_display)
6848 /* We must retry, since a timer may have requeued itself
6849 and that could alter the time delay. */
3007ebfb 6850 redisplay_preserve_echo_area (14);
9baacf76
GM
6851 else
6852 break;
0a65b032 6853 }
9baacf76 6854 while (!detect_input_pending ());
0a65b032 6855
52fd88d3 6856 /* If there is unread keyboard input, also return. */
b89a415a 6857 if (read_kbd != 0
52fd88d3
EZ
6858 && requeued_events_pending_p ())
6859 break;
6860
f694e5d2 6861 if (! EMACS_TIME_NEG_P (timer_delay) && time_limit != -1)
bae8d137
RS
6862 {
6863 EMACS_TIME difference;
f694e5d2 6864 EMACS_SUB_TIME (difference, timer_delay, timeout);
bae8d137
RS
6865 if (EMACS_TIME_NEG_P (difference))
6866 {
f694e5d2 6867 timeout = timer_delay;
bae8d137
RS
6868 timeout_reduced_for_timers = 1;
6869 }
6870 }
6871 }
6872
6720a7fb
JB
6873 /* Cause C-g and alarm signals to take immediate action,
6874 and cause input available signals to zero out timeout. */
b89a415a 6875 if (read_kbd < 0)
6720a7fb
JB
6876 set_waiting_for_input (&timeout);
6877
0a65b032
RS
6878 /* Wait till there is something to do. */
6879
b89a415a 6880 if (! read_kbd && NILP (wait_for_cell))
0a65b032
RS
6881 FD_ZERO (&waitchannels);
6882 else
6883 FD_SET (0, &waitchannels);
6884
ff11dfa1 6885 /* If a frame has been newly mapped and needs updating,
6720a7fb 6886 reprocess its display stuff. */
5164ee8e 6887 if (frame_garbaged && do_display)
0a65b032
RS
6888 {
6889 clear_waiting_for_input ();
3007ebfb 6890 redisplay_preserve_echo_area (15);
b89a415a 6891 if (read_kbd < 0)
0a65b032
RS
6892 set_waiting_for_input (&timeout);
6893 }
6720a7fb 6894
b89a415a 6895 if (read_kbd && detect_input_pending ())
1861b214
RS
6896 {
6897 nfds = 0;
6898 FD_ZERO (&waitchannels);
6899 }
6900 else
6901 nfds = select (1, &waitchannels, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
6902 &timeout);
f694e5d2
KH
6903
6904 xerrno = errno;
6720a7fb
JB
6905
6906 /* Make C-g and alarm signals set flags again */
6907 clear_waiting_for_input ();
6908
6909 /* If we woke up due to SIGWINCH, actually change size now. */
2b653806 6910 do_pending_window_change (0);
6720a7fb 6911
f694e5d2
KH
6912 if (time_limit && nfds == 0 && ! timeout_reduced_for_timers)
6913 /* We waited the full specified time, so return now. */
6914 break;
6915
6720a7fb
JB
6916 if (nfds == -1)
6917 {
6918 /* If the system call was interrupted, then go around the
6919 loop again. */
f694e5d2 6920 if (xerrno == EINTR)
8db121c4 6921 FD_ZERO (&waitchannels);
f694e5d2 6922 else
68c45bf0 6923 error ("select error: %s", emacs_strerror (xerrno));
6720a7fb 6924 }
6720a7fb 6925
f694e5d2
KH
6926 /* Check for keyboard input */
6927
b89a415a 6928 if (read_kbd
78c1afb6 6929 && detect_input_pending_run_timers (do_display))
f694e5d2 6930 {
78c1afb6 6931 swallow_events (do_display);
f694e5d2 6932 if (detect_input_pending_run_timers (do_display))
a2fab450 6933 break;
78c1afb6
EZ
6934 }
6935
52fd88d3 6936 /* If there is unread keyboard input, also return. */
b89a415a 6937 if (read_kbd
52fd88d3
EZ
6938 && requeued_events_pending_p ())
6939 break;
6940
f854a00b
RS
6941 /* If wait_for_cell. check for keyboard input
6942 but don't run any timers.
6943 ??? (It seems wrong to me to check for keyboard
6944 input at all when wait_for_cell, but the code
6945 has been this way since July 1994.
6946 Try changing this after version 19.31.) */
f3fbd155 6947 if (! NILP (wait_for_cell)
f854a00b
RS
6948 && detect_input_pending ())
6949 {
6950 swallow_events (do_display);
6951 if (detect_input_pending ())
6952 break;
6953 }
6954
0a65b032 6955 /* Exit now if the cell we're waiting for became non-nil. */
f3fbd155 6956 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
0a65b032 6957 break;
6720a7fb
JB
6958 }
6959
a87b802f
JB
6960 start_polling ();
6961
6720a7fb
JB
6962 return 0;
6963}
6964
f388c88a
EZ
6965#endif /* not subprocesses */
6966
6967/* The following functions are needed even if async subprocesses are
6968 not supported. Some of them are no-op stubs in that case. */
6720a7fb 6969
01faa934
DN
6970/* Add DESC to the set of keyboard input descriptors. */
6971
6972void
6973add_keyboard_wait_descriptor (int desc)
6974{
bf05eed6 6975#ifdef subprocesses /* actually means "not MSDOS" */
01faa934
DN
6976 FD_SET (desc, &input_wait_mask);
6977 FD_SET (desc, &non_process_wait_mask);
3fad2ad2
J
6978 if (desc > max_input_desc)
6979 max_input_desc = desc;
bf05eed6 6980#endif
01faa934
DN
6981}
6982
6983/* From now on, do not expect DESC to give keyboard input. */
6984
6985void
6986delete_keyboard_wait_descriptor (int desc)
6987{
bf05eed6 6988#ifdef subprocesses
01faa934 6989 int fd;
3fad2ad2 6990 int lim = max_input_desc;
01faa934
DN
6991
6992 FD_CLR (desc, &input_wait_mask);
6993 FD_CLR (desc, &non_process_wait_mask);
6994
3fad2ad2 6995 if (desc == max_input_desc)
01faa934 6996 for (fd = 0; fd < lim; fd++)
3fad2ad2
J
6997 if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask))
6998 max_input_desc = fd;
bf05eed6 6999#endif
01faa934
DN
7000}
7001
fc549af9
EZ
7002/* Setup coding systems of PROCESS. */
7003
7004void
7005setup_process_coding_systems (Lisp_Object process)
7006{
7007#ifdef subprocesses
7008 struct Lisp_Process *p = XPROCESS (process);
7009 int inch = p->infd;
7010 int outch = p->outfd;
7011 Lisp_Object coding_system;
7012
7013 if (inch < 0 || outch < 0)
7014 return;
7015
7016 if (!proc_decode_coding_system[inch])
7017 proc_decode_coding_system[inch]
7018 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
7019 coding_system = p->decode_coding_system;
7020 if (! NILP (p->filter))
7021 ;
7022 else if (BUFFERP (p->buffer))
7023 {
4b4deea2 7024 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
fc549af9
EZ
7025 coding_system = raw_text_coding_system (coding_system);
7026 }
7027 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7028
7029 if (!proc_encode_coding_system[outch])
7030 proc_encode_coding_system[outch]
7031 = (struct coding_system *) xmalloc (sizeof (struct coding_system));
7032 setup_coding_system (p->encode_coding_system,
7033 proc_encode_coding_system[outch]);
7034#endif
7035}
7036
7037/* Close all descriptors currently in use for communication
7038 with subprocess. This is used in a newly-forked subprocess
7039 to get rid of irrelevant descriptors. */
7040
7041void
7042close_process_descs (void)
7043{
7044#ifndef DOS_NT
7045 int i;
7046 for (i = 0; i < MAXDESC; i++)
7047 {
7048 Lisp_Object process;
7049 process = chan_process[i];
7050 if (!NILP (process))
7051 {
7052 int in = XPROCESS (process)->infd;
7053 int out = XPROCESS (process)->outfd;
7054 if (in >= 0)
7055 emacs_close (in);
7056 if (out >= 0 && in != out)
7057 emacs_close (out);
7058 }
7059 }
7060#endif
7061}
7062
6720a7fb 7063DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
f388c88a
EZ
7064 doc: /* Return the (or a) process associated with BUFFER.
7065BUFFER may be a buffer or the name of one. */)
7066 (register Lisp_Object buffer)
6720a7fb 7067{
f388c88a
EZ
7068#ifdef subprocesses
7069 register Lisp_Object buf, tail, proc;
7070
7071 if (NILP (buffer)) return Qnil;
7072 buf = Fget_buffer (buffer);
7073 if (NILP (buf)) return Qnil;
7074
7075 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
7076 {
7077 proc = Fcdr (XCAR (tail));
7078 if (PROCESSP (proc) && EQ (XPROCESS (proc)->buffer, buf))
7079 return proc;
7080 }
7081#endif /* subprocesses */
6720a7fb
JB
7082 return Qnil;
7083}
7084
52a1b894 7085DEFUN ("process-inherit-coding-system-flag",
fdb82f93
PJ
7086 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7087 1, 1, 0,
f388c88a
EZ
7088 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7089If this flag is t, `buffer-file-coding-system' of the buffer
7090associated with PROCESS will inherit the coding system used to decode
7091the process output. */)
5842a27b 7092 (register Lisp_Object process)
52a1b894 7093{
f388c88a
EZ
7094#ifdef subprocesses
7095 CHECK_PROCESS (process);
7096 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7097#else
52a1b894
EZ
7098 /* Ignore the argument and return the value of
7099 inherit-process-coding-system. */
7100 return inherit_process_coding_system ? Qt : Qnil;
f388c88a 7101#endif
52a1b894
EZ
7102}
7103
6720a7fb 7104/* Kill all processes associated with `buffer'.
f388c88a 7105 If `buffer' is nil, kill all processes */
6720a7fb 7106
d9bb0c32 7107void
f388c88a 7108kill_buffer_processes (Lisp_Object buffer)
6720a7fb 7109{
f388c88a
EZ
7110#ifdef subprocesses
7111 Lisp_Object tail, proc;
7112
7113 for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
7114 {
7115 proc = XCDR (XCAR (tail));
7116 if (PROCESSP (proc)
7117 && (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)))
7118 {
7119 if (NETCONN_P (proc) || SERIALCONN_P (proc))
7120 Fdelete_process (proc);
7121 else if (XPROCESS (proc)->infd >= 0)
7122 process_send_signal (proc, SIGHUP, Qnil, 1);
7123 }
7124 }
7125#else /* subprocesses */
7126 /* Since we have no subprocesses, this does nothing. */
7127#endif /* subprocesses */
6720a7fb
JB
7128}
7129
a7ca3326 7130DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
16a97296 7131 Swaiting_for_user_input_p, 0, 0, 0,
77defa9a
EZ
7132 doc: /* Returns non-nil if Emacs is waiting for input from the user.
7133This is intended for use by asynchronous process output filters and sentinels. */)
7134 (void)
7135{
7136#ifdef subprocesses
7137 return (waiting_for_user_input_p ? Qt : Qnil);
7138#else
7139 return Qnil;
7140#endif
7141}
7142
d568829b
EZ
7143/* Stop reading input from keyboard sources. */
7144
7145void
7146hold_keyboard_input (void)
7147{
7148 kbd_is_on_hold = 1;
7149}
7150
7151/* Resume reading input from keyboard sources. */
7152
7153void
7154unhold_keyboard_input (void)
7155{
7156 kbd_is_on_hold = 0;
7157}
7158
7159/* Return non-zero if keyboard input is on hold, zero otherwise. */
7160
7161int
7162kbd_on_hold_p (void)
7163{
7164 return kbd_is_on_hold;
7165}
7166
f388c88a
EZ
7167\f
7168/* Enumeration of and access to system processes a-la ps(1). */
7169
934e2a68
EZ
7170DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7171 0, 0, 0,
7172 doc: /* Return a list of numerical process IDs of all running processes.
7173If this functionality is unsupported, return nil.
7174
f388c88a
EZ
7175See `process-attributes' for getting attributes of a process given its ID. */)
7176 (void)
7177{
7178 return list_system_processes ();
7179}
7180
7181DEFUN ("process-attributes", Fprocess_attributes,
7182 Sprocess_attributes, 1, 1, 0,
7183 doc: /* Return attributes of the process given by its PID, a number.
7184
7185Value is an alist where each element is a cons cell of the form
7186
7187 \(KEY . VALUE)
7188
7189If this functionality is unsupported, the value is nil.
7190
7191See `list-system-processes' for getting a list of all process IDs.
7192
7193The KEYs of the attributes that this function may return are listed
7194below, together with the type of the associated VALUE (in parentheses).
7195Not all platforms support all of these attributes; unsupported
7196attributes will not appear in the returned alist.
7197Unless explicitly indicated otherwise, numbers can have either
7198integer or floating point values.
7199
7200 euid -- Effective user User ID of the process (number)
7201 user -- User name corresponding to euid (string)
7202 egid -- Effective user Group ID of the process (number)
7203 group -- Group name corresponding to egid (string)
7204 comm -- Command name (executable name only) (string)
7205 state -- Process state code, such as "S", "R", or "T" (string)
7206 ppid -- Parent process ID (number)
7207 pgrp -- Process group ID (number)
7208 sess -- Session ID, i.e. process ID of session leader (number)
7209 ttname -- Controlling tty name (string)
7210 tpgid -- ID of foreground process group on the process's tty (number)
7211 minflt -- number of minor page faults (number)
7212 majflt -- number of major page faults (number)
7213 cminflt -- cumulative number of minor page faults (number)
7214 cmajflt -- cumulative number of major page faults (number)
7215 utime -- user time used by the process, in the (HIGH LOW USEC) format
7216 stime -- system time used by the process, in the (HIGH LOW USEC) format
7217 time -- sum of utime and stime, in the (HIGH LOW USEC) format
7218 cutime -- user time used by the process and its children, (HIGH LOW USEC)
7219 cstime -- system time used by the process and its children, (HIGH LOW USEC)
7220 ctime -- sum of cutime and cstime, in the (HIGH LOW USEC) format
7221 pri -- priority of the process (number)
7222 nice -- nice value of the process (number)
7223 thcount -- process thread count (number)
7224 start -- time the process started, in the (HIGH LOW USEC) format
7225 vsize -- virtual memory size of the process in KB's (number)
7226 rss -- resident set size of the process in KB's (number)
7227 etime -- elapsed time the process is running, in (HIGH LOW USEC) format
7228 pcpu -- percents of CPU time used by the process (floating-point number)
7229 pmem -- percents of total physical memory used by process's resident set
7230 (floating-point number)
7231 args -- command line which invoked the process (string). */)
7232 ( Lisp_Object pid)
7233{
7234 return system_process_attributes (pid);
7235}
7236
7237\f
7238void
7239init_process (void)
7240{
7241#ifdef subprocesses
7242 register int i;
7243
7244 inhibit_sentinels = 0;
7245
7246#ifdef SIGCHLD
7247#ifndef CANNOT_DUMP
7248 if (! noninteractive || initialized)
7249#endif
7250 signal (SIGCHLD, sigchld_handler);
7251#endif
7252
7253 FD_ZERO (&input_wait_mask);
7254 FD_ZERO (&non_keyboard_wait_mask);
7255 FD_ZERO (&non_process_wait_mask);
3fad2ad2 7256 FD_ZERO (&write_mask);
f388c88a 7257 max_process_desc = 0;
3fad2ad2 7258 memset (fd_callback_info, 0, sizeof (fd_callback_info));
f388c88a
EZ
7259
7260#ifdef NON_BLOCKING_CONNECT
7261 FD_ZERO (&connect_wait_mask);
7262 num_pending_connects = 0;
7263#endif
7264
7265#ifdef ADAPTIVE_READ_BUFFERING
7266 process_output_delay_count = 0;
7267 process_output_skip = 0;
7268#endif
7269
7270 /* Don't do this, it caused infinite select loops. The display
7271 method should call add_keyboard_wait_descriptor on stdin if it
7272 needs that. */
7273#if 0
7274 FD_SET (0, &input_wait_mask);
7275#endif
7276
7277 Vprocess_alist = Qnil;
7278#ifdef SIGCHLD
7279 deleted_pid_list = Qnil;
7280#endif
7281 for (i = 0; i < MAXDESC; i++)
7282 {
7283 chan_process[i] = Qnil;
7284 proc_buffered_char[i] = -1;
7285 }
7286 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
7287 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
7288#ifdef DATAGRAM_SOCKETS
7289 memset (datagram_address, 0, sizeof datagram_address);
7290#endif
7291
f388c88a
EZ
7292 {
7293 Lisp_Object subfeatures = Qnil;
7294 const struct socket_options *sopt;
7295
7296#define ADD_SUBFEATURE(key, val) \
7297 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
7298
7299#ifdef NON_BLOCKING_CONNECT
7300 ADD_SUBFEATURE (QCnowait, Qt);
7301#endif
7302#ifdef DATAGRAM_SOCKETS
7303 ADD_SUBFEATURE (QCtype, Qdatagram);
7304#endif
7305#ifdef HAVE_SEQPACKET
7306 ADD_SUBFEATURE (QCtype, Qseqpacket);
7307#endif
7308#ifdef HAVE_LOCAL_SOCKETS
7309 ADD_SUBFEATURE (QCfamily, Qlocal);
7310#endif
7311 ADD_SUBFEATURE (QCfamily, Qipv4);
7312#ifdef AF_INET6
7313 ADD_SUBFEATURE (QCfamily, Qipv6);
7314#endif
7315#ifdef HAVE_GETSOCKNAME
7316 ADD_SUBFEATURE (QCservice, Qt);
7317#endif
5e617bc2 7318#if defined (O_NONBLOCK) || defined (O_NDELAY)
f388c88a
EZ
7319 ADD_SUBFEATURE (QCserver, Qt);
7320#endif
7321
7322 for (sopt = socket_options; sopt->name; sopt++)
7323 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
7324
7325 Fprovide (intern_c_string ("make-network-process"), subfeatures);
7326 }
f388c88a
EZ
7327
7328#if defined (DARWIN_OS)
7329 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7330 processes. As such, we only change the default value. */
7331 if (initialized)
7332 {
f44bd759
PE
7333 char const *release = (STRINGP (Voperating_system_release)
7334 ? SSDATA (Voperating_system_release)
7335 : 0);
f388c88a
EZ
7336 if (!release || !release[0] || (release[0] < MIN_PTY_KERNEL_VERSION
7337 && release[1] == '.')) {
7338 Vprocess_connection_type = Qnil;
7339 }
7340 }
7341#endif
7342#endif /* subprocesses */
7343 kbd_is_on_hold = 0;
7344}
7345
7346void
7347syms_of_process (void)
7348{
7349#ifdef subprocesses
7350
cd3520a4
JB
7351 DEFSYM (Qprocessp, "processp");
7352 DEFSYM (Qrun, "run");
7353 DEFSYM (Qstop, "stop");
7354 DEFSYM (Qsignal, "signal");
f388c88a
EZ
7355
7356 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7357 here again.
934e2a68 7358
f388c88a
EZ
7359 Qexit = intern_c_string ("exit");
7360 staticpro (&Qexit); */
934e2a68 7361
cd3520a4
JB
7362 DEFSYM (Qopen, "open");
7363 DEFSYM (Qclosed, "closed");
7364 DEFSYM (Qconnect, "connect");
7365 DEFSYM (Qfailed, "failed");
7366 DEFSYM (Qlisten, "listen");
7367 DEFSYM (Qlocal, "local");
7368 DEFSYM (Qipv4, "ipv4");
f388c88a 7369#ifdef AF_INET6
cd3520a4
JB
7370 DEFSYM (Qipv6, "ipv6");
7371#endif
7372 DEFSYM (Qdatagram, "datagram");
7373 DEFSYM (Qseqpacket, "seqpacket");
7374
7375 DEFSYM (QCport, ":port");
7376 DEFSYM (QCspeed, ":speed");
7377 DEFSYM (QCprocess, ":process");
7378
7379 DEFSYM (QCbytesize, ":bytesize");
7380 DEFSYM (QCstopbits, ":stopbits");
7381 DEFSYM (QCparity, ":parity");
7382 DEFSYM (Qodd, "odd");
7383 DEFSYM (Qeven, "even");
7384 DEFSYM (QCflowcontrol, ":flowcontrol");
7385 DEFSYM (Qhw, "hw");
7386 DEFSYM (Qsw, "sw");
7387 DEFSYM (QCsummary, ":summary");
7388
7389 DEFSYM (Qreal, "real");
7390 DEFSYM (Qnetwork, "network");
7391 DEFSYM (Qserial, "serial");
7392 DEFSYM (QCbuffer, ":buffer");
7393 DEFSYM (QChost, ":host");
7394 DEFSYM (QCservice, ":service");
7395 DEFSYM (QClocal, ":local");
7396 DEFSYM (QCremote, ":remote");
7397 DEFSYM (QCcoding, ":coding");
7398 DEFSYM (QCserver, ":server");
7399 DEFSYM (QCnowait, ":nowait");
7400 DEFSYM (QCsentinel, ":sentinel");
7401 DEFSYM (QClog, ":log");
7402 DEFSYM (QCnoquery, ":noquery");
7403 DEFSYM (QCstop, ":stop");
7404 DEFSYM (QCoptions, ":options");
7405 DEFSYM (QCplist, ":plist");
7406
7407 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
934e2a68 7408
f388c88a
EZ
7409 staticpro (&Vprocess_alist);
7410#ifdef SIGCHLD
7411 staticpro (&deleted_pid_list);
7412#endif
934e2a68 7413
f388c88a 7414#endif /* subprocesses */
6720a7fb 7415
cd3520a4
JB
7416 DEFSYM (QCname, ":name");
7417 DEFSYM (QCtype, ":type");
7418
7419 DEFSYM (Qeuid, "euid");
7420 DEFSYM (Qegid, "egid");
7421 DEFSYM (Quser, "user");
7422 DEFSYM (Qgroup, "group");
7423 DEFSYM (Qcomm, "comm");
7424 DEFSYM (Qstate, "state");
7425 DEFSYM (Qppid, "ppid");
7426 DEFSYM (Qpgrp, "pgrp");
7427 DEFSYM (Qsess, "sess");
7428 DEFSYM (Qttname, "ttname");
7429 DEFSYM (Qtpgid, "tpgid");
7430 DEFSYM (Qminflt, "minflt");
7431 DEFSYM (Qmajflt, "majflt");
7432 DEFSYM (Qcminflt, "cminflt");
7433 DEFSYM (Qcmajflt, "cmajflt");
7434 DEFSYM (Qutime, "utime");
7435 DEFSYM (Qstime, "stime");
7436 DEFSYM (Qtime, "time");
7437 DEFSYM (Qcutime, "cutime");
7438 DEFSYM (Qcstime, "cstime");
7439 DEFSYM (Qctime, "ctime");
7440 DEFSYM (Qpri, "pri");
7441 DEFSYM (Qnice, "nice");
7442 DEFSYM (Qthcount, "thcount");
7443 DEFSYM (Qstart, "start");
7444 DEFSYM (Qvsize, "vsize");
7445 DEFSYM (Qrss, "rss");
7446 DEFSYM (Qetime, "etime");
7447 DEFSYM (Qpcpu, "pcpu");
7448 DEFSYM (Qpmem, "pmem");
7449 DEFSYM (Qargs, "args");
9057ff80 7450
29208e82 7451 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
f388c88a
EZ
7452 doc: /* *Non-nil means delete processes immediately when they exit.
7453A value of nil means don't delete them until `list-processes' is run. */);
7454
7455 delete_exited_processes = 1;
7456
462aa963 7457#ifdef subprocesses
29208e82 7458 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
f388c88a
EZ
7459 doc: /* Control type of device used to communicate with subprocesses.
7460Values are nil to use a pipe, or t or `pty' to use a pty.
7461The value has no effect if the system has no ptys or if all ptys are busy:
7462then a pipe is used in any case.
7463The value takes effect when `start-process' is called. */);
7464 Vprocess_connection_type = Qt;
7465
7466#ifdef ADAPTIVE_READ_BUFFERING
29208e82 7467 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
f388c88a
EZ
7468 doc: /* If non-nil, improve receive buffering by delaying after short reads.
7469On some systems, when Emacs reads the output from a subprocess, the output data
7470is read in very small blocks, potentially resulting in very poor performance.
7471This behavior can be remedied to some extent by setting this variable to a
7472non-nil value, as it will automatically delay reading from such processes, to
7473allow them to produce more output before Emacs tries to read it.
7474If the value is t, the delay is reset after each write to the process; any other
7475non-nil value means that the delay is not reset on write.
7476The variable takes effect when `start-process' is called. */);
7477 Vprocess_adaptive_read_buffering = Qt;
7478#endif
7479
7480 defsubr (&Sprocessp);
7481 defsubr (&Sget_process);
7482 defsubr (&Sdelete_process);
7483 defsubr (&Sprocess_status);
7484 defsubr (&Sprocess_exit_status);
7485 defsubr (&Sprocess_id);
7486 defsubr (&Sprocess_name);
7487 defsubr (&Sprocess_tty_name);
7488 defsubr (&Sprocess_command);
7489 defsubr (&Sset_process_buffer);
7490 defsubr (&Sprocess_buffer);
7491 defsubr (&Sprocess_mark);
7492 defsubr (&Sset_process_filter);
7493 defsubr (&Sprocess_filter);
7494 defsubr (&Sset_process_sentinel);
7495 defsubr (&Sprocess_sentinel);
7496 defsubr (&Sset_process_window_size);
7497 defsubr (&Sset_process_inherit_coding_system_flag);
7498 defsubr (&Sset_process_query_on_exit_flag);
7499 defsubr (&Sprocess_query_on_exit_flag);
7500 defsubr (&Sprocess_contact);
7501 defsubr (&Sprocess_plist);
7502 defsubr (&Sset_process_plist);
f388c88a
EZ
7503 defsubr (&Sprocess_list);
7504 defsubr (&Sstart_process);
f388c88a
EZ
7505 defsubr (&Sserial_process_configure);
7506 defsubr (&Smake_serial_process);
f388c88a
EZ
7507 defsubr (&Sset_network_process_option);
7508 defsubr (&Smake_network_process);
7509 defsubr (&Sformat_network_address);
5e617bc2 7510#if defined (HAVE_NET_IF_H)
f388c88a
EZ
7511#ifdef SIOCGIFCONF
7512 defsubr (&Snetwork_interface_list);
7513#endif
5e617bc2 7514#if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
f388c88a
EZ
7515 defsubr (&Snetwork_interface_info);
7516#endif
5e617bc2 7517#endif /* defined (HAVE_NET_IF_H) */
f388c88a
EZ
7518#ifdef DATAGRAM_SOCKETS
7519 defsubr (&Sprocess_datagram_address);
7520 defsubr (&Sset_process_datagram_address);
7521#endif
7522 defsubr (&Saccept_process_output);
7523 defsubr (&Sprocess_send_region);
7524 defsubr (&Sprocess_send_string);
7525 defsubr (&Sinterrupt_process);
7526 defsubr (&Skill_process);
7527 defsubr (&Squit_process);
7528 defsubr (&Sstop_process);
7529 defsubr (&Scontinue_process);
7530 defsubr (&Sprocess_running_child_p);
7531 defsubr (&Sprocess_send_eof);
7532 defsubr (&Ssignal_process);
7533 defsubr (&Swaiting_for_user_input_p);
7534 defsubr (&Sprocess_type);
7535 defsubr (&Sset_process_coding_system);
7536 defsubr (&Sprocess_coding_system);
7537 defsubr (&Sset_process_filter_multibyte);
7538 defsubr (&Sprocess_filter_multibyte_p);
7539
7540#endif /* subprocesses */
7541
6720a7fb 7542 defsubr (&Sget_buffer_process);
52a1b894 7543 defsubr (&Sprocess_inherit_coding_system_flag);
934e2a68 7544 defsubr (&Slist_system_processes);
a20878b6 7545 defsubr (&Sprocess_attributes);
6720a7fb 7546}