Document that 'make-process' mixes the output streams
[emacs.git] / src / process.c
blobc357a8bdc3378f67cd9e8565b94d12daba40724c
1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2018 Free Software
4 Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
22 #include <config.h>
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <errno.h>
27 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
28 #include <sys/file.h>
29 #include <sys/stat.h>
30 #include <unistd.h>
31 #include <fcntl.h>
33 #include "lisp.h"
35 /* Only MS-DOS does not define `subprocesses'. */
36 #ifdef subprocesses
38 #include <sys/socket.h>
39 #include <netdb.h>
40 #include <netinet/in.h>
41 #include <arpa/inet.h>
43 #endif /* subprocesses */
45 #ifdef HAVE_SETRLIMIT
46 # include <sys/resource.h>
48 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
49 NOFILE_LIMIT is the initial limit on the number of open files,
50 which should be restored in child processes. */
51 static struct rlimit nofile_limit;
52 #endif
54 #ifdef subprocesses
56 /* Are local (unix) sockets supported? */
57 #if defined (HAVE_SYS_UN_H)
58 #if !defined (AF_LOCAL) && defined (AF_UNIX)
59 #define AF_LOCAL AF_UNIX
60 #endif
61 #ifdef AF_LOCAL
62 #define HAVE_LOCAL_SOCKETS
63 #include <sys/un.h>
64 #endif
65 #endif
67 #include <sys/ioctl.h>
68 #if defined (HAVE_NET_IF_H)
69 #include <net/if.h>
70 #endif /* HAVE_NET_IF_H */
72 #if defined (HAVE_IFADDRS_H)
73 /* Must be after net/if.h */
74 #include <ifaddrs.h>
76 /* We only use structs from this header when we use getifaddrs. */
77 #if defined (HAVE_NET_IF_DL_H)
78 #include <net/if_dl.h>
79 #endif
81 #endif
83 #ifdef NEED_BSDTTY
84 #include <bsdtty.h>
85 #endif
87 #ifdef USG5_4
88 # include <sys/stream.h>
89 # include <sys/stropts.h>
90 #endif
92 #ifdef HAVE_UTIL_H
93 #include <util.h>
94 #endif
96 #ifdef HAVE_PTY_H
97 #include <pty.h>
98 #endif
100 #include <c-ctype.h>
101 #include <flexmember.h>
102 #include <sig2str.h>
103 #include <verify.h>
105 #endif /* subprocesses */
107 #include "systime.h"
108 #include "systty.h"
110 #include "window.h"
111 #include "character.h"
112 #include "buffer.h"
113 #include "coding.h"
114 #include "process.h"
115 #include "frame.h"
116 #include "termopts.h"
117 #include "keyboard.h"
118 #include "blockinput.h"
119 #include "atimer.h"
120 #include "sysselect.h"
121 #include "syssignal.h"
122 #include "syswait.h"
123 #ifdef HAVE_GNUTLS
124 #include "gnutls.h"
125 #endif
127 #ifdef HAVE_WINDOW_SYSTEM
128 #include TERM_HEADER
129 #endif /* HAVE_WINDOW_SYSTEM */
131 #ifdef HAVE_GLIB
132 #include "xgselect.h"
133 #ifndef WINDOWSNT
134 #include <glib.h>
135 #endif
136 #endif
138 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
139 /* This is 0.1s in nanoseconds. */
140 #define ASYNC_RETRY_NSEC 100000000
141 #endif
143 #ifdef WINDOWSNT
144 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
145 const struct timespec *, const sigset_t *);
146 #endif
148 /* Work around GCC 4.3.0 bug with strict overflow checking; see
149 <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
150 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
151 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
152 # pragma GCC diagnostic ignored "-Wstrict-overflow"
153 #endif
155 /* True if keyboard input is on hold, zero otherwise. */
157 static bool kbd_is_on_hold;
159 /* Nonzero means don't run process sentinels. This is used
160 when exiting. */
161 bool inhibit_sentinels;
163 union u_sockaddr
165 struct sockaddr sa;
166 struct sockaddr_in in;
167 #ifdef AF_INET6
168 struct sockaddr_in6 in6;
169 #endif
170 #ifdef HAVE_LOCAL_SOCKETS
171 struct sockaddr_un un;
172 #endif
175 #ifdef subprocesses
177 #ifndef SOCK_CLOEXEC
178 # define SOCK_CLOEXEC 0
179 #endif
180 #ifndef SOCK_NONBLOCK
181 # define SOCK_NONBLOCK 0
182 #endif
184 /* True if ERRNUM represents an error where the system call would
185 block if a blocking variant were used. */
186 static bool
187 would_block (int errnum)
189 #ifdef EWOULDBLOCK
190 if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
191 return true;
192 #endif
193 return errnum == EAGAIN;
196 #ifndef HAVE_ACCEPT4
198 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
200 static int
201 close_on_exec (int fd)
203 if (0 <= fd)
204 fcntl (fd, F_SETFD, FD_CLOEXEC);
205 return fd;
208 # undef accept4
209 # define accept4(sockfd, addr, addrlen, flags) \
210 process_accept4 (sockfd, addr, addrlen, flags)
211 static int
212 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
214 return close_on_exec (accept (sockfd, addr, addrlen));
217 static int
218 process_socket (int domain, int type, int protocol)
220 return close_on_exec (socket (domain, type, protocol));
222 # undef socket
223 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
224 #endif
226 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
227 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
228 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
229 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
230 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
231 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
233 /* Number of events of change of status of a process. */
234 static EMACS_INT process_tick;
235 /* Number of events for which the user or sentinel has been notified. */
236 static EMACS_INT update_tick;
238 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
239 this system. We need to read full packets, so we need a
240 "non-destructive" select. So we require either native select,
241 or emulation of select using FIONREAD. */
243 #ifndef BROKEN_DATAGRAM_SOCKETS
244 # if defined HAVE_SELECT || defined USABLE_FIONREAD
245 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
246 # define DATAGRAM_SOCKETS
247 # endif
248 # endif
249 #endif
251 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
252 # define HAVE_SEQPACKET
253 #endif
255 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
256 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
257 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
259 /* Number of processes which have a non-zero read_output_delay,
260 and therefore might be delayed for adaptive read buffering. */
262 static int process_output_delay_count;
264 /* True if any process has non-nil read_output_skip. */
266 static bool process_output_skip;
268 static void start_process_unwind (Lisp_Object);
269 static void create_process (Lisp_Object, char **, Lisp_Object);
270 #ifdef USABLE_SIGIO
271 static bool keyboard_bit_set (fd_set *);
272 #endif
273 static void deactivate_process (Lisp_Object);
274 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
275 static int read_process_output (Lisp_Object, int);
276 static void create_pty (Lisp_Object);
277 static void exec_sentinel (Lisp_Object, Lisp_Object);
279 /* Number of bits set in connect_wait_mask. */
280 static int num_pending_connects;
282 /* The largest descriptor currently in use; -1 if none. */
283 static int max_desc;
285 /* Set the external socket descriptor for Emacs to use when
286 `make-network-process' is called with a non-nil
287 `:use-external-socket' option. The value should be either -1, or
288 the file descriptor of a socket that is already bound. */
289 static int external_sock_fd;
291 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
292 static Lisp_Object chan_process[FD_SETSIZE];
293 static void wait_for_socket_fds (Lisp_Object, char const *);
295 /* Alist of elements (NAME . PROCESS). */
296 static Lisp_Object Vprocess_alist;
298 /* Buffered-ahead input char from process, indexed by channel.
299 -1 means empty (no char is buffered).
300 Used on sys V where the only way to tell if there is any
301 output from the process is to read at least one char.
302 Always -1 on systems that support FIONREAD. */
304 static int proc_buffered_char[FD_SETSIZE];
306 /* Table of `struct coding-system' for each process. */
307 static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
308 static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
310 #ifdef DATAGRAM_SOCKETS
311 /* Table of `partner address' for datagram sockets. */
312 static struct sockaddr_and_len {
313 struct sockaddr *sa;
314 ptrdiff_t len;
315 } datagram_address[FD_SETSIZE];
316 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
317 #define DATAGRAM_CONN_P(proc) \
318 (PROCESSP (proc) && \
319 XPROCESS (proc)->infd >= 0 && \
320 datagram_address[XPROCESS (proc)->infd].sa != 0)
321 #else
322 #define DATAGRAM_CONN_P(proc) (0)
323 #endif
325 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
326 a `for' loop which iterates over processes from Vprocess_alist. */
328 #define FOR_EACH_PROCESS(list_var, proc_var) \
329 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
331 /* These setters are used only in this file, so they can be private. */
332 static void
333 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
335 p->buffer = val;
337 static void
338 pset_command (struct Lisp_Process *p, Lisp_Object val)
340 p->command = val;
342 static void
343 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
345 p->decode_coding_system = val;
347 static void
348 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
350 p->decoding_buf = val;
352 static void
353 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
355 p->encode_coding_system = val;
357 static void
358 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
360 p->encoding_buf = val;
362 static void
363 pset_filter (struct Lisp_Process *p, Lisp_Object val)
365 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
367 static void
368 pset_log (struct Lisp_Process *p, Lisp_Object val)
370 p->log = val;
372 static void
373 pset_mark (struct Lisp_Process *p, Lisp_Object val)
375 p->mark = val;
377 static void
378 pset_thread (struct Lisp_Process *p, Lisp_Object val)
380 p->thread = val;
382 static void
383 pset_name (struct Lisp_Process *p, Lisp_Object val)
385 p->name = val;
387 static void
388 pset_plist (struct Lisp_Process *p, Lisp_Object val)
390 p->plist = val;
392 static void
393 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
395 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
397 static void
398 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
400 p->tty_name = val;
402 static void
403 pset_type (struct Lisp_Process *p, Lisp_Object val)
405 p->type = val;
407 static void
408 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
410 p->write_queue = val;
412 static void
413 pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
415 p->stderrproc = val;
419 static Lisp_Object
420 make_lisp_proc (struct Lisp_Process *p)
422 return make_lisp_ptr (p, Lisp_Vectorlike);
425 enum fd_bits
427 /* Read from file descriptor. */
428 FOR_READ = 1,
429 /* Write to file descriptor. */
430 FOR_WRITE = 2,
431 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
432 set. */
433 KEYBOARD_FD = 4,
434 /* This descriptor refers to a process. */
435 PROCESS_FD = 8,
436 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
437 NON_BLOCKING_CONNECT_FD = 16
440 static struct fd_callback_data
442 fd_callback func;
443 void *data;
444 /* Flags from enum fd_bits. */
445 int flags;
446 /* If this fd is locked to a certain thread, this points to it.
447 Otherwise, this is NULL. If an fd is locked to a thread, then
448 only that thread is permitted to wait on it. */
449 struct thread_state *thread;
450 /* If this fd is currently being selected on by a thread, this
451 points to the thread. Otherwise it is NULL. */
452 struct thread_state *waiting_thread;
453 } fd_callback_info[FD_SETSIZE];
456 /* Add a file descriptor FD to be monitored for when read is possible.
457 When read is possible, call FUNC with argument DATA. */
459 void
460 add_read_fd (int fd, fd_callback func, void *data)
462 add_keyboard_wait_descriptor (fd);
464 fd_callback_info[fd].func = func;
465 fd_callback_info[fd].data = data;
468 static void
469 add_non_keyboard_read_fd (int fd)
471 eassert (fd >= 0 && fd < FD_SETSIZE);
472 eassert (fd_callback_info[fd].func == NULL);
474 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
475 fd_callback_info[fd].flags |= FOR_READ;
476 if (fd > max_desc)
477 max_desc = fd;
480 static void
481 add_process_read_fd (int fd)
483 add_non_keyboard_read_fd (fd);
484 fd_callback_info[fd].flags |= PROCESS_FD;
487 /* Stop monitoring file descriptor FD for when read is possible. */
489 void
490 delete_read_fd (int fd)
492 delete_keyboard_wait_descriptor (fd);
494 if (fd_callback_info[fd].flags == 0)
496 fd_callback_info[fd].func = 0;
497 fd_callback_info[fd].data = 0;
501 /* Add a file descriptor FD to be monitored for when write is possible.
502 When write is possible, call FUNC with argument DATA. */
504 void
505 add_write_fd (int fd, fd_callback func, void *data)
507 eassert (fd >= 0 && fd < FD_SETSIZE);
509 fd_callback_info[fd].func = func;
510 fd_callback_info[fd].data = data;
511 fd_callback_info[fd].flags |= FOR_WRITE;
512 if (fd > max_desc)
513 max_desc = fd;
516 static void
517 add_non_blocking_write_fd (int fd)
519 eassert (fd >= 0 && fd < FD_SETSIZE);
520 eassert (fd_callback_info[fd].func == NULL);
522 fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
523 if (fd > max_desc)
524 max_desc = fd;
525 ++num_pending_connects;
528 static void
529 recompute_max_desc (void)
531 int fd;
533 for (fd = max_desc; fd >= 0; --fd)
535 if (fd_callback_info[fd].flags != 0)
537 max_desc = fd;
538 break;
543 /* Stop monitoring file descriptor FD for when write is possible. */
545 void
546 delete_write_fd (int fd)
548 if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
550 if (--num_pending_connects < 0)
551 emacs_abort ();
553 fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
554 if (fd_callback_info[fd].flags == 0)
556 fd_callback_info[fd].func = 0;
557 fd_callback_info[fd].data = 0;
559 if (fd == max_desc)
560 recompute_max_desc ();
564 static void
565 compute_input_wait_mask (fd_set *mask)
567 int fd;
569 FD_ZERO (mask);
570 for (fd = 0; fd <= max_desc; ++fd)
572 if (fd_callback_info[fd].thread != NULL
573 && fd_callback_info[fd].thread != current_thread)
574 continue;
575 if (fd_callback_info[fd].waiting_thread != NULL
576 && fd_callback_info[fd].waiting_thread != current_thread)
577 continue;
578 if ((fd_callback_info[fd].flags & FOR_READ) != 0)
580 FD_SET (fd, mask);
581 fd_callback_info[fd].waiting_thread = current_thread;
586 static void
587 compute_non_process_wait_mask (fd_set *mask)
589 int fd;
591 FD_ZERO (mask);
592 for (fd = 0; fd <= max_desc; ++fd)
594 if (fd_callback_info[fd].thread != NULL
595 && fd_callback_info[fd].thread != current_thread)
596 continue;
597 if (fd_callback_info[fd].waiting_thread != NULL
598 && fd_callback_info[fd].waiting_thread != current_thread)
599 continue;
600 if ((fd_callback_info[fd].flags & FOR_READ) != 0
601 && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
603 FD_SET (fd, mask);
604 fd_callback_info[fd].waiting_thread = current_thread;
609 static void
610 compute_non_keyboard_wait_mask (fd_set *mask)
612 int fd;
614 FD_ZERO (mask);
615 for (fd = 0; fd <= max_desc; ++fd)
617 if (fd_callback_info[fd].thread != NULL
618 && fd_callback_info[fd].thread != current_thread)
619 continue;
620 if (fd_callback_info[fd].waiting_thread != NULL
621 && fd_callback_info[fd].waiting_thread != current_thread)
622 continue;
623 if ((fd_callback_info[fd].flags & FOR_READ) != 0
624 && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
626 FD_SET (fd, mask);
627 fd_callback_info[fd].waiting_thread = current_thread;
632 static void
633 compute_write_mask (fd_set *mask)
635 int fd;
637 FD_ZERO (mask);
638 for (fd = 0; fd <= max_desc; ++fd)
640 if (fd_callback_info[fd].thread != NULL
641 && fd_callback_info[fd].thread != current_thread)
642 continue;
643 if (fd_callback_info[fd].waiting_thread != NULL
644 && fd_callback_info[fd].waiting_thread != current_thread)
645 continue;
646 if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
648 FD_SET (fd, mask);
649 fd_callback_info[fd].waiting_thread = current_thread;
654 static void
655 clear_waiting_thread_info (void)
657 int fd;
659 for (fd = 0; fd <= max_desc; ++fd)
661 if (fd_callback_info[fd].waiting_thread == current_thread)
662 fd_callback_info[fd].waiting_thread = NULL;
667 /* Compute the Lisp form of the process status, p->status, from
668 the numeric status that was returned by `wait'. */
670 static Lisp_Object status_convert (int);
672 static void
673 update_status (struct Lisp_Process *p)
675 eassert (p->raw_status_new);
676 pset_status (p, status_convert (p->raw_status));
677 p->raw_status_new = 0;
680 /* Convert a process status word in Unix format to
681 the list that we use internally. */
683 static Lisp_Object
684 status_convert (int w)
686 if (WIFSTOPPED (w))
687 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
688 else if (WIFEXITED (w))
689 return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
690 WCOREDUMP (w) ? Qt : Qnil));
691 else if (WIFSIGNALED (w))
692 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
693 WCOREDUMP (w) ? Qt : Qnil));
694 else
695 return Qrun;
698 /* True if STATUS is that of a process attempting connection. */
700 static bool
701 connecting_status (Lisp_Object status)
703 return CONSP (status) && EQ (XCAR (status), Qconnect);
706 /* Given a status-list, extract the three pieces of information
707 and store them individually through the three pointers. */
709 static void
710 decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
711 bool *coredump)
713 Lisp_Object tem;
715 if (connecting_status (l))
716 l = XCAR (l);
718 if (SYMBOLP (l))
720 *symbol = l;
721 *code = make_number (0);
722 *coredump = 0;
724 else
726 *symbol = XCAR (l);
727 tem = XCDR (l);
728 *code = XCAR (tem);
729 tem = XCDR (tem);
730 *coredump = !NILP (tem);
734 /* Return a string describing a process status list. */
736 static Lisp_Object
737 status_message (struct Lisp_Process *p)
739 Lisp_Object status = p->status;
740 Lisp_Object symbol, code;
741 bool coredump;
742 Lisp_Object string;
744 decode_status (status, &symbol, &code, &coredump);
746 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
748 char const *signame;
749 synchronize_system_messages_locale ();
750 signame = strsignal (XFASTINT (code));
751 if (signame == 0)
752 string = build_string ("unknown");
753 else
755 int c1, c2;
757 string = build_unibyte_string (signame);
758 if (! NILP (Vlocale_coding_system))
759 string = (code_convert_string_norecord
760 (string, Vlocale_coding_system, 0));
761 c1 = STRING_CHAR (SDATA (string));
762 c2 = downcase (c1);
763 if (c1 != c2)
764 Faset (string, make_number (0), make_number (c2));
766 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
767 return concat2 (string, suffix);
769 else if (EQ (symbol, Qexit))
771 if (NETCONN1_P (p))
772 return build_string (XFASTINT (code) == 0
773 ? "deleted\n"
774 : "connection broken by remote peer\n");
775 if (XFASTINT (code) == 0)
776 return build_string ("finished\n");
777 AUTO_STRING (prefix, "exited abnormally with code ");
778 string = Fnumber_to_string (code);
779 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
780 return concat3 (prefix, string, suffix);
782 else if (EQ (symbol, Qfailed))
784 AUTO_STRING (format, "failed with code %s\n");
785 return CALLN (Fformat, format, code);
787 else
788 return Fcopy_sequence (Fsymbol_name (symbol));
791 enum { PTY_NAME_SIZE = 24 };
793 /* Open an available pty, returning a file descriptor.
794 Store into PTY_NAME the file name of the terminal corresponding to the pty.
795 Return -1 on failure. */
797 static int
798 allocate_pty (char pty_name[PTY_NAME_SIZE])
800 #ifdef HAVE_PTYS
801 int fd;
803 #ifdef PTY_ITERATION
804 PTY_ITERATION
805 #else
806 register int c, i;
807 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
808 for (i = 0; i < 16; i++)
809 #endif
811 #ifdef PTY_NAME_SPRINTF
812 PTY_NAME_SPRINTF
813 #else
814 sprintf (pty_name, "/dev/pty%c%x", c, i);
815 #endif /* no PTY_NAME_SPRINTF */
817 #ifdef PTY_OPEN
818 PTY_OPEN;
819 #else /* no PTY_OPEN */
820 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
821 #endif /* no PTY_OPEN */
823 if (fd >= 0)
825 #ifdef PTY_TTY_NAME_SPRINTF
826 PTY_TTY_NAME_SPRINTF
827 #else
828 sprintf (pty_name, "/dev/tty%c%x", c, i);
829 #endif /* no PTY_TTY_NAME_SPRINTF */
831 /* Set FD's close-on-exec flag. This is needed even if
832 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
833 doesn't require support for that combination.
834 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
835 doesn't work if the close-on-exec flag is set (Bug#20555).
836 Multithreaded platforms where posix_openpt ignores
837 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
838 have a race condition between the PTY_OPEN and here. */
839 fcntl (fd, F_SETFD, FD_CLOEXEC);
841 /* Check to make certain that both sides are available.
842 This avoids a nasty yet stupid bug in rlogins. */
843 if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
845 emacs_close (fd);
846 continue;
848 setup_pty (fd);
849 return fd;
852 #endif /* HAVE_PTYS */
853 return -1;
856 /* Allocate basically initialized process. */
858 static struct Lisp_Process *
859 allocate_process (void)
861 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
864 static Lisp_Object
865 make_process (Lisp_Object name)
867 struct Lisp_Process *p = allocate_process ();
868 /* Initialize Lisp data. Note that allocate_process initializes all
869 Lisp data to nil, so do it only for slots which should not be nil. */
870 pset_status (p, Qrun);
871 pset_mark (p, Fmake_marker ());
872 pset_thread (p, Fcurrent_thread ());
874 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
875 non-Lisp data, so do it only for slots which should not be zero. */
876 p->infd = -1;
877 p->outfd = -1;
878 for (int i = 0; i < PROCESS_OPEN_FDS; i++)
879 p->open_fd[i] = -1;
881 #ifdef HAVE_GNUTLS
882 verify (GNUTLS_STAGE_EMPTY == 0);
883 eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
884 eassert (NILP (p->gnutls_boot_parameters));
885 #endif
887 /* If name is already in use, modify it until it is unused. */
889 Lisp_Object name1 = name;
890 for (printmax_t i = 1; ; i++)
892 Lisp_Object tem = Fget_process (name1);
893 if (NILP (tem))
894 break;
895 char const suffix_fmt[] = "<%"pMd">";
896 char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
897 AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
898 name1 = concat2 (name, lsuffix);
900 name = name1;
901 pset_name (p, name);
902 pset_sentinel (p, Qinternal_default_process_sentinel);
903 pset_filter (p, Qinternal_default_process_filter);
904 Lisp_Object val;
905 XSETPROCESS (val, p);
906 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
907 return val;
910 static void
911 remove_process (register Lisp_Object proc)
913 register Lisp_Object pair;
915 pair = Frassq (proc, Vprocess_alist);
916 Vprocess_alist = Fdelq (pair, Vprocess_alist);
918 deactivate_process (proc);
921 void
922 update_processes_for_thread_death (Lisp_Object dying_thread)
924 Lisp_Object pair;
926 for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
928 Lisp_Object process = XCDR (XCAR (pair));
929 if (EQ (XPROCESS (process)->thread, dying_thread))
931 struct Lisp_Process *proc = XPROCESS (process);
933 pset_thread (proc, Qnil);
934 if (proc->infd >= 0)
935 fd_callback_info[proc->infd].thread = NULL;
936 if (proc->outfd >= 0)
937 fd_callback_info[proc->outfd].thread = NULL;
942 #ifdef HAVE_GETADDRINFO_A
943 static void
944 free_dns_request (Lisp_Object proc)
946 struct Lisp_Process *p = XPROCESS (proc);
948 if (p->dns_request->ar_result)
949 freeaddrinfo (p->dns_request->ar_result);
950 xfree (p->dns_request);
951 p->dns_request = NULL;
953 #endif
956 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
957 doc: /* Return t if OBJECT is a process. */)
958 (Lisp_Object object)
960 return PROCESSP (object) ? Qt : Qnil;
963 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
964 doc: /* Return the process named NAME, or nil if there is none. */)
965 (register Lisp_Object name)
967 if (PROCESSP (name))
968 return name;
969 CHECK_STRING (name);
970 return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
973 /* This is how commands for the user decode process arguments. It
974 accepts a process, a process name, a buffer, a buffer name, or nil.
975 Buffers denote the first process in the buffer, and nil denotes the
976 current buffer. */
978 static Lisp_Object
979 get_process (register Lisp_Object name)
981 register Lisp_Object proc, obj;
982 if (STRINGP (name))
984 obj = Fget_process (name);
985 if (NILP (obj))
986 obj = Fget_buffer (name);
987 if (NILP (obj))
988 error ("Process %s does not exist", SDATA (name));
990 else if (NILP (name))
991 obj = Fcurrent_buffer ();
992 else
993 obj = name;
995 /* Now obj should be either a buffer object or a process object. */
996 if (BUFFERP (obj))
998 if (NILP (BVAR (XBUFFER (obj), name)))
999 error ("Attempt to get process for a dead buffer");
1000 proc = Fget_buffer_process (obj);
1001 if (NILP (proc))
1002 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
1004 else
1006 CHECK_PROCESS (obj);
1007 proc = obj;
1009 return proc;
1013 /* Fdelete_process promises to immediately forget about the process, but in
1014 reality, Emacs needs to remember those processes until they have been
1015 treated by the SIGCHLD handler and waitpid has been invoked on them;
1016 otherwise they might fill up the kernel's process table.
1018 Some processes created by call-process are also put onto this list.
1020 Members of this list are (process-ID . filename) pairs. The
1021 process-ID is a number; the filename, if a string, is a file that
1022 needs to be removed after the process exits. */
1023 static Lisp_Object deleted_pid_list;
1025 void
1026 record_deleted_pid (pid_t pid, Lisp_Object filename)
1028 deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
1029 /* GC treated elements set to nil. */
1030 Fdelq (Qnil, deleted_pid_list));
1034 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
1035 doc: /* Delete PROCESS: kill it and forget about it immediately.
1036 PROCESS may be a process, a buffer, the name of a process or buffer, or
1037 nil, indicating the current buffer's process. */)
1038 (register Lisp_Object process)
1040 register struct Lisp_Process *p;
1042 process = get_process (process);
1043 p = XPROCESS (process);
1045 #ifdef HAVE_GETADDRINFO_A
1046 if (p->dns_request)
1048 /* Cancel the request. Unless shutting down, wait until
1049 completion. Free the request if completely canceled. */
1051 bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
1052 if (!canceled && !inhibit_sentinels)
1054 struct gaicb const *req = p->dns_request;
1055 while (gai_suspend (&req, 1, NULL) != 0)
1056 continue;
1057 canceled = true;
1059 if (canceled)
1060 free_dns_request (process);
1062 #endif
1064 p->raw_status_new = 0;
1065 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1067 pset_status (p, list2 (Qexit, make_number (0)));
1068 p->tick = ++process_tick;
1069 status_notify (p, NULL);
1070 redisplay_preserve_echo_area (13);
1072 else
1074 if (p->alive)
1075 record_kill_process (p, Qnil);
1077 if (p->infd >= 0)
1079 /* Update P's status, since record_kill_process will make the
1080 SIGCHLD handler update deleted_pid_list, not *P. */
1081 Lisp_Object symbol;
1082 if (p->raw_status_new)
1083 update_status (p);
1084 symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
1085 if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
1086 pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
1088 p->tick = ++process_tick;
1089 status_notify (p, NULL);
1090 redisplay_preserve_echo_area (13);
1093 remove_process (process);
1094 return Qnil;
1097 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
1098 doc: /* Return the status of PROCESS.
1099 The returned value is one of the following symbols:
1100 run -- for a process that is running.
1101 stop -- for a process stopped but continuable.
1102 exit -- for a process that has exited.
1103 signal -- for a process that has got a fatal signal.
1104 open -- for a network stream connection that is open.
1105 listen -- for a network stream server that is listening.
1106 closed -- for a network stream connection that is closed.
1107 connect -- when waiting for a non-blocking connection to complete.
1108 failed -- when a non-blocking connection has failed.
1109 nil -- if arg is a process name and no such process exists.
1110 PROCESS may be a process, a buffer, the name of a process, or
1111 nil, indicating the current buffer's process. */)
1112 (register Lisp_Object process)
1114 register struct Lisp_Process *p;
1115 register Lisp_Object status;
1117 if (STRINGP (process))
1118 process = Fget_process (process);
1119 else
1120 process = get_process (process);
1122 if (NILP (process))
1123 return process;
1125 p = XPROCESS (process);
1126 if (p->raw_status_new)
1127 update_status (p);
1128 status = p->status;
1129 if (CONSP (status))
1130 status = XCAR (status);
1131 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1133 if (EQ (status, Qexit))
1134 status = Qclosed;
1135 else if (EQ (p->command, Qt))
1136 status = Qstop;
1137 else if (EQ (status, Qrun))
1138 status = Qopen;
1140 return status;
1143 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1144 1, 1, 0,
1145 doc: /* Return the exit status of PROCESS or the signal number that killed it.
1146 If PROCESS has not yet exited or died, return 0. */)
1147 (register Lisp_Object process)
1149 CHECK_PROCESS (process);
1150 if (XPROCESS (process)->raw_status_new)
1151 update_status (XPROCESS (process));
1152 if (CONSP (XPROCESS (process)->status))
1153 return XCAR (XCDR (XPROCESS (process)->status));
1154 return make_number (0);
1157 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
1158 doc: /* Return the process id of PROCESS.
1159 This is the pid of the external process which PROCESS uses or talks to.
1160 For a network, serial, and pipe connections, this value is nil. */)
1161 (register Lisp_Object process)
1163 pid_t pid;
1165 CHECK_PROCESS (process);
1166 pid = XPROCESS (process)->pid;
1167 return (pid ? make_fixnum_or_float (pid) : Qnil);
1170 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
1171 doc: /* Return the name of PROCESS, as a string.
1172 This is the name of the program invoked in PROCESS,
1173 possibly modified to make it unique among process names. */)
1174 (register Lisp_Object process)
1176 CHECK_PROCESS (process);
1177 return XPROCESS (process)->name;
1180 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
1181 doc: /* Return the command that was executed to start PROCESS.
1182 This is a list of strings, the first string being the program executed
1183 and the rest of the strings being the arguments given to it.
1184 For a network or serial or pipe connection, this is nil (process is running)
1185 or t (process is stopped). */)
1186 (register Lisp_Object process)
1188 CHECK_PROCESS (process);
1189 return XPROCESS (process)->command;
1192 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
1193 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
1194 This is the terminal that the process itself reads and writes on,
1195 not the name of the pty that Emacs uses to talk with that terminal. */)
1196 (register Lisp_Object process)
1198 CHECK_PROCESS (process);
1199 return XPROCESS (process)->tty_name;
1202 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
1203 2, 2, 0,
1204 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1205 Return BUFFER. */)
1206 (register Lisp_Object process, Lisp_Object buffer)
1208 struct Lisp_Process *p;
1210 CHECK_PROCESS (process);
1211 if (!NILP (buffer))
1212 CHECK_BUFFER (buffer);
1213 p = XPROCESS (process);
1214 pset_buffer (p, buffer);
1215 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1216 pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
1217 setup_process_coding_systems (process);
1218 return buffer;
1221 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1222 1, 1, 0,
1223 doc: /* Return the buffer PROCESS is associated with.
1224 The default process filter inserts output from PROCESS into this buffer. */)
1225 (register Lisp_Object process)
1227 CHECK_PROCESS (process);
1228 return XPROCESS (process)->buffer;
1231 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1232 1, 1, 0,
1233 doc: /* Return the marker for the end of the last output from PROCESS. */)
1234 (register Lisp_Object process)
1236 CHECK_PROCESS (process);
1237 return XPROCESS (process)->mark;
1240 static void
1241 set_process_filter_masks (struct Lisp_Process *p)
1243 if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
1244 delete_read_fd (p->infd);
1245 else if (EQ (p->filter, Qt)
1246 /* Network or serial process not stopped: */
1247 && !EQ (p->command, Qt))
1248 add_process_read_fd (p->infd);
1251 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1252 2, 2, 0,
1253 doc: /* Give PROCESS the filter function FILTER; nil means default.
1254 A value of t means stop accepting output from the process.
1256 When a process has a non-default filter, its buffer is not used for output.
1257 Instead, each time it does output, the entire string of output is
1258 passed to the filter.
1260 The filter gets two arguments: the process and the string of output.
1261 The string argument is normally a multibyte string, except:
1262 - if the process's input coding system is no-conversion or raw-text,
1263 it is a unibyte string (the non-converted input). */)
1264 (Lisp_Object process, Lisp_Object filter)
1266 CHECK_PROCESS (process);
1267 struct Lisp_Process *p = XPROCESS (process);
1269 /* Don't signal an error if the process's input file descriptor
1270 is closed. This could make debugging Lisp more difficult,
1271 for example when doing something like
1273 (setq process (start-process ...))
1274 (debug)
1275 (set-process-filter process ...) */
1277 if (NILP (filter))
1278 filter = Qinternal_default_process_filter;
1280 pset_filter (p, filter);
1282 if (p->infd >= 0)
1283 set_process_filter_masks (p);
1285 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1286 pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
1287 setup_process_coding_systems (process);
1288 return filter;
1291 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1292 1, 1, 0,
1293 doc: /* Return the filter function of PROCESS.
1294 See `set-process-filter' for more info on filter functions. */)
1295 (register Lisp_Object process)
1297 CHECK_PROCESS (process);
1298 return XPROCESS (process)->filter;
1301 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1302 2, 2, 0,
1303 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1304 The sentinel is called as a function when the process changes state.
1305 It gets two arguments: the process, and a string describing the change. */)
1306 (register Lisp_Object process, Lisp_Object sentinel)
1308 struct Lisp_Process *p;
1310 CHECK_PROCESS (process);
1311 p = XPROCESS (process);
1313 if (NILP (sentinel))
1314 sentinel = Qinternal_default_process_sentinel;
1316 pset_sentinel (p, sentinel);
1317 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1318 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
1319 return sentinel;
1322 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1323 1, 1, 0,
1324 doc: /* Return the sentinel of PROCESS.
1325 See `set-process-sentinel' for more info on sentinels. */)
1326 (register Lisp_Object process)
1328 CHECK_PROCESS (process);
1329 return XPROCESS (process)->sentinel;
1332 DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread,
1333 2, 2, 0,
1334 doc: /* Set the locking thread of PROCESS to be THREAD.
1335 If THREAD is nil, the process is unlocked. */)
1336 (Lisp_Object process, Lisp_Object thread)
1338 struct Lisp_Process *proc;
1339 struct thread_state *tstate;
1341 CHECK_PROCESS (process);
1342 if (NILP (thread))
1343 tstate = NULL;
1344 else
1346 CHECK_THREAD (thread);
1347 tstate = XTHREAD (thread);
1350 proc = XPROCESS (process);
1351 pset_thread (proc, thread);
1352 if (proc->infd >= 0)
1353 fd_callback_info[proc->infd].thread = tstate;
1354 if (proc->outfd >= 0)
1355 fd_callback_info[proc->outfd].thread = tstate;
1357 return thread;
1360 DEFUN ("process-thread", Fprocess_thread, Sprocess_thread,
1361 1, 1, 0,
1362 doc: /* Ret the locking thread of PROCESS.
1363 If PROCESS is unlocked, this function returns nil. */)
1364 (Lisp_Object process)
1366 CHECK_PROCESS (process);
1367 return XPROCESS (process)->thread;
1370 DEFUN ("set-process-window-size", Fset_process_window_size,
1371 Sset_process_window_size, 3, 3, 0,
1372 doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1373 Value is t if PROCESS was successfully told about the window size,
1374 nil otherwise. */)
1375 (Lisp_Object process, Lisp_Object height, Lisp_Object width)
1377 CHECK_PROCESS (process);
1379 /* All known platforms store window sizes as 'unsigned short'. */
1380 CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
1381 CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
1383 if (NETCONN_P (process)
1384 || XPROCESS (process)->infd < 0
1385 || (set_window_size (XPROCESS (process)->infd,
1386 XINT (height), XINT (width))
1387 < 0))
1388 return Qnil;
1389 else
1390 return Qt;
1393 DEFUN ("set-process-inherit-coding-system-flag",
1394 Fset_process_inherit_coding_system_flag,
1395 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1396 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1397 If the second argument FLAG is non-nil, then the variable
1398 `buffer-file-coding-system' of the buffer associated with PROCESS
1399 will be bound to the value of the coding system used to decode
1400 the process output.
1402 This is useful when the coding system specified for the process buffer
1403 leaves either the character code conversion or the end-of-line conversion
1404 unspecified, or if the coding system used to decode the process output
1405 is more appropriate for saving the process buffer.
1407 Binding the variable `inherit-process-coding-system' to non-nil before
1408 starting the process is an alternative way of setting the inherit flag
1409 for the process which will run.
1411 This function returns FLAG. */)
1412 (register Lisp_Object process, Lisp_Object flag)
1414 CHECK_PROCESS (process);
1415 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1416 return flag;
1419 DEFUN ("set-process-query-on-exit-flag",
1420 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1421 2, 2, 0,
1422 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1423 If the second argument FLAG is non-nil, Emacs will query the user before
1424 exiting or killing a buffer if PROCESS is running. This function
1425 returns FLAG. */)
1426 (register Lisp_Object process, Lisp_Object flag)
1428 CHECK_PROCESS (process);
1429 XPROCESS (process)->kill_without_query = NILP (flag);
1430 return flag;
1433 DEFUN ("process-query-on-exit-flag",
1434 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1435 1, 1, 0,
1436 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1437 (register Lisp_Object process)
1439 CHECK_PROCESS (process);
1440 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1443 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1444 1, 2, 0,
1445 doc: /* Return the contact info of PROCESS; t for a real child.
1446 For a network or serial or pipe connection, the value depends on the
1447 optional KEY arg. If KEY is nil, value is a cons cell of the form
1448 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1449 connection; it is t for a pipe connection. If KEY is t, the complete
1450 contact information for the connection is returned, else the specific
1451 value for the keyword KEY is returned. See `make-network-process',
1452 `make-serial-process', or `make-pipe-process' for the list of keywords.
1453 If PROCESS is a non-blocking network process that hasn't been fully
1454 set up yet, this function will block until socket setup has completed. */)
1455 (Lisp_Object process, Lisp_Object key)
1457 Lisp_Object contact;
1459 CHECK_PROCESS (process);
1460 contact = XPROCESS (process)->childp;
1462 #ifdef DATAGRAM_SOCKETS
1464 if (NETCONN_P (process))
1465 wait_for_socket_fds (process, "process-contact");
1467 if (DATAGRAM_CONN_P (process)
1468 && (EQ (key, Qt) || EQ (key, QCremote)))
1469 contact = Fplist_put (contact, QCremote,
1470 Fprocess_datagram_address (process));
1471 #endif
1473 if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
1474 || EQ (key, Qt))
1475 return contact;
1476 if (NILP (key) && NETCONN_P (process))
1477 return list2 (Fplist_get (contact, QChost),
1478 Fplist_get (contact, QCservice));
1479 if (NILP (key) && SERIALCONN_P (process))
1480 return list2 (Fplist_get (contact, QCport),
1481 Fplist_get (contact, QCspeed));
1482 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1483 if the pipe process is useful for purposes other than receiving
1484 stderr. */
1485 if (NILP (key) && PIPECONN_P (process))
1486 return Qt;
1487 return Fplist_get (contact, key);
1490 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1491 1, 1, 0,
1492 doc: /* Return the plist of PROCESS. */)
1493 (register Lisp_Object process)
1495 CHECK_PROCESS (process);
1496 return XPROCESS (process)->plist;
1499 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1500 2, 2, 0,
1501 doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1502 (Lisp_Object process, Lisp_Object plist)
1504 CHECK_PROCESS (process);
1505 CHECK_LIST (plist);
1507 pset_plist (XPROCESS (process), plist);
1508 return plist;
1511 #if 0 /* Turned off because we don't currently record this info
1512 in the process. Perhaps add it. */
1513 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1514 doc: /* Return the connection type of PROCESS.
1515 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1516 a socket connection. */)
1517 (Lisp_Object process)
1519 return XPROCESS (process)->type;
1521 #endif
1523 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1524 doc: /* Return the connection type of PROCESS.
1525 The value is either the symbol `real', `network', `serial', or `pipe'.
1526 PROCESS may be a process, a buffer, the name of a process or buffer, or
1527 nil, indicating the current buffer's process. */)
1528 (Lisp_Object process)
1530 Lisp_Object proc;
1531 proc = get_process (process);
1532 return XPROCESS (proc)->type;
1535 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1536 1, 2, 0,
1537 doc: /* Convert network ADDRESS from internal format to a string.
1538 A 4 or 5 element vector represents an IPv4 address (with port number).
1539 An 8 or 9 element vector represents an IPv6 address (with port number).
1540 If optional second argument OMIT-PORT is non-nil, don't include a port
1541 number in the string, even when present in ADDRESS.
1542 Return nil if format of ADDRESS is invalid. */)
1543 (Lisp_Object address, Lisp_Object omit_port)
1545 if (NILP (address))
1546 return Qnil;
1548 if (STRINGP (address)) /* AF_LOCAL */
1549 return address;
1551 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1553 register struct Lisp_Vector *p = XVECTOR (address);
1554 ptrdiff_t size = p->header.size;
1555 Lisp_Object args[10];
1556 int nargs, i;
1557 char const *format;
1559 if (size == 4 || (size == 5 && !NILP (omit_port)))
1561 format = "%d.%d.%d.%d";
1562 nargs = 4;
1564 else if (size == 5)
1566 format = "%d.%d.%d.%d:%d";
1567 nargs = 5;
1569 else if (size == 8 || (size == 9 && !NILP (omit_port)))
1571 format = "%x:%x:%x:%x:%x:%x:%x:%x";
1572 nargs = 8;
1574 else if (size == 9)
1576 format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1577 nargs = 9;
1579 else
1580 return Qnil;
1582 AUTO_STRING (format_obj, format);
1583 args[0] = format_obj;
1585 for (i = 0; i < nargs; i++)
1587 if (! RANGED_INTEGERP (0, p->contents[i], 65535))
1588 return Qnil;
1590 if (nargs <= 5 /* IPv4 */
1591 && i < 4 /* host, not port */
1592 && XINT (p->contents[i]) > 255)
1593 return Qnil;
1595 args[i + 1] = p->contents[i];
1598 return Fformat (nargs + 1, args);
1601 if (CONSP (address))
1603 AUTO_STRING (format, "<Family %d>");
1604 return CALLN (Fformat, format, Fcar (address));
1607 return Qnil;
1610 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1611 doc: /* Return a list of all processes that are Emacs sub-processes. */)
1612 (void)
1614 return Fmapcar (Qcdr, Vprocess_alist);
1617 /* Starting asynchronous inferior processes. */
1619 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
1620 doc: /* Start a program in a subprocess. Return the process object for it.
1622 This is similar to `start-process', but arguments are specified as
1623 keyword/argument pairs. The following arguments are defined:
1625 :name NAME -- NAME is name for process. It is modified if necessary
1626 to make it unique.
1628 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1629 with the process. Process output goes at end of that buffer, unless
1630 you specify a filter function to handle the output. BUFFER may be
1631 also nil, meaning that this process is not associated with any buffer.
1633 :command COMMAND -- COMMAND is a list starting with the program file
1634 name, followed by strings to give to the program as arguments.
1636 :coding CODING -- If CODING is a symbol, it specifies the coding
1637 system used for both reading and writing for this process. If CODING
1638 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1639 ENCODING is used for writing.
1641 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1642 the process is running. If BOOL is not given, query before exiting.
1644 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1645 In the stopped state, a process does not accept incoming data, but you
1646 can send outgoing data. The stopped state is cleared by
1647 `continue-process' and set by `stop-process'.
1649 :connection-type TYPE -- TYPE is control type of device used to
1650 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1651 to use a pty, or nil to use the default specified through
1652 `process-connection-type'.
1654 :filter FILTER -- Install FILTER as the process filter.
1656 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1658 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1659 to the standard error of subprocess. Specifying this implies
1660 `:connection-type' is set to `pipe'. If STDERR is nil, standard error
1661 is mixed with standard output and sent to BUFFER or FILTER.
1663 usage: (make-process &rest ARGS) */)
1664 (ptrdiff_t nargs, Lisp_Object *args)
1666 Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
1667 Lisp_Object xstderr, stderrproc;
1668 ptrdiff_t count = SPECPDL_INDEX ();
1670 if (nargs == 0)
1671 return Qnil;
1673 /* Save arguments for process-contact and clone-process. */
1674 contact = Flist (nargs, args);
1676 buffer = Fplist_get (contact, QCbuffer);
1677 if (!NILP (buffer))
1678 buffer = Fget_buffer_create (buffer);
1680 /* Make sure that the child will be able to chdir to the current
1681 buffer's current directory, or its unhandled equivalent. We
1682 can't just have the child check for an error when it does the
1683 chdir, since it's in a vfork. */
1684 current_dir = encode_current_directory ();
1686 name = Fplist_get (contact, QCname);
1687 CHECK_STRING (name);
1689 command = Fplist_get (contact, QCcommand);
1690 if (CONSP (command))
1691 program = XCAR (command);
1692 else
1693 program = Qnil;
1695 if (!NILP (program))
1696 CHECK_STRING (program);
1698 bool query_on_exit = NILP (Fplist_get (contact, QCnoquery));
1700 stderrproc = Qnil;
1701 xstderr = Fplist_get (contact, QCstderr);
1702 if (PROCESSP (xstderr))
1704 if (!PIPECONN_P (xstderr))
1705 error ("Process is not a pipe process");
1706 stderrproc = xstderr;
1708 else if (!NILP (xstderr))
1710 CHECK_STRING (program);
1711 stderrproc = CALLN (Fmake_pipe_process,
1712 QCname,
1713 concat2 (name, build_string (" stderr")),
1714 QCbuffer,
1715 Fget_buffer_create (xstderr),
1716 QCnoquery,
1717 query_on_exit ? Qnil : Qt);
1720 proc = make_process (name);
1721 record_unwind_protect (start_process_unwind, proc);
1723 pset_childp (XPROCESS (proc), Qt);
1724 eassert (NILP (XPROCESS (proc)->plist));
1725 pset_type (XPROCESS (proc), Qreal);
1726 pset_buffer (XPROCESS (proc), buffer);
1727 pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
1728 pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
1729 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1731 if (!query_on_exit)
1732 XPROCESS (proc)->kill_without_query = 1;
1733 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
1734 pset_command (XPROCESS (proc), Qt);
1736 tem = Fplist_get (contact, QCconnection_type);
1737 if (EQ (tem, Qpty))
1738 XPROCESS (proc)->pty_flag = true;
1739 else if (EQ (tem, Qpipe))
1740 XPROCESS (proc)->pty_flag = false;
1741 else if (NILP (tem))
1742 XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
1743 else
1744 report_file_error ("Unknown connection type", tem);
1746 if (!NILP (stderrproc))
1748 pset_stderrproc (XPROCESS (proc), stderrproc);
1750 XPROCESS (proc)->pty_flag = false;
1753 #ifdef HAVE_GNUTLS
1754 /* AKA GNUTLS_INITSTAGE(proc). */
1755 verify (GNUTLS_STAGE_EMPTY == 0);
1756 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1757 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1758 #endif
1760 XPROCESS (proc)->adaptive_read_buffering
1761 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1762 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1764 /* Make the process marker point into the process buffer (if any). */
1765 if (BUFFERP (buffer))
1766 set_marker_both (XPROCESS (proc)->mark, buffer,
1767 BUF_ZV (XBUFFER (buffer)),
1768 BUF_ZV_BYTE (XBUFFER (buffer)));
1770 USE_SAFE_ALLOCA;
1773 /* Decide coding systems for communicating with the process. Here
1774 we don't setup the structure coding_system nor pay attention to
1775 unibyte mode. They are done in create_process. */
1777 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1778 Lisp_Object coding_systems = Qt;
1779 Lisp_Object val, *args2;
1781 tem = Fplist_get (contact, QCcoding);
1782 if (!NILP (tem))
1784 val = tem;
1785 if (CONSP (val))
1786 val = XCAR (val);
1788 else
1789 val = Vcoding_system_for_read;
1790 if (NILP (val))
1792 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1793 Lisp_Object tem2;
1794 SAFE_ALLOCA_LISP (args2, nargs2);
1795 ptrdiff_t i = 0;
1796 args2[i++] = Qstart_process;
1797 args2[i++] = name;
1798 args2[i++] = buffer;
1799 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1800 args2[i++] = XCAR (tem2);
1801 if (!NILP (program))
1802 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1803 if (CONSP (coding_systems))
1804 val = XCAR (coding_systems);
1805 else if (CONSP (Vdefault_process_coding_system))
1806 val = XCAR (Vdefault_process_coding_system);
1808 pset_decode_coding_system (XPROCESS (proc), val);
1810 if (!NILP (tem))
1812 val = tem;
1813 if (CONSP (val))
1814 val = XCDR (val);
1816 else
1817 val = Vcoding_system_for_write;
1818 if (NILP (val))
1820 if (EQ (coding_systems, Qt))
1822 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1823 Lisp_Object tem2;
1824 SAFE_ALLOCA_LISP (args2, nargs2);
1825 ptrdiff_t i = 0;
1826 args2[i++] = Qstart_process;
1827 args2[i++] = name;
1828 args2[i++] = buffer;
1829 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1830 args2[i++] = XCAR (tem2);
1831 if (!NILP (program))
1832 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1834 if (CONSP (coding_systems))
1835 val = XCDR (coding_systems);
1836 else if (CONSP (Vdefault_process_coding_system))
1837 val = XCDR (Vdefault_process_coding_system);
1839 pset_encode_coding_system (XPROCESS (proc), val);
1840 /* Note: At this moment, the above coding system may leave
1841 text-conversion or eol-conversion unspecified. They will be
1842 decided after we read output from the process and decode it by
1843 some coding system, or just before we actually send a text to
1844 the process. */
1848 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1849 eassert (XPROCESS (proc)->decoding_carryover == 0);
1850 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1852 XPROCESS (proc)->inherit_coding_system_flag
1853 = !(NILP (buffer) || !inherit_process_coding_system);
1855 if (!NILP (program))
1857 Lisp_Object program_args = XCDR (command);
1859 /* If program file name is not absolute, search our path for it.
1860 Put the name we will really use in TEM. */
1861 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1862 && !(SCHARS (program) > 1
1863 && IS_DEVICE_SEP (SREF (program, 1))))
1865 tem = Qnil;
1866 openp (Vexec_path, program, Vexec_suffixes, &tem,
1867 make_number (X_OK), false);
1868 if (NILP (tem))
1869 report_file_error ("Searching for program", program);
1870 tem = Fexpand_file_name (tem, Qnil);
1872 else
1874 if (!NILP (Ffile_directory_p (program)))
1875 error ("Specified program for new process is a directory");
1876 tem = program;
1879 /* Remove "/:" from TEM. */
1880 tem = remove_slash_colon (tem);
1882 Lisp_Object arg_encoding = Qnil;
1884 /* Encode the file name and put it in NEW_ARGV.
1885 That's where the child will use it to execute the program. */
1886 tem = list1 (ENCODE_FILE (tem));
1887 ptrdiff_t new_argc = 1;
1889 /* Here we encode arguments by the coding system used for sending
1890 data to the process. We don't support using different coding
1891 systems for encoding arguments and for encoding data sent to the
1892 process. */
1894 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
1896 Lisp_Object arg = XCAR (tem2);
1897 CHECK_STRING (arg);
1898 if (STRING_MULTIBYTE (arg))
1900 if (NILP (arg_encoding))
1901 arg_encoding = (complement_process_encoding_system
1902 (XPROCESS (proc)->encode_coding_system));
1903 arg = code_convert_string_norecord (arg, arg_encoding, 1);
1905 tem = Fcons (arg, tem);
1906 new_argc++;
1909 /* Now that everything is encoded we can collect the strings into
1910 NEW_ARGV. */
1911 char **new_argv;
1912 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
1913 new_argv[new_argc] = 0;
1915 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
1917 new_argv[i] = SSDATA (XCAR (tem));
1918 tem = XCDR (tem);
1921 create_process (proc, new_argv, current_dir);
1923 else
1924 create_pty (proc);
1926 SAFE_FREE ();
1927 return unbind_to (count, proc);
1930 /* If PROC doesn't have its pid set, then an error was signaled and
1931 the process wasn't started successfully, so remove it. */
1932 static void
1933 start_process_unwind (Lisp_Object proc)
1935 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1936 remove_process (proc);
1939 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1941 static void
1942 close_process_fd (int *fd_addr)
1944 int fd = *fd_addr;
1945 if (0 <= fd)
1947 *fd_addr = -1;
1948 emacs_close (fd);
1952 /* Indexes of file descriptors in open_fds. */
1953 enum
1955 /* The pipe from Emacs to its subprocess. */
1956 SUBPROCESS_STDIN,
1957 WRITE_TO_SUBPROCESS,
1959 /* The main pipe from the subprocess to Emacs. */
1960 READ_FROM_SUBPROCESS,
1961 SUBPROCESS_STDOUT,
1963 /* The pipe from the subprocess to Emacs that is closed when the
1964 subprocess execs. */
1965 READ_FROM_EXEC_MONITOR,
1966 EXEC_MONITOR_OUTPUT
1969 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
1971 static void
1972 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1974 struct Lisp_Process *p = XPROCESS (process);
1975 int inchannel, outchannel;
1976 pid_t pid;
1977 int vfork_errno;
1978 int forkin, forkout, forkerr = -1;
1979 bool pty_flag = 0;
1980 char pty_name[PTY_NAME_SIZE];
1981 Lisp_Object lisp_pty_name = Qnil;
1982 sigset_t oldset;
1984 inchannel = outchannel = -1;
1986 if (p->pty_flag)
1987 outchannel = inchannel = allocate_pty (pty_name);
1989 if (inchannel >= 0)
1991 p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
1992 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1993 /* On most USG systems it does not work to open the pty's tty here,
1994 then close it and reopen it in the child. */
1995 /* Don't let this terminal become our controlling terminal
1996 (in case we don't have one). */
1997 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1998 if (forkin < 0)
1999 report_file_error ("Opening pty", Qnil);
2000 p->open_fd[SUBPROCESS_STDIN] = forkin;
2001 #else
2002 forkin = forkout = -1;
2003 #endif /* not USG, or USG_SUBTTY_WORKS */
2004 pty_flag = 1;
2005 lisp_pty_name = build_string (pty_name);
2007 else
2009 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2010 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2011 report_file_error ("Creating pipe", Qnil);
2012 forkin = p->open_fd[SUBPROCESS_STDIN];
2013 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2014 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2015 forkout = p->open_fd[SUBPROCESS_STDOUT];
2017 if (!NILP (p->stderrproc))
2019 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2021 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2023 /* Close unnecessary file descriptors. */
2024 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2025 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2029 #ifndef WINDOWSNT
2030 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2031 report_file_error ("Creating pipe", Qnil);
2032 #endif
2034 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2035 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2037 /* Record this as an active process, with its channels. */
2038 chan_process[inchannel] = process;
2039 p->infd = inchannel;
2040 p->outfd = outchannel;
2042 /* Previously we recorded the tty descriptor used in the subprocess.
2043 It was only used for getting the foreground tty process, so now
2044 we just reopen the device (see emacs_get_tty_pgrp) as this is
2045 more portable (see USG_SUBTTY_WORKS above). */
2047 p->pty_flag = pty_flag;
2048 pset_status (p, Qrun);
2050 if (!EQ (p->command, Qt))
2051 add_process_read_fd (inchannel);
2053 /* This may signal an error. */
2054 setup_process_coding_systems (process);
2056 block_input ();
2057 block_child_signal (&oldset);
2059 #ifndef WINDOWSNT
2060 /* vfork, and prevent local vars from being clobbered by the vfork. */
2061 Lisp_Object volatile current_dir_volatile = current_dir;
2062 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
2063 char **volatile new_argv_volatile = new_argv;
2064 int volatile forkin_volatile = forkin;
2065 int volatile forkout_volatile = forkout;
2066 int volatile forkerr_volatile = forkerr;
2067 struct Lisp_Process *p_volatile = p;
2069 #ifdef DARWIN_OS
2070 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2071 necessary. Also, reset SIGCHLD handling after a vfork, as
2072 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2073 if (pty_flag)
2074 pid = fork ();
2075 else
2077 pid = vfork ();
2078 if (pid == 0)
2079 signal (SIGCHLD, SIG_DFL);
2081 #else
2082 pid = vfork ();
2083 #endif
2085 current_dir = current_dir_volatile;
2086 lisp_pty_name = lisp_pty_name_volatile;
2087 new_argv = new_argv_volatile;
2088 forkin = forkin_volatile;
2089 forkout = forkout_volatile;
2090 forkerr = forkerr_volatile;
2091 p = p_volatile;
2093 pty_flag = p->pty_flag;
2095 if (pid == 0)
2096 #endif /* not WINDOWSNT */
2098 /* Make the pty be the controlling terminal of the process. */
2099 #ifdef HAVE_PTYS
2100 /* First, disconnect its current controlling terminal.
2101 Do this even if !PTY_FLAG; see Bug#30762. */
2102 setsid ();
2103 /* Make the pty's terminal the controlling terminal. */
2104 if (pty_flag && forkin >= 0)
2106 #ifdef TIOCSCTTY
2107 /* We ignore the return value
2108 because faith@cs.unc.edu says that is necessary on Linux. */
2109 ioctl (forkin, TIOCSCTTY, 0);
2110 #endif
2112 #if defined (LDISC1)
2113 if (pty_flag && forkin >= 0)
2115 struct termios t;
2116 tcgetattr (forkin, &t);
2117 t.c_lflag = LDISC1;
2118 if (tcsetattr (forkin, TCSANOW, &t) < 0)
2119 emacs_perror ("create_process/tcsetattr LDISC1");
2121 #else
2122 #if defined (NTTYDISC) && defined (TIOCSETD)
2123 if (pty_flag && forkin >= 0)
2125 /* Use new line discipline. */
2126 int ldisc = NTTYDISC;
2127 ioctl (forkin, TIOCSETD, &ldisc);
2129 #endif
2130 #endif
2131 #ifdef TIOCNOTTY
2132 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2133 can do TIOCSPGRP only to the process's controlling tty. */
2134 if (pty_flag)
2136 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2137 I can't test it since I don't have 4.3. */
2138 int j = emacs_open (DEV_TTY, O_RDWR, 0);
2139 if (j >= 0)
2141 ioctl (j, TIOCNOTTY, 0);
2142 emacs_close (j);
2145 #endif /* TIOCNOTTY */
2147 #if !defined (DONT_REOPEN_PTY)
2148 /*** There is a suggestion that this ought to be a
2149 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2150 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2151 that system does seem to need this code, even though
2152 both TIOCSCTTY is defined. */
2153 /* Now close the pty (if we had it open) and reopen it.
2154 This makes the pty the controlling terminal of the subprocess. */
2155 if (pty_flag)
2158 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2159 would work? */
2160 if (forkin >= 0)
2161 emacs_close (forkin);
2162 forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
2164 if (forkin < 0)
2166 emacs_perror (SSDATA (lisp_pty_name));
2167 _exit (EXIT_CANCELED);
2171 #endif /* not DONT_REOPEN_PTY */
2173 #ifdef SETUP_SLAVE_PTY
2174 if (pty_flag)
2176 SETUP_SLAVE_PTY;
2178 #endif /* SETUP_SLAVE_PTY */
2179 #endif /* HAVE_PTYS */
2181 signal (SIGINT, SIG_DFL);
2182 signal (SIGQUIT, SIG_DFL);
2183 #ifdef SIGPROF
2184 signal (SIGPROF, SIG_DFL);
2185 #endif
2187 /* Emacs ignores SIGPIPE, but the child should not. */
2188 signal (SIGPIPE, SIG_DFL);
2190 /* Stop blocking SIGCHLD in the child. */
2191 unblock_child_signal (&oldset);
2193 if (pty_flag)
2194 child_setup_tty (forkout);
2196 if (forkerr < 0)
2197 forkerr = forkout;
2198 #ifdef WINDOWSNT
2199 pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2200 #else /* not WINDOWSNT */
2201 child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2202 #endif /* not WINDOWSNT */
2205 /* Back in the parent process. */
2207 vfork_errno = errno;
2208 p->pid = pid;
2209 if (pid >= 0)
2210 p->alive = 1;
2212 /* Stop blocking in the parent. */
2213 unblock_child_signal (&oldset);
2214 unblock_input ();
2216 if (pid < 0)
2217 report_file_errno ("Doing vfork", Qnil, vfork_errno);
2218 else
2220 /* vfork succeeded. */
2222 /* Close the pipe ends that the child uses, or the child's pty. */
2223 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2224 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2226 #ifdef WINDOWSNT
2227 register_child (pid, inchannel);
2228 #endif /* WINDOWSNT */
2230 pset_tty_name (p, lisp_pty_name);
2232 #ifndef WINDOWSNT
2233 /* Wait for child_setup to complete in case that vfork is
2234 actually defined as fork. The descriptor
2235 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2236 of a pipe is closed at the child side either by close-on-exec
2237 on successful execve or the _exit call in child_setup. */
2239 char dummy;
2241 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2242 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2243 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2245 #endif
2246 if (!NILP (p->stderrproc))
2248 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2249 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2254 static void
2255 create_pty (Lisp_Object process)
2257 struct Lisp_Process *p = XPROCESS (process);
2258 char pty_name[PTY_NAME_SIZE];
2259 int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
2261 if (pty_fd >= 0)
2263 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2264 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2265 /* On most USG systems it does not work to open the pty's tty here,
2266 then close it and reopen it in the child. */
2267 /* Don't let this terminal become our controlling terminal
2268 (in case we don't have one). */
2269 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2270 if (forkout < 0)
2271 report_file_error ("Opening pty", Qnil);
2272 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2273 #if defined (DONT_REOPEN_PTY)
2274 /* In the case that vfork is defined as fork, the parent process
2275 (Emacs) may send some data before the child process completes
2276 tty options setup. So we setup tty before forking. */
2277 child_setup_tty (forkout);
2278 #endif /* DONT_REOPEN_PTY */
2279 #endif /* not USG, or USG_SUBTTY_WORKS */
2281 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2283 /* Record this as an active process, with its channels.
2284 As a result, child_setup will close Emacs's side of the pipes. */
2285 chan_process[pty_fd] = process;
2286 p->infd = pty_fd;
2287 p->outfd = pty_fd;
2289 /* Previously we recorded the tty descriptor used in the subprocess.
2290 It was only used for getting the foreground tty process, so now
2291 we just reopen the device (see emacs_get_tty_pgrp) as this is
2292 more portable (see USG_SUBTTY_WORKS above). */
2294 p->pty_flag = 1;
2295 pset_status (p, Qrun);
2296 setup_process_coding_systems (process);
2298 add_process_read_fd (pty_fd);
2300 pset_tty_name (p, build_string (pty_name));
2303 p->pid = -2;
2306 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2307 0, MANY, 0,
2308 doc: /* Create and return a bidirectional pipe process.
2310 In Emacs, pipes are represented by process objects, so input and
2311 output work as for subprocesses, and `delete-process' closes a pipe.
2312 However, a pipe process has no process id, it cannot be signaled,
2313 and the status codes are different from normal processes.
2315 Arguments are specified as keyword/argument pairs. The following
2316 arguments are defined:
2318 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2320 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2321 with the process. Process output goes at the end of that buffer,
2322 unless you specify a filter function to handle the output. If BUFFER
2323 is not given, the value of NAME is used.
2325 :coding CODING -- If CODING is a symbol, it specifies the coding
2326 system used for both reading and writing for this process. If CODING
2327 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2328 ENCODING is used for writing.
2330 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2331 the process is running. If BOOL is not given, query before exiting.
2333 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2334 In the stopped state, a pipe process does not accept incoming data,
2335 but you can send outgoing data. The stopped state is cleared by
2336 `continue-process' and set by `stop-process'.
2338 :filter FILTER -- Install FILTER as the process filter.
2340 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2342 usage: (make-pipe-process &rest ARGS) */)
2343 (ptrdiff_t nargs, Lisp_Object *args)
2345 Lisp_Object proc, contact;
2346 struct Lisp_Process *p;
2347 Lisp_Object name, buffer;
2348 Lisp_Object tem;
2349 ptrdiff_t specpdl_count;
2350 int inchannel, outchannel;
2352 if (nargs == 0)
2353 return Qnil;
2355 contact = Flist (nargs, args);
2357 name = Fplist_get (contact, QCname);
2358 CHECK_STRING (name);
2359 proc = make_process (name);
2360 specpdl_count = SPECPDL_INDEX ();
2361 record_unwind_protect (remove_process, proc);
2362 p = XPROCESS (proc);
2364 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2365 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2366 report_file_error ("Creating pipe", Qnil);
2367 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2368 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2370 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2371 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2373 #ifdef WINDOWSNT
2374 register_aux_fd (inchannel);
2375 #endif
2377 /* Record this as an active process, with its channels. */
2378 chan_process[inchannel] = proc;
2379 p->infd = inchannel;
2380 p->outfd = outchannel;
2382 if (inchannel > max_desc)
2383 max_desc = inchannel;
2385 buffer = Fplist_get (contact, QCbuffer);
2386 if (NILP (buffer))
2387 buffer = name;
2388 buffer = Fget_buffer_create (buffer);
2389 pset_buffer (p, buffer);
2391 pset_childp (p, contact);
2392 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2393 pset_type (p, Qpipe);
2394 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2395 pset_filter (p, Fplist_get (contact, QCfilter));
2396 eassert (NILP (p->log));
2397 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2398 p->kill_without_query = 1;
2399 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2400 pset_command (p, Qt);
2401 eassert (! p->pty_flag);
2403 if (!EQ (p->command, Qt))
2404 add_process_read_fd (inchannel);
2405 p->adaptive_read_buffering
2406 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2407 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2409 /* Make the process marker point into the process buffer (if any). */
2410 if (BUFFERP (buffer))
2411 set_marker_both (p->mark, buffer,
2412 BUF_ZV (XBUFFER (buffer)),
2413 BUF_ZV_BYTE (XBUFFER (buffer)));
2416 /* Setup coding systems for communicating with the network stream. */
2418 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2419 Lisp_Object coding_systems = Qt;
2420 Lisp_Object val;
2422 tem = Fplist_get (contact, QCcoding);
2423 val = Qnil;
2424 if (!NILP (tem))
2426 val = tem;
2427 if (CONSP (val))
2428 val = XCAR (val);
2430 else if (!NILP (Vcoding_system_for_read))
2431 val = Vcoding_system_for_read;
2432 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2433 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2434 /* We dare not decode end-of-line format by setting VAL to
2435 Qraw_text, because the existing Emacs Lisp libraries
2436 assume that they receive bare code including a sequence of
2437 CR LF. */
2438 val = Qnil;
2439 else
2441 if (CONSP (coding_systems))
2442 val = XCAR (coding_systems);
2443 else if (CONSP (Vdefault_process_coding_system))
2444 val = XCAR (Vdefault_process_coding_system);
2445 else
2446 val = Qnil;
2448 pset_decode_coding_system (p, val);
2450 if (!NILP (tem))
2452 val = tem;
2453 if (CONSP (val))
2454 val = XCDR (val);
2456 else if (!NILP (Vcoding_system_for_write))
2457 val = Vcoding_system_for_write;
2458 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2459 val = Qnil;
2460 else
2462 if (CONSP (coding_systems))
2463 val = XCDR (coding_systems);
2464 else if (CONSP (Vdefault_process_coding_system))
2465 val = XCDR (Vdefault_process_coding_system);
2466 else
2467 val = Qnil;
2469 pset_encode_coding_system (p, val);
2471 /* This may signal an error. */
2472 setup_process_coding_systems (proc);
2474 specpdl_ptr = specpdl + specpdl_count;
2476 return proc;
2480 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2481 The address family of sa is not included in the result. */
2483 Lisp_Object
2484 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2486 Lisp_Object address;
2487 ptrdiff_t i;
2488 unsigned char *cp;
2489 struct Lisp_Vector *p;
2491 /* Workaround for a bug in getsockname on BSD: Names bound to
2492 sockets in the UNIX domain are inaccessible; getsockname returns
2493 a zero length name. */
2494 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2495 return empty_unibyte_string;
2497 switch (sa->sa_family)
2499 case AF_INET:
2501 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2502 len = sizeof (sin->sin_addr) + 1;
2503 address = Fmake_vector (make_number (len), Qnil);
2504 p = XVECTOR (address);
2505 p->contents[--len] = make_number (ntohs (sin->sin_port));
2506 cp = (unsigned char *) &sin->sin_addr;
2507 break;
2509 #ifdef AF_INET6
2510 case AF_INET6:
2512 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2513 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2514 len = sizeof (sin6->sin6_addr) / 2 + 1;
2515 address = Fmake_vector (make_number (len), Qnil);
2516 p = XVECTOR (address);
2517 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2518 for (i = 0; i < len; i++)
2519 p->contents[i] = make_number (ntohs (ip6[i]));
2520 return address;
2522 #endif
2523 #ifdef HAVE_LOCAL_SOCKETS
2524 case AF_LOCAL:
2526 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2527 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2528 /* If the first byte is NUL, the name is a Linux abstract
2529 socket name, and the name can contain embedded NULs. If
2530 it's not, we have a NUL-terminated string. Be careful not
2531 to walk past the end of the object looking for the name
2532 terminator, however. */
2533 if (name_length > 0 && sockun->sun_path[0] != '\0')
2535 const char *terminator
2536 = memchr (sockun->sun_path, '\0', name_length);
2538 if (terminator)
2539 name_length = terminator - (const char *) sockun->sun_path;
2542 return make_unibyte_string (sockun->sun_path, name_length);
2544 #endif
2545 default:
2546 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2547 address = Fcons (make_number (sa->sa_family),
2548 Fmake_vector (make_number (len), Qnil));
2549 p = XVECTOR (XCDR (address));
2550 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2551 break;
2554 i = 0;
2555 while (i < len)
2556 p->contents[i++] = make_number (*cp++);
2558 return address;
2561 /* Convert an internal struct addrinfo to a Lisp object. */
2563 static Lisp_Object
2564 conv_addrinfo_to_lisp (struct addrinfo *res)
2566 Lisp_Object protocol = make_number (res->ai_protocol);
2567 eassert (XINT (protocol) == res->ai_protocol);
2568 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2572 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2574 static ptrdiff_t
2575 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2577 struct Lisp_Vector *p;
2579 if (VECTORP (address))
2581 p = XVECTOR (address);
2582 if (p->header.size == 5)
2584 *familyp = AF_INET;
2585 return sizeof (struct sockaddr_in);
2587 #ifdef AF_INET6
2588 else if (p->header.size == 9)
2590 *familyp = AF_INET6;
2591 return sizeof (struct sockaddr_in6);
2593 #endif
2595 #ifdef HAVE_LOCAL_SOCKETS
2596 else if (STRINGP (address))
2598 *familyp = AF_LOCAL;
2599 return sizeof (struct sockaddr_un);
2601 #endif
2602 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2603 && VECTORP (XCDR (address)))
2605 struct sockaddr *sa;
2606 p = XVECTOR (XCDR (address));
2607 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2608 return 0;
2609 *familyp = XINT (XCAR (address));
2610 return p->header.size + sizeof (sa->sa_family);
2612 return 0;
2615 /* Convert an address object (vector or string) to an internal sockaddr.
2617 The address format has been basically validated by
2618 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2619 it could have come from user data. So if FAMILY is not valid,
2620 we return after zeroing *SA. */
2622 static void
2623 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2625 register struct Lisp_Vector *p;
2626 register unsigned char *cp = NULL;
2627 register int i;
2628 EMACS_INT hostport;
2630 memset (sa, 0, len);
2632 if (VECTORP (address))
2634 p = XVECTOR (address);
2635 if (family == AF_INET)
2637 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2638 len = sizeof (sin->sin_addr) + 1;
2639 hostport = XINT (p->contents[--len]);
2640 sin->sin_port = htons (hostport);
2641 cp = (unsigned char *)&sin->sin_addr;
2642 sa->sa_family = family;
2644 #ifdef AF_INET6
2645 else if (family == AF_INET6)
2647 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2648 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2649 len = sizeof (sin6->sin6_addr) / 2 + 1;
2650 hostport = XINT (p->contents[--len]);
2651 sin6->sin6_port = htons (hostport);
2652 for (i = 0; i < len; i++)
2653 if (INTEGERP (p->contents[i]))
2655 int j = XFASTINT (p->contents[i]) & 0xffff;
2656 ip6[i] = ntohs (j);
2658 sa->sa_family = family;
2659 return;
2661 #endif
2662 else
2663 return;
2665 else if (STRINGP (address))
2667 #ifdef HAVE_LOCAL_SOCKETS
2668 if (family == AF_LOCAL)
2670 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2671 cp = SDATA (address);
2672 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2673 sockun->sun_path[i] = *cp++;
2674 sa->sa_family = family;
2676 #endif
2677 return;
2679 else
2681 p = XVECTOR (XCDR (address));
2682 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2685 for (i = 0; i < len; i++)
2686 if (INTEGERP (p->contents[i]))
2687 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2690 #ifdef DATAGRAM_SOCKETS
2691 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2692 1, 1, 0,
2693 doc: /* Get the current datagram address associated with PROCESS.
2694 If PROCESS is a non-blocking network process that hasn't been fully
2695 set up yet, this function will block until socket setup has completed. */)
2696 (Lisp_Object process)
2698 int channel;
2700 CHECK_PROCESS (process);
2702 if (NETCONN_P (process))
2703 wait_for_socket_fds (process, "process-datagram-address");
2705 if (!DATAGRAM_CONN_P (process))
2706 return Qnil;
2708 channel = XPROCESS (process)->infd;
2709 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2710 datagram_address[channel].len);
2713 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2714 2, 2, 0,
2715 doc: /* Set the datagram address for PROCESS to ADDRESS.
2716 Return nil upon error setting address, ADDRESS otherwise.
2718 If PROCESS is a non-blocking network process that hasn't been fully
2719 set up yet, this function will block until socket setup has completed. */)
2720 (Lisp_Object process, Lisp_Object address)
2722 int channel;
2723 int family;
2724 ptrdiff_t len;
2726 CHECK_PROCESS (process);
2728 if (NETCONN_P (process))
2729 wait_for_socket_fds (process, "set-process-datagram-address");
2731 if (!DATAGRAM_CONN_P (process))
2732 return Qnil;
2734 channel = XPROCESS (process)->infd;
2736 len = get_lisp_to_sockaddr_size (address, &family);
2737 if (len == 0 || datagram_address[channel].len != len)
2738 return Qnil;
2739 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2740 return address;
2742 #endif
2745 static const struct socket_options {
2746 /* The name of this option. Should be lowercase version of option
2747 name without SO_ prefix. */
2748 const char *name;
2749 /* Option level SOL_... */
2750 int optlevel;
2751 /* Option number SO_... */
2752 int optnum;
2753 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2754 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2755 } socket_options[] =
2757 #ifdef SO_BINDTODEVICE
2758 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2759 #endif
2760 #ifdef SO_BROADCAST
2761 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2762 #endif
2763 #ifdef SO_DONTROUTE
2764 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2765 #endif
2766 #ifdef SO_KEEPALIVE
2767 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2768 #endif
2769 #ifdef SO_LINGER
2770 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2771 #endif
2772 #ifdef SO_OOBINLINE
2773 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2774 #endif
2775 #ifdef SO_PRIORITY
2776 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2777 #endif
2778 #ifdef SO_REUSEADDR
2779 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2780 #endif
2781 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2784 /* Set option OPT to value VAL on socket S.
2786 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2787 Signals an error if setting a known option fails.
2790 static int
2791 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2793 char *name;
2794 const struct socket_options *sopt;
2795 int ret = 0;
2797 CHECK_SYMBOL (opt);
2799 name = SSDATA (SYMBOL_NAME (opt));
2800 for (sopt = socket_options; sopt->name; sopt++)
2801 if (strcmp (name, sopt->name) == 0)
2802 break;
2804 switch (sopt->opttype)
2806 case SOPT_BOOL:
2808 int optval;
2809 optval = NILP (val) ? 0 : 1;
2810 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2811 &optval, sizeof (optval));
2812 break;
2815 case SOPT_INT:
2817 int optval;
2818 if (TYPE_RANGED_INTEGERP (int, val))
2819 optval = XINT (val);
2820 else
2821 error ("Bad option value for %s", name);
2822 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2823 &optval, sizeof (optval));
2824 break;
2827 #ifdef SO_BINDTODEVICE
2828 case SOPT_IFNAME:
2830 char devname[IFNAMSIZ + 1];
2832 /* This is broken, at least in the Linux 2.4 kernel.
2833 To unbind, the arg must be a zero integer, not the empty string.
2834 This should work on all systems. KFS. 2003-09-23. */
2835 memset (devname, 0, sizeof devname);
2836 if (STRINGP (val))
2838 char *arg = SSDATA (val);
2839 int len = min (strlen (arg), IFNAMSIZ);
2840 memcpy (devname, arg, len);
2842 else if (!NILP (val))
2843 error ("Bad option value for %s", name);
2844 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2845 devname, IFNAMSIZ);
2846 break;
2848 #endif
2850 #ifdef SO_LINGER
2851 case SOPT_LINGER:
2853 struct linger linger;
2855 linger.l_onoff = 1;
2856 linger.l_linger = 0;
2857 if (TYPE_RANGED_INTEGERP (int, val))
2858 linger.l_linger = XINT (val);
2859 else
2860 linger.l_onoff = NILP (val) ? 0 : 1;
2861 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2862 &linger, sizeof (linger));
2863 break;
2865 #endif
2867 default:
2868 return 0;
2871 if (ret < 0)
2873 int setsockopt_errno = errno;
2874 report_file_errno ("Cannot set network option", list2 (opt, val),
2875 setsockopt_errno);
2878 return (1 << sopt->optbit);
2882 DEFUN ("set-network-process-option",
2883 Fset_network_process_option, Sset_network_process_option,
2884 3, 4, 0,
2885 doc: /* For network process PROCESS set option OPTION to value VALUE.
2886 See `make-network-process' for a list of options and values.
2887 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2888 OPTION is not a supported option, return nil instead; otherwise return t.
2890 If PROCESS is a non-blocking network process that hasn't been fully
2891 set up yet, this function will block until socket setup has completed. */)
2892 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2894 int s;
2895 struct Lisp_Process *p;
2897 CHECK_PROCESS (process);
2898 p = XPROCESS (process);
2899 if (!NETCONN1_P (p))
2900 error ("Process is not a network process");
2902 wait_for_socket_fds (process, "set-network-process-option");
2904 s = p->infd;
2905 if (s < 0)
2906 error ("Process is not running");
2908 if (set_socket_option (s, option, value))
2910 pset_childp (p, Fplist_put (p->childp, option, value));
2911 return Qt;
2914 if (NILP (no_error))
2915 error ("Unknown or unsupported option");
2917 return Qnil;
2921 DEFUN ("serial-process-configure",
2922 Fserial_process_configure,
2923 Sserial_process_configure,
2924 0, MANY, 0,
2925 doc: /* Configure speed, bytesize, etc. of a serial process.
2927 Arguments are specified as keyword/argument pairs. Attributes that
2928 are not given are re-initialized from the process's current
2929 configuration (available via the function `process-contact') or set to
2930 reasonable default values. The following arguments are defined:
2932 :process PROCESS
2933 :name NAME
2934 :buffer BUFFER
2935 :port PORT
2936 -- Any of these arguments can be given to identify the process that is
2937 to be configured. If none of these arguments is given, the current
2938 buffer's process is used.
2940 :speed SPEED -- SPEED is the speed of the serial port in bits per
2941 second, also called baud rate. Any value can be given for SPEED, but
2942 most serial ports work only at a few defined values between 1200 and
2943 115200, with 9600 being the most common value. If SPEED is nil, the
2944 serial port is not configured any further, i.e., all other arguments
2945 are ignored. This may be useful for special serial ports such as
2946 Bluetooth-to-serial converters which can only be configured through AT
2947 commands. A value of nil for SPEED can be used only when passed
2948 through `make-serial-process' or `serial-term'.
2950 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2951 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2953 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2954 `odd' (use odd parity), or the symbol `even' (use even parity). If
2955 PARITY is not given, no parity is used.
2957 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2958 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2959 is not given or nil, 1 stopbit is used.
2961 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2962 flowcontrol to be used, which is either nil (don't use flowcontrol),
2963 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2964 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2965 flowcontrol is used.
2967 `serial-process-configure' is called by `make-serial-process' for the
2968 initial configuration of the serial port.
2970 Examples:
2972 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2974 \(serial-process-configure
2975 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2977 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2979 usage: (serial-process-configure &rest ARGS) */)
2980 (ptrdiff_t nargs, Lisp_Object *args)
2982 struct Lisp_Process *p;
2983 Lisp_Object contact = Qnil;
2984 Lisp_Object proc = Qnil;
2986 contact = Flist (nargs, args);
2988 proc = Fplist_get (contact, QCprocess);
2989 if (NILP (proc))
2990 proc = Fplist_get (contact, QCname);
2991 if (NILP (proc))
2992 proc = Fplist_get (contact, QCbuffer);
2993 if (NILP (proc))
2994 proc = Fplist_get (contact, QCport);
2995 proc = get_process (proc);
2996 p = XPROCESS (proc);
2997 if (!EQ (p->type, Qserial))
2998 error ("Not a serial process");
3000 if (NILP (Fplist_get (p->childp, QCspeed)))
3001 return Qnil;
3003 serial_configure (p, contact);
3004 return Qnil;
3007 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
3008 0, MANY, 0,
3009 doc: /* Create and return a serial port process.
3011 In Emacs, serial port connections are represented by process objects,
3012 so input and output work as for subprocesses, and `delete-process'
3013 closes a serial port connection. However, a serial process has no
3014 process id, it cannot be signaled, and the status codes are different
3015 from normal processes.
3017 `make-serial-process' creates a process and a buffer, on which you
3018 probably want to use `process-send-string'. Try \\[serial-term] for
3019 an interactive terminal. See below for examples.
3021 Arguments are specified as keyword/argument pairs. The following
3022 arguments are defined:
3024 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3025 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3026 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3027 the backslashes in strings).
3029 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3030 which this function calls.
3032 :name NAME -- NAME is the name of the process. If NAME is not given,
3033 the value of PORT is used.
3035 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3036 with the process. Process output goes at the end of that buffer,
3037 unless you specify a filter function to handle the output. If BUFFER
3038 is not given, the value of NAME is used.
3040 :coding CODING -- If CODING is a symbol, it specifies the coding
3041 system used for both reading and writing for this process. If CODING
3042 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3043 ENCODING is used for writing.
3045 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3046 the process is running. If BOOL is not given, query before exiting.
3048 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3049 In the stopped state, a serial process does not accept incoming data,
3050 but you can send outgoing data. The stopped state is cleared by
3051 `continue-process' and set by `stop-process'.
3053 :filter FILTER -- Install FILTER as the process filter.
3055 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3057 :plist PLIST -- Install PLIST as the initial plist of the process.
3059 :bytesize
3060 :parity
3061 :stopbits
3062 :flowcontrol
3063 -- This function calls `serial-process-configure' to handle these
3064 arguments.
3066 The original argument list, possibly modified by later configuration,
3067 is available via the function `process-contact'.
3069 Examples:
3071 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3073 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3075 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3077 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3079 usage: (make-serial-process &rest ARGS) */)
3080 (ptrdiff_t nargs, Lisp_Object *args)
3082 int fd = -1;
3083 Lisp_Object proc, contact, port;
3084 struct Lisp_Process *p;
3085 Lisp_Object name, buffer;
3086 Lisp_Object tem, val;
3087 ptrdiff_t specpdl_count;
3089 if (nargs == 0)
3090 return Qnil;
3092 contact = Flist (nargs, args);
3094 port = Fplist_get (contact, QCport);
3095 if (NILP (port))
3096 error ("No port specified");
3097 CHECK_STRING (port);
3099 if (NILP (Fplist_member (contact, QCspeed)))
3100 error (":speed not specified");
3101 if (!NILP (Fplist_get (contact, QCspeed)))
3102 CHECK_NUMBER (Fplist_get (contact, QCspeed));
3104 name = Fplist_get (contact, QCname);
3105 if (NILP (name))
3106 name = port;
3107 CHECK_STRING (name);
3108 proc = make_process (name);
3109 specpdl_count = SPECPDL_INDEX ();
3110 record_unwind_protect (remove_process, proc);
3111 p = XPROCESS (proc);
3113 fd = serial_open (port);
3114 p->open_fd[SUBPROCESS_STDIN] = fd;
3115 p->infd = fd;
3116 p->outfd = fd;
3117 if (fd > max_desc)
3118 max_desc = fd;
3119 chan_process[fd] = proc;
3121 buffer = Fplist_get (contact, QCbuffer);
3122 if (NILP (buffer))
3123 buffer = name;
3124 buffer = Fget_buffer_create (buffer);
3125 pset_buffer (p, buffer);
3127 pset_childp (p, contact);
3128 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3129 pset_type (p, Qserial);
3130 pset_sentinel (p, Fplist_get (contact, QCsentinel));
3131 pset_filter (p, Fplist_get (contact, QCfilter));
3132 eassert (NILP (p->log));
3133 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3134 p->kill_without_query = 1;
3135 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
3136 pset_command (p, Qt);
3137 eassert (! p->pty_flag);
3139 if (!EQ (p->command, Qt))
3140 add_process_read_fd (fd);
3142 if (BUFFERP (buffer))
3144 set_marker_both (p->mark, buffer,
3145 BUF_ZV (XBUFFER (buffer)),
3146 BUF_ZV_BYTE (XBUFFER (buffer)));
3149 tem = Fplist_member (contact, QCcoding);
3150 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3151 tem = Qnil;
3153 val = Qnil;
3154 if (!NILP (tem))
3156 val = XCAR (XCDR (tem));
3157 if (CONSP (val))
3158 val = XCAR (val);
3160 else if (!NILP (Vcoding_system_for_read))
3161 val = Vcoding_system_for_read;
3162 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3163 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3164 val = Qnil;
3165 pset_decode_coding_system (p, val);
3167 val = Qnil;
3168 if (!NILP (tem))
3170 val = XCAR (XCDR (tem));
3171 if (CONSP (val))
3172 val = XCDR (val);
3174 else if (!NILP (Vcoding_system_for_write))
3175 val = Vcoding_system_for_write;
3176 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3177 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3178 val = Qnil;
3179 pset_encode_coding_system (p, val);
3181 setup_process_coding_systems (proc);
3182 pset_decoding_buf (p, empty_unibyte_string);
3183 eassert (p->decoding_carryover == 0);
3184 pset_encoding_buf (p, empty_unibyte_string);
3185 p->inherit_coding_system_flag
3186 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3188 Fserial_process_configure (nargs, args);
3190 specpdl_ptr = specpdl + specpdl_count;
3192 return proc;
3195 static void
3196 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3197 Lisp_Object service, Lisp_Object name)
3199 Lisp_Object tem;
3200 struct Lisp_Process *p = XPROCESS (proc);
3201 Lisp_Object contact = p->childp;
3202 Lisp_Object coding_systems = Qt;
3203 Lisp_Object val;
3205 tem = Fplist_member (contact, QCcoding);
3206 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3207 tem = Qnil; /* No error message (too late!). */
3209 /* Setup coding systems for communicating with the network stream. */
3210 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3212 if (!NILP (tem))
3214 val = XCAR (XCDR (tem));
3215 if (CONSP (val))
3216 val = XCAR (val);
3218 else if (!NILP (Vcoding_system_for_read))
3219 val = Vcoding_system_for_read;
3220 else if ((!NILP (p->buffer)
3221 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3222 || (NILP (p->buffer)
3223 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3224 /* We dare not decode end-of-line format by setting VAL to
3225 Qraw_text, because the existing Emacs Lisp libraries
3226 assume that they receive bare code including a sequence of
3227 CR LF. */
3228 val = Qnil;
3229 else
3231 if (NILP (host) || NILP (service))
3232 coding_systems = Qnil;
3233 else
3234 coding_systems = CALLN (Ffind_operation_coding_system,
3235 Qopen_network_stream, name, p->buffer,
3236 host, service);
3237 if (CONSP (coding_systems))
3238 val = XCAR (coding_systems);
3239 else if (CONSP (Vdefault_process_coding_system))
3240 val = XCAR (Vdefault_process_coding_system);
3241 else
3242 val = Qnil;
3244 pset_decode_coding_system (p, val);
3246 if (!NILP (tem))
3248 val = XCAR (XCDR (tem));
3249 if (CONSP (val))
3250 val = XCDR (val);
3252 else if (!NILP (Vcoding_system_for_write))
3253 val = Vcoding_system_for_write;
3254 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3255 val = Qnil;
3256 else
3258 if (EQ (coding_systems, Qt))
3260 if (NILP (host) || NILP (service))
3261 coding_systems = Qnil;
3262 else
3263 coding_systems = CALLN (Ffind_operation_coding_system,
3264 Qopen_network_stream, name, p->buffer,
3265 host, service);
3267 if (CONSP (coding_systems))
3268 val = XCDR (coding_systems);
3269 else if (CONSP (Vdefault_process_coding_system))
3270 val = XCDR (Vdefault_process_coding_system);
3271 else
3272 val = Qnil;
3274 pset_encode_coding_system (p, val);
3276 pset_decoding_buf (p, empty_unibyte_string);
3277 p->decoding_carryover = 0;
3278 pset_encoding_buf (p, empty_unibyte_string);
3280 p->inherit_coding_system_flag
3281 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3284 #ifdef HAVE_GNUTLS
3285 static void
3286 finish_after_tls_connection (Lisp_Object proc)
3288 struct Lisp_Process *p = XPROCESS (proc);
3289 Lisp_Object contact = p->childp;
3290 Lisp_Object result = Qt;
3292 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3293 result = call3 (Qnsm_verify_connection,
3294 proc,
3295 Fplist_get (contact, QChost),
3296 Fplist_get (contact, QCservice));
3298 if (NILP (result))
3300 pset_status (p, list2 (Qfailed,
3301 build_string ("The Network Security Manager stopped the connections")));
3302 deactivate_process (proc);
3304 else if (p->outfd < 0)
3306 /* The counterparty may have closed the connection (especially
3307 if the NSM prompt above take a long time), so recheck the file
3308 descriptor here. */
3309 pset_status (p, Qfailed);
3310 deactivate_process (proc);
3312 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3314 /* If we cleared the connection wait mask before we did the TLS
3315 setup, then we have to say that the process is finally "open"
3316 here. */
3317 pset_status (p, Qrun);
3318 /* Execute the sentinel here. If we had relied on status_notify
3319 to do it later, it will read input from the process before
3320 calling the sentinel. */
3321 exec_sentinel (proc, build_string ("open\n"));
3324 #endif
3326 static void
3327 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3328 Lisp_Object use_external_socket_p)
3330 ptrdiff_t count = SPECPDL_INDEX ();
3331 int s = -1, outch, inch;
3332 int xerrno = 0;
3333 int family;
3334 struct sockaddr *sa = NULL;
3335 int ret;
3336 ptrdiff_t addrlen;
3337 struct Lisp_Process *p = XPROCESS (proc);
3338 Lisp_Object contact = p->childp;
3339 int optbits = 0;
3340 int socket_to_use = -1;
3342 if (!NILP (use_external_socket_p))
3344 socket_to_use = external_sock_fd;
3346 /* Ensure we don't consume the external socket twice. */
3347 external_sock_fd = -1;
3350 /* Do this in case we never enter the while-loop below. */
3351 s = -1;
3353 while (!NILP (addrinfos))
3355 Lisp_Object addrinfo = XCAR (addrinfos);
3356 addrinfos = XCDR (addrinfos);
3357 int protocol = XINT (XCAR (addrinfo));
3358 Lisp_Object ip_address = XCDR (addrinfo);
3360 #ifdef WINDOWSNT
3361 retry_connect:
3362 #endif
3364 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3365 if (sa)
3366 free (sa);
3367 sa = xmalloc (addrlen);
3368 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3370 s = socket_to_use;
3371 if (s < 0)
3373 int socktype = p->socktype | SOCK_CLOEXEC;
3374 if (p->is_non_blocking_client)
3375 socktype |= SOCK_NONBLOCK;
3376 s = socket (family, socktype, protocol);
3377 if (s < 0)
3379 xerrno = errno;
3380 continue;
3384 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3386 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3387 if (ret < 0)
3389 xerrno = errno;
3390 emacs_close (s);
3391 s = -1;
3392 if (0 <= socket_to_use)
3393 break;
3394 continue;
3398 #ifdef DATAGRAM_SOCKETS
3399 if (!p->is_server && p->socktype == SOCK_DGRAM)
3400 break;
3401 #endif /* DATAGRAM_SOCKETS */
3403 /* Make us close S if quit. */
3404 record_unwind_protect_int (close_file_unwind, s);
3406 /* Parse network options in the arg list. We simply ignore anything
3407 which isn't a known option (including other keywords). An error
3408 is signaled if setting a known option fails. */
3410 Lisp_Object params = contact, key, val;
3412 while (!NILP (params))
3414 key = XCAR (params);
3415 params = XCDR (params);
3416 val = XCAR (params);
3417 params = XCDR (params);
3418 optbits |= set_socket_option (s, key, val);
3422 if (p->is_server)
3424 /* Configure as a server socket. */
3426 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3427 explicit :reuseaddr key to override this. */
3428 #ifdef HAVE_LOCAL_SOCKETS
3429 if (family != AF_LOCAL)
3430 #endif
3431 if (!(optbits & (1 << OPIX_REUSEADDR)))
3433 int optval = 1;
3434 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3435 report_file_error ("Cannot set reuse option on server socket", Qnil);
3438 /* If passed a socket descriptor, it should be already bound. */
3439 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3440 report_file_error ("Cannot bind server socket", Qnil);
3442 #ifdef HAVE_GETSOCKNAME
3443 if (p->port == 0
3444 #ifdef HAVE_LOCAL_SOCKETS
3445 && family != AF_LOCAL
3446 #endif
3449 struct sockaddr_in sa1;
3450 socklen_t len1 = sizeof (sa1);
3451 #ifdef AF_INET6
3452 /* The code below assumes the port is at the same offset
3453 and of the same width in both IPv4 and IPv6
3454 structures, but the standards don't guarantee that,
3455 so verify it here. */
3456 struct sockaddr_in6 sa6;
3457 verify ((offsetof (struct sockaddr_in, sin_port)
3458 == offsetof (struct sockaddr_in6, sin6_port))
3459 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3460 #endif
3461 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3462 if (getsockname (s, psa1, &len1) == 0)
3464 Lisp_Object service = make_number (ntohs (sa1.sin_port));
3465 contact = Fplist_put (contact, QCservice, service);
3466 /* Save the port number so that we can stash it in
3467 the process object later. */
3468 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3469 psa->sin_port = sa1.sin_port;
3472 #endif
3474 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3475 report_file_error ("Cannot listen on server socket", Qnil);
3477 break;
3480 maybe_quit ();
3482 ret = connect (s, sa, addrlen);
3483 xerrno = errno;
3485 if (ret == 0 || xerrno == EISCONN)
3487 /* The unwind-protect will be discarded afterwards. */
3488 break;
3491 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3492 break;
3494 #ifndef WINDOWSNT
3495 if (xerrno == EINTR)
3497 /* Unlike most other syscalls connect() cannot be called
3498 again. (That would return EALREADY.) The proper way to
3499 wait for completion is pselect(). */
3500 int sc;
3501 socklen_t len;
3502 fd_set fdset;
3503 retry_select:
3504 FD_ZERO (&fdset);
3505 FD_SET (s, &fdset);
3506 maybe_quit ();
3507 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3508 if (sc == -1)
3510 if (errno == EINTR)
3511 goto retry_select;
3512 else
3513 report_file_error ("Failed select", Qnil);
3515 eassert (sc > 0);
3517 len = sizeof xerrno;
3518 eassert (FD_ISSET (s, &fdset));
3519 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3520 report_file_error ("Failed getsockopt", Qnil);
3521 if (xerrno == 0)
3522 break;
3523 if (NILP (addrinfos))
3524 report_file_errno ("Failed connect", Qnil, xerrno);
3526 #endif /* !WINDOWSNT */
3528 /* Discard the unwind protect closing S. */
3529 specpdl_ptr = specpdl + count;
3530 emacs_close (s);
3531 s = -1;
3532 if (0 <= socket_to_use)
3533 break;
3535 #ifdef WINDOWSNT
3536 if (xerrno == EINTR)
3537 goto retry_connect;
3538 #endif
3541 if (s >= 0)
3543 #ifdef DATAGRAM_SOCKETS
3544 if (p->socktype == SOCK_DGRAM)
3546 if (datagram_address[s].sa)
3547 emacs_abort ();
3549 datagram_address[s].sa = xmalloc (addrlen);
3550 datagram_address[s].len = addrlen;
3551 if (p->is_server)
3553 Lisp_Object remote;
3554 memset (datagram_address[s].sa, 0, addrlen);
3555 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3557 int rfamily;
3558 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3559 if (rlen != 0 && rfamily == family
3560 && rlen == addrlen)
3561 conv_lisp_to_sockaddr (rfamily, remote,
3562 datagram_address[s].sa, rlen);
3565 else
3566 memcpy (datagram_address[s].sa, sa, addrlen);
3568 #endif
3570 contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
3571 conv_sockaddr_to_lisp (sa, addrlen));
3572 #ifdef HAVE_GETSOCKNAME
3573 if (!p->is_server)
3575 struct sockaddr_storage sa1;
3576 socklen_t len1 = sizeof (sa1);
3577 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3578 if (getsockname (s, psa1, &len1) == 0)
3579 contact = Fplist_put (contact, QClocal,
3580 conv_sockaddr_to_lisp (psa1, len1));
3582 #endif
3585 if (s < 0)
3587 /* If non-blocking got this far - and failed - assume non-blocking is
3588 not supported after all. This is probably a wrong assumption, but
3589 the normal blocking calls to open-network-stream handles this error
3590 better. */
3591 if (p->is_non_blocking_client)
3592 return;
3594 report_file_errno ((p->is_server
3595 ? "make server process failed"
3596 : "make client process failed"),
3597 contact, xerrno);
3600 inch = s;
3601 outch = s;
3603 chan_process[inch] = proc;
3605 fcntl (inch, F_SETFL, O_NONBLOCK);
3607 p = XPROCESS (proc);
3608 p->open_fd[SUBPROCESS_STDIN] = inch;
3609 p->infd = inch;
3610 p->outfd = outch;
3612 /* Discard the unwind protect for closing S, if any. */
3613 specpdl_ptr = specpdl + count;
3615 if (p->is_server && p->socktype != SOCK_DGRAM)
3616 pset_status (p, Qlisten);
3618 /* Make the process marker point into the process buffer (if any). */
3619 if (BUFFERP (p->buffer))
3620 set_marker_both (p->mark, p->buffer,
3621 BUF_ZV (XBUFFER (p->buffer)),
3622 BUF_ZV_BYTE (XBUFFER (p->buffer)));
3624 if (p->is_non_blocking_client)
3626 /* We may get here if connect did succeed immediately. However,
3627 in that case, we still need to signal this like a non-blocking
3628 connection. */
3629 if (! (connecting_status (p->status)
3630 && EQ (XCDR (p->status), addrinfos)))
3631 pset_status (p, Fcons (Qconnect, addrinfos));
3632 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3633 add_non_blocking_write_fd (inch);
3635 else
3636 /* A server may have a client filter setting of Qt, but it must
3637 still listen for incoming connects unless it is stopped. */
3638 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3639 || (EQ (p->status, Qlisten) && NILP (p->command)))
3640 add_process_read_fd (inch);
3642 if (inch > max_desc)
3643 max_desc = inch;
3645 /* Set up the masks based on the process filter. */
3646 set_process_filter_masks (p);
3648 setup_process_coding_systems (proc);
3650 #ifdef HAVE_GNUTLS
3651 /* Continue the asynchronous connection. */
3652 if (!NILP (p->gnutls_boot_parameters))
3654 Lisp_Object boot, params = p->gnutls_boot_parameters;
3656 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3657 p->gnutls_boot_parameters = Qnil;
3659 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3660 /* Run sentinels, etc. */
3661 finish_after_tls_connection (proc);
3662 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3664 deactivate_process (proc);
3665 if (NILP (boot))
3666 pset_status (p, list2 (Qfailed,
3667 build_string ("TLS negotiation failed")));
3668 else
3669 pset_status (p, list2 (Qfailed, boot));
3672 #endif
3676 /* Create a network stream/datagram client/server process. Treated
3677 exactly like a normal process when reading and writing. Primary
3678 differences are in status display and process deletion. A network
3679 connection has no PID; you cannot signal it. All you can do is
3680 stop/continue it and deactivate/close it via delete-process. */
3682 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3683 0, MANY, 0,
3684 doc: /* Create and return a network server or client process.
3686 In Emacs, network connections are represented by process objects, so
3687 input and output work as for subprocesses and `delete-process' closes
3688 a network connection. However, a network process has no process id,
3689 it cannot be signaled, and the status codes are different from normal
3690 processes.
3692 Arguments are specified as keyword/argument pairs. The following
3693 arguments are defined:
3695 :name NAME -- NAME is name for process. It is modified if necessary
3696 to make it unique.
3698 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3699 with the process. Process output goes at end of that buffer, unless
3700 you specify a filter function to handle the output. BUFFER may be
3701 also nil, meaning that this process is not associated with any buffer.
3703 :host HOST -- HOST is name of the host to connect to, or its IP
3704 address. The symbol `local' specifies the local host. If specified
3705 for a server process, it must be a valid name or address for the local
3706 host, and only clients connecting to that address will be accepted.
3708 :service SERVICE -- SERVICE is name of the service desired, or an
3709 integer specifying a port number to connect to. If SERVICE is t,
3710 a random port number is selected for the server. A port number can
3711 be specified as an integer string, e.g., "80", as well as an integer.
3713 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3714 stream type connection, `datagram' creates a datagram type connection,
3715 `seqpacket' creates a reliable datagram connection.
3717 :family FAMILY -- FAMILY is the address (and protocol) family for the
3718 service specified by HOST and SERVICE. The default (nil) is to use
3719 whatever address family (IPv4 or IPv6) that is defined for the host
3720 and port number specified by HOST and SERVICE. Other address families
3721 supported are:
3722 local -- for a local (i.e. UNIX) address specified by SERVICE.
3723 ipv4 -- use IPv4 address family only.
3724 ipv6 -- use IPv6 address family only.
3726 :local ADDRESS -- ADDRESS is the local address used for the connection.
3727 This parameter is ignored when opening a client process. When specified
3728 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3730 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3731 connection. This parameter is ignored when opening a stream server
3732 process. For a datagram server process, it specifies the initial
3733 setting of the remote datagram address. When specified for a client
3734 process, the FAMILY, HOST, and SERVICE args are ignored.
3736 The format of ADDRESS depends on the address family:
3737 - An IPv4 address is represented as a vector of integers [A B C D P]
3738 corresponding to numeric IP address A.B.C.D and port number P.
3739 - A local address is represented as a string with the address in the
3740 local address space.
3741 - An "unsupported family" address is represented by a cons (F . AV)
3742 where F is the family number and AV is a vector containing the socket
3743 address data with one element per address data byte. Do not rely on
3744 this format in portable code, as it may depend on implementation
3745 defined constants, data sizes, and data structure alignment.
3747 :coding CODING -- If CODING is a symbol, it specifies the coding
3748 system used for both reading and writing for this process. If CODING
3749 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3750 ENCODING is used for writing.
3752 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3753 process, return without waiting for the connection to complete;
3754 instead, the sentinel function will be called with second arg matching
3755 "open" (if successful) or "failed" when the connect completes.
3756 Default is to use a blocking connect (i.e. wait) for stream type
3757 connections.
3759 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3760 running when Emacs is exited.
3762 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3763 In the stopped state, a server process does not accept new
3764 connections, and a client process does not handle incoming traffic.
3765 The stopped state is cleared by `continue-process' and set by
3766 `stop-process'.
3768 :filter FILTER -- Install FILTER as the process filter.
3770 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3771 process filter are multibyte, otherwise they are unibyte.
3772 If this keyword is not specified, the strings are multibyte.
3774 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3776 :log LOG -- Install LOG as the server process log function. This
3777 function is called when the server accepts a network connection from a
3778 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3779 is the server process, CLIENT is the new process for the connection,
3780 and MESSAGE is a string.
3782 :plist PLIST -- Install PLIST as the new process's initial plist.
3784 :tls-parameters LIST -- is a list that should be supplied if you're
3785 opening a TLS connection. The first element is the TLS type (either
3786 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3787 be a keyword list accepted by gnutls-boot (as returned by
3788 `gnutls-boot-parameters').
3790 :server QLEN -- if QLEN is non-nil, create a server process for the
3791 specified FAMILY, SERVICE, and connection type (stream or datagram).
3792 If QLEN is an integer, it is used as the max. length of the server's
3793 pending connection queue (also known as the backlog); the default
3794 queue length is 5. Default is to create a client process.
3796 The following network options can be specified for this connection:
3798 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3799 :dontroute BOOL -- Only send to directly connected hosts.
3800 :keepalive BOOL -- Send keep-alive messages on network stream.
3801 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3802 :oobinline BOOL -- Place out-of-band data in receive data stream.
3803 :priority INT -- Set protocol defined priority for sent packets.
3804 :reuseaddr BOOL -- Allow reusing a recently used local address
3805 (this is allowed by default for a server process).
3806 :bindtodevice NAME -- bind to interface NAME. Using this may require
3807 special privileges on some systems.
3808 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3809 been passed to Emacs. If Emacs wasn't
3810 passed a socket, this option is silently
3811 ignored.
3814 Consult the relevant system programmer's manual pages for more
3815 information on using these options.
3818 A server process will listen for and accept connections from clients.
3819 When a client connection is accepted, a new network process is created
3820 for the connection with the following parameters:
3822 - The client's process name is constructed by concatenating the server
3823 process's NAME and a client identification string.
3824 - If the FILTER argument is non-nil, the client process will not get a
3825 separate process buffer; otherwise, the client's process buffer is a newly
3826 created buffer named after the server process's BUFFER name or process
3827 NAME concatenated with the client identification string.
3828 - The connection type and the process filter and sentinel parameters are
3829 inherited from the server process's TYPE, FILTER and SENTINEL.
3830 - The client process's contact info is set according to the client's
3831 addressing information (typically an IP address and a port number).
3832 - The client process's plist is initialized from the server's plist.
3834 Notice that the FILTER and SENTINEL args are never used directly by
3835 the server process. Also, the BUFFER argument is not used directly by
3836 the server process, but via the optional :log function, accepted (and
3837 failed) connections may be logged in the server process's buffer.
3839 The original argument list, modified with the actual connection
3840 information, is available via the `process-contact' function.
3842 usage: (make-network-process &rest ARGS) */)
3843 (ptrdiff_t nargs, Lisp_Object *args)
3845 Lisp_Object proc;
3846 Lisp_Object contact;
3847 struct Lisp_Process *p;
3848 const char *portstring UNINIT;
3849 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3850 #ifdef HAVE_LOCAL_SOCKETS
3851 struct sockaddr_un address_un;
3852 #endif
3853 EMACS_INT port = 0;
3854 Lisp_Object tem;
3855 Lisp_Object name, buffer, host, service, address;
3856 Lisp_Object filter, sentinel, use_external_socket_p;
3857 Lisp_Object addrinfos = Qnil;
3858 int socktype;
3859 int family = -1;
3860 enum { any_protocol = 0 };
3861 #ifdef HAVE_GETADDRINFO_A
3862 struct gaicb *dns_request = NULL;
3863 #endif
3864 ptrdiff_t count = SPECPDL_INDEX ();
3866 if (nargs == 0)
3867 return Qnil;
3869 /* Save arguments for process-contact and clone-process. */
3870 contact = Flist (nargs, args);
3872 #ifdef WINDOWSNT
3873 /* Ensure socket support is loaded if available. */
3874 init_winsock (TRUE);
3875 #endif
3877 /* :type TYPE (nil: stream, datagram */
3878 tem = Fplist_get (contact, QCtype);
3879 if (NILP (tem))
3880 socktype = SOCK_STREAM;
3881 #ifdef DATAGRAM_SOCKETS
3882 else if (EQ (tem, Qdatagram))
3883 socktype = SOCK_DGRAM;
3884 #endif
3885 #ifdef HAVE_SEQPACKET
3886 else if (EQ (tem, Qseqpacket))
3887 socktype = SOCK_SEQPACKET;
3888 #endif
3889 else
3890 error ("Unsupported connection type");
3892 name = Fplist_get (contact, QCname);
3893 buffer = Fplist_get (contact, QCbuffer);
3894 filter = Fplist_get (contact, QCfilter);
3895 sentinel = Fplist_get (contact, QCsentinel);
3896 use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
3898 CHECK_STRING (name);
3900 /* :local ADDRESS or :remote ADDRESS */
3901 tem = Fplist_get (contact, QCserver);
3902 if (NILP (tem))
3903 address = Fplist_get (contact, QCremote);
3904 else
3905 address = Fplist_get (contact, QClocal);
3906 if (!NILP (address))
3908 host = service = Qnil;
3910 if (!get_lisp_to_sockaddr_size (address, &family))
3911 error ("Malformed :address");
3913 addrinfos = list1 (Fcons (make_number (any_protocol), address));
3914 goto open_socket;
3917 /* :family FAMILY -- nil (for Inet), local, or integer. */
3918 tem = Fplist_get (contact, QCfamily);
3919 if (NILP (tem))
3921 #ifdef AF_INET6
3922 family = AF_UNSPEC;
3923 #else
3924 family = AF_INET;
3925 #endif
3927 #ifdef HAVE_LOCAL_SOCKETS
3928 else if (EQ (tem, Qlocal))
3929 family = AF_LOCAL;
3930 #endif
3931 #ifdef AF_INET6
3932 else if (EQ (tem, Qipv6))
3933 family = AF_INET6;
3934 #endif
3935 else if (EQ (tem, Qipv4))
3936 family = AF_INET;
3937 else if (TYPE_RANGED_INTEGERP (int, tem))
3938 family = XINT (tem);
3939 else
3940 error ("Unknown address family");
3942 /* :service SERVICE -- string, integer (port number), or t (random port). */
3943 service = Fplist_get (contact, QCservice);
3945 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3946 host = Fplist_get (contact, QChost);
3947 if (NILP (host))
3949 /* The "connection" function gets it bind info from the address we're
3950 given, so use this dummy address if nothing is specified. */
3951 #ifdef HAVE_LOCAL_SOCKETS
3952 if (family != AF_LOCAL)
3953 #endif
3954 host = build_string ("127.0.0.1");
3956 else
3958 if (EQ (host, Qlocal))
3959 /* Depending on setup, "localhost" may map to different IPv4 and/or
3960 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3961 host = build_string ("127.0.0.1");
3962 CHECK_STRING (host);
3965 #ifdef HAVE_LOCAL_SOCKETS
3966 if (family == AF_LOCAL)
3968 if (!NILP (host))
3970 message (":family local ignores the :host property");
3971 contact = Fplist_put (contact, QChost, Qnil);
3972 host = Qnil;
3974 CHECK_STRING (service);
3975 if (sizeof address_un.sun_path <= SBYTES (service))
3976 error ("Service name too long");
3977 addrinfos = list1 (Fcons (make_number (any_protocol), service));
3978 goto open_socket;
3980 #endif
3982 /* Slow down polling to every ten seconds.
3983 Some kernels have a bug which causes retrying connect to fail
3984 after a connect. Polling can interfere with gethostbyname too. */
3985 #ifdef POLL_FOR_INPUT
3986 if (socktype != SOCK_DGRAM)
3988 record_unwind_protect_void (run_all_atimers);
3989 bind_polling_period (10);
3991 #endif
3993 if (!NILP (host))
3995 ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
3997 /* SERVICE can either be a string or int.
3998 Convert to a C string for later use by getaddrinfo. */
3999 if (EQ (service, Qt))
4001 portstring = "0";
4002 portstringlen = 1;
4004 else if (INTEGERP (service))
4006 portstring = portbuf;
4007 portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
4009 else
4011 CHECK_STRING (service);
4012 portstring = SSDATA (service);
4013 portstringlen = SBYTES (service);
4016 #ifdef HAVE_GETADDRINFO_A
4017 if (!NILP (Fplist_get (contact, QCnowait)))
4019 ptrdiff_t hostlen = SBYTES (host);
4020 struct req
4022 struct gaicb gaicb;
4023 struct addrinfo hints;
4024 char str[FLEXIBLE_ARRAY_MEMBER];
4025 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4026 hostlen + 1 + portstringlen + 1));
4027 dns_request = &req->gaicb;
4028 dns_request->ar_name = req->str;
4029 dns_request->ar_service = req->str + hostlen + 1;
4030 dns_request->ar_request = &req->hints;
4031 dns_request->ar_result = NULL;
4032 memset (&req->hints, 0, sizeof req->hints);
4033 req->hints.ai_family = family;
4034 req->hints.ai_socktype = socktype;
4035 strcpy (req->str, SSDATA (host));
4036 strcpy (req->str + hostlen + 1, portstring);
4038 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4039 if (ret)
4040 error ("%s/%s getaddrinfo_a error %d",
4041 SSDATA (host), portstring, ret);
4043 goto open_socket;
4045 #endif /* HAVE_GETADDRINFO_A */
4048 /* If we have a host, use getaddrinfo to resolve both host and service.
4049 Otherwise, use getservbyname to lookup the service. */
4051 if (!NILP (host))
4053 struct addrinfo *res, *lres;
4054 int ret;
4056 maybe_quit ();
4058 struct addrinfo hints;
4059 memset (&hints, 0, sizeof hints);
4060 hints.ai_family = family;
4061 hints.ai_socktype = socktype;
4063 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
4064 if (ret)
4065 #ifdef HAVE_GAI_STRERROR
4067 synchronize_system_messages_locale ();
4068 char const *str = gai_strerror (ret);
4069 if (! NILP (Vlocale_coding_system))
4070 str = SSDATA (code_convert_string_norecord
4071 (build_string (str), Vlocale_coding_system, 0));
4072 error ("%s/%s %s", SSDATA (host), portstring, str);
4074 #else
4075 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4076 #endif
4078 for (lres = res; lres; lres = lres->ai_next)
4079 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4081 addrinfos = Fnreverse (addrinfos);
4083 freeaddrinfo (res);
4085 goto open_socket;
4088 /* No hostname has been specified (e.g., a local server process). */
4090 if (EQ (service, Qt))
4091 port = 0;
4092 else if (INTEGERP (service))
4093 port = XINT (service);
4094 else
4096 CHECK_STRING (service);
4098 port = -1;
4099 if (SBYTES (service) != 0)
4101 /* Allow the service to be a string containing the port number,
4102 because that's allowed if you have getaddrbyname. */
4103 char *service_end;
4104 long int lport = strtol (SSDATA (service), &service_end, 10);
4105 if (service_end == SSDATA (service) + SBYTES (service))
4106 port = lport;
4107 else
4109 struct servent *svc_info
4110 = getservbyname (SSDATA (service),
4111 socktype == SOCK_DGRAM ? "udp" : "tcp");
4112 if (svc_info)
4113 port = ntohs (svc_info->s_port);
4118 if (! (0 <= port && port < 1 << 16))
4120 AUTO_STRING (unknown_service, "Unknown service: %s");
4121 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4124 open_socket:
4126 if (!NILP (buffer))
4127 buffer = Fget_buffer_create (buffer);
4129 /* Unwind bind_polling_period. */
4130 unbind_to (count, Qnil);
4132 proc = make_process (name);
4133 record_unwind_protect (remove_process, proc);
4134 p = XPROCESS (proc);
4135 pset_childp (p, contact);
4136 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
4137 pset_type (p, Qnetwork);
4139 pset_buffer (p, buffer);
4140 pset_sentinel (p, sentinel);
4141 pset_filter (p, filter);
4142 pset_log (p, Fplist_get (contact, QClog));
4143 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
4144 p->kill_without_query = 1;
4145 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
4146 pset_command (p, Qt);
4147 eassert (p->pid == 0);
4148 p->backlog = 5;
4149 eassert (! p->is_non_blocking_client);
4150 eassert (! p->is_server);
4151 p->port = port;
4152 p->socktype = socktype;
4153 #ifdef HAVE_GETADDRINFO_A
4154 eassert (! p->dns_request);
4155 #endif
4156 #ifdef HAVE_GNUTLS
4157 tem = Fplist_get (contact, QCtls_parameters);
4158 CHECK_LIST (tem);
4159 p->gnutls_boot_parameters = tem;
4160 #endif
4162 set_network_socket_coding_system (proc, host, service, name);
4164 /* :server BOOL */
4165 tem = Fplist_get (contact, QCserver);
4166 if (!NILP (tem))
4168 /* Don't support network sockets when non-blocking mode is
4169 not available, since a blocked Emacs is not useful. */
4170 p->is_server = true;
4171 if (TYPE_RANGED_INTEGERP (int, tem))
4172 p->backlog = XINT (tem);
4175 /* :nowait BOOL */
4176 if (!p->is_server && socktype != SOCK_DGRAM
4177 && !NILP (Fplist_get (contact, QCnowait)))
4178 p->is_non_blocking_client = true;
4180 bool postpone_connection = false;
4181 #ifdef HAVE_GETADDRINFO_A
4182 /* With async address resolution, the list of addresses is empty, so
4183 postpone connecting to the server. */
4184 if (!p->is_server && NILP (addrinfos))
4186 p->dns_request = dns_request;
4187 p->status = list1 (Qconnect);
4188 postpone_connection = true;
4190 #endif
4191 if (! postpone_connection)
4192 connect_network_socket (proc, addrinfos, use_external_socket_p);
4194 specpdl_ptr = specpdl + count;
4195 return proc;
4199 #ifdef HAVE_NET_IF_H
4201 #ifdef SIOCGIFCONF
4202 static Lisp_Object
4203 network_interface_list (void)
4205 struct ifconf ifconf;
4206 struct ifreq *ifreq;
4207 void *buf = NULL;
4208 ptrdiff_t buf_size = 512;
4209 int s;
4210 Lisp_Object res;
4211 ptrdiff_t count;
4213 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4214 if (s < 0)
4215 return Qnil;
4216 count = SPECPDL_INDEX ();
4217 record_unwind_protect_int (close_file_unwind, s);
4221 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
4222 ifconf.ifc_buf = buf;
4223 ifconf.ifc_len = buf_size;
4224 if (ioctl (s, SIOCGIFCONF, &ifconf))
4226 emacs_close (s);
4227 xfree (buf);
4228 return Qnil;
4231 while (ifconf.ifc_len == buf_size);
4233 res = unbind_to (count, Qnil);
4234 ifreq = ifconf.ifc_req;
4235 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
4237 struct ifreq *ifq = ifreq;
4238 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4239 #define SIZEOF_IFREQ(sif) \
4240 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4241 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4243 int len = SIZEOF_IFREQ (ifq);
4244 #else
4245 int len = sizeof (*ifreq);
4246 #endif
4247 char namebuf[sizeof (ifq->ifr_name) + 1];
4248 ifreq = (struct ifreq *) ((char *) ifreq + len);
4250 if (ifq->ifr_addr.sa_family != AF_INET)
4251 continue;
4253 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
4254 namebuf[sizeof (ifq->ifr_name)] = 0;
4255 res = Fcons (Fcons (build_string (namebuf),
4256 conv_sockaddr_to_lisp (&ifq->ifr_addr,
4257 sizeof (struct sockaddr))),
4258 res);
4261 xfree (buf);
4262 return res;
4264 #endif /* SIOCGIFCONF */
4266 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4268 struct ifflag_def {
4269 int flag_bit;
4270 const char *flag_sym;
4273 static const struct ifflag_def ifflag_table[] = {
4274 #ifdef IFF_UP
4275 { IFF_UP, "up" },
4276 #endif
4277 #ifdef IFF_BROADCAST
4278 { IFF_BROADCAST, "broadcast" },
4279 #endif
4280 #ifdef IFF_DEBUG
4281 { IFF_DEBUG, "debug" },
4282 #endif
4283 #ifdef IFF_LOOPBACK
4284 { IFF_LOOPBACK, "loopback" },
4285 #endif
4286 #ifdef IFF_POINTOPOINT
4287 { IFF_POINTOPOINT, "pointopoint" },
4288 #endif
4289 #ifdef IFF_RUNNING
4290 { IFF_RUNNING, "running" },
4291 #endif
4292 #ifdef IFF_NOARP
4293 { IFF_NOARP, "noarp" },
4294 #endif
4295 #ifdef IFF_PROMISC
4296 { IFF_PROMISC, "promisc" },
4297 #endif
4298 #ifdef IFF_NOTRAILERS
4299 #ifdef NS_IMPL_COCOA
4300 /* Really means smart, notrailers is obsolete. */
4301 { IFF_NOTRAILERS, "smart" },
4302 #else
4303 { IFF_NOTRAILERS, "notrailers" },
4304 #endif
4305 #endif
4306 #ifdef IFF_ALLMULTI
4307 { IFF_ALLMULTI, "allmulti" },
4308 #endif
4309 #ifdef IFF_MASTER
4310 { IFF_MASTER, "master" },
4311 #endif
4312 #ifdef IFF_SLAVE
4313 { IFF_SLAVE, "slave" },
4314 #endif
4315 #ifdef IFF_MULTICAST
4316 { IFF_MULTICAST, "multicast" },
4317 #endif
4318 #ifdef IFF_PORTSEL
4319 { IFF_PORTSEL, "portsel" },
4320 #endif
4321 #ifdef IFF_AUTOMEDIA
4322 { IFF_AUTOMEDIA, "automedia" },
4323 #endif
4324 #ifdef IFF_DYNAMIC
4325 { IFF_DYNAMIC, "dynamic" },
4326 #endif
4327 #ifdef IFF_OACTIVE
4328 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress. */
4329 #endif
4330 #ifdef IFF_SIMPLEX
4331 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4332 #endif
4333 #ifdef IFF_LINK0
4334 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit. */
4335 #endif
4336 #ifdef IFF_LINK1
4337 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit. */
4338 #endif
4339 #ifdef IFF_LINK2
4340 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit. */
4341 #endif
4342 { 0, 0 }
4345 static Lisp_Object
4346 network_interface_info (Lisp_Object ifname)
4348 struct ifreq rq;
4349 Lisp_Object res = Qnil;
4350 Lisp_Object elt;
4351 int s;
4352 bool any = 0;
4353 ptrdiff_t count;
4354 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4355 && defined HAVE_GETIFADDRS && defined LLADDR)
4356 struct ifaddrs *ifap;
4357 #endif
4359 CHECK_STRING (ifname);
4361 if (sizeof rq.ifr_name <= SBYTES (ifname))
4362 error ("interface name too long");
4363 lispstpcpy (rq.ifr_name, ifname);
4365 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4366 if (s < 0)
4367 return Qnil;
4368 count = SPECPDL_INDEX ();
4369 record_unwind_protect_int (close_file_unwind, s);
4371 elt = Qnil;
4372 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4373 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4375 int flags = rq.ifr_flags;
4376 const struct ifflag_def *fp;
4377 int fnum;
4379 /* If flags is smaller than int (i.e. short) it may have the high bit set
4380 due to IFF_MULTICAST. In that case, sign extending it into
4381 an int is wrong. */
4382 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4383 flags = (unsigned short) rq.ifr_flags;
4385 any = 1;
4386 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4388 if (flags & fp->flag_bit)
4390 elt = Fcons (intern (fp->flag_sym), elt);
4391 flags -= fp->flag_bit;
4394 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4396 if (flags & 1)
4398 elt = Fcons (make_number (fnum), elt);
4402 #endif
4403 res = Fcons (elt, res);
4405 elt = Qnil;
4406 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4407 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4409 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4410 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4411 int n;
4413 any = 1;
4414 for (n = 0; n < 6; n++)
4415 p->contents[n] = make_number (((unsigned char *)
4416 &rq.ifr_hwaddr.sa_data[0])
4417 [n]);
4418 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4420 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4421 if (getifaddrs (&ifap) != -1)
4423 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4424 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4425 struct ifaddrs *it;
4427 for (it = ifap; it != NULL; it = it->ifa_next)
4429 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4430 unsigned char linkaddr[6];
4431 int n;
4433 if (it->ifa_addr->sa_family != AF_LINK
4434 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4435 || sdl->sdl_alen != 6)
4436 continue;
4438 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4439 for (n = 0; n < 6; n++)
4440 p->contents[n] = make_number (linkaddr[n]);
4442 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
4443 break;
4446 #ifdef HAVE_FREEIFADDRS
4447 freeifaddrs (ifap);
4448 #endif
4450 #endif /* HAVE_GETIFADDRS && LLADDR */
4452 res = Fcons (elt, res);
4454 elt = Qnil;
4455 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4456 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4458 any = 1;
4459 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4460 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4461 #else
4462 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4463 #endif
4465 #endif
4466 res = Fcons (elt, res);
4468 elt = Qnil;
4469 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4470 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4472 any = 1;
4473 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4475 #endif
4476 res = Fcons (elt, res);
4478 elt = Qnil;
4479 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4480 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4482 any = 1;
4483 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4485 #endif
4486 res = Fcons (elt, res);
4488 return unbind_to (count, any ? res : Qnil);
4490 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4491 #endif /* defined (HAVE_NET_IF_H) */
4493 DEFUN ("network-interface-list", Fnetwork_interface_list,
4494 Snetwork_interface_list, 0, 0, 0,
4495 doc: /* Return an alist of all network interfaces and their network address.
4496 Each element is a cons, the car of which is a string containing the
4497 interface name, and the cdr is the network address in internal
4498 format; see the description of ADDRESS in `make-network-process'.
4500 If the information is not available, return nil. */)
4501 (void)
4503 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4504 return network_interface_list ();
4505 #else
4506 return Qnil;
4507 #endif
4510 DEFUN ("network-interface-info", Fnetwork_interface_info,
4511 Snetwork_interface_info, 1, 1, 0,
4512 doc: /* Return information about network interface named IFNAME.
4513 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4514 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4515 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4516 FLAGS is the current flags of the interface.
4518 Data that is unavailable is returned as nil. */)
4519 (Lisp_Object ifname)
4521 #if ((defined HAVE_NET_IF_H \
4522 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4523 || defined SIOCGIFFLAGS)) \
4524 || defined WINDOWSNT)
4525 return network_interface_info (ifname);
4526 #else
4527 return Qnil;
4528 #endif
4531 /* Turn off input and output for process PROC. */
4533 static void
4534 deactivate_process (Lisp_Object proc)
4536 int inchannel;
4537 struct Lisp_Process *p = XPROCESS (proc);
4538 int i;
4540 #ifdef HAVE_GNUTLS
4541 /* Delete GnuTLS structures in PROC, if any. */
4542 emacs_gnutls_deinit (proc);
4543 #endif /* HAVE_GNUTLS */
4545 if (p->read_output_delay > 0)
4547 if (--process_output_delay_count < 0)
4548 process_output_delay_count = 0;
4549 p->read_output_delay = 0;
4550 p->read_output_skip = 0;
4553 /* Beware SIGCHLD hereabouts. */
4555 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4556 close_process_fd (&p->open_fd[i]);
4558 inchannel = p->infd;
4559 if (inchannel >= 0)
4561 p->infd = -1;
4562 p->outfd = -1;
4563 #ifdef DATAGRAM_SOCKETS
4564 if (DATAGRAM_CHAN_P (inchannel))
4566 xfree (datagram_address[inchannel].sa);
4567 datagram_address[inchannel].sa = 0;
4568 datagram_address[inchannel].len = 0;
4570 #endif
4571 chan_process[inchannel] = Qnil;
4572 delete_read_fd (inchannel);
4573 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4574 delete_write_fd (inchannel);
4575 if (inchannel == max_desc)
4576 recompute_max_desc ();
4581 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4582 0, 4, 0,
4583 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4584 It is given to their filter functions.
4585 Optional argument PROCESS means do not return until output has been
4586 received from PROCESS.
4588 Optional second argument SECONDS and third argument MILLISEC
4589 specify a timeout; return after that much time even if there is
4590 no subprocess output. If SECONDS is a floating point number,
4591 it specifies a fractional number of seconds to wait.
4592 The MILLISEC argument is obsolete and should be avoided.
4594 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4595 from PROCESS only, suspending reading output from other processes.
4596 If JUST-THIS-ONE is an integer, don't run any timers either.
4597 Return non-nil if we received any output from PROCESS (or, if PROCESS
4598 is nil, from any process) before the timeout expired. */)
4599 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4600 Lisp_Object just_this_one)
4602 intmax_t secs;
4603 int nsecs;
4605 if (! NILP (process))
4607 CHECK_PROCESS (process);
4608 struct Lisp_Process *proc = XPROCESS (process);
4610 /* Can't wait for a process that is dedicated to a different
4611 thread. */
4612 if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ()))
4614 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4616 if (STRINGP (proc_thread_name))
4617 error ("Attempt to accept output from process %s locked to thread %s",
4618 SDATA (proc->name), SDATA (proc_thread_name));
4619 else
4620 error ("Attempt to accept output from process %s locked to thread %p",
4621 SDATA (proc->name), XTHREAD (proc->thread));
4624 else
4625 just_this_one = Qnil;
4627 if (!NILP (millisec))
4628 { /* Obsolete calling convention using integers rather than floats. */
4629 CHECK_NUMBER (millisec);
4630 if (NILP (seconds))
4631 seconds = make_float (XINT (millisec) / 1000.0);
4632 else
4634 CHECK_NUMBER (seconds);
4635 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4639 secs = 0;
4640 nsecs = -1;
4642 if (!NILP (seconds))
4644 if (INTEGERP (seconds))
4646 if (XINT (seconds) > 0)
4648 secs = XINT (seconds);
4649 nsecs = 0;
4652 else if (FLOATP (seconds))
4654 if (XFLOAT_DATA (seconds) > 0)
4656 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4657 secs = min (t.tv_sec, WAIT_READING_MAX);
4658 nsecs = t.tv_nsec;
4661 else
4662 wrong_type_argument (Qnumberp, seconds);
4664 else if (! NILP (process))
4665 nsecs = 0;
4667 return
4668 ((wait_reading_process_output (secs, nsecs, 0, 0,
4669 Qnil,
4670 !NILP (process) ? XPROCESS (process) : NULL,
4671 (NILP (just_this_one) ? 0
4672 : !INTEGERP (just_this_one) ? 1 : -1))
4673 <= 0)
4674 ? Qnil : Qt);
4677 /* Accept a connection for server process SERVER on CHANNEL. */
4679 static EMACS_INT connect_counter = 0;
4681 static void
4682 server_accept_connection (Lisp_Object server, int channel)
4684 Lisp_Object buffer;
4685 Lisp_Object contact, host, service;
4686 struct Lisp_Process *ps = XPROCESS (server);
4687 struct Lisp_Process *p;
4688 int s;
4689 union u_sockaddr saddr;
4690 socklen_t len = sizeof saddr;
4691 ptrdiff_t count;
4693 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4695 if (s < 0)
4697 int code = errno;
4698 if (!would_block (code) && !NILP (ps->log))
4699 call3 (ps->log, server, Qnil,
4700 concat3 (build_string ("accept failed with code"),
4701 Fnumber_to_string (make_number (code)),
4702 build_string ("\n")));
4703 return;
4706 count = SPECPDL_INDEX ();
4707 record_unwind_protect_int (close_file_unwind, s);
4709 connect_counter++;
4711 /* Setup a new process to handle the connection. */
4713 /* Generate a unique identification of the caller, and build contact
4714 information for this process. */
4715 host = Qt;
4716 service = Qnil;
4717 Lisp_Object args[11];
4718 int nargs = 0;
4719 AUTO_STRING (procname_format_in, "%s <%d.%d.%d.%d:%d>");
4720 AUTO_STRING (procname_format_in6, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4721 AUTO_STRING (procname_format_default, "%s <%d>");
4722 switch (saddr.sa.sa_family)
4724 case AF_INET:
4726 args[nargs++] = procname_format_in;
4727 nargs++;
4728 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4729 service = make_number (ntohs (saddr.in.sin_port));
4730 for (int i = 0; i < 4; i++)
4731 args[nargs++] = make_number (ip[i]);
4732 args[nargs++] = service;
4734 break;
4736 #ifdef AF_INET6
4737 case AF_INET6:
4739 args[nargs++] = procname_format_in6;
4740 nargs++;
4741 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4742 service = make_number (ntohs (saddr.in.sin_port));
4743 for (int i = 0; i < 8; i++)
4744 args[nargs++] = make_number (ip6[i]);
4745 args[nargs++] = service;
4747 break;
4748 #endif
4750 default:
4751 args[nargs++] = procname_format_default;
4752 nargs++;
4753 args[nargs++] = make_number (connect_counter);
4754 break;
4757 /* Create a new buffer name for this process if it doesn't have a
4758 filter. The new buffer name is based on the buffer name or
4759 process name of the server process concatenated with the caller
4760 identification. */
4762 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4763 || EQ (ps->filter, Qt)))
4764 buffer = Qnil;
4765 else
4767 buffer = ps->buffer;
4768 if (!NILP (buffer))
4769 buffer = Fbuffer_name (buffer);
4770 else
4771 buffer = ps->name;
4772 if (!NILP (buffer))
4774 args[1] = buffer;
4775 buffer = Fget_buffer_create (Fformat (nargs, args));
4779 /* Generate a unique name for the new server process. Combine the
4780 server process name with the caller identification. */
4782 args[1] = ps->name;
4783 Lisp_Object name = Fformat (nargs, args);
4784 Lisp_Object proc = make_process (name);
4786 chan_process[s] = proc;
4788 fcntl (s, F_SETFL, O_NONBLOCK);
4790 p = XPROCESS (proc);
4792 /* Build new contact information for this setup. */
4793 contact = Fcopy_sequence (ps->childp);
4794 contact = Fplist_put (contact, QCserver, Qnil);
4795 contact = Fplist_put (contact, QChost, host);
4796 if (!NILP (service))
4797 contact = Fplist_put (contact, QCservice, service);
4798 contact = Fplist_put (contact, QCremote,
4799 conv_sockaddr_to_lisp (&saddr.sa, len));
4800 #ifdef HAVE_GETSOCKNAME
4801 len = sizeof saddr;
4802 if (getsockname (s, &saddr.sa, &len) == 0)
4803 contact = Fplist_put (contact, QClocal,
4804 conv_sockaddr_to_lisp (&saddr.sa, len));
4805 #endif
4807 pset_childp (p, contact);
4808 pset_plist (p, Fcopy_sequence (ps->plist));
4809 pset_type (p, Qnetwork);
4811 pset_buffer (p, buffer);
4812 pset_sentinel (p, ps->sentinel);
4813 pset_filter (p, ps->filter);
4814 eassert (NILP (p->command));
4815 eassert (p->pid == 0);
4817 /* Discard the unwind protect for closing S. */
4818 specpdl_ptr = specpdl + count;
4820 p->open_fd[SUBPROCESS_STDIN] = s;
4821 p->infd = s;
4822 p->outfd = s;
4823 pset_status (p, Qrun);
4825 /* Client processes for accepted connections are not stopped initially. */
4826 if (!EQ (p->filter, Qt))
4827 add_process_read_fd (s);
4828 if (s > max_desc)
4829 max_desc = s;
4831 /* Setup coding system for new process based on server process.
4832 This seems to be the proper thing to do, as the coding system
4833 of the new process should reflect the settings at the time the
4834 server socket was opened; not the current settings. */
4836 pset_decode_coding_system (p, ps->decode_coding_system);
4837 pset_encode_coding_system (p, ps->encode_coding_system);
4838 setup_process_coding_systems (proc);
4840 pset_decoding_buf (p, empty_unibyte_string);
4841 eassert (p->decoding_carryover == 0);
4842 pset_encoding_buf (p, empty_unibyte_string);
4844 p->inherit_coding_system_flag
4845 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4847 AUTO_STRING (dash, "-");
4848 AUTO_STRING (nl, "\n");
4849 Lisp_Object host_string = STRINGP (host) ? host : dash;
4851 if (!NILP (ps->log))
4853 AUTO_STRING (accept_from, "accept from ");
4854 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
4857 AUTO_STRING (open_from, "open from ");
4858 exec_sentinel (proc, concat3 (open_from, host_string, nl));
4861 #ifdef HAVE_GETADDRINFO_A
4862 static Lisp_Object
4863 check_for_dns (Lisp_Object proc)
4865 struct Lisp_Process *p = XPROCESS (proc);
4866 Lisp_Object addrinfos = Qnil;
4868 /* Sanity check. */
4869 if (! p->dns_request)
4870 return Qnil;
4872 int ret = gai_error (p->dns_request);
4873 if (ret == EAI_INPROGRESS)
4874 return Qt;
4876 /* We got a response. */
4877 if (ret == 0)
4879 struct addrinfo *res;
4881 for (res = p->dns_request->ar_result; res; res = res->ai_next)
4882 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
4884 addrinfos = Fnreverse (addrinfos);
4886 /* The DNS lookup failed. */
4887 else if (connecting_status (p->status))
4889 deactivate_process (proc);
4890 pset_status (p, (list2
4891 (Qfailed,
4892 concat3 (build_string ("Name lookup of "),
4893 build_string (p->dns_request->ar_name),
4894 build_string (" failed")))));
4897 free_dns_request (proc);
4899 /* This process should not already be connected (or killed). */
4900 if (! connecting_status (p->status))
4901 return Qnil;
4903 return addrinfos;
4906 #endif /* HAVE_GETADDRINFO_A */
4908 static void
4909 wait_for_socket_fds (Lisp_Object process, char const *name)
4911 while (XPROCESS (process)->infd < 0
4912 && connecting_status (XPROCESS (process)->status))
4914 add_to_log ("Waiting for socket from %s...", build_string (name));
4915 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4919 static void
4920 wait_while_connecting (Lisp_Object process)
4922 while (connecting_status (XPROCESS (process)->status))
4924 add_to_log ("Waiting for connection...");
4925 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4929 static void
4930 wait_for_tls_negotiation (Lisp_Object process)
4932 #ifdef HAVE_GNUTLS
4933 while (XPROCESS (process)->gnutls_p
4934 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
4936 add_to_log ("Waiting for TLS...");
4937 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4939 #endif
4942 static void
4943 wait_reading_process_output_unwind (int data)
4945 clear_waiting_thread_info ();
4946 waiting_for_user_input_p = data;
4949 /* This is here so breakpoints can be put on it. */
4950 static void
4951 wait_reading_process_output_1 (void)
4955 /* Read and dispose of subprocess output while waiting for timeout to
4956 elapse and/or keyboard input to be available.
4958 TIME_LIMIT is:
4959 timeout in seconds
4960 If negative, gobble data immediately available but don't wait for any.
4962 NSECS is:
4963 an additional duration to wait, measured in nanoseconds
4964 If TIME_LIMIT is zero, then:
4965 If NSECS == 0, there is no limit.
4966 If NSECS > 0, the timeout consists of NSECS only.
4967 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4969 READ_KBD is:
4970 0 to ignore keyboard input, or
4971 1 to return when input is available, or
4972 -1 meaning caller will actually read the input, so don't throw to
4973 the quit handler
4975 DO_DISPLAY means redisplay should be done to show subprocess
4976 output that arrives.
4978 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4979 (and gobble terminal input into the buffer if any arrives).
4981 If WAIT_PROC is specified, wait until something arrives from that
4982 process.
4984 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4985 (suspending output from other processes). A negative value
4986 means don't run any timers either.
4988 Return positive if we received input from WAIT_PROC (or from any
4989 process if WAIT_PROC is null), zero if we attempted to receive
4990 input but got none, and negative if we didn't even try. */
4993 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4994 bool do_display,
4995 Lisp_Object wait_for_cell,
4996 struct Lisp_Process *wait_proc, int just_wait_proc)
4998 int channel, nfds;
4999 fd_set Available;
5000 fd_set Writeok;
5001 bool check_write;
5002 int check_delay;
5003 bool no_avail;
5004 int xerrno;
5005 Lisp_Object proc;
5006 struct timespec timeout, end_time, timer_delay;
5007 struct timespec got_output_end_time = invalid_timespec ();
5008 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
5009 int got_some_output = -1;
5010 uintmax_t prev_wait_proc_nbytes_read = wait_proc ? wait_proc->nbytes_read : 0;
5011 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5012 bool retry_for_async;
5013 #endif
5014 ptrdiff_t count = SPECPDL_INDEX ();
5016 /* Close to the current time if known, an invalid timespec otherwise. */
5017 struct timespec now = invalid_timespec ();
5019 eassert (wait_proc == NULL
5020 || EQ (wait_proc->thread, Qnil)
5021 || XTHREAD (wait_proc->thread) == current_thread);
5023 FD_ZERO (&Available);
5024 FD_ZERO (&Writeok);
5026 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5027 && !(CONSP (wait_proc->status)
5028 && EQ (XCAR (wait_proc->status), Qexit)))
5029 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5031 record_unwind_protect_int (wait_reading_process_output_unwind,
5032 waiting_for_user_input_p);
5033 waiting_for_user_input_p = read_kbd;
5035 if (TYPE_MAXIMUM (time_t) < time_limit)
5036 time_limit = TYPE_MAXIMUM (time_t);
5038 if (time_limit < 0 || nsecs < 0)
5039 wait = MINIMUM;
5040 else if (time_limit > 0 || nsecs > 0)
5042 wait = TIMEOUT;
5043 now = current_timespec ();
5044 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5046 else
5047 wait = INFINITY;
5049 while (1)
5051 bool process_skipped = false;
5053 /* If calling from keyboard input, do not quit
5054 since we want to return C-g as an input character.
5055 Otherwise, do pending quit if requested. */
5056 if (read_kbd >= 0)
5057 maybe_quit ();
5058 else if (pending_signals)
5059 process_pending_signals ();
5061 /* Exit now if the cell we're waiting for became non-nil. */
5062 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5063 break;
5065 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5067 Lisp_Object process_list_head, aproc;
5068 struct Lisp_Process *p;
5070 retry_for_async = false;
5071 FOR_EACH_PROCESS(process_list_head, aproc)
5073 p = XPROCESS (aproc);
5075 if (! wait_proc || p == wait_proc)
5077 #ifdef HAVE_GETADDRINFO_A
5078 /* Check for pending DNS requests. */
5079 if (p->dns_request)
5081 Lisp_Object addrinfos = check_for_dns (aproc);
5082 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5083 connect_network_socket (aproc, addrinfos, Qnil);
5084 else
5085 retry_for_async = true;
5087 #endif
5088 #ifdef HAVE_GNUTLS
5089 /* Continue TLS negotiation. */
5090 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5091 && p->is_non_blocking_client)
5093 gnutls_try_handshake (p);
5094 p->gnutls_handshakes_tried++;
5096 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5098 gnutls_verify_boot (aproc, Qnil);
5099 finish_after_tls_connection (aproc);
5101 else
5103 retry_for_async = true;
5104 if (p->gnutls_handshakes_tried
5105 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5107 deactivate_process (aproc);
5108 pset_status (p, list2 (Qfailed,
5109 build_string ("TLS negotiation failed")));
5113 #endif
5117 #endif /* GETADDRINFO_A or GNUTLS */
5119 /* Compute time from now till when time limit is up. */
5120 /* Exit if already run out. */
5121 if (wait == TIMEOUT)
5123 if (!timespec_valid_p (now))
5124 now = current_timespec ();
5125 if (timespec_cmp (end_time, now) <= 0)
5126 break;
5127 timeout = timespec_sub (end_time, now);
5129 else
5130 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5132 /* Normally we run timers here.
5133 But not if wait_for_cell; in those cases,
5134 the wait is supposed to be short,
5135 and those callers cannot handle running arbitrary Lisp code here. */
5136 if (NILP (wait_for_cell)
5137 && just_wait_proc >= 0)
5141 unsigned old_timers_run = timers_run;
5142 struct buffer *old_buffer = current_buffer;
5143 Lisp_Object old_window = selected_window;
5145 timer_delay = timer_check ();
5147 /* If a timer has run, this might have changed buffers
5148 an alike. Make read_key_sequence aware of that. */
5149 if (timers_run != old_timers_run
5150 && (old_buffer != current_buffer
5151 || !EQ (old_window, selected_window))
5152 && waiting_for_user_input_p == -1)
5153 record_asynch_buffer_change ();
5155 if (timers_run != old_timers_run && do_display)
5156 /* We must retry, since a timer may have requeued itself
5157 and that could alter the time_delay. */
5158 redisplay_preserve_echo_area (9);
5159 else
5160 break;
5162 while (!detect_input_pending ());
5164 /* If there is unread keyboard input, also return. */
5165 if (read_kbd != 0
5166 && requeued_events_pending_p ())
5167 break;
5169 /* This is so a breakpoint can be put here. */
5170 if (!timespec_valid_p (timer_delay))
5171 wait_reading_process_output_1 ();
5174 /* Cause C-g and alarm signals to take immediate action,
5175 and cause input available signals to zero out timeout.
5177 It is important that we do this before checking for process
5178 activity. If we get a SIGCHLD after the explicit checks for
5179 process activity, timeout is the only way we will know. */
5180 if (read_kbd < 0)
5181 set_waiting_for_input (&timeout);
5183 /* If status of something has changed, and no input is
5184 available, notify the user of the change right away. After
5185 this explicit check, we'll let the SIGCHLD handler zap
5186 timeout to get our attention. */
5187 if (update_tick != process_tick)
5189 fd_set Atemp;
5190 fd_set Ctemp;
5192 if (kbd_on_hold_p ())
5193 FD_ZERO (&Atemp);
5194 else
5195 compute_input_wait_mask (&Atemp);
5196 compute_write_mask (&Ctemp);
5198 timeout = make_timespec (0, 0);
5199 if ((thread_select (pselect, max_desc + 1,
5200 &Atemp,
5201 (num_pending_connects > 0 ? &Ctemp : NULL),
5202 NULL, &timeout, NULL)
5203 <= 0))
5205 /* It's okay for us to do this and then continue with
5206 the loop, since timeout has already been zeroed out. */
5207 clear_waiting_for_input ();
5208 got_some_output = status_notify (NULL, wait_proc);
5209 if (do_display) redisplay_preserve_echo_area (13);
5213 /* Don't wait for output from a non-running process. Just
5214 read whatever data has already been received. */
5215 if (wait_proc && wait_proc->raw_status_new)
5216 update_status (wait_proc);
5217 if (wait_proc
5218 && ! EQ (wait_proc->status, Qrun)
5219 && ! connecting_status (wait_proc->status))
5221 bool read_some_bytes = false;
5223 clear_waiting_for_input ();
5225 /* If data can be read from the process, do so until exhausted. */
5226 if (wait_proc->infd >= 0)
5228 XSETPROCESS (proc, wait_proc);
5230 while (true)
5232 int nread = read_process_output (proc, wait_proc->infd);
5233 if (nread < 0)
5235 if (errno == EIO || would_block (errno))
5236 break;
5238 else
5240 if (got_some_output < nread)
5241 got_some_output = nread;
5242 if (nread == 0)
5243 break;
5244 read_some_bytes = true;
5249 if (read_some_bytes && do_display)
5250 redisplay_preserve_echo_area (10);
5252 break;
5255 /* Wait till there is something to do. */
5257 if (wait_proc && just_wait_proc)
5259 if (wait_proc->infd < 0) /* Terminated. */
5260 break;
5261 FD_SET (wait_proc->infd, &Available);
5262 check_delay = 0;
5263 check_write = 0;
5265 else if (!NILP (wait_for_cell))
5267 compute_non_process_wait_mask (&Available);
5268 check_delay = 0;
5269 check_write = 0;
5271 else
5273 if (! read_kbd)
5274 compute_non_keyboard_wait_mask (&Available);
5275 else
5276 compute_input_wait_mask (&Available);
5277 compute_write_mask (&Writeok);
5278 check_delay = wait_proc ? 0 : process_output_delay_count;
5279 check_write = true;
5282 /* If frame size has changed or the window is newly mapped,
5283 redisplay now, before we start to wait. There is a race
5284 condition here; if a SIGIO arrives between now and the select
5285 and indicates that a frame is trashed, the select may block
5286 displaying a trashed screen. */
5287 if (frame_garbaged && do_display)
5289 clear_waiting_for_input ();
5290 redisplay_preserve_echo_area (11);
5291 if (read_kbd < 0)
5292 set_waiting_for_input (&timeout);
5295 /* Skip the `select' call if input is available and we're
5296 waiting for keyboard input or a cell change (which can be
5297 triggered by processing X events). In the latter case, set
5298 nfds to 1 to avoid breaking the loop. */
5299 no_avail = 0;
5300 if ((read_kbd || !NILP (wait_for_cell))
5301 && detect_input_pending ())
5303 nfds = read_kbd ? 0 : 1;
5304 no_avail = 1;
5305 FD_ZERO (&Available);
5307 else
5309 /* Set the timeout for adaptive read buffering if any
5310 process has non-zero read_output_skip and non-zero
5311 read_output_delay, and we are not reading output for a
5312 specific process. It is not executed if
5313 Vprocess_adaptive_read_buffering is nil. */
5314 if (process_output_skip && check_delay > 0)
5316 int adaptive_nsecs = timeout.tv_nsec;
5317 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5318 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5319 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5321 proc = chan_process[channel];
5322 if (NILP (proc))
5323 continue;
5324 /* Find minimum non-zero read_output_delay among the
5325 processes with non-zero read_output_skip. */
5326 if (XPROCESS (proc)->read_output_delay > 0)
5328 check_delay--;
5329 if (!XPROCESS (proc)->read_output_skip)
5330 continue;
5331 FD_CLR (channel, &Available);
5332 process_skipped = true;
5333 XPROCESS (proc)->read_output_skip = 0;
5334 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5335 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5338 timeout = make_timespec (0, adaptive_nsecs);
5339 process_output_skip = 0;
5342 /* If we've got some output and haven't limited our timeout
5343 with adaptive read buffering, limit it. */
5344 if (got_some_output > 0 && !process_skipped
5345 && (timeout.tv_sec
5346 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5347 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5350 if (NILP (wait_for_cell) && just_wait_proc >= 0
5351 && timespec_valid_p (timer_delay)
5352 && timespec_cmp (timer_delay, timeout) < 0)
5354 if (!timespec_valid_p (now))
5355 now = current_timespec ();
5356 struct timespec timeout_abs = timespec_add (now, timeout);
5357 if (!timespec_valid_p (got_output_end_time)
5358 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5359 got_output_end_time = timeout_abs;
5360 timeout = timer_delay;
5362 else
5363 got_output_end_time = invalid_timespec ();
5365 /* NOW can become inaccurate if time can pass during pselect. */
5366 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5367 now = invalid_timespec ();
5369 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5370 if (retry_for_async
5371 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5373 timeout.tv_sec = 0;
5374 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5376 #endif
5378 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5379 #if defined HAVE_GLIB && !defined HAVE_NS
5380 nfds = xg_select (max_desc + 1,
5381 &Available, (check_write ? &Writeok : 0),
5382 NULL, &timeout, NULL);
5383 #elif defined HAVE_NS
5384 /* And NS builds call thread_select in ns_select. */
5385 nfds = ns_select (max_desc + 1,
5386 &Available, (check_write ? &Writeok : 0),
5387 NULL, &timeout, NULL);
5388 #else /* !HAVE_GLIB */
5389 nfds = thread_select (pselect, max_desc + 1,
5390 &Available,
5391 (check_write ? &Writeok : 0),
5392 NULL, &timeout, NULL);
5393 #endif /* !HAVE_GLIB */
5395 #ifdef HAVE_GNUTLS
5396 /* GnuTLS buffers data internally. In lowat mode it leaves
5397 some data in the TCP buffers so that select works, but
5398 with custom pull/push functions we need to check if some
5399 data is available in the buffers manually. */
5400 if (nfds == 0)
5402 fd_set tls_available;
5403 int set = 0;
5405 FD_ZERO (&tls_available);
5406 if (! wait_proc)
5408 /* We're not waiting on a specific process, so loop
5409 through all the channels and check for data.
5410 This is a workaround needed for some versions of
5411 the gnutls library -- 2.12.14 has been confirmed
5412 to need it. See
5413 http://comments.gmane.org/gmane.emacs.devel/145074 */
5414 for (channel = 0; channel < FD_SETSIZE; ++channel)
5415 if (! NILP (chan_process[channel]))
5417 struct Lisp_Process *p =
5418 XPROCESS (chan_process[channel]);
5419 if (p && p->gnutls_p && p->gnutls_state
5420 && ((emacs_gnutls_record_check_pending
5421 (p->gnutls_state))
5422 > 0))
5424 nfds++;
5425 eassert (p->infd == channel);
5426 FD_SET (p->infd, &tls_available);
5427 set++;
5431 else
5433 /* Check this specific channel. */
5434 if (wait_proc->gnutls_p /* Check for valid process. */
5435 && wait_proc->gnutls_state
5436 /* Do we have pending data? */
5437 && ((emacs_gnutls_record_check_pending
5438 (wait_proc->gnutls_state))
5439 > 0))
5441 nfds = 1;
5442 eassert (0 <= wait_proc->infd);
5443 /* Set to Available. */
5444 FD_SET (wait_proc->infd, &tls_available);
5445 set++;
5448 if (set)
5449 Available = tls_available;
5451 #endif
5454 xerrno = errno;
5456 /* Make C-g and alarm signals set flags again. */
5457 clear_waiting_for_input ();
5459 /* If we woke up due to SIGWINCH, actually change size now. */
5460 do_pending_window_change (0);
5462 if (nfds == 0)
5464 /* Exit the main loop if we've passed the requested timeout,
5465 or have read some bytes from our wait_proc (either directly
5466 in this call or indirectly through timers / process filters),
5467 or aren't skipping processes and got some output and
5468 haven't lowered our timeout due to timers or SIGIO and
5469 have waited a long amount of time due to repeated
5470 timers. */
5471 struct timespec huge_timespec
5472 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
5473 struct timespec cmp_time = huge_timespec;
5474 if (wait < TIMEOUT
5475 || (wait_proc
5476 && wait_proc->nbytes_read != prev_wait_proc_nbytes_read))
5477 break;
5478 if (wait == TIMEOUT)
5479 cmp_time = end_time;
5480 if (!process_skipped && got_some_output > 0
5481 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5483 if (!timespec_valid_p (got_output_end_time))
5484 break;
5485 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5486 cmp_time = got_output_end_time;
5488 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5490 now = current_timespec ();
5491 if (timespec_cmp (cmp_time, now) <= 0)
5492 break;
5496 if (nfds < 0)
5498 if (xerrno == EINTR)
5499 no_avail = 1;
5500 else if (xerrno == EBADF)
5501 emacs_abort ();
5502 else
5503 report_file_errno ("Failed select", Qnil, xerrno);
5506 /* Check for keyboard input. */
5507 /* If there is any, return immediately
5508 to give it higher priority than subprocesses. */
5510 if (read_kbd != 0)
5512 unsigned old_timers_run = timers_run;
5513 struct buffer *old_buffer = current_buffer;
5514 Lisp_Object old_window = selected_window;
5515 bool leave = false;
5517 if (detect_input_pending_run_timers (do_display))
5519 swallow_events (do_display);
5520 if (detect_input_pending_run_timers (do_display))
5521 leave = true;
5524 /* If a timer has run, this might have changed buffers
5525 an alike. Make read_key_sequence aware of that. */
5526 if (timers_run != old_timers_run
5527 && waiting_for_user_input_p == -1
5528 && (old_buffer != current_buffer
5529 || !EQ (old_window, selected_window)))
5530 record_asynch_buffer_change ();
5532 if (leave)
5533 break;
5536 /* If there is unread keyboard input, also return. */
5537 if (read_kbd != 0
5538 && requeued_events_pending_p ())
5539 break;
5541 /* If we are not checking for keyboard input now,
5542 do process events (but don't run any timers).
5543 This is so that X events will be processed.
5544 Otherwise they may have to wait until polling takes place.
5545 That would causes delays in pasting selections, for example.
5547 (We used to do this only if wait_for_cell.) */
5548 if (read_kbd == 0 && detect_input_pending ())
5550 swallow_events (do_display);
5551 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5552 if (detect_input_pending ())
5553 break;
5554 #endif
5557 /* Exit now if the cell we're waiting for became non-nil. */
5558 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5559 break;
5561 #ifdef USABLE_SIGIO
5562 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5563 go read it. This can happen with X on BSD after logging out.
5564 In that case, there really is no input and no SIGIO,
5565 but select says there is input. */
5567 if (read_kbd && interrupt_input
5568 && keyboard_bit_set (&Available) && ! noninteractive)
5569 handle_input_available_signal (SIGIO);
5570 #endif
5572 /* If checking input just got us a size-change event from X,
5573 obey it now if we should. */
5574 if (read_kbd || ! NILP (wait_for_cell))
5575 do_pending_window_change (0);
5577 /* Check for data from a process. */
5578 if (no_avail || nfds == 0)
5579 continue;
5581 for (channel = 0; channel <= max_desc; ++channel)
5583 struct fd_callback_data *d = &fd_callback_info[channel];
5584 if (d->func
5585 && ((d->flags & FOR_READ
5586 && FD_ISSET (channel, &Available))
5587 || ((d->flags & FOR_WRITE)
5588 && FD_ISSET (channel, &Writeok))))
5589 d->func (channel, d->data);
5592 for (channel = 0; channel <= max_desc; channel++)
5594 if (FD_ISSET (channel, &Available)
5595 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5596 == PROCESS_FD))
5598 int nread;
5600 /* If waiting for this channel, arrange to return as
5601 soon as no more input to be processed. No more
5602 waiting. */
5603 proc = chan_process[channel];
5604 if (NILP (proc))
5605 continue;
5607 /* If this is a server stream socket, accept connection. */
5608 if (EQ (XPROCESS (proc)->status, Qlisten))
5610 server_accept_connection (proc, channel);
5611 continue;
5614 /* Read data from the process, starting with our
5615 buffered-ahead character if we have one. */
5617 nread = read_process_output (proc, channel);
5618 if ((!wait_proc || wait_proc == XPROCESS (proc))
5619 && got_some_output < nread)
5620 got_some_output = nread;
5621 if (nread > 0)
5623 /* Vacuum up any leftovers without waiting. */
5624 if (wait_proc == XPROCESS (proc))
5625 wait = MINIMUM;
5626 /* Since read_process_output can run a filter,
5627 which can call accept-process-output,
5628 don't try to read from any other processes
5629 before doing the select again. */
5630 FD_ZERO (&Available);
5632 if (do_display)
5633 redisplay_preserve_echo_area (12);
5635 else if (nread == -1 && would_block (errno))
5637 #ifdef HAVE_PTYS
5638 /* On some OSs with ptys, when the process on one end of
5639 a pty exits, the other end gets an error reading with
5640 errno = EIO instead of getting an EOF (0 bytes read).
5641 Therefore, if we get an error reading and errno =
5642 EIO, just continue, because the child process has
5643 exited and should clean itself up soon (e.g. when we
5644 get a SIGCHLD). */
5645 else if (nread == -1 && errno == EIO)
5647 struct Lisp_Process *p = XPROCESS (proc);
5649 /* Clear the descriptor now, so we only raise the
5650 signal once. */
5651 delete_read_fd (channel);
5653 if (p->pid == -2)
5655 /* If the EIO occurs on a pty, the SIGCHLD handler's
5656 waitpid call will not find the process object to
5657 delete. Do it here. */
5658 p->tick = ++process_tick;
5659 pset_status (p, Qfailed);
5662 #endif /* HAVE_PTYS */
5663 /* If we can detect process termination, don't consider the
5664 process gone just because its pipe is closed. */
5665 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5666 && !PIPECONN_P (proc))
5668 else if (nread == 0 && PIPECONN_P (proc))
5670 /* Preserve status of processes already terminated. */
5671 XPROCESS (proc)->tick = ++process_tick;
5672 deactivate_process (proc);
5673 if (EQ (XPROCESS (proc)->status, Qrun))
5674 pset_status (XPROCESS (proc),
5675 list2 (Qexit, make_number (0)));
5677 else
5679 /* Preserve status of processes already terminated. */
5680 XPROCESS (proc)->tick = ++process_tick;
5681 deactivate_process (proc);
5682 if (XPROCESS (proc)->raw_status_new)
5683 update_status (XPROCESS (proc));
5684 if (EQ (XPROCESS (proc)->status, Qrun))
5685 pset_status (XPROCESS (proc),
5686 list2 (Qexit, make_number (256)));
5689 if (FD_ISSET (channel, &Writeok)
5690 && (fd_callback_info[channel].flags
5691 & NON_BLOCKING_CONNECT_FD) != 0)
5693 struct Lisp_Process *p;
5695 delete_write_fd (channel);
5697 proc = chan_process[channel];
5698 if (NILP (proc))
5699 continue;
5701 p = XPROCESS (proc);
5703 #ifndef WINDOWSNT
5705 socklen_t xlen = sizeof (xerrno);
5706 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5707 xerrno = errno;
5709 #else
5710 /* On MS-Windows, getsockopt clears the error for the
5711 entire process, which may not be the right thing; see
5712 w32.c. Use getpeername instead. */
5714 struct sockaddr pname;
5715 socklen_t pnamelen = sizeof (pname);
5717 /* If connection failed, getpeername will fail. */
5718 xerrno = 0;
5719 if (getpeername (channel, &pname, &pnamelen) < 0)
5721 /* Obtain connect failure code through error slippage. */
5722 char dummy;
5723 xerrno = errno;
5724 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
5725 xerrno = errno;
5728 #endif
5729 if (xerrno)
5731 Lisp_Object addrinfos
5732 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
5733 if (!NILP (addrinfos))
5734 XSETCDR (p->status, XCDR (addrinfos));
5735 else
5737 p->tick = ++process_tick;
5738 pset_status (p, list2 (Qfailed, make_number (xerrno)));
5740 deactivate_process (proc);
5741 if (!NILP (addrinfos))
5742 connect_network_socket (proc, addrinfos, Qnil);
5744 else
5746 #ifdef HAVE_GNUTLS
5747 /* If we have an incompletely set up TLS connection,
5748 then defer the sentinel signaling until
5749 later. */
5750 if (NILP (p->gnutls_boot_parameters)
5751 && !p->gnutls_p)
5752 #endif
5754 pset_status (p, Qrun);
5755 /* Execute the sentinel here. If we had relied on
5756 status_notify to do it later, it will read input
5757 from the process before calling the sentinel. */
5758 exec_sentinel (proc, build_string ("open\n"));
5761 if (0 <= p->infd && !EQ (p->filter, Qt)
5762 && !EQ (p->command, Qt))
5763 add_process_read_fd (p->infd);
5766 } /* End for each file descriptor. */
5767 } /* End while exit conditions not met. */
5769 unbind_to (count, Qnil);
5771 /* If calling from keyboard input, do not quit
5772 since we want to return C-g as an input character.
5773 Otherwise, do pending quit if requested. */
5774 if (read_kbd >= 0)
5776 /* Prevent input_pending from remaining set if we quit. */
5777 clear_input_pending ();
5778 maybe_quit ();
5781 /* Timers and/or process filters that we have run could have themselves called
5782 `accept-process-output' (and by that indirectly this function), thus
5783 possibly reading some (or all) output of wait_proc without us noticing it.
5784 This could potentially lead to an endless wait (dealt with earlier in the
5785 function) and/or a wrong return value (dealt with here). */
5786 if (wait_proc && wait_proc->nbytes_read != prev_wait_proc_nbytes_read)
5787 got_some_output = min (INT_MAX, (wait_proc->nbytes_read
5788 - prev_wait_proc_nbytes_read));
5790 return got_some_output;
5793 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5795 static Lisp_Object
5796 read_process_output_call (Lisp_Object fun_and_args)
5798 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5801 static Lisp_Object
5802 read_process_output_error_handler (Lisp_Object error_val)
5804 cmd_error_internal (error_val, "error in process filter: ");
5805 Vinhibit_quit = Qt;
5806 update_echo_area ();
5807 Fsleep_for (make_number (2), Qnil);
5808 return Qt;
5811 static void
5812 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5813 ssize_t nbytes,
5814 struct coding_system *coding);
5816 /* Read pending output from the process channel,
5817 starting with our buffered-ahead character if we have one.
5818 Yield number of decoded characters read.
5820 This function reads at most 4096 characters.
5821 If you want to read all available subprocess output,
5822 you must call it repeatedly until it returns zero.
5824 The characters read are decoded according to PROC's coding-system
5825 for decoding. */
5827 static int
5828 read_process_output (Lisp_Object proc, int channel)
5830 ssize_t nbytes;
5831 struct Lisp_Process *p = XPROCESS (proc);
5832 struct coding_system *coding = proc_decode_coding_system[channel];
5833 int carryover = p->decoding_carryover;
5834 enum { readmax = 4096 };
5835 ptrdiff_t count = SPECPDL_INDEX ();
5836 Lisp_Object odeactivate;
5837 char chars[sizeof coding->carryover + readmax];
5839 if (carryover)
5840 /* See the comment above. */
5841 memcpy (chars, SDATA (p->decoding_buf), carryover);
5843 #ifdef DATAGRAM_SOCKETS
5844 /* We have a working select, so proc_buffered_char is always -1. */
5845 if (DATAGRAM_CHAN_P (channel))
5847 socklen_t len = datagram_address[channel].len;
5848 nbytes = recvfrom (channel, chars + carryover, readmax,
5849 0, datagram_address[channel].sa, &len);
5851 else
5852 #endif
5854 bool buffered = proc_buffered_char[channel] >= 0;
5855 if (buffered)
5857 chars[carryover] = proc_buffered_char[channel];
5858 proc_buffered_char[channel] = -1;
5860 #ifdef HAVE_GNUTLS
5861 if (p->gnutls_p && p->gnutls_state)
5862 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
5863 readmax - buffered);
5864 else
5865 #endif
5866 nbytes = emacs_read (channel, chars + carryover + buffered,
5867 readmax - buffered);
5868 if (nbytes > 0 && p->adaptive_read_buffering)
5870 int delay = p->read_output_delay;
5871 if (nbytes < 256)
5873 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5875 if (delay == 0)
5876 process_output_delay_count++;
5877 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5880 else if (delay > 0 && nbytes == readmax - buffered)
5882 delay -= READ_OUTPUT_DELAY_INCREMENT;
5883 if (delay == 0)
5884 process_output_delay_count--;
5886 p->read_output_delay = delay;
5887 if (delay)
5889 p->read_output_skip = 1;
5890 process_output_skip = 1;
5893 nbytes += buffered;
5894 nbytes += buffered && nbytes <= 0;
5897 p->decoding_carryover = 0;
5899 /* At this point, NBYTES holds number of bytes just received
5900 (including the one in proc_buffered_char[channel]). */
5901 if (nbytes <= 0)
5903 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5904 return nbytes;
5905 coding->mode |= CODING_MODE_LAST_BLOCK;
5908 /* Ignore carryover, it's been added by a previous iteration already. */
5909 p->nbytes_read += nbytes;
5911 /* Now set NBYTES how many bytes we must decode. */
5912 nbytes += carryover;
5914 odeactivate = Vdeactivate_mark;
5915 /* There's no good reason to let process filters change the current
5916 buffer, and many callers of accept-process-output, sit-for, and
5917 friends don't expect current-buffer to be changed from under them. */
5918 record_unwind_current_buffer ();
5920 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5922 /* Handling the process output should not deactivate the mark. */
5923 Vdeactivate_mark = odeactivate;
5925 unbind_to (count, Qnil);
5926 return nbytes;
5929 static void
5930 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5931 ssize_t nbytes,
5932 struct coding_system *coding)
5934 Lisp_Object outstream = p->filter;
5935 Lisp_Object text;
5936 bool outer_running_asynch_code = running_asynch_code;
5937 int waiting = waiting_for_user_input_p;
5939 #if 0
5940 Lisp_Object obuffer, okeymap;
5941 XSETBUFFER (obuffer, current_buffer);
5942 okeymap = BVAR (current_buffer, keymap);
5943 #endif
5945 /* We inhibit quit here instead of just catching it so that
5946 hitting ^G when a filter happens to be running won't screw
5947 it up. */
5948 specbind (Qinhibit_quit, Qt);
5949 specbind (Qlast_nonmenu_event, Qt);
5951 /* In case we get recursively called,
5952 and we already saved the match data nonrecursively,
5953 save the same match data in safely recursive fashion. */
5954 if (outer_running_asynch_code)
5956 Lisp_Object tem;
5957 /* Don't clobber the CURRENT match data, either! */
5958 tem = Fmatch_data (Qnil, Qnil, Qnil);
5959 restore_search_regs ();
5960 record_unwind_save_match_data ();
5961 Fset_match_data (tem, Qt);
5964 /* For speed, if a search happens within this code,
5965 save the match data in a special nonrecursive fashion. */
5966 running_asynch_code = 1;
5968 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5969 text = coding->dst_object;
5970 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5971 /* A new coding system might be found. */
5972 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5974 pset_decode_coding_system (p, Vlast_coding_system_used);
5976 /* Don't call setup_coding_system for
5977 proc_decode_coding_system[channel] here. It is done in
5978 detect_coding called via decode_coding above. */
5980 /* If a coding system for encoding is not yet decided, we set
5981 it as the same as coding-system for decoding.
5983 But, before doing that we must check if
5984 proc_encode_coding_system[p->outfd] surely points to a
5985 valid memory because p->outfd will be changed once EOF is
5986 sent to the process. */
5987 if (NILP (p->encode_coding_system) && p->outfd >= 0
5988 && proc_encode_coding_system[p->outfd])
5990 pset_encode_coding_system
5991 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5992 setup_coding_system (p->encode_coding_system,
5993 proc_encode_coding_system[p->outfd]);
5997 if (coding->carryover_bytes > 0)
5999 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
6000 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
6001 memcpy (SDATA (p->decoding_buf), coding->carryover,
6002 coding->carryover_bytes);
6003 p->decoding_carryover = coding->carryover_bytes;
6005 if (SBYTES (text) > 0)
6006 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
6007 sometimes it's simply wrong to wrap (e.g. when called from
6008 accept-process-output). */
6009 internal_condition_case_1 (read_process_output_call,
6010 list3 (outstream, make_lisp_proc (p), text),
6011 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6012 read_process_output_error_handler);
6014 /* If we saved the match data nonrecursively, restore it now. */
6015 restore_search_regs ();
6016 running_asynch_code = outer_running_asynch_code;
6018 /* Restore waiting_for_user_input_p as it was
6019 when we were called, in case the filter clobbered it. */
6020 waiting_for_user_input_p = waiting;
6022 #if 0 /* Call record_asynch_buffer_change unconditionally,
6023 because we might have changed minor modes or other things
6024 that affect key bindings. */
6025 if (! EQ (Fcurrent_buffer (), obuffer)
6026 || ! EQ (current_buffer->keymap, okeymap))
6027 #endif
6028 /* But do it only if the caller is actually going to read events.
6029 Otherwise there's no need to make him wake up, and it could
6030 cause trouble (for example it would make sit_for return). */
6031 if (waiting_for_user_input_p == -1)
6032 record_asynch_buffer_change ();
6035 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6036 Sinternal_default_process_filter, 2, 2, 0,
6037 doc: /* Function used as default process filter.
6038 This inserts the process's output into its buffer, if there is one.
6039 Otherwise it discards the output. */)
6040 (Lisp_Object proc, Lisp_Object text)
6042 struct Lisp_Process *p;
6043 ptrdiff_t opoint;
6045 CHECK_PROCESS (proc);
6046 p = XPROCESS (proc);
6047 CHECK_STRING (text);
6049 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6051 Lisp_Object old_read_only;
6052 ptrdiff_t old_begv, old_zv;
6053 ptrdiff_t old_begv_byte, old_zv_byte;
6054 ptrdiff_t before, before_byte;
6055 ptrdiff_t opoint_byte;
6056 struct buffer *b;
6058 Fset_buffer (p->buffer);
6059 opoint = PT;
6060 opoint_byte = PT_BYTE;
6061 old_read_only = BVAR (current_buffer, read_only);
6062 old_begv = BEGV;
6063 old_zv = ZV;
6064 old_begv_byte = BEGV_BYTE;
6065 old_zv_byte = ZV_BYTE;
6067 bset_read_only (current_buffer, Qnil);
6069 /* Insert new output into buffer at the current end-of-output
6070 marker, thus preserving logical ordering of input and output. */
6071 if (XMARKER (p->mark)->buffer)
6072 set_point_from_marker (p->mark);
6073 else
6074 SET_PT_BOTH (ZV, ZV_BYTE);
6075 before = PT;
6076 before_byte = PT_BYTE;
6078 /* If the output marker is outside of the visible region, save
6079 the restriction and widen. */
6080 if (! (BEGV <= PT && PT <= ZV))
6081 Fwiden ();
6083 /* Adjust the multibyteness of TEXT to that of the buffer. */
6084 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6085 != ! STRING_MULTIBYTE (text))
6086 text = (STRING_MULTIBYTE (text)
6087 ? Fstring_as_unibyte (text)
6088 : Fstring_to_multibyte (text));
6089 /* Insert before markers in case we are inserting where
6090 the buffer's mark is, and the user's next command is Meta-y. */
6091 insert_from_string_before_markers (text, 0, 0,
6092 SCHARS (text), SBYTES (text), 0);
6094 /* Make sure the process marker's position is valid when the
6095 process buffer is changed in the signal_after_change above.
6096 W3 is known to do that. */
6097 if (BUFFERP (p->buffer)
6098 && (b = XBUFFER (p->buffer), b != current_buffer))
6099 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6100 else
6101 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6103 update_mode_lines = 23;
6105 /* Make sure opoint and the old restrictions
6106 float ahead of any new text just as point would. */
6107 if (opoint >= before)
6109 opoint += PT - before;
6110 opoint_byte += PT_BYTE - before_byte;
6112 if (old_begv > before)
6114 old_begv += PT - before;
6115 old_begv_byte += PT_BYTE - before_byte;
6117 if (old_zv >= before)
6119 old_zv += PT - before;
6120 old_zv_byte += PT_BYTE - before_byte;
6123 /* If the restriction isn't what it should be, set it. */
6124 if (old_begv != BEGV || old_zv != ZV)
6125 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
6127 bset_read_only (current_buffer, old_read_only);
6128 SET_PT_BOTH (opoint, opoint_byte);
6130 return Qnil;
6133 /* Sending data to subprocess. */
6135 /* In send_process, when a write fails temporarily,
6136 wait_reading_process_output is called. It may execute user code,
6137 e.g. timers, that attempts to write new data to the same process.
6138 We must ensure that data is sent in the right order, and not
6139 interspersed half-completed with other writes (Bug#10815). This is
6140 handled by the write_queue element of struct process. It is a list
6141 with each entry having the form
6143 (string . (offset . length))
6145 where STRING is a lisp string, OFFSET is the offset into the
6146 string's byte sequence from which we should begin to send, and
6147 LENGTH is the number of bytes left to send. */
6149 /* Create a new entry in write_queue.
6150 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6151 BUF is a pointer to the string sequence of the input_obj or a C
6152 string in case of Qt or Qnil. */
6154 static void
6155 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6156 const char *buf, ptrdiff_t len, bool front)
6158 ptrdiff_t offset;
6159 Lisp_Object entry, obj;
6161 if (STRINGP (input_obj))
6163 offset = buf - SSDATA (input_obj);
6164 obj = input_obj;
6166 else
6168 offset = 0;
6169 obj = make_unibyte_string (buf, len);
6172 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
6174 if (front)
6175 pset_write_queue (p, Fcons (entry, p->write_queue));
6176 else
6177 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6180 /* Remove the first element in the write_queue of process P, put its
6181 contents in OBJ, BUF and LEN, and return true. If the
6182 write_queue is empty, return false. */
6184 static bool
6185 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6186 const char **buf, ptrdiff_t *len)
6188 Lisp_Object entry, offset_length;
6189 ptrdiff_t offset;
6191 if (NILP (p->write_queue))
6192 return 0;
6194 entry = XCAR (p->write_queue);
6195 pset_write_queue (p, XCDR (p->write_queue));
6197 *obj = XCAR (entry);
6198 offset_length = XCDR (entry);
6200 *len = XINT (XCDR (offset_length));
6201 offset = XINT (XCAR (offset_length));
6202 *buf = SSDATA (*obj) + offset;
6204 return 1;
6207 /* Send some data to process PROC.
6208 BUF is the beginning of the data; LEN is the number of characters.
6209 OBJECT is the Lisp object that the data comes from. If OBJECT is
6210 nil or t, it means that the data comes from C string.
6212 If OBJECT is not nil, the data is encoded by PROC's coding-system
6213 for encoding before it is sent.
6215 This function can evaluate Lisp code and can garbage collect. */
6217 static void
6218 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6219 Lisp_Object object)
6221 struct Lisp_Process *p = XPROCESS (proc);
6222 ssize_t rv;
6223 struct coding_system *coding;
6225 if (NETCONN_P (proc))
6227 wait_while_connecting (proc);
6228 wait_for_tls_negotiation (proc);
6231 if (p->raw_status_new)
6232 update_status (p);
6233 if (! EQ (p->status, Qrun))
6234 error ("Process %s not running", SDATA (p->name));
6235 if (p->outfd < 0)
6236 error ("Output file descriptor of %s is closed", SDATA (p->name));
6238 coding = proc_encode_coding_system[p->outfd];
6239 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6241 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6242 || (BUFFERP (object)
6243 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6244 || EQ (object, Qt))
6246 pset_encode_coding_system
6247 (p, complement_process_encoding_system (p->encode_coding_system));
6248 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6250 /* The coding system for encoding was changed to raw-text
6251 because we sent a unibyte text previously. Now we are
6252 sending a multibyte text, thus we must encode it by the
6253 original coding system specified for the current process.
6255 Another reason we come here is that the coding system
6256 was just complemented and a new one was returned by
6257 complement_process_encoding_system. */
6258 setup_coding_system (p->encode_coding_system, coding);
6259 Vlast_coding_system_used = p->encode_coding_system;
6261 coding->src_multibyte = 1;
6263 else
6265 coding->src_multibyte = 0;
6266 /* For sending a unibyte text, character code conversion should
6267 not take place but EOL conversion should. So, setup raw-text
6268 or one of the subsidiary if we have not yet done it. */
6269 if (CODING_REQUIRE_ENCODING (coding))
6271 if (CODING_REQUIRE_FLUSHING (coding))
6273 /* But, before changing the coding, we must flush out data. */
6274 coding->mode |= CODING_MODE_LAST_BLOCK;
6275 send_process (proc, "", 0, Qt);
6276 coding->mode &= CODING_MODE_LAST_BLOCK;
6278 setup_coding_system (raw_text_coding_system
6279 (Vlast_coding_system_used),
6280 coding);
6281 coding->src_multibyte = 0;
6284 coding->dst_multibyte = 0;
6286 if (CODING_REQUIRE_ENCODING (coding))
6288 coding->dst_object = Qt;
6289 if (BUFFERP (object))
6291 ptrdiff_t from_byte, from, to;
6292 ptrdiff_t save_pt, save_pt_byte;
6293 struct buffer *cur = current_buffer;
6295 set_buffer_internal (XBUFFER (object));
6296 save_pt = PT, save_pt_byte = PT_BYTE;
6298 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6299 from = BYTE_TO_CHAR (from_byte);
6300 to = BYTE_TO_CHAR (from_byte + len);
6301 TEMP_SET_PT_BOTH (from, from_byte);
6302 encode_coding_object (coding, object, from, from_byte,
6303 to, from_byte + len, Qt);
6304 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6305 set_buffer_internal (cur);
6307 else if (STRINGP (object))
6309 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6310 SBYTES (object), Qt);
6312 else
6314 coding->dst_object = make_unibyte_string (buf, len);
6315 coding->produced = len;
6318 len = coding->produced;
6319 object = coding->dst_object;
6320 buf = SSDATA (object);
6323 /* If there is already data in the write_queue, put the new data
6324 in the back of queue. Otherwise, ignore it. */
6325 if (!NILP (p->write_queue))
6326 write_queue_push (p, object, buf, len, 0);
6328 do /* while !NILP (p->write_queue) */
6330 ptrdiff_t cur_len = -1;
6331 const char *cur_buf;
6332 Lisp_Object cur_object;
6334 /* If write_queue is empty, ignore it. */
6335 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6337 cur_len = len;
6338 cur_buf = buf;
6339 cur_object = object;
6342 while (cur_len > 0)
6344 /* Send this batch, using one or more write calls. */
6345 ptrdiff_t written = 0;
6346 int outfd = p->outfd;
6347 #ifdef DATAGRAM_SOCKETS
6348 if (DATAGRAM_CHAN_P (outfd))
6350 rv = sendto (outfd, cur_buf, cur_len,
6351 0, datagram_address[outfd].sa,
6352 datagram_address[outfd].len);
6353 if (rv >= 0)
6354 written = rv;
6355 else if (errno == EMSGSIZE)
6356 report_file_error ("Sending datagram", proc);
6358 else
6359 #endif
6361 #ifdef HAVE_GNUTLS
6362 if (p->gnutls_p && p->gnutls_state)
6363 written = emacs_gnutls_write (p, cur_buf, cur_len);
6364 else
6365 #endif
6366 written = emacs_write_sig (outfd, cur_buf, cur_len);
6367 rv = (written ? 0 : -1);
6368 if (p->read_output_delay > 0
6369 && p->adaptive_read_buffering == 1)
6371 p->read_output_delay = 0;
6372 process_output_delay_count--;
6373 p->read_output_skip = 0;
6377 if (rv < 0)
6379 if (would_block (errno))
6380 /* Buffer is full. Wait, accepting input;
6381 that may allow the program
6382 to finish doing output and read more. */
6384 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6385 /* A gross hack to work around a bug in FreeBSD.
6386 In the following sequence, read(2) returns
6387 bogus data:
6389 write(2) 1022 bytes
6390 write(2) 954 bytes, get EAGAIN
6391 read(2) 1024 bytes in process_read_output
6392 read(2) 11 bytes in process_read_output
6394 That is, read(2) returns more bytes than have
6395 ever been written successfully. The 1033 bytes
6396 read are the 1022 bytes written successfully
6397 after processing (for example with CRs added if
6398 the terminal is set up that way which it is
6399 here). The same bytes will be seen again in a
6400 later read(2), without the CRs. */
6402 if (errno == EAGAIN)
6404 int flags = FWRITE;
6405 ioctl (p->outfd, TIOCFLUSH, &flags);
6407 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6409 /* Put what we should have written in wait_queue. */
6410 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6411 wait_reading_process_output (0, 20 * 1000 * 1000,
6412 0, 0, Qnil, NULL, 0);
6413 /* Reread queue, to see what is left. */
6414 break;
6416 else if (errno == EPIPE)
6418 p->raw_status_new = 0;
6419 pset_status (p, list2 (Qexit, make_number (256)));
6420 p->tick = ++process_tick;
6421 deactivate_process (proc);
6422 error ("process %s no longer connected to pipe; closed it",
6423 SDATA (p->name));
6425 else
6426 /* This is a real error. */
6427 report_file_error ("Writing to process", proc);
6429 cur_buf += written;
6430 cur_len -= written;
6433 while (!NILP (p->write_queue));
6436 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6437 3, 3, 0,
6438 doc: /* Send current contents of region as input to PROCESS.
6439 PROCESS may be a process, a buffer, the name of a process or buffer, or
6440 nil, indicating the current buffer's process.
6441 Called from program, takes three arguments, PROCESS, START and END.
6442 If the region is more than 500 characters long,
6443 it is sent in several bunches. This may happen even for shorter regions.
6444 Output from processes can arrive in between bunches.
6446 If PROCESS is a non-blocking network process that hasn't been fully
6447 set up yet, this function will block until socket setup has completed. */)
6448 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6450 Lisp_Object proc = get_process (process);
6451 ptrdiff_t start_byte, end_byte;
6453 validate_region (&start, &end);
6455 start_byte = CHAR_TO_BYTE (XINT (start));
6456 end_byte = CHAR_TO_BYTE (XINT (end));
6458 if (XINT (start) < GPT && XINT (end) > GPT)
6459 move_gap_both (XINT (start), start_byte);
6461 if (NETCONN_P (proc))
6462 wait_while_connecting (proc);
6464 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6465 end_byte - start_byte, Fcurrent_buffer ());
6467 return Qnil;
6470 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6471 2, 2, 0,
6472 doc: /* Send PROCESS the contents of STRING as input.
6473 PROCESS may be a process, a buffer, the name of a process or buffer, or
6474 nil, indicating the current buffer's process.
6475 If STRING is more than 500 characters long,
6476 it is sent in several bunches. This may happen even for shorter strings.
6477 Output from processes can arrive in between bunches.
6479 If PROCESS is a non-blocking network process that hasn't been fully
6480 set up yet, this function will block until socket setup has completed. */)
6481 (Lisp_Object process, Lisp_Object string)
6483 CHECK_STRING (string);
6484 Lisp_Object proc = get_process (process);
6485 send_process (proc, SSDATA (string),
6486 SBYTES (string), string);
6487 return Qnil;
6490 /* Return the foreground process group for the tty/pty that
6491 the process P uses. */
6492 static pid_t
6493 emacs_get_tty_pgrp (struct Lisp_Process *p)
6495 pid_t gid = -1;
6497 #ifdef TIOCGPGRP
6498 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6500 int fd;
6501 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6502 master side. Try the slave side. */
6503 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6505 if (fd != -1)
6507 ioctl (fd, TIOCGPGRP, &gid);
6508 emacs_close (fd);
6511 #endif /* defined (TIOCGPGRP ) */
6513 return gid;
6516 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6517 Sprocess_running_child_p, 0, 1, 0,
6518 doc: /* Return non-nil if PROCESS has given the terminal to a
6519 child. If the operating system does not make it possible to find out,
6520 return t. If we can find out, return the numeric ID of the foreground
6521 process group. */)
6522 (Lisp_Object process)
6524 /* Initialize in case ioctl doesn't exist or gives an error,
6525 in a way that will cause returning t. */
6526 Lisp_Object proc = get_process (process);
6527 struct Lisp_Process *p = XPROCESS (proc);
6529 if (!EQ (p->type, Qreal))
6530 error ("Process %s is not a subprocess",
6531 SDATA (p->name));
6532 if (p->infd < 0)
6533 error ("Process %s is not active",
6534 SDATA (p->name));
6536 pid_t gid = emacs_get_tty_pgrp (p);
6538 if (gid == p->pid)
6539 return Qnil;
6540 if (gid != -1)
6541 return make_number (gid);
6542 return Qt;
6545 /* Send a signal number SIGNO to PROCESS.
6546 If CURRENT_GROUP is t, that means send to the process group
6547 that currently owns the terminal being used to communicate with PROCESS.
6548 This is used for various commands in shell mode.
6549 If CURRENT_GROUP is lambda, that means send to the process group
6550 that currently owns the terminal, but only if it is NOT the shell itself.
6552 If NOMSG is false, insert signal-announcements into process's buffers
6553 right away.
6555 If we can, we try to signal PROCESS by sending control characters
6556 down the pty. This allows us to signal inferiors who have changed
6557 their uid, for which kill would return an EPERM error. */
6559 static void
6560 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6561 bool nomsg)
6563 Lisp_Object proc;
6564 struct Lisp_Process *p;
6565 pid_t gid;
6566 bool no_pgrp = 0;
6568 proc = get_process (process);
6569 p = XPROCESS (proc);
6571 if (!EQ (p->type, Qreal))
6572 error ("Process %s is not a subprocess",
6573 SDATA (p->name));
6574 if (p->infd < 0)
6575 error ("Process %s is not active",
6576 SDATA (p->name));
6578 if (!p->pty_flag)
6579 current_group = Qnil;
6581 /* If we are using pgrps, get a pgrp number and make it negative. */
6582 if (NILP (current_group))
6583 /* Send the signal to the shell's process group. */
6584 gid = p->pid;
6585 else
6587 #ifdef SIGNALS_VIA_CHARACTERS
6588 /* If possible, send signals to the entire pgrp
6589 by sending an input character to it. */
6591 struct termios t;
6592 cc_t *sig_char = NULL;
6594 tcgetattr (p->infd, &t);
6596 switch (signo)
6598 case SIGINT:
6599 sig_char = &t.c_cc[VINTR];
6600 break;
6602 case SIGQUIT:
6603 sig_char = &t.c_cc[VQUIT];
6604 break;
6606 case SIGTSTP:
6607 #ifdef VSWTCH
6608 sig_char = &t.c_cc[VSWTCH];
6609 #else
6610 sig_char = &t.c_cc[VSUSP];
6611 #endif
6612 break;
6615 if (sig_char && *sig_char != CDISABLE)
6617 send_process (proc, (char *) sig_char, 1, Qnil);
6618 return;
6620 /* If we can't send the signal with a character,
6621 fall through and send it another way. */
6623 /* The code above may fall through if it can't
6624 handle the signal. */
6625 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6627 #ifdef TIOCGPGRP
6628 /* Get the current pgrp using the tty itself, if we have that.
6629 Otherwise, use the pty to get the pgrp.
6630 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6631 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6632 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6633 His patch indicates that if TIOCGPGRP returns an error, then
6634 we should just assume that p->pid is also the process group id. */
6636 gid = emacs_get_tty_pgrp (p);
6638 if (gid == -1)
6639 /* If we can't get the information, assume
6640 the shell owns the tty. */
6641 gid = p->pid;
6643 /* It is not clear whether anything really can set GID to -1.
6644 Perhaps on some system one of those ioctls can or could do so.
6645 Or perhaps this is vestigial. */
6646 if (gid == -1)
6647 no_pgrp = 1;
6648 #else /* ! defined (TIOCGPGRP) */
6649 /* Can't select pgrps on this system, so we know that
6650 the child itself heads the pgrp. */
6651 gid = p->pid;
6652 #endif /* ! defined (TIOCGPGRP) */
6654 /* If current_group is lambda, and the shell owns the terminal,
6655 don't send any signal. */
6656 if (EQ (current_group, Qlambda) && gid == p->pid)
6657 return;
6660 #ifdef SIGCONT
6661 if (signo == SIGCONT)
6663 p->raw_status_new = 0;
6664 pset_status (p, Qrun);
6665 p->tick = ++process_tick;
6666 if (!nomsg)
6668 status_notify (NULL, NULL);
6669 redisplay_preserve_echo_area (13);
6672 #endif
6674 #ifdef TIOCSIGSEND
6675 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6676 We don't know whether the bug is fixed in later HP-UX versions. */
6677 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6678 return;
6679 #endif
6681 /* If we don't have process groups, send the signal to the immediate
6682 subprocess. That isn't really right, but it's better than any
6683 obvious alternative. */
6684 pid_t pid = no_pgrp ? gid : - gid;
6686 /* Do not kill an already-reaped process, as that could kill an
6687 innocent bystander that happens to have the same process ID. */
6688 sigset_t oldset;
6689 block_child_signal (&oldset);
6690 if (p->alive)
6691 kill (pid, signo);
6692 unblock_child_signal (&oldset);
6695 DEFUN ("internal-default-interrupt-process",
6696 Finternal_default_interrupt_process,
6697 Sinternal_default_interrupt_process, 0, 2, 0,
6698 doc: /* Default function to interrupt process PROCESS.
6699 It shall be the last element in list `interrupt-process-functions'.
6700 See function `interrupt-process' for more details on usage. */)
6701 (Lisp_Object process, Lisp_Object current_group)
6703 process_send_signal (process, SIGINT, current_group, 0);
6704 return process;
6707 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6708 doc: /* Interrupt process PROCESS.
6709 PROCESS may be a process, a buffer, or the name of a process or buffer.
6710 No arg or nil means current buffer's process.
6711 Second arg CURRENT-GROUP non-nil means send signal to
6712 the current process-group of the process's controlling terminal
6713 rather than to the process's own process group.
6714 If the process is a shell, this means interrupt current subjob
6715 rather than the shell.
6717 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6718 don't send the signal.
6720 This function calls the functions of `interrupt-process-functions' in
6721 the order of the list, until one of them returns non-`nil'. */)
6722 (Lisp_Object process, Lisp_Object current_group)
6724 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
6725 process, current_group);
6728 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6729 doc: /* Kill process PROCESS. May be process or name of one.
6730 See function `interrupt-process' for more details on usage. */)
6731 (Lisp_Object process, Lisp_Object current_group)
6733 process_send_signal (process, SIGKILL, current_group, 0);
6734 return process;
6737 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6738 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6739 See function `interrupt-process' for more details on usage. */)
6740 (Lisp_Object process, Lisp_Object current_group)
6742 process_send_signal (process, SIGQUIT, current_group, 0);
6743 return process;
6746 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6747 doc: /* Stop process PROCESS. May be process or name of one.
6748 See function `interrupt-process' for more details on usage.
6749 If PROCESS is a network or serial or pipe connection, inhibit handling
6750 of incoming traffic. */)
6751 (Lisp_Object process, Lisp_Object current_group)
6753 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6754 || PIPECONN_P (process)))
6756 struct Lisp_Process *p;
6758 p = XPROCESS (process);
6759 if (NILP (p->command)
6760 && p->infd >= 0)
6761 delete_read_fd (p->infd);
6762 pset_command (p, Qt);
6763 return process;
6765 #ifndef SIGTSTP
6766 error ("No SIGTSTP support");
6767 #else
6768 process_send_signal (process, SIGTSTP, current_group, 0);
6769 #endif
6770 return process;
6773 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6774 doc: /* Continue process PROCESS. May be process or name of one.
6775 See function `interrupt-process' for more details on usage.
6776 If PROCESS is a network or serial process, resume handling of incoming
6777 traffic. */)
6778 (Lisp_Object process, Lisp_Object current_group)
6780 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6781 || PIPECONN_P (process)))
6783 struct Lisp_Process *p;
6785 p = XPROCESS (process);
6786 if (EQ (p->command, Qt)
6787 && p->infd >= 0
6788 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6790 add_process_read_fd (p->infd);
6791 #ifdef WINDOWSNT
6792 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6793 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6794 #else /* not WINDOWSNT */
6795 tcflush (p->infd, TCIFLUSH);
6796 #endif /* not WINDOWSNT */
6798 pset_command (p, Qnil);
6799 return process;
6801 #ifdef SIGCONT
6802 process_send_signal (process, SIGCONT, current_group, 0);
6803 #else
6804 error ("No SIGCONT support");
6805 #endif
6806 return process;
6809 /* Return the integer value of the signal whose abbreviation is ABBR,
6810 or a negative number if there is no such signal. */
6811 static int
6812 abbr_to_signal (char const *name)
6814 int i, signo;
6815 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
6817 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
6818 name += 3;
6820 for (i = 0; i < sizeof sigbuf; i++)
6822 sigbuf[i] = c_toupper (name[i]);
6823 if (! sigbuf[i])
6824 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
6827 return -1;
6830 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6831 2, 2, "sProcess (name or number): \nnSignal code: ",
6832 doc: /* Send PROCESS the signal with code SIGCODE.
6833 PROCESS may also be a number specifying the process id of the
6834 process to signal; in this case, the process need not be a child of
6835 this Emacs.
6836 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6837 (Lisp_Object process, Lisp_Object sigcode)
6839 pid_t pid;
6840 int signo;
6842 if (STRINGP (process))
6844 Lisp_Object tem = Fget_process (process);
6845 if (NILP (tem))
6846 tem = string_to_number (SSDATA (process), 10, S2N_OVERFLOW_TO_FLOAT);
6847 process = tem;
6849 else if (!NUMBERP (process))
6850 process = get_process (process);
6852 if (NILP (process))
6853 return process;
6855 if (NUMBERP (process))
6856 CONS_TO_INTEGER (process, pid_t, pid);
6857 else
6859 CHECK_PROCESS (process);
6860 pid = XPROCESS (process)->pid;
6861 if (pid <= 0)
6862 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6865 if (INTEGERP (sigcode))
6867 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
6868 signo = XINT (sigcode);
6870 else
6872 char *name;
6874 CHECK_SYMBOL (sigcode);
6875 name = SSDATA (SYMBOL_NAME (sigcode));
6877 signo = abbr_to_signal (name);
6878 if (signo < 0)
6879 error ("Undefined signal name %s", name);
6882 return make_number (kill (pid, signo));
6885 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6886 doc: /* Make PROCESS see end-of-file in its input.
6887 EOF comes after any text already sent to it.
6888 PROCESS may be a process, a buffer, the name of a process or buffer, or
6889 nil, indicating the current buffer's process.
6890 If PROCESS is a network connection, or is a process communicating
6891 through a pipe (as opposed to a pty), then you cannot send any more
6892 text to PROCESS after you call this function.
6893 If PROCESS is a serial process, wait until all output written to the
6894 process has been transmitted to the serial port. */)
6895 (Lisp_Object process)
6897 Lisp_Object proc;
6898 struct coding_system *coding = NULL;
6899 int outfd;
6901 proc = get_process (process);
6903 if (NETCONN_P (proc))
6904 wait_while_connecting (proc);
6906 if (DATAGRAM_CONN_P (proc))
6907 return process;
6910 outfd = XPROCESS (proc)->outfd;
6911 if (outfd >= 0)
6912 coding = proc_encode_coding_system[outfd];
6914 /* Make sure the process is really alive. */
6915 if (XPROCESS (proc)->raw_status_new)
6916 update_status (XPROCESS (proc));
6917 if (! EQ (XPROCESS (proc)->status, Qrun))
6918 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6920 if (coding && CODING_REQUIRE_FLUSHING (coding))
6922 coding->mode |= CODING_MODE_LAST_BLOCK;
6923 send_process (proc, "", 0, Qnil);
6926 if (XPROCESS (proc)->pty_flag)
6927 send_process (proc, "\004", 1, Qnil);
6928 else if (EQ (XPROCESS (proc)->type, Qserial))
6930 #ifndef WINDOWSNT
6931 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6932 report_file_error ("Failed tcdrain", Qnil);
6933 #endif /* not WINDOWSNT */
6934 /* Do nothing on Windows because writes are blocking. */
6936 else
6938 struct Lisp_Process *p = XPROCESS (proc);
6939 int old_outfd = p->outfd;
6940 int new_outfd;
6942 #ifdef HAVE_SHUTDOWN
6943 /* If this is a network connection, or socketpair is used
6944 for communication with the subprocess, call shutdown to cause EOF.
6945 (In some old system, shutdown to socketpair doesn't work.
6946 Then we just can't win.) */
6947 if (0 <= old_outfd
6948 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
6949 shutdown (old_outfd, 1);
6950 #endif
6951 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
6952 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6953 if (new_outfd < 0)
6954 report_file_error ("Opening null device", Qnil);
6955 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
6956 p->outfd = new_outfd;
6958 if (!proc_encode_coding_system[new_outfd])
6959 proc_encode_coding_system[new_outfd]
6960 = xmalloc (sizeof (struct coding_system));
6961 if (old_outfd >= 0)
6963 *proc_encode_coding_system[new_outfd]
6964 = *proc_encode_coding_system[old_outfd];
6965 memset (proc_encode_coding_system[old_outfd], 0,
6966 sizeof (struct coding_system));
6968 else
6969 setup_coding_system (p->encode_coding_system,
6970 proc_encode_coding_system[new_outfd]);
6972 return process;
6975 /* The main Emacs thread records child processes in three places:
6977 - Vprocess_alist, for asynchronous subprocesses, which are child
6978 processes visible to Lisp.
6980 - deleted_pid_list, for child processes invisible to Lisp,
6981 typically because of delete-process. These are recorded so that
6982 the processes can be reaped when they exit, so that the operating
6983 system's process table is not cluttered by zombies.
6985 - the local variable PID in Fcall_process, call_process_cleanup and
6986 call_process_kill, for synchronous subprocesses.
6987 record_unwind_protect is used to make sure this process is not
6988 forgotten: if the user interrupts call-process and the child
6989 process refuses to exit immediately even with two C-g's,
6990 call_process_kill adds PID's contents to deleted_pid_list before
6991 returning.
6993 The main Emacs thread invokes waitpid only on child processes that
6994 it creates and that have not been reaped. This avoid races on
6995 platforms such as GTK, where other threads create their own
6996 subprocesses which the main thread should not reap. For example,
6997 if the main thread attempted to reap an already-reaped child, it
6998 might inadvertently reap a GTK-created process that happened to
6999 have the same process ID. */
7001 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
7002 its own SIGCHLD handling. On POSIXish systems, glib needs this to
7003 keep track of its own children. GNUstep is similar. */
7005 static void dummy_handler (int sig) {}
7006 static signal_handler_t volatile lib_child_handler;
7008 /* Handle a SIGCHLD signal by looking for known child processes of
7009 Emacs whose status have changed. For each one found, record its
7010 new status.
7012 All we do is change the status; we do not run sentinels or print
7013 notifications. That is saved for the next time keyboard input is
7014 done, in order to avoid timing errors.
7016 ** WARNING: this can be called during garbage collection.
7017 Therefore, it must not be fooled by the presence of mark bits in
7018 Lisp objects.
7020 ** USG WARNING: Although it is not obvious from the documentation
7021 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7022 signal() before executing at least one wait(), otherwise the
7023 handler will be called again, resulting in an infinite loop. The
7024 relevant portion of the documentation reads "SIGCLD signals will be
7025 queued and the signal-catching function will be continually
7026 reentered until the queue is empty". Invoking signal() causes the
7027 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7028 Inc.
7030 ** Malloc WARNING: This should never call malloc either directly or
7031 indirectly; if it does, that is a bug. */
7033 static void
7034 handle_child_signal (int sig)
7036 Lisp_Object tail, proc;
7038 /* Find the process that signaled us, and record its status. */
7040 /* The process can have been deleted by Fdelete_process, or have
7041 been started asynchronously by Fcall_process. */
7042 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7044 bool all_pids_are_fixnums
7045 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7046 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7047 Lisp_Object head = XCAR (tail);
7048 Lisp_Object xpid;
7049 if (! CONSP (head))
7050 continue;
7051 xpid = XCAR (head);
7052 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
7054 pid_t deleted_pid;
7055 if (INTEGERP (xpid))
7056 deleted_pid = XINT (xpid);
7057 else
7058 deleted_pid = XFLOAT_DATA (xpid);
7059 if (child_status_changed (deleted_pid, 0, 0))
7061 if (STRINGP (XCDR (head)))
7062 unlink (SSDATA (XCDR (head)));
7063 XSETCAR (tail, Qnil);
7068 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7069 FOR_EACH_PROCESS (tail, proc)
7071 struct Lisp_Process *p = XPROCESS (proc);
7072 int status;
7074 if (p->alive
7075 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7077 /* Change the status of the process that was found. */
7078 p->tick = ++process_tick;
7079 p->raw_status = status;
7080 p->raw_status_new = 1;
7082 /* If process has terminated, stop waiting for its output. */
7083 if (WIFSIGNALED (status) || WIFEXITED (status))
7085 bool clear_desc_flag = 0;
7086 p->alive = 0;
7087 if (p->infd >= 0)
7088 clear_desc_flag = 1;
7090 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7091 if (clear_desc_flag)
7092 delete_read_fd (p->infd);
7097 lib_child_handler (sig);
7098 #ifdef NS_IMPL_GNUSTEP
7099 /* NSTask in GNUstep sets its child handler each time it is called.
7100 So we must re-set ours. */
7101 catch_child_signal ();
7102 #endif
7105 static void
7106 deliver_child_signal (int sig)
7108 deliver_process_signal (sig, handle_child_signal);
7112 static Lisp_Object
7113 exec_sentinel_error_handler (Lisp_Object error_val)
7115 /* Make sure error_val is a cons cell, as all the rest of error
7116 handling expects that, and will barf otherwise. */
7117 if (!CONSP (error_val))
7118 error_val = Fcons (Qerror, error_val);
7119 cmd_error_internal (error_val, "error in process sentinel: ");
7120 Vinhibit_quit = Qt;
7121 update_echo_area ();
7122 Fsleep_for (make_number (2), Qnil);
7123 return Qt;
7126 static void
7127 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
7129 Lisp_Object sentinel, odeactivate;
7130 struct Lisp_Process *p = XPROCESS (proc);
7131 ptrdiff_t count = SPECPDL_INDEX ();
7132 bool outer_running_asynch_code = running_asynch_code;
7133 int waiting = waiting_for_user_input_p;
7135 if (inhibit_sentinels)
7136 return;
7138 odeactivate = Vdeactivate_mark;
7139 #if 0
7140 Lisp_Object obuffer, okeymap;
7141 XSETBUFFER (obuffer, current_buffer);
7142 okeymap = BVAR (current_buffer, keymap);
7143 #endif
7145 /* There's no good reason to let sentinels change the current
7146 buffer, and many callers of accept-process-output, sit-for, and
7147 friends don't expect current-buffer to be changed from under them. */
7148 record_unwind_current_buffer ();
7150 sentinel = p->sentinel;
7152 /* Inhibit quit so that random quits don't screw up a running filter. */
7153 specbind (Qinhibit_quit, Qt);
7154 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
7156 /* In case we get recursively called,
7157 and we already saved the match data nonrecursively,
7158 save the same match data in safely recursive fashion. */
7159 if (outer_running_asynch_code)
7161 Lisp_Object tem;
7162 tem = Fmatch_data (Qnil, Qnil, Qnil);
7163 restore_search_regs ();
7164 record_unwind_save_match_data ();
7165 Fset_match_data (tem, Qt);
7168 /* For speed, if a search happens within this code,
7169 save the match data in a special nonrecursive fashion. */
7170 running_asynch_code = 1;
7172 internal_condition_case_1 (read_process_output_call,
7173 list3 (sentinel, proc, reason),
7174 !NILP (Vdebug_on_error) ? Qnil : Qerror,
7175 exec_sentinel_error_handler);
7177 /* If we saved the match data nonrecursively, restore it now. */
7178 restore_search_regs ();
7179 running_asynch_code = outer_running_asynch_code;
7181 Vdeactivate_mark = odeactivate;
7183 /* Restore waiting_for_user_input_p as it was
7184 when we were called, in case the filter clobbered it. */
7185 waiting_for_user_input_p = waiting;
7187 #if 0
7188 if (! EQ (Fcurrent_buffer (), obuffer)
7189 || ! EQ (current_buffer->keymap, okeymap))
7190 #endif
7191 /* But do it only if the caller is actually going to read events.
7192 Otherwise there's no need to make him wake up, and it could
7193 cause trouble (for example it would make sit_for return). */
7194 if (waiting_for_user_input_p == -1)
7195 record_asynch_buffer_change ();
7197 unbind_to (count, Qnil);
7200 /* Report all recent events of a change in process status
7201 (either run the sentinel or output a message).
7202 This is usually done while Emacs is waiting for keyboard input
7203 but can be done at other times.
7205 Return positive if any input was received from WAIT_PROC (or from
7206 any process if WAIT_PROC is null), zero if input was attempted but
7207 none received, and negative if we didn't even try. */
7209 static int
7210 status_notify (struct Lisp_Process *deleting_process,
7211 struct Lisp_Process *wait_proc)
7213 Lisp_Object proc;
7214 Lisp_Object tail, msg;
7215 int got_some_output = -1;
7217 tail = Qnil;
7218 msg = Qnil;
7220 /* Set this now, so that if new processes are created by sentinels
7221 that we run, we get called again to handle their status changes. */
7222 update_tick = process_tick;
7224 FOR_EACH_PROCESS (tail, proc)
7226 Lisp_Object symbol;
7227 register struct Lisp_Process *p = XPROCESS (proc);
7229 if (p->tick != p->update_tick)
7231 p->update_tick = p->tick;
7233 /* If process is still active, read any output that remains. */
7234 while (! EQ (p->filter, Qt)
7235 && ! connecting_status (p->status)
7236 && ! EQ (p->status, Qlisten)
7237 /* Network or serial process not stopped: */
7238 && ! EQ (p->command, Qt)
7239 && p->infd >= 0
7240 && p != deleting_process)
7242 int nread = read_process_output (proc, p->infd);
7243 if ((!wait_proc || wait_proc == XPROCESS (proc))
7244 && got_some_output < nread)
7245 got_some_output = nread;
7246 if (nread <= 0)
7247 break;
7250 /* Get the text to use for the message. */
7251 if (p->raw_status_new)
7252 update_status (p);
7253 msg = status_message (p);
7255 /* If process is terminated, deactivate it or delete it. */
7256 symbol = p->status;
7257 if (CONSP (p->status))
7258 symbol = XCAR (p->status);
7260 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
7261 || EQ (symbol, Qclosed))
7263 if (delete_exited_processes)
7264 remove_process (proc);
7265 else
7266 deactivate_process (proc);
7269 /* The actions above may have further incremented p->tick.
7270 So set p->update_tick again so that an error in the sentinel will
7271 not cause this code to be run again. */
7272 p->update_tick = p->tick;
7273 /* Now output the message suitably. */
7274 exec_sentinel (proc, msg);
7275 if (BUFFERP (p->buffer))
7276 /* In case it uses %s in mode-line-format. */
7277 bset_update_mode_line (XBUFFER (p->buffer));
7279 } /* end for */
7281 return got_some_output;
7284 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
7285 Sinternal_default_process_sentinel, 2, 2, 0,
7286 doc: /* Function used as default sentinel for processes.
7287 This inserts a status message into the process's buffer, if there is one. */)
7288 (Lisp_Object proc, Lisp_Object msg)
7290 Lisp_Object buffer, symbol;
7291 struct Lisp_Process *p;
7292 CHECK_PROCESS (proc);
7293 p = XPROCESS (proc);
7294 buffer = p->buffer;
7295 symbol = p->status;
7296 if (CONSP (symbol))
7297 symbol = XCAR (symbol);
7299 if (!EQ (symbol, Qrun) && !NILP (buffer))
7301 Lisp_Object tem;
7302 struct buffer *old = current_buffer;
7303 ptrdiff_t opoint, opoint_byte;
7304 ptrdiff_t before, before_byte;
7306 /* Avoid error if buffer is deleted
7307 (probably that's why the process is dead, too). */
7308 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
7309 return Qnil;
7310 Fset_buffer (buffer);
7312 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7313 msg = (code_convert_string_norecord
7314 (msg, Vlocale_coding_system, 1));
7316 opoint = PT;
7317 opoint_byte = PT_BYTE;
7318 /* Insert new output into buffer
7319 at the current end-of-output marker,
7320 thus preserving logical ordering of input and output. */
7321 if (XMARKER (p->mark)->buffer)
7322 Fgoto_char (p->mark);
7323 else
7324 SET_PT_BOTH (ZV, ZV_BYTE);
7326 before = PT;
7327 before_byte = PT_BYTE;
7329 tem = BVAR (current_buffer, read_only);
7330 bset_read_only (current_buffer, Qnil);
7331 insert_string ("\nProcess ");
7332 { /* FIXME: temporary kludge. */
7333 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
7334 insert_string (" ");
7335 Finsert (1, &msg);
7336 bset_read_only (current_buffer, tem);
7337 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7339 if (opoint >= before)
7340 SET_PT_BOTH (opoint + (PT - before),
7341 opoint_byte + (PT_BYTE - before_byte));
7342 else
7343 SET_PT_BOTH (opoint, opoint_byte);
7345 set_buffer_internal (old);
7347 return Qnil;
7351 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7352 Sset_process_coding_system, 1, 3, 0,
7353 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
7354 DECODING will be used to decode subprocess output and ENCODING to
7355 encode subprocess input. */)
7356 (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
7358 CHECK_PROCESS (process);
7360 struct Lisp_Process *p = XPROCESS (process);
7362 Fcheck_coding_system (decoding);
7363 Fcheck_coding_system (encoding);
7364 encoding = coding_inherit_eol_type (encoding, Qnil);
7365 pset_decode_coding_system (p, decoding);
7366 pset_encode_coding_system (p, encoding);
7368 /* If the sockets haven't been set up yet, the final setup part of
7369 this will be called asynchronously. */
7370 if (p->infd < 0 || p->outfd < 0)
7371 return Qnil;
7373 setup_process_coding_systems (process);
7375 return Qnil;
7378 DEFUN ("process-coding-system",
7379 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7380 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7381 (register Lisp_Object process)
7383 CHECK_PROCESS (process);
7384 return Fcons (XPROCESS (process)->decode_coding_system,
7385 XPROCESS (process)->encode_coding_system);
7388 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
7389 Sset_process_filter_multibyte, 2, 2, 0,
7390 doc: /* Set multibyteness of the strings given to PROCESS's filter.
7391 If FLAG is non-nil, the filter is given multibyte strings.
7392 If FLAG is nil, the filter is given unibyte strings. In this case,
7393 all character code conversion except for end-of-line conversion is
7394 suppressed. */)
7395 (Lisp_Object process, Lisp_Object flag)
7397 CHECK_PROCESS (process);
7399 struct Lisp_Process *p = XPROCESS (process);
7400 if (NILP (flag))
7401 pset_decode_coding_system
7402 (p, raw_text_coding_system (p->decode_coding_system));
7404 /* If the sockets haven't been set up yet, the final setup part of
7405 this will be called asynchronously. */
7406 if (p->infd < 0 || p->outfd < 0)
7407 return Qnil;
7409 setup_process_coding_systems (process);
7411 return Qnil;
7414 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
7415 Sprocess_filter_multibyte_p, 1, 1, 0,
7416 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7417 (Lisp_Object process)
7419 CHECK_PROCESS (process);
7420 struct Lisp_Process *p = XPROCESS (process);
7421 if (p->infd < 0)
7422 return Qnil;
7423 struct coding_system *coding = proc_decode_coding_system[p->infd];
7424 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
7430 # ifdef HAVE_GPM
7432 void
7433 add_gpm_wait_descriptor (int desc)
7435 add_keyboard_wait_descriptor (desc);
7438 void
7439 delete_gpm_wait_descriptor (int desc)
7441 delete_keyboard_wait_descriptor (desc);
7444 # endif
7446 # ifdef USABLE_SIGIO
7448 /* Return true if *MASK has a bit set
7449 that corresponds to one of the keyboard input descriptors. */
7451 static bool
7452 keyboard_bit_set (fd_set *mask)
7454 int fd;
7456 for (fd = 0; fd <= max_desc; fd++)
7457 if (FD_ISSET (fd, mask)
7458 && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
7459 == (FOR_READ | KEYBOARD_FD)))
7460 return 1;
7462 return 0;
7464 # endif
7466 #else /* not subprocesses */
7468 /* This is referenced in thread.c:run_thread (which is never actually
7469 called, since threads are not enabled for this configuration. */
7470 void
7471 update_processes_for_thread_death (Lisp_Object dying_thread)
7475 /* Defined in msdos.c. */
7476 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7477 struct timespec *, void *);
7479 /* Implementation of wait_reading_process_output, assuming that there
7480 are no subprocesses. Used only by the MS-DOS build.
7482 Wait for timeout to elapse and/or keyboard input to be available.
7484 TIME_LIMIT is:
7485 timeout in seconds
7486 If negative, gobble data immediately available but don't wait for any.
7488 NSECS is:
7489 an additional duration to wait, measured in nanoseconds
7490 If TIME_LIMIT is zero, then:
7491 If NSECS == 0, there is no limit.
7492 If NSECS > 0, the timeout consists of NSECS only.
7493 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7495 READ_KBD is:
7496 0 to ignore keyboard input, or
7497 1 to return when input is available, or
7498 -1 means caller will actually read the input, so don't throw to
7499 the quit handler.
7501 see full version for other parameters. We know that wait_proc will
7502 always be NULL, since `subprocesses' isn't defined.
7504 DO_DISPLAY means redisplay should be done to show subprocess
7505 output that arrives.
7507 Return -1 signifying we got no output and did not try. */
7510 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7511 bool do_display,
7512 Lisp_Object wait_for_cell,
7513 struct Lisp_Process *wait_proc, int just_wait_proc)
7515 register int nfds;
7516 struct timespec end_time, timeout;
7517 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
7519 if (TYPE_MAXIMUM (time_t) < time_limit)
7520 time_limit = TYPE_MAXIMUM (time_t);
7522 if (time_limit < 0 || nsecs < 0)
7523 wait = MINIMUM;
7524 else if (time_limit > 0 || nsecs > 0)
7526 wait = TIMEOUT;
7527 end_time = timespec_add (current_timespec (),
7528 make_timespec (time_limit, nsecs));
7530 else
7531 wait = INFINITY;
7533 /* Turn off periodic alarms (in case they are in use)
7534 and then turn off any other atimers,
7535 because the select emulator uses alarms. */
7536 stop_polling ();
7537 turn_on_atimers (0);
7539 while (1)
7541 bool timeout_reduced_for_timers = false;
7542 fd_set waitchannels;
7543 int xerrno;
7545 /* If calling from keyboard input, do not quit
7546 since we want to return C-g as an input character.
7547 Otherwise, do pending quit if requested. */
7548 if (read_kbd >= 0)
7549 maybe_quit ();
7551 /* Exit now if the cell we're waiting for became non-nil. */
7552 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7553 break;
7555 /* Compute time from now till when time limit is up. */
7556 /* Exit if already run out. */
7557 if (wait == TIMEOUT)
7559 struct timespec now = current_timespec ();
7560 if (timespec_cmp (end_time, now) <= 0)
7561 break;
7562 timeout = timespec_sub (end_time, now);
7564 else
7565 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7567 /* If our caller will not immediately handle keyboard events,
7568 run timer events directly.
7569 (Callers that will immediately read keyboard events
7570 call timer_delay on their own.) */
7571 if (NILP (wait_for_cell))
7573 struct timespec timer_delay;
7577 unsigned old_timers_run = timers_run;
7578 timer_delay = timer_check ();
7579 if (timers_run != old_timers_run && do_display)
7580 /* We must retry, since a timer may have requeued itself
7581 and that could alter the time delay. */
7582 redisplay_preserve_echo_area (14);
7583 else
7584 break;
7586 while (!detect_input_pending ());
7588 /* If there is unread keyboard input, also return. */
7589 if (read_kbd != 0
7590 && requeued_events_pending_p ())
7591 break;
7593 if (timespec_valid_p (timer_delay))
7595 if (timespec_cmp (timer_delay, timeout) < 0)
7597 timeout = timer_delay;
7598 timeout_reduced_for_timers = true;
7603 /* Cause C-g and alarm signals to take immediate action,
7604 and cause input available signals to zero out timeout. */
7605 if (read_kbd < 0)
7606 set_waiting_for_input (&timeout);
7608 /* If a frame has been newly mapped and needs updating,
7609 reprocess its display stuff. */
7610 if (frame_garbaged && do_display)
7612 clear_waiting_for_input ();
7613 redisplay_preserve_echo_area (15);
7614 if (read_kbd < 0)
7615 set_waiting_for_input (&timeout);
7618 /* Wait till there is something to do. */
7619 FD_ZERO (&waitchannels);
7620 if (read_kbd && detect_input_pending ())
7621 nfds = 0;
7622 else
7624 if (read_kbd || !NILP (wait_for_cell))
7625 FD_SET (0, &waitchannels);
7626 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
7629 xerrno = errno;
7631 /* Make C-g and alarm signals set flags again. */
7632 clear_waiting_for_input ();
7634 /* If we woke up due to SIGWINCH, actually change size now. */
7635 do_pending_window_change (0);
7637 if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
7638 /* We waited the full specified time, so return now. */
7639 break;
7641 if (nfds == -1)
7643 /* If the system call was interrupted, then go around the
7644 loop again. */
7645 if (xerrno == EINTR)
7646 FD_ZERO (&waitchannels);
7647 else
7648 report_file_errno ("Failed select", Qnil, xerrno);
7651 /* Check for keyboard input. */
7653 if (read_kbd
7654 && detect_input_pending_run_timers (do_display))
7656 swallow_events (do_display);
7657 if (detect_input_pending_run_timers (do_display))
7658 break;
7661 /* If there is unread keyboard input, also return. */
7662 if (read_kbd
7663 && requeued_events_pending_p ())
7664 break;
7666 /* If wait_for_cell. check for keyboard input
7667 but don't run any timers.
7668 ??? (It seems wrong to me to check for keyboard
7669 input at all when wait_for_cell, but the code
7670 has been this way since July 1994.
7671 Try changing this after version 19.31.) */
7672 if (! NILP (wait_for_cell)
7673 && detect_input_pending ())
7675 swallow_events (do_display);
7676 if (detect_input_pending ())
7677 break;
7680 /* Exit now if the cell we're waiting for became non-nil. */
7681 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7682 break;
7685 start_polling ();
7687 return -1;
7690 #endif /* not subprocesses */
7692 /* The following functions are needed even if async subprocesses are
7693 not supported. Some of them are no-op stubs in that case. */
7695 #ifdef HAVE_TIMERFD
7697 /* Add FD, which is a descriptor returned by timerfd_create,
7698 to the set of non-keyboard input descriptors. */
7700 void
7701 add_timer_wait_descriptor (int fd)
7703 add_read_fd (fd, timerfd_callback, NULL);
7704 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
7707 #endif /* HAVE_TIMERFD */
7709 /* If program file NAME starts with /: for quoting a magic
7710 name, remove that, preserving the multibyteness of NAME. */
7712 Lisp_Object
7713 remove_slash_colon (Lisp_Object name)
7715 return
7716 (SREF (name, 0) == '/' && SREF (name, 1) == ':'
7717 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
7718 SBYTES (name) - 2, STRING_MULTIBYTE (name))
7719 : name);
7722 /* Add DESC to the set of keyboard input descriptors. */
7724 void
7725 add_keyboard_wait_descriptor (int desc)
7727 #ifdef subprocesses /* Actually means "not MSDOS". */
7728 eassert (desc >= 0 && desc < FD_SETSIZE);
7729 fd_callback_info[desc].flags &= ~PROCESS_FD;
7730 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
7731 if (desc > max_desc)
7732 max_desc = desc;
7733 #endif
7736 /* From now on, do not expect DESC to give keyboard input. */
7738 void
7739 delete_keyboard_wait_descriptor (int desc)
7741 #ifdef subprocesses
7742 eassert (desc >= 0 && desc < FD_SETSIZE);
7744 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
7746 if (desc == max_desc)
7747 recompute_max_desc ();
7748 #endif
7751 /* Setup coding systems of PROCESS. */
7753 void
7754 setup_process_coding_systems (Lisp_Object process)
7756 #ifdef subprocesses
7757 struct Lisp_Process *p = XPROCESS (process);
7758 int inch = p->infd;
7759 int outch = p->outfd;
7760 Lisp_Object coding_system;
7762 if (inch < 0 || outch < 0)
7763 return;
7765 if (!proc_decode_coding_system[inch])
7766 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
7767 coding_system = p->decode_coding_system;
7768 if (EQ (p->filter, Qinternal_default_process_filter)
7769 && BUFFERP (p->buffer))
7771 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
7772 coding_system = raw_text_coding_system (coding_system);
7774 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7776 if (!proc_encode_coding_system[outch])
7777 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
7778 setup_coding_system (p->encode_coding_system,
7779 proc_encode_coding_system[outch]);
7780 #endif
7783 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7784 doc: /* Return the (or a) live process associated with BUFFER.
7785 BUFFER may be a buffer or the name of one.
7786 Return nil if all processes associated with BUFFER have been
7787 deleted or killed. */)
7788 (register Lisp_Object buffer)
7790 #ifdef subprocesses
7791 register Lisp_Object buf, tail, proc;
7793 if (NILP (buffer)) return Qnil;
7794 buf = Fget_buffer (buffer);
7795 if (NILP (buf)) return Qnil;
7797 FOR_EACH_PROCESS (tail, proc)
7798 if (EQ (XPROCESS (proc)->buffer, buf))
7799 return proc;
7800 #endif /* subprocesses */
7801 return Qnil;
7804 DEFUN ("process-inherit-coding-system-flag",
7805 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7806 1, 1, 0,
7807 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7808 If this flag is t, `buffer-file-coding-system' of the buffer
7809 associated with PROCESS will inherit the coding system used to decode
7810 the process output. */)
7811 (register Lisp_Object process)
7813 #ifdef subprocesses
7814 CHECK_PROCESS (process);
7815 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7816 #else
7817 /* Ignore the argument and return the value of
7818 inherit-process-coding-system. */
7819 return inherit_process_coding_system ? Qt : Qnil;
7820 #endif
7823 /* Kill all processes associated with `buffer'.
7824 If `buffer' is nil, kill all processes. */
7826 void
7827 kill_buffer_processes (Lisp_Object buffer)
7829 #ifdef subprocesses
7830 Lisp_Object tail, proc;
7832 FOR_EACH_PROCESS (tail, proc)
7833 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
7835 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
7836 Fdelete_process (proc);
7837 else if (XPROCESS (proc)->infd >= 0)
7838 process_send_signal (proc, SIGHUP, Qnil, 1);
7840 #else /* subprocesses */
7841 /* Since we have no subprocesses, this does nothing. */
7842 #endif /* subprocesses */
7845 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
7846 Swaiting_for_user_input_p, 0, 0, 0,
7847 doc: /* Return non-nil if Emacs is waiting for input from the user.
7848 This is intended for use by asynchronous process output filters and sentinels. */)
7849 (void)
7851 #ifdef subprocesses
7852 return (waiting_for_user_input_p ? Qt : Qnil);
7853 #else
7854 return Qnil;
7855 #endif
7858 /* Stop reading input from keyboard sources. */
7860 void
7861 hold_keyboard_input (void)
7863 kbd_is_on_hold = 1;
7866 /* Resume reading input from keyboard sources. */
7868 void
7869 unhold_keyboard_input (void)
7871 kbd_is_on_hold = 0;
7874 /* Return true if keyboard input is on hold, zero otherwise. */
7876 bool
7877 kbd_on_hold_p (void)
7879 return kbd_is_on_hold;
7883 /* Enumeration of and access to system processes a-la ps(1). */
7885 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7886 0, 0, 0,
7887 doc: /* Return a list of numerical process IDs of all running processes.
7888 If this functionality is unsupported, return nil.
7890 See `process-attributes' for getting attributes of a process given its ID. */)
7891 (void)
7893 return list_system_processes ();
7896 DEFUN ("process-attributes", Fprocess_attributes,
7897 Sprocess_attributes, 1, 1, 0,
7898 doc: /* Return attributes of the process given by its PID, a number.
7900 Value is an alist where each element is a cons cell of the form
7902 (KEY . VALUE)
7904 If this functionality is unsupported, the value is nil.
7906 See `list-system-processes' for getting a list of all process IDs.
7908 The KEYs of the attributes that this function may return are listed
7909 below, together with the type of the associated VALUE (in parentheses).
7910 Not all platforms support all of these attributes; unsupported
7911 attributes will not appear in the returned alist.
7912 Unless explicitly indicated otherwise, numbers can have either
7913 integer or floating point values.
7915 euid -- Effective user User ID of the process (number)
7916 user -- User name corresponding to euid (string)
7917 egid -- Effective user Group ID of the process (number)
7918 group -- Group name corresponding to egid (string)
7919 comm -- Command name (executable name only) (string)
7920 state -- Process state code, such as "S", "R", or "T" (string)
7921 ppid -- Parent process ID (number)
7922 pgrp -- Process group ID (number)
7923 sess -- Session ID, i.e. process ID of session leader (number)
7924 ttname -- Controlling tty name (string)
7925 tpgid -- ID of foreground process group on the process's tty (number)
7926 minflt -- number of minor page faults (number)
7927 majflt -- number of major page faults (number)
7928 cminflt -- cumulative number of minor page faults (number)
7929 cmajflt -- cumulative number of major page faults (number)
7930 utime -- user time used by the process, in (current-time) format,
7931 which is a list of integers (HIGH LOW USEC PSEC)
7932 stime -- system time used by the process (current-time)
7933 time -- sum of utime and stime (current-time)
7934 cutime -- user time used by the process and its children (current-time)
7935 cstime -- system time used by the process and its children (current-time)
7936 ctime -- sum of cutime and cstime (current-time)
7937 pri -- priority of the process (number)
7938 nice -- nice value of the process (number)
7939 thcount -- process thread count (number)
7940 start -- time the process started (current-time)
7941 vsize -- virtual memory size of the process in KB's (number)
7942 rss -- resident set size of the process in KB's (number)
7943 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7944 pcpu -- percents of CPU time used by the process (floating-point number)
7945 pmem -- percents of total physical memory used by process's resident set
7946 (floating-point number)
7947 args -- command line which invoked the process (string). */)
7948 ( Lisp_Object pid)
7950 return system_process_attributes (pid);
7953 #ifdef subprocesses
7954 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7955 Invoke this after init_process_emacs, and after glib and/or GNUstep
7956 futz with the SIGCHLD handler, but before Emacs forks any children.
7957 This function's caller should block SIGCHLD. */
7959 void
7960 catch_child_signal (void)
7962 struct sigaction action, old_action;
7963 sigset_t oldset;
7964 emacs_sigaction_init (&action, deliver_child_signal);
7965 block_child_signal (&oldset);
7966 sigaction (SIGCHLD, &action, &old_action);
7967 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7968 || ! (old_action.sa_flags & SA_SIGINFO));
7970 if (old_action.sa_handler != deliver_child_signal)
7971 lib_child_handler
7972 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7973 ? dummy_handler
7974 : old_action.sa_handler);
7975 unblock_child_signal (&oldset);
7977 #endif /* subprocesses */
7979 /* Limit the number of open files to the value it had at startup. */
7981 void
7982 restore_nofile_limit (void)
7984 #ifdef HAVE_SETRLIMIT
7985 if (FD_SETSIZE < nofile_limit.rlim_cur)
7986 setrlimit (RLIMIT_NOFILE, &nofile_limit);
7987 #endif
7991 /* This is not called "init_process" because that is the name of a
7992 Mach system call, so it would cause problems on Darwin systems. */
7993 void
7994 init_process_emacs (int sockfd)
7996 #ifdef subprocesses
7997 int i;
7999 inhibit_sentinels = 0;
8001 #ifndef CANNOT_DUMP
8002 if (! noninteractive || initialized)
8003 #endif
8005 #if defined HAVE_GLIB && !defined WINDOWSNT
8006 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
8007 this should always fail, but is enough to initialize glib's
8008 private SIGCHLD handler, allowing catch_child_signal to copy
8009 it into lib_child_handler. */
8010 g_source_unref (g_child_watch_source_new (getpid ()));
8011 #endif
8012 catch_child_signal ();
8015 #ifdef HAVE_SETRLIMIT
8016 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8017 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
8018 nofile_limit.rlim_cur = 0;
8019 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8021 struct rlimit rlim = nofile_limit;
8022 rlim.rlim_cur = FD_SETSIZE;
8023 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8024 nofile_limit.rlim_cur = 0;
8026 #endif
8028 external_sock_fd = sockfd;
8029 Lisp_Object sockname = Qnil;
8030 # if HAVE_GETSOCKNAME
8031 if (0 <= sockfd)
8033 union u_sockaddr sa;
8034 socklen_t salen = sizeof sa;
8035 if (getsockname (sockfd, &sa.sa, &salen) == 0)
8036 sockname = conv_sockaddr_to_lisp (&sa.sa, salen);
8038 # endif
8039 Vinternal__daemon_sockname = sockname;
8041 max_desc = -1;
8042 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8044 num_pending_connects = 0;
8046 process_output_delay_count = 0;
8047 process_output_skip = 0;
8049 /* Don't do this, it caused infinite select loops. The display
8050 method should call add_keyboard_wait_descriptor on stdin if it
8051 needs that. */
8052 #if 0
8053 FD_SET (0, &input_wait_mask);
8054 #endif
8056 Vprocess_alist = Qnil;
8057 deleted_pid_list = Qnil;
8058 for (i = 0; i < FD_SETSIZE; i++)
8060 chan_process[i] = Qnil;
8061 proc_buffered_char[i] = -1;
8063 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8064 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8065 #ifdef DATAGRAM_SOCKETS
8066 memset (datagram_address, 0, sizeof datagram_address);
8067 #endif
8069 #if defined (DARWIN_OS)
8070 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8071 processes. As such, we only change the default value. */
8072 if (initialized)
8074 char const *release = (STRINGP (Voperating_system_release)
8075 ? SSDATA (Voperating_system_release)
8076 : 0);
8077 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
8078 Vprocess_connection_type = Qnil;
8081 #endif
8082 #endif /* subprocesses */
8083 kbd_is_on_hold = 0;
8086 void
8087 syms_of_process (void)
8089 #ifdef subprocesses
8091 DEFSYM (Qprocessp, "processp");
8092 DEFSYM (Qrun, "run");
8093 DEFSYM (Qstop, "stop");
8094 DEFSYM (Qsignal, "signal");
8096 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8097 here again. */
8099 DEFSYM (Qopen, "open");
8100 DEFSYM (Qclosed, "closed");
8101 DEFSYM (Qconnect, "connect");
8102 DEFSYM (Qfailed, "failed");
8103 DEFSYM (Qlisten, "listen");
8104 DEFSYM (Qlocal, "local");
8105 DEFSYM (Qipv4, "ipv4");
8106 #ifdef AF_INET6
8107 DEFSYM (Qipv6, "ipv6");
8108 #endif
8109 DEFSYM (Qdatagram, "datagram");
8110 DEFSYM (Qseqpacket, "seqpacket");
8112 DEFSYM (QCport, ":port");
8113 DEFSYM (QCspeed, ":speed");
8114 DEFSYM (QCprocess, ":process");
8116 DEFSYM (QCbytesize, ":bytesize");
8117 DEFSYM (QCstopbits, ":stopbits");
8118 DEFSYM (QCparity, ":parity");
8119 DEFSYM (Qodd, "odd");
8120 DEFSYM (Qeven, "even");
8121 DEFSYM (QCflowcontrol, ":flowcontrol");
8122 DEFSYM (Qhw, "hw");
8123 DEFSYM (Qsw, "sw");
8124 DEFSYM (QCsummary, ":summary");
8126 DEFSYM (Qreal, "real");
8127 DEFSYM (Qnetwork, "network");
8128 DEFSYM (Qserial, "serial");
8129 DEFSYM (QCbuffer, ":buffer");
8130 DEFSYM (QChost, ":host");
8131 DEFSYM (QCservice, ":service");
8132 DEFSYM (QClocal, ":local");
8133 DEFSYM (QCremote, ":remote");
8134 DEFSYM (QCcoding, ":coding");
8135 DEFSYM (QCserver, ":server");
8136 DEFSYM (QCnowait, ":nowait");
8137 DEFSYM (QCsentinel, ":sentinel");
8138 DEFSYM (QCuse_external_socket, ":use-external-socket");
8139 DEFSYM (QCtls_parameters, ":tls-parameters");
8140 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8141 DEFSYM (QClog, ":log");
8142 DEFSYM (QCnoquery, ":noquery");
8143 DEFSYM (QCstop, ":stop");
8144 DEFSYM (QCplist, ":plist");
8145 DEFSYM (QCcommand, ":command");
8146 DEFSYM (QCconnection_type, ":connection-type");
8147 DEFSYM (QCstderr, ":stderr");
8148 DEFSYM (Qpty, "pty");
8149 DEFSYM (Qpipe, "pipe");
8151 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8153 staticpro (&Vprocess_alist);
8154 staticpro (&deleted_pid_list);
8156 #endif /* subprocesses */
8158 DEFSYM (QCname, ":name");
8159 DEFSYM (QCtype, ":type");
8161 DEFSYM (Qeuid, "euid");
8162 DEFSYM (Qegid, "egid");
8163 DEFSYM (Quser, "user");
8164 DEFSYM (Qgroup, "group");
8165 DEFSYM (Qcomm, "comm");
8166 DEFSYM (Qstate, "state");
8167 DEFSYM (Qppid, "ppid");
8168 DEFSYM (Qpgrp, "pgrp");
8169 DEFSYM (Qsess, "sess");
8170 DEFSYM (Qttname, "ttname");
8171 DEFSYM (Qtpgid, "tpgid");
8172 DEFSYM (Qminflt, "minflt");
8173 DEFSYM (Qmajflt, "majflt");
8174 DEFSYM (Qcminflt, "cminflt");
8175 DEFSYM (Qcmajflt, "cmajflt");
8176 DEFSYM (Qutime, "utime");
8177 DEFSYM (Qstime, "stime");
8178 DEFSYM (Qtime, "time");
8179 DEFSYM (Qcutime, "cutime");
8180 DEFSYM (Qcstime, "cstime");
8181 DEFSYM (Qctime, "ctime");
8182 #ifdef subprocesses
8183 DEFSYM (Qinternal_default_process_sentinel,
8184 "internal-default-process-sentinel");
8185 DEFSYM (Qinternal_default_process_filter,
8186 "internal-default-process-filter");
8187 #endif
8188 DEFSYM (Qpri, "pri");
8189 DEFSYM (Qnice, "nice");
8190 DEFSYM (Qthcount, "thcount");
8191 DEFSYM (Qstart, "start");
8192 DEFSYM (Qvsize, "vsize");
8193 DEFSYM (Qrss, "rss");
8194 DEFSYM (Qetime, "etime");
8195 DEFSYM (Qpcpu, "pcpu");
8196 DEFSYM (Qpmem, "pmem");
8197 DEFSYM (Qargs, "args");
8199 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8200 doc: /* Non-nil means delete processes immediately when they exit.
8201 A value of nil means don't delete them until `list-processes' is run. */);
8203 delete_exited_processes = 1;
8205 #ifdef subprocesses
8206 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8207 doc: /* Control type of device used to communicate with subprocesses.
8208 Values are nil to use a pipe, or t or `pty' to use a pty.
8209 The value has no effect if the system has no ptys or if all ptys are busy:
8210 then a pipe is used in any case.
8211 The value takes effect when `start-process' is called. */);
8212 Vprocess_connection_type = Qt;
8214 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8215 doc: /* If non-nil, improve receive buffering by delaying after short reads.
8216 On some systems, when Emacs reads the output from a subprocess, the output data
8217 is read in very small blocks, potentially resulting in very poor performance.
8218 This behavior can be remedied to some extent by setting this variable to a
8219 non-nil value, as it will automatically delay reading from such processes, to
8220 allow them to produce more output before Emacs tries to read it.
8221 If the value is t, the delay is reset after each write to the process; any other
8222 non-nil value means that the delay is not reset on write.
8223 The variable takes effect when `start-process' is called. */);
8224 Vprocess_adaptive_read_buffering = Qt;
8226 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8227 doc: /* List of functions to be called for `interrupt-process'.
8228 The arguments of the functions are the same as for `interrupt-process'.
8229 These functions are called in the order of the list, until one of them
8230 returns non-`nil'. */);
8231 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8233 DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname,
8234 doc: /* Name of external socket passed to Emacs, or nil if none. */);
8235 Vinternal__daemon_sockname = Qnil;
8237 DEFSYM (Qinternal_default_interrupt_process,
8238 "internal-default-interrupt-process");
8239 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8241 defsubr (&Sprocessp);
8242 defsubr (&Sget_process);
8243 defsubr (&Sdelete_process);
8244 defsubr (&Sprocess_status);
8245 defsubr (&Sprocess_exit_status);
8246 defsubr (&Sprocess_id);
8247 defsubr (&Sprocess_name);
8248 defsubr (&Sprocess_tty_name);
8249 defsubr (&Sprocess_command);
8250 defsubr (&Sset_process_buffer);
8251 defsubr (&Sprocess_buffer);
8252 defsubr (&Sprocess_mark);
8253 defsubr (&Sset_process_filter);
8254 defsubr (&Sprocess_filter);
8255 defsubr (&Sset_process_sentinel);
8256 defsubr (&Sprocess_sentinel);
8257 defsubr (&Sset_process_thread);
8258 defsubr (&Sprocess_thread);
8259 defsubr (&Sset_process_window_size);
8260 defsubr (&Sset_process_inherit_coding_system_flag);
8261 defsubr (&Sset_process_query_on_exit_flag);
8262 defsubr (&Sprocess_query_on_exit_flag);
8263 defsubr (&Sprocess_contact);
8264 defsubr (&Sprocess_plist);
8265 defsubr (&Sset_process_plist);
8266 defsubr (&Sprocess_list);
8267 defsubr (&Smake_process);
8268 defsubr (&Smake_pipe_process);
8269 defsubr (&Sserial_process_configure);
8270 defsubr (&Smake_serial_process);
8271 defsubr (&Sset_network_process_option);
8272 defsubr (&Smake_network_process);
8273 defsubr (&Sformat_network_address);
8274 defsubr (&Snetwork_interface_list);
8275 defsubr (&Snetwork_interface_info);
8276 #ifdef DATAGRAM_SOCKETS
8277 defsubr (&Sprocess_datagram_address);
8278 defsubr (&Sset_process_datagram_address);
8279 #endif
8280 defsubr (&Saccept_process_output);
8281 defsubr (&Sprocess_send_region);
8282 defsubr (&Sprocess_send_string);
8283 defsubr (&Sinternal_default_interrupt_process);
8284 defsubr (&Sinterrupt_process);
8285 defsubr (&Skill_process);
8286 defsubr (&Squit_process);
8287 defsubr (&Sstop_process);
8288 defsubr (&Scontinue_process);
8289 defsubr (&Sprocess_running_child_p);
8290 defsubr (&Sprocess_send_eof);
8291 defsubr (&Ssignal_process);
8292 defsubr (&Swaiting_for_user_input_p);
8293 defsubr (&Sprocess_type);
8294 defsubr (&Sinternal_default_process_sentinel);
8295 defsubr (&Sinternal_default_process_filter);
8296 defsubr (&Sset_process_coding_system);
8297 defsubr (&Sprocess_coding_system);
8298 defsubr (&Sset_process_filter_multibyte);
8299 defsubr (&Sprocess_filter_multibyte_p);
8302 Lisp_Object subfeatures = Qnil;
8303 const struct socket_options *sopt;
8305 #define ADD_SUBFEATURE(key, val) \
8306 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8308 ADD_SUBFEATURE (QCnowait, Qt);
8309 #ifdef DATAGRAM_SOCKETS
8310 ADD_SUBFEATURE (QCtype, Qdatagram);
8311 #endif
8312 #ifdef HAVE_SEQPACKET
8313 ADD_SUBFEATURE (QCtype, Qseqpacket);
8314 #endif
8315 #ifdef HAVE_LOCAL_SOCKETS
8316 ADD_SUBFEATURE (QCfamily, Qlocal);
8317 #endif
8318 ADD_SUBFEATURE (QCfamily, Qipv4);
8319 #ifdef AF_INET6
8320 ADD_SUBFEATURE (QCfamily, Qipv6);
8321 #endif
8322 #ifdef HAVE_GETSOCKNAME
8323 ADD_SUBFEATURE (QCservice, Qt);
8324 #endif
8325 ADD_SUBFEATURE (QCserver, Qt);
8327 for (sopt = socket_options; sopt->name; sopt++)
8328 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8330 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8333 #endif /* subprocesses */
8335 defsubr (&Sget_buffer_process);
8336 defsubr (&Sprocess_inherit_coding_system_flag);
8337 defsubr (&Slist_system_processes);
8338 defsubr (&Sprocess_attributes);