* test/lisp/mouse-tests.el: Fix tests broken by mouse.el change
[emacs.git] / src / process.c
blobff3edbb11a0ed316dd66be5a8bce821723e744a3
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 #ifdef subprocesses
165 #ifndef SOCK_CLOEXEC
166 # define SOCK_CLOEXEC 0
167 #endif
168 #ifndef SOCK_NONBLOCK
169 # define SOCK_NONBLOCK 0
170 #endif
172 /* True if ERRNUM represents an error where the system call would
173 block if a blocking variant were used. */
174 static bool
175 would_block (int errnum)
177 #ifdef EWOULDBLOCK
178 if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
179 return true;
180 #endif
181 return errnum == EAGAIN;
184 #ifndef HAVE_ACCEPT4
186 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
188 static int
189 close_on_exec (int fd)
191 if (0 <= fd)
192 fcntl (fd, F_SETFD, FD_CLOEXEC);
193 return fd;
196 # undef accept4
197 # define accept4(sockfd, addr, addrlen, flags) \
198 process_accept4 (sockfd, addr, addrlen, flags)
199 static int
200 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
202 return close_on_exec (accept (sockfd, addr, addrlen));
205 static int
206 process_socket (int domain, int type, int protocol)
208 return close_on_exec (socket (domain, type, protocol));
210 # undef socket
211 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
212 #endif
214 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
215 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
216 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
217 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
218 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
219 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
221 /* Number of events of change of status of a process. */
222 static EMACS_INT process_tick;
223 /* Number of events for which the user or sentinel has been notified. */
224 static EMACS_INT update_tick;
226 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
227 this system. We need to read full packets, so we need a
228 "non-destructive" select. So we require either native select,
229 or emulation of select using FIONREAD. */
231 #ifndef BROKEN_DATAGRAM_SOCKETS
232 # if defined HAVE_SELECT || defined USABLE_FIONREAD
233 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
234 # define DATAGRAM_SOCKETS
235 # endif
236 # endif
237 #endif
239 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
240 # define HAVE_SEQPACKET
241 #endif
243 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
244 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
245 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
247 /* Number of processes which have a non-zero read_output_delay,
248 and therefore might be delayed for adaptive read buffering. */
250 static int process_output_delay_count;
252 /* True if any process has non-nil read_output_skip. */
254 static bool process_output_skip;
256 static void start_process_unwind (Lisp_Object);
257 static void create_process (Lisp_Object, char **, Lisp_Object);
258 #ifdef USABLE_SIGIO
259 static bool keyboard_bit_set (fd_set *);
260 #endif
261 static void deactivate_process (Lisp_Object);
262 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
263 static int read_process_output (Lisp_Object, int);
264 static void create_pty (Lisp_Object);
265 static void exec_sentinel (Lisp_Object, Lisp_Object);
267 /* Number of bits set in connect_wait_mask. */
268 static int num_pending_connects;
270 /* The largest descriptor currently in use; -1 if none. */
271 static int max_desc;
273 /* Set the external socket descriptor for Emacs to use when
274 `make-network-process' is called with a non-nil
275 `:use-external-socket' option. The value should be either -1, or
276 the file descriptor of a socket that is already bound. */
277 static int external_sock_fd;
279 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
280 static Lisp_Object chan_process[FD_SETSIZE];
281 static void wait_for_socket_fds (Lisp_Object, char const *);
283 /* Alist of elements (NAME . PROCESS). */
284 static Lisp_Object Vprocess_alist;
286 /* Buffered-ahead input char from process, indexed by channel.
287 -1 means empty (no char is buffered).
288 Used on sys V where the only way to tell if there is any
289 output from the process is to read at least one char.
290 Always -1 on systems that support FIONREAD. */
292 static int proc_buffered_char[FD_SETSIZE];
294 /* Table of `struct coding-system' for each process. */
295 static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
296 static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
298 #ifdef DATAGRAM_SOCKETS
299 /* Table of `partner address' for datagram sockets. */
300 static struct sockaddr_and_len {
301 struct sockaddr *sa;
302 ptrdiff_t len;
303 } datagram_address[FD_SETSIZE];
304 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
305 #define DATAGRAM_CONN_P(proc) \
306 (PROCESSP (proc) && \
307 XPROCESS (proc)->infd >= 0 && \
308 datagram_address[XPROCESS (proc)->infd].sa != 0)
309 #else
310 #define DATAGRAM_CONN_P(proc) (0)
311 #endif
313 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
314 a `for' loop which iterates over processes from Vprocess_alist. */
316 #define FOR_EACH_PROCESS(list_var, proc_var) \
317 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
319 /* These setters are used only in this file, so they can be private. */
320 static void
321 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
323 p->buffer = val;
325 static void
326 pset_command (struct Lisp_Process *p, Lisp_Object val)
328 p->command = val;
330 static void
331 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
333 p->decode_coding_system = val;
335 static void
336 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
338 p->decoding_buf = val;
340 static void
341 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
343 p->encode_coding_system = val;
345 static void
346 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
348 p->encoding_buf = val;
350 static void
351 pset_filter (struct Lisp_Process *p, Lisp_Object val)
353 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
355 static void
356 pset_log (struct Lisp_Process *p, Lisp_Object val)
358 p->log = val;
360 static void
361 pset_mark (struct Lisp_Process *p, Lisp_Object val)
363 p->mark = val;
365 static void
366 pset_thread (struct Lisp_Process *p, Lisp_Object val)
368 p->thread = val;
370 static void
371 pset_name (struct Lisp_Process *p, Lisp_Object val)
373 p->name = val;
375 static void
376 pset_plist (struct Lisp_Process *p, Lisp_Object val)
378 p->plist = val;
380 static void
381 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
383 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
385 static void
386 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
388 p->tty_name = val;
390 static void
391 pset_type (struct Lisp_Process *p, Lisp_Object val)
393 p->type = val;
395 static void
396 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
398 p->write_queue = val;
400 static void
401 pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
403 p->stderrproc = val;
407 static Lisp_Object
408 make_lisp_proc (struct Lisp_Process *p)
410 return make_lisp_ptr (p, Lisp_Vectorlike);
413 enum fd_bits
415 /* Read from file descriptor. */
416 FOR_READ = 1,
417 /* Write to file descriptor. */
418 FOR_WRITE = 2,
419 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
420 set. */
421 KEYBOARD_FD = 4,
422 /* This descriptor refers to a process. */
423 PROCESS_FD = 8,
424 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
425 NON_BLOCKING_CONNECT_FD = 16
428 static struct fd_callback_data
430 fd_callback func;
431 void *data;
432 /* Flags from enum fd_bits. */
433 int flags;
434 /* If this fd is locked to a certain thread, this points to it.
435 Otherwise, this is NULL. If an fd is locked to a thread, then
436 only that thread is permitted to wait on it. */
437 struct thread_state *thread;
438 /* If this fd is currently being selected on by a thread, this
439 points to the thread. Otherwise it is NULL. */
440 struct thread_state *waiting_thread;
441 } fd_callback_info[FD_SETSIZE];
444 /* Add a file descriptor FD to be monitored for when read is possible.
445 When read is possible, call FUNC with argument DATA. */
447 void
448 add_read_fd (int fd, fd_callback func, void *data)
450 add_keyboard_wait_descriptor (fd);
452 fd_callback_info[fd].func = func;
453 fd_callback_info[fd].data = data;
456 static void
457 add_non_keyboard_read_fd (int fd)
459 eassert (fd >= 0 && fd < FD_SETSIZE);
460 eassert (fd_callback_info[fd].func == NULL);
462 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
463 fd_callback_info[fd].flags |= FOR_READ;
464 if (fd > max_desc)
465 max_desc = fd;
468 static void
469 add_process_read_fd (int fd)
471 add_non_keyboard_read_fd (fd);
472 fd_callback_info[fd].flags |= PROCESS_FD;
475 /* Stop monitoring file descriptor FD for when read is possible. */
477 void
478 delete_read_fd (int fd)
480 delete_keyboard_wait_descriptor (fd);
482 if (fd_callback_info[fd].flags == 0)
484 fd_callback_info[fd].func = 0;
485 fd_callback_info[fd].data = 0;
489 /* Add a file descriptor FD to be monitored for when write is possible.
490 When write is possible, call FUNC with argument DATA. */
492 void
493 add_write_fd (int fd, fd_callback func, void *data)
495 eassert (fd >= 0 && fd < FD_SETSIZE);
497 fd_callback_info[fd].func = func;
498 fd_callback_info[fd].data = data;
499 fd_callback_info[fd].flags |= FOR_WRITE;
500 if (fd > max_desc)
501 max_desc = fd;
504 static void
505 add_non_blocking_write_fd (int fd)
507 eassert (fd >= 0 && fd < FD_SETSIZE);
508 eassert (fd_callback_info[fd].func == NULL);
510 fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
511 if (fd > max_desc)
512 max_desc = fd;
513 ++num_pending_connects;
516 static void
517 recompute_max_desc (void)
519 int fd;
521 for (fd = max_desc; fd >= 0; --fd)
523 if (fd_callback_info[fd].flags != 0)
525 max_desc = fd;
526 break;
531 /* Stop monitoring file descriptor FD for when write is possible. */
533 void
534 delete_write_fd (int fd)
536 if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
538 if (--num_pending_connects < 0)
539 emacs_abort ();
541 fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
542 if (fd_callback_info[fd].flags == 0)
544 fd_callback_info[fd].func = 0;
545 fd_callback_info[fd].data = 0;
547 if (fd == max_desc)
548 recompute_max_desc ();
552 static void
553 compute_input_wait_mask (fd_set *mask)
555 int fd;
557 FD_ZERO (mask);
558 for (fd = 0; fd <= max_desc; ++fd)
560 if (fd_callback_info[fd].thread != NULL
561 && fd_callback_info[fd].thread != current_thread)
562 continue;
563 if (fd_callback_info[fd].waiting_thread != NULL
564 && fd_callback_info[fd].waiting_thread != current_thread)
565 continue;
566 if ((fd_callback_info[fd].flags & FOR_READ) != 0)
568 FD_SET (fd, mask);
569 fd_callback_info[fd].waiting_thread = current_thread;
574 static void
575 compute_non_process_wait_mask (fd_set *mask)
577 int fd;
579 FD_ZERO (mask);
580 for (fd = 0; fd <= max_desc; ++fd)
582 if (fd_callback_info[fd].thread != NULL
583 && fd_callback_info[fd].thread != current_thread)
584 continue;
585 if (fd_callback_info[fd].waiting_thread != NULL
586 && fd_callback_info[fd].waiting_thread != current_thread)
587 continue;
588 if ((fd_callback_info[fd].flags & FOR_READ) != 0
589 && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
591 FD_SET (fd, mask);
592 fd_callback_info[fd].waiting_thread = current_thread;
597 static void
598 compute_non_keyboard_wait_mask (fd_set *mask)
600 int fd;
602 FD_ZERO (mask);
603 for (fd = 0; fd <= max_desc; ++fd)
605 if (fd_callback_info[fd].thread != NULL
606 && fd_callback_info[fd].thread != current_thread)
607 continue;
608 if (fd_callback_info[fd].waiting_thread != NULL
609 && fd_callback_info[fd].waiting_thread != current_thread)
610 continue;
611 if ((fd_callback_info[fd].flags & FOR_READ) != 0
612 && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
614 FD_SET (fd, mask);
615 fd_callback_info[fd].waiting_thread = current_thread;
620 static void
621 compute_write_mask (fd_set *mask)
623 int fd;
625 FD_ZERO (mask);
626 for (fd = 0; fd <= max_desc; ++fd)
628 if (fd_callback_info[fd].thread != NULL
629 && fd_callback_info[fd].thread != current_thread)
630 continue;
631 if (fd_callback_info[fd].waiting_thread != NULL
632 && fd_callback_info[fd].waiting_thread != current_thread)
633 continue;
634 if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
636 FD_SET (fd, mask);
637 fd_callback_info[fd].waiting_thread = current_thread;
642 static void
643 clear_waiting_thread_info (void)
645 int fd;
647 for (fd = 0; fd <= max_desc; ++fd)
649 if (fd_callback_info[fd].waiting_thread == current_thread)
650 fd_callback_info[fd].waiting_thread = NULL;
655 /* Compute the Lisp form of the process status, p->status, from
656 the numeric status that was returned by `wait'. */
658 static Lisp_Object status_convert (int);
660 static void
661 update_status (struct Lisp_Process *p)
663 eassert (p->raw_status_new);
664 pset_status (p, status_convert (p->raw_status));
665 p->raw_status_new = 0;
668 /* Convert a process status word in Unix format to
669 the list that we use internally. */
671 static Lisp_Object
672 status_convert (int w)
674 if (WIFSTOPPED (w))
675 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
676 else if (WIFEXITED (w))
677 return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
678 WCOREDUMP (w) ? Qt : Qnil));
679 else if (WIFSIGNALED (w))
680 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
681 WCOREDUMP (w) ? Qt : Qnil));
682 else
683 return Qrun;
686 /* True if STATUS is that of a process attempting connection. */
688 static bool
689 connecting_status (Lisp_Object status)
691 return CONSP (status) && EQ (XCAR (status), Qconnect);
694 /* Given a status-list, extract the three pieces of information
695 and store them individually through the three pointers. */
697 static void
698 decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
699 bool *coredump)
701 Lisp_Object tem;
703 if (connecting_status (l))
704 l = XCAR (l);
706 if (SYMBOLP (l))
708 *symbol = l;
709 *code = make_number (0);
710 *coredump = 0;
712 else
714 *symbol = XCAR (l);
715 tem = XCDR (l);
716 *code = XCAR (tem);
717 tem = XCDR (tem);
718 *coredump = !NILP (tem);
722 /* Return a string describing a process status list. */
724 static Lisp_Object
725 status_message (struct Lisp_Process *p)
727 Lisp_Object status = p->status;
728 Lisp_Object symbol, code;
729 bool coredump;
730 Lisp_Object string;
732 decode_status (status, &symbol, &code, &coredump);
734 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
736 char const *signame;
737 synchronize_system_messages_locale ();
738 signame = strsignal (XFASTINT (code));
739 if (signame == 0)
740 string = build_string ("unknown");
741 else
743 int c1, c2;
745 string = build_unibyte_string (signame);
746 if (! NILP (Vlocale_coding_system))
747 string = (code_convert_string_norecord
748 (string, Vlocale_coding_system, 0));
749 c1 = STRING_CHAR (SDATA (string));
750 c2 = downcase (c1);
751 if (c1 != c2)
752 Faset (string, make_number (0), make_number (c2));
754 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
755 return concat2 (string, suffix);
757 else if (EQ (symbol, Qexit))
759 if (NETCONN1_P (p))
760 return build_string (XFASTINT (code) == 0
761 ? "deleted\n"
762 : "connection broken by remote peer\n");
763 if (XFASTINT (code) == 0)
764 return build_string ("finished\n");
765 AUTO_STRING (prefix, "exited abnormally with code ");
766 string = Fnumber_to_string (code);
767 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
768 return concat3 (prefix, string, suffix);
770 else if (EQ (symbol, Qfailed))
772 AUTO_STRING (format, "failed with code %s\n");
773 return CALLN (Fformat, format, code);
775 else
776 return Fcopy_sequence (Fsymbol_name (symbol));
779 enum { PTY_NAME_SIZE = 24 };
781 /* Open an available pty, returning a file descriptor.
782 Store into PTY_NAME the file name of the terminal corresponding to the pty.
783 Return -1 on failure. */
785 static int
786 allocate_pty (char pty_name[PTY_NAME_SIZE])
788 #ifdef HAVE_PTYS
789 int fd;
791 #ifdef PTY_ITERATION
792 PTY_ITERATION
793 #else
794 register int c, i;
795 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
796 for (i = 0; i < 16; i++)
797 #endif
799 #ifdef PTY_NAME_SPRINTF
800 PTY_NAME_SPRINTF
801 #else
802 sprintf (pty_name, "/dev/pty%c%x", c, i);
803 #endif /* no PTY_NAME_SPRINTF */
805 #ifdef PTY_OPEN
806 PTY_OPEN;
807 #else /* no PTY_OPEN */
808 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
809 #endif /* no PTY_OPEN */
811 if (fd >= 0)
813 #ifdef PTY_TTY_NAME_SPRINTF
814 PTY_TTY_NAME_SPRINTF
815 #else
816 sprintf (pty_name, "/dev/tty%c%x", c, i);
817 #endif /* no PTY_TTY_NAME_SPRINTF */
819 /* Set FD's close-on-exec flag. This is needed even if
820 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
821 doesn't require support for that combination.
822 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
823 doesn't work if the close-on-exec flag is set (Bug#20555).
824 Multithreaded platforms where posix_openpt ignores
825 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
826 have a race condition between the PTY_OPEN and here. */
827 fcntl (fd, F_SETFD, FD_CLOEXEC);
829 /* Check to make certain that both sides are available.
830 This avoids a nasty yet stupid bug in rlogins. */
831 if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
833 emacs_close (fd);
834 continue;
836 setup_pty (fd);
837 return fd;
840 #endif /* HAVE_PTYS */
841 return -1;
844 /* Allocate basically initialized process. */
846 static struct Lisp_Process *
847 allocate_process (void)
849 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
852 static Lisp_Object
853 make_process (Lisp_Object name)
855 struct Lisp_Process *p = allocate_process ();
856 /* Initialize Lisp data. Note that allocate_process initializes all
857 Lisp data to nil, so do it only for slots which should not be nil. */
858 pset_status (p, Qrun);
859 pset_mark (p, Fmake_marker ());
860 pset_thread (p, Fcurrent_thread ());
862 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
863 non-Lisp data, so do it only for slots which should not be zero. */
864 p->infd = -1;
865 p->outfd = -1;
866 for (int i = 0; i < PROCESS_OPEN_FDS; i++)
867 p->open_fd[i] = -1;
869 #ifdef HAVE_GNUTLS
870 verify (GNUTLS_STAGE_EMPTY == 0);
871 eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
872 eassert (NILP (p->gnutls_boot_parameters));
873 #endif
875 /* If name is already in use, modify it until it is unused. */
877 Lisp_Object name1 = name;
878 for (printmax_t i = 1; ; i++)
880 Lisp_Object tem = Fget_process (name1);
881 if (NILP (tem))
882 break;
883 char const suffix_fmt[] = "<%"pMd">";
884 char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
885 AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
886 name1 = concat2 (name, lsuffix);
888 name = name1;
889 pset_name (p, name);
890 pset_sentinel (p, Qinternal_default_process_sentinel);
891 pset_filter (p, Qinternal_default_process_filter);
892 Lisp_Object val;
893 XSETPROCESS (val, p);
894 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
895 return val;
898 static void
899 remove_process (register Lisp_Object proc)
901 register Lisp_Object pair;
903 pair = Frassq (proc, Vprocess_alist);
904 Vprocess_alist = Fdelq (pair, Vprocess_alist);
906 deactivate_process (proc);
909 void
910 update_processes_for_thread_death (Lisp_Object dying_thread)
912 Lisp_Object pair;
914 for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
916 Lisp_Object process = XCDR (XCAR (pair));
917 if (EQ (XPROCESS (process)->thread, dying_thread))
919 struct Lisp_Process *proc = XPROCESS (process);
921 pset_thread (proc, Qnil);
922 if (proc->infd >= 0)
923 fd_callback_info[proc->infd].thread = NULL;
924 if (proc->outfd >= 0)
925 fd_callback_info[proc->outfd].thread = NULL;
930 #ifdef HAVE_GETADDRINFO_A
931 static void
932 free_dns_request (Lisp_Object proc)
934 struct Lisp_Process *p = XPROCESS (proc);
936 if (p->dns_request->ar_result)
937 freeaddrinfo (p->dns_request->ar_result);
938 xfree (p->dns_request);
939 p->dns_request = NULL;
941 #endif
944 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
945 doc: /* Return t if OBJECT is a process. */)
946 (Lisp_Object object)
948 return PROCESSP (object) ? Qt : Qnil;
951 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
952 doc: /* Return the process named NAME, or nil if there is none. */)
953 (register Lisp_Object name)
955 if (PROCESSP (name))
956 return name;
957 CHECK_STRING (name);
958 return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
961 /* This is how commands for the user decode process arguments. It
962 accepts a process, a process name, a buffer, a buffer name, or nil.
963 Buffers denote the first process in the buffer, and nil denotes the
964 current buffer. */
966 static Lisp_Object
967 get_process (register Lisp_Object name)
969 register Lisp_Object proc, obj;
970 if (STRINGP (name))
972 obj = Fget_process (name);
973 if (NILP (obj))
974 obj = Fget_buffer (name);
975 if (NILP (obj))
976 error ("Process %s does not exist", SDATA (name));
978 else if (NILP (name))
979 obj = Fcurrent_buffer ();
980 else
981 obj = name;
983 /* Now obj should be either a buffer object or a process object. */
984 if (BUFFERP (obj))
986 if (NILP (BVAR (XBUFFER (obj), name)))
987 error ("Attempt to get process for a dead buffer");
988 proc = Fget_buffer_process (obj);
989 if (NILP (proc))
990 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
992 else
994 CHECK_PROCESS (obj);
995 proc = obj;
997 return proc;
1001 /* Fdelete_process promises to immediately forget about the process, but in
1002 reality, Emacs needs to remember those processes until they have been
1003 treated by the SIGCHLD handler and waitpid has been invoked on them;
1004 otherwise they might fill up the kernel's process table.
1006 Some processes created by call-process are also put onto this list.
1008 Members of this list are (process-ID . filename) pairs. The
1009 process-ID is a number; the filename, if a string, is a file that
1010 needs to be removed after the process exits. */
1011 static Lisp_Object deleted_pid_list;
1013 void
1014 record_deleted_pid (pid_t pid, Lisp_Object filename)
1016 deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
1017 /* GC treated elements set to nil. */
1018 Fdelq (Qnil, deleted_pid_list));
1022 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
1023 doc: /* Delete PROCESS: kill it and forget about it immediately.
1024 PROCESS may be a process, a buffer, the name of a process or buffer, or
1025 nil, indicating the current buffer's process. */)
1026 (register Lisp_Object process)
1028 register struct Lisp_Process *p;
1030 process = get_process (process);
1031 p = XPROCESS (process);
1033 #ifdef HAVE_GETADDRINFO_A
1034 if (p->dns_request)
1036 /* Cancel the request. Unless shutting down, wait until
1037 completion. Free the request if completely canceled. */
1039 bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
1040 if (!canceled && !inhibit_sentinels)
1042 struct gaicb const *req = p->dns_request;
1043 while (gai_suspend (&req, 1, NULL) != 0)
1044 continue;
1045 canceled = true;
1047 if (canceled)
1048 free_dns_request (process);
1050 #endif
1052 p->raw_status_new = 0;
1053 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1055 pset_status (p, list2 (Qexit, make_number (0)));
1056 p->tick = ++process_tick;
1057 status_notify (p, NULL);
1058 redisplay_preserve_echo_area (13);
1060 else
1062 if (p->alive)
1063 record_kill_process (p, Qnil);
1065 if (p->infd >= 0)
1067 /* Update P's status, since record_kill_process will make the
1068 SIGCHLD handler update deleted_pid_list, not *P. */
1069 Lisp_Object symbol;
1070 if (p->raw_status_new)
1071 update_status (p);
1072 symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
1073 if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
1074 pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
1076 p->tick = ++process_tick;
1077 status_notify (p, NULL);
1078 redisplay_preserve_echo_area (13);
1081 remove_process (process);
1082 return Qnil;
1085 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
1086 doc: /* Return the status of PROCESS.
1087 The returned value is one of the following symbols:
1088 run -- for a process that is running.
1089 stop -- for a process stopped but continuable.
1090 exit -- for a process that has exited.
1091 signal -- for a process that has got a fatal signal.
1092 open -- for a network stream connection that is open.
1093 listen -- for a network stream server that is listening.
1094 closed -- for a network stream connection that is closed.
1095 connect -- when waiting for a non-blocking connection to complete.
1096 failed -- when a non-blocking connection has failed.
1097 nil -- if arg is a process name and no such process exists.
1098 PROCESS may be a process, a buffer, the name of a process, or
1099 nil, indicating the current buffer's process. */)
1100 (register Lisp_Object process)
1102 register struct Lisp_Process *p;
1103 register Lisp_Object status;
1105 if (STRINGP (process))
1106 process = Fget_process (process);
1107 else
1108 process = get_process (process);
1110 if (NILP (process))
1111 return process;
1113 p = XPROCESS (process);
1114 if (p->raw_status_new)
1115 update_status (p);
1116 status = p->status;
1117 if (CONSP (status))
1118 status = XCAR (status);
1119 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1121 if (EQ (status, Qexit))
1122 status = Qclosed;
1123 else if (EQ (p->command, Qt))
1124 status = Qstop;
1125 else if (EQ (status, Qrun))
1126 status = Qopen;
1128 return status;
1131 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1132 1, 1, 0,
1133 doc: /* Return the exit status of PROCESS or the signal number that killed it.
1134 If PROCESS has not yet exited or died, return 0. */)
1135 (register Lisp_Object process)
1137 CHECK_PROCESS (process);
1138 if (XPROCESS (process)->raw_status_new)
1139 update_status (XPROCESS (process));
1140 if (CONSP (XPROCESS (process)->status))
1141 return XCAR (XCDR (XPROCESS (process)->status));
1142 return make_number (0);
1145 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
1146 doc: /* Return the process id of PROCESS.
1147 This is the pid of the external process which PROCESS uses or talks to.
1148 For a network, serial, and pipe connections, this value is nil. */)
1149 (register Lisp_Object process)
1151 pid_t pid;
1153 CHECK_PROCESS (process);
1154 pid = XPROCESS (process)->pid;
1155 return (pid ? make_fixnum_or_float (pid) : Qnil);
1158 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
1159 doc: /* Return the name of PROCESS, as a string.
1160 This is the name of the program invoked in PROCESS,
1161 possibly modified to make it unique among process names. */)
1162 (register Lisp_Object process)
1164 CHECK_PROCESS (process);
1165 return XPROCESS (process)->name;
1168 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
1169 doc: /* Return the command that was executed to start PROCESS.
1170 This is a list of strings, the first string being the program executed
1171 and the rest of the strings being the arguments given to it.
1172 For a network or serial or pipe connection, this is nil (process is running)
1173 or t (process is stopped). */)
1174 (register Lisp_Object process)
1176 CHECK_PROCESS (process);
1177 return XPROCESS (process)->command;
1180 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
1181 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
1182 This is the terminal that the process itself reads and writes on,
1183 not the name of the pty that Emacs uses to talk with that terminal. */)
1184 (register Lisp_Object process)
1186 CHECK_PROCESS (process);
1187 return XPROCESS (process)->tty_name;
1190 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
1191 2, 2, 0,
1192 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1193 Return BUFFER. */)
1194 (register Lisp_Object process, Lisp_Object buffer)
1196 struct Lisp_Process *p;
1198 CHECK_PROCESS (process);
1199 if (!NILP (buffer))
1200 CHECK_BUFFER (buffer);
1201 p = XPROCESS (process);
1202 pset_buffer (p, buffer);
1203 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1204 pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
1205 setup_process_coding_systems (process);
1206 return buffer;
1209 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1210 1, 1, 0,
1211 doc: /* Return the buffer PROCESS is associated with.
1212 The default process filter inserts output from PROCESS into this buffer. */)
1213 (register Lisp_Object process)
1215 CHECK_PROCESS (process);
1216 return XPROCESS (process)->buffer;
1219 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1220 1, 1, 0,
1221 doc: /* Return the marker for the end of the last output from PROCESS. */)
1222 (register Lisp_Object process)
1224 CHECK_PROCESS (process);
1225 return XPROCESS (process)->mark;
1228 static void
1229 set_process_filter_masks (struct Lisp_Process *p)
1231 if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
1232 delete_read_fd (p->infd);
1233 else if (EQ (p->filter, Qt)
1234 /* Network or serial process not stopped: */
1235 && !EQ (p->command, Qt))
1236 add_process_read_fd (p->infd);
1239 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1240 2, 2, 0,
1241 doc: /* Give PROCESS the filter function FILTER; nil means default.
1242 A value of t means stop accepting output from the process.
1244 When a process has a non-default filter, its buffer is not used for output.
1245 Instead, each time it does output, the entire string of output is
1246 passed to the filter.
1248 The filter gets two arguments: the process and the string of output.
1249 The string argument is normally a multibyte string, except:
1250 - if the process's input coding system is no-conversion or raw-text,
1251 it is a unibyte string (the non-converted input). */)
1252 (Lisp_Object process, Lisp_Object filter)
1254 CHECK_PROCESS (process);
1255 struct Lisp_Process *p = XPROCESS (process);
1257 /* Don't signal an error if the process's input file descriptor
1258 is closed. This could make debugging Lisp more difficult,
1259 for example when doing something like
1261 (setq process (start-process ...))
1262 (debug)
1263 (set-process-filter process ...) */
1265 if (NILP (filter))
1266 filter = Qinternal_default_process_filter;
1268 pset_filter (p, filter);
1270 if (p->infd >= 0)
1271 set_process_filter_masks (p);
1273 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1274 pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
1275 setup_process_coding_systems (process);
1276 return filter;
1279 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1280 1, 1, 0,
1281 doc: /* Return the filter function of PROCESS.
1282 See `set-process-filter' for more info on filter functions. */)
1283 (register Lisp_Object process)
1285 CHECK_PROCESS (process);
1286 return XPROCESS (process)->filter;
1289 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1290 2, 2, 0,
1291 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1292 The sentinel is called as a function when the process changes state.
1293 It gets two arguments: the process, and a string describing the change. */)
1294 (register Lisp_Object process, Lisp_Object sentinel)
1296 struct Lisp_Process *p;
1298 CHECK_PROCESS (process);
1299 p = XPROCESS (process);
1301 if (NILP (sentinel))
1302 sentinel = Qinternal_default_process_sentinel;
1304 pset_sentinel (p, sentinel);
1305 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1306 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
1307 return sentinel;
1310 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1311 1, 1, 0,
1312 doc: /* Return the sentinel of PROCESS.
1313 See `set-process-sentinel' for more info on sentinels. */)
1314 (register Lisp_Object process)
1316 CHECK_PROCESS (process);
1317 return XPROCESS (process)->sentinel;
1320 DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread,
1321 2, 2, 0,
1322 doc: /* Set the locking thread of PROCESS to be THREAD.
1323 If THREAD is nil, the process is unlocked. */)
1324 (Lisp_Object process, Lisp_Object thread)
1326 struct Lisp_Process *proc;
1327 struct thread_state *tstate;
1329 CHECK_PROCESS (process);
1330 if (NILP (thread))
1331 tstate = NULL;
1332 else
1334 CHECK_THREAD (thread);
1335 tstate = XTHREAD (thread);
1338 proc = XPROCESS (process);
1339 pset_thread (proc, thread);
1340 if (proc->infd >= 0)
1341 fd_callback_info[proc->infd].thread = tstate;
1342 if (proc->outfd >= 0)
1343 fd_callback_info[proc->outfd].thread = tstate;
1345 return thread;
1348 DEFUN ("process-thread", Fprocess_thread, Sprocess_thread,
1349 1, 1, 0,
1350 doc: /* Ret the locking thread of PROCESS.
1351 If PROCESS is unlocked, this function returns nil. */)
1352 (Lisp_Object process)
1354 CHECK_PROCESS (process);
1355 return XPROCESS (process)->thread;
1358 DEFUN ("set-process-window-size", Fset_process_window_size,
1359 Sset_process_window_size, 3, 3, 0,
1360 doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1361 Value is t if PROCESS was successfully told about the window size,
1362 nil otherwise. */)
1363 (Lisp_Object process, Lisp_Object height, Lisp_Object width)
1365 CHECK_PROCESS (process);
1367 /* All known platforms store window sizes as 'unsigned short'. */
1368 CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
1369 CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
1371 if (NETCONN_P (process)
1372 || XPROCESS (process)->infd < 0
1373 || (set_window_size (XPROCESS (process)->infd,
1374 XINT (height), XINT (width))
1375 < 0))
1376 return Qnil;
1377 else
1378 return Qt;
1381 DEFUN ("set-process-inherit-coding-system-flag",
1382 Fset_process_inherit_coding_system_flag,
1383 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1384 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1385 If the second argument FLAG is non-nil, then the variable
1386 `buffer-file-coding-system' of the buffer associated with PROCESS
1387 will be bound to the value of the coding system used to decode
1388 the process output.
1390 This is useful when the coding system specified for the process buffer
1391 leaves either the character code conversion or the end-of-line conversion
1392 unspecified, or if the coding system used to decode the process output
1393 is more appropriate for saving the process buffer.
1395 Binding the variable `inherit-process-coding-system' to non-nil before
1396 starting the process is an alternative way of setting the inherit flag
1397 for the process which will run.
1399 This function returns FLAG. */)
1400 (register Lisp_Object process, Lisp_Object flag)
1402 CHECK_PROCESS (process);
1403 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1404 return flag;
1407 DEFUN ("set-process-query-on-exit-flag",
1408 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1409 2, 2, 0,
1410 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1411 If the second argument FLAG is non-nil, Emacs will query the user before
1412 exiting or killing a buffer if PROCESS is running. This function
1413 returns FLAG. */)
1414 (register Lisp_Object process, Lisp_Object flag)
1416 CHECK_PROCESS (process);
1417 XPROCESS (process)->kill_without_query = NILP (flag);
1418 return flag;
1421 DEFUN ("process-query-on-exit-flag",
1422 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1423 1, 1, 0,
1424 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1425 (register Lisp_Object process)
1427 CHECK_PROCESS (process);
1428 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1431 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1432 1, 2, 0,
1433 doc: /* Return the contact info of PROCESS; t for a real child.
1434 For a network or serial or pipe connection, the value depends on the
1435 optional KEY arg. If KEY is nil, value is a cons cell of the form
1436 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1437 connection; it is t for a pipe connection. If KEY is t, the complete
1438 contact information for the connection is returned, else the specific
1439 value for the keyword KEY is returned. See `make-network-process',
1440 `make-serial-process', or `make-pipe-process' for the list of keywords.
1441 If PROCESS is a non-blocking network process that hasn't been fully
1442 set up yet, this function will block until socket setup has completed. */)
1443 (Lisp_Object process, Lisp_Object key)
1445 Lisp_Object contact;
1447 CHECK_PROCESS (process);
1448 contact = XPROCESS (process)->childp;
1450 #ifdef DATAGRAM_SOCKETS
1452 if (NETCONN_P (process))
1453 wait_for_socket_fds (process, "process-contact");
1455 if (DATAGRAM_CONN_P (process)
1456 && (EQ (key, Qt) || EQ (key, QCremote)))
1457 contact = Fplist_put (contact, QCremote,
1458 Fprocess_datagram_address (process));
1459 #endif
1461 if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
1462 || EQ (key, Qt))
1463 return contact;
1464 if (NILP (key) && NETCONN_P (process))
1465 return list2 (Fplist_get (contact, QChost),
1466 Fplist_get (contact, QCservice));
1467 if (NILP (key) && SERIALCONN_P (process))
1468 return list2 (Fplist_get (contact, QCport),
1469 Fplist_get (contact, QCspeed));
1470 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1471 if the pipe process is useful for purposes other than receiving
1472 stderr. */
1473 if (NILP (key) && PIPECONN_P (process))
1474 return Qt;
1475 return Fplist_get (contact, key);
1478 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1479 1, 1, 0,
1480 doc: /* Return the plist of PROCESS. */)
1481 (register Lisp_Object process)
1483 CHECK_PROCESS (process);
1484 return XPROCESS (process)->plist;
1487 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1488 2, 2, 0,
1489 doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1490 (Lisp_Object process, Lisp_Object plist)
1492 CHECK_PROCESS (process);
1493 CHECK_LIST (plist);
1495 pset_plist (XPROCESS (process), plist);
1496 return plist;
1499 #if 0 /* Turned off because we don't currently record this info
1500 in the process. Perhaps add it. */
1501 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1502 doc: /* Return the connection type of PROCESS.
1503 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1504 a socket connection. */)
1505 (Lisp_Object process)
1507 return XPROCESS (process)->type;
1509 #endif
1511 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1512 doc: /* Return the connection type of PROCESS.
1513 The value is either the symbol `real', `network', `serial', or `pipe'.
1514 PROCESS may be a process, a buffer, the name of a process or buffer, or
1515 nil, indicating the current buffer's process. */)
1516 (Lisp_Object process)
1518 Lisp_Object proc;
1519 proc = get_process (process);
1520 return XPROCESS (proc)->type;
1523 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1524 1, 2, 0,
1525 doc: /* Convert network ADDRESS from internal format to a string.
1526 A 4 or 5 element vector represents an IPv4 address (with port number).
1527 An 8 or 9 element vector represents an IPv6 address (with port number).
1528 If optional second argument OMIT-PORT is non-nil, don't include a port
1529 number in the string, even when present in ADDRESS.
1530 Return nil if format of ADDRESS is invalid. */)
1531 (Lisp_Object address, Lisp_Object omit_port)
1533 if (NILP (address))
1534 return Qnil;
1536 if (STRINGP (address)) /* AF_LOCAL */
1537 return address;
1539 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1541 register struct Lisp_Vector *p = XVECTOR (address);
1542 ptrdiff_t size = p->header.size;
1543 Lisp_Object args[10];
1544 int nargs, i;
1545 char const *format;
1547 if (size == 4 || (size == 5 && !NILP (omit_port)))
1549 format = "%d.%d.%d.%d";
1550 nargs = 4;
1552 else if (size == 5)
1554 format = "%d.%d.%d.%d:%d";
1555 nargs = 5;
1557 else if (size == 8 || (size == 9 && !NILP (omit_port)))
1559 format = "%x:%x:%x:%x:%x:%x:%x:%x";
1560 nargs = 8;
1562 else if (size == 9)
1564 format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1565 nargs = 9;
1567 else
1568 return Qnil;
1570 AUTO_STRING (format_obj, format);
1571 args[0] = format_obj;
1573 for (i = 0; i < nargs; i++)
1575 if (! RANGED_INTEGERP (0, p->contents[i], 65535))
1576 return Qnil;
1578 if (nargs <= 5 /* IPv4 */
1579 && i < 4 /* host, not port */
1580 && XINT (p->contents[i]) > 255)
1581 return Qnil;
1583 args[i + 1] = p->contents[i];
1586 return Fformat (nargs + 1, args);
1589 if (CONSP (address))
1591 AUTO_STRING (format, "<Family %d>");
1592 return CALLN (Fformat, format, Fcar (address));
1595 return Qnil;
1598 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1599 doc: /* Return a list of all processes that are Emacs sub-processes. */)
1600 (void)
1602 return Fmapcar (Qcdr, Vprocess_alist);
1605 /* Starting asynchronous inferior processes. */
1607 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
1608 doc: /* Start a program in a subprocess. Return the process object for it.
1610 This is similar to `start-process', but arguments are specified as
1611 keyword/argument pairs. The following arguments are defined:
1613 :name NAME -- NAME is name for process. It is modified if necessary
1614 to make it unique.
1616 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1617 with the process. Process output goes at end of that buffer, unless
1618 you specify an output stream or filter function to handle the output.
1619 BUFFER may be also nil, meaning that this process is not associated
1620 with any buffer.
1622 :command COMMAND -- COMMAND is a list starting with the program file
1623 name, followed by strings to give to the program as arguments.
1625 :coding CODING -- If CODING is a symbol, it specifies the coding
1626 system used for both reading and writing for this process. If CODING
1627 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1628 ENCODING is used for writing.
1630 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1631 the process is running. If BOOL is not given, query before exiting.
1633 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1634 In the stopped state, a process does not accept incoming data, but you
1635 can send outgoing data. The stopped state is cleared by
1636 `continue-process' and set by `stop-process'.
1638 :connection-type TYPE -- TYPE is control type of device used to
1639 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1640 to use a pty, or nil to use the default specified through
1641 `process-connection-type'.
1643 :filter FILTER -- Install FILTER as the process filter.
1645 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1647 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1648 to the standard error of subprocess. Specifying this implies
1649 `:connection-type' is set to `pipe'.
1651 usage: (make-process &rest ARGS) */)
1652 (ptrdiff_t nargs, Lisp_Object *args)
1654 Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
1655 Lisp_Object xstderr, stderrproc;
1656 ptrdiff_t count = SPECPDL_INDEX ();
1658 if (nargs == 0)
1659 return Qnil;
1661 /* Save arguments for process-contact and clone-process. */
1662 contact = Flist (nargs, args);
1664 buffer = Fplist_get (contact, QCbuffer);
1665 if (!NILP (buffer))
1666 buffer = Fget_buffer_create (buffer);
1668 /* Make sure that the child will be able to chdir to the current
1669 buffer's current directory, or its unhandled equivalent. We
1670 can't just have the child check for an error when it does the
1671 chdir, since it's in a vfork. */
1672 current_dir = encode_current_directory ();
1674 name = Fplist_get (contact, QCname);
1675 CHECK_STRING (name);
1677 command = Fplist_get (contact, QCcommand);
1678 if (CONSP (command))
1679 program = XCAR (command);
1680 else
1681 program = Qnil;
1683 if (!NILP (program))
1684 CHECK_STRING (program);
1686 bool query_on_exit = NILP (Fplist_get (contact, QCnoquery));
1688 stderrproc = Qnil;
1689 xstderr = Fplist_get (contact, QCstderr);
1690 if (PROCESSP (xstderr))
1692 if (!PIPECONN_P (xstderr))
1693 error ("Process is not a pipe process");
1694 stderrproc = xstderr;
1696 else if (!NILP (xstderr))
1698 CHECK_STRING (program);
1699 stderrproc = CALLN (Fmake_pipe_process,
1700 QCname,
1701 concat2 (name, build_string (" stderr")),
1702 QCbuffer,
1703 Fget_buffer_create (xstderr),
1704 QCnoquery,
1705 query_on_exit ? Qnil : Qt);
1708 proc = make_process (name);
1709 record_unwind_protect (start_process_unwind, proc);
1711 pset_childp (XPROCESS (proc), Qt);
1712 eassert (NILP (XPROCESS (proc)->plist));
1713 pset_type (XPROCESS (proc), Qreal);
1714 pset_buffer (XPROCESS (proc), buffer);
1715 pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
1716 pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
1717 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1719 if (!query_on_exit)
1720 XPROCESS (proc)->kill_without_query = 1;
1721 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
1722 pset_command (XPROCESS (proc), Qt);
1724 tem = Fplist_get (contact, QCconnection_type);
1725 if (EQ (tem, Qpty))
1726 XPROCESS (proc)->pty_flag = true;
1727 else if (EQ (tem, Qpipe))
1728 XPROCESS (proc)->pty_flag = false;
1729 else if (NILP (tem))
1730 XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
1731 else
1732 report_file_error ("Unknown connection type", tem);
1734 if (!NILP (stderrproc))
1736 pset_stderrproc (XPROCESS (proc), stderrproc);
1738 XPROCESS (proc)->pty_flag = false;
1741 #ifdef HAVE_GNUTLS
1742 /* AKA GNUTLS_INITSTAGE(proc). */
1743 verify (GNUTLS_STAGE_EMPTY == 0);
1744 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1745 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1746 #endif
1748 XPROCESS (proc)->adaptive_read_buffering
1749 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1750 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1752 /* Make the process marker point into the process buffer (if any). */
1753 if (BUFFERP (buffer))
1754 set_marker_both (XPROCESS (proc)->mark, buffer,
1755 BUF_ZV (XBUFFER (buffer)),
1756 BUF_ZV_BYTE (XBUFFER (buffer)));
1758 USE_SAFE_ALLOCA;
1761 /* Decide coding systems for communicating with the process. Here
1762 we don't setup the structure coding_system nor pay attention to
1763 unibyte mode. They are done in create_process. */
1765 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1766 Lisp_Object coding_systems = Qt;
1767 Lisp_Object val, *args2;
1769 tem = Fplist_get (contact, QCcoding);
1770 if (!NILP (tem))
1772 val = tem;
1773 if (CONSP (val))
1774 val = XCAR (val);
1776 else
1777 val = Vcoding_system_for_read;
1778 if (NILP (val))
1780 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1781 Lisp_Object tem2;
1782 SAFE_ALLOCA_LISP (args2, nargs2);
1783 ptrdiff_t i = 0;
1784 args2[i++] = Qstart_process;
1785 args2[i++] = name;
1786 args2[i++] = buffer;
1787 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1788 args2[i++] = XCAR (tem2);
1789 if (!NILP (program))
1790 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1791 if (CONSP (coding_systems))
1792 val = XCAR (coding_systems);
1793 else if (CONSP (Vdefault_process_coding_system))
1794 val = XCAR (Vdefault_process_coding_system);
1796 pset_decode_coding_system (XPROCESS (proc), val);
1798 if (!NILP (tem))
1800 val = tem;
1801 if (CONSP (val))
1802 val = XCDR (val);
1804 else
1805 val = Vcoding_system_for_write;
1806 if (NILP (val))
1808 if (EQ (coding_systems, Qt))
1810 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1811 Lisp_Object tem2;
1812 SAFE_ALLOCA_LISP (args2, nargs2);
1813 ptrdiff_t i = 0;
1814 args2[i++] = Qstart_process;
1815 args2[i++] = name;
1816 args2[i++] = buffer;
1817 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1818 args2[i++] = XCAR (tem2);
1819 if (!NILP (program))
1820 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1822 if (CONSP (coding_systems))
1823 val = XCDR (coding_systems);
1824 else if (CONSP (Vdefault_process_coding_system))
1825 val = XCDR (Vdefault_process_coding_system);
1827 pset_encode_coding_system (XPROCESS (proc), val);
1828 /* Note: At this moment, the above coding system may leave
1829 text-conversion or eol-conversion unspecified. They will be
1830 decided after we read output from the process and decode it by
1831 some coding system, or just before we actually send a text to
1832 the process. */
1836 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1837 eassert (XPROCESS (proc)->decoding_carryover == 0);
1838 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1840 XPROCESS (proc)->inherit_coding_system_flag
1841 = !(NILP (buffer) || !inherit_process_coding_system);
1843 if (!NILP (program))
1845 Lisp_Object program_args = XCDR (command);
1847 /* If program file name is not absolute, search our path for it.
1848 Put the name we will really use in TEM. */
1849 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1850 && !(SCHARS (program) > 1
1851 && IS_DEVICE_SEP (SREF (program, 1))))
1853 tem = Qnil;
1854 openp (Vexec_path, program, Vexec_suffixes, &tem,
1855 make_number (X_OK), false);
1856 if (NILP (tem))
1857 report_file_error ("Searching for program", program);
1858 tem = Fexpand_file_name (tem, Qnil);
1860 else
1862 if (!NILP (Ffile_directory_p (program)))
1863 error ("Specified program for new process is a directory");
1864 tem = program;
1867 /* Remove "/:" from TEM. */
1868 tem = remove_slash_colon (tem);
1870 Lisp_Object arg_encoding = Qnil;
1872 /* Encode the file name and put it in NEW_ARGV.
1873 That's where the child will use it to execute the program. */
1874 tem = list1 (ENCODE_FILE (tem));
1875 ptrdiff_t new_argc = 1;
1877 /* Here we encode arguments by the coding system used for sending
1878 data to the process. We don't support using different coding
1879 systems for encoding arguments and for encoding data sent to the
1880 process. */
1882 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
1884 Lisp_Object arg = XCAR (tem2);
1885 CHECK_STRING (arg);
1886 if (STRING_MULTIBYTE (arg))
1888 if (NILP (arg_encoding))
1889 arg_encoding = (complement_process_encoding_system
1890 (XPROCESS (proc)->encode_coding_system));
1891 arg = code_convert_string_norecord (arg, arg_encoding, 1);
1893 tem = Fcons (arg, tem);
1894 new_argc++;
1897 /* Now that everything is encoded we can collect the strings into
1898 NEW_ARGV. */
1899 char **new_argv;
1900 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
1901 new_argv[new_argc] = 0;
1903 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
1905 new_argv[i] = SSDATA (XCAR (tem));
1906 tem = XCDR (tem);
1909 create_process (proc, new_argv, current_dir);
1911 else
1912 create_pty (proc);
1914 SAFE_FREE ();
1915 return unbind_to (count, proc);
1918 /* If PROC doesn't have its pid set, then an error was signaled and
1919 the process wasn't started successfully, so remove it. */
1920 static void
1921 start_process_unwind (Lisp_Object proc)
1923 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1924 remove_process (proc);
1927 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1929 static void
1930 close_process_fd (int *fd_addr)
1932 int fd = *fd_addr;
1933 if (0 <= fd)
1935 *fd_addr = -1;
1936 emacs_close (fd);
1940 /* Indexes of file descriptors in open_fds. */
1941 enum
1943 /* The pipe from Emacs to its subprocess. */
1944 SUBPROCESS_STDIN,
1945 WRITE_TO_SUBPROCESS,
1947 /* The main pipe from the subprocess to Emacs. */
1948 READ_FROM_SUBPROCESS,
1949 SUBPROCESS_STDOUT,
1951 /* The pipe from the subprocess to Emacs that is closed when the
1952 subprocess execs. */
1953 READ_FROM_EXEC_MONITOR,
1954 EXEC_MONITOR_OUTPUT
1957 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
1959 static void
1960 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1962 struct Lisp_Process *p = XPROCESS (process);
1963 int inchannel, outchannel;
1964 pid_t pid;
1965 int vfork_errno;
1966 int forkin, forkout, forkerr = -1;
1967 bool pty_flag = 0;
1968 char pty_name[PTY_NAME_SIZE];
1969 Lisp_Object lisp_pty_name = Qnil;
1970 sigset_t oldset;
1972 inchannel = outchannel = -1;
1974 if (p->pty_flag)
1975 outchannel = inchannel = allocate_pty (pty_name);
1977 if (inchannel >= 0)
1979 p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
1980 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1981 /* On most USG systems it does not work to open the pty's tty here,
1982 then close it and reopen it in the child. */
1983 /* Don't let this terminal become our controlling terminal
1984 (in case we don't have one). */
1985 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1986 if (forkin < 0)
1987 report_file_error ("Opening pty", Qnil);
1988 p->open_fd[SUBPROCESS_STDIN] = forkin;
1989 #else
1990 forkin = forkout = -1;
1991 #endif /* not USG, or USG_SUBTTY_WORKS */
1992 pty_flag = 1;
1993 lisp_pty_name = build_string (pty_name);
1995 else
1997 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
1998 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
1999 report_file_error ("Creating pipe", Qnil);
2000 forkin = p->open_fd[SUBPROCESS_STDIN];
2001 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2002 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2003 forkout = p->open_fd[SUBPROCESS_STDOUT];
2005 if (!NILP (p->stderrproc))
2007 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2009 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2011 /* Close unnecessary file descriptors. */
2012 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2013 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2017 #ifndef WINDOWSNT
2018 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2019 report_file_error ("Creating pipe", Qnil);
2020 #endif
2022 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2023 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2025 /* Record this as an active process, with its channels. */
2026 chan_process[inchannel] = process;
2027 p->infd = inchannel;
2028 p->outfd = outchannel;
2030 /* Previously we recorded the tty descriptor used in the subprocess.
2031 It was only used for getting the foreground tty process, so now
2032 we just reopen the device (see emacs_get_tty_pgrp) as this is
2033 more portable (see USG_SUBTTY_WORKS above). */
2035 p->pty_flag = pty_flag;
2036 pset_status (p, Qrun);
2038 if (!EQ (p->command, Qt))
2039 add_process_read_fd (inchannel);
2041 /* This may signal an error. */
2042 setup_process_coding_systems (process);
2044 block_input ();
2045 block_child_signal (&oldset);
2047 #ifndef WINDOWSNT
2048 /* vfork, and prevent local vars from being clobbered by the vfork. */
2049 Lisp_Object volatile current_dir_volatile = current_dir;
2050 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
2051 char **volatile new_argv_volatile = new_argv;
2052 int volatile forkin_volatile = forkin;
2053 int volatile forkout_volatile = forkout;
2054 int volatile forkerr_volatile = forkerr;
2055 struct Lisp_Process *p_volatile = p;
2057 #ifdef DARWIN_OS
2058 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2059 necessary. Also, reset SIGCHLD handling after a vfork, as
2060 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2061 if (pty_flag)
2062 pid = fork ();
2063 else
2065 pid = vfork ();
2066 if (pid == 0)
2067 signal (SIGCHLD, SIG_DFL);
2069 #else
2070 pid = vfork ();
2071 #endif
2073 current_dir = current_dir_volatile;
2074 lisp_pty_name = lisp_pty_name_volatile;
2075 new_argv = new_argv_volatile;
2076 forkin = forkin_volatile;
2077 forkout = forkout_volatile;
2078 forkerr = forkerr_volatile;
2079 p = p_volatile;
2081 pty_flag = p->pty_flag;
2083 if (pid == 0)
2084 #endif /* not WINDOWSNT */
2086 /* Make the pty be the controlling terminal of the process. */
2087 #ifdef HAVE_PTYS
2088 /* First, disconnect its current controlling terminal. */
2089 if (pty_flag)
2090 setsid ();
2091 /* Make the pty's terminal the controlling terminal. */
2092 if (pty_flag && forkin >= 0)
2094 #ifdef TIOCSCTTY
2095 /* We ignore the return value
2096 because faith@cs.unc.edu says that is necessary on Linux. */
2097 ioctl (forkin, TIOCSCTTY, 0);
2098 #endif
2100 #if defined (LDISC1)
2101 if (pty_flag && forkin >= 0)
2103 struct termios t;
2104 tcgetattr (forkin, &t);
2105 t.c_lflag = LDISC1;
2106 if (tcsetattr (forkin, TCSANOW, &t) < 0)
2107 emacs_perror ("create_process/tcsetattr LDISC1");
2109 #else
2110 #if defined (NTTYDISC) && defined (TIOCSETD)
2111 if (pty_flag && forkin >= 0)
2113 /* Use new line discipline. */
2114 int ldisc = NTTYDISC;
2115 ioctl (forkin, TIOCSETD, &ldisc);
2117 #endif
2118 #endif
2119 #ifdef TIOCNOTTY
2120 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2121 can do TIOCSPGRP only to the process's controlling tty. */
2122 if (pty_flag)
2124 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2125 I can't test it since I don't have 4.3. */
2126 int j = emacs_open (DEV_TTY, O_RDWR, 0);
2127 if (j >= 0)
2129 ioctl (j, TIOCNOTTY, 0);
2130 emacs_close (j);
2133 #endif /* TIOCNOTTY */
2135 #if !defined (DONT_REOPEN_PTY)
2136 /*** There is a suggestion that this ought to be a
2137 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2138 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2139 that system does seem to need this code, even though
2140 both TIOCSCTTY is defined. */
2141 /* Now close the pty (if we had it open) and reopen it.
2142 This makes the pty the controlling terminal of the subprocess. */
2143 if (pty_flag)
2146 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2147 would work? */
2148 if (forkin >= 0)
2149 emacs_close (forkin);
2150 forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
2152 if (forkin < 0)
2154 emacs_perror (SSDATA (lisp_pty_name));
2155 _exit (EXIT_CANCELED);
2159 #endif /* not DONT_REOPEN_PTY */
2161 #ifdef SETUP_SLAVE_PTY
2162 if (pty_flag)
2164 SETUP_SLAVE_PTY;
2166 #endif /* SETUP_SLAVE_PTY */
2167 #endif /* HAVE_PTYS */
2169 signal (SIGINT, SIG_DFL);
2170 signal (SIGQUIT, SIG_DFL);
2171 #ifdef SIGPROF
2172 signal (SIGPROF, SIG_DFL);
2173 #endif
2175 /* Emacs ignores SIGPIPE, but the child should not. */
2176 signal (SIGPIPE, SIG_DFL);
2178 /* Stop blocking SIGCHLD in the child. */
2179 unblock_child_signal (&oldset);
2181 if (pty_flag)
2182 child_setup_tty (forkout);
2184 if (forkerr < 0)
2185 forkerr = forkout;
2186 #ifdef WINDOWSNT
2187 pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2188 #else /* not WINDOWSNT */
2189 child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2190 #endif /* not WINDOWSNT */
2193 /* Back in the parent process. */
2195 vfork_errno = errno;
2196 p->pid = pid;
2197 if (pid >= 0)
2198 p->alive = 1;
2200 /* Stop blocking in the parent. */
2201 unblock_child_signal (&oldset);
2202 unblock_input ();
2204 if (pid < 0)
2205 report_file_errno ("Doing vfork", Qnil, vfork_errno);
2206 else
2208 /* vfork succeeded. */
2210 /* Close the pipe ends that the child uses, or the child's pty. */
2211 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2212 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2214 #ifdef WINDOWSNT
2215 register_child (pid, inchannel);
2216 #endif /* WINDOWSNT */
2218 pset_tty_name (p, lisp_pty_name);
2220 #ifndef WINDOWSNT
2221 /* Wait for child_setup to complete in case that vfork is
2222 actually defined as fork. The descriptor
2223 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2224 of a pipe is closed at the child side either by close-on-exec
2225 on successful execve or the _exit call in child_setup. */
2227 char dummy;
2229 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2230 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2231 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2233 #endif
2234 if (!NILP (p->stderrproc))
2236 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2237 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2242 static void
2243 create_pty (Lisp_Object process)
2245 struct Lisp_Process *p = XPROCESS (process);
2246 char pty_name[PTY_NAME_SIZE];
2247 int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
2249 if (pty_fd >= 0)
2251 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2252 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2253 /* On most USG systems it does not work to open the pty's tty here,
2254 then close it and reopen it in the child. */
2255 /* Don't let this terminal become our controlling terminal
2256 (in case we don't have one). */
2257 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2258 if (forkout < 0)
2259 report_file_error ("Opening pty", Qnil);
2260 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2261 #if defined (DONT_REOPEN_PTY)
2262 /* In the case that vfork is defined as fork, the parent process
2263 (Emacs) may send some data before the child process completes
2264 tty options setup. So we setup tty before forking. */
2265 child_setup_tty (forkout);
2266 #endif /* DONT_REOPEN_PTY */
2267 #endif /* not USG, or USG_SUBTTY_WORKS */
2269 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2271 /* Record this as an active process, with its channels.
2272 As a result, child_setup will close Emacs's side of the pipes. */
2273 chan_process[pty_fd] = process;
2274 p->infd = pty_fd;
2275 p->outfd = pty_fd;
2277 /* Previously we recorded the tty descriptor used in the subprocess.
2278 It was only used for getting the foreground tty process, so now
2279 we just reopen the device (see emacs_get_tty_pgrp) as this is
2280 more portable (see USG_SUBTTY_WORKS above). */
2282 p->pty_flag = 1;
2283 pset_status (p, Qrun);
2284 setup_process_coding_systems (process);
2286 add_process_read_fd (pty_fd);
2288 pset_tty_name (p, build_string (pty_name));
2291 p->pid = -2;
2294 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2295 0, MANY, 0,
2296 doc: /* Create and return a bidirectional pipe process.
2298 In Emacs, pipes are represented by process objects, so input and
2299 output work as for subprocesses, and `delete-process' closes a pipe.
2300 However, a pipe process has no process id, it cannot be signaled,
2301 and the status codes are different from normal processes.
2303 Arguments are specified as keyword/argument pairs. The following
2304 arguments are defined:
2306 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2308 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2309 with the process. Process output goes at the end of that buffer,
2310 unless you specify an output stream or filter function to handle the
2311 output. If BUFFER is not given, the value of NAME is used.
2313 :coding CODING -- If CODING is a symbol, it specifies the coding
2314 system used for both reading and writing for this process. If CODING
2315 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2316 ENCODING is used for writing.
2318 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2319 the process is running. If BOOL is not given, query before exiting.
2321 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2322 In the stopped state, a pipe process does not accept incoming data,
2323 but you can send outgoing data. The stopped state is cleared by
2324 `continue-process' and set by `stop-process'.
2326 :filter FILTER -- Install FILTER as the process filter.
2328 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2330 usage: (make-pipe-process &rest ARGS) */)
2331 (ptrdiff_t nargs, Lisp_Object *args)
2333 Lisp_Object proc, contact;
2334 struct Lisp_Process *p;
2335 Lisp_Object name, buffer;
2336 Lisp_Object tem;
2337 ptrdiff_t specpdl_count;
2338 int inchannel, outchannel;
2340 if (nargs == 0)
2341 return Qnil;
2343 contact = Flist (nargs, args);
2345 name = Fplist_get (contact, QCname);
2346 CHECK_STRING (name);
2347 proc = make_process (name);
2348 specpdl_count = SPECPDL_INDEX ();
2349 record_unwind_protect (remove_process, proc);
2350 p = XPROCESS (proc);
2352 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2353 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2354 report_file_error ("Creating pipe", Qnil);
2355 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2356 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2358 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2359 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2361 #ifdef WINDOWSNT
2362 register_aux_fd (inchannel);
2363 #endif
2365 /* Record this as an active process, with its channels. */
2366 chan_process[inchannel] = proc;
2367 p->infd = inchannel;
2368 p->outfd = outchannel;
2370 if (inchannel > max_desc)
2371 max_desc = inchannel;
2373 buffer = Fplist_get (contact, QCbuffer);
2374 if (NILP (buffer))
2375 buffer = name;
2376 buffer = Fget_buffer_create (buffer);
2377 pset_buffer (p, buffer);
2379 pset_childp (p, contact);
2380 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2381 pset_type (p, Qpipe);
2382 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2383 pset_filter (p, Fplist_get (contact, QCfilter));
2384 eassert (NILP (p->log));
2385 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2386 p->kill_without_query = 1;
2387 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2388 pset_command (p, Qt);
2389 eassert (! p->pty_flag);
2391 if (!EQ (p->command, Qt))
2392 add_process_read_fd (inchannel);
2393 p->adaptive_read_buffering
2394 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2395 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2397 /* Make the process marker point into the process buffer (if any). */
2398 if (BUFFERP (buffer))
2399 set_marker_both (p->mark, buffer,
2400 BUF_ZV (XBUFFER (buffer)),
2401 BUF_ZV_BYTE (XBUFFER (buffer)));
2404 /* Setup coding systems for communicating with the network stream. */
2406 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2407 Lisp_Object coding_systems = Qt;
2408 Lisp_Object val;
2410 tem = Fplist_get (contact, QCcoding);
2411 val = Qnil;
2412 if (!NILP (tem))
2414 val = tem;
2415 if (CONSP (val))
2416 val = XCAR (val);
2418 else if (!NILP (Vcoding_system_for_read))
2419 val = Vcoding_system_for_read;
2420 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2421 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2422 /* We dare not decode end-of-line format by setting VAL to
2423 Qraw_text, because the existing Emacs Lisp libraries
2424 assume that they receive bare code including a sequence of
2425 CR LF. */
2426 val = Qnil;
2427 else
2429 if (CONSP (coding_systems))
2430 val = XCAR (coding_systems);
2431 else if (CONSP (Vdefault_process_coding_system))
2432 val = XCAR (Vdefault_process_coding_system);
2433 else
2434 val = Qnil;
2436 pset_decode_coding_system (p, val);
2438 if (!NILP (tem))
2440 val = tem;
2441 if (CONSP (val))
2442 val = XCDR (val);
2444 else if (!NILP (Vcoding_system_for_write))
2445 val = Vcoding_system_for_write;
2446 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2447 val = Qnil;
2448 else
2450 if (CONSP (coding_systems))
2451 val = XCDR (coding_systems);
2452 else if (CONSP (Vdefault_process_coding_system))
2453 val = XCDR (Vdefault_process_coding_system);
2454 else
2455 val = Qnil;
2457 pset_encode_coding_system (p, val);
2459 /* This may signal an error. */
2460 setup_process_coding_systems (proc);
2462 specpdl_ptr = specpdl + specpdl_count;
2464 return proc;
2468 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2469 The address family of sa is not included in the result. */
2471 Lisp_Object
2472 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2474 Lisp_Object address;
2475 ptrdiff_t i;
2476 unsigned char *cp;
2477 struct Lisp_Vector *p;
2479 /* Workaround for a bug in getsockname on BSD: Names bound to
2480 sockets in the UNIX domain are inaccessible; getsockname returns
2481 a zero length name. */
2482 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2483 return empty_unibyte_string;
2485 switch (sa->sa_family)
2487 case AF_INET:
2489 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2490 len = sizeof (sin->sin_addr) + 1;
2491 address = Fmake_vector (make_number (len), Qnil);
2492 p = XVECTOR (address);
2493 p->contents[--len] = make_number (ntohs (sin->sin_port));
2494 cp = (unsigned char *) &sin->sin_addr;
2495 break;
2497 #ifdef AF_INET6
2498 case AF_INET6:
2500 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2501 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2502 len = sizeof (sin6->sin6_addr) / 2 + 1;
2503 address = Fmake_vector (make_number (len), Qnil);
2504 p = XVECTOR (address);
2505 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2506 for (i = 0; i < len; i++)
2507 p->contents[i] = make_number (ntohs (ip6[i]));
2508 return address;
2510 #endif
2511 #ifdef HAVE_LOCAL_SOCKETS
2512 case AF_LOCAL:
2514 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2515 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2516 /* If the first byte is NUL, the name is a Linux abstract
2517 socket name, and the name can contain embedded NULs. If
2518 it's not, we have a NUL-terminated string. Be careful not
2519 to walk past the end of the object looking for the name
2520 terminator, however. */
2521 if (name_length > 0 && sockun->sun_path[0] != '\0')
2523 const char *terminator
2524 = memchr (sockun->sun_path, '\0', name_length);
2526 if (terminator)
2527 name_length = terminator - (const char *) sockun->sun_path;
2530 return make_unibyte_string (sockun->sun_path, name_length);
2532 #endif
2533 default:
2534 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2535 address = Fcons (make_number (sa->sa_family),
2536 Fmake_vector (make_number (len), Qnil));
2537 p = XVECTOR (XCDR (address));
2538 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2539 break;
2542 i = 0;
2543 while (i < len)
2544 p->contents[i++] = make_number (*cp++);
2546 return address;
2549 /* Convert an internal struct addrinfo to a Lisp object. */
2551 static Lisp_Object
2552 conv_addrinfo_to_lisp (struct addrinfo *res)
2554 Lisp_Object protocol = make_number (res->ai_protocol);
2555 eassert (XINT (protocol) == res->ai_protocol);
2556 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2560 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2562 static ptrdiff_t
2563 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2565 struct Lisp_Vector *p;
2567 if (VECTORP (address))
2569 p = XVECTOR (address);
2570 if (p->header.size == 5)
2572 *familyp = AF_INET;
2573 return sizeof (struct sockaddr_in);
2575 #ifdef AF_INET6
2576 else if (p->header.size == 9)
2578 *familyp = AF_INET6;
2579 return sizeof (struct sockaddr_in6);
2581 #endif
2583 #ifdef HAVE_LOCAL_SOCKETS
2584 else if (STRINGP (address))
2586 *familyp = AF_LOCAL;
2587 return sizeof (struct sockaddr_un);
2589 #endif
2590 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2591 && VECTORP (XCDR (address)))
2593 struct sockaddr *sa;
2594 p = XVECTOR (XCDR (address));
2595 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2596 return 0;
2597 *familyp = XINT (XCAR (address));
2598 return p->header.size + sizeof (sa->sa_family);
2600 return 0;
2603 /* Convert an address object (vector or string) to an internal sockaddr.
2605 The address format has been basically validated by
2606 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2607 it could have come from user data. So if FAMILY is not valid,
2608 we return after zeroing *SA. */
2610 static void
2611 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2613 register struct Lisp_Vector *p;
2614 register unsigned char *cp = NULL;
2615 register int i;
2616 EMACS_INT hostport;
2618 memset (sa, 0, len);
2620 if (VECTORP (address))
2622 p = XVECTOR (address);
2623 if (family == AF_INET)
2625 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2626 len = sizeof (sin->sin_addr) + 1;
2627 hostport = XINT (p->contents[--len]);
2628 sin->sin_port = htons (hostport);
2629 cp = (unsigned char *)&sin->sin_addr;
2630 sa->sa_family = family;
2632 #ifdef AF_INET6
2633 else if (family == AF_INET6)
2635 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2636 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2637 len = sizeof (sin6->sin6_addr) / 2 + 1;
2638 hostport = XINT (p->contents[--len]);
2639 sin6->sin6_port = htons (hostport);
2640 for (i = 0; i < len; i++)
2641 if (INTEGERP (p->contents[i]))
2643 int j = XFASTINT (p->contents[i]) & 0xffff;
2644 ip6[i] = ntohs (j);
2646 sa->sa_family = family;
2647 return;
2649 #endif
2650 else
2651 return;
2653 else if (STRINGP (address))
2655 #ifdef HAVE_LOCAL_SOCKETS
2656 if (family == AF_LOCAL)
2658 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2659 cp = SDATA (address);
2660 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2661 sockun->sun_path[i] = *cp++;
2662 sa->sa_family = family;
2664 #endif
2665 return;
2667 else
2669 p = XVECTOR (XCDR (address));
2670 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2673 for (i = 0; i < len; i++)
2674 if (INTEGERP (p->contents[i]))
2675 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2678 #ifdef DATAGRAM_SOCKETS
2679 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2680 1, 1, 0,
2681 doc: /* Get the current datagram address associated with PROCESS.
2682 If PROCESS is a non-blocking network process that hasn't been fully
2683 set up yet, this function will block until socket setup has completed. */)
2684 (Lisp_Object process)
2686 int channel;
2688 CHECK_PROCESS (process);
2690 if (NETCONN_P (process))
2691 wait_for_socket_fds (process, "process-datagram-address");
2693 if (!DATAGRAM_CONN_P (process))
2694 return Qnil;
2696 channel = XPROCESS (process)->infd;
2697 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2698 datagram_address[channel].len);
2701 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2702 2, 2, 0,
2703 doc: /* Set the datagram address for PROCESS to ADDRESS.
2704 Return nil upon error setting address, ADDRESS otherwise.
2706 If PROCESS is a non-blocking network process that hasn't been fully
2707 set up yet, this function will block until socket setup has completed. */)
2708 (Lisp_Object process, Lisp_Object address)
2710 int channel;
2711 int family;
2712 ptrdiff_t len;
2714 CHECK_PROCESS (process);
2716 if (NETCONN_P (process))
2717 wait_for_socket_fds (process, "set-process-datagram-address");
2719 if (!DATAGRAM_CONN_P (process))
2720 return Qnil;
2722 channel = XPROCESS (process)->infd;
2724 len = get_lisp_to_sockaddr_size (address, &family);
2725 if (len == 0 || datagram_address[channel].len != len)
2726 return Qnil;
2727 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2728 return address;
2730 #endif
2733 static const struct socket_options {
2734 /* The name of this option. Should be lowercase version of option
2735 name without SO_ prefix. */
2736 const char *name;
2737 /* Option level SOL_... */
2738 int optlevel;
2739 /* Option number SO_... */
2740 int optnum;
2741 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2742 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2743 } socket_options[] =
2745 #ifdef SO_BINDTODEVICE
2746 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2747 #endif
2748 #ifdef SO_BROADCAST
2749 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2750 #endif
2751 #ifdef SO_DONTROUTE
2752 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2753 #endif
2754 #ifdef SO_KEEPALIVE
2755 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2756 #endif
2757 #ifdef SO_LINGER
2758 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2759 #endif
2760 #ifdef SO_OOBINLINE
2761 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2762 #endif
2763 #ifdef SO_PRIORITY
2764 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2765 #endif
2766 #ifdef SO_REUSEADDR
2767 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2768 #endif
2769 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2772 /* Set option OPT to value VAL on socket S.
2774 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2775 Signals an error if setting a known option fails.
2778 static int
2779 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2781 char *name;
2782 const struct socket_options *sopt;
2783 int ret = 0;
2785 CHECK_SYMBOL (opt);
2787 name = SSDATA (SYMBOL_NAME (opt));
2788 for (sopt = socket_options; sopt->name; sopt++)
2789 if (strcmp (name, sopt->name) == 0)
2790 break;
2792 switch (sopt->opttype)
2794 case SOPT_BOOL:
2796 int optval;
2797 optval = NILP (val) ? 0 : 1;
2798 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2799 &optval, sizeof (optval));
2800 break;
2803 case SOPT_INT:
2805 int optval;
2806 if (TYPE_RANGED_INTEGERP (int, val))
2807 optval = XINT (val);
2808 else
2809 error ("Bad option value for %s", name);
2810 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2811 &optval, sizeof (optval));
2812 break;
2815 #ifdef SO_BINDTODEVICE
2816 case SOPT_IFNAME:
2818 char devname[IFNAMSIZ + 1];
2820 /* This is broken, at least in the Linux 2.4 kernel.
2821 To unbind, the arg must be a zero integer, not the empty string.
2822 This should work on all systems. KFS. 2003-09-23. */
2823 memset (devname, 0, sizeof devname);
2824 if (STRINGP (val))
2826 char *arg = SSDATA (val);
2827 int len = min (strlen (arg), IFNAMSIZ);
2828 memcpy (devname, arg, len);
2830 else if (!NILP (val))
2831 error ("Bad option value for %s", name);
2832 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2833 devname, IFNAMSIZ);
2834 break;
2836 #endif
2838 #ifdef SO_LINGER
2839 case SOPT_LINGER:
2841 struct linger linger;
2843 linger.l_onoff = 1;
2844 linger.l_linger = 0;
2845 if (TYPE_RANGED_INTEGERP (int, val))
2846 linger.l_linger = XINT (val);
2847 else
2848 linger.l_onoff = NILP (val) ? 0 : 1;
2849 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2850 &linger, sizeof (linger));
2851 break;
2853 #endif
2855 default:
2856 return 0;
2859 if (ret < 0)
2861 int setsockopt_errno = errno;
2862 report_file_errno ("Cannot set network option", list2 (opt, val),
2863 setsockopt_errno);
2866 return (1 << sopt->optbit);
2870 DEFUN ("set-network-process-option",
2871 Fset_network_process_option, Sset_network_process_option,
2872 3, 4, 0,
2873 doc: /* For network process PROCESS set option OPTION to value VALUE.
2874 See `make-network-process' for a list of options and values.
2875 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2876 OPTION is not a supported option, return nil instead; otherwise return t.
2878 If PROCESS is a non-blocking network process that hasn't been fully
2879 set up yet, this function will block until socket setup has completed. */)
2880 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2882 int s;
2883 struct Lisp_Process *p;
2885 CHECK_PROCESS (process);
2886 p = XPROCESS (process);
2887 if (!NETCONN1_P (p))
2888 error ("Process is not a network process");
2890 wait_for_socket_fds (process, "set-network-process-option");
2892 s = p->infd;
2893 if (s < 0)
2894 error ("Process is not running");
2896 if (set_socket_option (s, option, value))
2898 pset_childp (p, Fplist_put (p->childp, option, value));
2899 return Qt;
2902 if (NILP (no_error))
2903 error ("Unknown or unsupported option");
2905 return Qnil;
2909 DEFUN ("serial-process-configure",
2910 Fserial_process_configure,
2911 Sserial_process_configure,
2912 0, MANY, 0,
2913 doc: /* Configure speed, bytesize, etc. of a serial process.
2915 Arguments are specified as keyword/argument pairs. Attributes that
2916 are not given are re-initialized from the process's current
2917 configuration (available via the function `process-contact') or set to
2918 reasonable default values. The following arguments are defined:
2920 :process PROCESS
2921 :name NAME
2922 :buffer BUFFER
2923 :port PORT
2924 -- Any of these arguments can be given to identify the process that is
2925 to be configured. If none of these arguments is given, the current
2926 buffer's process is used.
2928 :speed SPEED -- SPEED is the speed of the serial port in bits per
2929 second, also called baud rate. Any value can be given for SPEED, but
2930 most serial ports work only at a few defined values between 1200 and
2931 115200, with 9600 being the most common value. If SPEED is nil, the
2932 serial port is not configured any further, i.e., all other arguments
2933 are ignored. This may be useful for special serial ports such as
2934 Bluetooth-to-serial converters which can only be configured through AT
2935 commands. A value of nil for SPEED can be used only when passed
2936 through `make-serial-process' or `serial-term'.
2938 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2939 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2941 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2942 `odd' (use odd parity), or the symbol `even' (use even parity). If
2943 PARITY is not given, no parity is used.
2945 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2946 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2947 is not given or nil, 1 stopbit is used.
2949 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2950 flowcontrol to be used, which is either nil (don't use flowcontrol),
2951 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2952 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2953 flowcontrol is used.
2955 `serial-process-configure' is called by `make-serial-process' for the
2956 initial configuration of the serial port.
2958 Examples:
2960 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2962 \(serial-process-configure
2963 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2965 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2967 usage: (serial-process-configure &rest ARGS) */)
2968 (ptrdiff_t nargs, Lisp_Object *args)
2970 struct Lisp_Process *p;
2971 Lisp_Object contact = Qnil;
2972 Lisp_Object proc = Qnil;
2974 contact = Flist (nargs, args);
2976 proc = Fplist_get (contact, QCprocess);
2977 if (NILP (proc))
2978 proc = Fplist_get (contact, QCname);
2979 if (NILP (proc))
2980 proc = Fplist_get (contact, QCbuffer);
2981 if (NILP (proc))
2982 proc = Fplist_get (contact, QCport);
2983 proc = get_process (proc);
2984 p = XPROCESS (proc);
2985 if (!EQ (p->type, Qserial))
2986 error ("Not a serial process");
2988 if (NILP (Fplist_get (p->childp, QCspeed)))
2989 return Qnil;
2991 serial_configure (p, contact);
2992 return Qnil;
2995 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2996 0, MANY, 0,
2997 doc: /* Create and return a serial port process.
2999 In Emacs, serial port connections are represented by process objects,
3000 so input and output work as for subprocesses, and `delete-process'
3001 closes a serial port connection. However, a serial process has no
3002 process id, it cannot be signaled, and the status codes are different
3003 from normal processes.
3005 `make-serial-process' creates a process and a buffer, on which you
3006 probably want to use `process-send-string'. Try \\[serial-term] for
3007 an interactive terminal. See below for examples.
3009 Arguments are specified as keyword/argument pairs. The following
3010 arguments are defined:
3012 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3013 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3014 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3015 the backslashes in strings).
3017 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3018 which this function calls.
3020 :name NAME -- NAME is the name of the process. If NAME is not given,
3021 the value of PORT is used.
3023 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3024 with the process. Process output goes at the end of that buffer,
3025 unless you specify an output stream or filter function to handle the
3026 output. If BUFFER is not given, the value of NAME is used.
3028 :coding CODING -- If CODING is a symbol, it specifies the coding
3029 system used for both reading and writing for this process. If CODING
3030 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3031 ENCODING is used for writing.
3033 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3034 the process is running. If BOOL is not given, query before exiting.
3036 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3037 In the stopped state, a serial process does not accept incoming data,
3038 but you can send outgoing data. The stopped state is cleared by
3039 `continue-process' and set by `stop-process'.
3041 :filter FILTER -- Install FILTER as the process filter.
3043 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3045 :plist PLIST -- Install PLIST as the initial plist of the process.
3047 :bytesize
3048 :parity
3049 :stopbits
3050 :flowcontrol
3051 -- This function calls `serial-process-configure' to handle these
3052 arguments.
3054 The original argument list, possibly modified by later configuration,
3055 is available via the function `process-contact'.
3057 Examples:
3059 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3061 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3063 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3065 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3067 usage: (make-serial-process &rest ARGS) */)
3068 (ptrdiff_t nargs, Lisp_Object *args)
3070 int fd = -1;
3071 Lisp_Object proc, contact, port;
3072 struct Lisp_Process *p;
3073 Lisp_Object name, buffer;
3074 Lisp_Object tem, val;
3075 ptrdiff_t specpdl_count;
3077 if (nargs == 0)
3078 return Qnil;
3080 contact = Flist (nargs, args);
3082 port = Fplist_get (contact, QCport);
3083 if (NILP (port))
3084 error ("No port specified");
3085 CHECK_STRING (port);
3087 if (NILP (Fplist_member (contact, QCspeed)))
3088 error (":speed not specified");
3089 if (!NILP (Fplist_get (contact, QCspeed)))
3090 CHECK_NUMBER (Fplist_get (contact, QCspeed));
3092 name = Fplist_get (contact, QCname);
3093 if (NILP (name))
3094 name = port;
3095 CHECK_STRING (name);
3096 proc = make_process (name);
3097 specpdl_count = SPECPDL_INDEX ();
3098 record_unwind_protect (remove_process, proc);
3099 p = XPROCESS (proc);
3101 fd = serial_open (port);
3102 p->open_fd[SUBPROCESS_STDIN] = fd;
3103 p->infd = fd;
3104 p->outfd = fd;
3105 if (fd > max_desc)
3106 max_desc = fd;
3107 chan_process[fd] = proc;
3109 buffer = Fplist_get (contact, QCbuffer);
3110 if (NILP (buffer))
3111 buffer = name;
3112 buffer = Fget_buffer_create (buffer);
3113 pset_buffer (p, buffer);
3115 pset_childp (p, contact);
3116 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3117 pset_type (p, Qserial);
3118 pset_sentinel (p, Fplist_get (contact, QCsentinel));
3119 pset_filter (p, Fplist_get (contact, QCfilter));
3120 eassert (NILP (p->log));
3121 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3122 p->kill_without_query = 1;
3123 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
3124 pset_command (p, Qt);
3125 eassert (! p->pty_flag);
3127 if (!EQ (p->command, Qt))
3128 add_process_read_fd (fd);
3130 if (BUFFERP (buffer))
3132 set_marker_both (p->mark, buffer,
3133 BUF_ZV (XBUFFER (buffer)),
3134 BUF_ZV_BYTE (XBUFFER (buffer)));
3137 tem = Fplist_member (contact, QCcoding);
3138 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3139 tem = Qnil;
3141 val = Qnil;
3142 if (!NILP (tem))
3144 val = XCAR (XCDR (tem));
3145 if (CONSP (val))
3146 val = XCAR (val);
3148 else if (!NILP (Vcoding_system_for_read))
3149 val = Vcoding_system_for_read;
3150 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3151 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3152 val = Qnil;
3153 pset_decode_coding_system (p, val);
3155 val = Qnil;
3156 if (!NILP (tem))
3158 val = XCAR (XCDR (tem));
3159 if (CONSP (val))
3160 val = XCDR (val);
3162 else if (!NILP (Vcoding_system_for_write))
3163 val = Vcoding_system_for_write;
3164 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3165 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3166 val = Qnil;
3167 pset_encode_coding_system (p, val);
3169 setup_process_coding_systems (proc);
3170 pset_decoding_buf (p, empty_unibyte_string);
3171 eassert (p->decoding_carryover == 0);
3172 pset_encoding_buf (p, empty_unibyte_string);
3173 p->inherit_coding_system_flag
3174 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3176 Fserial_process_configure (nargs, args);
3178 specpdl_ptr = specpdl + specpdl_count;
3180 return proc;
3183 static void
3184 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3185 Lisp_Object service, Lisp_Object name)
3187 Lisp_Object tem;
3188 struct Lisp_Process *p = XPROCESS (proc);
3189 Lisp_Object contact = p->childp;
3190 Lisp_Object coding_systems = Qt;
3191 Lisp_Object val;
3193 tem = Fplist_member (contact, QCcoding);
3194 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3195 tem = Qnil; /* No error message (too late!). */
3197 /* Setup coding systems for communicating with the network stream. */
3198 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3200 if (!NILP (tem))
3202 val = XCAR (XCDR (tem));
3203 if (CONSP (val))
3204 val = XCAR (val);
3206 else if (!NILP (Vcoding_system_for_read))
3207 val = Vcoding_system_for_read;
3208 else if ((!NILP (p->buffer)
3209 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3210 || (NILP (p->buffer)
3211 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3212 /* We dare not decode end-of-line format by setting VAL to
3213 Qraw_text, because the existing Emacs Lisp libraries
3214 assume that they receive bare code including a sequence of
3215 CR LF. */
3216 val = Qnil;
3217 else
3219 if (NILP (host) || NILP (service))
3220 coding_systems = Qnil;
3221 else
3222 coding_systems = CALLN (Ffind_operation_coding_system,
3223 Qopen_network_stream, name, p->buffer,
3224 host, service);
3225 if (CONSP (coding_systems))
3226 val = XCAR (coding_systems);
3227 else if (CONSP (Vdefault_process_coding_system))
3228 val = XCAR (Vdefault_process_coding_system);
3229 else
3230 val = Qnil;
3232 pset_decode_coding_system (p, val);
3234 if (!NILP (tem))
3236 val = XCAR (XCDR (tem));
3237 if (CONSP (val))
3238 val = XCDR (val);
3240 else if (!NILP (Vcoding_system_for_write))
3241 val = Vcoding_system_for_write;
3242 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3243 val = Qnil;
3244 else
3246 if (EQ (coding_systems, Qt))
3248 if (NILP (host) || NILP (service))
3249 coding_systems = Qnil;
3250 else
3251 coding_systems = CALLN (Ffind_operation_coding_system,
3252 Qopen_network_stream, name, p->buffer,
3253 host, service);
3255 if (CONSP (coding_systems))
3256 val = XCDR (coding_systems);
3257 else if (CONSP (Vdefault_process_coding_system))
3258 val = XCDR (Vdefault_process_coding_system);
3259 else
3260 val = Qnil;
3262 pset_encode_coding_system (p, val);
3264 pset_decoding_buf (p, empty_unibyte_string);
3265 p->decoding_carryover = 0;
3266 pset_encoding_buf (p, empty_unibyte_string);
3268 p->inherit_coding_system_flag
3269 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3272 #ifdef HAVE_GNUTLS
3273 static void
3274 finish_after_tls_connection (Lisp_Object proc)
3276 struct Lisp_Process *p = XPROCESS (proc);
3277 Lisp_Object contact = p->childp;
3278 Lisp_Object result = Qt;
3280 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3281 result = call3 (Qnsm_verify_connection,
3282 proc,
3283 Fplist_get (contact, QChost),
3284 Fplist_get (contact, QCservice));
3286 if (NILP (result))
3288 pset_status (p, list2 (Qfailed,
3289 build_string ("The Network Security Manager stopped the connections")));
3290 deactivate_process (proc);
3292 else if (p->outfd < 0)
3294 /* The counterparty may have closed the connection (especially
3295 if the NSM prompt above take a long time), so recheck the file
3296 descriptor here. */
3297 pset_status (p, Qfailed);
3298 deactivate_process (proc);
3300 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3302 /* If we cleared the connection wait mask before we did the TLS
3303 setup, then we have to say that the process is finally "open"
3304 here. */
3305 pset_status (p, Qrun);
3306 /* Execute the sentinel here. If we had relied on status_notify
3307 to do it later, it will read input from the process before
3308 calling the sentinel. */
3309 exec_sentinel (proc, build_string ("open\n"));
3312 #endif
3314 static void
3315 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3316 Lisp_Object use_external_socket_p)
3318 ptrdiff_t count = SPECPDL_INDEX ();
3319 int s = -1, outch, inch;
3320 int xerrno = 0;
3321 int family;
3322 struct sockaddr *sa = NULL;
3323 int ret;
3324 ptrdiff_t addrlen;
3325 struct Lisp_Process *p = XPROCESS (proc);
3326 Lisp_Object contact = p->childp;
3327 int optbits = 0;
3328 int socket_to_use = -1;
3330 if (!NILP (use_external_socket_p))
3332 socket_to_use = external_sock_fd;
3334 /* Ensure we don't consume the external socket twice. */
3335 external_sock_fd = -1;
3338 /* Do this in case we never enter the while-loop below. */
3339 s = -1;
3341 while (!NILP (addrinfos))
3343 Lisp_Object addrinfo = XCAR (addrinfos);
3344 addrinfos = XCDR (addrinfos);
3345 int protocol = XINT (XCAR (addrinfo));
3346 Lisp_Object ip_address = XCDR (addrinfo);
3348 #ifdef WINDOWSNT
3349 retry_connect:
3350 #endif
3352 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3353 if (sa)
3354 free (sa);
3355 sa = xmalloc (addrlen);
3356 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3358 s = socket_to_use;
3359 if (s < 0)
3361 int socktype = p->socktype | SOCK_CLOEXEC;
3362 if (p->is_non_blocking_client)
3363 socktype |= SOCK_NONBLOCK;
3364 s = socket (family, socktype, protocol);
3365 if (s < 0)
3367 xerrno = errno;
3368 continue;
3372 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3374 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3375 if (ret < 0)
3377 xerrno = errno;
3378 emacs_close (s);
3379 s = -1;
3380 if (0 <= socket_to_use)
3381 break;
3382 continue;
3386 #ifdef DATAGRAM_SOCKETS
3387 if (!p->is_server && p->socktype == SOCK_DGRAM)
3388 break;
3389 #endif /* DATAGRAM_SOCKETS */
3391 /* Make us close S if quit. */
3392 record_unwind_protect_int (close_file_unwind, s);
3394 /* Parse network options in the arg list. We simply ignore anything
3395 which isn't a known option (including other keywords). An error
3396 is signaled if setting a known option fails. */
3398 Lisp_Object params = contact, key, val;
3400 while (!NILP (params))
3402 key = XCAR (params);
3403 params = XCDR (params);
3404 val = XCAR (params);
3405 params = XCDR (params);
3406 optbits |= set_socket_option (s, key, val);
3410 if (p->is_server)
3412 /* Configure as a server socket. */
3414 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3415 explicit :reuseaddr key to override this. */
3416 #ifdef HAVE_LOCAL_SOCKETS
3417 if (family != AF_LOCAL)
3418 #endif
3419 if (!(optbits & (1 << OPIX_REUSEADDR)))
3421 int optval = 1;
3422 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3423 report_file_error ("Cannot set reuse option on server socket", Qnil);
3426 /* If passed a socket descriptor, it should be already bound. */
3427 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3428 report_file_error ("Cannot bind server socket", Qnil);
3430 #ifdef HAVE_GETSOCKNAME
3431 if (p->port == 0
3432 #ifdef HAVE_LOCAL_SOCKETS
3433 && family != AF_LOCAL
3434 #endif
3437 struct sockaddr_in sa1;
3438 socklen_t len1 = sizeof (sa1);
3439 #ifdef AF_INET6
3440 /* The code below assumes the port is at the same offset
3441 and of the same width in both IPv4 and IPv6
3442 structures, but the standards don't guarantee that,
3443 so verify it here. */
3444 struct sockaddr_in6 sa6;
3445 verify ((offsetof (struct sockaddr_in, sin_port)
3446 == offsetof (struct sockaddr_in6, sin6_port))
3447 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3448 #endif
3449 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3450 if (getsockname (s, psa1, &len1) == 0)
3452 Lisp_Object service = make_number (ntohs (sa1.sin_port));
3453 contact = Fplist_put (contact, QCservice, service);
3454 /* Save the port number so that we can stash it in
3455 the process object later. */
3456 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3457 psa->sin_port = sa1.sin_port;
3460 #endif
3462 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3463 report_file_error ("Cannot listen on server socket", Qnil);
3465 break;
3468 maybe_quit ();
3470 ret = connect (s, sa, addrlen);
3471 xerrno = errno;
3473 if (ret == 0 || xerrno == EISCONN)
3475 /* The unwind-protect will be discarded afterwards. */
3476 break;
3479 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3480 break;
3482 #ifndef WINDOWSNT
3483 if (xerrno == EINTR)
3485 /* Unlike most other syscalls connect() cannot be called
3486 again. (That would return EALREADY.) The proper way to
3487 wait for completion is pselect(). */
3488 int sc;
3489 socklen_t len;
3490 fd_set fdset;
3491 retry_select:
3492 FD_ZERO (&fdset);
3493 FD_SET (s, &fdset);
3494 maybe_quit ();
3495 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3496 if (sc == -1)
3498 if (errno == EINTR)
3499 goto retry_select;
3500 else
3501 report_file_error ("Failed select", Qnil);
3503 eassert (sc > 0);
3505 len = sizeof xerrno;
3506 eassert (FD_ISSET (s, &fdset));
3507 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3508 report_file_error ("Failed getsockopt", Qnil);
3509 if (xerrno == 0)
3510 break;
3511 if (NILP (addrinfos))
3512 report_file_errno ("Failed connect", Qnil, xerrno);
3514 #endif /* !WINDOWSNT */
3516 /* Discard the unwind protect closing S. */
3517 specpdl_ptr = specpdl + count;
3518 emacs_close (s);
3519 s = -1;
3520 if (0 <= socket_to_use)
3521 break;
3523 #ifdef WINDOWSNT
3524 if (xerrno == EINTR)
3525 goto retry_connect;
3526 #endif
3529 if (s >= 0)
3531 #ifdef DATAGRAM_SOCKETS
3532 if (p->socktype == SOCK_DGRAM)
3534 if (datagram_address[s].sa)
3535 emacs_abort ();
3537 datagram_address[s].sa = xmalloc (addrlen);
3538 datagram_address[s].len = addrlen;
3539 if (p->is_server)
3541 Lisp_Object remote;
3542 memset (datagram_address[s].sa, 0, addrlen);
3543 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3545 int rfamily;
3546 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3547 if (rlen != 0 && rfamily == family
3548 && rlen == addrlen)
3549 conv_lisp_to_sockaddr (rfamily, remote,
3550 datagram_address[s].sa, rlen);
3553 else
3554 memcpy (datagram_address[s].sa, sa, addrlen);
3556 #endif
3558 contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
3559 conv_sockaddr_to_lisp (sa, addrlen));
3560 #ifdef HAVE_GETSOCKNAME
3561 if (!p->is_server)
3563 struct sockaddr_storage sa1;
3564 socklen_t len1 = sizeof (sa1);
3565 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3566 if (getsockname (s, psa1, &len1) == 0)
3567 contact = Fplist_put (contact, QClocal,
3568 conv_sockaddr_to_lisp (psa1, len1));
3570 #endif
3573 if (s < 0)
3575 /* If non-blocking got this far - and failed - assume non-blocking is
3576 not supported after all. This is probably a wrong assumption, but
3577 the normal blocking calls to open-network-stream handles this error
3578 better. */
3579 if (p->is_non_blocking_client)
3580 return;
3582 report_file_errno ((p->is_server
3583 ? "make server process failed"
3584 : "make client process failed"),
3585 contact, xerrno);
3588 inch = s;
3589 outch = s;
3591 chan_process[inch] = proc;
3593 fcntl (inch, F_SETFL, O_NONBLOCK);
3595 p = XPROCESS (proc);
3596 p->open_fd[SUBPROCESS_STDIN] = inch;
3597 p->infd = inch;
3598 p->outfd = outch;
3600 /* Discard the unwind protect for closing S, if any. */
3601 specpdl_ptr = specpdl + count;
3603 if (p->is_server && p->socktype != SOCK_DGRAM)
3604 pset_status (p, Qlisten);
3606 /* Make the process marker point into the process buffer (if any). */
3607 if (BUFFERP (p->buffer))
3608 set_marker_both (p->mark, p->buffer,
3609 BUF_ZV (XBUFFER (p->buffer)),
3610 BUF_ZV_BYTE (XBUFFER (p->buffer)));
3612 if (p->is_non_blocking_client)
3614 /* We may get here if connect did succeed immediately. However,
3615 in that case, we still need to signal this like a non-blocking
3616 connection. */
3617 if (! (connecting_status (p->status)
3618 && EQ (XCDR (p->status), addrinfos)))
3619 pset_status (p, Fcons (Qconnect, addrinfos));
3620 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3621 add_non_blocking_write_fd (inch);
3623 else
3624 /* A server may have a client filter setting of Qt, but it must
3625 still listen for incoming connects unless it is stopped. */
3626 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3627 || (EQ (p->status, Qlisten) && NILP (p->command)))
3628 add_process_read_fd (inch);
3630 if (inch > max_desc)
3631 max_desc = inch;
3633 /* Set up the masks based on the process filter. */
3634 set_process_filter_masks (p);
3636 setup_process_coding_systems (proc);
3638 #ifdef HAVE_GNUTLS
3639 /* Continue the asynchronous connection. */
3640 if (!NILP (p->gnutls_boot_parameters))
3642 Lisp_Object boot, params = p->gnutls_boot_parameters;
3644 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3645 p->gnutls_boot_parameters = Qnil;
3647 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3648 /* Run sentinels, etc. */
3649 finish_after_tls_connection (proc);
3650 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3652 deactivate_process (proc);
3653 if (NILP (boot))
3654 pset_status (p, list2 (Qfailed,
3655 build_string ("TLS negotiation failed")));
3656 else
3657 pset_status (p, list2 (Qfailed, boot));
3660 #endif
3664 /* Create a network stream/datagram client/server process. Treated
3665 exactly like a normal process when reading and writing. Primary
3666 differences are in status display and process deletion. A network
3667 connection has no PID; you cannot signal it. All you can do is
3668 stop/continue it and deactivate/close it via delete-process. */
3670 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3671 0, MANY, 0,
3672 doc: /* Create and return a network server or client process.
3674 In Emacs, network connections are represented by process objects, so
3675 input and output work as for subprocesses and `delete-process' closes
3676 a network connection. However, a network process has no process id,
3677 it cannot be signaled, and the status codes are different from normal
3678 processes.
3680 Arguments are specified as keyword/argument pairs. The following
3681 arguments are defined:
3683 :name NAME -- NAME is name for process. It is modified if necessary
3684 to make it unique.
3686 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3687 with the process. Process output goes at end of that buffer, unless
3688 you specify an output stream or filter function to handle the output.
3689 BUFFER may be also nil, meaning that this process is not associated
3690 with any buffer.
3692 :host HOST -- HOST is name of the host to connect to, or its IP
3693 address. The symbol `local' specifies the local host. If specified
3694 for a server process, it must be a valid name or address for the local
3695 host, and only clients connecting to that address will be accepted.
3697 :service SERVICE -- SERVICE is name of the service desired, or an
3698 integer specifying a port number to connect to. If SERVICE is t,
3699 a random port number is selected for the server. A port number can
3700 be specified as an integer string, e.g., "80", as well as an integer.
3702 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3703 stream type connection, `datagram' creates a datagram type connection,
3704 `seqpacket' creates a reliable datagram connection.
3706 :family FAMILY -- FAMILY is the address (and protocol) family for the
3707 service specified by HOST and SERVICE. The default (nil) is to use
3708 whatever address family (IPv4 or IPv6) that is defined for the host
3709 and port number specified by HOST and SERVICE. Other address families
3710 supported are:
3711 local -- for a local (i.e. UNIX) address specified by SERVICE.
3712 ipv4 -- use IPv4 address family only.
3713 ipv6 -- use IPv6 address family only.
3715 :local ADDRESS -- ADDRESS is the local address used for the connection.
3716 This parameter is ignored when opening a client process. When specified
3717 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3719 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3720 connection. This parameter is ignored when opening a stream server
3721 process. For a datagram server process, it specifies the initial
3722 setting of the remote datagram address. When specified for a client
3723 process, the FAMILY, HOST, and SERVICE args are ignored.
3725 The format of ADDRESS depends on the address family:
3726 - An IPv4 address is represented as an vector of integers [A B C D P]
3727 corresponding to numeric IP address A.B.C.D and port number P.
3728 - A local address is represented as a string with the address in the
3729 local address space.
3730 - An "unsupported family" address is represented by a cons (F . AV)
3731 where F is the family number and AV is a vector containing the socket
3732 address data with one element per address data byte. Do not rely on
3733 this format in portable code, as it may depend on implementation
3734 defined constants, data sizes, and data structure alignment.
3736 :coding CODING -- If CODING is a symbol, it specifies the coding
3737 system used for both reading and writing for this process. If CODING
3738 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3739 ENCODING is used for writing.
3741 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3742 process, return without waiting for the connection to complete;
3743 instead, the sentinel function will be called with second arg matching
3744 "open" (if successful) or "failed" when the connect completes.
3745 Default is to use a blocking connect (i.e. wait) for stream type
3746 connections.
3748 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3749 running when Emacs is exited.
3751 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3752 In the stopped state, a server process does not accept new
3753 connections, and a client process does not handle incoming traffic.
3754 The stopped state is cleared by `continue-process' and set by
3755 `stop-process'.
3757 :filter FILTER -- Install FILTER as the process filter.
3759 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3760 process filter are multibyte, otherwise they are unibyte.
3761 If this keyword is not specified, the strings are multibyte.
3763 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3765 :log LOG -- Install LOG as the server process log function. This
3766 function is called when the server accepts a network connection from a
3767 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3768 is the server process, CLIENT is the new process for the connection,
3769 and MESSAGE is a string.
3771 :plist PLIST -- Install PLIST as the new process's initial plist.
3773 :tls-parameters LIST -- is a list that should be supplied if you're
3774 opening a TLS connection. The first element is the TLS type (either
3775 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3776 be a keyword list accepted by gnutls-boot (as returned by
3777 `gnutls-boot-parameters').
3779 :server QLEN -- if QLEN is non-nil, create a server process for the
3780 specified FAMILY, SERVICE, and connection type (stream or datagram).
3781 If QLEN is an integer, it is used as the max. length of the server's
3782 pending connection queue (also known as the backlog); the default
3783 queue length is 5. Default is to create a client process.
3785 The following network options can be specified for this connection:
3787 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3788 :dontroute BOOL -- Only send to directly connected hosts.
3789 :keepalive BOOL -- Send keep-alive messages on network stream.
3790 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3791 :oobinline BOOL -- Place out-of-band data in receive data stream.
3792 :priority INT -- Set protocol defined priority for sent packets.
3793 :reuseaddr BOOL -- Allow reusing a recently used local address
3794 (this is allowed by default for a server process).
3795 :bindtodevice NAME -- bind to interface NAME. Using this may require
3796 special privileges on some systems.
3797 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3798 been passed to Emacs. If Emacs wasn't
3799 passed a socket, this option is silently
3800 ignored.
3803 Consult the relevant system programmer's manual pages for more
3804 information on using these options.
3807 A server process will listen for and accept connections from clients.
3808 When a client connection is accepted, a new network process is created
3809 for the connection with the following parameters:
3811 - The client's process name is constructed by concatenating the server
3812 process's NAME and a client identification string.
3813 - If the FILTER argument is non-nil, the client process will not get a
3814 separate process buffer; otherwise, the client's process buffer is a newly
3815 created buffer named after the server process's BUFFER name or process
3816 NAME concatenated with the client identification string.
3817 - The connection type and the process filter and sentinel parameters are
3818 inherited from the server process's TYPE, FILTER and SENTINEL.
3819 - The client process's contact info is set according to the client's
3820 addressing information (typically an IP address and a port number).
3821 - The client process's plist is initialized from the server's plist.
3823 Notice that the FILTER and SENTINEL args are never used directly by
3824 the server process. Also, the BUFFER argument is not used directly by
3825 the server process, but via the optional :log function, accepted (and
3826 failed) connections may be logged in the server process's buffer.
3828 The original argument list, modified with the actual connection
3829 information, is available via the `process-contact' function.
3831 usage: (make-network-process &rest ARGS) */)
3832 (ptrdiff_t nargs, Lisp_Object *args)
3834 Lisp_Object proc;
3835 Lisp_Object contact;
3836 struct Lisp_Process *p;
3837 const char *portstring UNINIT;
3838 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3839 #ifdef HAVE_LOCAL_SOCKETS
3840 struct sockaddr_un address_un;
3841 #endif
3842 EMACS_INT port = 0;
3843 Lisp_Object tem;
3844 Lisp_Object name, buffer, host, service, address;
3845 Lisp_Object filter, sentinel, use_external_socket_p;
3846 Lisp_Object addrinfos = Qnil;
3847 int socktype;
3848 int family = -1;
3849 enum { any_protocol = 0 };
3850 #ifdef HAVE_GETADDRINFO_A
3851 struct gaicb *dns_request = NULL;
3852 #endif
3853 ptrdiff_t count = SPECPDL_INDEX ();
3855 if (nargs == 0)
3856 return Qnil;
3858 /* Save arguments for process-contact and clone-process. */
3859 contact = Flist (nargs, args);
3861 #ifdef WINDOWSNT
3862 /* Ensure socket support is loaded if available. */
3863 init_winsock (TRUE);
3864 #endif
3866 /* :type TYPE (nil: stream, datagram */
3867 tem = Fplist_get (contact, QCtype);
3868 if (NILP (tem))
3869 socktype = SOCK_STREAM;
3870 #ifdef DATAGRAM_SOCKETS
3871 else if (EQ (tem, Qdatagram))
3872 socktype = SOCK_DGRAM;
3873 #endif
3874 #ifdef HAVE_SEQPACKET
3875 else if (EQ (tem, Qseqpacket))
3876 socktype = SOCK_SEQPACKET;
3877 #endif
3878 else
3879 error ("Unsupported connection type");
3881 name = Fplist_get (contact, QCname);
3882 buffer = Fplist_get (contact, QCbuffer);
3883 filter = Fplist_get (contact, QCfilter);
3884 sentinel = Fplist_get (contact, QCsentinel);
3885 use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
3887 CHECK_STRING (name);
3889 /* :local ADDRESS or :remote ADDRESS */
3890 tem = Fplist_get (contact, QCserver);
3891 if (NILP (tem))
3892 address = Fplist_get (contact, QCremote);
3893 else
3894 address = Fplist_get (contact, QClocal);
3895 if (!NILP (address))
3897 host = service = Qnil;
3899 if (!get_lisp_to_sockaddr_size (address, &family))
3900 error ("Malformed :address");
3902 addrinfos = list1 (Fcons (make_number (any_protocol), address));
3903 goto open_socket;
3906 /* :family FAMILY -- nil (for Inet), local, or integer. */
3907 tem = Fplist_get (contact, QCfamily);
3908 if (NILP (tem))
3910 #ifdef AF_INET6
3911 family = AF_UNSPEC;
3912 #else
3913 family = AF_INET;
3914 #endif
3916 #ifdef HAVE_LOCAL_SOCKETS
3917 else if (EQ (tem, Qlocal))
3918 family = AF_LOCAL;
3919 #endif
3920 #ifdef AF_INET6
3921 else if (EQ (tem, Qipv6))
3922 family = AF_INET6;
3923 #endif
3924 else if (EQ (tem, Qipv4))
3925 family = AF_INET;
3926 else if (TYPE_RANGED_INTEGERP (int, tem))
3927 family = XINT (tem);
3928 else
3929 error ("Unknown address family");
3931 /* :service SERVICE -- string, integer (port number), or t (random port). */
3932 service = Fplist_get (contact, QCservice);
3934 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3935 host = Fplist_get (contact, QChost);
3936 if (NILP (host))
3938 /* The "connection" function gets it bind info from the address we're
3939 given, so use this dummy address if nothing is specified. */
3940 #ifdef HAVE_LOCAL_SOCKETS
3941 if (family != AF_LOCAL)
3942 #endif
3943 host = build_string ("127.0.0.1");
3945 else
3947 if (EQ (host, Qlocal))
3948 /* Depending on setup, "localhost" may map to different IPv4 and/or
3949 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3950 host = build_string ("127.0.0.1");
3951 CHECK_STRING (host);
3954 #ifdef HAVE_LOCAL_SOCKETS
3955 if (family == AF_LOCAL)
3957 if (!NILP (host))
3959 message (":family local ignores the :host property");
3960 contact = Fplist_put (contact, QChost, Qnil);
3961 host = Qnil;
3963 CHECK_STRING (service);
3964 if (sizeof address_un.sun_path <= SBYTES (service))
3965 error ("Service name too long");
3966 addrinfos = list1 (Fcons (make_number (any_protocol), service));
3967 goto open_socket;
3969 #endif
3971 /* Slow down polling to every ten seconds.
3972 Some kernels have a bug which causes retrying connect to fail
3973 after a connect. Polling can interfere with gethostbyname too. */
3974 #ifdef POLL_FOR_INPUT
3975 if (socktype != SOCK_DGRAM)
3977 record_unwind_protect_void (run_all_atimers);
3978 bind_polling_period (10);
3980 #endif
3982 if (!NILP (host))
3984 ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
3986 /* SERVICE can either be a string or int.
3987 Convert to a C string for later use by getaddrinfo. */
3988 if (EQ (service, Qt))
3990 portstring = "0";
3991 portstringlen = 1;
3993 else if (INTEGERP (service))
3995 portstring = portbuf;
3996 portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
3998 else
4000 CHECK_STRING (service);
4001 portstring = SSDATA (service);
4002 portstringlen = SBYTES (service);
4005 #ifdef HAVE_GETADDRINFO_A
4006 if (!NILP (Fplist_get (contact, QCnowait)))
4008 ptrdiff_t hostlen = SBYTES (host);
4009 struct req
4011 struct gaicb gaicb;
4012 struct addrinfo hints;
4013 char str[FLEXIBLE_ARRAY_MEMBER];
4014 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4015 hostlen + 1 + portstringlen + 1));
4016 dns_request = &req->gaicb;
4017 dns_request->ar_name = req->str;
4018 dns_request->ar_service = req->str + hostlen + 1;
4019 dns_request->ar_request = &req->hints;
4020 dns_request->ar_result = NULL;
4021 memset (&req->hints, 0, sizeof req->hints);
4022 req->hints.ai_family = family;
4023 req->hints.ai_socktype = socktype;
4024 strcpy (req->str, SSDATA (host));
4025 strcpy (req->str + hostlen + 1, portstring);
4027 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4028 if (ret)
4029 error ("%s/%s getaddrinfo_a error %d",
4030 SSDATA (host), portstring, ret);
4032 goto open_socket;
4034 #endif /* HAVE_GETADDRINFO_A */
4037 /* If we have a host, use getaddrinfo to resolve both host and service.
4038 Otherwise, use getservbyname to lookup the service. */
4040 if (!NILP (host))
4042 struct addrinfo *res, *lres;
4043 int ret;
4045 maybe_quit ();
4047 struct addrinfo hints;
4048 memset (&hints, 0, sizeof hints);
4049 hints.ai_family = family;
4050 hints.ai_socktype = socktype;
4052 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
4053 if (ret)
4054 #ifdef HAVE_GAI_STRERROR
4056 synchronize_system_messages_locale ();
4057 char const *str = gai_strerror (ret);
4058 if (! NILP (Vlocale_coding_system))
4059 str = SSDATA (code_convert_string_norecord
4060 (build_string (str), Vlocale_coding_system, 0));
4061 error ("%s/%s %s", SSDATA (host), portstring, str);
4063 #else
4064 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4065 #endif
4067 for (lres = res; lres; lres = lres->ai_next)
4068 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4070 addrinfos = Fnreverse (addrinfos);
4072 freeaddrinfo (res);
4074 goto open_socket;
4077 /* No hostname has been specified (e.g., a local server process). */
4079 if (EQ (service, Qt))
4080 port = 0;
4081 else if (INTEGERP (service))
4082 port = XINT (service);
4083 else
4085 CHECK_STRING (service);
4087 port = -1;
4088 if (SBYTES (service) != 0)
4090 /* Allow the service to be a string containing the port number,
4091 because that's allowed if you have getaddrbyname. */
4092 char *service_end;
4093 long int lport = strtol (SSDATA (service), &service_end, 10);
4094 if (service_end == SSDATA (service) + SBYTES (service))
4095 port = lport;
4096 else
4098 struct servent *svc_info
4099 = getservbyname (SSDATA (service),
4100 socktype == SOCK_DGRAM ? "udp" : "tcp");
4101 if (svc_info)
4102 port = ntohs (svc_info->s_port);
4107 if (! (0 <= port && port < 1 << 16))
4109 AUTO_STRING (unknown_service, "Unknown service: %s");
4110 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4113 open_socket:
4115 if (!NILP (buffer))
4116 buffer = Fget_buffer_create (buffer);
4118 /* Unwind bind_polling_period. */
4119 unbind_to (count, Qnil);
4121 proc = make_process (name);
4122 record_unwind_protect (remove_process, proc);
4123 p = XPROCESS (proc);
4124 pset_childp (p, contact);
4125 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
4126 pset_type (p, Qnetwork);
4128 pset_buffer (p, buffer);
4129 pset_sentinel (p, sentinel);
4130 pset_filter (p, filter);
4131 pset_log (p, Fplist_get (contact, QClog));
4132 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
4133 p->kill_without_query = 1;
4134 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
4135 pset_command (p, Qt);
4136 eassert (p->pid == 0);
4137 p->backlog = 5;
4138 eassert (! p->is_non_blocking_client);
4139 eassert (! p->is_server);
4140 p->port = port;
4141 p->socktype = socktype;
4142 #ifdef HAVE_GETADDRINFO_A
4143 eassert (! p->dns_request);
4144 #endif
4145 #ifdef HAVE_GNUTLS
4146 tem = Fplist_get (contact, QCtls_parameters);
4147 CHECK_LIST (tem);
4148 p->gnutls_boot_parameters = tem;
4149 #endif
4151 set_network_socket_coding_system (proc, host, service, name);
4153 /* :server BOOL */
4154 tem = Fplist_get (contact, QCserver);
4155 if (!NILP (tem))
4157 /* Don't support network sockets when non-blocking mode is
4158 not available, since a blocked Emacs is not useful. */
4159 p->is_server = true;
4160 if (TYPE_RANGED_INTEGERP (int, tem))
4161 p->backlog = XINT (tem);
4164 /* :nowait BOOL */
4165 if (!p->is_server && socktype != SOCK_DGRAM
4166 && !NILP (Fplist_get (contact, QCnowait)))
4167 p->is_non_blocking_client = true;
4169 bool postpone_connection = false;
4170 #ifdef HAVE_GETADDRINFO_A
4171 /* With async address resolution, the list of addresses is empty, so
4172 postpone connecting to the server. */
4173 if (!p->is_server && NILP (addrinfos))
4175 p->dns_request = dns_request;
4176 p->status = list1 (Qconnect);
4177 postpone_connection = true;
4179 #endif
4180 if (! postpone_connection)
4181 connect_network_socket (proc, addrinfos, use_external_socket_p);
4183 specpdl_ptr = specpdl + count;
4184 return proc;
4188 #ifdef HAVE_NET_IF_H
4190 #ifdef SIOCGIFCONF
4191 static Lisp_Object
4192 network_interface_list (void)
4194 struct ifconf ifconf;
4195 struct ifreq *ifreq;
4196 void *buf = NULL;
4197 ptrdiff_t buf_size = 512;
4198 int s;
4199 Lisp_Object res;
4200 ptrdiff_t count;
4202 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4203 if (s < 0)
4204 return Qnil;
4205 count = SPECPDL_INDEX ();
4206 record_unwind_protect_int (close_file_unwind, s);
4210 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
4211 ifconf.ifc_buf = buf;
4212 ifconf.ifc_len = buf_size;
4213 if (ioctl (s, SIOCGIFCONF, &ifconf))
4215 emacs_close (s);
4216 xfree (buf);
4217 return Qnil;
4220 while (ifconf.ifc_len == buf_size);
4222 res = unbind_to (count, Qnil);
4223 ifreq = ifconf.ifc_req;
4224 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
4226 struct ifreq *ifq = ifreq;
4227 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4228 #define SIZEOF_IFREQ(sif) \
4229 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4230 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4232 int len = SIZEOF_IFREQ (ifq);
4233 #else
4234 int len = sizeof (*ifreq);
4235 #endif
4236 char namebuf[sizeof (ifq->ifr_name) + 1];
4237 ifreq = (struct ifreq *) ((char *) ifreq + len);
4239 if (ifq->ifr_addr.sa_family != AF_INET)
4240 continue;
4242 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
4243 namebuf[sizeof (ifq->ifr_name)] = 0;
4244 res = Fcons (Fcons (build_string (namebuf),
4245 conv_sockaddr_to_lisp (&ifq->ifr_addr,
4246 sizeof (struct sockaddr))),
4247 res);
4250 xfree (buf);
4251 return res;
4253 #endif /* SIOCGIFCONF */
4255 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4257 struct ifflag_def {
4258 int flag_bit;
4259 const char *flag_sym;
4262 static const struct ifflag_def ifflag_table[] = {
4263 #ifdef IFF_UP
4264 { IFF_UP, "up" },
4265 #endif
4266 #ifdef IFF_BROADCAST
4267 { IFF_BROADCAST, "broadcast" },
4268 #endif
4269 #ifdef IFF_DEBUG
4270 { IFF_DEBUG, "debug" },
4271 #endif
4272 #ifdef IFF_LOOPBACK
4273 { IFF_LOOPBACK, "loopback" },
4274 #endif
4275 #ifdef IFF_POINTOPOINT
4276 { IFF_POINTOPOINT, "pointopoint" },
4277 #endif
4278 #ifdef IFF_RUNNING
4279 { IFF_RUNNING, "running" },
4280 #endif
4281 #ifdef IFF_NOARP
4282 { IFF_NOARP, "noarp" },
4283 #endif
4284 #ifdef IFF_PROMISC
4285 { IFF_PROMISC, "promisc" },
4286 #endif
4287 #ifdef IFF_NOTRAILERS
4288 #ifdef NS_IMPL_COCOA
4289 /* Really means smart, notrailers is obsolete. */
4290 { IFF_NOTRAILERS, "smart" },
4291 #else
4292 { IFF_NOTRAILERS, "notrailers" },
4293 #endif
4294 #endif
4295 #ifdef IFF_ALLMULTI
4296 { IFF_ALLMULTI, "allmulti" },
4297 #endif
4298 #ifdef IFF_MASTER
4299 { IFF_MASTER, "master" },
4300 #endif
4301 #ifdef IFF_SLAVE
4302 { IFF_SLAVE, "slave" },
4303 #endif
4304 #ifdef IFF_MULTICAST
4305 { IFF_MULTICAST, "multicast" },
4306 #endif
4307 #ifdef IFF_PORTSEL
4308 { IFF_PORTSEL, "portsel" },
4309 #endif
4310 #ifdef IFF_AUTOMEDIA
4311 { IFF_AUTOMEDIA, "automedia" },
4312 #endif
4313 #ifdef IFF_DYNAMIC
4314 { IFF_DYNAMIC, "dynamic" },
4315 #endif
4316 #ifdef IFF_OACTIVE
4317 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress. */
4318 #endif
4319 #ifdef IFF_SIMPLEX
4320 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4321 #endif
4322 #ifdef IFF_LINK0
4323 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit. */
4324 #endif
4325 #ifdef IFF_LINK1
4326 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit. */
4327 #endif
4328 #ifdef IFF_LINK2
4329 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit. */
4330 #endif
4331 { 0, 0 }
4334 static Lisp_Object
4335 network_interface_info (Lisp_Object ifname)
4337 struct ifreq rq;
4338 Lisp_Object res = Qnil;
4339 Lisp_Object elt;
4340 int s;
4341 bool any = 0;
4342 ptrdiff_t count;
4343 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4344 && defined HAVE_GETIFADDRS && defined LLADDR)
4345 struct ifaddrs *ifap;
4346 #endif
4348 CHECK_STRING (ifname);
4350 if (sizeof rq.ifr_name <= SBYTES (ifname))
4351 error ("interface name too long");
4352 lispstpcpy (rq.ifr_name, ifname);
4354 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4355 if (s < 0)
4356 return Qnil;
4357 count = SPECPDL_INDEX ();
4358 record_unwind_protect_int (close_file_unwind, s);
4360 elt = Qnil;
4361 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4362 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4364 int flags = rq.ifr_flags;
4365 const struct ifflag_def *fp;
4366 int fnum;
4368 /* If flags is smaller than int (i.e. short) it may have the high bit set
4369 due to IFF_MULTICAST. In that case, sign extending it into
4370 an int is wrong. */
4371 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4372 flags = (unsigned short) rq.ifr_flags;
4374 any = 1;
4375 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4377 if (flags & fp->flag_bit)
4379 elt = Fcons (intern (fp->flag_sym), elt);
4380 flags -= fp->flag_bit;
4383 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4385 if (flags & 1)
4387 elt = Fcons (make_number (fnum), elt);
4391 #endif
4392 res = Fcons (elt, res);
4394 elt = Qnil;
4395 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4396 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4398 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4399 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4400 int n;
4402 any = 1;
4403 for (n = 0; n < 6; n++)
4404 p->contents[n] = make_number (((unsigned char *)
4405 &rq.ifr_hwaddr.sa_data[0])
4406 [n]);
4407 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4409 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4410 if (getifaddrs (&ifap) != -1)
4412 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4413 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4414 struct ifaddrs *it;
4416 for (it = ifap; it != NULL; it = it->ifa_next)
4418 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4419 unsigned char linkaddr[6];
4420 int n;
4422 if (it->ifa_addr->sa_family != AF_LINK
4423 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4424 || sdl->sdl_alen != 6)
4425 continue;
4427 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4428 for (n = 0; n < 6; n++)
4429 p->contents[n] = make_number (linkaddr[n]);
4431 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
4432 break;
4435 #ifdef HAVE_FREEIFADDRS
4436 freeifaddrs (ifap);
4437 #endif
4439 #endif /* HAVE_GETIFADDRS && LLADDR */
4441 res = Fcons (elt, res);
4443 elt = Qnil;
4444 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4445 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4447 any = 1;
4448 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4449 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4450 #else
4451 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4452 #endif
4454 #endif
4455 res = Fcons (elt, res);
4457 elt = Qnil;
4458 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4459 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4461 any = 1;
4462 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4464 #endif
4465 res = Fcons (elt, res);
4467 elt = Qnil;
4468 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4469 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4471 any = 1;
4472 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4474 #endif
4475 res = Fcons (elt, res);
4477 return unbind_to (count, any ? res : Qnil);
4479 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4480 #endif /* defined (HAVE_NET_IF_H) */
4482 DEFUN ("network-interface-list", Fnetwork_interface_list,
4483 Snetwork_interface_list, 0, 0, 0,
4484 doc: /* Return an alist of all network interfaces and their network address.
4485 Each element is a cons, the car of which is a string containing the
4486 interface name, and the cdr is the network address in internal
4487 format; see the description of ADDRESS in `make-network-process'.
4489 If the information is not available, return nil. */)
4490 (void)
4492 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4493 return network_interface_list ();
4494 #else
4495 return Qnil;
4496 #endif
4499 DEFUN ("network-interface-info", Fnetwork_interface_info,
4500 Snetwork_interface_info, 1, 1, 0,
4501 doc: /* Return information about network interface named IFNAME.
4502 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4503 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4504 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4505 FLAGS is the current flags of the interface.
4507 Data that is unavailable is returned as nil. */)
4508 (Lisp_Object ifname)
4510 #if ((defined HAVE_NET_IF_H \
4511 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4512 || defined SIOCGIFFLAGS)) \
4513 || defined WINDOWSNT)
4514 return network_interface_info (ifname);
4515 #else
4516 return Qnil;
4517 #endif
4520 /* Turn off input and output for process PROC. */
4522 static void
4523 deactivate_process (Lisp_Object proc)
4525 int inchannel;
4526 struct Lisp_Process *p = XPROCESS (proc);
4527 int i;
4529 #ifdef HAVE_GNUTLS
4530 /* Delete GnuTLS structures in PROC, if any. */
4531 emacs_gnutls_deinit (proc);
4532 #endif /* HAVE_GNUTLS */
4534 if (p->read_output_delay > 0)
4536 if (--process_output_delay_count < 0)
4537 process_output_delay_count = 0;
4538 p->read_output_delay = 0;
4539 p->read_output_skip = 0;
4542 /* Beware SIGCHLD hereabouts. */
4544 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4545 close_process_fd (&p->open_fd[i]);
4547 inchannel = p->infd;
4548 if (inchannel >= 0)
4550 p->infd = -1;
4551 p->outfd = -1;
4552 #ifdef DATAGRAM_SOCKETS
4553 if (DATAGRAM_CHAN_P (inchannel))
4555 xfree (datagram_address[inchannel].sa);
4556 datagram_address[inchannel].sa = 0;
4557 datagram_address[inchannel].len = 0;
4559 #endif
4560 chan_process[inchannel] = Qnil;
4561 delete_read_fd (inchannel);
4562 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4563 delete_write_fd (inchannel);
4564 if (inchannel == max_desc)
4565 recompute_max_desc ();
4570 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4571 0, 4, 0,
4572 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4573 It is given to their filter functions.
4574 Optional argument PROCESS means do not return until output has been
4575 received from PROCESS.
4577 Optional second argument SECONDS and third argument MILLISEC
4578 specify a timeout; return after that much time even if there is
4579 no subprocess output. If SECONDS is a floating point number,
4580 it specifies a fractional number of seconds to wait.
4581 The MILLISEC argument is obsolete and should be avoided.
4583 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4584 from PROCESS only, suspending reading output from other processes.
4585 If JUST-THIS-ONE is an integer, don't run any timers either.
4586 Return non-nil if we received any output from PROCESS (or, if PROCESS
4587 is nil, from any process) before the timeout expired. */)
4588 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4589 Lisp_Object just_this_one)
4591 intmax_t secs;
4592 int nsecs;
4594 if (! NILP (process))
4596 CHECK_PROCESS (process);
4597 struct Lisp_Process *proc = XPROCESS (process);
4599 /* Can't wait for a process that is dedicated to a different
4600 thread. */
4601 if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ()))
4603 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4605 if (STRINGP (proc_thread_name))
4606 error ("Attempt to accept output from process %s locked to thread %s",
4607 SDATA (proc->name), SDATA (proc_thread_name));
4608 else
4609 error ("Attempt to accept output from process %s locked to thread %p",
4610 SDATA (proc->name), XTHREAD (proc->thread));
4613 else
4614 just_this_one = Qnil;
4616 if (!NILP (millisec))
4617 { /* Obsolete calling convention using integers rather than floats. */
4618 CHECK_NUMBER (millisec);
4619 if (NILP (seconds))
4620 seconds = make_float (XINT (millisec) / 1000.0);
4621 else
4623 CHECK_NUMBER (seconds);
4624 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4628 secs = 0;
4629 nsecs = -1;
4631 if (!NILP (seconds))
4633 if (INTEGERP (seconds))
4635 if (XINT (seconds) > 0)
4637 secs = XINT (seconds);
4638 nsecs = 0;
4641 else if (FLOATP (seconds))
4643 if (XFLOAT_DATA (seconds) > 0)
4645 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4646 secs = min (t.tv_sec, WAIT_READING_MAX);
4647 nsecs = t.tv_nsec;
4650 else
4651 wrong_type_argument (Qnumberp, seconds);
4653 else if (! NILP (process))
4654 nsecs = 0;
4656 return
4657 ((wait_reading_process_output (secs, nsecs, 0, 0,
4658 Qnil,
4659 !NILP (process) ? XPROCESS (process) : NULL,
4660 (NILP (just_this_one) ? 0
4661 : !INTEGERP (just_this_one) ? 1 : -1))
4662 <= 0)
4663 ? Qnil : Qt);
4666 /* Accept a connection for server process SERVER on CHANNEL. */
4668 static EMACS_INT connect_counter = 0;
4670 static void
4671 server_accept_connection (Lisp_Object server, int channel)
4673 Lisp_Object buffer;
4674 Lisp_Object contact, host, service;
4675 struct Lisp_Process *ps = XPROCESS (server);
4676 struct Lisp_Process *p;
4677 int s;
4678 union u_sockaddr {
4679 struct sockaddr sa;
4680 struct sockaddr_in in;
4681 #ifdef AF_INET6
4682 struct sockaddr_in6 in6;
4683 #endif
4684 #ifdef HAVE_LOCAL_SOCKETS
4685 struct sockaddr_un un;
4686 #endif
4687 } saddr;
4688 socklen_t len = sizeof saddr;
4689 ptrdiff_t count;
4691 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4693 if (s < 0)
4695 int code = errno;
4696 if (!would_block (code) && !NILP (ps->log))
4697 call3 (ps->log, server, Qnil,
4698 concat3 (build_string ("accept failed with code"),
4699 Fnumber_to_string (make_number (code)),
4700 build_string ("\n")));
4701 return;
4704 count = SPECPDL_INDEX ();
4705 record_unwind_protect_int (close_file_unwind, s);
4707 connect_counter++;
4709 /* Setup a new process to handle the connection. */
4711 /* Generate a unique identification of the caller, and build contact
4712 information for this process. */
4713 host = Qt;
4714 service = Qnil;
4715 Lisp_Object args[11];
4716 int nargs = 0;
4717 AUTO_STRING (procname_format_in, "%s <%d.%d.%d.%d:%d>");
4718 AUTO_STRING (procname_format_in6, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4719 AUTO_STRING (procname_format_default, "%s <%d>");
4720 switch (saddr.sa.sa_family)
4722 case AF_INET:
4724 args[nargs++] = procname_format_in;
4725 nargs++;
4726 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4727 service = make_number (ntohs (saddr.in.sin_port));
4728 for (int i = 0; i < 4; i++)
4729 args[nargs++] = make_number (ip[i]);
4730 args[nargs++] = service;
4732 break;
4734 #ifdef AF_INET6
4735 case AF_INET6:
4737 args[nargs++] = procname_format_in6;
4738 nargs++;
4739 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4740 service = make_number (ntohs (saddr.in.sin_port));
4741 for (int i = 0; i < 8; i++)
4742 args[nargs++] = make_number (ip6[i]);
4743 args[nargs++] = service;
4745 break;
4746 #endif
4748 default:
4749 args[nargs++] = procname_format_default;
4750 nargs++;
4751 args[nargs++] = make_number (connect_counter);
4752 break;
4755 /* Create a new buffer name for this process if it doesn't have a
4756 filter. The new buffer name is based on the buffer name or
4757 process name of the server process concatenated with the caller
4758 identification. */
4760 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4761 || EQ (ps->filter, Qt)))
4762 buffer = Qnil;
4763 else
4765 buffer = ps->buffer;
4766 if (!NILP (buffer))
4767 buffer = Fbuffer_name (buffer);
4768 else
4769 buffer = ps->name;
4770 if (!NILP (buffer))
4772 args[1] = buffer;
4773 buffer = Fget_buffer_create (Fformat (nargs, args));
4777 /* Generate a unique name for the new server process. Combine the
4778 server process name with the caller identification. */
4780 args[1] = ps->name;
4781 Lisp_Object name = Fformat (nargs, args);
4782 Lisp_Object proc = make_process (name);
4784 chan_process[s] = proc;
4786 fcntl (s, F_SETFL, O_NONBLOCK);
4788 p = XPROCESS (proc);
4790 /* Build new contact information for this setup. */
4791 contact = Fcopy_sequence (ps->childp);
4792 contact = Fplist_put (contact, QCserver, Qnil);
4793 contact = Fplist_put (contact, QChost, host);
4794 if (!NILP (service))
4795 contact = Fplist_put (contact, QCservice, service);
4796 contact = Fplist_put (contact, QCremote,
4797 conv_sockaddr_to_lisp (&saddr.sa, len));
4798 #ifdef HAVE_GETSOCKNAME
4799 len = sizeof saddr;
4800 if (getsockname (s, &saddr.sa, &len) == 0)
4801 contact = Fplist_put (contact, QClocal,
4802 conv_sockaddr_to_lisp (&saddr.sa, len));
4803 #endif
4805 pset_childp (p, contact);
4806 pset_plist (p, Fcopy_sequence (ps->plist));
4807 pset_type (p, Qnetwork);
4809 pset_buffer (p, buffer);
4810 pset_sentinel (p, ps->sentinel);
4811 pset_filter (p, ps->filter);
4812 eassert (NILP (p->command));
4813 eassert (p->pid == 0);
4815 /* Discard the unwind protect for closing S. */
4816 specpdl_ptr = specpdl + count;
4818 p->open_fd[SUBPROCESS_STDIN] = s;
4819 p->infd = s;
4820 p->outfd = s;
4821 pset_status (p, Qrun);
4823 /* Client processes for accepted connections are not stopped initially. */
4824 if (!EQ (p->filter, Qt))
4825 add_process_read_fd (s);
4826 if (s > max_desc)
4827 max_desc = s;
4829 /* Setup coding system for new process based on server process.
4830 This seems to be the proper thing to do, as the coding system
4831 of the new process should reflect the settings at the time the
4832 server socket was opened; not the current settings. */
4834 pset_decode_coding_system (p, ps->decode_coding_system);
4835 pset_encode_coding_system (p, ps->encode_coding_system);
4836 setup_process_coding_systems (proc);
4838 pset_decoding_buf (p, empty_unibyte_string);
4839 eassert (p->decoding_carryover == 0);
4840 pset_encoding_buf (p, empty_unibyte_string);
4842 p->inherit_coding_system_flag
4843 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4845 AUTO_STRING (dash, "-");
4846 AUTO_STRING (nl, "\n");
4847 Lisp_Object host_string = STRINGP (host) ? host : dash;
4849 if (!NILP (ps->log))
4851 AUTO_STRING (accept_from, "accept from ");
4852 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
4855 AUTO_STRING (open_from, "open from ");
4856 exec_sentinel (proc, concat3 (open_from, host_string, nl));
4859 #ifdef HAVE_GETADDRINFO_A
4860 static Lisp_Object
4861 check_for_dns (Lisp_Object proc)
4863 struct Lisp_Process *p = XPROCESS (proc);
4864 Lisp_Object addrinfos = Qnil;
4866 /* Sanity check. */
4867 if (! p->dns_request)
4868 return Qnil;
4870 int ret = gai_error (p->dns_request);
4871 if (ret == EAI_INPROGRESS)
4872 return Qt;
4874 /* We got a response. */
4875 if (ret == 0)
4877 struct addrinfo *res;
4879 for (res = p->dns_request->ar_result; res; res = res->ai_next)
4880 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
4882 addrinfos = Fnreverse (addrinfos);
4884 /* The DNS lookup failed. */
4885 else if (connecting_status (p->status))
4887 deactivate_process (proc);
4888 pset_status (p, (list2
4889 (Qfailed,
4890 concat3 (build_string ("Name lookup of "),
4891 build_string (p->dns_request->ar_name),
4892 build_string (" failed")))));
4895 free_dns_request (proc);
4897 /* This process should not already be connected (or killed). */
4898 if (! connecting_status (p->status))
4899 return Qnil;
4901 return addrinfos;
4904 #endif /* HAVE_GETADDRINFO_A */
4906 static void
4907 wait_for_socket_fds (Lisp_Object process, char const *name)
4909 while (XPROCESS (process)->infd < 0
4910 && connecting_status (XPROCESS (process)->status))
4912 add_to_log ("Waiting for socket from %s...", build_string (name));
4913 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4917 static void
4918 wait_while_connecting (Lisp_Object process)
4920 while (connecting_status (XPROCESS (process)->status))
4922 add_to_log ("Waiting for connection...");
4923 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4927 static void
4928 wait_for_tls_negotiation (Lisp_Object process)
4930 #ifdef HAVE_GNUTLS
4931 while (XPROCESS (process)->gnutls_p
4932 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
4934 add_to_log ("Waiting for TLS...");
4935 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4937 #endif
4940 static void
4941 wait_reading_process_output_unwind (int data)
4943 clear_waiting_thread_info ();
4944 waiting_for_user_input_p = data;
4947 /* This is here so breakpoints can be put on it. */
4948 static void
4949 wait_reading_process_output_1 (void)
4953 /* Read and dispose of subprocess output while waiting for timeout to
4954 elapse and/or keyboard input to be available.
4956 TIME_LIMIT is:
4957 timeout in seconds
4958 If negative, gobble data immediately available but don't wait for any.
4960 NSECS is:
4961 an additional duration to wait, measured in nanoseconds
4962 If TIME_LIMIT is zero, then:
4963 If NSECS == 0, there is no limit.
4964 If NSECS > 0, the timeout consists of NSECS only.
4965 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4967 READ_KBD is:
4968 0 to ignore keyboard input, or
4969 1 to return when input is available, or
4970 -1 meaning caller will actually read the input, so don't throw to
4971 the quit handler
4973 DO_DISPLAY means redisplay should be done to show subprocess
4974 output that arrives.
4976 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4977 (and gobble terminal input into the buffer if any arrives).
4979 If WAIT_PROC is specified, wait until something arrives from that
4980 process.
4982 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4983 (suspending output from other processes). A negative value
4984 means don't run any timers either.
4986 Return positive if we received input from WAIT_PROC (or from any
4987 process if WAIT_PROC is null), zero if we attempted to receive
4988 input but got none, and negative if we didn't even try. */
4991 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4992 bool do_display,
4993 Lisp_Object wait_for_cell,
4994 struct Lisp_Process *wait_proc, int just_wait_proc)
4996 int channel, nfds;
4997 fd_set Available;
4998 fd_set Writeok;
4999 bool check_write;
5000 int check_delay;
5001 bool no_avail;
5002 int xerrno;
5003 Lisp_Object proc;
5004 struct timespec timeout, end_time, timer_delay;
5005 struct timespec got_output_end_time = invalid_timespec ();
5006 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
5007 int got_some_output = -1;
5008 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5009 bool retry_for_async;
5010 #endif
5011 ptrdiff_t count = SPECPDL_INDEX ();
5013 /* Close to the current time if known, an invalid timespec otherwise. */
5014 struct timespec now = invalid_timespec ();
5016 eassert (wait_proc == NULL
5017 || EQ (wait_proc->thread, Qnil)
5018 || XTHREAD (wait_proc->thread) == current_thread);
5020 FD_ZERO (&Available);
5021 FD_ZERO (&Writeok);
5023 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5024 && !(CONSP (wait_proc->status)
5025 && EQ (XCAR (wait_proc->status), Qexit)))
5026 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5028 record_unwind_protect_int (wait_reading_process_output_unwind,
5029 waiting_for_user_input_p);
5030 waiting_for_user_input_p = read_kbd;
5032 if (TYPE_MAXIMUM (time_t) < time_limit)
5033 time_limit = TYPE_MAXIMUM (time_t);
5035 if (time_limit < 0 || nsecs < 0)
5036 wait = MINIMUM;
5037 else if (time_limit > 0 || nsecs > 0)
5039 wait = TIMEOUT;
5040 now = current_timespec ();
5041 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5043 else
5044 wait = INFINITY;
5046 while (1)
5048 bool process_skipped = false;
5050 /* If calling from keyboard input, do not quit
5051 since we want to return C-g as an input character.
5052 Otherwise, do pending quit if requested. */
5053 if (read_kbd >= 0)
5054 maybe_quit ();
5055 else if (pending_signals)
5056 process_pending_signals ();
5058 /* Exit now if the cell we're waiting for became non-nil. */
5059 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5060 break;
5062 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5064 Lisp_Object process_list_head, aproc;
5065 struct Lisp_Process *p;
5067 retry_for_async = false;
5068 FOR_EACH_PROCESS(process_list_head, aproc)
5070 p = XPROCESS (aproc);
5072 if (! wait_proc || p == wait_proc)
5074 #ifdef HAVE_GETADDRINFO_A
5075 /* Check for pending DNS requests. */
5076 if (p->dns_request)
5078 Lisp_Object addrinfos = check_for_dns (aproc);
5079 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5080 connect_network_socket (aproc, addrinfos, Qnil);
5081 else
5082 retry_for_async = true;
5084 #endif
5085 #ifdef HAVE_GNUTLS
5086 /* Continue TLS negotiation. */
5087 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5088 && p->is_non_blocking_client)
5090 gnutls_try_handshake (p);
5091 p->gnutls_handshakes_tried++;
5093 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5095 gnutls_verify_boot (aproc, Qnil);
5096 finish_after_tls_connection (aproc);
5098 else
5100 retry_for_async = true;
5101 if (p->gnutls_handshakes_tried
5102 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5104 deactivate_process (aproc);
5105 pset_status (p, list2 (Qfailed,
5106 build_string ("TLS negotiation failed")));
5110 #endif
5114 #endif /* GETADDRINFO_A or GNUTLS */
5116 /* Compute time from now till when time limit is up. */
5117 /* Exit if already run out. */
5118 if (wait == TIMEOUT)
5120 if (!timespec_valid_p (now))
5121 now = current_timespec ();
5122 if (timespec_cmp (end_time, now) <= 0)
5123 break;
5124 timeout = timespec_sub (end_time, now);
5126 else
5127 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5129 /* Normally we run timers here.
5130 But not if wait_for_cell; in those cases,
5131 the wait is supposed to be short,
5132 and those callers cannot handle running arbitrary Lisp code here. */
5133 if (NILP (wait_for_cell)
5134 && just_wait_proc >= 0)
5138 unsigned old_timers_run = timers_run;
5139 struct buffer *old_buffer = current_buffer;
5140 Lisp_Object old_window = selected_window;
5142 timer_delay = timer_check ();
5144 /* If a timer has run, this might have changed buffers
5145 an alike. Make read_key_sequence aware of that. */
5146 if (timers_run != old_timers_run
5147 && (old_buffer != current_buffer
5148 || !EQ (old_window, selected_window))
5149 && waiting_for_user_input_p == -1)
5150 record_asynch_buffer_change ();
5152 if (timers_run != old_timers_run && do_display)
5153 /* We must retry, since a timer may have requeued itself
5154 and that could alter the time_delay. */
5155 redisplay_preserve_echo_area (9);
5156 else
5157 break;
5159 while (!detect_input_pending ());
5161 /* If there is unread keyboard input, also return. */
5162 if (read_kbd != 0
5163 && requeued_events_pending_p ())
5164 break;
5166 /* This is so a breakpoint can be put here. */
5167 if (!timespec_valid_p (timer_delay))
5168 wait_reading_process_output_1 ();
5171 /* Cause C-g and alarm signals to take immediate action,
5172 and cause input available signals to zero out timeout.
5174 It is important that we do this before checking for process
5175 activity. If we get a SIGCHLD after the explicit checks for
5176 process activity, timeout is the only way we will know. */
5177 if (read_kbd < 0)
5178 set_waiting_for_input (&timeout);
5180 /* If status of something has changed, and no input is
5181 available, notify the user of the change right away. After
5182 this explicit check, we'll let the SIGCHLD handler zap
5183 timeout to get our attention. */
5184 if (update_tick != process_tick)
5186 fd_set Atemp;
5187 fd_set Ctemp;
5189 if (kbd_on_hold_p ())
5190 FD_ZERO (&Atemp);
5191 else
5192 compute_input_wait_mask (&Atemp);
5193 compute_write_mask (&Ctemp);
5195 timeout = make_timespec (0, 0);
5196 if ((thread_select (pselect, max_desc + 1,
5197 &Atemp,
5198 (num_pending_connects > 0 ? &Ctemp : NULL),
5199 NULL, &timeout, NULL)
5200 <= 0))
5202 /* It's okay for us to do this and then continue with
5203 the loop, since timeout has already been zeroed out. */
5204 clear_waiting_for_input ();
5205 got_some_output = status_notify (NULL, wait_proc);
5206 if (do_display) redisplay_preserve_echo_area (13);
5210 /* Don't wait for output from a non-running process. Just
5211 read whatever data has already been received. */
5212 if (wait_proc && wait_proc->raw_status_new)
5213 update_status (wait_proc);
5214 if (wait_proc
5215 && ! EQ (wait_proc->status, Qrun)
5216 && ! connecting_status (wait_proc->status))
5218 bool read_some_bytes = false;
5220 clear_waiting_for_input ();
5222 /* If data can be read from the process, do so until exhausted. */
5223 if (wait_proc->infd >= 0)
5225 XSETPROCESS (proc, wait_proc);
5227 while (true)
5229 int nread = read_process_output (proc, wait_proc->infd);
5230 if (nread < 0)
5232 if (errno == EIO || would_block (errno))
5233 break;
5235 else
5237 if (got_some_output < nread)
5238 got_some_output = nread;
5239 if (nread == 0)
5240 break;
5241 read_some_bytes = true;
5246 if (read_some_bytes && do_display)
5247 redisplay_preserve_echo_area (10);
5249 break;
5252 /* Wait till there is something to do. */
5254 if (wait_proc && just_wait_proc)
5256 if (wait_proc->infd < 0) /* Terminated. */
5257 break;
5258 FD_SET (wait_proc->infd, &Available);
5259 check_delay = 0;
5260 check_write = 0;
5262 else if (!NILP (wait_for_cell))
5264 compute_non_process_wait_mask (&Available);
5265 check_delay = 0;
5266 check_write = 0;
5268 else
5270 if (! read_kbd)
5271 compute_non_keyboard_wait_mask (&Available);
5272 else
5273 compute_input_wait_mask (&Available);
5274 compute_write_mask (&Writeok);
5275 check_delay = wait_proc ? 0 : process_output_delay_count;
5276 check_write = true;
5279 /* If frame size has changed or the window is newly mapped,
5280 redisplay now, before we start to wait. There is a race
5281 condition here; if a SIGIO arrives between now and the select
5282 and indicates that a frame is trashed, the select may block
5283 displaying a trashed screen. */
5284 if (frame_garbaged && do_display)
5286 clear_waiting_for_input ();
5287 redisplay_preserve_echo_area (11);
5288 if (read_kbd < 0)
5289 set_waiting_for_input (&timeout);
5292 /* Skip the `select' call if input is available and we're
5293 waiting for keyboard input or a cell change (which can be
5294 triggered by processing X events). In the latter case, set
5295 nfds to 1 to avoid breaking the loop. */
5296 no_avail = 0;
5297 if ((read_kbd || !NILP (wait_for_cell))
5298 && detect_input_pending ())
5300 nfds = read_kbd ? 0 : 1;
5301 no_avail = 1;
5302 FD_ZERO (&Available);
5304 else
5306 /* Set the timeout for adaptive read buffering if any
5307 process has non-zero read_output_skip and non-zero
5308 read_output_delay, and we are not reading output for a
5309 specific process. It is not executed if
5310 Vprocess_adaptive_read_buffering is nil. */
5311 if (process_output_skip && check_delay > 0)
5313 int adaptive_nsecs = timeout.tv_nsec;
5314 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5315 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5316 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5318 proc = chan_process[channel];
5319 if (NILP (proc))
5320 continue;
5321 /* Find minimum non-zero read_output_delay among the
5322 processes with non-zero read_output_skip. */
5323 if (XPROCESS (proc)->read_output_delay > 0)
5325 check_delay--;
5326 if (!XPROCESS (proc)->read_output_skip)
5327 continue;
5328 FD_CLR (channel, &Available);
5329 process_skipped = true;
5330 XPROCESS (proc)->read_output_skip = 0;
5331 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5332 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5335 timeout = make_timespec (0, adaptive_nsecs);
5336 process_output_skip = 0;
5339 /* If we've got some output and haven't limited our timeout
5340 with adaptive read buffering, limit it. */
5341 if (got_some_output > 0 && !process_skipped
5342 && (timeout.tv_sec
5343 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5344 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5347 if (NILP (wait_for_cell) && just_wait_proc >= 0
5348 && timespec_valid_p (timer_delay)
5349 && timespec_cmp (timer_delay, timeout) < 0)
5351 if (!timespec_valid_p (now))
5352 now = current_timespec ();
5353 struct timespec timeout_abs = timespec_add (now, timeout);
5354 if (!timespec_valid_p (got_output_end_time)
5355 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5356 got_output_end_time = timeout_abs;
5357 timeout = timer_delay;
5359 else
5360 got_output_end_time = invalid_timespec ();
5362 /* NOW can become inaccurate if time can pass during pselect. */
5363 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5364 now = invalid_timespec ();
5366 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5367 if (retry_for_async
5368 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5370 timeout.tv_sec = 0;
5371 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5373 #endif
5375 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5376 #if defined HAVE_GLIB && !defined HAVE_NS
5377 nfds = xg_select (max_desc + 1,
5378 &Available, (check_write ? &Writeok : 0),
5379 NULL, &timeout, NULL);
5380 #elif defined HAVE_NS
5381 /* And NS builds call thread_select in ns_select. */
5382 nfds = ns_select (max_desc + 1,
5383 &Available, (check_write ? &Writeok : 0),
5384 NULL, &timeout, NULL);
5385 #else /* !HAVE_GLIB */
5386 nfds = thread_select (pselect, max_desc + 1,
5387 &Available,
5388 (check_write ? &Writeok : 0),
5389 NULL, &timeout, NULL);
5390 #endif /* !HAVE_GLIB */
5392 #ifdef HAVE_GNUTLS
5393 /* GnuTLS buffers data internally. In lowat mode it leaves
5394 some data in the TCP buffers so that select works, but
5395 with custom pull/push functions we need to check if some
5396 data is available in the buffers manually. */
5397 if (nfds == 0)
5399 fd_set tls_available;
5400 int set = 0;
5402 FD_ZERO (&tls_available);
5403 if (! wait_proc)
5405 /* We're not waiting on a specific process, so loop
5406 through all the channels and check for data.
5407 This is a workaround needed for some versions of
5408 the gnutls library -- 2.12.14 has been confirmed
5409 to need it. See
5410 http://comments.gmane.org/gmane.emacs.devel/145074 */
5411 for (channel = 0; channel < FD_SETSIZE; ++channel)
5412 if (! NILP (chan_process[channel]))
5414 struct Lisp_Process *p =
5415 XPROCESS (chan_process[channel]);
5416 if (p && p->gnutls_p && p->gnutls_state
5417 && ((emacs_gnutls_record_check_pending
5418 (p->gnutls_state))
5419 > 0))
5421 nfds++;
5422 eassert (p->infd == channel);
5423 FD_SET (p->infd, &tls_available);
5424 set++;
5428 else
5430 /* Check this specific channel. */
5431 if (wait_proc->gnutls_p /* Check for valid process. */
5432 && wait_proc->gnutls_state
5433 /* Do we have pending data? */
5434 && ((emacs_gnutls_record_check_pending
5435 (wait_proc->gnutls_state))
5436 > 0))
5438 nfds = 1;
5439 eassert (0 <= wait_proc->infd);
5440 /* Set to Available. */
5441 FD_SET (wait_proc->infd, &tls_available);
5442 set++;
5445 if (set)
5446 Available = tls_available;
5448 #endif
5451 xerrno = errno;
5453 /* Make C-g and alarm signals set flags again. */
5454 clear_waiting_for_input ();
5456 /* If we woke up due to SIGWINCH, actually change size now. */
5457 do_pending_window_change (0);
5459 if (nfds == 0)
5461 /* Exit the main loop if we've passed the requested timeout,
5462 or aren't skipping processes and got some output and
5463 haven't lowered our timeout due to timers or SIGIO and
5464 have waited a long amount of time due to repeated
5465 timers. */
5466 struct timespec huge_timespec
5467 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
5468 struct timespec cmp_time = huge_timespec;
5469 if (wait < TIMEOUT)
5470 break;
5471 if (wait == TIMEOUT)
5472 cmp_time = end_time;
5473 if (!process_skipped && got_some_output > 0
5474 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5476 if (!timespec_valid_p (got_output_end_time))
5477 break;
5478 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5479 cmp_time = got_output_end_time;
5481 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5483 now = current_timespec ();
5484 if (timespec_cmp (cmp_time, now) <= 0)
5485 break;
5489 if (nfds < 0)
5491 if (xerrno == EINTR)
5492 no_avail = 1;
5493 else if (xerrno == EBADF)
5494 emacs_abort ();
5495 else
5496 report_file_errno ("Failed select", Qnil, xerrno);
5499 /* Check for keyboard input. */
5500 /* If there is any, return immediately
5501 to give it higher priority than subprocesses. */
5503 if (read_kbd != 0)
5505 unsigned old_timers_run = timers_run;
5506 struct buffer *old_buffer = current_buffer;
5507 Lisp_Object old_window = selected_window;
5508 bool leave = false;
5510 if (detect_input_pending_run_timers (do_display))
5512 swallow_events (do_display);
5513 if (detect_input_pending_run_timers (do_display))
5514 leave = true;
5517 /* If a timer has run, this might have changed buffers
5518 an alike. Make read_key_sequence aware of that. */
5519 if (timers_run != old_timers_run
5520 && waiting_for_user_input_p == -1
5521 && (old_buffer != current_buffer
5522 || !EQ (old_window, selected_window)))
5523 record_asynch_buffer_change ();
5525 if (leave)
5526 break;
5529 /* If there is unread keyboard input, also return. */
5530 if (read_kbd != 0
5531 && requeued_events_pending_p ())
5532 break;
5534 /* If we are not checking for keyboard input now,
5535 do process events (but don't run any timers).
5536 This is so that X events will be processed.
5537 Otherwise they may have to wait until polling takes place.
5538 That would causes delays in pasting selections, for example.
5540 (We used to do this only if wait_for_cell.) */
5541 if (read_kbd == 0 && detect_input_pending ())
5543 swallow_events (do_display);
5544 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5545 if (detect_input_pending ())
5546 break;
5547 #endif
5550 /* Exit now if the cell we're waiting for became non-nil. */
5551 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5552 break;
5554 #ifdef USABLE_SIGIO
5555 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5556 go read it. This can happen with X on BSD after logging out.
5557 In that case, there really is no input and no SIGIO,
5558 but select says there is input. */
5560 if (read_kbd && interrupt_input
5561 && keyboard_bit_set (&Available) && ! noninteractive)
5562 handle_input_available_signal (SIGIO);
5563 #endif
5565 /* If checking input just got us a size-change event from X,
5566 obey it now if we should. */
5567 if (read_kbd || ! NILP (wait_for_cell))
5568 do_pending_window_change (0);
5570 /* Check for data from a process. */
5571 if (no_avail || nfds == 0)
5572 continue;
5574 for (channel = 0; channel <= max_desc; ++channel)
5576 struct fd_callback_data *d = &fd_callback_info[channel];
5577 if (d->func
5578 && ((d->flags & FOR_READ
5579 && FD_ISSET (channel, &Available))
5580 || ((d->flags & FOR_WRITE)
5581 && FD_ISSET (channel, &Writeok))))
5582 d->func (channel, d->data);
5585 for (channel = 0; channel <= max_desc; channel++)
5587 if (FD_ISSET (channel, &Available)
5588 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5589 == PROCESS_FD))
5591 int nread;
5593 /* If waiting for this channel, arrange to return as
5594 soon as no more input to be processed. No more
5595 waiting. */
5596 proc = chan_process[channel];
5597 if (NILP (proc))
5598 continue;
5600 /* If this is a server stream socket, accept connection. */
5601 if (EQ (XPROCESS (proc)->status, Qlisten))
5603 server_accept_connection (proc, channel);
5604 continue;
5607 /* Read data from the process, starting with our
5608 buffered-ahead character if we have one. */
5610 nread = read_process_output (proc, channel);
5611 if ((!wait_proc || wait_proc == XPROCESS (proc))
5612 && got_some_output < nread)
5613 got_some_output = nread;
5614 if (nread > 0)
5616 /* Vacuum up any leftovers without waiting. */
5617 if (wait_proc == XPROCESS (proc))
5618 wait = MINIMUM;
5619 /* Since read_process_output can run a filter,
5620 which can call accept-process-output,
5621 don't try to read from any other processes
5622 before doing the select again. */
5623 FD_ZERO (&Available);
5625 if (do_display)
5626 redisplay_preserve_echo_area (12);
5628 else if (nread == -1 && would_block (errno))
5630 #ifdef HAVE_PTYS
5631 /* On some OSs with ptys, when the process on one end of
5632 a pty exits, the other end gets an error reading with
5633 errno = EIO instead of getting an EOF (0 bytes read).
5634 Therefore, if we get an error reading and errno =
5635 EIO, just continue, because the child process has
5636 exited and should clean itself up soon (e.g. when we
5637 get a SIGCHLD). */
5638 else if (nread == -1 && errno == EIO)
5640 struct Lisp_Process *p = XPROCESS (proc);
5642 /* Clear the descriptor now, so we only raise the
5643 signal once. */
5644 delete_read_fd (channel);
5646 if (p->pid == -2)
5648 /* If the EIO occurs on a pty, the SIGCHLD handler's
5649 waitpid call will not find the process object to
5650 delete. Do it here. */
5651 p->tick = ++process_tick;
5652 pset_status (p, Qfailed);
5655 #endif /* HAVE_PTYS */
5656 /* If we can detect process termination, don't consider the
5657 process gone just because its pipe is closed. */
5658 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5659 && !PIPECONN_P (proc))
5661 else if (nread == 0 && PIPECONN_P (proc))
5663 /* Preserve status of processes already terminated. */
5664 XPROCESS (proc)->tick = ++process_tick;
5665 deactivate_process (proc);
5666 if (EQ (XPROCESS (proc)->status, Qrun))
5667 pset_status (XPROCESS (proc),
5668 list2 (Qexit, make_number (0)));
5670 else
5672 /* Preserve status of processes already terminated. */
5673 XPROCESS (proc)->tick = ++process_tick;
5674 deactivate_process (proc);
5675 if (XPROCESS (proc)->raw_status_new)
5676 update_status (XPROCESS (proc));
5677 if (EQ (XPROCESS (proc)->status, Qrun))
5678 pset_status (XPROCESS (proc),
5679 list2 (Qexit, make_number (256)));
5682 if (FD_ISSET (channel, &Writeok)
5683 && (fd_callback_info[channel].flags
5684 & NON_BLOCKING_CONNECT_FD) != 0)
5686 struct Lisp_Process *p;
5688 delete_write_fd (channel);
5690 proc = chan_process[channel];
5691 if (NILP (proc))
5692 continue;
5694 p = XPROCESS (proc);
5696 #ifndef WINDOWSNT
5698 socklen_t xlen = sizeof (xerrno);
5699 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5700 xerrno = errno;
5702 #else
5703 /* On MS-Windows, getsockopt clears the error for the
5704 entire process, which may not be the right thing; see
5705 w32.c. Use getpeername instead. */
5707 struct sockaddr pname;
5708 socklen_t pnamelen = sizeof (pname);
5710 /* If connection failed, getpeername will fail. */
5711 xerrno = 0;
5712 if (getpeername (channel, &pname, &pnamelen) < 0)
5714 /* Obtain connect failure code through error slippage. */
5715 char dummy;
5716 xerrno = errno;
5717 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
5718 xerrno = errno;
5721 #endif
5722 if (xerrno)
5724 Lisp_Object addrinfos
5725 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
5726 if (!NILP (addrinfos))
5727 XSETCDR (p->status, XCDR (addrinfos));
5728 else
5730 p->tick = ++process_tick;
5731 pset_status (p, list2 (Qfailed, make_number (xerrno)));
5733 deactivate_process (proc);
5734 if (!NILP (addrinfos))
5735 connect_network_socket (proc, addrinfos, Qnil);
5737 else
5739 #ifdef HAVE_GNUTLS
5740 /* If we have an incompletely set up TLS connection,
5741 then defer the sentinel signaling until
5742 later. */
5743 if (NILP (p->gnutls_boot_parameters)
5744 && !p->gnutls_p)
5745 #endif
5747 pset_status (p, Qrun);
5748 /* Execute the sentinel here. If we had relied on
5749 status_notify to do it later, it will read input
5750 from the process before calling the sentinel. */
5751 exec_sentinel (proc, build_string ("open\n"));
5754 if (0 <= p->infd && !EQ (p->filter, Qt)
5755 && !EQ (p->command, Qt))
5756 add_process_read_fd (p->infd);
5759 } /* End for each file descriptor. */
5760 } /* End while exit conditions not met. */
5762 unbind_to (count, Qnil);
5764 /* If calling from keyboard input, do not quit
5765 since we want to return C-g as an input character.
5766 Otherwise, do pending quit if requested. */
5767 if (read_kbd >= 0)
5769 /* Prevent input_pending from remaining set if we quit. */
5770 clear_input_pending ();
5771 maybe_quit ();
5774 return got_some_output;
5777 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5779 static Lisp_Object
5780 read_process_output_call (Lisp_Object fun_and_args)
5782 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5785 static Lisp_Object
5786 read_process_output_error_handler (Lisp_Object error_val)
5788 cmd_error_internal (error_val, "error in process filter: ");
5789 Vinhibit_quit = Qt;
5790 update_echo_area ();
5791 Fsleep_for (make_number (2), Qnil);
5792 return Qt;
5795 static void
5796 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5797 ssize_t nbytes,
5798 struct coding_system *coding);
5800 /* Read pending output from the process channel,
5801 starting with our buffered-ahead character if we have one.
5802 Yield number of decoded characters read.
5804 This function reads at most 4096 characters.
5805 If you want to read all available subprocess output,
5806 you must call it repeatedly until it returns zero.
5808 The characters read are decoded according to PROC's coding-system
5809 for decoding. */
5811 static int
5812 read_process_output (Lisp_Object proc, int channel)
5814 ssize_t nbytes;
5815 struct Lisp_Process *p = XPROCESS (proc);
5816 struct coding_system *coding = proc_decode_coding_system[channel];
5817 int carryover = p->decoding_carryover;
5818 enum { readmax = 4096 };
5819 ptrdiff_t count = SPECPDL_INDEX ();
5820 Lisp_Object odeactivate;
5821 char chars[sizeof coding->carryover + readmax];
5823 if (carryover)
5824 /* See the comment above. */
5825 memcpy (chars, SDATA (p->decoding_buf), carryover);
5827 #ifdef DATAGRAM_SOCKETS
5828 /* We have a working select, so proc_buffered_char is always -1. */
5829 if (DATAGRAM_CHAN_P (channel))
5831 socklen_t len = datagram_address[channel].len;
5832 nbytes = recvfrom (channel, chars + carryover, readmax,
5833 0, datagram_address[channel].sa, &len);
5835 else
5836 #endif
5838 bool buffered = proc_buffered_char[channel] >= 0;
5839 if (buffered)
5841 chars[carryover] = proc_buffered_char[channel];
5842 proc_buffered_char[channel] = -1;
5844 #ifdef HAVE_GNUTLS
5845 if (p->gnutls_p && p->gnutls_state)
5846 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
5847 readmax - buffered);
5848 else
5849 #endif
5850 nbytes = emacs_read (channel, chars + carryover + buffered,
5851 readmax - buffered);
5852 if (nbytes > 0 && p->adaptive_read_buffering)
5854 int delay = p->read_output_delay;
5855 if (nbytes < 256)
5857 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5859 if (delay == 0)
5860 process_output_delay_count++;
5861 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5864 else if (delay > 0 && nbytes == readmax - buffered)
5866 delay -= READ_OUTPUT_DELAY_INCREMENT;
5867 if (delay == 0)
5868 process_output_delay_count--;
5870 p->read_output_delay = delay;
5871 if (delay)
5873 p->read_output_skip = 1;
5874 process_output_skip = 1;
5877 nbytes += buffered;
5878 nbytes += buffered && nbytes <= 0;
5881 p->decoding_carryover = 0;
5883 /* At this point, NBYTES holds number of bytes just received
5884 (including the one in proc_buffered_char[channel]). */
5885 if (nbytes <= 0)
5887 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5888 return nbytes;
5889 coding->mode |= CODING_MODE_LAST_BLOCK;
5892 /* Now set NBYTES how many bytes we must decode. */
5893 nbytes += carryover;
5895 odeactivate = Vdeactivate_mark;
5896 /* There's no good reason to let process filters change the current
5897 buffer, and many callers of accept-process-output, sit-for, and
5898 friends don't expect current-buffer to be changed from under them. */
5899 record_unwind_current_buffer ();
5901 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5903 /* Handling the process output should not deactivate the mark. */
5904 Vdeactivate_mark = odeactivate;
5906 unbind_to (count, Qnil);
5907 return nbytes;
5910 static void
5911 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5912 ssize_t nbytes,
5913 struct coding_system *coding)
5915 Lisp_Object outstream = p->filter;
5916 Lisp_Object text;
5917 bool outer_running_asynch_code = running_asynch_code;
5918 int waiting = waiting_for_user_input_p;
5920 #if 0
5921 Lisp_Object obuffer, okeymap;
5922 XSETBUFFER (obuffer, current_buffer);
5923 okeymap = BVAR (current_buffer, keymap);
5924 #endif
5926 /* We inhibit quit here instead of just catching it so that
5927 hitting ^G when a filter happens to be running won't screw
5928 it up. */
5929 specbind (Qinhibit_quit, Qt);
5930 specbind (Qlast_nonmenu_event, Qt);
5932 /* In case we get recursively called,
5933 and we already saved the match data nonrecursively,
5934 save the same match data in safely recursive fashion. */
5935 if (outer_running_asynch_code)
5937 Lisp_Object tem;
5938 /* Don't clobber the CURRENT match data, either! */
5939 tem = Fmatch_data (Qnil, Qnil, Qnil);
5940 restore_search_regs ();
5941 record_unwind_save_match_data ();
5942 Fset_match_data (tem, Qt);
5945 /* For speed, if a search happens within this code,
5946 save the match data in a special nonrecursive fashion. */
5947 running_asynch_code = 1;
5949 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5950 text = coding->dst_object;
5951 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5952 /* A new coding system might be found. */
5953 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5955 pset_decode_coding_system (p, Vlast_coding_system_used);
5957 /* Don't call setup_coding_system for
5958 proc_decode_coding_system[channel] here. It is done in
5959 detect_coding called via decode_coding above. */
5961 /* If a coding system for encoding is not yet decided, we set
5962 it as the same as coding-system for decoding.
5964 But, before doing that we must check if
5965 proc_encode_coding_system[p->outfd] surely points to a
5966 valid memory because p->outfd will be changed once EOF is
5967 sent to the process. */
5968 if (NILP (p->encode_coding_system) && p->outfd >= 0
5969 && proc_encode_coding_system[p->outfd])
5971 pset_encode_coding_system
5972 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5973 setup_coding_system (p->encode_coding_system,
5974 proc_encode_coding_system[p->outfd]);
5978 if (coding->carryover_bytes > 0)
5980 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5981 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5982 memcpy (SDATA (p->decoding_buf), coding->carryover,
5983 coding->carryover_bytes);
5984 p->decoding_carryover = coding->carryover_bytes;
5986 if (SBYTES (text) > 0)
5987 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5988 sometimes it's simply wrong to wrap (e.g. when called from
5989 accept-process-output). */
5990 internal_condition_case_1 (read_process_output_call,
5991 list3 (outstream, make_lisp_proc (p), text),
5992 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5993 read_process_output_error_handler);
5995 /* If we saved the match data nonrecursively, restore it now. */
5996 restore_search_regs ();
5997 running_asynch_code = outer_running_asynch_code;
5999 /* Restore waiting_for_user_input_p as it was
6000 when we were called, in case the filter clobbered it. */
6001 waiting_for_user_input_p = waiting;
6003 #if 0 /* Call record_asynch_buffer_change unconditionally,
6004 because we might have changed minor modes or other things
6005 that affect key bindings. */
6006 if (! EQ (Fcurrent_buffer (), obuffer)
6007 || ! EQ (current_buffer->keymap, okeymap))
6008 #endif
6009 /* But do it only if the caller is actually going to read events.
6010 Otherwise there's no need to make him wake up, and it could
6011 cause trouble (for example it would make sit_for return). */
6012 if (waiting_for_user_input_p == -1)
6013 record_asynch_buffer_change ();
6016 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6017 Sinternal_default_process_filter, 2, 2, 0,
6018 doc: /* Function used as default process filter.
6019 This inserts the process's output into its buffer, if there is one.
6020 Otherwise it discards the output. */)
6021 (Lisp_Object proc, Lisp_Object text)
6023 struct Lisp_Process *p;
6024 ptrdiff_t opoint;
6026 CHECK_PROCESS (proc);
6027 p = XPROCESS (proc);
6028 CHECK_STRING (text);
6030 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6032 Lisp_Object old_read_only;
6033 ptrdiff_t old_begv, old_zv;
6034 ptrdiff_t old_begv_byte, old_zv_byte;
6035 ptrdiff_t before, before_byte;
6036 ptrdiff_t opoint_byte;
6037 struct buffer *b;
6039 Fset_buffer (p->buffer);
6040 opoint = PT;
6041 opoint_byte = PT_BYTE;
6042 old_read_only = BVAR (current_buffer, read_only);
6043 old_begv = BEGV;
6044 old_zv = ZV;
6045 old_begv_byte = BEGV_BYTE;
6046 old_zv_byte = ZV_BYTE;
6048 bset_read_only (current_buffer, Qnil);
6050 /* Insert new output into buffer at the current end-of-output
6051 marker, thus preserving logical ordering of input and output. */
6052 if (XMARKER (p->mark)->buffer)
6053 set_point_from_marker (p->mark);
6054 else
6055 SET_PT_BOTH (ZV, ZV_BYTE);
6056 before = PT;
6057 before_byte = PT_BYTE;
6059 /* If the output marker is outside of the visible region, save
6060 the restriction and widen. */
6061 if (! (BEGV <= PT && PT <= ZV))
6062 Fwiden ();
6064 /* Adjust the multibyteness of TEXT to that of the buffer. */
6065 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6066 != ! STRING_MULTIBYTE (text))
6067 text = (STRING_MULTIBYTE (text)
6068 ? Fstring_as_unibyte (text)
6069 : Fstring_to_multibyte (text));
6070 /* Insert before markers in case we are inserting where
6071 the buffer's mark is, and the user's next command is Meta-y. */
6072 insert_from_string_before_markers (text, 0, 0,
6073 SCHARS (text), SBYTES (text), 0);
6075 /* Make sure the process marker's position is valid when the
6076 process buffer is changed in the signal_after_change above.
6077 W3 is known to do that. */
6078 if (BUFFERP (p->buffer)
6079 && (b = XBUFFER (p->buffer), b != current_buffer))
6080 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6081 else
6082 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6084 update_mode_lines = 23;
6086 /* Make sure opoint and the old restrictions
6087 float ahead of any new text just as point would. */
6088 if (opoint >= before)
6090 opoint += PT - before;
6091 opoint_byte += PT_BYTE - before_byte;
6093 if (old_begv > before)
6095 old_begv += PT - before;
6096 old_begv_byte += PT_BYTE - before_byte;
6098 if (old_zv >= before)
6100 old_zv += PT - before;
6101 old_zv_byte += PT_BYTE - before_byte;
6104 /* If the restriction isn't what it should be, set it. */
6105 if (old_begv != BEGV || old_zv != ZV)
6106 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
6108 bset_read_only (current_buffer, old_read_only);
6109 SET_PT_BOTH (opoint, opoint_byte);
6111 return Qnil;
6114 /* Sending data to subprocess. */
6116 /* In send_process, when a write fails temporarily,
6117 wait_reading_process_output is called. It may execute user code,
6118 e.g. timers, that attempts to write new data to the same process.
6119 We must ensure that data is sent in the right order, and not
6120 interspersed half-completed with other writes (Bug#10815). This is
6121 handled by the write_queue element of struct process. It is a list
6122 with each entry having the form
6124 (string . (offset . length))
6126 where STRING is a lisp string, OFFSET is the offset into the
6127 string's byte sequence from which we should begin to send, and
6128 LENGTH is the number of bytes left to send. */
6130 /* Create a new entry in write_queue.
6131 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6132 BUF is a pointer to the string sequence of the input_obj or a C
6133 string in case of Qt or Qnil. */
6135 static void
6136 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6137 const char *buf, ptrdiff_t len, bool front)
6139 ptrdiff_t offset;
6140 Lisp_Object entry, obj;
6142 if (STRINGP (input_obj))
6144 offset = buf - SSDATA (input_obj);
6145 obj = input_obj;
6147 else
6149 offset = 0;
6150 obj = make_unibyte_string (buf, len);
6153 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
6155 if (front)
6156 pset_write_queue (p, Fcons (entry, p->write_queue));
6157 else
6158 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6161 /* Remove the first element in the write_queue of process P, put its
6162 contents in OBJ, BUF and LEN, and return true. If the
6163 write_queue is empty, return false. */
6165 static bool
6166 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6167 const char **buf, ptrdiff_t *len)
6169 Lisp_Object entry, offset_length;
6170 ptrdiff_t offset;
6172 if (NILP (p->write_queue))
6173 return 0;
6175 entry = XCAR (p->write_queue);
6176 pset_write_queue (p, XCDR (p->write_queue));
6178 *obj = XCAR (entry);
6179 offset_length = XCDR (entry);
6181 *len = XINT (XCDR (offset_length));
6182 offset = XINT (XCAR (offset_length));
6183 *buf = SSDATA (*obj) + offset;
6185 return 1;
6188 /* Send some data to process PROC.
6189 BUF is the beginning of the data; LEN is the number of characters.
6190 OBJECT is the Lisp object that the data comes from. If OBJECT is
6191 nil or t, it means that the data comes from C string.
6193 If OBJECT is not nil, the data is encoded by PROC's coding-system
6194 for encoding before it is sent.
6196 This function can evaluate Lisp code and can garbage collect. */
6198 static void
6199 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6200 Lisp_Object object)
6202 struct Lisp_Process *p = XPROCESS (proc);
6203 ssize_t rv;
6204 struct coding_system *coding;
6206 if (NETCONN_P (proc))
6208 wait_while_connecting (proc);
6209 wait_for_tls_negotiation (proc);
6212 if (p->raw_status_new)
6213 update_status (p);
6214 if (! EQ (p->status, Qrun))
6215 error ("Process %s not running", SDATA (p->name));
6216 if (p->outfd < 0)
6217 error ("Output file descriptor of %s is closed", SDATA (p->name));
6219 coding = proc_encode_coding_system[p->outfd];
6220 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6222 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6223 || (BUFFERP (object)
6224 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6225 || EQ (object, Qt))
6227 pset_encode_coding_system
6228 (p, complement_process_encoding_system (p->encode_coding_system));
6229 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6231 /* The coding system for encoding was changed to raw-text
6232 because we sent a unibyte text previously. Now we are
6233 sending a multibyte text, thus we must encode it by the
6234 original coding system specified for the current process.
6236 Another reason we come here is that the coding system
6237 was just complemented and a new one was returned by
6238 complement_process_encoding_system. */
6239 setup_coding_system (p->encode_coding_system, coding);
6240 Vlast_coding_system_used = p->encode_coding_system;
6242 coding->src_multibyte = 1;
6244 else
6246 coding->src_multibyte = 0;
6247 /* For sending a unibyte text, character code conversion should
6248 not take place but EOL conversion should. So, setup raw-text
6249 or one of the subsidiary if we have not yet done it. */
6250 if (CODING_REQUIRE_ENCODING (coding))
6252 if (CODING_REQUIRE_FLUSHING (coding))
6254 /* But, before changing the coding, we must flush out data. */
6255 coding->mode |= CODING_MODE_LAST_BLOCK;
6256 send_process (proc, "", 0, Qt);
6257 coding->mode &= CODING_MODE_LAST_BLOCK;
6259 setup_coding_system (raw_text_coding_system
6260 (Vlast_coding_system_used),
6261 coding);
6262 coding->src_multibyte = 0;
6265 coding->dst_multibyte = 0;
6267 if (CODING_REQUIRE_ENCODING (coding))
6269 coding->dst_object = Qt;
6270 if (BUFFERP (object))
6272 ptrdiff_t from_byte, from, to;
6273 ptrdiff_t save_pt, save_pt_byte;
6274 struct buffer *cur = current_buffer;
6276 set_buffer_internal (XBUFFER (object));
6277 save_pt = PT, save_pt_byte = PT_BYTE;
6279 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6280 from = BYTE_TO_CHAR (from_byte);
6281 to = BYTE_TO_CHAR (from_byte + len);
6282 TEMP_SET_PT_BOTH (from, from_byte);
6283 encode_coding_object (coding, object, from, from_byte,
6284 to, from_byte + len, Qt);
6285 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6286 set_buffer_internal (cur);
6288 else if (STRINGP (object))
6290 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6291 SBYTES (object), Qt);
6293 else
6295 coding->dst_object = make_unibyte_string (buf, len);
6296 coding->produced = len;
6299 len = coding->produced;
6300 object = coding->dst_object;
6301 buf = SSDATA (object);
6304 /* If there is already data in the write_queue, put the new data
6305 in the back of queue. Otherwise, ignore it. */
6306 if (!NILP (p->write_queue))
6307 write_queue_push (p, object, buf, len, 0);
6309 do /* while !NILP (p->write_queue) */
6311 ptrdiff_t cur_len = -1;
6312 const char *cur_buf;
6313 Lisp_Object cur_object;
6315 /* If write_queue is empty, ignore it. */
6316 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6318 cur_len = len;
6319 cur_buf = buf;
6320 cur_object = object;
6323 while (cur_len > 0)
6325 /* Send this batch, using one or more write calls. */
6326 ptrdiff_t written = 0;
6327 int outfd = p->outfd;
6328 #ifdef DATAGRAM_SOCKETS
6329 if (DATAGRAM_CHAN_P (outfd))
6331 rv = sendto (outfd, cur_buf, cur_len,
6332 0, datagram_address[outfd].sa,
6333 datagram_address[outfd].len);
6334 if (rv >= 0)
6335 written = rv;
6336 else if (errno == EMSGSIZE)
6337 report_file_error ("Sending datagram", proc);
6339 else
6340 #endif
6342 #ifdef HAVE_GNUTLS
6343 if (p->gnutls_p && p->gnutls_state)
6344 written = emacs_gnutls_write (p, cur_buf, cur_len);
6345 else
6346 #endif
6347 written = emacs_write_sig (outfd, cur_buf, cur_len);
6348 rv = (written ? 0 : -1);
6349 if (p->read_output_delay > 0
6350 && p->adaptive_read_buffering == 1)
6352 p->read_output_delay = 0;
6353 process_output_delay_count--;
6354 p->read_output_skip = 0;
6358 if (rv < 0)
6360 if (would_block (errno))
6361 /* Buffer is full. Wait, accepting input;
6362 that may allow the program
6363 to finish doing output and read more. */
6365 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6366 /* A gross hack to work around a bug in FreeBSD.
6367 In the following sequence, read(2) returns
6368 bogus data:
6370 write(2) 1022 bytes
6371 write(2) 954 bytes, get EAGAIN
6372 read(2) 1024 bytes in process_read_output
6373 read(2) 11 bytes in process_read_output
6375 That is, read(2) returns more bytes than have
6376 ever been written successfully. The 1033 bytes
6377 read are the 1022 bytes written successfully
6378 after processing (for example with CRs added if
6379 the terminal is set up that way which it is
6380 here). The same bytes will be seen again in a
6381 later read(2), without the CRs. */
6383 if (errno == EAGAIN)
6385 int flags = FWRITE;
6386 ioctl (p->outfd, TIOCFLUSH, &flags);
6388 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6390 /* Put what we should have written in wait_queue. */
6391 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6392 wait_reading_process_output (0, 20 * 1000 * 1000,
6393 0, 0, Qnil, NULL, 0);
6394 /* Reread queue, to see what is left. */
6395 break;
6397 else if (errno == EPIPE)
6399 p->raw_status_new = 0;
6400 pset_status (p, list2 (Qexit, make_number (256)));
6401 p->tick = ++process_tick;
6402 deactivate_process (proc);
6403 error ("process %s no longer connected to pipe; closed it",
6404 SDATA (p->name));
6406 else
6407 /* This is a real error. */
6408 report_file_error ("Writing to process", proc);
6410 cur_buf += written;
6411 cur_len -= written;
6414 while (!NILP (p->write_queue));
6417 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6418 3, 3, 0,
6419 doc: /* Send current contents of region as input to PROCESS.
6420 PROCESS may be a process, a buffer, the name of a process or buffer, or
6421 nil, indicating the current buffer's process.
6422 Called from program, takes three arguments, PROCESS, START and END.
6423 If the region is more than 500 characters long,
6424 it is sent in several bunches. This may happen even for shorter regions.
6425 Output from processes can arrive in between bunches.
6427 If PROCESS is a non-blocking network process that hasn't been fully
6428 set up yet, this function will block until socket setup has completed. */)
6429 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6431 Lisp_Object proc = get_process (process);
6432 ptrdiff_t start_byte, end_byte;
6434 validate_region (&start, &end);
6436 start_byte = CHAR_TO_BYTE (XINT (start));
6437 end_byte = CHAR_TO_BYTE (XINT (end));
6439 if (XINT (start) < GPT && XINT (end) > GPT)
6440 move_gap_both (XINT (start), start_byte);
6442 if (NETCONN_P (proc))
6443 wait_while_connecting (proc);
6445 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6446 end_byte - start_byte, Fcurrent_buffer ());
6448 return Qnil;
6451 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6452 2, 2, 0,
6453 doc: /* Send PROCESS the contents of STRING as input.
6454 PROCESS may be a process, a buffer, the name of a process or buffer, or
6455 nil, indicating the current buffer's process.
6456 If STRING is more than 500 characters long,
6457 it is sent in several bunches. This may happen even for shorter strings.
6458 Output from processes can arrive in between bunches.
6460 If PROCESS is a non-blocking network process that hasn't been fully
6461 set up yet, this function will block until socket setup has completed. */)
6462 (Lisp_Object process, Lisp_Object string)
6464 CHECK_STRING (string);
6465 Lisp_Object proc = get_process (process);
6466 send_process (proc, SSDATA (string),
6467 SBYTES (string), string);
6468 return Qnil;
6471 /* Return the foreground process group for the tty/pty that
6472 the process P uses. */
6473 static pid_t
6474 emacs_get_tty_pgrp (struct Lisp_Process *p)
6476 pid_t gid = -1;
6478 #ifdef TIOCGPGRP
6479 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6481 int fd;
6482 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6483 master side. Try the slave side. */
6484 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6486 if (fd != -1)
6488 ioctl (fd, TIOCGPGRP, &gid);
6489 emacs_close (fd);
6492 #endif /* defined (TIOCGPGRP ) */
6494 return gid;
6497 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6498 Sprocess_running_child_p, 0, 1, 0,
6499 doc: /* Return non-nil if PROCESS has given the terminal to a
6500 child. If the operating system does not make it possible to find out,
6501 return t. If we can find out, return the numeric ID of the foreground
6502 process group. */)
6503 (Lisp_Object process)
6505 /* Initialize in case ioctl doesn't exist or gives an error,
6506 in a way that will cause returning t. */
6507 Lisp_Object proc = get_process (process);
6508 struct Lisp_Process *p = XPROCESS (proc);
6510 if (!EQ (p->type, Qreal))
6511 error ("Process %s is not a subprocess",
6512 SDATA (p->name));
6513 if (p->infd < 0)
6514 error ("Process %s is not active",
6515 SDATA (p->name));
6517 pid_t gid = emacs_get_tty_pgrp (p);
6519 if (gid == p->pid)
6520 return Qnil;
6521 if (gid != -1)
6522 return make_number (gid);
6523 return Qt;
6526 /* Send a signal number SIGNO to PROCESS.
6527 If CURRENT_GROUP is t, that means send to the process group
6528 that currently owns the terminal being used to communicate with PROCESS.
6529 This is used for various commands in shell mode.
6530 If CURRENT_GROUP is lambda, that means send to the process group
6531 that currently owns the terminal, but only if it is NOT the shell itself.
6533 If NOMSG is false, insert signal-announcements into process's buffers
6534 right away.
6536 If we can, we try to signal PROCESS by sending control characters
6537 down the pty. This allows us to signal inferiors who have changed
6538 their uid, for which kill would return an EPERM error. */
6540 static void
6541 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6542 bool nomsg)
6544 Lisp_Object proc;
6545 struct Lisp_Process *p;
6546 pid_t gid;
6547 bool no_pgrp = 0;
6549 proc = get_process (process);
6550 p = XPROCESS (proc);
6552 if (!EQ (p->type, Qreal))
6553 error ("Process %s is not a subprocess",
6554 SDATA (p->name));
6555 if (p->infd < 0)
6556 error ("Process %s is not active",
6557 SDATA (p->name));
6559 if (!p->pty_flag)
6560 current_group = Qnil;
6562 /* If we are using pgrps, get a pgrp number and make it negative. */
6563 if (NILP (current_group))
6564 /* Send the signal to the shell's process group. */
6565 gid = p->pid;
6566 else
6568 #ifdef SIGNALS_VIA_CHARACTERS
6569 /* If possible, send signals to the entire pgrp
6570 by sending an input character to it. */
6572 struct termios t;
6573 cc_t *sig_char = NULL;
6575 tcgetattr (p->infd, &t);
6577 switch (signo)
6579 case SIGINT:
6580 sig_char = &t.c_cc[VINTR];
6581 break;
6583 case SIGQUIT:
6584 sig_char = &t.c_cc[VQUIT];
6585 break;
6587 case SIGTSTP:
6588 #ifdef VSWTCH
6589 sig_char = &t.c_cc[VSWTCH];
6590 #else
6591 sig_char = &t.c_cc[VSUSP];
6592 #endif
6593 break;
6596 if (sig_char && *sig_char != CDISABLE)
6598 send_process (proc, (char *) sig_char, 1, Qnil);
6599 return;
6601 /* If we can't send the signal with a character,
6602 fall through and send it another way. */
6604 /* The code above may fall through if it can't
6605 handle the signal. */
6606 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6608 #ifdef TIOCGPGRP
6609 /* Get the current pgrp using the tty itself, if we have that.
6610 Otherwise, use the pty to get the pgrp.
6611 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6612 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6613 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6614 His patch indicates that if TIOCGPGRP returns an error, then
6615 we should just assume that p->pid is also the process group id. */
6617 gid = emacs_get_tty_pgrp (p);
6619 if (gid == -1)
6620 /* If we can't get the information, assume
6621 the shell owns the tty. */
6622 gid = p->pid;
6624 /* It is not clear whether anything really can set GID to -1.
6625 Perhaps on some system one of those ioctls can or could do so.
6626 Or perhaps this is vestigial. */
6627 if (gid == -1)
6628 no_pgrp = 1;
6629 #else /* ! defined (TIOCGPGRP) */
6630 /* Can't select pgrps on this system, so we know that
6631 the child itself heads the pgrp. */
6632 gid = p->pid;
6633 #endif /* ! defined (TIOCGPGRP) */
6635 /* If current_group is lambda, and the shell owns the terminal,
6636 don't send any signal. */
6637 if (EQ (current_group, Qlambda) && gid == p->pid)
6638 return;
6641 #ifdef SIGCONT
6642 if (signo == SIGCONT)
6644 p->raw_status_new = 0;
6645 pset_status (p, Qrun);
6646 p->tick = ++process_tick;
6647 if (!nomsg)
6649 status_notify (NULL, NULL);
6650 redisplay_preserve_echo_area (13);
6653 #endif
6655 #ifdef TIOCSIGSEND
6656 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6657 We don't know whether the bug is fixed in later HP-UX versions. */
6658 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6659 return;
6660 #endif
6662 /* If we don't have process groups, send the signal to the immediate
6663 subprocess. That isn't really right, but it's better than any
6664 obvious alternative. */
6665 pid_t pid = no_pgrp ? gid : - gid;
6667 /* Do not kill an already-reaped process, as that could kill an
6668 innocent bystander that happens to have the same process ID. */
6669 sigset_t oldset;
6670 block_child_signal (&oldset);
6671 if (p->alive)
6672 kill (pid, signo);
6673 unblock_child_signal (&oldset);
6676 DEFUN ("internal-default-interrupt-process",
6677 Finternal_default_interrupt_process,
6678 Sinternal_default_interrupt_process, 0, 2, 0,
6679 doc: /* Default function to interrupt process PROCESS.
6680 It shall be the last element in list `interrupt-process-functions'.
6681 See function `interrupt-process' for more details on usage. */)
6682 (Lisp_Object process, Lisp_Object current_group)
6684 process_send_signal (process, SIGINT, current_group, 0);
6685 return process;
6688 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6689 doc: /* Interrupt process PROCESS.
6690 PROCESS may be a process, a buffer, or the name of a process or buffer.
6691 No arg or nil means current buffer's process.
6692 Second arg CURRENT-GROUP non-nil means send signal to
6693 the current process-group of the process's controlling terminal
6694 rather than to the process's own process group.
6695 If the process is a shell, this means interrupt current subjob
6696 rather than the shell.
6698 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6699 don't send the signal.
6701 This function calls the functions of `interrupt-process-functions' in
6702 the order of the list, until one of them returns non-`nil'. */)
6703 (Lisp_Object process, Lisp_Object current_group)
6705 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
6706 process, current_group);
6709 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6710 doc: /* Kill process PROCESS. May be process or name of one.
6711 See function `interrupt-process' for more details on usage. */)
6712 (Lisp_Object process, Lisp_Object current_group)
6714 process_send_signal (process, SIGKILL, current_group, 0);
6715 return process;
6718 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6719 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6720 See function `interrupt-process' for more details on usage. */)
6721 (Lisp_Object process, Lisp_Object current_group)
6723 process_send_signal (process, SIGQUIT, current_group, 0);
6724 return process;
6727 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6728 doc: /* Stop process PROCESS. May be process or name of one.
6729 See function `interrupt-process' for more details on usage.
6730 If PROCESS is a network or serial or pipe connection, inhibit handling
6731 of incoming traffic. */)
6732 (Lisp_Object process, Lisp_Object current_group)
6734 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6735 || PIPECONN_P (process)))
6737 struct Lisp_Process *p;
6739 p = XPROCESS (process);
6740 if (NILP (p->command)
6741 && p->infd >= 0)
6742 delete_read_fd (p->infd);
6743 pset_command (p, Qt);
6744 return process;
6746 #ifndef SIGTSTP
6747 error ("No SIGTSTP support");
6748 #else
6749 process_send_signal (process, SIGTSTP, current_group, 0);
6750 #endif
6751 return process;
6754 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6755 doc: /* Continue process PROCESS. May be process or name of one.
6756 See function `interrupt-process' for more details on usage.
6757 If PROCESS is a network or serial process, resume handling of incoming
6758 traffic. */)
6759 (Lisp_Object process, Lisp_Object current_group)
6761 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6762 || PIPECONN_P (process)))
6764 struct Lisp_Process *p;
6766 p = XPROCESS (process);
6767 if (EQ (p->command, Qt)
6768 && p->infd >= 0
6769 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6771 add_process_read_fd (p->infd);
6772 #ifdef WINDOWSNT
6773 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6774 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6775 #else /* not WINDOWSNT */
6776 tcflush (p->infd, TCIFLUSH);
6777 #endif /* not WINDOWSNT */
6779 pset_command (p, Qnil);
6780 return process;
6782 #ifdef SIGCONT
6783 process_send_signal (process, SIGCONT, current_group, 0);
6784 #else
6785 error ("No SIGCONT support");
6786 #endif
6787 return process;
6790 /* Return the integer value of the signal whose abbreviation is ABBR,
6791 or a negative number if there is no such signal. */
6792 static int
6793 abbr_to_signal (char const *name)
6795 int i, signo;
6796 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
6798 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
6799 name += 3;
6801 for (i = 0; i < sizeof sigbuf; i++)
6803 sigbuf[i] = c_toupper (name[i]);
6804 if (! sigbuf[i])
6805 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
6808 return -1;
6811 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6812 2, 2, "sProcess (name or number): \nnSignal code: ",
6813 doc: /* Send PROCESS the signal with code SIGCODE.
6814 PROCESS may also be a number specifying the process id of the
6815 process to signal; in this case, the process need not be a child of
6816 this Emacs.
6817 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6818 (Lisp_Object process, Lisp_Object sigcode)
6820 pid_t pid;
6821 int signo;
6823 if (STRINGP (process))
6825 Lisp_Object tem = Fget_process (process);
6826 if (NILP (tem))
6828 Lisp_Object process_number
6829 = string_to_number (SSDATA (process), 10, 1);
6830 if (NUMBERP (process_number))
6831 tem = process_number;
6833 process = tem;
6835 else if (!NUMBERP (process))
6836 process = get_process (process);
6838 if (NILP (process))
6839 return process;
6841 if (NUMBERP (process))
6842 CONS_TO_INTEGER (process, pid_t, pid);
6843 else
6845 CHECK_PROCESS (process);
6846 pid = XPROCESS (process)->pid;
6847 if (pid <= 0)
6848 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6851 if (INTEGERP (sigcode))
6853 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
6854 signo = XINT (sigcode);
6856 else
6858 char *name;
6860 CHECK_SYMBOL (sigcode);
6861 name = SSDATA (SYMBOL_NAME (sigcode));
6863 signo = abbr_to_signal (name);
6864 if (signo < 0)
6865 error ("Undefined signal name %s", name);
6868 return make_number (kill (pid, signo));
6871 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6872 doc: /* Make PROCESS see end-of-file in its input.
6873 EOF comes after any text already sent to it.
6874 PROCESS may be a process, a buffer, the name of a process or buffer, or
6875 nil, indicating the current buffer's process.
6876 If PROCESS is a network connection, or is a process communicating
6877 through a pipe (as opposed to a pty), then you cannot send any more
6878 text to PROCESS after you call this function.
6879 If PROCESS is a serial process, wait until all output written to the
6880 process has been transmitted to the serial port. */)
6881 (Lisp_Object process)
6883 Lisp_Object proc;
6884 struct coding_system *coding = NULL;
6885 int outfd;
6887 proc = get_process (process);
6889 if (NETCONN_P (proc))
6890 wait_while_connecting (proc);
6892 if (DATAGRAM_CONN_P (proc))
6893 return process;
6896 outfd = XPROCESS (proc)->outfd;
6897 if (outfd >= 0)
6898 coding = proc_encode_coding_system[outfd];
6900 /* Make sure the process is really alive. */
6901 if (XPROCESS (proc)->raw_status_new)
6902 update_status (XPROCESS (proc));
6903 if (! EQ (XPROCESS (proc)->status, Qrun))
6904 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6906 if (coding && CODING_REQUIRE_FLUSHING (coding))
6908 coding->mode |= CODING_MODE_LAST_BLOCK;
6909 send_process (proc, "", 0, Qnil);
6912 if (XPROCESS (proc)->pty_flag)
6913 send_process (proc, "\004", 1, Qnil);
6914 else if (EQ (XPROCESS (proc)->type, Qserial))
6916 #ifndef WINDOWSNT
6917 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6918 report_file_error ("Failed tcdrain", Qnil);
6919 #endif /* not WINDOWSNT */
6920 /* Do nothing on Windows because writes are blocking. */
6922 else
6924 struct Lisp_Process *p = XPROCESS (proc);
6925 int old_outfd = p->outfd;
6926 int new_outfd;
6928 #ifdef HAVE_SHUTDOWN
6929 /* If this is a network connection, or socketpair is used
6930 for communication with the subprocess, call shutdown to cause EOF.
6931 (In some old system, shutdown to socketpair doesn't work.
6932 Then we just can't win.) */
6933 if (0 <= old_outfd
6934 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
6935 shutdown (old_outfd, 1);
6936 #endif
6937 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
6938 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6939 if (new_outfd < 0)
6940 report_file_error ("Opening null device", Qnil);
6941 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
6942 p->outfd = new_outfd;
6944 if (!proc_encode_coding_system[new_outfd])
6945 proc_encode_coding_system[new_outfd]
6946 = xmalloc (sizeof (struct coding_system));
6947 if (old_outfd >= 0)
6949 *proc_encode_coding_system[new_outfd]
6950 = *proc_encode_coding_system[old_outfd];
6951 memset (proc_encode_coding_system[old_outfd], 0,
6952 sizeof (struct coding_system));
6954 else
6955 setup_coding_system (p->encode_coding_system,
6956 proc_encode_coding_system[new_outfd]);
6958 return process;
6961 /* The main Emacs thread records child processes in three places:
6963 - Vprocess_alist, for asynchronous subprocesses, which are child
6964 processes visible to Lisp.
6966 - deleted_pid_list, for child processes invisible to Lisp,
6967 typically because of delete-process. These are recorded so that
6968 the processes can be reaped when they exit, so that the operating
6969 system's process table is not cluttered by zombies.
6971 - the local variable PID in Fcall_process, call_process_cleanup and
6972 call_process_kill, for synchronous subprocesses.
6973 record_unwind_protect is used to make sure this process is not
6974 forgotten: if the user interrupts call-process and the child
6975 process refuses to exit immediately even with two C-g's,
6976 call_process_kill adds PID's contents to deleted_pid_list before
6977 returning.
6979 The main Emacs thread invokes waitpid only on child processes that
6980 it creates and that have not been reaped. This avoid races on
6981 platforms such as GTK, where other threads create their own
6982 subprocesses which the main thread should not reap. For example,
6983 if the main thread attempted to reap an already-reaped child, it
6984 might inadvertently reap a GTK-created process that happened to
6985 have the same process ID. */
6987 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6988 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6989 keep track of its own children. GNUstep is similar. */
6991 static void dummy_handler (int sig) {}
6992 static signal_handler_t volatile lib_child_handler;
6994 /* Handle a SIGCHLD signal by looking for known child processes of
6995 Emacs whose status have changed. For each one found, record its
6996 new status.
6998 All we do is change the status; we do not run sentinels or print
6999 notifications. That is saved for the next time keyboard input is
7000 done, in order to avoid timing errors.
7002 ** WARNING: this can be called during garbage collection.
7003 Therefore, it must not be fooled by the presence of mark bits in
7004 Lisp objects.
7006 ** USG WARNING: Although it is not obvious from the documentation
7007 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7008 signal() before executing at least one wait(), otherwise the
7009 handler will be called again, resulting in an infinite loop. The
7010 relevant portion of the documentation reads "SIGCLD signals will be
7011 queued and the signal-catching function will be continually
7012 reentered until the queue is empty". Invoking signal() causes the
7013 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7014 Inc.
7016 ** Malloc WARNING: This should never call malloc either directly or
7017 indirectly; if it does, that is a bug. */
7019 static void
7020 handle_child_signal (int sig)
7022 Lisp_Object tail, proc;
7024 /* Find the process that signaled us, and record its status. */
7026 /* The process can have been deleted by Fdelete_process, or have
7027 been started asynchronously by Fcall_process. */
7028 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7030 bool all_pids_are_fixnums
7031 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7032 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7033 Lisp_Object head = XCAR (tail);
7034 Lisp_Object xpid;
7035 if (! CONSP (head))
7036 continue;
7037 xpid = XCAR (head);
7038 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
7040 pid_t deleted_pid;
7041 if (INTEGERP (xpid))
7042 deleted_pid = XINT (xpid);
7043 else
7044 deleted_pid = XFLOAT_DATA (xpid);
7045 if (child_status_changed (deleted_pid, 0, 0))
7047 if (STRINGP (XCDR (head)))
7048 unlink (SSDATA (XCDR (head)));
7049 XSETCAR (tail, Qnil);
7054 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7055 FOR_EACH_PROCESS (tail, proc)
7057 struct Lisp_Process *p = XPROCESS (proc);
7058 int status;
7060 if (p->alive
7061 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7063 /* Change the status of the process that was found. */
7064 p->tick = ++process_tick;
7065 p->raw_status = status;
7066 p->raw_status_new = 1;
7068 /* If process has terminated, stop waiting for its output. */
7069 if (WIFSIGNALED (status) || WIFEXITED (status))
7071 bool clear_desc_flag = 0;
7072 p->alive = 0;
7073 if (p->infd >= 0)
7074 clear_desc_flag = 1;
7076 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7077 if (clear_desc_flag)
7078 delete_read_fd (p->infd);
7083 lib_child_handler (sig);
7084 #ifdef NS_IMPL_GNUSTEP
7085 /* NSTask in GNUstep sets its child handler each time it is called.
7086 So we must re-set ours. */
7087 catch_child_signal ();
7088 #endif
7091 static void
7092 deliver_child_signal (int sig)
7094 deliver_process_signal (sig, handle_child_signal);
7098 static Lisp_Object
7099 exec_sentinel_error_handler (Lisp_Object error_val)
7101 /* Make sure error_val is a cons cell, as all the rest of error
7102 handling expects that, and will barf otherwise. */
7103 if (!CONSP (error_val))
7104 error_val = Fcons (Qerror, error_val);
7105 cmd_error_internal (error_val, "error in process sentinel: ");
7106 Vinhibit_quit = Qt;
7107 update_echo_area ();
7108 Fsleep_for (make_number (2), Qnil);
7109 return Qt;
7112 static void
7113 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
7115 Lisp_Object sentinel, odeactivate;
7116 struct Lisp_Process *p = XPROCESS (proc);
7117 ptrdiff_t count = SPECPDL_INDEX ();
7118 bool outer_running_asynch_code = running_asynch_code;
7119 int waiting = waiting_for_user_input_p;
7121 if (inhibit_sentinels)
7122 return;
7124 odeactivate = Vdeactivate_mark;
7125 #if 0
7126 Lisp_Object obuffer, okeymap;
7127 XSETBUFFER (obuffer, current_buffer);
7128 okeymap = BVAR (current_buffer, keymap);
7129 #endif
7131 /* There's no good reason to let sentinels change the current
7132 buffer, and many callers of accept-process-output, sit-for, and
7133 friends don't expect current-buffer to be changed from under them. */
7134 record_unwind_current_buffer ();
7136 sentinel = p->sentinel;
7138 /* Inhibit quit so that random quits don't screw up a running filter. */
7139 specbind (Qinhibit_quit, Qt);
7140 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
7142 /* In case we get recursively called,
7143 and we already saved the match data nonrecursively,
7144 save the same match data in safely recursive fashion. */
7145 if (outer_running_asynch_code)
7147 Lisp_Object tem;
7148 tem = Fmatch_data (Qnil, Qnil, Qnil);
7149 restore_search_regs ();
7150 record_unwind_save_match_data ();
7151 Fset_match_data (tem, Qt);
7154 /* For speed, if a search happens within this code,
7155 save the match data in a special nonrecursive fashion. */
7156 running_asynch_code = 1;
7158 internal_condition_case_1 (read_process_output_call,
7159 list3 (sentinel, proc, reason),
7160 !NILP (Vdebug_on_error) ? Qnil : Qerror,
7161 exec_sentinel_error_handler);
7163 /* If we saved the match data nonrecursively, restore it now. */
7164 restore_search_regs ();
7165 running_asynch_code = outer_running_asynch_code;
7167 Vdeactivate_mark = odeactivate;
7169 /* Restore waiting_for_user_input_p as it was
7170 when we were called, in case the filter clobbered it. */
7171 waiting_for_user_input_p = waiting;
7173 #if 0
7174 if (! EQ (Fcurrent_buffer (), obuffer)
7175 || ! EQ (current_buffer->keymap, okeymap))
7176 #endif
7177 /* But do it only if the caller is actually going to read events.
7178 Otherwise there's no need to make him wake up, and it could
7179 cause trouble (for example it would make sit_for return). */
7180 if (waiting_for_user_input_p == -1)
7181 record_asynch_buffer_change ();
7183 unbind_to (count, Qnil);
7186 /* Report all recent events of a change in process status
7187 (either run the sentinel or output a message).
7188 This is usually done while Emacs is waiting for keyboard input
7189 but can be done at other times.
7191 Return positive if any input was received from WAIT_PROC (or from
7192 any process if WAIT_PROC is null), zero if input was attempted but
7193 none received, and negative if we didn't even try. */
7195 static int
7196 status_notify (struct Lisp_Process *deleting_process,
7197 struct Lisp_Process *wait_proc)
7199 Lisp_Object proc;
7200 Lisp_Object tail, msg;
7201 int got_some_output = -1;
7203 tail = Qnil;
7204 msg = Qnil;
7206 /* Set this now, so that if new processes are created by sentinels
7207 that we run, we get called again to handle their status changes. */
7208 update_tick = process_tick;
7210 FOR_EACH_PROCESS (tail, proc)
7212 Lisp_Object symbol;
7213 register struct Lisp_Process *p = XPROCESS (proc);
7215 if (p->tick != p->update_tick)
7217 p->update_tick = p->tick;
7219 /* If process is still active, read any output that remains. */
7220 while (! EQ (p->filter, Qt)
7221 && ! connecting_status (p->status)
7222 && ! EQ (p->status, Qlisten)
7223 /* Network or serial process not stopped: */
7224 && ! EQ (p->command, Qt)
7225 && p->infd >= 0
7226 && p != deleting_process)
7228 int nread = read_process_output (proc, p->infd);
7229 if ((!wait_proc || wait_proc == XPROCESS (proc))
7230 && got_some_output < nread)
7231 got_some_output = nread;
7232 if (nread <= 0)
7233 break;
7236 /* Get the text to use for the message. */
7237 if (p->raw_status_new)
7238 update_status (p);
7239 msg = status_message (p);
7241 /* If process is terminated, deactivate it or delete it. */
7242 symbol = p->status;
7243 if (CONSP (p->status))
7244 symbol = XCAR (p->status);
7246 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
7247 || EQ (symbol, Qclosed))
7249 if (delete_exited_processes)
7250 remove_process (proc);
7251 else
7252 deactivate_process (proc);
7255 /* The actions above may have further incremented p->tick.
7256 So set p->update_tick again so that an error in the sentinel will
7257 not cause this code to be run again. */
7258 p->update_tick = p->tick;
7259 /* Now output the message suitably. */
7260 exec_sentinel (proc, msg);
7261 if (BUFFERP (p->buffer))
7262 /* In case it uses %s in mode-line-format. */
7263 bset_update_mode_line (XBUFFER (p->buffer));
7265 } /* end for */
7267 return got_some_output;
7270 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
7271 Sinternal_default_process_sentinel, 2, 2, 0,
7272 doc: /* Function used as default sentinel for processes.
7273 This inserts a status message into the process's buffer, if there is one. */)
7274 (Lisp_Object proc, Lisp_Object msg)
7276 Lisp_Object buffer, symbol;
7277 struct Lisp_Process *p;
7278 CHECK_PROCESS (proc);
7279 p = XPROCESS (proc);
7280 buffer = p->buffer;
7281 symbol = p->status;
7282 if (CONSP (symbol))
7283 symbol = XCAR (symbol);
7285 if (!EQ (symbol, Qrun) && !NILP (buffer))
7287 Lisp_Object tem;
7288 struct buffer *old = current_buffer;
7289 ptrdiff_t opoint, opoint_byte;
7290 ptrdiff_t before, before_byte;
7292 /* Avoid error if buffer is deleted
7293 (probably that's why the process is dead, too). */
7294 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
7295 return Qnil;
7296 Fset_buffer (buffer);
7298 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7299 msg = (code_convert_string_norecord
7300 (msg, Vlocale_coding_system, 1));
7302 opoint = PT;
7303 opoint_byte = PT_BYTE;
7304 /* Insert new output into buffer
7305 at the current end-of-output marker,
7306 thus preserving logical ordering of input and output. */
7307 if (XMARKER (p->mark)->buffer)
7308 Fgoto_char (p->mark);
7309 else
7310 SET_PT_BOTH (ZV, ZV_BYTE);
7312 before = PT;
7313 before_byte = PT_BYTE;
7315 tem = BVAR (current_buffer, read_only);
7316 bset_read_only (current_buffer, Qnil);
7317 insert_string ("\nProcess ");
7318 { /* FIXME: temporary kludge. */
7319 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
7320 insert_string (" ");
7321 Finsert (1, &msg);
7322 bset_read_only (current_buffer, tem);
7323 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7325 if (opoint >= before)
7326 SET_PT_BOTH (opoint + (PT - before),
7327 opoint_byte + (PT_BYTE - before_byte));
7328 else
7329 SET_PT_BOTH (opoint, opoint_byte);
7331 set_buffer_internal (old);
7333 return Qnil;
7337 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7338 Sset_process_coding_system, 1, 3, 0,
7339 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
7340 DECODING will be used to decode subprocess output and ENCODING to
7341 encode subprocess input. */)
7342 (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
7344 CHECK_PROCESS (process);
7346 struct Lisp_Process *p = XPROCESS (process);
7348 Fcheck_coding_system (decoding);
7349 Fcheck_coding_system (encoding);
7350 encoding = coding_inherit_eol_type (encoding, Qnil);
7351 pset_decode_coding_system (p, decoding);
7352 pset_encode_coding_system (p, encoding);
7354 /* If the sockets haven't been set up yet, the final setup part of
7355 this will be called asynchronously. */
7356 if (p->infd < 0 || p->outfd < 0)
7357 return Qnil;
7359 setup_process_coding_systems (process);
7361 return Qnil;
7364 DEFUN ("process-coding-system",
7365 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7366 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7367 (register Lisp_Object process)
7369 CHECK_PROCESS (process);
7370 return Fcons (XPROCESS (process)->decode_coding_system,
7371 XPROCESS (process)->encode_coding_system);
7374 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
7375 Sset_process_filter_multibyte, 2, 2, 0,
7376 doc: /* Set multibyteness of the strings given to PROCESS's filter.
7377 If FLAG is non-nil, the filter is given multibyte strings.
7378 If FLAG is nil, the filter is given unibyte strings. In this case,
7379 all character code conversion except for end-of-line conversion is
7380 suppressed. */)
7381 (Lisp_Object process, Lisp_Object flag)
7383 CHECK_PROCESS (process);
7385 struct Lisp_Process *p = XPROCESS (process);
7386 if (NILP (flag))
7387 pset_decode_coding_system
7388 (p, raw_text_coding_system (p->decode_coding_system));
7390 /* If the sockets haven't been set up yet, the final setup part of
7391 this will be called asynchronously. */
7392 if (p->infd < 0 || p->outfd < 0)
7393 return Qnil;
7395 setup_process_coding_systems (process);
7397 return Qnil;
7400 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
7401 Sprocess_filter_multibyte_p, 1, 1, 0,
7402 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7403 (Lisp_Object process)
7405 CHECK_PROCESS (process);
7406 struct Lisp_Process *p = XPROCESS (process);
7407 if (p->infd < 0)
7408 return Qnil;
7409 struct coding_system *coding = proc_decode_coding_system[p->infd];
7410 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
7416 # ifdef HAVE_GPM
7418 void
7419 add_gpm_wait_descriptor (int desc)
7421 add_keyboard_wait_descriptor (desc);
7424 void
7425 delete_gpm_wait_descriptor (int desc)
7427 delete_keyboard_wait_descriptor (desc);
7430 # endif
7432 # ifdef USABLE_SIGIO
7434 /* Return true if *MASK has a bit set
7435 that corresponds to one of the keyboard input descriptors. */
7437 static bool
7438 keyboard_bit_set (fd_set *mask)
7440 int fd;
7442 for (fd = 0; fd <= max_desc; fd++)
7443 if (FD_ISSET (fd, mask)
7444 && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
7445 == (FOR_READ | KEYBOARD_FD)))
7446 return 1;
7448 return 0;
7450 # endif
7452 #else /* not subprocesses */
7454 /* This is referenced in thread.c:run_thread (which is never actually
7455 called, since threads are not enabled for this configuration. */
7456 void
7457 update_processes_for_thread_death (Lisp_Object dying_thread)
7461 /* Defined in msdos.c. */
7462 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7463 struct timespec *, void *);
7465 /* Implementation of wait_reading_process_output, assuming that there
7466 are no subprocesses. Used only by the MS-DOS build.
7468 Wait for timeout to elapse and/or keyboard input to be available.
7470 TIME_LIMIT is:
7471 timeout in seconds
7472 If negative, gobble data immediately available but don't wait for any.
7474 NSECS is:
7475 an additional duration to wait, measured in nanoseconds
7476 If TIME_LIMIT is zero, then:
7477 If NSECS == 0, there is no limit.
7478 If NSECS > 0, the timeout consists of NSECS only.
7479 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7481 READ_KBD is:
7482 0 to ignore keyboard input, or
7483 1 to return when input is available, or
7484 -1 means caller will actually read the input, so don't throw to
7485 the quit handler.
7487 see full version for other parameters. We know that wait_proc will
7488 always be NULL, since `subprocesses' isn't defined.
7490 DO_DISPLAY means redisplay should be done to show subprocess
7491 output that arrives.
7493 Return -1 signifying we got no output and did not try. */
7496 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7497 bool do_display,
7498 Lisp_Object wait_for_cell,
7499 struct Lisp_Process *wait_proc, int just_wait_proc)
7501 register int nfds;
7502 struct timespec end_time, timeout;
7503 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
7505 if (TYPE_MAXIMUM (time_t) < time_limit)
7506 time_limit = TYPE_MAXIMUM (time_t);
7508 if (time_limit < 0 || nsecs < 0)
7509 wait = MINIMUM;
7510 else if (time_limit > 0 || nsecs > 0)
7512 wait = TIMEOUT;
7513 end_time = timespec_add (current_timespec (),
7514 make_timespec (time_limit, nsecs));
7516 else
7517 wait = INFINITY;
7519 /* Turn off periodic alarms (in case they are in use)
7520 and then turn off any other atimers,
7521 because the select emulator uses alarms. */
7522 stop_polling ();
7523 turn_on_atimers (0);
7525 while (1)
7527 bool timeout_reduced_for_timers = false;
7528 fd_set waitchannels;
7529 int xerrno;
7531 /* If calling from keyboard input, do not quit
7532 since we want to return C-g as an input character.
7533 Otherwise, do pending quit if requested. */
7534 if (read_kbd >= 0)
7535 maybe_quit ();
7537 /* Exit now if the cell we're waiting for became non-nil. */
7538 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7539 break;
7541 /* Compute time from now till when time limit is up. */
7542 /* Exit if already run out. */
7543 if (wait == TIMEOUT)
7545 struct timespec now = current_timespec ();
7546 if (timespec_cmp (end_time, now) <= 0)
7547 break;
7548 timeout = timespec_sub (end_time, now);
7550 else
7551 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7553 /* If our caller will not immediately handle keyboard events,
7554 run timer events directly.
7555 (Callers that will immediately read keyboard events
7556 call timer_delay on their own.) */
7557 if (NILP (wait_for_cell))
7559 struct timespec timer_delay;
7563 unsigned old_timers_run = timers_run;
7564 timer_delay = timer_check ();
7565 if (timers_run != old_timers_run && do_display)
7566 /* We must retry, since a timer may have requeued itself
7567 and that could alter the time delay. */
7568 redisplay_preserve_echo_area (14);
7569 else
7570 break;
7572 while (!detect_input_pending ());
7574 /* If there is unread keyboard input, also return. */
7575 if (read_kbd != 0
7576 && requeued_events_pending_p ())
7577 break;
7579 if (timespec_valid_p (timer_delay))
7581 if (timespec_cmp (timer_delay, timeout) < 0)
7583 timeout = timer_delay;
7584 timeout_reduced_for_timers = true;
7589 /* Cause C-g and alarm signals to take immediate action,
7590 and cause input available signals to zero out timeout. */
7591 if (read_kbd < 0)
7592 set_waiting_for_input (&timeout);
7594 /* If a frame has been newly mapped and needs updating,
7595 reprocess its display stuff. */
7596 if (frame_garbaged && do_display)
7598 clear_waiting_for_input ();
7599 redisplay_preserve_echo_area (15);
7600 if (read_kbd < 0)
7601 set_waiting_for_input (&timeout);
7604 /* Wait till there is something to do. */
7605 FD_ZERO (&waitchannels);
7606 if (read_kbd && detect_input_pending ())
7607 nfds = 0;
7608 else
7610 if (read_kbd || !NILP (wait_for_cell))
7611 FD_SET (0, &waitchannels);
7612 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
7615 xerrno = errno;
7617 /* Make C-g and alarm signals set flags again. */
7618 clear_waiting_for_input ();
7620 /* If we woke up due to SIGWINCH, actually change size now. */
7621 do_pending_window_change (0);
7623 if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
7624 /* We waited the full specified time, so return now. */
7625 break;
7627 if (nfds == -1)
7629 /* If the system call was interrupted, then go around the
7630 loop again. */
7631 if (xerrno == EINTR)
7632 FD_ZERO (&waitchannels);
7633 else
7634 report_file_errno ("Failed select", Qnil, xerrno);
7637 /* Check for keyboard input. */
7639 if (read_kbd
7640 && detect_input_pending_run_timers (do_display))
7642 swallow_events (do_display);
7643 if (detect_input_pending_run_timers (do_display))
7644 break;
7647 /* If there is unread keyboard input, also return. */
7648 if (read_kbd
7649 && requeued_events_pending_p ())
7650 break;
7652 /* If wait_for_cell. check for keyboard input
7653 but don't run any timers.
7654 ??? (It seems wrong to me to check for keyboard
7655 input at all when wait_for_cell, but the code
7656 has been this way since July 1994.
7657 Try changing this after version 19.31.) */
7658 if (! NILP (wait_for_cell)
7659 && detect_input_pending ())
7661 swallow_events (do_display);
7662 if (detect_input_pending ())
7663 break;
7666 /* Exit now if the cell we're waiting for became non-nil. */
7667 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7668 break;
7671 start_polling ();
7673 return -1;
7676 #endif /* not subprocesses */
7678 /* The following functions are needed even if async subprocesses are
7679 not supported. Some of them are no-op stubs in that case. */
7681 #ifdef HAVE_TIMERFD
7683 /* Add FD, which is a descriptor returned by timerfd_create,
7684 to the set of non-keyboard input descriptors. */
7686 void
7687 add_timer_wait_descriptor (int fd)
7689 add_read_fd (fd, timerfd_callback, NULL);
7690 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
7693 #endif /* HAVE_TIMERFD */
7695 /* If program file NAME starts with /: for quoting a magic
7696 name, remove that, preserving the multibyteness of NAME. */
7698 Lisp_Object
7699 remove_slash_colon (Lisp_Object name)
7701 return
7702 (SREF (name, 0) == '/' && SREF (name, 1) == ':'
7703 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
7704 SBYTES (name) - 2, STRING_MULTIBYTE (name))
7705 : name);
7708 /* Add DESC to the set of keyboard input descriptors. */
7710 void
7711 add_keyboard_wait_descriptor (int desc)
7713 #ifdef subprocesses /* Actually means "not MSDOS". */
7714 eassert (desc >= 0 && desc < FD_SETSIZE);
7715 fd_callback_info[desc].flags &= ~PROCESS_FD;
7716 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
7717 if (desc > max_desc)
7718 max_desc = desc;
7719 #endif
7722 /* From now on, do not expect DESC to give keyboard input. */
7724 void
7725 delete_keyboard_wait_descriptor (int desc)
7727 #ifdef subprocesses
7728 eassert (desc >= 0 && desc < FD_SETSIZE);
7730 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
7732 if (desc == max_desc)
7733 recompute_max_desc ();
7734 #endif
7737 /* Setup coding systems of PROCESS. */
7739 void
7740 setup_process_coding_systems (Lisp_Object process)
7742 #ifdef subprocesses
7743 struct Lisp_Process *p = XPROCESS (process);
7744 int inch = p->infd;
7745 int outch = p->outfd;
7746 Lisp_Object coding_system;
7748 if (inch < 0 || outch < 0)
7749 return;
7751 if (!proc_decode_coding_system[inch])
7752 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
7753 coding_system = p->decode_coding_system;
7754 if (EQ (p->filter, Qinternal_default_process_filter)
7755 && BUFFERP (p->buffer))
7757 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
7758 coding_system = raw_text_coding_system (coding_system);
7760 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7762 if (!proc_encode_coding_system[outch])
7763 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
7764 setup_coding_system (p->encode_coding_system,
7765 proc_encode_coding_system[outch]);
7766 #endif
7769 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7770 doc: /* Return the (or a) live process associated with BUFFER.
7771 BUFFER may be a buffer or the name of one.
7772 Return nil if all processes associated with BUFFER have been
7773 deleted or killed. */)
7774 (register Lisp_Object buffer)
7776 #ifdef subprocesses
7777 register Lisp_Object buf, tail, proc;
7779 if (NILP (buffer)) return Qnil;
7780 buf = Fget_buffer (buffer);
7781 if (NILP (buf)) return Qnil;
7783 FOR_EACH_PROCESS (tail, proc)
7784 if (EQ (XPROCESS (proc)->buffer, buf))
7785 return proc;
7786 #endif /* subprocesses */
7787 return Qnil;
7790 DEFUN ("process-inherit-coding-system-flag",
7791 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7792 1, 1, 0,
7793 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7794 If this flag is t, `buffer-file-coding-system' of the buffer
7795 associated with PROCESS will inherit the coding system used to decode
7796 the process output. */)
7797 (register Lisp_Object process)
7799 #ifdef subprocesses
7800 CHECK_PROCESS (process);
7801 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7802 #else
7803 /* Ignore the argument and return the value of
7804 inherit-process-coding-system. */
7805 return inherit_process_coding_system ? Qt : Qnil;
7806 #endif
7809 /* Kill all processes associated with `buffer'.
7810 If `buffer' is nil, kill all processes. */
7812 void
7813 kill_buffer_processes (Lisp_Object buffer)
7815 #ifdef subprocesses
7816 Lisp_Object tail, proc;
7818 FOR_EACH_PROCESS (tail, proc)
7819 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
7821 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
7822 Fdelete_process (proc);
7823 else if (XPROCESS (proc)->infd >= 0)
7824 process_send_signal (proc, SIGHUP, Qnil, 1);
7826 #else /* subprocesses */
7827 /* Since we have no subprocesses, this does nothing. */
7828 #endif /* subprocesses */
7831 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
7832 Swaiting_for_user_input_p, 0, 0, 0,
7833 doc: /* Return non-nil if Emacs is waiting for input from the user.
7834 This is intended for use by asynchronous process output filters and sentinels. */)
7835 (void)
7837 #ifdef subprocesses
7838 return (waiting_for_user_input_p ? Qt : Qnil);
7839 #else
7840 return Qnil;
7841 #endif
7844 /* Stop reading input from keyboard sources. */
7846 void
7847 hold_keyboard_input (void)
7849 kbd_is_on_hold = 1;
7852 /* Resume reading input from keyboard sources. */
7854 void
7855 unhold_keyboard_input (void)
7857 kbd_is_on_hold = 0;
7860 /* Return true if keyboard input is on hold, zero otherwise. */
7862 bool
7863 kbd_on_hold_p (void)
7865 return kbd_is_on_hold;
7869 /* Enumeration of and access to system processes a-la ps(1). */
7871 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7872 0, 0, 0,
7873 doc: /* Return a list of numerical process IDs of all running processes.
7874 If this functionality is unsupported, return nil.
7876 See `process-attributes' for getting attributes of a process given its ID. */)
7877 (void)
7879 return list_system_processes ();
7882 DEFUN ("process-attributes", Fprocess_attributes,
7883 Sprocess_attributes, 1, 1, 0,
7884 doc: /* Return attributes of the process given by its PID, a number.
7886 Value is an alist where each element is a cons cell of the form
7888 (KEY . VALUE)
7890 If this functionality is unsupported, the value is nil.
7892 See `list-system-processes' for getting a list of all process IDs.
7894 The KEYs of the attributes that this function may return are listed
7895 below, together with the type of the associated VALUE (in parentheses).
7896 Not all platforms support all of these attributes; unsupported
7897 attributes will not appear in the returned alist.
7898 Unless explicitly indicated otherwise, numbers can have either
7899 integer or floating point values.
7901 euid -- Effective user User ID of the process (number)
7902 user -- User name corresponding to euid (string)
7903 egid -- Effective user Group ID of the process (number)
7904 group -- Group name corresponding to egid (string)
7905 comm -- Command name (executable name only) (string)
7906 state -- Process state code, such as "S", "R", or "T" (string)
7907 ppid -- Parent process ID (number)
7908 pgrp -- Process group ID (number)
7909 sess -- Session ID, i.e. process ID of session leader (number)
7910 ttname -- Controlling tty name (string)
7911 tpgid -- ID of foreground process group on the process's tty (number)
7912 minflt -- number of minor page faults (number)
7913 majflt -- number of major page faults (number)
7914 cminflt -- cumulative number of minor page faults (number)
7915 cmajflt -- cumulative number of major page faults (number)
7916 utime -- user time used by the process, in (current-time) format,
7917 which is a list of integers (HIGH LOW USEC PSEC)
7918 stime -- system time used by the process (current-time)
7919 time -- sum of utime and stime (current-time)
7920 cutime -- user time used by the process and its children (current-time)
7921 cstime -- system time used by the process and its children (current-time)
7922 ctime -- sum of cutime and cstime (current-time)
7923 pri -- priority of the process (number)
7924 nice -- nice value of the process (number)
7925 thcount -- process thread count (number)
7926 start -- time the process started (current-time)
7927 vsize -- virtual memory size of the process in KB's (number)
7928 rss -- resident set size of the process in KB's (number)
7929 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7930 pcpu -- percents of CPU time used by the process (floating-point number)
7931 pmem -- percents of total physical memory used by process's resident set
7932 (floating-point number)
7933 args -- command line which invoked the process (string). */)
7934 ( Lisp_Object pid)
7936 return system_process_attributes (pid);
7939 #ifdef subprocesses
7940 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7941 Invoke this after init_process_emacs, and after glib and/or GNUstep
7942 futz with the SIGCHLD handler, but before Emacs forks any children.
7943 This function's caller should block SIGCHLD. */
7945 void
7946 catch_child_signal (void)
7948 struct sigaction action, old_action;
7949 sigset_t oldset;
7950 emacs_sigaction_init (&action, deliver_child_signal);
7951 block_child_signal (&oldset);
7952 sigaction (SIGCHLD, &action, &old_action);
7953 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7954 || ! (old_action.sa_flags & SA_SIGINFO));
7956 if (old_action.sa_handler != deliver_child_signal)
7957 lib_child_handler
7958 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7959 ? dummy_handler
7960 : old_action.sa_handler);
7961 unblock_child_signal (&oldset);
7963 #endif /* subprocesses */
7965 /* Limit the number of open files to the value it had at startup. */
7967 void
7968 restore_nofile_limit (void)
7970 #ifdef HAVE_SETRLIMIT
7971 if (FD_SETSIZE < nofile_limit.rlim_cur)
7972 setrlimit (RLIMIT_NOFILE, &nofile_limit);
7973 #endif
7977 /* This is not called "init_process" because that is the name of a
7978 Mach system call, so it would cause problems on Darwin systems. */
7979 void
7980 init_process_emacs (int sockfd)
7982 #ifdef subprocesses
7983 int i;
7985 inhibit_sentinels = 0;
7987 #ifndef CANNOT_DUMP
7988 if (! noninteractive || initialized)
7989 #endif
7991 #if defined HAVE_GLIB && !defined WINDOWSNT
7992 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7993 this should always fail, but is enough to initialize glib's
7994 private SIGCHLD handler, allowing catch_child_signal to copy
7995 it into lib_child_handler. */
7996 g_source_unref (g_child_watch_source_new (getpid ()));
7997 #endif
7998 catch_child_signal ();
8001 #ifdef HAVE_SETRLIMIT
8002 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8003 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
8004 nofile_limit.rlim_cur = 0;
8005 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8007 struct rlimit rlim = nofile_limit;
8008 rlim.rlim_cur = FD_SETSIZE;
8009 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8010 nofile_limit.rlim_cur = 0;
8012 #endif
8014 external_sock_fd = sockfd;
8015 max_desc = -1;
8016 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8018 num_pending_connects = 0;
8020 process_output_delay_count = 0;
8021 process_output_skip = 0;
8023 /* Don't do this, it caused infinite select loops. The display
8024 method should call add_keyboard_wait_descriptor on stdin if it
8025 needs that. */
8026 #if 0
8027 FD_SET (0, &input_wait_mask);
8028 #endif
8030 Vprocess_alist = Qnil;
8031 deleted_pid_list = Qnil;
8032 for (i = 0; i < FD_SETSIZE; i++)
8034 chan_process[i] = Qnil;
8035 proc_buffered_char[i] = -1;
8037 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8038 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8039 #ifdef DATAGRAM_SOCKETS
8040 memset (datagram_address, 0, sizeof datagram_address);
8041 #endif
8043 #if defined (DARWIN_OS)
8044 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8045 processes. As such, we only change the default value. */
8046 if (initialized)
8048 char const *release = (STRINGP (Voperating_system_release)
8049 ? SSDATA (Voperating_system_release)
8050 : 0);
8051 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
8052 Vprocess_connection_type = Qnil;
8055 #endif
8056 #endif /* subprocesses */
8057 kbd_is_on_hold = 0;
8060 void
8061 syms_of_process (void)
8063 #ifdef subprocesses
8065 DEFSYM (Qprocessp, "processp");
8066 DEFSYM (Qrun, "run");
8067 DEFSYM (Qstop, "stop");
8068 DEFSYM (Qsignal, "signal");
8070 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8071 here again. */
8073 DEFSYM (Qopen, "open");
8074 DEFSYM (Qclosed, "closed");
8075 DEFSYM (Qconnect, "connect");
8076 DEFSYM (Qfailed, "failed");
8077 DEFSYM (Qlisten, "listen");
8078 DEFSYM (Qlocal, "local");
8079 DEFSYM (Qipv4, "ipv4");
8080 #ifdef AF_INET6
8081 DEFSYM (Qipv6, "ipv6");
8082 #endif
8083 DEFSYM (Qdatagram, "datagram");
8084 DEFSYM (Qseqpacket, "seqpacket");
8086 DEFSYM (QCport, ":port");
8087 DEFSYM (QCspeed, ":speed");
8088 DEFSYM (QCprocess, ":process");
8090 DEFSYM (QCbytesize, ":bytesize");
8091 DEFSYM (QCstopbits, ":stopbits");
8092 DEFSYM (QCparity, ":parity");
8093 DEFSYM (Qodd, "odd");
8094 DEFSYM (Qeven, "even");
8095 DEFSYM (QCflowcontrol, ":flowcontrol");
8096 DEFSYM (Qhw, "hw");
8097 DEFSYM (Qsw, "sw");
8098 DEFSYM (QCsummary, ":summary");
8100 DEFSYM (Qreal, "real");
8101 DEFSYM (Qnetwork, "network");
8102 DEFSYM (Qserial, "serial");
8103 DEFSYM (QCbuffer, ":buffer");
8104 DEFSYM (QChost, ":host");
8105 DEFSYM (QCservice, ":service");
8106 DEFSYM (QClocal, ":local");
8107 DEFSYM (QCremote, ":remote");
8108 DEFSYM (QCcoding, ":coding");
8109 DEFSYM (QCserver, ":server");
8110 DEFSYM (QCnowait, ":nowait");
8111 DEFSYM (QCsentinel, ":sentinel");
8112 DEFSYM (QCuse_external_socket, ":use-external-socket");
8113 DEFSYM (QCtls_parameters, ":tls-parameters");
8114 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8115 DEFSYM (QClog, ":log");
8116 DEFSYM (QCnoquery, ":noquery");
8117 DEFSYM (QCstop, ":stop");
8118 DEFSYM (QCplist, ":plist");
8119 DEFSYM (QCcommand, ":command");
8120 DEFSYM (QCconnection_type, ":connection-type");
8121 DEFSYM (QCstderr, ":stderr");
8122 DEFSYM (Qpty, "pty");
8123 DEFSYM (Qpipe, "pipe");
8125 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8127 staticpro (&Vprocess_alist);
8128 staticpro (&deleted_pid_list);
8130 #endif /* subprocesses */
8132 DEFSYM (QCname, ":name");
8133 DEFSYM (QCtype, ":type");
8135 DEFSYM (Qeuid, "euid");
8136 DEFSYM (Qegid, "egid");
8137 DEFSYM (Quser, "user");
8138 DEFSYM (Qgroup, "group");
8139 DEFSYM (Qcomm, "comm");
8140 DEFSYM (Qstate, "state");
8141 DEFSYM (Qppid, "ppid");
8142 DEFSYM (Qpgrp, "pgrp");
8143 DEFSYM (Qsess, "sess");
8144 DEFSYM (Qttname, "ttname");
8145 DEFSYM (Qtpgid, "tpgid");
8146 DEFSYM (Qminflt, "minflt");
8147 DEFSYM (Qmajflt, "majflt");
8148 DEFSYM (Qcminflt, "cminflt");
8149 DEFSYM (Qcmajflt, "cmajflt");
8150 DEFSYM (Qutime, "utime");
8151 DEFSYM (Qstime, "stime");
8152 DEFSYM (Qtime, "time");
8153 DEFSYM (Qcutime, "cutime");
8154 DEFSYM (Qcstime, "cstime");
8155 DEFSYM (Qctime, "ctime");
8156 #ifdef subprocesses
8157 DEFSYM (Qinternal_default_process_sentinel,
8158 "internal-default-process-sentinel");
8159 DEFSYM (Qinternal_default_process_filter,
8160 "internal-default-process-filter");
8161 #endif
8162 DEFSYM (Qpri, "pri");
8163 DEFSYM (Qnice, "nice");
8164 DEFSYM (Qthcount, "thcount");
8165 DEFSYM (Qstart, "start");
8166 DEFSYM (Qvsize, "vsize");
8167 DEFSYM (Qrss, "rss");
8168 DEFSYM (Qetime, "etime");
8169 DEFSYM (Qpcpu, "pcpu");
8170 DEFSYM (Qpmem, "pmem");
8171 DEFSYM (Qargs, "args");
8173 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8174 doc: /* Non-nil means delete processes immediately when they exit.
8175 A value of nil means don't delete them until `list-processes' is run. */);
8177 delete_exited_processes = 1;
8179 #ifdef subprocesses
8180 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8181 doc: /* Control type of device used to communicate with subprocesses.
8182 Values are nil to use a pipe, or t or `pty' to use a pty.
8183 The value has no effect if the system has no ptys or if all ptys are busy:
8184 then a pipe is used in any case.
8185 The value takes effect when `start-process' is called. */);
8186 Vprocess_connection_type = Qt;
8188 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8189 doc: /* If non-nil, improve receive buffering by delaying after short reads.
8190 On some systems, when Emacs reads the output from a subprocess, the output data
8191 is read in very small blocks, potentially resulting in very poor performance.
8192 This behavior can be remedied to some extent by setting this variable to a
8193 non-nil value, as it will automatically delay reading from such processes, to
8194 allow them to produce more output before Emacs tries to read it.
8195 If the value is t, the delay is reset after each write to the process; any other
8196 non-nil value means that the delay is not reset on write.
8197 The variable takes effect when `start-process' is called. */);
8198 Vprocess_adaptive_read_buffering = Qt;
8200 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8201 doc: /* List of functions to be called for `interrupt-process'.
8202 The arguments of the functions are the same as for `interrupt-process'.
8203 These functions are called in the order of the list, until one of them
8204 returns non-`nil'. */);
8205 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8207 DEFSYM (Qinternal_default_interrupt_process,
8208 "internal-default-interrupt-process");
8209 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8211 defsubr (&Sprocessp);
8212 defsubr (&Sget_process);
8213 defsubr (&Sdelete_process);
8214 defsubr (&Sprocess_status);
8215 defsubr (&Sprocess_exit_status);
8216 defsubr (&Sprocess_id);
8217 defsubr (&Sprocess_name);
8218 defsubr (&Sprocess_tty_name);
8219 defsubr (&Sprocess_command);
8220 defsubr (&Sset_process_buffer);
8221 defsubr (&Sprocess_buffer);
8222 defsubr (&Sprocess_mark);
8223 defsubr (&Sset_process_filter);
8224 defsubr (&Sprocess_filter);
8225 defsubr (&Sset_process_sentinel);
8226 defsubr (&Sprocess_sentinel);
8227 defsubr (&Sset_process_thread);
8228 defsubr (&Sprocess_thread);
8229 defsubr (&Sset_process_window_size);
8230 defsubr (&Sset_process_inherit_coding_system_flag);
8231 defsubr (&Sset_process_query_on_exit_flag);
8232 defsubr (&Sprocess_query_on_exit_flag);
8233 defsubr (&Sprocess_contact);
8234 defsubr (&Sprocess_plist);
8235 defsubr (&Sset_process_plist);
8236 defsubr (&Sprocess_list);
8237 defsubr (&Smake_process);
8238 defsubr (&Smake_pipe_process);
8239 defsubr (&Sserial_process_configure);
8240 defsubr (&Smake_serial_process);
8241 defsubr (&Sset_network_process_option);
8242 defsubr (&Smake_network_process);
8243 defsubr (&Sformat_network_address);
8244 defsubr (&Snetwork_interface_list);
8245 defsubr (&Snetwork_interface_info);
8246 #ifdef DATAGRAM_SOCKETS
8247 defsubr (&Sprocess_datagram_address);
8248 defsubr (&Sset_process_datagram_address);
8249 #endif
8250 defsubr (&Saccept_process_output);
8251 defsubr (&Sprocess_send_region);
8252 defsubr (&Sprocess_send_string);
8253 defsubr (&Sinternal_default_interrupt_process);
8254 defsubr (&Sinterrupt_process);
8255 defsubr (&Skill_process);
8256 defsubr (&Squit_process);
8257 defsubr (&Sstop_process);
8258 defsubr (&Scontinue_process);
8259 defsubr (&Sprocess_running_child_p);
8260 defsubr (&Sprocess_send_eof);
8261 defsubr (&Ssignal_process);
8262 defsubr (&Swaiting_for_user_input_p);
8263 defsubr (&Sprocess_type);
8264 defsubr (&Sinternal_default_process_sentinel);
8265 defsubr (&Sinternal_default_process_filter);
8266 defsubr (&Sset_process_coding_system);
8267 defsubr (&Sprocess_coding_system);
8268 defsubr (&Sset_process_filter_multibyte);
8269 defsubr (&Sprocess_filter_multibyte_p);
8272 Lisp_Object subfeatures = Qnil;
8273 const struct socket_options *sopt;
8275 #define ADD_SUBFEATURE(key, val) \
8276 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8278 ADD_SUBFEATURE (QCnowait, Qt);
8279 #ifdef DATAGRAM_SOCKETS
8280 ADD_SUBFEATURE (QCtype, Qdatagram);
8281 #endif
8282 #ifdef HAVE_SEQPACKET
8283 ADD_SUBFEATURE (QCtype, Qseqpacket);
8284 #endif
8285 #ifdef HAVE_LOCAL_SOCKETS
8286 ADD_SUBFEATURE (QCfamily, Qlocal);
8287 #endif
8288 ADD_SUBFEATURE (QCfamily, Qipv4);
8289 #ifdef AF_INET6
8290 ADD_SUBFEATURE (QCfamily, Qipv6);
8291 #endif
8292 #ifdef HAVE_GETSOCKNAME
8293 ADD_SUBFEATURE (QCservice, Qt);
8294 #endif
8295 ADD_SUBFEATURE (QCserver, Qt);
8297 for (sopt = socket_options; sopt->name; sopt++)
8298 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8300 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8303 #endif /* subprocesses */
8305 defsubr (&Sget_buffer_process);
8306 defsubr (&Sprocess_inherit_coding_system_flag);
8307 defsubr (&Slist_system_processes);
8308 defsubr (&Sprocess_attributes);