Fix file-attributes race on GNU hosts
[emacs.git] / src / process.c
blob730caea677f9cedf2b6377b7c10d0892444e943b
1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2017 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 <http://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 #ifdef HAVE_SETRLIMIT
44 # include <sys/resource.h>
46 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
47 NOFILE_LIMIT is the initial limit on the number of open files,
48 which should be restored in child processes. */
49 static struct rlimit nofile_limit;
50 #endif
52 /* Are local (unix) sockets supported? */
53 #if defined (HAVE_SYS_UN_H)
54 #if !defined (AF_LOCAL) && defined (AF_UNIX)
55 #define AF_LOCAL AF_UNIX
56 #endif
57 #ifdef AF_LOCAL
58 #define HAVE_LOCAL_SOCKETS
59 #include <sys/un.h>
60 #endif
61 #endif
63 #include <sys/ioctl.h>
64 #if defined (HAVE_NET_IF_H)
65 #include <net/if.h>
66 #endif /* HAVE_NET_IF_H */
68 #if defined (HAVE_IFADDRS_H)
69 /* Must be after net/if.h */
70 #include <ifaddrs.h>
72 /* We only use structs from this header when we use getifaddrs. */
73 #if defined (HAVE_NET_IF_DL_H)
74 #include <net/if_dl.h>
75 #endif
77 #endif
79 #ifdef NEED_BSDTTY
80 #include <bsdtty.h>
81 #endif
83 #ifdef USG5_4
84 # include <sys/stream.h>
85 # include <sys/stropts.h>
86 #endif
88 #ifdef HAVE_UTIL_H
89 #include <util.h>
90 #endif
92 #ifdef HAVE_PTY_H
93 #include <pty.h>
94 #endif
96 #include <c-ctype.h>
97 #include <flexmember.h>
98 #include <sig2str.h>
99 #include <verify.h>
101 #endif /* subprocesses */
103 #include "systime.h"
104 #include "systty.h"
106 #include "window.h"
107 #include "character.h"
108 #include "buffer.h"
109 #include "coding.h"
110 #include "process.h"
111 #include "frame.h"
112 #include "termopts.h"
113 #include "keyboard.h"
114 #include "blockinput.h"
115 #include "atimer.h"
116 #include "sysselect.h"
117 #include "syssignal.h"
118 #include "syswait.h"
119 #ifdef HAVE_GNUTLS
120 #include "gnutls.h"
121 #endif
123 #ifdef HAVE_WINDOW_SYSTEM
124 #include TERM_HEADER
125 #endif /* HAVE_WINDOW_SYSTEM */
127 #ifdef HAVE_GLIB
128 #include "xgselect.h"
129 #ifndef WINDOWSNT
130 #include <glib.h>
131 #endif
132 #endif
134 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
135 /* This is 0.1s in nanoseconds. */
136 #define ASYNC_RETRY_NSEC 100000000
137 #endif
139 #ifdef WINDOWSNT
140 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
141 const struct timespec *, const sigset_t *);
142 #endif
144 /* Work around GCC 4.3.0 bug with strict overflow checking; see
145 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
146 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
147 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
148 # pragma GCC diagnostic ignored "-Wstrict-overflow"
149 #endif
151 /* True if keyboard input is on hold, zero otherwise. */
153 static bool kbd_is_on_hold;
155 /* Nonzero means don't run process sentinels. This is used
156 when exiting. */
157 bool inhibit_sentinels;
159 #ifdef subprocesses
161 #ifndef SOCK_CLOEXEC
162 # define SOCK_CLOEXEC 0
163 #endif
164 #ifndef SOCK_NONBLOCK
165 # define SOCK_NONBLOCK 0
166 #endif
168 /* True if ERRNUM represents an error where the system call would
169 block if a blocking variant were used. */
170 static bool
171 would_block (int errnum)
173 #ifdef EWOULDBLOCK
174 if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
175 return true;
176 #endif
177 return errnum == EAGAIN;
180 #ifndef HAVE_ACCEPT4
182 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
184 static int
185 close_on_exec (int fd)
187 if (0 <= fd)
188 fcntl (fd, F_SETFD, FD_CLOEXEC);
189 return fd;
192 # undef accept4
193 # define accept4(sockfd, addr, addrlen, flags) \
194 process_accept4 (sockfd, addr, addrlen, flags)
195 static int
196 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
198 return close_on_exec (accept (sockfd, addr, addrlen));
201 static int
202 process_socket (int domain, int type, int protocol)
204 return close_on_exec (socket (domain, type, protocol));
206 # undef socket
207 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
208 #endif
210 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
211 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
212 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
213 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
214 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
215 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
217 /* Number of events of change of status of a process. */
218 static EMACS_INT process_tick;
219 /* Number of events for which the user or sentinel has been notified. */
220 static EMACS_INT update_tick;
222 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
223 this system. We need to read full packets, so we need a
224 "non-destructive" select. So we require either native select,
225 or emulation of select using FIONREAD. */
227 #ifndef BROKEN_DATAGRAM_SOCKETS
228 # if defined HAVE_SELECT || defined USABLE_FIONREAD
229 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
230 # define DATAGRAM_SOCKETS
231 # endif
232 # endif
233 #endif
235 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
236 # define HAVE_SEQPACKET
237 #endif
239 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
240 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
241 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
243 /* Number of processes which have a non-zero read_output_delay,
244 and therefore might be delayed for adaptive read buffering. */
246 static int process_output_delay_count;
248 /* True if any process has non-nil read_output_skip. */
250 static bool process_output_skip;
252 static void start_process_unwind (Lisp_Object);
253 static void create_process (Lisp_Object, char **, Lisp_Object);
254 #ifdef USABLE_SIGIO
255 static bool keyboard_bit_set (fd_set *);
256 #endif
257 static void deactivate_process (Lisp_Object);
258 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
259 static int read_process_output (Lisp_Object, int);
260 static void create_pty (Lisp_Object);
261 static void exec_sentinel (Lisp_Object, Lisp_Object);
263 /* Number of bits set in connect_wait_mask. */
264 static int num_pending_connects;
266 /* The largest descriptor currently in use; -1 if none. */
267 static int max_desc;
269 /* Set the external socket descriptor for Emacs to use when
270 `make-network-process' is called with a non-nil
271 `:use-external-socket' option. The value should be either -1, or
272 the file descriptor of a socket that is already bound. */
273 static int external_sock_fd;
275 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
276 static Lisp_Object chan_process[FD_SETSIZE];
277 static void wait_for_socket_fds (Lisp_Object, char const *);
279 /* Alist of elements (NAME . PROCESS). */
280 static Lisp_Object Vprocess_alist;
282 /* Buffered-ahead input char from process, indexed by channel.
283 -1 means empty (no char is buffered).
284 Used on sys V where the only way to tell if there is any
285 output from the process is to read at least one char.
286 Always -1 on systems that support FIONREAD. */
288 static int proc_buffered_char[FD_SETSIZE];
290 /* Table of `struct coding-system' for each process. */
291 static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
292 static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
294 #ifdef DATAGRAM_SOCKETS
295 /* Table of `partner address' for datagram sockets. */
296 static struct sockaddr_and_len {
297 struct sockaddr *sa;
298 ptrdiff_t len;
299 } datagram_address[FD_SETSIZE];
300 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
301 #define DATAGRAM_CONN_P(proc) \
302 (PROCESSP (proc) && \
303 XPROCESS (proc)->infd >= 0 && \
304 datagram_address[XPROCESS (proc)->infd].sa != 0)
305 #else
306 #define DATAGRAM_CONN_P(proc) (0)
307 #endif
309 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
310 a `for' loop which iterates over processes from Vprocess_alist. */
312 #define FOR_EACH_PROCESS(list_var, proc_var) \
313 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
315 /* These setters are used only in this file, so they can be private. */
316 static void
317 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
319 p->buffer = val;
321 static void
322 pset_command (struct Lisp_Process *p, Lisp_Object val)
324 p->command = val;
326 static void
327 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
329 p->decode_coding_system = val;
331 static void
332 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
334 p->decoding_buf = val;
336 static void
337 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
339 p->encode_coding_system = val;
341 static void
342 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
344 p->encoding_buf = val;
346 static void
347 pset_filter (struct Lisp_Process *p, Lisp_Object val)
349 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
351 static void
352 pset_log (struct Lisp_Process *p, Lisp_Object val)
354 p->log = val;
356 static void
357 pset_mark (struct Lisp_Process *p, Lisp_Object val)
359 p->mark = val;
361 static void
362 pset_thread (struct Lisp_Process *p, Lisp_Object val)
364 p->thread = val;
366 static void
367 pset_name (struct Lisp_Process *p, Lisp_Object val)
369 p->name = val;
371 static void
372 pset_plist (struct Lisp_Process *p, Lisp_Object val)
374 p->plist = val;
376 static void
377 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
379 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
381 static void
382 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
384 p->tty_name = val;
386 static void
387 pset_type (struct Lisp_Process *p, Lisp_Object val)
389 p->type = val;
391 static void
392 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
394 p->write_queue = val;
396 static void
397 pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
399 p->stderrproc = val;
403 static Lisp_Object
404 make_lisp_proc (struct Lisp_Process *p)
406 return make_lisp_ptr (p, Lisp_Vectorlike);
409 enum fd_bits
411 /* Read from file descriptor. */
412 FOR_READ = 1,
413 /* Write to file descriptor. */
414 FOR_WRITE = 2,
415 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
416 set. */
417 KEYBOARD_FD = 4,
418 /* This descriptor refers to a process. */
419 PROCESS_FD = 8,
420 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
421 NON_BLOCKING_CONNECT_FD = 16
424 static struct fd_callback_data
426 fd_callback func;
427 void *data;
428 /* Flags from enum fd_bits. */
429 int flags;
430 /* If this fd is locked to a certain thread, this points to it.
431 Otherwise, this is NULL. If an fd is locked to a thread, then
432 only that thread is permitted to wait on it. */
433 struct thread_state *thread;
434 /* If this fd is currently being selected on by a thread, this
435 points to the thread. Otherwise it is NULL. */
436 struct thread_state *waiting_thread;
437 } fd_callback_info[FD_SETSIZE];
440 /* Add a file descriptor FD to be monitored for when read is possible.
441 When read is possible, call FUNC with argument DATA. */
443 void
444 add_read_fd (int fd, fd_callback func, void *data)
446 add_keyboard_wait_descriptor (fd);
448 fd_callback_info[fd].func = func;
449 fd_callback_info[fd].data = data;
452 static void
453 add_non_keyboard_read_fd (int fd)
455 eassert (fd >= 0 && fd < FD_SETSIZE);
456 eassert (fd_callback_info[fd].func == NULL);
458 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
459 fd_callback_info[fd].flags |= FOR_READ;
460 if (fd > max_desc)
461 max_desc = fd;
464 static void
465 add_process_read_fd (int fd)
467 add_non_keyboard_read_fd (fd);
468 fd_callback_info[fd].flags |= PROCESS_FD;
471 /* Stop monitoring file descriptor FD for when read is possible. */
473 void
474 delete_read_fd (int fd)
476 delete_keyboard_wait_descriptor (fd);
478 if (fd_callback_info[fd].flags == 0)
480 fd_callback_info[fd].func = 0;
481 fd_callback_info[fd].data = 0;
485 /* Add a file descriptor FD to be monitored for when write is possible.
486 When write is possible, call FUNC with argument DATA. */
488 void
489 add_write_fd (int fd, fd_callback func, void *data)
491 eassert (fd >= 0 && fd < FD_SETSIZE);
493 fd_callback_info[fd].func = func;
494 fd_callback_info[fd].data = data;
495 fd_callback_info[fd].flags |= FOR_WRITE;
496 if (fd > max_desc)
497 max_desc = fd;
500 static void
501 add_non_blocking_write_fd (int fd)
503 eassert (fd >= 0 && fd < FD_SETSIZE);
504 eassert (fd_callback_info[fd].func == NULL);
506 fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
507 if (fd > max_desc)
508 max_desc = fd;
509 ++num_pending_connects;
512 static void
513 recompute_max_desc (void)
515 int fd;
517 for (fd = max_desc; fd >= 0; --fd)
519 if (fd_callback_info[fd].flags != 0)
521 max_desc = fd;
522 break;
527 /* Stop monitoring file descriptor FD for when write is possible. */
529 void
530 delete_write_fd (int fd)
532 if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
534 if (--num_pending_connects < 0)
535 emacs_abort ();
537 fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
538 if (fd_callback_info[fd].flags == 0)
540 fd_callback_info[fd].func = 0;
541 fd_callback_info[fd].data = 0;
543 if (fd == max_desc)
544 recompute_max_desc ();
548 static void
549 compute_input_wait_mask (fd_set *mask)
551 int fd;
553 FD_ZERO (mask);
554 for (fd = 0; fd <= max_desc; ++fd)
556 if (fd_callback_info[fd].thread != NULL
557 && fd_callback_info[fd].thread != current_thread)
558 continue;
559 if (fd_callback_info[fd].waiting_thread != NULL
560 && fd_callback_info[fd].waiting_thread != current_thread)
561 continue;
562 if ((fd_callback_info[fd].flags & FOR_READ) != 0)
564 FD_SET (fd, mask);
565 fd_callback_info[fd].waiting_thread = current_thread;
570 static void
571 compute_non_process_wait_mask (fd_set *mask)
573 int fd;
575 FD_ZERO (mask);
576 for (fd = 0; fd <= max_desc; ++fd)
578 if (fd_callback_info[fd].thread != NULL
579 && fd_callback_info[fd].thread != current_thread)
580 continue;
581 if (fd_callback_info[fd].waiting_thread != NULL
582 && fd_callback_info[fd].waiting_thread != current_thread)
583 continue;
584 if ((fd_callback_info[fd].flags & FOR_READ) != 0
585 && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
587 FD_SET (fd, mask);
588 fd_callback_info[fd].waiting_thread = current_thread;
593 static void
594 compute_non_keyboard_wait_mask (fd_set *mask)
596 int fd;
598 FD_ZERO (mask);
599 for (fd = 0; fd <= max_desc; ++fd)
601 if (fd_callback_info[fd].thread != NULL
602 && fd_callback_info[fd].thread != current_thread)
603 continue;
604 if (fd_callback_info[fd].waiting_thread != NULL
605 && fd_callback_info[fd].waiting_thread != current_thread)
606 continue;
607 if ((fd_callback_info[fd].flags & FOR_READ) != 0
608 && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
610 FD_SET (fd, mask);
611 fd_callback_info[fd].waiting_thread = current_thread;
616 static void
617 compute_write_mask (fd_set *mask)
619 int fd;
621 FD_ZERO (mask);
622 for (fd = 0; fd <= max_desc; ++fd)
624 if (fd_callback_info[fd].thread != NULL
625 && fd_callback_info[fd].thread != current_thread)
626 continue;
627 if (fd_callback_info[fd].waiting_thread != NULL
628 && fd_callback_info[fd].waiting_thread != current_thread)
629 continue;
630 if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
632 FD_SET (fd, mask);
633 fd_callback_info[fd].waiting_thread = current_thread;
638 static void
639 clear_waiting_thread_info (void)
641 int fd;
643 for (fd = 0; fd <= max_desc; ++fd)
645 if (fd_callback_info[fd].waiting_thread == current_thread)
646 fd_callback_info[fd].waiting_thread = NULL;
651 /* Compute the Lisp form of the process status, p->status, from
652 the numeric status that was returned by `wait'. */
654 static Lisp_Object status_convert (int);
656 static void
657 update_status (struct Lisp_Process *p)
659 eassert (p->raw_status_new);
660 pset_status (p, status_convert (p->raw_status));
661 p->raw_status_new = 0;
664 /* Convert a process status word in Unix format to
665 the list that we use internally. */
667 static Lisp_Object
668 status_convert (int w)
670 if (WIFSTOPPED (w))
671 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
672 else if (WIFEXITED (w))
673 return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
674 WCOREDUMP (w) ? Qt : Qnil));
675 else if (WIFSIGNALED (w))
676 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
677 WCOREDUMP (w) ? Qt : Qnil));
678 else
679 return Qrun;
682 /* True if STATUS is that of a process attempting connection. */
684 static bool
685 connecting_status (Lisp_Object status)
687 return CONSP (status) && EQ (XCAR (status), Qconnect);
690 /* Given a status-list, extract the three pieces of information
691 and store them individually through the three pointers. */
693 static void
694 decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
695 bool *coredump)
697 Lisp_Object tem;
699 if (connecting_status (l))
700 l = XCAR (l);
702 if (SYMBOLP (l))
704 *symbol = l;
705 *code = make_number (0);
706 *coredump = 0;
708 else
710 *symbol = XCAR (l);
711 tem = XCDR (l);
712 *code = XCAR (tem);
713 tem = XCDR (tem);
714 *coredump = !NILP (tem);
718 /* Return a string describing a process status list. */
720 static Lisp_Object
721 status_message (struct Lisp_Process *p)
723 Lisp_Object status = p->status;
724 Lisp_Object symbol, code;
725 bool coredump;
726 Lisp_Object string;
728 decode_status (status, &symbol, &code, &coredump);
730 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
732 char const *signame;
733 synchronize_system_messages_locale ();
734 signame = strsignal (XFASTINT (code));
735 if (signame == 0)
736 string = build_string ("unknown");
737 else
739 int c1, c2;
741 string = build_unibyte_string (signame);
742 if (! NILP (Vlocale_coding_system))
743 string = (code_convert_string_norecord
744 (string, Vlocale_coding_system, 0));
745 c1 = STRING_CHAR (SDATA (string));
746 c2 = downcase (c1);
747 if (c1 != c2)
748 Faset (string, make_number (0), make_number (c2));
750 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
751 return concat2 (string, suffix);
753 else if (EQ (symbol, Qexit))
755 if (NETCONN1_P (p))
756 return build_string (XFASTINT (code) == 0
757 ? "deleted\n"
758 : "connection broken by remote peer\n");
759 if (XFASTINT (code) == 0)
760 return build_string ("finished\n");
761 AUTO_STRING (prefix, "exited abnormally with code ");
762 string = Fnumber_to_string (code);
763 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
764 return concat3 (prefix, string, suffix);
766 else if (EQ (symbol, Qfailed))
768 AUTO_STRING (format, "failed with code %s\n");
769 return CALLN (Fformat, format, code);
771 else
772 return Fcopy_sequence (Fsymbol_name (symbol));
775 enum { PTY_NAME_SIZE = 24 };
777 /* Open an available pty, returning a file descriptor.
778 Store into PTY_NAME the file name of the terminal corresponding to the pty.
779 Return -1 on failure. */
781 static int
782 allocate_pty (char pty_name[PTY_NAME_SIZE])
784 #ifdef HAVE_PTYS
785 int fd;
787 #ifdef PTY_ITERATION
788 PTY_ITERATION
789 #else
790 register int c, i;
791 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
792 for (i = 0; i < 16; i++)
793 #endif
795 #ifdef PTY_NAME_SPRINTF
796 PTY_NAME_SPRINTF
797 #else
798 sprintf (pty_name, "/dev/pty%c%x", c, i);
799 #endif /* no PTY_NAME_SPRINTF */
801 #ifdef PTY_OPEN
802 PTY_OPEN;
803 #else /* no PTY_OPEN */
804 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
805 #endif /* no PTY_OPEN */
807 if (fd >= 0)
809 #ifdef PTY_TTY_NAME_SPRINTF
810 PTY_TTY_NAME_SPRINTF
811 #else
812 sprintf (pty_name, "/dev/tty%c%x", c, i);
813 #endif /* no PTY_TTY_NAME_SPRINTF */
815 /* Set FD's close-on-exec flag. This is needed even if
816 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
817 doesn't require support for that combination.
818 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
819 doesn't work if the close-on-exec flag is set (Bug#20555).
820 Multithreaded platforms where posix_openpt ignores
821 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
822 have a race condition between the PTY_OPEN and here. */
823 fcntl (fd, F_SETFD, FD_CLOEXEC);
825 /* Check to make certain that both sides are available.
826 This avoids a nasty yet stupid bug in rlogins. */
827 if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
829 emacs_close (fd);
830 continue;
832 setup_pty (fd);
833 return fd;
836 #endif /* HAVE_PTYS */
837 return -1;
840 /* Allocate basically initialized process. */
842 static struct Lisp_Process *
843 allocate_process (void)
845 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
848 static Lisp_Object
849 make_process (Lisp_Object name)
851 struct Lisp_Process *p = allocate_process ();
852 /* Initialize Lisp data. Note that allocate_process initializes all
853 Lisp data to nil, so do it only for slots which should not be nil. */
854 pset_status (p, Qrun);
855 pset_mark (p, Fmake_marker ());
856 pset_thread (p, Fcurrent_thread ());
858 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
859 non-Lisp data, so do it only for slots which should not be zero. */
860 p->infd = -1;
861 p->outfd = -1;
862 for (int i = 0; i < PROCESS_OPEN_FDS; i++)
863 p->open_fd[i] = -1;
865 #ifdef HAVE_GNUTLS
866 verify (GNUTLS_STAGE_EMPTY == 0);
867 eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
868 eassert (NILP (p->gnutls_boot_parameters));
869 #endif
871 /* If name is already in use, modify it until it is unused. */
873 Lisp_Object name1 = name;
874 for (printmax_t i = 1; ; i++)
876 Lisp_Object tem = Fget_process (name1);
877 if (NILP (tem))
878 break;
879 char const suffix_fmt[] = "<%"pMd">";
880 char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
881 AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
882 name1 = concat2 (name, lsuffix);
884 name = name1;
885 pset_name (p, name);
886 pset_sentinel (p, Qinternal_default_process_sentinel);
887 pset_filter (p, Qinternal_default_process_filter);
888 Lisp_Object val;
889 XSETPROCESS (val, p);
890 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
891 return val;
894 static void
895 remove_process (register Lisp_Object proc)
897 register Lisp_Object pair;
899 pair = Frassq (proc, Vprocess_alist);
900 Vprocess_alist = Fdelq (pair, Vprocess_alist);
902 deactivate_process (proc);
905 void
906 update_processes_for_thread_death (Lisp_Object dying_thread)
908 Lisp_Object pair;
910 for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
912 Lisp_Object process = XCDR (XCAR (pair));
913 if (EQ (XPROCESS (process)->thread, dying_thread))
915 struct Lisp_Process *proc = XPROCESS (process);
917 pset_thread (proc, Qnil);
918 if (proc->infd >= 0)
919 fd_callback_info[proc->infd].thread = NULL;
920 if (proc->outfd >= 0)
921 fd_callback_info[proc->outfd].thread = NULL;
926 #ifdef HAVE_GETADDRINFO_A
927 static void
928 free_dns_request (Lisp_Object proc)
930 struct Lisp_Process *p = XPROCESS (proc);
932 if (p->dns_request->ar_result)
933 freeaddrinfo (p->dns_request->ar_result);
934 xfree (p->dns_request);
935 p->dns_request = NULL;
937 #endif
940 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
941 doc: /* Return t if OBJECT is a process. */)
942 (Lisp_Object object)
944 return PROCESSP (object) ? Qt : Qnil;
947 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
948 doc: /* Return the process named NAME, or nil if there is none. */)
949 (register Lisp_Object name)
951 if (PROCESSP (name))
952 return name;
953 CHECK_STRING (name);
954 return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
957 /* This is how commands for the user decode process arguments. It
958 accepts a process, a process name, a buffer, a buffer name, or nil.
959 Buffers denote the first process in the buffer, and nil denotes the
960 current buffer. */
962 static Lisp_Object
963 get_process (register Lisp_Object name)
965 register Lisp_Object proc, obj;
966 if (STRINGP (name))
968 obj = Fget_process (name);
969 if (NILP (obj))
970 obj = Fget_buffer (name);
971 if (NILP (obj))
972 error ("Process %s does not exist", SDATA (name));
974 else if (NILP (name))
975 obj = Fcurrent_buffer ();
976 else
977 obj = name;
979 /* Now obj should be either a buffer object or a process object. */
980 if (BUFFERP (obj))
982 if (NILP (BVAR (XBUFFER (obj), name)))
983 error ("Attempt to get process for a dead buffer");
984 proc = Fget_buffer_process (obj);
985 if (NILP (proc))
986 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
988 else
990 CHECK_PROCESS (obj);
991 proc = obj;
993 return proc;
997 /* Fdelete_process promises to immediately forget about the process, but in
998 reality, Emacs needs to remember those processes until they have been
999 treated by the SIGCHLD handler and waitpid has been invoked on them;
1000 otherwise they might fill up the kernel's process table.
1002 Some processes created by call-process are also put onto this list.
1004 Members of this list are (process-ID . filename) pairs. The
1005 process-ID is a number; the filename, if a string, is a file that
1006 needs to be removed after the process exits. */
1007 static Lisp_Object deleted_pid_list;
1009 void
1010 record_deleted_pid (pid_t pid, Lisp_Object filename)
1012 deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
1013 /* GC treated elements set to nil. */
1014 Fdelq (Qnil, deleted_pid_list));
1018 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
1019 doc: /* Delete PROCESS: kill it and forget about it immediately.
1020 PROCESS may be a process, a buffer, the name of a process or buffer, or
1021 nil, indicating the current buffer's process. */)
1022 (register Lisp_Object process)
1024 register struct Lisp_Process *p;
1026 process = get_process (process);
1027 p = XPROCESS (process);
1029 #ifdef HAVE_GETADDRINFO_A
1030 if (p->dns_request)
1032 /* Cancel the request. Unless shutting down, wait until
1033 completion. Free the request if completely canceled. */
1035 bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
1036 if (!canceled && !inhibit_sentinels)
1038 struct gaicb const *req = p->dns_request;
1039 while (gai_suspend (&req, 1, NULL) != 0)
1040 continue;
1041 canceled = true;
1043 if (canceled)
1044 free_dns_request (process);
1046 #endif
1048 p->raw_status_new = 0;
1049 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1051 pset_status (p, list2 (Qexit, make_number (0)));
1052 p->tick = ++process_tick;
1053 status_notify (p, NULL);
1054 redisplay_preserve_echo_area (13);
1056 else
1058 if (p->alive)
1059 record_kill_process (p, Qnil);
1061 if (p->infd >= 0)
1063 /* Update P's status, since record_kill_process will make the
1064 SIGCHLD handler update deleted_pid_list, not *P. */
1065 Lisp_Object symbol;
1066 if (p->raw_status_new)
1067 update_status (p);
1068 symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
1069 if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
1070 pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
1072 p->tick = ++process_tick;
1073 status_notify (p, NULL);
1074 redisplay_preserve_echo_area (13);
1077 remove_process (process);
1078 return Qnil;
1081 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
1082 doc: /* Return the status of PROCESS.
1083 The returned value is one of the following symbols:
1084 run -- for a process that is running.
1085 stop -- for a process stopped but continuable.
1086 exit -- for a process that has exited.
1087 signal -- for a process that has got a fatal signal.
1088 open -- for a network stream connection that is open.
1089 listen -- for a network stream server that is listening.
1090 closed -- for a network stream connection that is closed.
1091 connect -- when waiting for a non-blocking connection to complete.
1092 failed -- when a non-blocking connection has failed.
1093 nil -- if arg is a process name and no such process exists.
1094 PROCESS may be a process, a buffer, the name of a process, or
1095 nil, indicating the current buffer's process. */)
1096 (register Lisp_Object process)
1098 register struct Lisp_Process *p;
1099 register Lisp_Object status;
1101 if (STRINGP (process))
1102 process = Fget_process (process);
1103 else
1104 process = get_process (process);
1106 if (NILP (process))
1107 return process;
1109 p = XPROCESS (process);
1110 if (p->raw_status_new)
1111 update_status (p);
1112 status = p->status;
1113 if (CONSP (status))
1114 status = XCAR (status);
1115 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1117 if (EQ (status, Qexit))
1118 status = Qclosed;
1119 else if (EQ (p->command, Qt))
1120 status = Qstop;
1121 else if (EQ (status, Qrun))
1122 status = Qopen;
1124 return status;
1127 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1128 1, 1, 0,
1129 doc: /* Return the exit status of PROCESS or the signal number that killed it.
1130 If PROCESS has not yet exited or died, return 0. */)
1131 (register Lisp_Object process)
1133 CHECK_PROCESS (process);
1134 if (XPROCESS (process)->raw_status_new)
1135 update_status (XPROCESS (process));
1136 if (CONSP (XPROCESS (process)->status))
1137 return XCAR (XCDR (XPROCESS (process)->status));
1138 return make_number (0);
1141 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
1142 doc: /* Return the process id of PROCESS.
1143 This is the pid of the external process which PROCESS uses or talks to.
1144 For a network, serial, and pipe connections, this value is nil. */)
1145 (register Lisp_Object process)
1147 pid_t pid;
1149 CHECK_PROCESS (process);
1150 pid = XPROCESS (process)->pid;
1151 return (pid ? make_fixnum_or_float (pid) : Qnil);
1154 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
1155 doc: /* Return the name of PROCESS, as a string.
1156 This is the name of the program invoked in PROCESS,
1157 possibly modified to make it unique among process names. */)
1158 (register Lisp_Object process)
1160 CHECK_PROCESS (process);
1161 return XPROCESS (process)->name;
1164 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
1165 doc: /* Return the command that was executed to start PROCESS.
1166 This is a list of strings, the first string being the program executed
1167 and the rest of the strings being the arguments given to it.
1168 For a network or serial or pipe connection, this is nil (process is running)
1169 or t (process is stopped). */)
1170 (register Lisp_Object process)
1172 CHECK_PROCESS (process);
1173 return XPROCESS (process)->command;
1176 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
1177 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
1178 This is the terminal that the process itself reads and writes on,
1179 not the name of the pty that Emacs uses to talk with that terminal. */)
1180 (register Lisp_Object process)
1182 CHECK_PROCESS (process);
1183 return XPROCESS (process)->tty_name;
1186 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
1187 2, 2, 0,
1188 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1189 Return BUFFER. */)
1190 (register Lisp_Object process, Lisp_Object buffer)
1192 struct Lisp_Process *p;
1194 CHECK_PROCESS (process);
1195 if (!NILP (buffer))
1196 CHECK_BUFFER (buffer);
1197 p = XPROCESS (process);
1198 pset_buffer (p, buffer);
1199 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1200 pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
1201 setup_process_coding_systems (process);
1202 return buffer;
1205 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1206 1, 1, 0,
1207 doc: /* Return the buffer PROCESS is associated with.
1208 The default process filter inserts output from PROCESS into this buffer. */)
1209 (register Lisp_Object process)
1211 CHECK_PROCESS (process);
1212 return XPROCESS (process)->buffer;
1215 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1216 1, 1, 0,
1217 doc: /* Return the marker for the end of the last output from PROCESS. */)
1218 (register Lisp_Object process)
1220 CHECK_PROCESS (process);
1221 return XPROCESS (process)->mark;
1224 static void
1225 set_process_filter_masks (struct Lisp_Process *p)
1227 if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
1228 delete_read_fd (p->infd);
1229 else if (EQ (p->filter, Qt)
1230 /* Network or serial process not stopped: */
1231 && !EQ (p->command, Qt))
1232 add_process_read_fd (p->infd);
1235 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1236 2, 2, 0,
1237 doc: /* Give PROCESS the filter function FILTER; nil means default.
1238 A value of t means stop accepting output from the process.
1240 When a process has a non-default filter, its buffer is not used for output.
1241 Instead, each time it does output, the entire string of output is
1242 passed to the filter.
1244 The filter gets two arguments: the process and the string of output.
1245 The string argument is normally a multibyte string, except:
1246 - if the process's input coding system is no-conversion or raw-text,
1247 it is a unibyte string (the non-converted input), or else
1248 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1249 string (the result of converting the decoded input multibyte
1250 string to unibyte with `string-make-unibyte'). */)
1251 (Lisp_Object process, Lisp_Object filter)
1253 CHECK_PROCESS (process);
1254 struct Lisp_Process *p = XPROCESS (process);
1256 /* Don't signal an error if the process's input file descriptor
1257 is closed. This could make debugging Lisp more difficult,
1258 for example when doing something like
1260 (setq process (start-process ...))
1261 (debug)
1262 (set-process-filter process ...) */
1264 if (NILP (filter))
1265 filter = Qinternal_default_process_filter;
1267 pset_filter (p, filter);
1269 if (p->infd >= 0)
1270 set_process_filter_masks (p);
1272 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1273 pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
1274 setup_process_coding_systems (process);
1275 return filter;
1278 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1279 1, 1, 0,
1280 doc: /* Return the filter function of PROCESS.
1281 See `set-process-filter' for more info on filter functions. */)
1282 (register Lisp_Object process)
1284 CHECK_PROCESS (process);
1285 return XPROCESS (process)->filter;
1288 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1289 2, 2, 0,
1290 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1291 The sentinel is called as a function when the process changes state.
1292 It gets two arguments: the process, and a string describing the change. */)
1293 (register Lisp_Object process, Lisp_Object sentinel)
1295 struct Lisp_Process *p;
1297 CHECK_PROCESS (process);
1298 p = XPROCESS (process);
1300 if (NILP (sentinel))
1301 sentinel = Qinternal_default_process_sentinel;
1303 pset_sentinel (p, sentinel);
1304 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1305 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
1306 return sentinel;
1309 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1310 1, 1, 0,
1311 doc: /* Return the sentinel of PROCESS.
1312 See `set-process-sentinel' for more info on sentinels. */)
1313 (register Lisp_Object process)
1315 CHECK_PROCESS (process);
1316 return XPROCESS (process)->sentinel;
1319 DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread,
1320 2, 2, 0,
1321 doc: /* Set the locking thread of PROCESS to be THREAD.
1322 If THREAD is nil, the process is unlocked. */)
1323 (Lisp_Object process, Lisp_Object thread)
1325 struct Lisp_Process *proc;
1326 struct thread_state *tstate;
1328 CHECK_PROCESS (process);
1329 if (NILP (thread))
1330 tstate = NULL;
1331 else
1333 CHECK_THREAD (thread);
1334 tstate = XTHREAD (thread);
1337 proc = XPROCESS (process);
1338 pset_thread (proc, thread);
1339 if (proc->infd >= 0)
1340 fd_callback_info[proc->infd].thread = tstate;
1341 if (proc->outfd >= 0)
1342 fd_callback_info[proc->outfd].thread = tstate;
1344 return thread;
1347 DEFUN ("process-thread", Fprocess_thread, Sprocess_thread,
1348 1, 1, 0,
1349 doc: /* Ret the locking thread of PROCESS.
1350 If PROCESS is unlocked, this function returns nil. */)
1351 (Lisp_Object process)
1353 CHECK_PROCESS (process);
1354 return XPROCESS (process)->thread;
1357 DEFUN ("set-process-window-size", Fset_process_window_size,
1358 Sset_process_window_size, 3, 3, 0,
1359 doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1360 Value is t if PROCESS was successfully told about the window size,
1361 nil otherwise. */)
1362 (Lisp_Object process, Lisp_Object height, Lisp_Object width)
1364 CHECK_PROCESS (process);
1366 /* All known platforms store window sizes as 'unsigned short'. */
1367 CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
1368 CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
1370 if (NETCONN_P (process)
1371 || XPROCESS (process)->infd < 0
1372 || (set_window_size (XPROCESS (process)->infd,
1373 XINT (height), XINT (width))
1374 < 0))
1375 return Qnil;
1376 else
1377 return Qt;
1380 DEFUN ("set-process-inherit-coding-system-flag",
1381 Fset_process_inherit_coding_system_flag,
1382 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1383 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1384 If the second argument FLAG is non-nil, then the variable
1385 `buffer-file-coding-system' of the buffer associated with PROCESS
1386 will be bound to the value of the coding system used to decode
1387 the process output.
1389 This is useful when the coding system specified for the process buffer
1390 leaves either the character code conversion or the end-of-line conversion
1391 unspecified, or if the coding system used to decode the process output
1392 is more appropriate for saving the process buffer.
1394 Binding the variable `inherit-process-coding-system' to non-nil before
1395 starting the process is an alternative way of setting the inherit flag
1396 for the process which will run.
1398 This function returns FLAG. */)
1399 (register Lisp_Object process, Lisp_Object flag)
1401 CHECK_PROCESS (process);
1402 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1403 return flag;
1406 DEFUN ("set-process-query-on-exit-flag",
1407 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1408 2, 2, 0,
1409 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1410 If the second argument FLAG is non-nil, Emacs will query the user before
1411 exiting or killing a buffer if PROCESS is running. This function
1412 returns FLAG. */)
1413 (register Lisp_Object process, Lisp_Object flag)
1415 CHECK_PROCESS (process);
1416 XPROCESS (process)->kill_without_query = NILP (flag);
1417 return flag;
1420 DEFUN ("process-query-on-exit-flag",
1421 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1422 1, 1, 0,
1423 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1424 (register Lisp_Object process)
1426 CHECK_PROCESS (process);
1427 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1430 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1431 1, 2, 0,
1432 doc: /* Return the contact info of PROCESS; t for a real child.
1433 For a network or serial or pipe connection, the value depends on the
1434 optional KEY arg. If KEY is nil, value is a cons cell of the form
1435 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1436 connection; it is t for a pipe connection. If KEY is t, the complete
1437 contact information for the connection is returned, else the specific
1438 value for the keyword KEY is returned. See `make-network-process',
1439 `make-serial-process', or `make pipe-process' for the list of keywords.
1440 If PROCESS is a non-blocking network process that hasn't been fully
1441 set up yet, this function will block until socket setup has completed. */)
1442 (Lisp_Object process, Lisp_Object key)
1444 Lisp_Object contact;
1446 CHECK_PROCESS (process);
1447 contact = XPROCESS (process)->childp;
1449 #ifdef DATAGRAM_SOCKETS
1451 if (NETCONN_P (process))
1452 wait_for_socket_fds (process, "process-contact");
1454 if (DATAGRAM_CONN_P (process)
1455 && (EQ (key, Qt) || EQ (key, QCremote)))
1456 contact = Fplist_put (contact, QCremote,
1457 Fprocess_datagram_address (process));
1458 #endif
1460 if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
1461 || EQ (key, Qt))
1462 return contact;
1463 if (NILP (key) && NETCONN_P (process))
1464 return list2 (Fplist_get (contact, QChost),
1465 Fplist_get (contact, QCservice));
1466 if (NILP (key) && SERIALCONN_P (process))
1467 return list2 (Fplist_get (contact, QCport),
1468 Fplist_get (contact, QCspeed));
1469 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1470 if the pipe process is useful for purposes other than receiving
1471 stderr. */
1472 if (NILP (key) && PIPECONN_P (process))
1473 return Qt;
1474 return Fplist_get (contact, key);
1477 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1478 1, 1, 0,
1479 doc: /* Return the plist of PROCESS. */)
1480 (register Lisp_Object process)
1482 CHECK_PROCESS (process);
1483 return XPROCESS (process)->plist;
1486 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1487 2, 2, 0,
1488 doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1489 (Lisp_Object process, Lisp_Object plist)
1491 CHECK_PROCESS (process);
1492 CHECK_LIST (plist);
1494 pset_plist (XPROCESS (process), plist);
1495 return plist;
1498 #if 0 /* Turned off because we don't currently record this info
1499 in the process. Perhaps add it. */
1500 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1501 doc: /* Return the connection type of PROCESS.
1502 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1503 a socket connection. */)
1504 (Lisp_Object process)
1506 return XPROCESS (process)->type;
1508 #endif
1510 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1511 doc: /* Return the connection type of PROCESS.
1512 The value is either the symbol `real', `network', `serial', or `pipe'.
1513 PROCESS may be a process, a buffer, the name of a process or buffer, or
1514 nil, indicating the current buffer's process. */)
1515 (Lisp_Object process)
1517 Lisp_Object proc;
1518 proc = get_process (process);
1519 return XPROCESS (proc)->type;
1522 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1523 1, 2, 0,
1524 doc: /* Convert network ADDRESS from internal format to a string.
1525 A 4 or 5 element vector represents an IPv4 address (with port number).
1526 An 8 or 9 element vector represents an IPv6 address (with port number).
1527 If optional second argument OMIT-PORT is non-nil, don't include a port
1528 number in the string, even when present in ADDRESS.
1529 Return nil if format of ADDRESS is invalid. */)
1530 (Lisp_Object address, Lisp_Object omit_port)
1532 if (NILP (address))
1533 return Qnil;
1535 if (STRINGP (address)) /* AF_LOCAL */
1536 return address;
1538 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1540 register struct Lisp_Vector *p = XVECTOR (address);
1541 ptrdiff_t size = p->header.size;
1542 Lisp_Object args[10];
1543 int nargs, i;
1544 char const *format;
1546 if (size == 4 || (size == 5 && !NILP (omit_port)))
1548 format = "%d.%d.%d.%d";
1549 nargs = 4;
1551 else if (size == 5)
1553 format = "%d.%d.%d.%d:%d";
1554 nargs = 5;
1556 else if (size == 8 || (size == 9 && !NILP (omit_port)))
1558 format = "%x:%x:%x:%x:%x:%x:%x:%x";
1559 nargs = 8;
1561 else if (size == 9)
1563 format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1564 nargs = 9;
1566 else
1567 return Qnil;
1569 AUTO_STRING (format_obj, format);
1570 args[0] = format_obj;
1572 for (i = 0; i < nargs; i++)
1574 if (! RANGED_INTEGERP (0, p->contents[i], 65535))
1575 return Qnil;
1577 if (nargs <= 5 /* IPv4 */
1578 && i < 4 /* host, not port */
1579 && XINT (p->contents[i]) > 255)
1580 return Qnil;
1582 args[i + 1] = p->contents[i];
1585 return Fformat (nargs + 1, args);
1588 if (CONSP (address))
1590 AUTO_STRING (format, "<Family %d>");
1591 return CALLN (Fformat, format, Fcar (address));
1594 return Qnil;
1597 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1598 doc: /* Return a list of all processes that are Emacs sub-processes. */)
1599 (void)
1601 return Fmapcar (Qcdr, Vprocess_alist);
1604 /* Starting asynchronous inferior processes. */
1606 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
1607 doc: /* Start a program in a subprocess. Return the process object for it.
1609 This is similar to `start-process', but arguments are specified as
1610 keyword/argument pairs. The following arguments are defined:
1612 :name NAME -- NAME is name for process. It is modified if necessary
1613 to make it unique.
1615 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1616 with the process. Process output goes at end of that buffer, unless
1617 you specify an output stream or filter function to handle the output.
1618 BUFFER may be also nil, meaning that this process is not associated
1619 with any buffer.
1621 :command COMMAND -- COMMAND is a list starting with the program file
1622 name, followed by strings to give to the program as arguments.
1624 :coding CODING -- If CODING is a symbol, it specifies the coding
1625 system used for both reading and writing for this process. If CODING
1626 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1627 ENCODING is used for writing.
1629 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1630 the process is running. If BOOL is not given, query before exiting.
1632 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1633 In the stopped state, a process does not accept incoming data, but you
1634 can send outgoing data. The stopped state is cleared by
1635 `continue-process' and set by `stop-process'.
1637 :connection-type TYPE -- TYPE is control type of device used to
1638 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1639 to use a pty, or nil to use the default specified through
1640 `process-connection-type'.
1642 :filter FILTER -- Install FILTER as the process filter.
1644 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1646 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1647 to the standard error of subprocess. Specifying this implies
1648 `:connection-type' is set to `pipe'.
1650 usage: (make-process &rest ARGS) */)
1651 (ptrdiff_t nargs, Lisp_Object *args)
1653 Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
1654 Lisp_Object xstderr, stderrproc;
1655 ptrdiff_t count = SPECPDL_INDEX ();
1657 if (nargs == 0)
1658 return Qnil;
1660 /* Save arguments for process-contact and clone-process. */
1661 contact = Flist (nargs, args);
1663 buffer = Fplist_get (contact, QCbuffer);
1664 if (!NILP (buffer))
1665 buffer = Fget_buffer_create (buffer);
1667 /* Make sure that the child will be able to chdir to the current
1668 buffer's current directory, or its unhandled equivalent. We
1669 can't just have the child check for an error when it does the
1670 chdir, since it's in a vfork. */
1671 current_dir = encode_current_directory ();
1673 name = Fplist_get (contact, QCname);
1674 CHECK_STRING (name);
1676 command = Fplist_get (contact, QCcommand);
1677 if (CONSP (command))
1678 program = XCAR (command);
1679 else
1680 program = Qnil;
1682 if (!NILP (program))
1683 CHECK_STRING (program);
1685 stderrproc = Qnil;
1686 xstderr = Fplist_get (contact, QCstderr);
1687 if (PROCESSP (xstderr))
1689 if (!PIPECONN_P (xstderr))
1690 error ("Process is not a pipe process");
1691 stderrproc = xstderr;
1693 else if (!NILP (xstderr))
1695 CHECK_STRING (program);
1696 stderrproc = CALLN (Fmake_pipe_process,
1697 QCname,
1698 concat2 (name, build_string (" stderr")),
1699 QCbuffer,
1700 Fget_buffer_create (xstderr));
1703 proc = make_process (name);
1704 record_unwind_protect (start_process_unwind, proc);
1706 pset_childp (XPROCESS (proc), Qt);
1707 eassert (NILP (XPROCESS (proc)->plist));
1708 pset_type (XPROCESS (proc), Qreal);
1709 pset_buffer (XPROCESS (proc), buffer);
1710 pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
1711 pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
1712 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1714 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
1715 XPROCESS (proc)->kill_without_query = 1;
1716 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
1717 pset_command (XPROCESS (proc), Qt);
1719 tem = Fplist_get (contact, QCconnection_type);
1720 if (EQ (tem, Qpty))
1721 XPROCESS (proc)->pty_flag = true;
1722 else if (EQ (tem, Qpipe))
1723 XPROCESS (proc)->pty_flag = false;
1724 else if (NILP (tem))
1725 XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
1726 else
1727 report_file_error ("Unknown connection type", tem);
1729 if (!NILP (stderrproc))
1731 pset_stderrproc (XPROCESS (proc), stderrproc);
1733 XPROCESS (proc)->pty_flag = false;
1736 #ifdef HAVE_GNUTLS
1737 /* AKA GNUTLS_INITSTAGE(proc). */
1738 verify (GNUTLS_STAGE_EMPTY == 0);
1739 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1740 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1741 #endif
1743 XPROCESS (proc)->adaptive_read_buffering
1744 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1745 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1747 /* Make the process marker point into the process buffer (if any). */
1748 if (BUFFERP (buffer))
1749 set_marker_both (XPROCESS (proc)->mark, buffer,
1750 BUF_ZV (XBUFFER (buffer)),
1751 BUF_ZV_BYTE (XBUFFER (buffer)));
1753 USE_SAFE_ALLOCA;
1756 /* Decide coding systems for communicating with the process. Here
1757 we don't setup the structure coding_system nor pay attention to
1758 unibyte mode. They are done in create_process. */
1760 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1761 Lisp_Object coding_systems = Qt;
1762 Lisp_Object val, *args2;
1764 tem = Fplist_get (contact, QCcoding);
1765 if (!NILP (tem))
1767 val = tem;
1768 if (CONSP (val))
1769 val = XCAR (val);
1771 else
1772 val = Vcoding_system_for_read;
1773 if (NILP (val))
1775 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1776 Lisp_Object tem2;
1777 SAFE_ALLOCA_LISP (args2, nargs2);
1778 ptrdiff_t i = 0;
1779 args2[i++] = Qstart_process;
1780 args2[i++] = name;
1781 args2[i++] = buffer;
1782 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1783 args2[i++] = XCAR (tem2);
1784 if (!NILP (program))
1785 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1786 if (CONSP (coding_systems))
1787 val = XCAR (coding_systems);
1788 else if (CONSP (Vdefault_process_coding_system))
1789 val = XCAR (Vdefault_process_coding_system);
1791 pset_decode_coding_system (XPROCESS (proc), val);
1793 if (!NILP (tem))
1795 val = tem;
1796 if (CONSP (val))
1797 val = XCDR (val);
1799 else
1800 val = Vcoding_system_for_write;
1801 if (NILP (val))
1803 if (EQ (coding_systems, Qt))
1805 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1806 Lisp_Object tem2;
1807 SAFE_ALLOCA_LISP (args2, nargs2);
1808 ptrdiff_t i = 0;
1809 args2[i++] = Qstart_process;
1810 args2[i++] = name;
1811 args2[i++] = buffer;
1812 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1813 args2[i++] = XCAR (tem2);
1814 if (!NILP (program))
1815 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1817 if (CONSP (coding_systems))
1818 val = XCDR (coding_systems);
1819 else if (CONSP (Vdefault_process_coding_system))
1820 val = XCDR (Vdefault_process_coding_system);
1822 pset_encode_coding_system (XPROCESS (proc), val);
1823 /* Note: At this moment, the above coding system may leave
1824 text-conversion or eol-conversion unspecified. They will be
1825 decided after we read output from the process and decode it by
1826 some coding system, or just before we actually send a text to
1827 the process. */
1831 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1832 eassert (XPROCESS (proc)->decoding_carryover == 0);
1833 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1835 XPROCESS (proc)->inherit_coding_system_flag
1836 = !(NILP (buffer) || !inherit_process_coding_system);
1838 if (!NILP (program))
1840 Lisp_Object program_args = XCDR (command);
1842 /* If program file name is not absolute, search our path for it.
1843 Put the name we will really use in TEM. */
1844 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1845 && !(SCHARS (program) > 1
1846 && IS_DEVICE_SEP (SREF (program, 1))))
1848 tem = Qnil;
1849 openp (Vexec_path, program, Vexec_suffixes, &tem,
1850 make_number (X_OK), false);
1851 if (NILP (tem))
1852 report_file_error ("Searching for program", program);
1853 tem = Fexpand_file_name (tem, Qnil);
1855 else
1857 if (!NILP (Ffile_directory_p (program)))
1858 error ("Specified program for new process is a directory");
1859 tem = program;
1862 /* Remove "/:" from TEM. */
1863 tem = remove_slash_colon (tem);
1865 Lisp_Object arg_encoding = Qnil;
1867 /* Encode the file name and put it in NEW_ARGV.
1868 That's where the child will use it to execute the program. */
1869 tem = list1 (ENCODE_FILE (tem));
1870 ptrdiff_t new_argc = 1;
1872 /* Here we encode arguments by the coding system used for sending
1873 data to the process. We don't support using different coding
1874 systems for encoding arguments and for encoding data sent to the
1875 process. */
1877 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
1879 Lisp_Object arg = XCAR (tem2);
1880 CHECK_STRING (arg);
1881 if (STRING_MULTIBYTE (arg))
1883 if (NILP (arg_encoding))
1884 arg_encoding = (complement_process_encoding_system
1885 (XPROCESS (proc)->encode_coding_system));
1886 arg = code_convert_string_norecord (arg, arg_encoding, 1);
1888 tem = Fcons (arg, tem);
1889 new_argc++;
1892 /* Now that everything is encoded we can collect the strings into
1893 NEW_ARGV. */
1894 char **new_argv;
1895 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
1896 new_argv[new_argc] = 0;
1898 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
1900 new_argv[i] = SSDATA (XCAR (tem));
1901 tem = XCDR (tem);
1904 create_process (proc, new_argv, current_dir);
1906 else
1907 create_pty (proc);
1909 SAFE_FREE ();
1910 return unbind_to (count, proc);
1913 /* If PROC doesn't have its pid set, then an error was signaled and
1914 the process wasn't started successfully, so remove it. */
1915 static void
1916 start_process_unwind (Lisp_Object proc)
1918 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1919 remove_process (proc);
1922 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1924 static void
1925 close_process_fd (int *fd_addr)
1927 int fd = *fd_addr;
1928 if (0 <= fd)
1930 *fd_addr = -1;
1931 emacs_close (fd);
1935 /* Indexes of file descriptors in open_fds. */
1936 enum
1938 /* The pipe from Emacs to its subprocess. */
1939 SUBPROCESS_STDIN,
1940 WRITE_TO_SUBPROCESS,
1942 /* The main pipe from the subprocess to Emacs. */
1943 READ_FROM_SUBPROCESS,
1944 SUBPROCESS_STDOUT,
1946 /* The pipe from the subprocess to Emacs that is closed when the
1947 subprocess execs. */
1948 READ_FROM_EXEC_MONITOR,
1949 EXEC_MONITOR_OUTPUT
1952 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
1954 static void
1955 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1957 struct Lisp_Process *p = XPROCESS (process);
1958 int inchannel, outchannel;
1959 pid_t pid;
1960 int vfork_errno;
1961 int forkin, forkout, forkerr = -1;
1962 bool pty_flag = 0;
1963 char pty_name[PTY_NAME_SIZE];
1964 Lisp_Object lisp_pty_name = Qnil;
1965 sigset_t oldset;
1967 inchannel = outchannel = -1;
1969 if (p->pty_flag)
1970 outchannel = inchannel = allocate_pty (pty_name);
1972 if (inchannel >= 0)
1974 p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
1975 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1976 /* On most USG systems it does not work to open the pty's tty here,
1977 then close it and reopen it in the child. */
1978 /* Don't let this terminal become our controlling terminal
1979 (in case we don't have one). */
1980 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1981 if (forkin < 0)
1982 report_file_error ("Opening pty", Qnil);
1983 p->open_fd[SUBPROCESS_STDIN] = forkin;
1984 #else
1985 forkin = forkout = -1;
1986 #endif /* not USG, or USG_SUBTTY_WORKS */
1987 pty_flag = 1;
1988 lisp_pty_name = build_string (pty_name);
1990 else
1992 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
1993 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
1994 report_file_error ("Creating pipe", Qnil);
1995 forkin = p->open_fd[SUBPROCESS_STDIN];
1996 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
1997 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
1998 forkout = p->open_fd[SUBPROCESS_STDOUT];
2000 if (!NILP (p->stderrproc))
2002 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2004 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2006 /* Close unnecessary file descriptors. */
2007 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2008 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2012 #ifndef WINDOWSNT
2013 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2014 report_file_error ("Creating pipe", Qnil);
2015 #endif
2017 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2018 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2020 /* Record this as an active process, with its channels. */
2021 chan_process[inchannel] = process;
2022 p->infd = inchannel;
2023 p->outfd = outchannel;
2025 /* Previously we recorded the tty descriptor used in the subprocess.
2026 It was only used for getting the foreground tty process, so now
2027 we just reopen the device (see emacs_get_tty_pgrp) as this is
2028 more portable (see USG_SUBTTY_WORKS above). */
2030 p->pty_flag = pty_flag;
2031 pset_status (p, Qrun);
2033 if (!EQ (p->command, Qt))
2034 add_process_read_fd (inchannel);
2036 /* This may signal an error. */
2037 setup_process_coding_systems (process);
2039 block_input ();
2040 block_child_signal (&oldset);
2042 #ifndef WINDOWSNT
2043 /* vfork, and prevent local vars from being clobbered by the vfork. */
2044 Lisp_Object volatile current_dir_volatile = current_dir;
2045 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
2046 char **volatile new_argv_volatile = new_argv;
2047 int volatile forkin_volatile = forkin;
2048 int volatile forkout_volatile = forkout;
2049 int volatile forkerr_volatile = forkerr;
2050 struct Lisp_Process *p_volatile = p;
2052 #ifdef DARWIN_OS
2053 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2054 necessary. Also, reset SIGCHLD handling after a vfork, as
2055 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2056 if (pty_flag)
2057 pid = fork ();
2058 else
2060 pid = vfork ();
2061 if (pid == 0)
2062 signal (SIGCHLD, SIG_DFL);
2064 #else
2065 pid = vfork ();
2066 #endif
2068 current_dir = current_dir_volatile;
2069 lisp_pty_name = lisp_pty_name_volatile;
2070 new_argv = new_argv_volatile;
2071 forkin = forkin_volatile;
2072 forkout = forkout_volatile;
2073 forkerr = forkerr_volatile;
2074 p = p_volatile;
2076 pty_flag = p->pty_flag;
2078 if (pid == 0)
2079 #endif /* not WINDOWSNT */
2081 /* Make the pty be the controlling terminal of the process. */
2082 #ifdef HAVE_PTYS
2083 /* First, disconnect its current controlling terminal. */
2084 if (pty_flag)
2085 setsid ();
2086 /* Make the pty's terminal the controlling terminal. */
2087 if (pty_flag && forkin >= 0)
2089 #ifdef TIOCSCTTY
2090 /* We ignore the return value
2091 because faith@cs.unc.edu says that is necessary on Linux. */
2092 ioctl (forkin, TIOCSCTTY, 0);
2093 #endif
2095 #if defined (LDISC1)
2096 if (pty_flag && forkin >= 0)
2098 struct termios t;
2099 tcgetattr (forkin, &t);
2100 t.c_lflag = LDISC1;
2101 if (tcsetattr (forkin, TCSANOW, &t) < 0)
2102 emacs_perror ("create_process/tcsetattr LDISC1");
2104 #else
2105 #if defined (NTTYDISC) && defined (TIOCSETD)
2106 if (pty_flag && forkin >= 0)
2108 /* Use new line discipline. */
2109 int ldisc = NTTYDISC;
2110 ioctl (forkin, TIOCSETD, &ldisc);
2112 #endif
2113 #endif
2114 #ifdef TIOCNOTTY
2115 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2116 can do TIOCSPGRP only to the process's controlling tty. */
2117 if (pty_flag)
2119 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2120 I can't test it since I don't have 4.3. */
2121 int j = emacs_open (DEV_TTY, O_RDWR, 0);
2122 if (j >= 0)
2124 ioctl (j, TIOCNOTTY, 0);
2125 emacs_close (j);
2128 #endif /* TIOCNOTTY */
2130 #if !defined (DONT_REOPEN_PTY)
2131 /*** There is a suggestion that this ought to be a
2132 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2133 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2134 that system does seem to need this code, even though
2135 both TIOCSCTTY is defined. */
2136 /* Now close the pty (if we had it open) and reopen it.
2137 This makes the pty the controlling terminal of the subprocess. */
2138 if (pty_flag)
2141 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2142 would work? */
2143 if (forkin >= 0)
2144 emacs_close (forkin);
2145 forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
2147 if (forkin < 0)
2149 emacs_perror (SSDATA (lisp_pty_name));
2150 _exit (EXIT_CANCELED);
2154 #endif /* not DONT_REOPEN_PTY */
2156 #ifdef SETUP_SLAVE_PTY
2157 if (pty_flag)
2159 SETUP_SLAVE_PTY;
2161 #endif /* SETUP_SLAVE_PTY */
2162 #endif /* HAVE_PTYS */
2164 signal (SIGINT, SIG_DFL);
2165 signal (SIGQUIT, SIG_DFL);
2166 #ifdef SIGPROF
2167 signal (SIGPROF, SIG_DFL);
2168 #endif
2170 /* Emacs ignores SIGPIPE, but the child should not. */
2171 signal (SIGPIPE, SIG_DFL);
2173 /* Stop blocking SIGCHLD in the child. */
2174 unblock_child_signal (&oldset);
2176 if (pty_flag)
2177 child_setup_tty (forkout);
2179 if (forkerr < 0)
2180 forkerr = forkout;
2181 #ifdef WINDOWSNT
2182 pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2183 #else /* not WINDOWSNT */
2184 child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2185 #endif /* not WINDOWSNT */
2188 /* Back in the parent process. */
2190 vfork_errno = errno;
2191 p->pid = pid;
2192 if (pid >= 0)
2193 p->alive = 1;
2195 /* Stop blocking in the parent. */
2196 unblock_child_signal (&oldset);
2197 unblock_input ();
2199 if (pid < 0)
2200 report_file_errno ("Doing vfork", Qnil, vfork_errno);
2201 else
2203 /* vfork succeeded. */
2205 /* Close the pipe ends that the child uses, or the child's pty. */
2206 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2207 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2209 #ifdef WINDOWSNT
2210 register_child (pid, inchannel);
2211 #endif /* WINDOWSNT */
2213 pset_tty_name (p, lisp_pty_name);
2215 #ifndef WINDOWSNT
2216 /* Wait for child_setup to complete in case that vfork is
2217 actually defined as fork. The descriptor
2218 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2219 of a pipe is closed at the child side either by close-on-exec
2220 on successful execve or the _exit call in child_setup. */
2222 char dummy;
2224 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2225 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2226 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2228 #endif
2229 if (!NILP (p->stderrproc))
2231 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2232 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2237 static void
2238 create_pty (Lisp_Object process)
2240 struct Lisp_Process *p = XPROCESS (process);
2241 char pty_name[PTY_NAME_SIZE];
2242 int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
2244 if (pty_fd >= 0)
2246 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2247 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2248 /* On most USG systems it does not work to open the pty's tty here,
2249 then close it and reopen it in the child. */
2250 /* Don't let this terminal become our controlling terminal
2251 (in case we don't have one). */
2252 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2253 if (forkout < 0)
2254 report_file_error ("Opening pty", Qnil);
2255 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2256 #if defined (DONT_REOPEN_PTY)
2257 /* In the case that vfork is defined as fork, the parent process
2258 (Emacs) may send some data before the child process completes
2259 tty options setup. So we setup tty before forking. */
2260 child_setup_tty (forkout);
2261 #endif /* DONT_REOPEN_PTY */
2262 #endif /* not USG, or USG_SUBTTY_WORKS */
2264 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2266 /* Record this as an active process, with its channels.
2267 As a result, child_setup will close Emacs's side of the pipes. */
2268 chan_process[pty_fd] = process;
2269 p->infd = pty_fd;
2270 p->outfd = pty_fd;
2272 /* Previously we recorded the tty descriptor used in the subprocess.
2273 It was only used for getting the foreground tty process, so now
2274 we just reopen the device (see emacs_get_tty_pgrp) as this is
2275 more portable (see USG_SUBTTY_WORKS above). */
2277 p->pty_flag = 1;
2278 pset_status (p, Qrun);
2279 setup_process_coding_systems (process);
2281 add_process_read_fd (pty_fd);
2283 pset_tty_name (p, build_string (pty_name));
2286 p->pid = -2;
2289 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2290 0, MANY, 0,
2291 doc: /* Create and return a bidirectional pipe process.
2293 In Emacs, pipes are represented by process objects, so input and
2294 output work as for subprocesses, and `delete-process' closes a pipe.
2295 However, a pipe process has no process id, it cannot be signaled,
2296 and the status codes are different from normal processes.
2298 Arguments are specified as keyword/argument pairs. The following
2299 arguments are defined:
2301 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2303 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2304 with the process. Process output goes at the end of that buffer,
2305 unless you specify an output stream or filter function to handle the
2306 output. If BUFFER is not given, the value of NAME is used.
2308 :coding CODING -- If CODING is a symbol, it specifies the coding
2309 system used for both reading and writing for this process. If CODING
2310 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2311 ENCODING is used for writing.
2313 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2314 the process is running. If BOOL is not given, query before exiting.
2316 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2317 In the stopped state, a pipe process does not accept incoming data,
2318 but you can send outgoing data. The stopped state is cleared by
2319 `continue-process' and set by `stop-process'.
2321 :filter FILTER -- Install FILTER as the process filter.
2323 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2325 usage: (make-pipe-process &rest ARGS) */)
2326 (ptrdiff_t nargs, Lisp_Object *args)
2328 Lisp_Object proc, contact;
2329 struct Lisp_Process *p;
2330 Lisp_Object name, buffer;
2331 Lisp_Object tem;
2332 ptrdiff_t specpdl_count;
2333 int inchannel, outchannel;
2335 if (nargs == 0)
2336 return Qnil;
2338 contact = Flist (nargs, args);
2340 name = Fplist_get (contact, QCname);
2341 CHECK_STRING (name);
2342 proc = make_process (name);
2343 specpdl_count = SPECPDL_INDEX ();
2344 record_unwind_protect (remove_process, proc);
2345 p = XPROCESS (proc);
2347 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2348 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2349 report_file_error ("Creating pipe", Qnil);
2350 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2351 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2353 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2354 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2356 #ifdef WINDOWSNT
2357 register_aux_fd (inchannel);
2358 #endif
2360 /* Record this as an active process, with its channels. */
2361 chan_process[inchannel] = proc;
2362 p->infd = inchannel;
2363 p->outfd = outchannel;
2365 if (inchannel > max_desc)
2366 max_desc = inchannel;
2368 buffer = Fplist_get (contact, QCbuffer);
2369 if (NILP (buffer))
2370 buffer = name;
2371 buffer = Fget_buffer_create (buffer);
2372 pset_buffer (p, buffer);
2374 pset_childp (p, contact);
2375 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2376 pset_type (p, Qpipe);
2377 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2378 pset_filter (p, Fplist_get (contact, QCfilter));
2379 eassert (NILP (p->log));
2380 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2381 p->kill_without_query = 1;
2382 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2383 pset_command (p, Qt);
2384 eassert (! p->pty_flag);
2386 if (!EQ (p->command, Qt))
2387 add_process_read_fd (inchannel);
2388 p->adaptive_read_buffering
2389 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2390 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2392 /* Make the process marker point into the process buffer (if any). */
2393 if (BUFFERP (buffer))
2394 set_marker_both (p->mark, buffer,
2395 BUF_ZV (XBUFFER (buffer)),
2396 BUF_ZV_BYTE (XBUFFER (buffer)));
2399 /* Setup coding systems for communicating with the network stream. */
2401 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2402 Lisp_Object coding_systems = Qt;
2403 Lisp_Object val;
2405 tem = Fplist_get (contact, QCcoding);
2406 val = Qnil;
2407 if (!NILP (tem))
2409 val = tem;
2410 if (CONSP (val))
2411 val = XCAR (val);
2413 else if (!NILP (Vcoding_system_for_read))
2414 val = Vcoding_system_for_read;
2415 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2416 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2417 /* We dare not decode end-of-line format by setting VAL to
2418 Qraw_text, because the existing Emacs Lisp libraries
2419 assume that they receive bare code including a sequence of
2420 CR LF. */
2421 val = Qnil;
2422 else
2424 if (CONSP (coding_systems))
2425 val = XCAR (coding_systems);
2426 else if (CONSP (Vdefault_process_coding_system))
2427 val = XCAR (Vdefault_process_coding_system);
2428 else
2429 val = Qnil;
2431 pset_decode_coding_system (p, val);
2433 if (!NILP (tem))
2435 val = tem;
2436 if (CONSP (val))
2437 val = XCDR (val);
2439 else if (!NILP (Vcoding_system_for_write))
2440 val = Vcoding_system_for_write;
2441 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2442 val = Qnil;
2443 else
2445 if (CONSP (coding_systems))
2446 val = XCDR (coding_systems);
2447 else if (CONSP (Vdefault_process_coding_system))
2448 val = XCDR (Vdefault_process_coding_system);
2449 else
2450 val = Qnil;
2452 pset_encode_coding_system (p, val);
2454 /* This may signal an error. */
2455 setup_process_coding_systems (proc);
2457 specpdl_ptr = specpdl + specpdl_count;
2459 return proc;
2463 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2464 The address family of sa is not included in the result. */
2466 Lisp_Object
2467 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2469 Lisp_Object address;
2470 ptrdiff_t i;
2471 unsigned char *cp;
2472 struct Lisp_Vector *p;
2474 /* Workaround for a bug in getsockname on BSD: Names bound to
2475 sockets in the UNIX domain are inaccessible; getsockname returns
2476 a zero length name. */
2477 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2478 return empty_unibyte_string;
2480 switch (sa->sa_family)
2482 case AF_INET:
2484 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2485 len = sizeof (sin->sin_addr) + 1;
2486 address = Fmake_vector (make_number (len), Qnil);
2487 p = XVECTOR (address);
2488 p->contents[--len] = make_number (ntohs (sin->sin_port));
2489 cp = (unsigned char *) &sin->sin_addr;
2490 break;
2492 #ifdef AF_INET6
2493 case AF_INET6:
2495 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2496 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2497 len = sizeof (sin6->sin6_addr) / 2 + 1;
2498 address = Fmake_vector (make_number (len), Qnil);
2499 p = XVECTOR (address);
2500 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2501 for (i = 0; i < len; i++)
2502 p->contents[i] = make_number (ntohs (ip6[i]));
2503 return address;
2505 #endif
2506 #ifdef HAVE_LOCAL_SOCKETS
2507 case AF_LOCAL:
2509 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2510 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2511 /* If the first byte is NUL, the name is a Linux abstract
2512 socket name, and the name can contain embedded NULs. If
2513 it's not, we have a NUL-terminated string. Be careful not
2514 to walk past the end of the object looking for the name
2515 terminator, however. */
2516 if (name_length > 0 && sockun->sun_path[0] != '\0')
2518 const char *terminator
2519 = memchr (sockun->sun_path, '\0', name_length);
2521 if (terminator)
2522 name_length = terminator - (const char *) sockun->sun_path;
2525 return make_unibyte_string (sockun->sun_path, name_length);
2527 #endif
2528 default:
2529 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2530 address = Fcons (make_number (sa->sa_family),
2531 Fmake_vector (make_number (len), Qnil));
2532 p = XVECTOR (XCDR (address));
2533 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2534 break;
2537 i = 0;
2538 while (i < len)
2539 p->contents[i++] = make_number (*cp++);
2541 return address;
2544 /* Convert an internal struct addrinfo to a Lisp object. */
2546 static Lisp_Object
2547 conv_addrinfo_to_lisp (struct addrinfo *res)
2549 Lisp_Object protocol = make_number (res->ai_protocol);
2550 eassert (XINT (protocol) == res->ai_protocol);
2551 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2555 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2557 static ptrdiff_t
2558 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2560 struct Lisp_Vector *p;
2562 if (VECTORP (address))
2564 p = XVECTOR (address);
2565 if (p->header.size == 5)
2567 *familyp = AF_INET;
2568 return sizeof (struct sockaddr_in);
2570 #ifdef AF_INET6
2571 else if (p->header.size == 9)
2573 *familyp = AF_INET6;
2574 return sizeof (struct sockaddr_in6);
2576 #endif
2578 #ifdef HAVE_LOCAL_SOCKETS
2579 else if (STRINGP (address))
2581 *familyp = AF_LOCAL;
2582 return sizeof (struct sockaddr_un);
2584 #endif
2585 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2586 && VECTORP (XCDR (address)))
2588 struct sockaddr *sa;
2589 p = XVECTOR (XCDR (address));
2590 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2591 return 0;
2592 *familyp = XINT (XCAR (address));
2593 return p->header.size + sizeof (sa->sa_family);
2595 return 0;
2598 /* Convert an address object (vector or string) to an internal sockaddr.
2600 The address format has been basically validated by
2601 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2602 it could have come from user data. So if FAMILY is not valid,
2603 we return after zeroing *SA. */
2605 static void
2606 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2608 register struct Lisp_Vector *p;
2609 register unsigned char *cp = NULL;
2610 register int i;
2611 EMACS_INT hostport;
2613 memset (sa, 0, len);
2615 if (VECTORP (address))
2617 p = XVECTOR (address);
2618 if (family == AF_INET)
2620 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2621 len = sizeof (sin->sin_addr) + 1;
2622 hostport = XINT (p->contents[--len]);
2623 sin->sin_port = htons (hostport);
2624 cp = (unsigned char *)&sin->sin_addr;
2625 sa->sa_family = family;
2627 #ifdef AF_INET6
2628 else if (family == AF_INET6)
2630 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2631 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2632 len = sizeof (sin6->sin6_addr) / 2 + 1;
2633 hostport = XINT (p->contents[--len]);
2634 sin6->sin6_port = htons (hostport);
2635 for (i = 0; i < len; i++)
2636 if (INTEGERP (p->contents[i]))
2638 int j = XFASTINT (p->contents[i]) & 0xffff;
2639 ip6[i] = ntohs (j);
2641 sa->sa_family = family;
2642 return;
2644 #endif
2645 else
2646 return;
2648 else if (STRINGP (address))
2650 #ifdef HAVE_LOCAL_SOCKETS
2651 if (family == AF_LOCAL)
2653 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2654 cp = SDATA (address);
2655 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2656 sockun->sun_path[i] = *cp++;
2657 sa->sa_family = family;
2659 #endif
2660 return;
2662 else
2664 p = XVECTOR (XCDR (address));
2665 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2668 for (i = 0; i < len; i++)
2669 if (INTEGERP (p->contents[i]))
2670 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2673 #ifdef DATAGRAM_SOCKETS
2674 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2675 1, 1, 0,
2676 doc: /* Get the current datagram address associated with PROCESS.
2677 If PROCESS is a non-blocking network process that hasn't been fully
2678 set up yet, this function will block until socket setup has completed. */)
2679 (Lisp_Object process)
2681 int channel;
2683 CHECK_PROCESS (process);
2685 if (NETCONN_P (process))
2686 wait_for_socket_fds (process, "process-datagram-address");
2688 if (!DATAGRAM_CONN_P (process))
2689 return Qnil;
2691 channel = XPROCESS (process)->infd;
2692 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2693 datagram_address[channel].len);
2696 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2697 2, 2, 0,
2698 doc: /* Set the datagram address for PROCESS to ADDRESS.
2699 Return nil upon error setting address, ADDRESS otherwise.
2701 If PROCESS is a non-blocking network process that hasn't been fully
2702 set up yet, this function will block until socket setup has completed. */)
2703 (Lisp_Object process, Lisp_Object address)
2705 int channel;
2706 int family;
2707 ptrdiff_t len;
2709 CHECK_PROCESS (process);
2711 if (NETCONN_P (process))
2712 wait_for_socket_fds (process, "set-process-datagram-address");
2714 if (!DATAGRAM_CONN_P (process))
2715 return Qnil;
2717 channel = XPROCESS (process)->infd;
2719 len = get_lisp_to_sockaddr_size (address, &family);
2720 if (len == 0 || datagram_address[channel].len != len)
2721 return Qnil;
2722 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2723 return address;
2725 #endif
2728 static const struct socket_options {
2729 /* The name of this option. Should be lowercase version of option
2730 name without SO_ prefix. */
2731 const char *name;
2732 /* Option level SOL_... */
2733 int optlevel;
2734 /* Option number SO_... */
2735 int optnum;
2736 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2737 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2738 } socket_options[] =
2740 #ifdef SO_BINDTODEVICE
2741 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2742 #endif
2743 #ifdef SO_BROADCAST
2744 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2745 #endif
2746 #ifdef SO_DONTROUTE
2747 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2748 #endif
2749 #ifdef SO_KEEPALIVE
2750 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2751 #endif
2752 #ifdef SO_LINGER
2753 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2754 #endif
2755 #ifdef SO_OOBINLINE
2756 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2757 #endif
2758 #ifdef SO_PRIORITY
2759 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2760 #endif
2761 #ifdef SO_REUSEADDR
2762 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2763 #endif
2764 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2767 /* Set option OPT to value VAL on socket S.
2769 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2770 Signals an error if setting a known option fails.
2773 static int
2774 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2776 char *name;
2777 const struct socket_options *sopt;
2778 int ret = 0;
2780 CHECK_SYMBOL (opt);
2782 name = SSDATA (SYMBOL_NAME (opt));
2783 for (sopt = socket_options; sopt->name; sopt++)
2784 if (strcmp (name, sopt->name) == 0)
2785 break;
2787 switch (sopt->opttype)
2789 case SOPT_BOOL:
2791 int optval;
2792 optval = NILP (val) ? 0 : 1;
2793 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2794 &optval, sizeof (optval));
2795 break;
2798 case SOPT_INT:
2800 int optval;
2801 if (TYPE_RANGED_INTEGERP (int, val))
2802 optval = XINT (val);
2803 else
2804 error ("Bad option value for %s", name);
2805 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2806 &optval, sizeof (optval));
2807 break;
2810 #ifdef SO_BINDTODEVICE
2811 case SOPT_IFNAME:
2813 char devname[IFNAMSIZ + 1];
2815 /* This is broken, at least in the Linux 2.4 kernel.
2816 To unbind, the arg must be a zero integer, not the empty string.
2817 This should work on all systems. KFS. 2003-09-23. */
2818 memset (devname, 0, sizeof devname);
2819 if (STRINGP (val))
2821 char *arg = SSDATA (val);
2822 int len = min (strlen (arg), IFNAMSIZ);
2823 memcpy (devname, arg, len);
2825 else if (!NILP (val))
2826 error ("Bad option value for %s", name);
2827 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2828 devname, IFNAMSIZ);
2829 break;
2831 #endif
2833 #ifdef SO_LINGER
2834 case SOPT_LINGER:
2836 struct linger linger;
2838 linger.l_onoff = 1;
2839 linger.l_linger = 0;
2840 if (TYPE_RANGED_INTEGERP (int, val))
2841 linger.l_linger = XINT (val);
2842 else
2843 linger.l_onoff = NILP (val) ? 0 : 1;
2844 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2845 &linger, sizeof (linger));
2846 break;
2848 #endif
2850 default:
2851 return 0;
2854 if (ret < 0)
2856 int setsockopt_errno = errno;
2857 report_file_errno ("Cannot set network option", list2 (opt, val),
2858 setsockopt_errno);
2861 return (1 << sopt->optbit);
2865 DEFUN ("set-network-process-option",
2866 Fset_network_process_option, Sset_network_process_option,
2867 3, 4, 0,
2868 doc: /* For network process PROCESS set option OPTION to value VALUE.
2869 See `make-network-process' for a list of options and values.
2870 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2871 OPTION is not a supported option, return nil instead; otherwise return t.
2873 If PROCESS is a non-blocking network process that hasn't been fully
2874 set up yet, this function will block until socket setup has completed. */)
2875 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2877 int s;
2878 struct Lisp_Process *p;
2880 CHECK_PROCESS (process);
2881 p = XPROCESS (process);
2882 if (!NETCONN1_P (p))
2883 error ("Process is not a network process");
2885 wait_for_socket_fds (process, "set-network-process-option");
2887 s = p->infd;
2888 if (s < 0)
2889 error ("Process is not running");
2891 if (set_socket_option (s, option, value))
2893 pset_childp (p, Fplist_put (p->childp, option, value));
2894 return Qt;
2897 if (NILP (no_error))
2898 error ("Unknown or unsupported option");
2900 return Qnil;
2904 DEFUN ("serial-process-configure",
2905 Fserial_process_configure,
2906 Sserial_process_configure,
2907 0, MANY, 0,
2908 doc: /* Configure speed, bytesize, etc. of a serial process.
2910 Arguments are specified as keyword/argument pairs. Attributes that
2911 are not given are re-initialized from the process's current
2912 configuration (available via the function `process-contact') or set to
2913 reasonable default values. The following arguments are defined:
2915 :process PROCESS
2916 :name NAME
2917 :buffer BUFFER
2918 :port PORT
2919 -- Any of these arguments can be given to identify the process that is
2920 to be configured. If none of these arguments is given, the current
2921 buffer's process is used.
2923 :speed SPEED -- SPEED is the speed of the serial port in bits per
2924 second, also called baud rate. Any value can be given for SPEED, but
2925 most serial ports work only at a few defined values between 1200 and
2926 115200, with 9600 being the most common value. If SPEED is nil, the
2927 serial port is not configured any further, i.e., all other arguments
2928 are ignored. This may be useful for special serial ports such as
2929 Bluetooth-to-serial converters which can only be configured through AT
2930 commands. A value of nil for SPEED can be used only when passed
2931 through `make-serial-process' or `serial-term'.
2933 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2934 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2936 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2937 `odd' (use odd parity), or the symbol `even' (use even parity). If
2938 PARITY is not given, no parity is used.
2940 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2941 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2942 is not given or nil, 1 stopbit is used.
2944 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2945 flowcontrol to be used, which is either nil (don't use flowcontrol),
2946 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2947 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2948 flowcontrol is used.
2950 `serial-process-configure' is called by `make-serial-process' for the
2951 initial configuration of the serial port.
2953 Examples:
2955 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2957 \(serial-process-configure
2958 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2960 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2962 usage: (serial-process-configure &rest ARGS) */)
2963 (ptrdiff_t nargs, Lisp_Object *args)
2965 struct Lisp_Process *p;
2966 Lisp_Object contact = Qnil;
2967 Lisp_Object proc = Qnil;
2969 contact = Flist (nargs, args);
2971 proc = Fplist_get (contact, QCprocess);
2972 if (NILP (proc))
2973 proc = Fplist_get (contact, QCname);
2974 if (NILP (proc))
2975 proc = Fplist_get (contact, QCbuffer);
2976 if (NILP (proc))
2977 proc = Fplist_get (contact, QCport);
2978 proc = get_process (proc);
2979 p = XPROCESS (proc);
2980 if (!EQ (p->type, Qserial))
2981 error ("Not a serial process");
2983 if (NILP (Fplist_get (p->childp, QCspeed)))
2984 return Qnil;
2986 serial_configure (p, contact);
2987 return Qnil;
2990 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2991 0, MANY, 0,
2992 doc: /* Create and return a serial port process.
2994 In Emacs, serial port connections are represented by process objects,
2995 so input and output work as for subprocesses, and `delete-process'
2996 closes a serial port connection. However, a serial process has no
2997 process id, it cannot be signaled, and the status codes are different
2998 from normal processes.
3000 `make-serial-process' creates a process and a buffer, on which you
3001 probably want to use `process-send-string'. Try \\[serial-term] for
3002 an interactive terminal. See below for examples.
3004 Arguments are specified as keyword/argument pairs. The following
3005 arguments are defined:
3007 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3008 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3009 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3010 the backslashes in strings).
3012 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3013 which this function calls.
3015 :name NAME -- NAME is the name of the process. If NAME is not given,
3016 the value of PORT is used.
3018 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3019 with the process. Process output goes at the end of that buffer,
3020 unless you specify an output stream or filter function to handle the
3021 output. If BUFFER is not given, the value of NAME is used.
3023 :coding CODING -- If CODING is a symbol, it specifies the coding
3024 system used for both reading and writing for this process. If CODING
3025 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3026 ENCODING is used for writing.
3028 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3029 the process is running. If BOOL is not given, query before exiting.
3031 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3032 In the stopped state, a serial process does not accept incoming data,
3033 but you can send outgoing data. The stopped state is cleared by
3034 `continue-process' and set by `stop-process'.
3036 :filter FILTER -- Install FILTER as the process filter.
3038 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3040 :plist PLIST -- Install PLIST as the initial plist of the process.
3042 :bytesize
3043 :parity
3044 :stopbits
3045 :flowcontrol
3046 -- This function calls `serial-process-configure' to handle these
3047 arguments.
3049 The original argument list, possibly modified by later configuration,
3050 is available via the function `process-contact'.
3052 Examples:
3054 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3056 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3058 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3060 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3062 usage: (make-serial-process &rest ARGS) */)
3063 (ptrdiff_t nargs, Lisp_Object *args)
3065 int fd = -1;
3066 Lisp_Object proc, contact, port;
3067 struct Lisp_Process *p;
3068 Lisp_Object name, buffer;
3069 Lisp_Object tem, val;
3070 ptrdiff_t specpdl_count;
3072 if (nargs == 0)
3073 return Qnil;
3075 contact = Flist (nargs, args);
3077 port = Fplist_get (contact, QCport);
3078 if (NILP (port))
3079 error ("No port specified");
3080 CHECK_STRING (port);
3082 if (NILP (Fplist_member (contact, QCspeed)))
3083 error (":speed not specified");
3084 if (!NILP (Fplist_get (contact, QCspeed)))
3085 CHECK_NUMBER (Fplist_get (contact, QCspeed));
3087 name = Fplist_get (contact, QCname);
3088 if (NILP (name))
3089 name = port;
3090 CHECK_STRING (name);
3091 proc = make_process (name);
3092 specpdl_count = SPECPDL_INDEX ();
3093 record_unwind_protect (remove_process, proc);
3094 p = XPROCESS (proc);
3096 fd = serial_open (port);
3097 p->open_fd[SUBPROCESS_STDIN] = fd;
3098 p->infd = fd;
3099 p->outfd = fd;
3100 if (fd > max_desc)
3101 max_desc = fd;
3102 chan_process[fd] = proc;
3104 buffer = Fplist_get (contact, QCbuffer);
3105 if (NILP (buffer))
3106 buffer = name;
3107 buffer = Fget_buffer_create (buffer);
3108 pset_buffer (p, buffer);
3110 pset_childp (p, contact);
3111 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3112 pset_type (p, Qserial);
3113 pset_sentinel (p, Fplist_get (contact, QCsentinel));
3114 pset_filter (p, Fplist_get (contact, QCfilter));
3115 eassert (NILP (p->log));
3116 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3117 p->kill_without_query = 1;
3118 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
3119 pset_command (p, Qt);
3120 eassert (! p->pty_flag);
3122 if (!EQ (p->command, Qt))
3123 add_process_read_fd (fd);
3125 if (BUFFERP (buffer))
3127 set_marker_both (p->mark, buffer,
3128 BUF_ZV (XBUFFER (buffer)),
3129 BUF_ZV_BYTE (XBUFFER (buffer)));
3132 tem = Fplist_member (contact, QCcoding);
3133 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3134 tem = Qnil;
3136 val = Qnil;
3137 if (!NILP (tem))
3139 val = XCAR (XCDR (tem));
3140 if (CONSP (val))
3141 val = XCAR (val);
3143 else if (!NILP (Vcoding_system_for_read))
3144 val = Vcoding_system_for_read;
3145 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3146 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3147 val = Qnil;
3148 pset_decode_coding_system (p, val);
3150 val = Qnil;
3151 if (!NILP (tem))
3153 val = XCAR (XCDR (tem));
3154 if (CONSP (val))
3155 val = XCDR (val);
3157 else if (!NILP (Vcoding_system_for_write))
3158 val = Vcoding_system_for_write;
3159 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3160 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3161 val = Qnil;
3162 pset_encode_coding_system (p, val);
3164 setup_process_coding_systems (proc);
3165 pset_decoding_buf (p, empty_unibyte_string);
3166 eassert (p->decoding_carryover == 0);
3167 pset_encoding_buf (p, empty_unibyte_string);
3168 p->inherit_coding_system_flag
3169 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3171 Fserial_process_configure (nargs, args);
3173 specpdl_ptr = specpdl + specpdl_count;
3175 return proc;
3178 static void
3179 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3180 Lisp_Object service, Lisp_Object name)
3182 Lisp_Object tem;
3183 struct Lisp_Process *p = XPROCESS (proc);
3184 Lisp_Object contact = p->childp;
3185 Lisp_Object coding_systems = Qt;
3186 Lisp_Object val;
3188 tem = Fplist_member (contact, QCcoding);
3189 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3190 tem = Qnil; /* No error message (too late!). */
3192 /* Setup coding systems for communicating with the network stream. */
3193 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3195 if (!NILP (tem))
3197 val = XCAR (XCDR (tem));
3198 if (CONSP (val))
3199 val = XCAR (val);
3201 else if (!NILP (Vcoding_system_for_read))
3202 val = Vcoding_system_for_read;
3203 else if ((!NILP (p->buffer)
3204 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3205 || (NILP (p->buffer)
3206 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3207 /* We dare not decode end-of-line format by setting VAL to
3208 Qraw_text, because the existing Emacs Lisp libraries
3209 assume that they receive bare code including a sequence of
3210 CR LF. */
3211 val = Qnil;
3212 else
3214 if (NILP (host) || NILP (service))
3215 coding_systems = Qnil;
3216 else
3217 coding_systems = CALLN (Ffind_operation_coding_system,
3218 Qopen_network_stream, name, p->buffer,
3219 host, service);
3220 if (CONSP (coding_systems))
3221 val = XCAR (coding_systems);
3222 else if (CONSP (Vdefault_process_coding_system))
3223 val = XCAR (Vdefault_process_coding_system);
3224 else
3225 val = Qnil;
3227 pset_decode_coding_system (p, val);
3229 if (!NILP (tem))
3231 val = XCAR (XCDR (tem));
3232 if (CONSP (val))
3233 val = XCDR (val);
3235 else if (!NILP (Vcoding_system_for_write))
3236 val = Vcoding_system_for_write;
3237 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3238 val = Qnil;
3239 else
3241 if (EQ (coding_systems, Qt))
3243 if (NILP (host) || NILP (service))
3244 coding_systems = Qnil;
3245 else
3246 coding_systems = CALLN (Ffind_operation_coding_system,
3247 Qopen_network_stream, name, p->buffer,
3248 host, service);
3250 if (CONSP (coding_systems))
3251 val = XCDR (coding_systems);
3252 else if (CONSP (Vdefault_process_coding_system))
3253 val = XCDR (Vdefault_process_coding_system);
3254 else
3255 val = Qnil;
3257 pset_encode_coding_system (p, val);
3259 pset_decoding_buf (p, empty_unibyte_string);
3260 p->decoding_carryover = 0;
3261 pset_encoding_buf (p, empty_unibyte_string);
3263 p->inherit_coding_system_flag
3264 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3267 #ifdef HAVE_GNUTLS
3268 static void
3269 finish_after_tls_connection (Lisp_Object proc)
3271 struct Lisp_Process *p = XPROCESS (proc);
3272 Lisp_Object contact = p->childp;
3273 Lisp_Object result = Qt;
3275 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3276 result = call3 (Qnsm_verify_connection,
3277 proc,
3278 Fplist_get (contact, QChost),
3279 Fplist_get (contact, QCservice));
3281 if (NILP (result))
3283 pset_status (p, list2 (Qfailed,
3284 build_string ("The Network Security Manager stopped the connections")));
3285 deactivate_process (proc);
3287 else if (p->outfd < 0)
3289 /* The counterparty may have closed the connection (especially
3290 if the NSM prompt above take a long time), so recheck the file
3291 descriptor here. */
3292 pset_status (p, Qfailed);
3293 deactivate_process (proc);
3295 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3297 /* If we cleared the connection wait mask before we did the TLS
3298 setup, then we have to say that the process is finally "open"
3299 here. */
3300 pset_status (p, Qrun);
3301 /* Execute the sentinel here. If we had relied on status_notify
3302 to do it later, it will read input from the process before
3303 calling the sentinel. */
3304 exec_sentinel (proc, build_string ("open\n"));
3307 #endif
3309 static void
3310 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3311 Lisp_Object use_external_socket_p)
3313 ptrdiff_t count = SPECPDL_INDEX ();
3314 int s = -1, outch, inch;
3315 int xerrno = 0;
3316 int family;
3317 struct sockaddr *sa = NULL;
3318 int ret;
3319 ptrdiff_t addrlen;
3320 struct Lisp_Process *p = XPROCESS (proc);
3321 Lisp_Object contact = p->childp;
3322 int optbits = 0;
3323 int socket_to_use = -1;
3325 if (!NILP (use_external_socket_p))
3327 socket_to_use = external_sock_fd;
3329 /* Ensure we don't consume the external socket twice. */
3330 external_sock_fd = -1;
3333 /* Do this in case we never enter the while-loop below. */
3334 s = -1;
3336 while (!NILP (addrinfos))
3338 Lisp_Object addrinfo = XCAR (addrinfos);
3339 addrinfos = XCDR (addrinfos);
3340 int protocol = XINT (XCAR (addrinfo));
3341 Lisp_Object ip_address = XCDR (addrinfo);
3343 #ifdef WINDOWSNT
3344 retry_connect:
3345 #endif
3347 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3348 if (sa)
3349 free (sa);
3350 sa = xmalloc (addrlen);
3351 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3353 s = socket_to_use;
3354 if (s < 0)
3356 int socktype = p->socktype | SOCK_CLOEXEC;
3357 if (p->is_non_blocking_client)
3358 socktype |= SOCK_NONBLOCK;
3359 s = socket (family, socktype, protocol);
3360 if (s < 0)
3362 xerrno = errno;
3363 continue;
3367 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3369 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3370 if (ret < 0)
3372 xerrno = errno;
3373 emacs_close (s);
3374 s = -1;
3375 if (0 <= socket_to_use)
3376 break;
3377 continue;
3381 #ifdef DATAGRAM_SOCKETS
3382 if (!p->is_server && p->socktype == SOCK_DGRAM)
3383 break;
3384 #endif /* DATAGRAM_SOCKETS */
3386 /* Make us close S if quit. */
3387 record_unwind_protect_int (close_file_unwind, s);
3389 /* Parse network options in the arg list. We simply ignore anything
3390 which isn't a known option (including other keywords). An error
3391 is signaled if setting a known option fails. */
3393 Lisp_Object params = contact, key, val;
3395 while (!NILP (params))
3397 key = XCAR (params);
3398 params = XCDR (params);
3399 val = XCAR (params);
3400 params = XCDR (params);
3401 optbits |= set_socket_option (s, key, val);
3405 if (p->is_server)
3407 /* Configure as a server socket. */
3409 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3410 explicit :reuseaddr key to override this. */
3411 #ifdef HAVE_LOCAL_SOCKETS
3412 if (family != AF_LOCAL)
3413 #endif
3414 if (!(optbits & (1 << OPIX_REUSEADDR)))
3416 int optval = 1;
3417 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3418 report_file_error ("Cannot set reuse option on server socket", Qnil);
3421 /* If passed a socket descriptor, it should be already bound. */
3422 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3423 report_file_error ("Cannot bind server socket", Qnil);
3425 #ifdef HAVE_GETSOCKNAME
3426 if (p->port == 0
3427 #ifdef HAVE_LOCAL_SOCKETS
3428 && family != AF_LOCAL
3429 #endif
3432 struct sockaddr_in sa1;
3433 socklen_t len1 = sizeof (sa1);
3434 #ifdef AF_INET6
3435 /* The code below assumes the port is at the same offset
3436 and of the same width in both IPv4 and IPv6
3437 structures, but the standards don't guarantee that,
3438 so verify it here. */
3439 struct sockaddr_in6 sa6;
3440 verify ((offsetof (struct sockaddr_in, sin_port)
3441 == offsetof (struct sockaddr_in6, sin6_port))
3442 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3443 #endif
3444 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3445 if (getsockname (s, psa1, &len1) == 0)
3447 Lisp_Object service = make_number (ntohs (sa1.sin_port));
3448 contact = Fplist_put (contact, QCservice, service);
3449 /* Save the port number so that we can stash it in
3450 the process object later. */
3451 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3452 psa->sin_port = sa1.sin_port;
3455 #endif
3457 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3458 report_file_error ("Cannot listen on server socket", Qnil);
3460 break;
3463 maybe_quit ();
3465 ret = connect (s, sa, addrlen);
3466 xerrno = errno;
3468 if (ret == 0 || xerrno == EISCONN)
3470 /* The unwind-protect will be discarded afterwards. */
3471 break;
3474 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3475 break;
3477 #ifndef WINDOWSNT
3478 if (xerrno == EINTR)
3480 /* Unlike most other syscalls connect() cannot be called
3481 again. (That would return EALREADY.) The proper way to
3482 wait for completion is pselect(). */
3483 int sc;
3484 socklen_t len;
3485 fd_set fdset;
3486 retry_select:
3487 FD_ZERO (&fdset);
3488 FD_SET (s, &fdset);
3489 maybe_quit ();
3490 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3491 if (sc == -1)
3493 if (errno == EINTR)
3494 goto retry_select;
3495 else
3496 report_file_error ("Failed select", Qnil);
3498 eassert (sc > 0);
3500 len = sizeof xerrno;
3501 eassert (FD_ISSET (s, &fdset));
3502 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3503 report_file_error ("Failed getsockopt", Qnil);
3504 if (xerrno == 0)
3505 break;
3506 if (NILP (addrinfos))
3507 report_file_errno ("Failed connect", Qnil, xerrno);
3509 #endif /* !WINDOWSNT */
3511 /* Discard the unwind protect closing S. */
3512 specpdl_ptr = specpdl + count;
3513 emacs_close (s);
3514 s = -1;
3515 if (0 <= socket_to_use)
3516 break;
3518 #ifdef WINDOWSNT
3519 if (xerrno == EINTR)
3520 goto retry_connect;
3521 #endif
3524 if (s >= 0)
3526 #ifdef DATAGRAM_SOCKETS
3527 if (p->socktype == SOCK_DGRAM)
3529 if (datagram_address[s].sa)
3530 emacs_abort ();
3532 datagram_address[s].sa = xmalloc (addrlen);
3533 datagram_address[s].len = addrlen;
3534 if (p->is_server)
3536 Lisp_Object remote;
3537 memset (datagram_address[s].sa, 0, addrlen);
3538 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3540 int rfamily;
3541 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3542 if (rlen != 0 && rfamily == family
3543 && rlen == addrlen)
3544 conv_lisp_to_sockaddr (rfamily, remote,
3545 datagram_address[s].sa, rlen);
3548 else
3549 memcpy (datagram_address[s].sa, sa, addrlen);
3551 #endif
3553 contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
3554 conv_sockaddr_to_lisp (sa, addrlen));
3555 #ifdef HAVE_GETSOCKNAME
3556 if (!p->is_server)
3558 struct sockaddr_storage sa1;
3559 socklen_t len1 = sizeof (sa1);
3560 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3561 if (getsockname (s, psa1, &len1) == 0)
3562 contact = Fplist_put (contact, QClocal,
3563 conv_sockaddr_to_lisp (psa1, len1));
3565 #endif
3568 if (s < 0)
3570 /* If non-blocking got this far - and failed - assume non-blocking is
3571 not supported after all. This is probably a wrong assumption, but
3572 the normal blocking calls to open-network-stream handles this error
3573 better. */
3574 if (p->is_non_blocking_client)
3575 return;
3577 report_file_errno ((p->is_server
3578 ? "make server process failed"
3579 : "make client process failed"),
3580 contact, xerrno);
3583 inch = s;
3584 outch = s;
3586 chan_process[inch] = proc;
3588 fcntl (inch, F_SETFL, O_NONBLOCK);
3590 p = XPROCESS (proc);
3591 p->open_fd[SUBPROCESS_STDIN] = inch;
3592 p->infd = inch;
3593 p->outfd = outch;
3595 /* Discard the unwind protect for closing S, if any. */
3596 specpdl_ptr = specpdl + count;
3598 if (p->is_server && p->socktype != SOCK_DGRAM)
3599 pset_status (p, Qlisten);
3601 /* Make the process marker point into the process buffer (if any). */
3602 if (BUFFERP (p->buffer))
3603 set_marker_both (p->mark, p->buffer,
3604 BUF_ZV (XBUFFER (p->buffer)),
3605 BUF_ZV_BYTE (XBUFFER (p->buffer)));
3607 if (p->is_non_blocking_client)
3609 /* We may get here if connect did succeed immediately. However,
3610 in that case, we still need to signal this like a non-blocking
3611 connection. */
3612 if (! (connecting_status (p->status)
3613 && EQ (XCDR (p->status), addrinfos)))
3614 pset_status (p, Fcons (Qconnect, addrinfos));
3615 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3616 add_non_blocking_write_fd (inch);
3618 else
3619 /* A server may have a client filter setting of Qt, but it must
3620 still listen for incoming connects unless it is stopped. */
3621 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3622 || (EQ (p->status, Qlisten) && NILP (p->command)))
3623 add_process_read_fd (inch);
3625 if (inch > max_desc)
3626 max_desc = inch;
3628 /* Set up the masks based on the process filter. */
3629 set_process_filter_masks (p);
3631 setup_process_coding_systems (proc);
3633 #ifdef HAVE_GNUTLS
3634 /* Continue the asynchronous connection. */
3635 if (!NILP (p->gnutls_boot_parameters))
3637 Lisp_Object boot, params = p->gnutls_boot_parameters;
3639 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3640 p->gnutls_boot_parameters = Qnil;
3642 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3643 /* Run sentinels, etc. */
3644 finish_after_tls_connection (proc);
3645 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3647 deactivate_process (proc);
3648 if (NILP (boot))
3649 pset_status (p, list2 (Qfailed,
3650 build_string ("TLS negotiation failed")));
3651 else
3652 pset_status (p, list2 (Qfailed, boot));
3655 #endif
3659 /* Create a network stream/datagram client/server process. Treated
3660 exactly like a normal process when reading and writing. Primary
3661 differences are in status display and process deletion. A network
3662 connection has no PID; you cannot signal it. All you can do is
3663 stop/continue it and deactivate/close it via delete-process. */
3665 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3666 0, MANY, 0,
3667 doc: /* Create and return a network server or client process.
3669 In Emacs, network connections are represented by process objects, so
3670 input and output work as for subprocesses and `delete-process' closes
3671 a network connection. However, a network process has no process id,
3672 it cannot be signaled, and the status codes are different from normal
3673 processes.
3675 Arguments are specified as keyword/argument pairs. The following
3676 arguments are defined:
3678 :name NAME -- NAME is name for process. It is modified if necessary
3679 to make it unique.
3681 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3682 with the process. Process output goes at end of that buffer, unless
3683 you specify an output stream or filter function to handle the output.
3684 BUFFER may be also nil, meaning that this process is not associated
3685 with any buffer.
3687 :host HOST -- HOST is name of the host to connect to, or its IP
3688 address. The symbol `local' specifies the local host. If specified
3689 for a server process, it must be a valid name or address for the local
3690 host, and only clients connecting to that address will be accepted.
3692 :service SERVICE -- SERVICE is name of the service desired, or an
3693 integer specifying a port number to connect to. If SERVICE is t,
3694 a random port number is selected for the server. A port number can
3695 be specified as an integer string, e.g., "80", as well as an integer.
3697 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3698 stream type connection, `datagram' creates a datagram type connection,
3699 `seqpacket' creates a reliable datagram connection.
3701 :family FAMILY -- FAMILY is the address (and protocol) family for the
3702 service specified by HOST and SERVICE. The default (nil) is to use
3703 whatever address family (IPv4 or IPv6) that is defined for the host
3704 and port number specified by HOST and SERVICE. Other address families
3705 supported are:
3706 local -- for a local (i.e. UNIX) address specified by SERVICE.
3707 ipv4 -- use IPv4 address family only.
3708 ipv6 -- use IPv6 address family only.
3710 :local ADDRESS -- ADDRESS is the local address used for the connection.
3711 This parameter is ignored when opening a client process. When specified
3712 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3714 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3715 connection. This parameter is ignored when opening a stream server
3716 process. For a datagram server process, it specifies the initial
3717 setting of the remote datagram address. When specified for a client
3718 process, the FAMILY, HOST, and SERVICE args are ignored.
3720 The format of ADDRESS depends on the address family:
3721 - An IPv4 address is represented as an vector of integers [A B C D P]
3722 corresponding to numeric IP address A.B.C.D and port number P.
3723 - A local address is represented as a string with the address in the
3724 local address space.
3725 - An "unsupported family" address is represented by a cons (F . AV)
3726 where F is the family number and AV is a vector containing the socket
3727 address data with one element per address data byte. Do not rely on
3728 this format in portable code, as it may depend on implementation
3729 defined constants, data sizes, and data structure alignment.
3731 :coding CODING -- If CODING is a symbol, it specifies the coding
3732 system used for both reading and writing for this process. If CODING
3733 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3734 ENCODING is used for writing.
3736 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3737 process, return without waiting for the connection to complete;
3738 instead, the sentinel function will be called with second arg matching
3739 "open" (if successful) or "failed" when the connect completes.
3740 Default is to use a blocking connect (i.e. wait) for stream type
3741 connections.
3743 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3744 running when Emacs is exited.
3746 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3747 In the stopped state, a server process does not accept new
3748 connections, and a client process does not handle incoming traffic.
3749 The stopped state is cleared by `continue-process' and set by
3750 `stop-process'.
3752 :filter FILTER -- Install FILTER as the process filter.
3754 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3755 process filter are multibyte, otherwise they are unibyte.
3756 If this keyword is not specified, the strings are multibyte if
3757 the default value of `enable-multibyte-characters' is non-nil.
3759 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3761 :log LOG -- Install LOG as the server process log function. This
3762 function is called when the server accepts a network connection from a
3763 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3764 is the server process, CLIENT is the new process for the connection,
3765 and MESSAGE is a string.
3767 :plist PLIST -- Install PLIST as the new process's initial plist.
3769 :tls-parameters LIST -- is a list that should be supplied if you're
3770 opening a TLS connection. The first element is the TLS type (either
3771 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3772 be a keyword list accepted by gnutls-boot (as returned by
3773 `gnutls-boot-parameters').
3775 :server QLEN -- if QLEN is non-nil, create a server process for the
3776 specified FAMILY, SERVICE, and connection type (stream or datagram).
3777 If QLEN is an integer, it is used as the max. length of the server's
3778 pending connection queue (also known as the backlog); the default
3779 queue length is 5. Default is to create a client process.
3781 The following network options can be specified for this connection:
3783 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3784 :dontroute BOOL -- Only send to directly connected hosts.
3785 :keepalive BOOL -- Send keep-alive messages on network stream.
3786 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3787 :oobinline BOOL -- Place out-of-band data in receive data stream.
3788 :priority INT -- Set protocol defined priority for sent packets.
3789 :reuseaddr BOOL -- Allow reusing a recently used local address
3790 (this is allowed by default for a server process).
3791 :bindtodevice NAME -- bind to interface NAME. Using this may require
3792 special privileges on some systems.
3793 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3794 been passed to Emacs. If Emacs wasn't
3795 passed a socket, this option is silently
3796 ignored.
3799 Consult the relevant system programmer's manual pages for more
3800 information on using these options.
3803 A server process will listen for and accept connections from clients.
3804 When a client connection is accepted, a new network process is created
3805 for the connection with the following parameters:
3807 - The client's process name is constructed by concatenating the server
3808 process's NAME and a client identification string.
3809 - If the FILTER argument is non-nil, the client process will not get a
3810 separate process buffer; otherwise, the client's process buffer is a newly
3811 created buffer named after the server process's BUFFER name or process
3812 NAME concatenated with the client identification string.
3813 - The connection type and the process filter and sentinel parameters are
3814 inherited from the server process's TYPE, FILTER and SENTINEL.
3815 - The client process's contact info is set according to the client's
3816 addressing information (typically an IP address and a port number).
3817 - The client process's plist is initialized from the server's plist.
3819 Notice that the FILTER and SENTINEL args are never used directly by
3820 the server process. Also, the BUFFER argument is not used directly by
3821 the server process, but via the optional :log function, accepted (and
3822 failed) connections may be logged in the server process's buffer.
3824 The original argument list, modified with the actual connection
3825 information, is available via the `process-contact' function.
3827 usage: (make-network-process &rest ARGS) */)
3828 (ptrdiff_t nargs, Lisp_Object *args)
3830 Lisp_Object proc;
3831 Lisp_Object contact;
3832 struct Lisp_Process *p;
3833 const char *portstring;
3834 ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
3835 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3836 #ifdef HAVE_LOCAL_SOCKETS
3837 struct sockaddr_un address_un;
3838 #endif
3839 EMACS_INT port = 0;
3840 Lisp_Object tem;
3841 Lisp_Object name, buffer, host, service, address;
3842 Lisp_Object filter, sentinel, use_external_socket_p;
3843 Lisp_Object addrinfos = Qnil;
3844 int socktype;
3845 int family = -1;
3846 enum { any_protocol = 0 };
3847 #ifdef HAVE_GETADDRINFO_A
3848 struct gaicb *dns_request = NULL;
3849 #endif
3850 ptrdiff_t count = SPECPDL_INDEX ();
3852 if (nargs == 0)
3853 return Qnil;
3855 /* Save arguments for process-contact and clone-process. */
3856 contact = Flist (nargs, args);
3858 #ifdef WINDOWSNT
3859 /* Ensure socket support is loaded if available. */
3860 init_winsock (TRUE);
3861 #endif
3863 /* :type TYPE (nil: stream, datagram */
3864 tem = Fplist_get (contact, QCtype);
3865 if (NILP (tem))
3866 socktype = SOCK_STREAM;
3867 #ifdef DATAGRAM_SOCKETS
3868 else if (EQ (tem, Qdatagram))
3869 socktype = SOCK_DGRAM;
3870 #endif
3871 #ifdef HAVE_SEQPACKET
3872 else if (EQ (tem, Qseqpacket))
3873 socktype = SOCK_SEQPACKET;
3874 #endif
3875 else
3876 error ("Unsupported connection type");
3878 name = Fplist_get (contact, QCname);
3879 buffer = Fplist_get (contact, QCbuffer);
3880 filter = Fplist_get (contact, QCfilter);
3881 sentinel = Fplist_get (contact, QCsentinel);
3882 use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
3884 CHECK_STRING (name);
3886 /* :local ADDRESS or :remote ADDRESS */
3887 tem = Fplist_get (contact, QCserver);
3888 if (NILP (tem))
3889 address = Fplist_get (contact, QCremote);
3890 else
3891 address = Fplist_get (contact, QClocal);
3892 if (!NILP (address))
3894 host = service = Qnil;
3896 if (!get_lisp_to_sockaddr_size (address, &family))
3897 error ("Malformed :address");
3899 addrinfos = list1 (Fcons (make_number (any_protocol), address));
3900 goto open_socket;
3903 /* :family FAMILY -- nil (for Inet), local, or integer. */
3904 tem = Fplist_get (contact, QCfamily);
3905 if (NILP (tem))
3907 #ifdef AF_INET6
3908 family = AF_UNSPEC;
3909 #else
3910 family = AF_INET;
3911 #endif
3913 #ifdef HAVE_LOCAL_SOCKETS
3914 else if (EQ (tem, Qlocal))
3915 family = AF_LOCAL;
3916 #endif
3917 #ifdef AF_INET6
3918 else if (EQ (tem, Qipv6))
3919 family = AF_INET6;
3920 #endif
3921 else if (EQ (tem, Qipv4))
3922 family = AF_INET;
3923 else if (TYPE_RANGED_INTEGERP (int, tem))
3924 family = XINT (tem);
3925 else
3926 error ("Unknown address family");
3928 /* :service SERVICE -- string, integer (port number), or t (random port). */
3929 service = Fplist_get (contact, QCservice);
3931 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3932 host = Fplist_get (contact, QChost);
3933 if (NILP (host))
3935 /* The "connection" function gets it bind info from the address we're
3936 given, so use this dummy address if nothing is specified. */
3937 #ifdef HAVE_LOCAL_SOCKETS
3938 if (family != AF_LOCAL)
3939 #endif
3940 host = build_string ("127.0.0.1");
3942 else
3944 if (EQ (host, Qlocal))
3945 /* Depending on setup, "localhost" may map to different IPv4 and/or
3946 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3947 host = build_string ("127.0.0.1");
3948 CHECK_STRING (host);
3951 #ifdef HAVE_LOCAL_SOCKETS
3952 if (family == AF_LOCAL)
3954 if (!NILP (host))
3956 message (":family local ignores the :host property");
3957 contact = Fplist_put (contact, QChost, Qnil);
3958 host = Qnil;
3960 CHECK_STRING (service);
3961 if (sizeof address_un.sun_path <= SBYTES (service))
3962 error ("Service name too long");
3963 addrinfos = list1 (Fcons (make_number (any_protocol), service));
3964 goto open_socket;
3966 #endif
3968 /* Slow down polling to every ten seconds.
3969 Some kernels have a bug which causes retrying connect to fail
3970 after a connect. Polling can interfere with gethostbyname too. */
3971 #ifdef POLL_FOR_INPUT
3972 if (socktype != SOCK_DGRAM)
3974 record_unwind_protect_void (run_all_atimers);
3975 bind_polling_period (10);
3977 #endif
3979 if (!NILP (host))
3981 /* SERVICE can either be a string or int.
3982 Convert to a C string for later use by getaddrinfo. */
3983 if (EQ (service, Qt))
3985 portstring = "0";
3986 portstringlen = 1;
3988 else if (INTEGERP (service))
3990 portstring = portbuf;
3991 portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
3993 else
3995 CHECK_STRING (service);
3996 portstring = SSDATA (service);
3997 portstringlen = SBYTES (service);
4001 #ifdef HAVE_GETADDRINFO_A
4002 if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
4004 ptrdiff_t hostlen = SBYTES (host);
4005 struct req
4007 struct gaicb gaicb;
4008 struct addrinfo hints;
4009 char str[FLEXIBLE_ARRAY_MEMBER];
4010 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4011 hostlen + 1 + portstringlen + 1));
4012 dns_request = &req->gaicb;
4013 dns_request->ar_name = req->str;
4014 dns_request->ar_service = req->str + hostlen + 1;
4015 dns_request->ar_request = &req->hints;
4016 dns_request->ar_result = NULL;
4017 memset (&req->hints, 0, sizeof req->hints);
4018 req->hints.ai_family = family;
4019 req->hints.ai_socktype = socktype;
4020 strcpy (req->str, SSDATA (host));
4021 strcpy (req->str + hostlen + 1, portstring);
4023 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4024 if (ret)
4025 error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
4027 goto open_socket;
4029 #endif /* HAVE_GETADDRINFO_A */
4031 /* If we have a host, use getaddrinfo to resolve both host and service.
4032 Otherwise, use getservbyname to lookup the service. */
4034 if (!NILP (host))
4036 struct addrinfo *res, *lres;
4037 int ret;
4039 maybe_quit ();
4041 struct addrinfo hints;
4042 memset (&hints, 0, sizeof hints);
4043 hints.ai_family = family;
4044 hints.ai_socktype = socktype;
4046 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
4047 if (ret)
4048 #ifdef HAVE_GAI_STRERROR
4050 synchronize_system_messages_locale ();
4051 char const *str = gai_strerror (ret);
4052 if (! NILP (Vlocale_coding_system))
4053 str = SSDATA (code_convert_string_norecord
4054 (build_string (str), Vlocale_coding_system, 0));
4055 error ("%s/%s %s", SSDATA (host), portstring, str);
4057 #else
4058 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4059 #endif
4061 for (lres = res; lres; lres = lres->ai_next)
4062 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4064 addrinfos = Fnreverse (addrinfos);
4066 freeaddrinfo (res);
4068 goto open_socket;
4071 /* No hostname has been specified (e.g., a local server process). */
4073 if (EQ (service, Qt))
4074 port = 0;
4075 else if (INTEGERP (service))
4076 port = XINT (service);
4077 else
4079 CHECK_STRING (service);
4081 port = -1;
4082 if (SBYTES (service) != 0)
4084 /* Allow the service to be a string containing the port number,
4085 because that's allowed if you have getaddrbyname. */
4086 char *service_end;
4087 long int lport = strtol (SSDATA (service), &service_end, 10);
4088 if (service_end == SSDATA (service) + SBYTES (service))
4089 port = lport;
4090 else
4092 struct servent *svc_info
4093 = getservbyname (SSDATA (service),
4094 socktype == SOCK_DGRAM ? "udp" : "tcp");
4095 if (svc_info)
4096 port = ntohs (svc_info->s_port);
4101 if (! (0 <= port && port < 1 << 16))
4103 AUTO_STRING (unknown_service, "Unknown service: %s");
4104 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4107 open_socket:
4109 if (!NILP (buffer))
4110 buffer = Fget_buffer_create (buffer);
4112 /* Unwind bind_polling_period. */
4113 unbind_to (count, Qnil);
4115 proc = make_process (name);
4116 record_unwind_protect (remove_process, proc);
4117 p = XPROCESS (proc);
4118 pset_childp (p, contact);
4119 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
4120 pset_type (p, Qnetwork);
4122 pset_buffer (p, buffer);
4123 pset_sentinel (p, sentinel);
4124 pset_filter (p, filter);
4125 pset_log (p, Fplist_get (contact, QClog));
4126 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
4127 p->kill_without_query = 1;
4128 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
4129 pset_command (p, Qt);
4130 eassert (p->pid == 0);
4131 p->backlog = 5;
4132 eassert (! p->is_non_blocking_client);
4133 eassert (! p->is_server);
4134 p->port = port;
4135 p->socktype = socktype;
4136 #ifdef HAVE_GETADDRINFO_A
4137 eassert (! p->dns_request);
4138 #endif
4139 #ifdef HAVE_GNUTLS
4140 tem = Fplist_get (contact, QCtls_parameters);
4141 CHECK_LIST (tem);
4142 p->gnutls_boot_parameters = tem;
4143 #endif
4145 set_network_socket_coding_system (proc, host, service, name);
4147 /* :server BOOL */
4148 tem = Fplist_get (contact, QCserver);
4149 if (!NILP (tem))
4151 /* Don't support network sockets when non-blocking mode is
4152 not available, since a blocked Emacs is not useful. */
4153 p->is_server = true;
4154 if (TYPE_RANGED_INTEGERP (int, tem))
4155 p->backlog = XINT (tem);
4158 /* :nowait BOOL */
4159 if (!p->is_server && socktype != SOCK_DGRAM
4160 && !NILP (Fplist_get (contact, QCnowait)))
4161 p->is_non_blocking_client = true;
4163 bool postpone_connection = false;
4164 #ifdef HAVE_GETADDRINFO_A
4165 /* With async address resolution, the list of addresses is empty, so
4166 postpone connecting to the server. */
4167 if (!p->is_server && NILP (addrinfos))
4169 p->dns_request = dns_request;
4170 p->status = list1 (Qconnect);
4171 postpone_connection = true;
4173 #endif
4174 if (! postpone_connection)
4175 connect_network_socket (proc, addrinfos, use_external_socket_p);
4177 specpdl_ptr = specpdl + count;
4178 return proc;
4182 #ifdef HAVE_NET_IF_H
4184 #ifdef SIOCGIFCONF
4185 static Lisp_Object
4186 network_interface_list (void)
4188 struct ifconf ifconf;
4189 struct ifreq *ifreq;
4190 void *buf = NULL;
4191 ptrdiff_t buf_size = 512;
4192 int s;
4193 Lisp_Object res;
4194 ptrdiff_t count;
4196 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4197 if (s < 0)
4198 return Qnil;
4199 count = SPECPDL_INDEX ();
4200 record_unwind_protect_int (close_file_unwind, s);
4204 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
4205 ifconf.ifc_buf = buf;
4206 ifconf.ifc_len = buf_size;
4207 if (ioctl (s, SIOCGIFCONF, &ifconf))
4209 emacs_close (s);
4210 xfree (buf);
4211 return Qnil;
4214 while (ifconf.ifc_len == buf_size);
4216 res = unbind_to (count, Qnil);
4217 ifreq = ifconf.ifc_req;
4218 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
4220 struct ifreq *ifq = ifreq;
4221 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4222 #define SIZEOF_IFREQ(sif) \
4223 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4224 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4226 int len = SIZEOF_IFREQ (ifq);
4227 #else
4228 int len = sizeof (*ifreq);
4229 #endif
4230 char namebuf[sizeof (ifq->ifr_name) + 1];
4231 ifreq = (struct ifreq *) ((char *) ifreq + len);
4233 if (ifq->ifr_addr.sa_family != AF_INET)
4234 continue;
4236 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
4237 namebuf[sizeof (ifq->ifr_name)] = 0;
4238 res = Fcons (Fcons (build_string (namebuf),
4239 conv_sockaddr_to_lisp (&ifq->ifr_addr,
4240 sizeof (struct sockaddr))),
4241 res);
4244 xfree (buf);
4245 return res;
4247 #endif /* SIOCGIFCONF */
4249 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4251 struct ifflag_def {
4252 int flag_bit;
4253 const char *flag_sym;
4256 static const struct ifflag_def ifflag_table[] = {
4257 #ifdef IFF_UP
4258 { IFF_UP, "up" },
4259 #endif
4260 #ifdef IFF_BROADCAST
4261 { IFF_BROADCAST, "broadcast" },
4262 #endif
4263 #ifdef IFF_DEBUG
4264 { IFF_DEBUG, "debug" },
4265 #endif
4266 #ifdef IFF_LOOPBACK
4267 { IFF_LOOPBACK, "loopback" },
4268 #endif
4269 #ifdef IFF_POINTOPOINT
4270 { IFF_POINTOPOINT, "pointopoint" },
4271 #endif
4272 #ifdef IFF_RUNNING
4273 { IFF_RUNNING, "running" },
4274 #endif
4275 #ifdef IFF_NOARP
4276 { IFF_NOARP, "noarp" },
4277 #endif
4278 #ifdef IFF_PROMISC
4279 { IFF_PROMISC, "promisc" },
4280 #endif
4281 #ifdef IFF_NOTRAILERS
4282 #ifdef NS_IMPL_COCOA
4283 /* Really means smart, notrailers is obsolete. */
4284 { IFF_NOTRAILERS, "smart" },
4285 #else
4286 { IFF_NOTRAILERS, "notrailers" },
4287 #endif
4288 #endif
4289 #ifdef IFF_ALLMULTI
4290 { IFF_ALLMULTI, "allmulti" },
4291 #endif
4292 #ifdef IFF_MASTER
4293 { IFF_MASTER, "master" },
4294 #endif
4295 #ifdef IFF_SLAVE
4296 { IFF_SLAVE, "slave" },
4297 #endif
4298 #ifdef IFF_MULTICAST
4299 { IFF_MULTICAST, "multicast" },
4300 #endif
4301 #ifdef IFF_PORTSEL
4302 { IFF_PORTSEL, "portsel" },
4303 #endif
4304 #ifdef IFF_AUTOMEDIA
4305 { IFF_AUTOMEDIA, "automedia" },
4306 #endif
4307 #ifdef IFF_DYNAMIC
4308 { IFF_DYNAMIC, "dynamic" },
4309 #endif
4310 #ifdef IFF_OACTIVE
4311 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress. */
4312 #endif
4313 #ifdef IFF_SIMPLEX
4314 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4315 #endif
4316 #ifdef IFF_LINK0
4317 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit. */
4318 #endif
4319 #ifdef IFF_LINK1
4320 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit. */
4321 #endif
4322 #ifdef IFF_LINK2
4323 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit. */
4324 #endif
4325 { 0, 0 }
4328 static Lisp_Object
4329 network_interface_info (Lisp_Object ifname)
4331 struct ifreq rq;
4332 Lisp_Object res = Qnil;
4333 Lisp_Object elt;
4334 int s;
4335 bool any = 0;
4336 ptrdiff_t count;
4337 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4338 && defined HAVE_GETIFADDRS && defined LLADDR)
4339 struct ifaddrs *ifap;
4340 #endif
4342 CHECK_STRING (ifname);
4344 if (sizeof rq.ifr_name <= SBYTES (ifname))
4345 error ("interface name too long");
4346 lispstpcpy (rq.ifr_name, ifname);
4348 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4349 if (s < 0)
4350 return Qnil;
4351 count = SPECPDL_INDEX ();
4352 record_unwind_protect_int (close_file_unwind, s);
4354 elt = Qnil;
4355 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4356 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4358 int flags = rq.ifr_flags;
4359 const struct ifflag_def *fp;
4360 int fnum;
4362 /* If flags is smaller than int (i.e. short) it may have the high bit set
4363 due to IFF_MULTICAST. In that case, sign extending it into
4364 an int is wrong. */
4365 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4366 flags = (unsigned short) rq.ifr_flags;
4368 any = 1;
4369 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4371 if (flags & fp->flag_bit)
4373 elt = Fcons (intern (fp->flag_sym), elt);
4374 flags -= fp->flag_bit;
4377 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4379 if (flags & 1)
4381 elt = Fcons (make_number (fnum), elt);
4385 #endif
4386 res = Fcons (elt, res);
4388 elt = Qnil;
4389 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4390 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4392 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4393 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4394 int n;
4396 any = 1;
4397 for (n = 0; n < 6; n++)
4398 p->contents[n] = make_number (((unsigned char *)
4399 &rq.ifr_hwaddr.sa_data[0])
4400 [n]);
4401 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4403 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4404 if (getifaddrs (&ifap) != -1)
4406 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4407 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4408 struct ifaddrs *it;
4410 for (it = ifap; it != NULL; it = it->ifa_next)
4412 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4413 unsigned char linkaddr[6];
4414 int n;
4416 if (it->ifa_addr->sa_family != AF_LINK
4417 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4418 || sdl->sdl_alen != 6)
4419 continue;
4421 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4422 for (n = 0; n < 6; n++)
4423 p->contents[n] = make_number (linkaddr[n]);
4425 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
4426 break;
4429 #ifdef HAVE_FREEIFADDRS
4430 freeifaddrs (ifap);
4431 #endif
4433 #endif /* HAVE_GETIFADDRS && LLADDR */
4435 res = Fcons (elt, res);
4437 elt = Qnil;
4438 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4439 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4441 any = 1;
4442 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4443 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4444 #else
4445 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4446 #endif
4448 #endif
4449 res = Fcons (elt, res);
4451 elt = Qnil;
4452 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4453 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4455 any = 1;
4456 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4458 #endif
4459 res = Fcons (elt, res);
4461 elt = Qnil;
4462 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4463 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4465 any = 1;
4466 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4468 #endif
4469 res = Fcons (elt, res);
4471 return unbind_to (count, any ? res : Qnil);
4473 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4474 #endif /* defined (HAVE_NET_IF_H) */
4476 DEFUN ("network-interface-list", Fnetwork_interface_list,
4477 Snetwork_interface_list, 0, 0, 0,
4478 doc: /* Return an alist of all network interfaces and their network address.
4479 Each element is a cons, the car of which is a string containing the
4480 interface name, and the cdr is the network address in internal
4481 format; see the description of ADDRESS in `make-network-process'.
4483 If the information is not available, return nil. */)
4484 (void)
4486 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4487 return network_interface_list ();
4488 #else
4489 return Qnil;
4490 #endif
4493 DEFUN ("network-interface-info", Fnetwork_interface_info,
4494 Snetwork_interface_info, 1, 1, 0,
4495 doc: /* Return information about network interface named IFNAME.
4496 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4497 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4498 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4499 FLAGS is the current flags of the interface.
4501 Data that is unavailable is returned as nil. */)
4502 (Lisp_Object ifname)
4504 #if ((defined HAVE_NET_IF_H \
4505 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4506 || defined SIOCGIFFLAGS)) \
4507 || defined WINDOWSNT)
4508 return network_interface_info (ifname);
4509 #else
4510 return Qnil;
4511 #endif
4514 /* Turn off input and output for process PROC. */
4516 static void
4517 deactivate_process (Lisp_Object proc)
4519 int inchannel;
4520 struct Lisp_Process *p = XPROCESS (proc);
4521 int i;
4523 #ifdef HAVE_GNUTLS
4524 /* Delete GnuTLS structures in PROC, if any. */
4525 emacs_gnutls_deinit (proc);
4526 #endif /* HAVE_GNUTLS */
4528 if (p->read_output_delay > 0)
4530 if (--process_output_delay_count < 0)
4531 process_output_delay_count = 0;
4532 p->read_output_delay = 0;
4533 p->read_output_skip = 0;
4536 /* Beware SIGCHLD hereabouts. */
4538 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4539 close_process_fd (&p->open_fd[i]);
4541 inchannel = p->infd;
4542 if (inchannel >= 0)
4544 p->infd = -1;
4545 p->outfd = -1;
4546 #ifdef DATAGRAM_SOCKETS
4547 if (DATAGRAM_CHAN_P (inchannel))
4549 xfree (datagram_address[inchannel].sa);
4550 datagram_address[inchannel].sa = 0;
4551 datagram_address[inchannel].len = 0;
4553 #endif
4554 chan_process[inchannel] = Qnil;
4555 delete_read_fd (inchannel);
4556 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4557 delete_write_fd (inchannel);
4558 if (inchannel == max_desc)
4559 recompute_max_desc ();
4564 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4565 0, 4, 0,
4566 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4567 It is given to their filter functions.
4568 Optional argument PROCESS means do not return until output has been
4569 received from PROCESS.
4571 Optional second argument SECONDS and third argument MILLISEC
4572 specify a timeout; return after that much time even if there is
4573 no subprocess output. If SECONDS is a floating point number,
4574 it specifies a fractional number of seconds to wait.
4575 The MILLISEC argument is obsolete and should be avoided.
4577 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4578 from PROCESS only, suspending reading output from other processes.
4579 If JUST-THIS-ONE is an integer, don't run any timers either.
4580 Return non-nil if we received any output from PROCESS (or, if PROCESS
4581 is nil, from any process) before the timeout expired. */)
4582 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4583 Lisp_Object just_this_one)
4585 intmax_t secs;
4586 int nsecs;
4588 if (! NILP (process))
4590 CHECK_PROCESS (process);
4591 struct Lisp_Process *proc = XPROCESS (process);
4593 /* Can't wait for a process that is dedicated to a different
4594 thread. */
4595 if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ()))
4597 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4599 if (STRINGP (proc_thread_name))
4600 error ("Attempt to accept output from process %s locked to thread %s",
4601 SDATA (proc->name), SDATA (proc_thread_name));
4602 else
4603 error ("Attempt to accept output from process %s locked to thread %p",
4604 SDATA (proc->name), XTHREAD (proc->thread));
4607 else
4608 just_this_one = Qnil;
4610 if (!NILP (millisec))
4611 { /* Obsolete calling convention using integers rather than floats. */
4612 CHECK_NUMBER (millisec);
4613 if (NILP (seconds))
4614 seconds = make_float (XINT (millisec) / 1000.0);
4615 else
4617 CHECK_NUMBER (seconds);
4618 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4622 secs = 0;
4623 nsecs = -1;
4625 if (!NILP (seconds))
4627 if (INTEGERP (seconds))
4629 if (XINT (seconds) > 0)
4631 secs = XINT (seconds);
4632 nsecs = 0;
4635 else if (FLOATP (seconds))
4637 if (XFLOAT_DATA (seconds) > 0)
4639 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4640 secs = min (t.tv_sec, WAIT_READING_MAX);
4641 nsecs = t.tv_nsec;
4644 else
4645 wrong_type_argument (Qnumberp, seconds);
4647 else if (! NILP (process))
4648 nsecs = 0;
4650 return
4651 ((wait_reading_process_output (secs, nsecs, 0, 0,
4652 Qnil,
4653 !NILP (process) ? XPROCESS (process) : NULL,
4654 (NILP (just_this_one) ? 0
4655 : !INTEGERP (just_this_one) ? 1 : -1))
4656 <= 0)
4657 ? Qnil : Qt);
4660 /* Accept a connection for server process SERVER on CHANNEL. */
4662 static EMACS_INT connect_counter = 0;
4664 static void
4665 server_accept_connection (Lisp_Object server, int channel)
4667 Lisp_Object buffer;
4668 Lisp_Object contact, host, service;
4669 struct Lisp_Process *ps = XPROCESS (server);
4670 struct Lisp_Process *p;
4671 int s;
4672 union u_sockaddr {
4673 struct sockaddr sa;
4674 struct sockaddr_in in;
4675 #ifdef AF_INET6
4676 struct sockaddr_in6 in6;
4677 #endif
4678 #ifdef HAVE_LOCAL_SOCKETS
4679 struct sockaddr_un un;
4680 #endif
4681 } saddr;
4682 socklen_t len = sizeof saddr;
4683 ptrdiff_t count;
4685 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4687 if (s < 0)
4689 int code = errno;
4690 if (!would_block (code) && !NILP (ps->log))
4691 call3 (ps->log, server, Qnil,
4692 concat3 (build_string ("accept failed with code"),
4693 Fnumber_to_string (make_number (code)),
4694 build_string ("\n")));
4695 return;
4698 count = SPECPDL_INDEX ();
4699 record_unwind_protect_int (close_file_unwind, s);
4701 connect_counter++;
4703 /* Setup a new process to handle the connection. */
4705 /* Generate a unique identification of the caller, and build contact
4706 information for this process. */
4707 host = Qt;
4708 service = Qnil;
4709 Lisp_Object args[11];
4710 int nargs = 0;
4711 AUTO_STRING (procname_format_in, "%s <%d.%d.%d.%d:%d>");
4712 AUTO_STRING (procname_format_in6, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4713 AUTO_STRING (procname_format_default, "%s <%d>");
4714 switch (saddr.sa.sa_family)
4716 case AF_INET:
4718 args[nargs++] = procname_format_in;
4719 nargs++;
4720 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4721 service = make_number (ntohs (saddr.in.sin_port));
4722 for (int i = 0; i < 4; i++)
4723 args[nargs++] = make_number (ip[i]);
4724 args[nargs++] = service;
4726 break;
4728 #ifdef AF_INET6
4729 case AF_INET6:
4731 args[nargs++] = procname_format_in6;
4732 nargs++;
4733 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4734 service = make_number (ntohs (saddr.in.sin_port));
4735 for (int i = 0; i < 8; i++)
4736 args[nargs++] = make_number (ip6[i]);
4737 args[nargs++] = service;
4739 break;
4740 #endif
4742 default:
4743 args[nargs++] = procname_format_default;
4744 nargs++;
4745 args[nargs++] = make_number (connect_counter);
4746 break;
4749 /* Create a new buffer name for this process if it doesn't have a
4750 filter. The new buffer name is based on the buffer name or
4751 process name of the server process concatenated with the caller
4752 identification. */
4754 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4755 || EQ (ps->filter, Qt)))
4756 buffer = Qnil;
4757 else
4759 buffer = ps->buffer;
4760 if (!NILP (buffer))
4761 buffer = Fbuffer_name (buffer);
4762 else
4763 buffer = ps->name;
4764 if (!NILP (buffer))
4766 args[1] = buffer;
4767 buffer = Fget_buffer_create (Fformat (nargs, args));
4771 /* Generate a unique name for the new server process. Combine the
4772 server process name with the caller identification. */
4774 args[1] = ps->name;
4775 Lisp_Object name = Fformat (nargs, args);
4776 Lisp_Object proc = make_process (name);
4778 chan_process[s] = proc;
4780 fcntl (s, F_SETFL, O_NONBLOCK);
4782 p = XPROCESS (proc);
4784 /* Build new contact information for this setup. */
4785 contact = Fcopy_sequence (ps->childp);
4786 contact = Fplist_put (contact, QCserver, Qnil);
4787 contact = Fplist_put (contact, QChost, host);
4788 if (!NILP (service))
4789 contact = Fplist_put (contact, QCservice, service);
4790 contact = Fplist_put (contact, QCremote,
4791 conv_sockaddr_to_lisp (&saddr.sa, len));
4792 #ifdef HAVE_GETSOCKNAME
4793 len = sizeof saddr;
4794 if (getsockname (s, &saddr.sa, &len) == 0)
4795 contact = Fplist_put (contact, QClocal,
4796 conv_sockaddr_to_lisp (&saddr.sa, len));
4797 #endif
4799 pset_childp (p, contact);
4800 pset_plist (p, Fcopy_sequence (ps->plist));
4801 pset_type (p, Qnetwork);
4803 pset_buffer (p, buffer);
4804 pset_sentinel (p, ps->sentinel);
4805 pset_filter (p, ps->filter);
4806 eassert (NILP (p->command));
4807 eassert (p->pid == 0);
4809 /* Discard the unwind protect for closing S. */
4810 specpdl_ptr = specpdl + count;
4812 p->open_fd[SUBPROCESS_STDIN] = s;
4813 p->infd = s;
4814 p->outfd = s;
4815 pset_status (p, Qrun);
4817 /* Client processes for accepted connections are not stopped initially. */
4818 if (!EQ (p->filter, Qt))
4819 add_process_read_fd (s);
4820 if (s > max_desc)
4821 max_desc = s;
4823 /* Setup coding system for new process based on server process.
4824 This seems to be the proper thing to do, as the coding system
4825 of the new process should reflect the settings at the time the
4826 server socket was opened; not the current settings. */
4828 pset_decode_coding_system (p, ps->decode_coding_system);
4829 pset_encode_coding_system (p, ps->encode_coding_system);
4830 setup_process_coding_systems (proc);
4832 pset_decoding_buf (p, empty_unibyte_string);
4833 eassert (p->decoding_carryover == 0);
4834 pset_encoding_buf (p, empty_unibyte_string);
4836 p->inherit_coding_system_flag
4837 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4839 AUTO_STRING (dash, "-");
4840 AUTO_STRING (nl, "\n");
4841 Lisp_Object host_string = STRINGP (host) ? host : dash;
4843 if (!NILP (ps->log))
4845 AUTO_STRING (accept_from, "accept from ");
4846 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
4849 AUTO_STRING (open_from, "open from ");
4850 exec_sentinel (proc, concat3 (open_from, host_string, nl));
4853 #ifdef HAVE_GETADDRINFO_A
4854 static Lisp_Object
4855 check_for_dns (Lisp_Object proc)
4857 struct Lisp_Process *p = XPROCESS (proc);
4858 Lisp_Object addrinfos = Qnil;
4860 /* Sanity check. */
4861 if (! p->dns_request)
4862 return Qnil;
4864 int ret = gai_error (p->dns_request);
4865 if (ret == EAI_INPROGRESS)
4866 return Qt;
4868 /* We got a response. */
4869 if (ret == 0)
4871 struct addrinfo *res;
4873 for (res = p->dns_request->ar_result; res; res = res->ai_next)
4874 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
4876 addrinfos = Fnreverse (addrinfos);
4878 /* The DNS lookup failed. */
4879 else if (connecting_status (p->status))
4881 deactivate_process (proc);
4882 pset_status (p, (list2
4883 (Qfailed,
4884 concat3 (build_string ("Name lookup of "),
4885 build_string (p->dns_request->ar_name),
4886 build_string (" failed")))));
4889 free_dns_request (proc);
4891 /* This process should not already be connected (or killed). */
4892 if (! connecting_status (p->status))
4893 return Qnil;
4895 return addrinfos;
4898 #endif /* HAVE_GETADDRINFO_A */
4900 static void
4901 wait_for_socket_fds (Lisp_Object process, char const *name)
4903 while (XPROCESS (process)->infd < 0
4904 && connecting_status (XPROCESS (process)->status))
4906 add_to_log ("Waiting for socket from %s...", build_string (name));
4907 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4911 static void
4912 wait_while_connecting (Lisp_Object process)
4914 while (connecting_status (XPROCESS (process)->status))
4916 add_to_log ("Waiting for connection...");
4917 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4921 static void
4922 wait_for_tls_negotiation (Lisp_Object process)
4924 #ifdef HAVE_GNUTLS
4925 while (XPROCESS (process)->gnutls_p
4926 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
4928 add_to_log ("Waiting for TLS...");
4929 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4931 #endif
4934 static void
4935 wait_reading_process_output_unwind (int data)
4937 clear_waiting_thread_info ();
4938 waiting_for_user_input_p = data;
4941 /* This is here so breakpoints can be put on it. */
4942 static void
4943 wait_reading_process_output_1 (void)
4947 /* Read and dispose of subprocess output while waiting for timeout to
4948 elapse and/or keyboard input to be available.
4950 TIME_LIMIT is:
4951 timeout in seconds
4952 If negative, gobble data immediately available but don't wait for any.
4954 NSECS is:
4955 an additional duration to wait, measured in nanoseconds
4956 If TIME_LIMIT is zero, then:
4957 If NSECS == 0, there is no limit.
4958 If NSECS > 0, the timeout consists of NSECS only.
4959 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4961 READ_KBD is:
4962 0 to ignore keyboard input, or
4963 1 to return when input is available, or
4964 -1 meaning caller will actually read the input, so don't throw to
4965 the quit handler
4967 DO_DISPLAY means redisplay should be done to show subprocess
4968 output that arrives.
4970 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4971 (and gobble terminal input into the buffer if any arrives).
4973 If WAIT_PROC is specified, wait until something arrives from that
4974 process.
4976 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4977 (suspending output from other processes). A negative value
4978 means don't run any timers either.
4980 Return positive if we received input from WAIT_PROC (or from any
4981 process if WAIT_PROC is null), zero if we attempted to receive
4982 input but got none, and negative if we didn't even try. */
4985 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4986 bool do_display,
4987 Lisp_Object wait_for_cell,
4988 struct Lisp_Process *wait_proc, int just_wait_proc)
4990 int channel, nfds;
4991 fd_set Available;
4992 fd_set Writeok;
4993 bool check_write;
4994 int check_delay;
4995 bool no_avail;
4996 int xerrno;
4997 Lisp_Object proc;
4998 struct timespec timeout, end_time, timer_delay;
4999 struct timespec got_output_end_time = invalid_timespec ();
5000 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
5001 int got_some_output = -1;
5002 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5003 bool retry_for_async;
5004 #endif
5005 ptrdiff_t count = SPECPDL_INDEX ();
5007 /* Close to the current time if known, an invalid timespec otherwise. */
5008 struct timespec now = invalid_timespec ();
5010 eassert (wait_proc == NULL
5011 || EQ (wait_proc->thread, Qnil)
5012 || XTHREAD (wait_proc->thread) == current_thread);
5014 FD_ZERO (&Available);
5015 FD_ZERO (&Writeok);
5017 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5018 && !(CONSP (wait_proc->status)
5019 && EQ (XCAR (wait_proc->status), Qexit)))
5020 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5022 record_unwind_protect_int (wait_reading_process_output_unwind,
5023 waiting_for_user_input_p);
5024 waiting_for_user_input_p = read_kbd;
5026 if (TYPE_MAXIMUM (time_t) < time_limit)
5027 time_limit = TYPE_MAXIMUM (time_t);
5029 if (time_limit < 0 || nsecs < 0)
5030 wait = MINIMUM;
5031 else if (time_limit > 0 || nsecs > 0)
5033 wait = TIMEOUT;
5034 now = current_timespec ();
5035 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5037 else
5038 wait = INFINITY;
5040 while (1)
5042 bool process_skipped = false;
5044 /* If calling from keyboard input, do not quit
5045 since we want to return C-g as an input character.
5046 Otherwise, do pending quit if requested. */
5047 if (read_kbd >= 0)
5048 maybe_quit ();
5049 else if (pending_signals)
5050 process_pending_signals ();
5052 /* Exit now if the cell we're waiting for became non-nil. */
5053 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5054 break;
5056 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5058 Lisp_Object process_list_head, aproc;
5059 struct Lisp_Process *p;
5061 retry_for_async = false;
5062 FOR_EACH_PROCESS(process_list_head, aproc)
5064 p = XPROCESS (aproc);
5066 if (! wait_proc || p == wait_proc)
5068 #ifdef HAVE_GETADDRINFO_A
5069 /* Check for pending DNS requests. */
5070 if (p->dns_request)
5072 Lisp_Object addrinfos = check_for_dns (aproc);
5073 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5074 connect_network_socket (aproc, addrinfos, Qnil);
5075 else
5076 retry_for_async = true;
5078 #endif
5079 #ifdef HAVE_GNUTLS
5080 /* Continue TLS negotiation. */
5081 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5082 && p->is_non_blocking_client)
5084 gnutls_try_handshake (p);
5085 p->gnutls_handshakes_tried++;
5087 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5089 gnutls_verify_boot (aproc, Qnil);
5090 finish_after_tls_connection (aproc);
5092 else
5094 retry_for_async = true;
5095 if (p->gnutls_handshakes_tried
5096 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5098 deactivate_process (aproc);
5099 pset_status (p, list2 (Qfailed,
5100 build_string ("TLS negotiation failed")));
5104 #endif
5108 #endif /* GETADDRINFO_A or GNUTLS */
5110 /* Compute time from now till when time limit is up. */
5111 /* Exit if already run out. */
5112 if (wait == TIMEOUT)
5114 if (!timespec_valid_p (now))
5115 now = current_timespec ();
5116 if (timespec_cmp (end_time, now) <= 0)
5117 break;
5118 timeout = timespec_sub (end_time, now);
5120 else
5121 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5123 /* Normally we run timers here.
5124 But not if wait_for_cell; in those cases,
5125 the wait is supposed to be short,
5126 and those callers cannot handle running arbitrary Lisp code here. */
5127 if (NILP (wait_for_cell)
5128 && just_wait_proc >= 0)
5132 unsigned old_timers_run = timers_run;
5133 struct buffer *old_buffer = current_buffer;
5134 Lisp_Object old_window = selected_window;
5136 timer_delay = timer_check ();
5138 /* If a timer has run, this might have changed buffers
5139 an alike. Make read_key_sequence aware of that. */
5140 if (timers_run != old_timers_run
5141 && (old_buffer != current_buffer
5142 || !EQ (old_window, selected_window))
5143 && waiting_for_user_input_p == -1)
5144 record_asynch_buffer_change ();
5146 if (timers_run != old_timers_run && do_display)
5147 /* We must retry, since a timer may have requeued itself
5148 and that could alter the time_delay. */
5149 redisplay_preserve_echo_area (9);
5150 else
5151 break;
5153 while (!detect_input_pending ());
5155 /* If there is unread keyboard input, also return. */
5156 if (read_kbd != 0
5157 && requeued_events_pending_p ())
5158 break;
5160 /* This is so a breakpoint can be put here. */
5161 if (!timespec_valid_p (timer_delay))
5162 wait_reading_process_output_1 ();
5165 /* Cause C-g and alarm signals to take immediate action,
5166 and cause input available signals to zero out timeout.
5168 It is important that we do this before checking for process
5169 activity. If we get a SIGCHLD after the explicit checks for
5170 process activity, timeout is the only way we will know. */
5171 if (read_kbd < 0)
5172 set_waiting_for_input (&timeout);
5174 /* If status of something has changed, and no input is
5175 available, notify the user of the change right away. After
5176 this explicit check, we'll let the SIGCHLD handler zap
5177 timeout to get our attention. */
5178 if (update_tick != process_tick)
5180 fd_set Atemp;
5181 fd_set Ctemp;
5183 if (kbd_on_hold_p ())
5184 FD_ZERO (&Atemp);
5185 else
5186 compute_input_wait_mask (&Atemp);
5187 compute_write_mask (&Ctemp);
5189 timeout = make_timespec (0, 0);
5190 if ((thread_select (pselect, max_desc + 1,
5191 &Atemp,
5192 (num_pending_connects > 0 ? &Ctemp : NULL),
5193 NULL, &timeout, NULL)
5194 <= 0))
5196 /* It's okay for us to do this and then continue with
5197 the loop, since timeout has already been zeroed out. */
5198 clear_waiting_for_input ();
5199 got_some_output = status_notify (NULL, wait_proc);
5200 if (do_display) redisplay_preserve_echo_area (13);
5204 /* Don't wait for output from a non-running process. Just
5205 read whatever data has already been received. */
5206 if (wait_proc && wait_proc->raw_status_new)
5207 update_status (wait_proc);
5208 if (wait_proc
5209 && ! EQ (wait_proc->status, Qrun)
5210 && ! connecting_status (wait_proc->status))
5212 bool read_some_bytes = false;
5214 clear_waiting_for_input ();
5216 /* If data can be read from the process, do so until exhausted. */
5217 if (wait_proc->infd >= 0)
5219 XSETPROCESS (proc, wait_proc);
5221 while (true)
5223 int nread = read_process_output (proc, wait_proc->infd);
5224 if (nread < 0)
5226 if (errno == EIO || would_block (errno))
5227 break;
5229 else
5231 if (got_some_output < nread)
5232 got_some_output = nread;
5233 if (nread == 0)
5234 break;
5235 read_some_bytes = true;
5240 if (read_some_bytes && do_display)
5241 redisplay_preserve_echo_area (10);
5243 break;
5246 /* Wait till there is something to do. */
5248 if (wait_proc && just_wait_proc)
5250 if (wait_proc->infd < 0) /* Terminated. */
5251 break;
5252 FD_SET (wait_proc->infd, &Available);
5253 check_delay = 0;
5254 check_write = 0;
5256 else if (!NILP (wait_for_cell))
5258 compute_non_process_wait_mask (&Available);
5259 check_delay = 0;
5260 check_write = 0;
5262 else
5264 if (! read_kbd)
5265 compute_non_keyboard_wait_mask (&Available);
5266 else
5267 compute_input_wait_mask (&Available);
5268 compute_write_mask (&Writeok);
5269 check_delay = wait_proc ? 0 : process_output_delay_count;
5270 check_write = true;
5273 /* If frame size has changed or the window is newly mapped,
5274 redisplay now, before we start to wait. There is a race
5275 condition here; if a SIGIO arrives between now and the select
5276 and indicates that a frame is trashed, the select may block
5277 displaying a trashed screen. */
5278 if (frame_garbaged && do_display)
5280 clear_waiting_for_input ();
5281 redisplay_preserve_echo_area (11);
5282 if (read_kbd < 0)
5283 set_waiting_for_input (&timeout);
5286 /* Skip the `select' call if input is available and we're
5287 waiting for keyboard input or a cell change (which can be
5288 triggered by processing X events). In the latter case, set
5289 nfds to 1 to avoid breaking the loop. */
5290 no_avail = 0;
5291 if ((read_kbd || !NILP (wait_for_cell))
5292 && detect_input_pending ())
5294 nfds = read_kbd ? 0 : 1;
5295 no_avail = 1;
5296 FD_ZERO (&Available);
5298 else
5300 /* Set the timeout for adaptive read buffering if any
5301 process has non-zero read_output_skip and non-zero
5302 read_output_delay, and we are not reading output for a
5303 specific process. It is not executed if
5304 Vprocess_adaptive_read_buffering is nil. */
5305 if (process_output_skip && check_delay > 0)
5307 int adaptive_nsecs = timeout.tv_nsec;
5308 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5309 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5310 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5312 proc = chan_process[channel];
5313 if (NILP (proc))
5314 continue;
5315 /* Find minimum non-zero read_output_delay among the
5316 processes with non-zero read_output_skip. */
5317 if (XPROCESS (proc)->read_output_delay > 0)
5319 check_delay--;
5320 if (!XPROCESS (proc)->read_output_skip)
5321 continue;
5322 FD_CLR (channel, &Available);
5323 process_skipped = true;
5324 XPROCESS (proc)->read_output_skip = 0;
5325 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5326 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5329 timeout = make_timespec (0, adaptive_nsecs);
5330 process_output_skip = 0;
5333 /* If we've got some output and haven't limited our timeout
5334 with adaptive read buffering, limit it. */
5335 if (got_some_output > 0 && !process_skipped
5336 && (timeout.tv_sec
5337 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5338 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5341 if (NILP (wait_for_cell) && just_wait_proc >= 0
5342 && timespec_valid_p (timer_delay)
5343 && timespec_cmp (timer_delay, timeout) < 0)
5345 if (!timespec_valid_p (now))
5346 now = current_timespec ();
5347 struct timespec timeout_abs = timespec_add (now, timeout);
5348 if (!timespec_valid_p (got_output_end_time)
5349 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5350 got_output_end_time = timeout_abs;
5351 timeout = timer_delay;
5353 else
5354 got_output_end_time = invalid_timespec ();
5356 /* NOW can become inaccurate if time can pass during pselect. */
5357 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5358 now = invalid_timespec ();
5360 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5361 if (retry_for_async
5362 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5364 timeout.tv_sec = 0;
5365 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5367 #endif
5369 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5370 #if defined HAVE_GLIB && !defined HAVE_NS
5371 nfds = xg_select (max_desc + 1,
5372 &Available, (check_write ? &Writeok : 0),
5373 NULL, &timeout, NULL);
5374 #elif defined HAVE_NS
5375 /* And NS builds call thread_select in ns_select. */
5376 nfds = ns_select (max_desc + 1,
5377 &Available, (check_write ? &Writeok : 0),
5378 NULL, &timeout, NULL);
5379 #else /* !HAVE_GLIB */
5380 nfds = thread_select (pselect, max_desc + 1,
5381 &Available,
5382 (check_write ? &Writeok : 0),
5383 NULL, &timeout, NULL);
5384 #endif /* !HAVE_GLIB */
5386 #ifdef HAVE_GNUTLS
5387 /* GnuTLS buffers data internally. In lowat mode it leaves
5388 some data in the TCP buffers so that select works, but
5389 with custom pull/push functions we need to check if some
5390 data is available in the buffers manually. */
5391 if (nfds == 0)
5393 fd_set tls_available;
5394 int set = 0;
5396 FD_ZERO (&tls_available);
5397 if (! wait_proc)
5399 /* We're not waiting on a specific process, so loop
5400 through all the channels and check for data.
5401 This is a workaround needed for some versions of
5402 the gnutls library -- 2.12.14 has been confirmed
5403 to need it. See
5404 http://comments.gmane.org/gmane.emacs.devel/145074 */
5405 for (channel = 0; channel < FD_SETSIZE; ++channel)
5406 if (! NILP (chan_process[channel]))
5408 struct Lisp_Process *p =
5409 XPROCESS (chan_process[channel]);
5410 if (p && p->gnutls_p && p->gnutls_state
5411 && ((emacs_gnutls_record_check_pending
5412 (p->gnutls_state))
5413 > 0))
5415 nfds++;
5416 eassert (p->infd == channel);
5417 FD_SET (p->infd, &tls_available);
5418 set++;
5422 else
5424 /* Check this specific channel. */
5425 if (wait_proc->gnutls_p /* Check for valid process. */
5426 && wait_proc->gnutls_state
5427 /* Do we have pending data? */
5428 && ((emacs_gnutls_record_check_pending
5429 (wait_proc->gnutls_state))
5430 > 0))
5432 nfds = 1;
5433 eassert (0 <= wait_proc->infd);
5434 /* Set to Available. */
5435 FD_SET (wait_proc->infd, &tls_available);
5436 set++;
5439 if (set)
5440 Available = tls_available;
5442 #endif
5445 xerrno = errno;
5447 /* Make C-g and alarm signals set flags again. */
5448 clear_waiting_for_input ();
5450 /* If we woke up due to SIGWINCH, actually change size now. */
5451 do_pending_window_change (0);
5453 if (nfds == 0)
5455 /* Exit the main loop if we've passed the requested timeout,
5456 or aren't skipping processes and got some output and
5457 haven't lowered our timeout due to timers or SIGIO and
5458 have waited a long amount of time due to repeated
5459 timers. */
5460 struct timespec huge_timespec
5461 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
5462 struct timespec cmp_time = huge_timespec;
5463 if (wait < TIMEOUT)
5464 break;
5465 if (wait == TIMEOUT)
5466 cmp_time = end_time;
5467 if (!process_skipped && got_some_output > 0
5468 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5470 if (!timespec_valid_p (got_output_end_time))
5471 break;
5472 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5473 cmp_time = got_output_end_time;
5475 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5477 now = current_timespec ();
5478 if (timespec_cmp (cmp_time, now) <= 0)
5479 break;
5483 if (nfds < 0)
5485 if (xerrno == EINTR)
5486 no_avail = 1;
5487 else if (xerrno == EBADF)
5488 emacs_abort ();
5489 else
5490 report_file_errno ("Failed select", Qnil, xerrno);
5493 /* Check for keyboard input. */
5494 /* If there is any, return immediately
5495 to give it higher priority than subprocesses. */
5497 if (read_kbd != 0)
5499 unsigned old_timers_run = timers_run;
5500 struct buffer *old_buffer = current_buffer;
5501 Lisp_Object old_window = selected_window;
5502 bool leave = false;
5504 if (detect_input_pending_run_timers (do_display))
5506 swallow_events (do_display);
5507 if (detect_input_pending_run_timers (do_display))
5508 leave = true;
5511 /* If a timer has run, this might have changed buffers
5512 an alike. Make read_key_sequence aware of that. */
5513 if (timers_run != old_timers_run
5514 && waiting_for_user_input_p == -1
5515 && (old_buffer != current_buffer
5516 || !EQ (old_window, selected_window)))
5517 record_asynch_buffer_change ();
5519 if (leave)
5520 break;
5523 /* If there is unread keyboard input, also return. */
5524 if (read_kbd != 0
5525 && requeued_events_pending_p ())
5526 break;
5528 /* If we are not checking for keyboard input now,
5529 do process events (but don't run any timers).
5530 This is so that X events will be processed.
5531 Otherwise they may have to wait until polling takes place.
5532 That would causes delays in pasting selections, for example.
5534 (We used to do this only if wait_for_cell.) */
5535 if (read_kbd == 0 && detect_input_pending ())
5537 swallow_events (do_display);
5538 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5539 if (detect_input_pending ())
5540 break;
5541 #endif
5544 /* Exit now if the cell we're waiting for became non-nil. */
5545 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5546 break;
5548 #ifdef USABLE_SIGIO
5549 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5550 go read it. This can happen with X on BSD after logging out.
5551 In that case, there really is no input and no SIGIO,
5552 but select says there is input. */
5554 if (read_kbd && interrupt_input
5555 && keyboard_bit_set (&Available) && ! noninteractive)
5556 handle_input_available_signal (SIGIO);
5557 #endif
5559 /* If checking input just got us a size-change event from X,
5560 obey it now if we should. */
5561 if (read_kbd || ! NILP (wait_for_cell))
5562 do_pending_window_change (0);
5564 /* Check for data from a process. */
5565 if (no_avail || nfds == 0)
5566 continue;
5568 for (channel = 0; channel <= max_desc; ++channel)
5570 struct fd_callback_data *d = &fd_callback_info[channel];
5571 if (d->func
5572 && ((d->flags & FOR_READ
5573 && FD_ISSET (channel, &Available))
5574 || ((d->flags & FOR_WRITE)
5575 && FD_ISSET (channel, &Writeok))))
5576 d->func (channel, d->data);
5579 for (channel = 0; channel <= max_desc; channel++)
5581 if (FD_ISSET (channel, &Available)
5582 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5583 == PROCESS_FD))
5585 int nread;
5587 /* If waiting for this channel, arrange to return as
5588 soon as no more input to be processed. No more
5589 waiting. */
5590 proc = chan_process[channel];
5591 if (NILP (proc))
5592 continue;
5594 /* If this is a server stream socket, accept connection. */
5595 if (EQ (XPROCESS (proc)->status, Qlisten))
5597 server_accept_connection (proc, channel);
5598 continue;
5601 /* Read data from the process, starting with our
5602 buffered-ahead character if we have one. */
5604 nread = read_process_output (proc, channel);
5605 if ((!wait_proc || wait_proc == XPROCESS (proc))
5606 && got_some_output < nread)
5607 got_some_output = nread;
5608 if (nread > 0)
5610 /* Vacuum up any leftovers without waiting. */
5611 if (wait_proc == XPROCESS (proc))
5612 wait = MINIMUM;
5613 /* Since read_process_output can run a filter,
5614 which can call accept-process-output,
5615 don't try to read from any other processes
5616 before doing the select again. */
5617 FD_ZERO (&Available);
5619 if (do_display)
5620 redisplay_preserve_echo_area (12);
5622 else if (nread == -1 && would_block (errno))
5624 #ifdef WINDOWSNT
5625 /* FIXME: Is this special case still needed? */
5626 /* Note that we cannot distinguish between no input
5627 available now and a closed pipe.
5628 With luck, a closed pipe will be accompanied by
5629 subprocess termination and SIGCHLD. */
5630 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5631 && !PIPECONN_P (proc))
5633 #endif
5634 #ifdef HAVE_PTYS
5635 /* On some OSs with ptys, when the process on one end of
5636 a pty exits, the other end gets an error reading with
5637 errno = EIO instead of getting an EOF (0 bytes read).
5638 Therefore, if we get an error reading and errno =
5639 EIO, just continue, because the child process has
5640 exited and should clean itself up soon (e.g. when we
5641 get a SIGCHLD). */
5642 else if (nread == -1 && errno == EIO)
5644 struct Lisp_Process *p = XPROCESS (proc);
5646 /* Clear the descriptor now, so we only raise the
5647 signal once. */
5648 delete_read_fd (channel);
5650 if (p->pid == -2)
5652 /* If the EIO occurs on a pty, the SIGCHLD handler's
5653 waitpid call will not find the process object to
5654 delete. Do it here. */
5655 p->tick = ++process_tick;
5656 pset_status (p, Qfailed);
5659 #endif /* HAVE_PTYS */
5660 /* If we can detect process termination, don't consider the
5661 process gone just because its pipe is closed. */
5662 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5663 && !PIPECONN_P (proc))
5665 else if (nread == 0 && PIPECONN_P (proc))
5667 /* Preserve status of processes already terminated. */
5668 XPROCESS (proc)->tick = ++process_tick;
5669 deactivate_process (proc);
5670 if (EQ (XPROCESS (proc)->status, Qrun))
5671 pset_status (XPROCESS (proc),
5672 list2 (Qexit, make_number (0)));
5674 else
5676 /* Preserve status of processes already terminated. */
5677 XPROCESS (proc)->tick = ++process_tick;
5678 deactivate_process (proc);
5679 if (XPROCESS (proc)->raw_status_new)
5680 update_status (XPROCESS (proc));
5681 if (EQ (XPROCESS (proc)->status, Qrun))
5682 pset_status (XPROCESS (proc),
5683 list2 (Qexit, make_number (256)));
5686 if (FD_ISSET (channel, &Writeok)
5687 && (fd_callback_info[channel].flags
5688 & NON_BLOCKING_CONNECT_FD) != 0)
5690 struct Lisp_Process *p;
5692 delete_write_fd (channel);
5694 proc = chan_process[channel];
5695 if (NILP (proc))
5696 continue;
5698 p = XPROCESS (proc);
5700 #ifndef WINDOWSNT
5702 socklen_t xlen = sizeof (xerrno);
5703 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5704 xerrno = errno;
5706 #else
5707 /* On MS-Windows, getsockopt clears the error for the
5708 entire process, which may not be the right thing; see
5709 w32.c. Use getpeername instead. */
5711 struct sockaddr pname;
5712 socklen_t pnamelen = sizeof (pname);
5714 /* If connection failed, getpeername will fail. */
5715 xerrno = 0;
5716 if (getpeername (channel, &pname, &pnamelen) < 0)
5718 /* Obtain connect failure code through error slippage. */
5719 char dummy;
5720 xerrno = errno;
5721 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
5722 xerrno = errno;
5725 #endif
5726 if (xerrno)
5728 Lisp_Object addrinfos
5729 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
5730 if (!NILP (addrinfos))
5731 XSETCDR (p->status, XCDR (addrinfos));
5732 else
5734 p->tick = ++process_tick;
5735 pset_status (p, list2 (Qfailed, make_number (xerrno)));
5737 deactivate_process (proc);
5738 if (!NILP (addrinfos))
5739 connect_network_socket (proc, addrinfos, Qnil);
5741 else
5743 #ifdef HAVE_GNUTLS
5744 /* If we have an incompletely set up TLS connection,
5745 then defer the sentinel signaling until
5746 later. */
5747 if (NILP (p->gnutls_boot_parameters)
5748 && !p->gnutls_p)
5749 #endif
5751 pset_status (p, Qrun);
5752 /* Execute the sentinel here. If we had relied on
5753 status_notify to do it later, it will read input
5754 from the process before calling the sentinel. */
5755 exec_sentinel (proc, build_string ("open\n"));
5758 if (0 <= p->infd && !EQ (p->filter, Qt)
5759 && !EQ (p->command, Qt))
5760 add_process_read_fd (p->infd);
5763 } /* End for each file descriptor. */
5764 } /* End while exit conditions not met. */
5766 unbind_to (count, Qnil);
5768 /* If calling from keyboard input, do not quit
5769 since we want to return C-g as an input character.
5770 Otherwise, do pending quit if requested. */
5771 if (read_kbd >= 0)
5773 /* Prevent input_pending from remaining set if we quit. */
5774 clear_input_pending ();
5775 maybe_quit ();
5778 return got_some_output;
5781 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5783 static Lisp_Object
5784 read_process_output_call (Lisp_Object fun_and_args)
5786 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5789 static Lisp_Object
5790 read_process_output_error_handler (Lisp_Object error_val)
5792 cmd_error_internal (error_val, "error in process filter: ");
5793 Vinhibit_quit = Qt;
5794 update_echo_area ();
5795 Fsleep_for (make_number (2), Qnil);
5796 return Qt;
5799 static void
5800 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5801 ssize_t nbytes,
5802 struct coding_system *coding);
5804 /* Read pending output from the process channel,
5805 starting with our buffered-ahead character if we have one.
5806 Yield number of decoded characters read.
5808 This function reads at most 4096 characters.
5809 If you want to read all available subprocess output,
5810 you must call it repeatedly until it returns zero.
5812 The characters read are decoded according to PROC's coding-system
5813 for decoding. */
5815 static int
5816 read_process_output (Lisp_Object proc, int channel)
5818 ssize_t nbytes;
5819 struct Lisp_Process *p = XPROCESS (proc);
5820 struct coding_system *coding = proc_decode_coding_system[channel];
5821 int carryover = p->decoding_carryover;
5822 enum { readmax = 4096 };
5823 ptrdiff_t count = SPECPDL_INDEX ();
5824 Lisp_Object odeactivate;
5825 char chars[sizeof coding->carryover + readmax];
5827 if (carryover)
5828 /* See the comment above. */
5829 memcpy (chars, SDATA (p->decoding_buf), carryover);
5831 #ifdef DATAGRAM_SOCKETS
5832 /* We have a working select, so proc_buffered_char is always -1. */
5833 if (DATAGRAM_CHAN_P (channel))
5835 socklen_t len = datagram_address[channel].len;
5836 nbytes = recvfrom (channel, chars + carryover, readmax,
5837 0, datagram_address[channel].sa, &len);
5839 else
5840 #endif
5842 bool buffered = proc_buffered_char[channel] >= 0;
5843 if (buffered)
5845 chars[carryover] = proc_buffered_char[channel];
5846 proc_buffered_char[channel] = -1;
5848 #ifdef HAVE_GNUTLS
5849 if (p->gnutls_p && p->gnutls_state)
5850 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
5851 readmax - buffered);
5852 else
5853 #endif
5854 nbytes = emacs_read (channel, chars + carryover + buffered,
5855 readmax - buffered);
5856 if (nbytes > 0 && p->adaptive_read_buffering)
5858 int delay = p->read_output_delay;
5859 if (nbytes < 256)
5861 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5863 if (delay == 0)
5864 process_output_delay_count++;
5865 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5868 else if (delay > 0 && nbytes == readmax - buffered)
5870 delay -= READ_OUTPUT_DELAY_INCREMENT;
5871 if (delay == 0)
5872 process_output_delay_count--;
5874 p->read_output_delay = delay;
5875 if (delay)
5877 p->read_output_skip = 1;
5878 process_output_skip = 1;
5881 nbytes += buffered;
5882 nbytes += buffered && nbytes <= 0;
5885 p->decoding_carryover = 0;
5887 /* At this point, NBYTES holds number of bytes just received
5888 (including the one in proc_buffered_char[channel]). */
5889 if (nbytes <= 0)
5891 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5892 return nbytes;
5893 coding->mode |= CODING_MODE_LAST_BLOCK;
5896 /* Now set NBYTES how many bytes we must decode. */
5897 nbytes += carryover;
5899 odeactivate = Vdeactivate_mark;
5900 /* There's no good reason to let process filters change the current
5901 buffer, and many callers of accept-process-output, sit-for, and
5902 friends don't expect current-buffer to be changed from under them. */
5903 record_unwind_current_buffer ();
5905 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5907 /* Handling the process output should not deactivate the mark. */
5908 Vdeactivate_mark = odeactivate;
5910 unbind_to (count, Qnil);
5911 return nbytes;
5914 static void
5915 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5916 ssize_t nbytes,
5917 struct coding_system *coding)
5919 Lisp_Object outstream = p->filter;
5920 Lisp_Object text;
5921 bool outer_running_asynch_code = running_asynch_code;
5922 int waiting = waiting_for_user_input_p;
5924 #if 0
5925 Lisp_Object obuffer, okeymap;
5926 XSETBUFFER (obuffer, current_buffer);
5927 okeymap = BVAR (current_buffer, keymap);
5928 #endif
5930 /* We inhibit quit here instead of just catching it so that
5931 hitting ^G when a filter happens to be running won't screw
5932 it up. */
5933 specbind (Qinhibit_quit, Qt);
5934 specbind (Qlast_nonmenu_event, Qt);
5936 /* In case we get recursively called,
5937 and we already saved the match data nonrecursively,
5938 save the same match data in safely recursive fashion. */
5939 if (outer_running_asynch_code)
5941 Lisp_Object tem;
5942 /* Don't clobber the CURRENT match data, either! */
5943 tem = Fmatch_data (Qnil, Qnil, Qnil);
5944 restore_search_regs ();
5945 record_unwind_save_match_data ();
5946 Fset_match_data (tem, Qt);
5949 /* For speed, if a search happens within this code,
5950 save the match data in a special nonrecursive fashion. */
5951 running_asynch_code = 1;
5953 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5954 text = coding->dst_object;
5955 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5956 /* A new coding system might be found. */
5957 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5959 pset_decode_coding_system (p, Vlast_coding_system_used);
5961 /* Don't call setup_coding_system for
5962 proc_decode_coding_system[channel] here. It is done in
5963 detect_coding called via decode_coding above. */
5965 /* If a coding system for encoding is not yet decided, we set
5966 it as the same as coding-system for decoding.
5968 But, before doing that we must check if
5969 proc_encode_coding_system[p->outfd] surely points to a
5970 valid memory because p->outfd will be changed once EOF is
5971 sent to the process. */
5972 if (NILP (p->encode_coding_system) && p->outfd >= 0
5973 && proc_encode_coding_system[p->outfd])
5975 pset_encode_coding_system
5976 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5977 setup_coding_system (p->encode_coding_system,
5978 proc_encode_coding_system[p->outfd]);
5982 if (coding->carryover_bytes > 0)
5984 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5985 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5986 memcpy (SDATA (p->decoding_buf), coding->carryover,
5987 coding->carryover_bytes);
5988 p->decoding_carryover = coding->carryover_bytes;
5990 if (SBYTES (text) > 0)
5991 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5992 sometimes it's simply wrong to wrap (e.g. when called from
5993 accept-process-output). */
5994 internal_condition_case_1 (read_process_output_call,
5995 list3 (outstream, make_lisp_proc (p), text),
5996 !NILP (Vdebug_on_error) ? Qnil : Qerror,
5997 read_process_output_error_handler);
5999 /* If we saved the match data nonrecursively, restore it now. */
6000 restore_search_regs ();
6001 running_asynch_code = outer_running_asynch_code;
6003 /* Restore waiting_for_user_input_p as it was
6004 when we were called, in case the filter clobbered it. */
6005 waiting_for_user_input_p = waiting;
6007 #if 0 /* Call record_asynch_buffer_change unconditionally,
6008 because we might have changed minor modes or other things
6009 that affect key bindings. */
6010 if (! EQ (Fcurrent_buffer (), obuffer)
6011 || ! EQ (current_buffer->keymap, okeymap))
6012 #endif
6013 /* But do it only if the caller is actually going to read events.
6014 Otherwise there's no need to make him wake up, and it could
6015 cause trouble (for example it would make sit_for return). */
6016 if (waiting_for_user_input_p == -1)
6017 record_asynch_buffer_change ();
6020 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6021 Sinternal_default_process_filter, 2, 2, 0,
6022 doc: /* Function used as default process filter.
6023 This inserts the process's output into its buffer, if there is one.
6024 Otherwise it discards the output. */)
6025 (Lisp_Object proc, Lisp_Object text)
6027 struct Lisp_Process *p;
6028 ptrdiff_t opoint;
6030 CHECK_PROCESS (proc);
6031 p = XPROCESS (proc);
6032 CHECK_STRING (text);
6034 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6036 Lisp_Object old_read_only;
6037 ptrdiff_t old_begv, old_zv;
6038 ptrdiff_t old_begv_byte, old_zv_byte;
6039 ptrdiff_t before, before_byte;
6040 ptrdiff_t opoint_byte;
6041 struct buffer *b;
6043 Fset_buffer (p->buffer);
6044 opoint = PT;
6045 opoint_byte = PT_BYTE;
6046 old_read_only = BVAR (current_buffer, read_only);
6047 old_begv = BEGV;
6048 old_zv = ZV;
6049 old_begv_byte = BEGV_BYTE;
6050 old_zv_byte = ZV_BYTE;
6052 bset_read_only (current_buffer, Qnil);
6054 /* Insert new output into buffer at the current end-of-output
6055 marker, thus preserving logical ordering of input and output. */
6056 if (XMARKER (p->mark)->buffer)
6057 set_point_from_marker (p->mark);
6058 else
6059 SET_PT_BOTH (ZV, ZV_BYTE);
6060 before = PT;
6061 before_byte = PT_BYTE;
6063 /* If the output marker is outside of the visible region, save
6064 the restriction and widen. */
6065 if (! (BEGV <= PT && PT <= ZV))
6066 Fwiden ();
6068 /* Adjust the multibyteness of TEXT to that of the buffer. */
6069 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6070 != ! STRING_MULTIBYTE (text))
6071 text = (STRING_MULTIBYTE (text)
6072 ? Fstring_as_unibyte (text)
6073 : Fstring_to_multibyte (text));
6074 /* Insert before markers in case we are inserting where
6075 the buffer's mark is, and the user's next command is Meta-y. */
6076 insert_from_string_before_markers (text, 0, 0,
6077 SCHARS (text), SBYTES (text), 0);
6079 /* Make sure the process marker's position is valid when the
6080 process buffer is changed in the signal_after_change above.
6081 W3 is known to do that. */
6082 if (BUFFERP (p->buffer)
6083 && (b = XBUFFER (p->buffer), b != current_buffer))
6084 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6085 else
6086 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6088 update_mode_lines = 23;
6090 /* Make sure opoint and the old restrictions
6091 float ahead of any new text just as point would. */
6092 if (opoint >= before)
6094 opoint += PT - before;
6095 opoint_byte += PT_BYTE - before_byte;
6097 if (old_begv > before)
6099 old_begv += PT - before;
6100 old_begv_byte += PT_BYTE - before_byte;
6102 if (old_zv >= before)
6104 old_zv += PT - before;
6105 old_zv_byte += PT_BYTE - before_byte;
6108 /* If the restriction isn't what it should be, set it. */
6109 if (old_begv != BEGV || old_zv != ZV)
6110 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
6112 bset_read_only (current_buffer, old_read_only);
6113 SET_PT_BOTH (opoint, opoint_byte);
6115 return Qnil;
6118 /* Sending data to subprocess. */
6120 /* In send_process, when a write fails temporarily,
6121 wait_reading_process_output is called. It may execute user code,
6122 e.g. timers, that attempts to write new data to the same process.
6123 We must ensure that data is sent in the right order, and not
6124 interspersed half-completed with other writes (Bug#10815). This is
6125 handled by the write_queue element of struct process. It is a list
6126 with each entry having the form
6128 (string . (offset . length))
6130 where STRING is a lisp string, OFFSET is the offset into the
6131 string's byte sequence from which we should begin to send, and
6132 LENGTH is the number of bytes left to send. */
6134 /* Create a new entry in write_queue.
6135 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6136 BUF is a pointer to the string sequence of the input_obj or a C
6137 string in case of Qt or Qnil. */
6139 static void
6140 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6141 const char *buf, ptrdiff_t len, bool front)
6143 ptrdiff_t offset;
6144 Lisp_Object entry, obj;
6146 if (STRINGP (input_obj))
6148 offset = buf - SSDATA (input_obj);
6149 obj = input_obj;
6151 else
6153 offset = 0;
6154 obj = make_unibyte_string (buf, len);
6157 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
6159 if (front)
6160 pset_write_queue (p, Fcons (entry, p->write_queue));
6161 else
6162 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6165 /* Remove the first element in the write_queue of process P, put its
6166 contents in OBJ, BUF and LEN, and return true. If the
6167 write_queue is empty, return false. */
6169 static bool
6170 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6171 const char **buf, ptrdiff_t *len)
6173 Lisp_Object entry, offset_length;
6174 ptrdiff_t offset;
6176 if (NILP (p->write_queue))
6177 return 0;
6179 entry = XCAR (p->write_queue);
6180 pset_write_queue (p, XCDR (p->write_queue));
6182 *obj = XCAR (entry);
6183 offset_length = XCDR (entry);
6185 *len = XINT (XCDR (offset_length));
6186 offset = XINT (XCAR (offset_length));
6187 *buf = SSDATA (*obj) + offset;
6189 return 1;
6192 /* Send some data to process PROC.
6193 BUF is the beginning of the data; LEN is the number of characters.
6194 OBJECT is the Lisp object that the data comes from. If OBJECT is
6195 nil or t, it means that the data comes from C string.
6197 If OBJECT is not nil, the data is encoded by PROC's coding-system
6198 for encoding before it is sent.
6200 This function can evaluate Lisp code and can garbage collect. */
6202 static void
6203 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6204 Lisp_Object object)
6206 struct Lisp_Process *p = XPROCESS (proc);
6207 ssize_t rv;
6208 struct coding_system *coding;
6210 if (NETCONN_P (proc))
6212 wait_while_connecting (proc);
6213 wait_for_tls_negotiation (proc);
6216 if (p->raw_status_new)
6217 update_status (p);
6218 if (! EQ (p->status, Qrun))
6219 error ("Process %s not running", SDATA (p->name));
6220 if (p->outfd < 0)
6221 error ("Output file descriptor of %s is closed", SDATA (p->name));
6223 coding = proc_encode_coding_system[p->outfd];
6224 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6226 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6227 || (BUFFERP (object)
6228 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6229 || EQ (object, Qt))
6231 pset_encode_coding_system
6232 (p, complement_process_encoding_system (p->encode_coding_system));
6233 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6235 /* The coding system for encoding was changed to raw-text
6236 because we sent a unibyte text previously. Now we are
6237 sending a multibyte text, thus we must encode it by the
6238 original coding system specified for the current process.
6240 Another reason we come here is that the coding system
6241 was just complemented and a new one was returned by
6242 complement_process_encoding_system. */
6243 setup_coding_system (p->encode_coding_system, coding);
6244 Vlast_coding_system_used = p->encode_coding_system;
6246 coding->src_multibyte = 1;
6248 else
6250 coding->src_multibyte = 0;
6251 /* For sending a unibyte text, character code conversion should
6252 not take place but EOL conversion should. So, setup raw-text
6253 or one of the subsidiary if we have not yet done it. */
6254 if (CODING_REQUIRE_ENCODING (coding))
6256 if (CODING_REQUIRE_FLUSHING (coding))
6258 /* But, before changing the coding, we must flush out data. */
6259 coding->mode |= CODING_MODE_LAST_BLOCK;
6260 send_process (proc, "", 0, Qt);
6261 coding->mode &= CODING_MODE_LAST_BLOCK;
6263 setup_coding_system (raw_text_coding_system
6264 (Vlast_coding_system_used),
6265 coding);
6266 coding->src_multibyte = 0;
6269 coding->dst_multibyte = 0;
6271 if (CODING_REQUIRE_ENCODING (coding))
6273 coding->dst_object = Qt;
6274 if (BUFFERP (object))
6276 ptrdiff_t from_byte, from, to;
6277 ptrdiff_t save_pt, save_pt_byte;
6278 struct buffer *cur = current_buffer;
6280 set_buffer_internal (XBUFFER (object));
6281 save_pt = PT, save_pt_byte = PT_BYTE;
6283 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6284 from = BYTE_TO_CHAR (from_byte);
6285 to = BYTE_TO_CHAR (from_byte + len);
6286 TEMP_SET_PT_BOTH (from, from_byte);
6287 encode_coding_object (coding, object, from, from_byte,
6288 to, from_byte + len, Qt);
6289 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6290 set_buffer_internal (cur);
6292 else if (STRINGP (object))
6294 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6295 SBYTES (object), Qt);
6297 else
6299 coding->dst_object = make_unibyte_string (buf, len);
6300 coding->produced = len;
6303 len = coding->produced;
6304 object = coding->dst_object;
6305 buf = SSDATA (object);
6308 /* If there is already data in the write_queue, put the new data
6309 in the back of queue. Otherwise, ignore it. */
6310 if (!NILP (p->write_queue))
6311 write_queue_push (p, object, buf, len, 0);
6313 do /* while !NILP (p->write_queue) */
6315 ptrdiff_t cur_len = -1;
6316 const char *cur_buf;
6317 Lisp_Object cur_object;
6319 /* If write_queue is empty, ignore it. */
6320 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6322 cur_len = len;
6323 cur_buf = buf;
6324 cur_object = object;
6327 while (cur_len > 0)
6329 /* Send this batch, using one or more write calls. */
6330 ptrdiff_t written = 0;
6331 int outfd = p->outfd;
6332 #ifdef DATAGRAM_SOCKETS
6333 if (DATAGRAM_CHAN_P (outfd))
6335 rv = sendto (outfd, cur_buf, cur_len,
6336 0, datagram_address[outfd].sa,
6337 datagram_address[outfd].len);
6338 if (rv >= 0)
6339 written = rv;
6340 else if (errno == EMSGSIZE)
6341 report_file_error ("Sending datagram", proc);
6343 else
6344 #endif
6346 #ifdef HAVE_GNUTLS
6347 if (p->gnutls_p && p->gnutls_state)
6348 written = emacs_gnutls_write (p, cur_buf, cur_len);
6349 else
6350 #endif
6351 written = emacs_write_sig (outfd, cur_buf, cur_len);
6352 rv = (written ? 0 : -1);
6353 if (p->read_output_delay > 0
6354 && p->adaptive_read_buffering == 1)
6356 p->read_output_delay = 0;
6357 process_output_delay_count--;
6358 p->read_output_skip = 0;
6362 if (rv < 0)
6364 if (would_block (errno))
6365 /* Buffer is full. Wait, accepting input;
6366 that may allow the program
6367 to finish doing output and read more. */
6369 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6370 /* A gross hack to work around a bug in FreeBSD.
6371 In the following sequence, read(2) returns
6372 bogus data:
6374 write(2) 1022 bytes
6375 write(2) 954 bytes, get EAGAIN
6376 read(2) 1024 bytes in process_read_output
6377 read(2) 11 bytes in process_read_output
6379 That is, read(2) returns more bytes than have
6380 ever been written successfully. The 1033 bytes
6381 read are the 1022 bytes written successfully
6382 after processing (for example with CRs added if
6383 the terminal is set up that way which it is
6384 here). The same bytes will be seen again in a
6385 later read(2), without the CRs. */
6387 if (errno == EAGAIN)
6389 int flags = FWRITE;
6390 ioctl (p->outfd, TIOCFLUSH, &flags);
6392 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6394 /* Put what we should have written in wait_queue. */
6395 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6396 wait_reading_process_output (0, 20 * 1000 * 1000,
6397 0, 0, Qnil, NULL, 0);
6398 /* Reread queue, to see what is left. */
6399 break;
6401 else if (errno == EPIPE)
6403 p->raw_status_new = 0;
6404 pset_status (p, list2 (Qexit, make_number (256)));
6405 p->tick = ++process_tick;
6406 deactivate_process (proc);
6407 error ("process %s no longer connected to pipe; closed it",
6408 SDATA (p->name));
6410 else
6411 /* This is a real error. */
6412 report_file_error ("Writing to process", proc);
6414 cur_buf += written;
6415 cur_len -= written;
6418 while (!NILP (p->write_queue));
6421 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6422 3, 3, 0,
6423 doc: /* Send current contents of region as input to PROCESS.
6424 PROCESS may be a process, a buffer, the name of a process or buffer, or
6425 nil, indicating the current buffer's process.
6426 Called from program, takes three arguments, PROCESS, START and END.
6427 If the region is more than 500 characters long,
6428 it is sent in several bunches. This may happen even for shorter regions.
6429 Output from processes can arrive in between bunches.
6431 If PROCESS is a non-blocking network process that hasn't been fully
6432 set up yet, this function will block until socket setup has completed. */)
6433 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6435 Lisp_Object proc = get_process (process);
6436 ptrdiff_t start_byte, end_byte;
6438 validate_region (&start, &end);
6440 start_byte = CHAR_TO_BYTE (XINT (start));
6441 end_byte = CHAR_TO_BYTE (XINT (end));
6443 if (XINT (start) < GPT && XINT (end) > GPT)
6444 move_gap_both (XINT (start), start_byte);
6446 if (NETCONN_P (proc))
6447 wait_while_connecting (proc);
6449 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6450 end_byte - start_byte, Fcurrent_buffer ());
6452 return Qnil;
6455 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6456 2, 2, 0,
6457 doc: /* Send PROCESS the contents of STRING as input.
6458 PROCESS may be a process, a buffer, the name of a process or buffer, or
6459 nil, indicating the current buffer's process.
6460 If STRING is more than 500 characters long,
6461 it is sent in several bunches. This may happen even for shorter strings.
6462 Output from processes can arrive in between bunches.
6464 If PROCESS is a non-blocking network process that hasn't been fully
6465 set up yet, this function will block until socket setup has completed. */)
6466 (Lisp_Object process, Lisp_Object string)
6468 CHECK_STRING (string);
6469 Lisp_Object proc = get_process (process);
6470 send_process (proc, SSDATA (string),
6471 SBYTES (string), string);
6472 return Qnil;
6475 /* Return the foreground process group for the tty/pty that
6476 the process P uses. */
6477 static pid_t
6478 emacs_get_tty_pgrp (struct Lisp_Process *p)
6480 pid_t gid = -1;
6482 #ifdef TIOCGPGRP
6483 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6485 int fd;
6486 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6487 master side. Try the slave side. */
6488 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6490 if (fd != -1)
6492 ioctl (fd, TIOCGPGRP, &gid);
6493 emacs_close (fd);
6496 #endif /* defined (TIOCGPGRP ) */
6498 return gid;
6501 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6502 Sprocess_running_child_p, 0, 1, 0,
6503 doc: /* Return non-nil if PROCESS has given the terminal to a
6504 child. If the operating system does not make it possible to find out,
6505 return t. If we can find out, return the numeric ID of the foreground
6506 process group. */)
6507 (Lisp_Object process)
6509 /* Initialize in case ioctl doesn't exist or gives an error,
6510 in a way that will cause returning t. */
6511 Lisp_Object proc = get_process (process);
6512 struct Lisp_Process *p = XPROCESS (proc);
6514 if (!EQ (p->type, Qreal))
6515 error ("Process %s is not a subprocess",
6516 SDATA (p->name));
6517 if (p->infd < 0)
6518 error ("Process %s is not active",
6519 SDATA (p->name));
6521 pid_t gid = emacs_get_tty_pgrp (p);
6523 if (gid == p->pid)
6524 return Qnil;
6525 if (gid != -1)
6526 return make_number (gid);
6527 return Qt;
6530 /* Send a signal number SIGNO to PROCESS.
6531 If CURRENT_GROUP is t, that means send to the process group
6532 that currently owns the terminal being used to communicate with PROCESS.
6533 This is used for various commands in shell mode.
6534 If CURRENT_GROUP is lambda, that means send to the process group
6535 that currently owns the terminal, but only if it is NOT the shell itself.
6537 If NOMSG is false, insert signal-announcements into process's buffers
6538 right away.
6540 If we can, we try to signal PROCESS by sending control characters
6541 down the pty. This allows us to signal inferiors who have changed
6542 their uid, for which kill would return an EPERM error. */
6544 static void
6545 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6546 bool nomsg)
6548 Lisp_Object proc;
6549 struct Lisp_Process *p;
6550 pid_t gid;
6551 bool no_pgrp = 0;
6553 proc = get_process (process);
6554 p = XPROCESS (proc);
6556 if (!EQ (p->type, Qreal))
6557 error ("Process %s is not a subprocess",
6558 SDATA (p->name));
6559 if (p->infd < 0)
6560 error ("Process %s is not active",
6561 SDATA (p->name));
6563 if (!p->pty_flag)
6564 current_group = Qnil;
6566 /* If we are using pgrps, get a pgrp number and make it negative. */
6567 if (NILP (current_group))
6568 /* Send the signal to the shell's process group. */
6569 gid = p->pid;
6570 else
6572 #ifdef SIGNALS_VIA_CHARACTERS
6573 /* If possible, send signals to the entire pgrp
6574 by sending an input character to it. */
6576 struct termios t;
6577 cc_t *sig_char = NULL;
6579 tcgetattr (p->infd, &t);
6581 switch (signo)
6583 case SIGINT:
6584 sig_char = &t.c_cc[VINTR];
6585 break;
6587 case SIGQUIT:
6588 sig_char = &t.c_cc[VQUIT];
6589 break;
6591 case SIGTSTP:
6592 #ifdef VSWTCH
6593 sig_char = &t.c_cc[VSWTCH];
6594 #else
6595 sig_char = &t.c_cc[VSUSP];
6596 #endif
6597 break;
6600 if (sig_char && *sig_char != CDISABLE)
6602 send_process (proc, (char *) sig_char, 1, Qnil);
6603 return;
6605 /* If we can't send the signal with a character,
6606 fall through and send it another way. */
6608 /* The code above may fall through if it can't
6609 handle the signal. */
6610 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6612 #ifdef TIOCGPGRP
6613 /* Get the current pgrp using the tty itself, if we have that.
6614 Otherwise, use the pty to get the pgrp.
6615 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6616 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6617 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6618 His patch indicates that if TIOCGPGRP returns an error, then
6619 we should just assume that p->pid is also the process group id. */
6621 gid = emacs_get_tty_pgrp (p);
6623 if (gid == -1)
6624 /* If we can't get the information, assume
6625 the shell owns the tty. */
6626 gid = p->pid;
6628 /* It is not clear whether anything really can set GID to -1.
6629 Perhaps on some system one of those ioctls can or could do so.
6630 Or perhaps this is vestigial. */
6631 if (gid == -1)
6632 no_pgrp = 1;
6633 #else /* ! defined (TIOCGPGRP) */
6634 /* Can't select pgrps on this system, so we know that
6635 the child itself heads the pgrp. */
6636 gid = p->pid;
6637 #endif /* ! defined (TIOCGPGRP) */
6639 /* If current_group is lambda, and the shell owns the terminal,
6640 don't send any signal. */
6641 if (EQ (current_group, Qlambda) && gid == p->pid)
6642 return;
6645 #ifdef SIGCONT
6646 if (signo == SIGCONT)
6648 p->raw_status_new = 0;
6649 pset_status (p, Qrun);
6650 p->tick = ++process_tick;
6651 if (!nomsg)
6653 status_notify (NULL, NULL);
6654 redisplay_preserve_echo_area (13);
6657 #endif
6659 #ifdef TIOCSIGSEND
6660 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6661 We don't know whether the bug is fixed in later HP-UX versions. */
6662 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6663 return;
6664 #endif
6666 /* If we don't have process groups, send the signal to the immediate
6667 subprocess. That isn't really right, but it's better than any
6668 obvious alternative. */
6669 pid_t pid = no_pgrp ? gid : - gid;
6671 /* Do not kill an already-reaped process, as that could kill an
6672 innocent bystander that happens to have the same process ID. */
6673 sigset_t oldset;
6674 block_child_signal (&oldset);
6675 if (p->alive)
6676 kill (pid, signo);
6677 unblock_child_signal (&oldset);
6680 DEFUN ("internal-default-interrupt-process",
6681 Finternal_default_interrupt_process,
6682 Sinternal_default_interrupt_process, 0, 2, 0,
6683 doc: /* Default function to interrupt process PROCESS.
6684 It shall be the last element in list `interrupt-process-functions'.
6685 See function `interrupt-process' for more details on usage. */)
6686 (Lisp_Object process, Lisp_Object current_group)
6688 process_send_signal (process, SIGINT, current_group, 0);
6689 return process;
6692 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6693 doc: /* Interrupt process PROCESS.
6694 PROCESS may be a process, a buffer, or the name of a process or buffer.
6695 No arg or nil means current buffer's process.
6696 Second arg CURRENT-GROUP non-nil means send signal to
6697 the current process-group of the process's controlling terminal
6698 rather than to the process's own process group.
6699 If the process is a shell, this means interrupt current subjob
6700 rather than the shell.
6702 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6703 don't send the signal.
6705 This function calls the functions of `interrupt-process-functions' in
6706 the order of the list, until one of them returns non-`nil'. */)
6707 (Lisp_Object process, Lisp_Object current_group)
6709 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
6710 process, current_group);
6713 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6714 doc: /* Kill process PROCESS. May be process or name of one.
6715 See function `interrupt-process' for more details on usage. */)
6716 (Lisp_Object process, Lisp_Object current_group)
6718 process_send_signal (process, SIGKILL, current_group, 0);
6719 return process;
6722 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6723 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6724 See function `interrupt-process' for more details on usage. */)
6725 (Lisp_Object process, Lisp_Object current_group)
6727 process_send_signal (process, SIGQUIT, current_group, 0);
6728 return process;
6731 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6732 doc: /* Stop process PROCESS. May be process or name of one.
6733 See function `interrupt-process' for more details on usage.
6734 If PROCESS is a network or serial or pipe connection, inhibit handling
6735 of incoming traffic. */)
6736 (Lisp_Object process, Lisp_Object current_group)
6738 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6739 || PIPECONN_P (process)))
6741 struct Lisp_Process *p;
6743 p = XPROCESS (process);
6744 if (NILP (p->command)
6745 && p->infd >= 0)
6746 delete_read_fd (p->infd);
6747 pset_command (p, Qt);
6748 return process;
6750 #ifndef SIGTSTP
6751 error ("No SIGTSTP support");
6752 #else
6753 process_send_signal (process, SIGTSTP, current_group, 0);
6754 #endif
6755 return process;
6758 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6759 doc: /* Continue process PROCESS. May be process or name of one.
6760 See function `interrupt-process' for more details on usage.
6761 If PROCESS is a network or serial process, resume handling of incoming
6762 traffic. */)
6763 (Lisp_Object process, Lisp_Object current_group)
6765 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6766 || PIPECONN_P (process)))
6768 struct Lisp_Process *p;
6770 p = XPROCESS (process);
6771 if (EQ (p->command, Qt)
6772 && p->infd >= 0
6773 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6775 add_process_read_fd (p->infd);
6776 #ifdef WINDOWSNT
6777 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6778 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6779 #else /* not WINDOWSNT */
6780 tcflush (p->infd, TCIFLUSH);
6781 #endif /* not WINDOWSNT */
6783 pset_command (p, Qnil);
6784 return process;
6786 #ifdef SIGCONT
6787 process_send_signal (process, SIGCONT, current_group, 0);
6788 #else
6789 error ("No SIGCONT support");
6790 #endif
6791 return process;
6794 /* Return the integer value of the signal whose abbreviation is ABBR,
6795 or a negative number if there is no such signal. */
6796 static int
6797 abbr_to_signal (char const *name)
6799 int i, signo;
6800 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
6802 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
6803 name += 3;
6805 for (i = 0; i < sizeof sigbuf; i++)
6807 sigbuf[i] = c_toupper (name[i]);
6808 if (! sigbuf[i])
6809 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
6812 return -1;
6815 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6816 2, 2, "sProcess (name or number): \nnSignal code: ",
6817 doc: /* Send PROCESS the signal with code SIGCODE.
6818 PROCESS may also be a number specifying the process id of the
6819 process to signal; in this case, the process need not be a child of
6820 this Emacs.
6821 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6822 (Lisp_Object process, Lisp_Object sigcode)
6824 pid_t pid;
6825 int signo;
6827 if (STRINGP (process))
6829 Lisp_Object tem = Fget_process (process);
6830 if (NILP (tem))
6832 Lisp_Object process_number
6833 = string_to_number (SSDATA (process), 10, 1);
6834 if (NUMBERP (process_number))
6835 tem = process_number;
6837 process = tem;
6839 else if (!NUMBERP (process))
6840 process = get_process (process);
6842 if (NILP (process))
6843 return process;
6845 if (NUMBERP (process))
6846 CONS_TO_INTEGER (process, pid_t, pid);
6847 else
6849 CHECK_PROCESS (process);
6850 pid = XPROCESS (process)->pid;
6851 if (pid <= 0)
6852 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6855 if (INTEGERP (sigcode))
6857 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
6858 signo = XINT (sigcode);
6860 else
6862 char *name;
6864 CHECK_SYMBOL (sigcode);
6865 name = SSDATA (SYMBOL_NAME (sigcode));
6867 signo = abbr_to_signal (name);
6868 if (signo < 0)
6869 error ("Undefined signal name %s", name);
6872 return make_number (kill (pid, signo));
6875 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6876 doc: /* Make PROCESS see end-of-file in its input.
6877 EOF comes after any text already sent to it.
6878 PROCESS may be a process, a buffer, the name of a process or buffer, or
6879 nil, indicating the current buffer's process.
6880 If PROCESS is a network connection, or is a process communicating
6881 through a pipe (as opposed to a pty), then you cannot send any more
6882 text to PROCESS after you call this function.
6883 If PROCESS is a serial process, wait until all output written to the
6884 process has been transmitted to the serial port. */)
6885 (Lisp_Object process)
6887 Lisp_Object proc;
6888 struct coding_system *coding = NULL;
6889 int outfd;
6891 proc = get_process (process);
6893 if (NETCONN_P (proc))
6894 wait_while_connecting (proc);
6896 if (DATAGRAM_CONN_P (proc))
6897 return process;
6900 outfd = XPROCESS (proc)->outfd;
6901 if (outfd >= 0)
6902 coding = proc_encode_coding_system[outfd];
6904 /* Make sure the process is really alive. */
6905 if (XPROCESS (proc)->raw_status_new)
6906 update_status (XPROCESS (proc));
6907 if (! EQ (XPROCESS (proc)->status, Qrun))
6908 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6910 if (coding && CODING_REQUIRE_FLUSHING (coding))
6912 coding->mode |= CODING_MODE_LAST_BLOCK;
6913 send_process (proc, "", 0, Qnil);
6916 if (XPROCESS (proc)->pty_flag)
6917 send_process (proc, "\004", 1, Qnil);
6918 else if (EQ (XPROCESS (proc)->type, Qserial))
6920 #ifndef WINDOWSNT
6921 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6922 report_file_error ("Failed tcdrain", Qnil);
6923 #endif /* not WINDOWSNT */
6924 /* Do nothing on Windows because writes are blocking. */
6926 else
6928 struct Lisp_Process *p = XPROCESS (proc);
6929 int old_outfd = p->outfd;
6930 int new_outfd;
6932 #ifdef HAVE_SHUTDOWN
6933 /* If this is a network connection, or socketpair is used
6934 for communication with the subprocess, call shutdown to cause EOF.
6935 (In some old system, shutdown to socketpair doesn't work.
6936 Then we just can't win.) */
6937 if (0 <= old_outfd
6938 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
6939 shutdown (old_outfd, 1);
6940 #endif
6941 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
6942 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6943 if (new_outfd < 0)
6944 report_file_error ("Opening null device", Qnil);
6945 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
6946 p->outfd = new_outfd;
6948 if (!proc_encode_coding_system[new_outfd])
6949 proc_encode_coding_system[new_outfd]
6950 = xmalloc (sizeof (struct coding_system));
6951 if (old_outfd >= 0)
6953 *proc_encode_coding_system[new_outfd]
6954 = *proc_encode_coding_system[old_outfd];
6955 memset (proc_encode_coding_system[old_outfd], 0,
6956 sizeof (struct coding_system));
6958 else
6959 setup_coding_system (p->encode_coding_system,
6960 proc_encode_coding_system[new_outfd]);
6962 return process;
6965 /* The main Emacs thread records child processes in three places:
6967 - Vprocess_alist, for asynchronous subprocesses, which are child
6968 processes visible to Lisp.
6970 - deleted_pid_list, for child processes invisible to Lisp,
6971 typically because of delete-process. These are recorded so that
6972 the processes can be reaped when they exit, so that the operating
6973 system's process table is not cluttered by zombies.
6975 - the local variable PID in Fcall_process, call_process_cleanup and
6976 call_process_kill, for synchronous subprocesses.
6977 record_unwind_protect is used to make sure this process is not
6978 forgotten: if the user interrupts call-process and the child
6979 process refuses to exit immediately even with two C-g's,
6980 call_process_kill adds PID's contents to deleted_pid_list before
6981 returning.
6983 The main Emacs thread invokes waitpid only on child processes that
6984 it creates and that have not been reaped. This avoid races on
6985 platforms such as GTK, where other threads create their own
6986 subprocesses which the main thread should not reap. For example,
6987 if the main thread attempted to reap an already-reaped child, it
6988 might inadvertently reap a GTK-created process that happened to
6989 have the same process ID. */
6991 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6992 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6993 keep track of its own children. GNUstep is similar. */
6995 static void dummy_handler (int sig) {}
6996 static signal_handler_t volatile lib_child_handler;
6998 /* Handle a SIGCHLD signal by looking for known child processes of
6999 Emacs whose status have changed. For each one found, record its
7000 new status.
7002 All we do is change the status; we do not run sentinels or print
7003 notifications. That is saved for the next time keyboard input is
7004 done, in order to avoid timing errors.
7006 ** WARNING: this can be called during garbage collection.
7007 Therefore, it must not be fooled by the presence of mark bits in
7008 Lisp objects.
7010 ** USG WARNING: Although it is not obvious from the documentation
7011 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7012 signal() before executing at least one wait(), otherwise the
7013 handler will be called again, resulting in an infinite loop. The
7014 relevant portion of the documentation reads "SIGCLD signals will be
7015 queued and the signal-catching function will be continually
7016 reentered until the queue is empty". Invoking signal() causes the
7017 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7018 Inc.
7020 ** Malloc WARNING: This should never call malloc either directly or
7021 indirectly; if it does, that is a bug. */
7023 static void
7024 handle_child_signal (int sig)
7026 Lisp_Object tail, proc;
7028 /* Find the process that signaled us, and record its status. */
7030 /* The process can have been deleted by Fdelete_process, or have
7031 been started asynchronously by Fcall_process. */
7032 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7034 bool all_pids_are_fixnums
7035 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7036 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7037 Lisp_Object head = XCAR (tail);
7038 Lisp_Object xpid;
7039 if (! CONSP (head))
7040 continue;
7041 xpid = XCAR (head);
7042 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
7044 pid_t deleted_pid;
7045 if (INTEGERP (xpid))
7046 deleted_pid = XINT (xpid);
7047 else
7048 deleted_pid = XFLOAT_DATA (xpid);
7049 if (child_status_changed (deleted_pid, 0, 0))
7051 if (STRINGP (XCDR (head)))
7052 unlink (SSDATA (XCDR (head)));
7053 XSETCAR (tail, Qnil);
7058 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7059 FOR_EACH_PROCESS (tail, proc)
7061 struct Lisp_Process *p = XPROCESS (proc);
7062 int status;
7064 if (p->alive
7065 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7067 /* Change the status of the process that was found. */
7068 p->tick = ++process_tick;
7069 p->raw_status = status;
7070 p->raw_status_new = 1;
7072 /* If process has terminated, stop waiting for its output. */
7073 if (WIFSIGNALED (status) || WIFEXITED (status))
7075 bool clear_desc_flag = 0;
7076 p->alive = 0;
7077 if (p->infd >= 0)
7078 clear_desc_flag = 1;
7080 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7081 if (clear_desc_flag)
7082 delete_read_fd (p->infd);
7087 lib_child_handler (sig);
7088 #ifdef NS_IMPL_GNUSTEP
7089 /* NSTask in GNUstep sets its child handler each time it is called.
7090 So we must re-set ours. */
7091 catch_child_signal ();
7092 #endif
7095 static void
7096 deliver_child_signal (int sig)
7098 deliver_process_signal (sig, handle_child_signal);
7102 static Lisp_Object
7103 exec_sentinel_error_handler (Lisp_Object 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 /* Defined in msdos.c. */
7455 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7456 struct timespec *, void *);
7458 /* Implementation of wait_reading_process_output, assuming that there
7459 are no subprocesses. Used only by the MS-DOS build.
7461 Wait for timeout to elapse and/or keyboard input to be available.
7463 TIME_LIMIT is:
7464 timeout in seconds
7465 If negative, gobble data immediately available but don't wait for any.
7467 NSECS is:
7468 an additional duration to wait, measured in nanoseconds
7469 If TIME_LIMIT is zero, then:
7470 If NSECS == 0, there is no limit.
7471 If NSECS > 0, the timeout consists of NSECS only.
7472 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7474 READ_KBD is:
7475 0 to ignore keyboard input, or
7476 1 to return when input is available, or
7477 -1 means caller will actually read the input, so don't throw to
7478 the quit handler.
7480 see full version for other parameters. We know that wait_proc will
7481 always be NULL, since `subprocesses' isn't defined.
7483 DO_DISPLAY means redisplay should be done to show subprocess
7484 output that arrives.
7486 Return -1 signifying we got no output and did not try. */
7489 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7490 bool do_display,
7491 Lisp_Object wait_for_cell,
7492 struct Lisp_Process *wait_proc, int just_wait_proc)
7494 register int nfds;
7495 struct timespec end_time, timeout;
7496 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
7498 if (TYPE_MAXIMUM (time_t) < time_limit)
7499 time_limit = TYPE_MAXIMUM (time_t);
7501 if (time_limit < 0 || nsecs < 0)
7502 wait = MINIMUM;
7503 else if (time_limit > 0 || nsecs > 0)
7505 wait = TIMEOUT;
7506 end_time = timespec_add (current_timespec (),
7507 make_timespec (time_limit, nsecs));
7509 else
7510 wait = INFINITY;
7512 /* Turn off periodic alarms (in case they are in use)
7513 and then turn off any other atimers,
7514 because the select emulator uses alarms. */
7515 stop_polling ();
7516 turn_on_atimers (0);
7518 while (1)
7520 bool timeout_reduced_for_timers = false;
7521 fd_set waitchannels;
7522 int xerrno;
7524 /* If calling from keyboard input, do not quit
7525 since we want to return C-g as an input character.
7526 Otherwise, do pending quit if requested. */
7527 if (read_kbd >= 0)
7528 maybe_quit ();
7530 /* Exit now if the cell we're waiting for became non-nil. */
7531 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7532 break;
7534 /* Compute time from now till when time limit is up. */
7535 /* Exit if already run out. */
7536 if (wait == TIMEOUT)
7538 struct timespec now = current_timespec ();
7539 if (timespec_cmp (end_time, now) <= 0)
7540 break;
7541 timeout = timespec_sub (end_time, now);
7543 else
7544 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7546 /* If our caller will not immediately handle keyboard events,
7547 run timer events directly.
7548 (Callers that will immediately read keyboard events
7549 call timer_delay on their own.) */
7550 if (NILP (wait_for_cell))
7552 struct timespec timer_delay;
7556 unsigned old_timers_run = timers_run;
7557 timer_delay = timer_check ();
7558 if (timers_run != old_timers_run && do_display)
7559 /* We must retry, since a timer may have requeued itself
7560 and that could alter the time delay. */
7561 redisplay_preserve_echo_area (14);
7562 else
7563 break;
7565 while (!detect_input_pending ());
7567 /* If there is unread keyboard input, also return. */
7568 if (read_kbd != 0
7569 && requeued_events_pending_p ())
7570 break;
7572 if (timespec_valid_p (timer_delay))
7574 if (timespec_cmp (timer_delay, timeout) < 0)
7576 timeout = timer_delay;
7577 timeout_reduced_for_timers = true;
7582 /* Cause C-g and alarm signals to take immediate action,
7583 and cause input available signals to zero out timeout. */
7584 if (read_kbd < 0)
7585 set_waiting_for_input (&timeout);
7587 /* If a frame has been newly mapped and needs updating,
7588 reprocess its display stuff. */
7589 if (frame_garbaged && do_display)
7591 clear_waiting_for_input ();
7592 redisplay_preserve_echo_area (15);
7593 if (read_kbd < 0)
7594 set_waiting_for_input (&timeout);
7597 /* Wait till there is something to do. */
7598 FD_ZERO (&waitchannels);
7599 if (read_kbd && detect_input_pending ())
7600 nfds = 0;
7601 else
7603 if (read_kbd || !NILP (wait_for_cell))
7604 FD_SET (0, &waitchannels);
7605 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
7608 xerrno = errno;
7610 /* Make C-g and alarm signals set flags again. */
7611 clear_waiting_for_input ();
7613 /* If we woke up due to SIGWINCH, actually change size now. */
7614 do_pending_window_change (0);
7616 if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
7617 /* We waited the full specified time, so return now. */
7618 break;
7620 if (nfds == -1)
7622 /* If the system call was interrupted, then go around the
7623 loop again. */
7624 if (xerrno == EINTR)
7625 FD_ZERO (&waitchannels);
7626 else
7627 report_file_errno ("Failed select", Qnil, xerrno);
7630 /* Check for keyboard input. */
7632 if (read_kbd
7633 && detect_input_pending_run_timers (do_display))
7635 swallow_events (do_display);
7636 if (detect_input_pending_run_timers (do_display))
7637 break;
7640 /* If there is unread keyboard input, also return. */
7641 if (read_kbd
7642 && requeued_events_pending_p ())
7643 break;
7645 /* If wait_for_cell. check for keyboard input
7646 but don't run any timers.
7647 ??? (It seems wrong to me to check for keyboard
7648 input at all when wait_for_cell, but the code
7649 has been this way since July 1994.
7650 Try changing this after version 19.31.) */
7651 if (! NILP (wait_for_cell)
7652 && detect_input_pending ())
7654 swallow_events (do_display);
7655 if (detect_input_pending ())
7656 break;
7659 /* Exit now if the cell we're waiting for became non-nil. */
7660 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7661 break;
7664 start_polling ();
7666 return -1;
7669 #endif /* not subprocesses */
7671 /* The following functions are needed even if async subprocesses are
7672 not supported. Some of them are no-op stubs in that case. */
7674 #ifdef HAVE_TIMERFD
7676 /* Add FD, which is a descriptor returned by timerfd_create,
7677 to the set of non-keyboard input descriptors. */
7679 void
7680 add_timer_wait_descriptor (int fd)
7682 add_read_fd (fd, timerfd_callback, NULL);
7683 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
7686 #endif /* HAVE_TIMERFD */
7688 /* If program file NAME starts with /: for quoting a magic
7689 name, remove that, preserving the multibyteness of NAME. */
7691 Lisp_Object
7692 remove_slash_colon (Lisp_Object name)
7694 return
7695 ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
7696 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
7697 SBYTES (name) - 2, STRING_MULTIBYTE (name))
7698 : name);
7701 /* Add DESC to the set of keyboard input descriptors. */
7703 void
7704 add_keyboard_wait_descriptor (int desc)
7706 #ifdef subprocesses /* Actually means "not MSDOS". */
7707 eassert (desc >= 0 && desc < FD_SETSIZE);
7708 fd_callback_info[desc].flags &= ~PROCESS_FD;
7709 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
7710 if (desc > max_desc)
7711 max_desc = desc;
7712 #endif
7715 /* From now on, do not expect DESC to give keyboard input. */
7717 void
7718 delete_keyboard_wait_descriptor (int desc)
7720 #ifdef subprocesses
7721 eassert (desc >= 0 && desc < FD_SETSIZE);
7723 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
7725 if (desc == max_desc)
7726 recompute_max_desc ();
7727 #endif
7730 /* Setup coding systems of PROCESS. */
7732 void
7733 setup_process_coding_systems (Lisp_Object process)
7735 #ifdef subprocesses
7736 struct Lisp_Process *p = XPROCESS (process);
7737 int inch = p->infd;
7738 int outch = p->outfd;
7739 Lisp_Object coding_system;
7741 if (inch < 0 || outch < 0)
7742 return;
7744 if (!proc_decode_coding_system[inch])
7745 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
7746 coding_system = p->decode_coding_system;
7747 if (EQ (p->filter, Qinternal_default_process_filter)
7748 && BUFFERP (p->buffer))
7750 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
7751 coding_system = raw_text_coding_system (coding_system);
7753 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7755 if (!proc_encode_coding_system[outch])
7756 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
7757 setup_coding_system (p->encode_coding_system,
7758 proc_encode_coding_system[outch]);
7759 #endif
7762 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7763 doc: /* Return the (or a) live process associated with BUFFER.
7764 BUFFER may be a buffer or the name of one.
7765 Return nil if all processes associated with BUFFER have been
7766 deleted or killed. */)
7767 (register Lisp_Object buffer)
7769 #ifdef subprocesses
7770 register Lisp_Object buf, tail, proc;
7772 if (NILP (buffer)) return Qnil;
7773 buf = Fget_buffer (buffer);
7774 if (NILP (buf)) return Qnil;
7776 FOR_EACH_PROCESS (tail, proc)
7777 if (EQ (XPROCESS (proc)->buffer, buf))
7778 return proc;
7779 #endif /* subprocesses */
7780 return Qnil;
7783 DEFUN ("process-inherit-coding-system-flag",
7784 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7785 1, 1, 0,
7786 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7787 If this flag is t, `buffer-file-coding-system' of the buffer
7788 associated with PROCESS will inherit the coding system used to decode
7789 the process output. */)
7790 (register Lisp_Object process)
7792 #ifdef subprocesses
7793 CHECK_PROCESS (process);
7794 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7795 #else
7796 /* Ignore the argument and return the value of
7797 inherit-process-coding-system. */
7798 return inherit_process_coding_system ? Qt : Qnil;
7799 #endif
7802 /* Kill all processes associated with `buffer'.
7803 If `buffer' is nil, kill all processes. */
7805 void
7806 kill_buffer_processes (Lisp_Object buffer)
7808 #ifdef subprocesses
7809 Lisp_Object tail, proc;
7811 FOR_EACH_PROCESS (tail, proc)
7812 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
7814 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
7815 Fdelete_process (proc);
7816 else if (XPROCESS (proc)->infd >= 0)
7817 process_send_signal (proc, SIGHUP, Qnil, 1);
7819 #else /* subprocesses */
7820 /* Since we have no subprocesses, this does nothing. */
7821 #endif /* subprocesses */
7824 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
7825 Swaiting_for_user_input_p, 0, 0, 0,
7826 doc: /* Return non-nil if Emacs is waiting for input from the user.
7827 This is intended for use by asynchronous process output filters and sentinels. */)
7828 (void)
7830 #ifdef subprocesses
7831 return (waiting_for_user_input_p ? Qt : Qnil);
7832 #else
7833 return Qnil;
7834 #endif
7837 /* Stop reading input from keyboard sources. */
7839 void
7840 hold_keyboard_input (void)
7842 kbd_is_on_hold = 1;
7845 /* Resume reading input from keyboard sources. */
7847 void
7848 unhold_keyboard_input (void)
7850 kbd_is_on_hold = 0;
7853 /* Return true if keyboard input is on hold, zero otherwise. */
7855 bool
7856 kbd_on_hold_p (void)
7858 return kbd_is_on_hold;
7862 /* Enumeration of and access to system processes a-la ps(1). */
7864 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7865 0, 0, 0,
7866 doc: /* Return a list of numerical process IDs of all running processes.
7867 If this functionality is unsupported, return nil.
7869 See `process-attributes' for getting attributes of a process given its ID. */)
7870 (void)
7872 return list_system_processes ();
7875 DEFUN ("process-attributes", Fprocess_attributes,
7876 Sprocess_attributes, 1, 1, 0,
7877 doc: /* Return attributes of the process given by its PID, a number.
7879 Value is an alist where each element is a cons cell of the form
7881 (KEY . VALUE)
7883 If this functionality is unsupported, the value is nil.
7885 See `list-system-processes' for getting a list of all process IDs.
7887 The KEYs of the attributes that this function may return are listed
7888 below, together with the type of the associated VALUE (in parentheses).
7889 Not all platforms support all of these attributes; unsupported
7890 attributes will not appear in the returned alist.
7891 Unless explicitly indicated otherwise, numbers can have either
7892 integer or floating point values.
7894 euid -- Effective user User ID of the process (number)
7895 user -- User name corresponding to euid (string)
7896 egid -- Effective user Group ID of the process (number)
7897 group -- Group name corresponding to egid (string)
7898 comm -- Command name (executable name only) (string)
7899 state -- Process state code, such as "S", "R", or "T" (string)
7900 ppid -- Parent process ID (number)
7901 pgrp -- Process group ID (number)
7902 sess -- Session ID, i.e. process ID of session leader (number)
7903 ttname -- Controlling tty name (string)
7904 tpgid -- ID of foreground process group on the process's tty (number)
7905 minflt -- number of minor page faults (number)
7906 majflt -- number of major page faults (number)
7907 cminflt -- cumulative number of minor page faults (number)
7908 cmajflt -- cumulative number of major page faults (number)
7909 utime -- user time used by the process, in (current-time) format,
7910 which is a list of integers (HIGH LOW USEC PSEC)
7911 stime -- system time used by the process (current-time)
7912 time -- sum of utime and stime (current-time)
7913 cutime -- user time used by the process and its children (current-time)
7914 cstime -- system time used by the process and its children (current-time)
7915 ctime -- sum of cutime and cstime (current-time)
7916 pri -- priority of the process (number)
7917 nice -- nice value of the process (number)
7918 thcount -- process thread count (number)
7919 start -- time the process started (current-time)
7920 vsize -- virtual memory size of the process in KB's (number)
7921 rss -- resident set size of the process in KB's (number)
7922 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7923 pcpu -- percents of CPU time used by the process (floating-point number)
7924 pmem -- percents of total physical memory used by process's resident set
7925 (floating-point number)
7926 args -- command line which invoked the process (string). */)
7927 ( Lisp_Object pid)
7929 return system_process_attributes (pid);
7932 #ifdef subprocesses
7933 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7934 Invoke this after init_process_emacs, and after glib and/or GNUstep
7935 futz with the SIGCHLD handler, but before Emacs forks any children.
7936 This function's caller should block SIGCHLD. */
7938 void
7939 catch_child_signal (void)
7941 struct sigaction action, old_action;
7942 sigset_t oldset;
7943 emacs_sigaction_init (&action, deliver_child_signal);
7944 block_child_signal (&oldset);
7945 sigaction (SIGCHLD, &action, &old_action);
7946 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7947 || ! (old_action.sa_flags & SA_SIGINFO));
7949 if (old_action.sa_handler != deliver_child_signal)
7950 lib_child_handler
7951 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7952 ? dummy_handler
7953 : old_action.sa_handler);
7954 unblock_child_signal (&oldset);
7956 #endif /* subprocesses */
7958 /* Limit the number of open files to the value it had at startup. */
7960 void
7961 restore_nofile_limit (void)
7963 #ifdef HAVE_SETRLIMIT
7964 if (FD_SETSIZE < nofile_limit.rlim_cur)
7965 setrlimit (RLIMIT_NOFILE, &nofile_limit);
7966 #endif
7970 /* This is not called "init_process" because that is the name of a
7971 Mach system call, so it would cause problems on Darwin systems. */
7972 void
7973 init_process_emacs (int sockfd)
7975 #ifdef subprocesses
7976 int i;
7978 inhibit_sentinels = 0;
7980 #ifndef CANNOT_DUMP
7981 if (! noninteractive || initialized)
7982 #endif
7984 #if defined HAVE_GLIB && !defined WINDOWSNT
7985 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7986 this should always fail, but is enough to initialize glib's
7987 private SIGCHLD handler, allowing catch_child_signal to copy
7988 it into lib_child_handler. */
7989 g_source_unref (g_child_watch_source_new (getpid ()));
7990 #endif
7991 catch_child_signal ();
7994 #ifdef HAVE_SETRLIMIT
7995 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
7996 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
7997 nofile_limit.rlim_cur = 0;
7998 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8000 struct rlimit rlim = nofile_limit;
8001 rlim.rlim_cur = FD_SETSIZE;
8002 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8003 nofile_limit.rlim_cur = 0;
8005 #endif
8007 external_sock_fd = sockfd;
8008 max_desc = -1;
8009 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8011 num_pending_connects = 0;
8013 process_output_delay_count = 0;
8014 process_output_skip = 0;
8016 /* Don't do this, it caused infinite select loops. The display
8017 method should call add_keyboard_wait_descriptor on stdin if it
8018 needs that. */
8019 #if 0
8020 FD_SET (0, &input_wait_mask);
8021 #endif
8023 Vprocess_alist = Qnil;
8024 deleted_pid_list = Qnil;
8025 for (i = 0; i < FD_SETSIZE; i++)
8027 chan_process[i] = Qnil;
8028 proc_buffered_char[i] = -1;
8030 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8031 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8032 #ifdef DATAGRAM_SOCKETS
8033 memset (datagram_address, 0, sizeof datagram_address);
8034 #endif
8036 #if defined (DARWIN_OS)
8037 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8038 processes. As such, we only change the default value. */
8039 if (initialized)
8041 char const *release = (STRINGP (Voperating_system_release)
8042 ? SSDATA (Voperating_system_release)
8043 : 0);
8044 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
8045 Vprocess_connection_type = Qnil;
8048 #endif
8049 #endif /* subprocesses */
8050 kbd_is_on_hold = 0;
8053 void
8054 syms_of_process (void)
8056 #ifdef subprocesses
8058 DEFSYM (Qprocessp, "processp");
8059 DEFSYM (Qrun, "run");
8060 DEFSYM (Qstop, "stop");
8061 DEFSYM (Qsignal, "signal");
8063 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8064 here again. */
8066 DEFSYM (Qopen, "open");
8067 DEFSYM (Qclosed, "closed");
8068 DEFSYM (Qconnect, "connect");
8069 DEFSYM (Qfailed, "failed");
8070 DEFSYM (Qlisten, "listen");
8071 DEFSYM (Qlocal, "local");
8072 DEFSYM (Qipv4, "ipv4");
8073 #ifdef AF_INET6
8074 DEFSYM (Qipv6, "ipv6");
8075 #endif
8076 DEFSYM (Qdatagram, "datagram");
8077 DEFSYM (Qseqpacket, "seqpacket");
8079 DEFSYM (QCport, ":port");
8080 DEFSYM (QCspeed, ":speed");
8081 DEFSYM (QCprocess, ":process");
8083 DEFSYM (QCbytesize, ":bytesize");
8084 DEFSYM (QCstopbits, ":stopbits");
8085 DEFSYM (QCparity, ":parity");
8086 DEFSYM (Qodd, "odd");
8087 DEFSYM (Qeven, "even");
8088 DEFSYM (QCflowcontrol, ":flowcontrol");
8089 DEFSYM (Qhw, "hw");
8090 DEFSYM (Qsw, "sw");
8091 DEFSYM (QCsummary, ":summary");
8093 DEFSYM (Qreal, "real");
8094 DEFSYM (Qnetwork, "network");
8095 DEFSYM (Qserial, "serial");
8096 DEFSYM (Qpipe, "pipe");
8097 DEFSYM (QCbuffer, ":buffer");
8098 DEFSYM (QChost, ":host");
8099 DEFSYM (QCservice, ":service");
8100 DEFSYM (QClocal, ":local");
8101 DEFSYM (QCremote, ":remote");
8102 DEFSYM (QCcoding, ":coding");
8103 DEFSYM (QCserver, ":server");
8104 DEFSYM (QCnowait, ":nowait");
8105 DEFSYM (QCsentinel, ":sentinel");
8106 DEFSYM (QCuse_external_socket, ":use-external-socket");
8107 DEFSYM (QCtls_parameters, ":tls-parameters");
8108 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8109 DEFSYM (QClog, ":log");
8110 DEFSYM (QCnoquery, ":noquery");
8111 DEFSYM (QCstop, ":stop");
8112 DEFSYM (QCplist, ":plist");
8113 DEFSYM (QCcommand, ":command");
8114 DEFSYM (QCconnection_type, ":connection-type");
8115 DEFSYM (QCstderr, ":stderr");
8116 DEFSYM (Qpty, "pty");
8117 DEFSYM (Qpipe, "pipe");
8119 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8121 staticpro (&Vprocess_alist);
8122 staticpro (&deleted_pid_list);
8124 #endif /* subprocesses */
8126 DEFSYM (QCname, ":name");
8127 DEFSYM (QCtype, ":type");
8129 DEFSYM (Qeuid, "euid");
8130 DEFSYM (Qegid, "egid");
8131 DEFSYM (Quser, "user");
8132 DEFSYM (Qgroup, "group");
8133 DEFSYM (Qcomm, "comm");
8134 DEFSYM (Qstate, "state");
8135 DEFSYM (Qppid, "ppid");
8136 DEFSYM (Qpgrp, "pgrp");
8137 DEFSYM (Qsess, "sess");
8138 DEFSYM (Qttname, "ttname");
8139 DEFSYM (Qtpgid, "tpgid");
8140 DEFSYM (Qminflt, "minflt");
8141 DEFSYM (Qmajflt, "majflt");
8142 DEFSYM (Qcminflt, "cminflt");
8143 DEFSYM (Qcmajflt, "cmajflt");
8144 DEFSYM (Qutime, "utime");
8145 DEFSYM (Qstime, "stime");
8146 DEFSYM (Qtime, "time");
8147 DEFSYM (Qcutime, "cutime");
8148 DEFSYM (Qcstime, "cstime");
8149 DEFSYM (Qctime, "ctime");
8150 #ifdef subprocesses
8151 DEFSYM (Qinternal_default_process_sentinel,
8152 "internal-default-process-sentinel");
8153 DEFSYM (Qinternal_default_process_filter,
8154 "internal-default-process-filter");
8155 #endif
8156 DEFSYM (Qpri, "pri");
8157 DEFSYM (Qnice, "nice");
8158 DEFSYM (Qthcount, "thcount");
8159 DEFSYM (Qstart, "start");
8160 DEFSYM (Qvsize, "vsize");
8161 DEFSYM (Qrss, "rss");
8162 DEFSYM (Qetime, "etime");
8163 DEFSYM (Qpcpu, "pcpu");
8164 DEFSYM (Qpmem, "pmem");
8165 DEFSYM (Qargs, "args");
8167 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8168 doc: /* Non-nil means delete processes immediately when they exit.
8169 A value of nil means don't delete them until `list-processes' is run. */);
8171 delete_exited_processes = 1;
8173 #ifdef subprocesses
8174 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8175 doc: /* Control type of device used to communicate with subprocesses.
8176 Values are nil to use a pipe, or t or `pty' to use a pty.
8177 The value has no effect if the system has no ptys or if all ptys are busy:
8178 then a pipe is used in any case.
8179 The value takes effect when `start-process' is called. */);
8180 Vprocess_connection_type = Qt;
8182 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8183 doc: /* If non-nil, improve receive buffering by delaying after short reads.
8184 On some systems, when Emacs reads the output from a subprocess, the output data
8185 is read in very small blocks, potentially resulting in very poor performance.
8186 This behavior can be remedied to some extent by setting this variable to a
8187 non-nil value, as it will automatically delay reading from such processes, to
8188 allow them to produce more output before Emacs tries to read it.
8189 If the value is t, the delay is reset after each write to the process; any other
8190 non-nil value means that the delay is not reset on write.
8191 The variable takes effect when `start-process' is called. */);
8192 Vprocess_adaptive_read_buffering = Qt;
8194 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8195 doc: /* List of functions to be called for `interrupt-process'.
8196 The arguments of the functions are the same as for `interrupt-process'.
8197 These functions are called in the order of the list, until one of them
8198 returns non-`nil'. */);
8199 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8201 DEFSYM (Qinternal_default_interrupt_process,
8202 "internal-default-interrupt-process");
8203 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8205 defsubr (&Sprocessp);
8206 defsubr (&Sget_process);
8207 defsubr (&Sdelete_process);
8208 defsubr (&Sprocess_status);
8209 defsubr (&Sprocess_exit_status);
8210 defsubr (&Sprocess_id);
8211 defsubr (&Sprocess_name);
8212 defsubr (&Sprocess_tty_name);
8213 defsubr (&Sprocess_command);
8214 defsubr (&Sset_process_buffer);
8215 defsubr (&Sprocess_buffer);
8216 defsubr (&Sprocess_mark);
8217 defsubr (&Sset_process_filter);
8218 defsubr (&Sprocess_filter);
8219 defsubr (&Sset_process_sentinel);
8220 defsubr (&Sprocess_sentinel);
8221 defsubr (&Sset_process_thread);
8222 defsubr (&Sprocess_thread);
8223 defsubr (&Sset_process_window_size);
8224 defsubr (&Sset_process_inherit_coding_system_flag);
8225 defsubr (&Sset_process_query_on_exit_flag);
8226 defsubr (&Sprocess_query_on_exit_flag);
8227 defsubr (&Sprocess_contact);
8228 defsubr (&Sprocess_plist);
8229 defsubr (&Sset_process_plist);
8230 defsubr (&Sprocess_list);
8231 defsubr (&Smake_process);
8232 defsubr (&Smake_pipe_process);
8233 defsubr (&Sserial_process_configure);
8234 defsubr (&Smake_serial_process);
8235 defsubr (&Sset_network_process_option);
8236 defsubr (&Smake_network_process);
8237 defsubr (&Sformat_network_address);
8238 defsubr (&Snetwork_interface_list);
8239 defsubr (&Snetwork_interface_info);
8240 #ifdef DATAGRAM_SOCKETS
8241 defsubr (&Sprocess_datagram_address);
8242 defsubr (&Sset_process_datagram_address);
8243 #endif
8244 defsubr (&Saccept_process_output);
8245 defsubr (&Sprocess_send_region);
8246 defsubr (&Sprocess_send_string);
8247 defsubr (&Sinternal_default_interrupt_process);
8248 defsubr (&Sinterrupt_process);
8249 defsubr (&Skill_process);
8250 defsubr (&Squit_process);
8251 defsubr (&Sstop_process);
8252 defsubr (&Scontinue_process);
8253 defsubr (&Sprocess_running_child_p);
8254 defsubr (&Sprocess_send_eof);
8255 defsubr (&Ssignal_process);
8256 defsubr (&Swaiting_for_user_input_p);
8257 defsubr (&Sprocess_type);
8258 defsubr (&Sinternal_default_process_sentinel);
8259 defsubr (&Sinternal_default_process_filter);
8260 defsubr (&Sset_process_coding_system);
8261 defsubr (&Sprocess_coding_system);
8262 defsubr (&Sset_process_filter_multibyte);
8263 defsubr (&Sprocess_filter_multibyte_p);
8266 Lisp_Object subfeatures = Qnil;
8267 const struct socket_options *sopt;
8269 #define ADD_SUBFEATURE(key, val) \
8270 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8272 ADD_SUBFEATURE (QCnowait, Qt);
8273 #ifdef DATAGRAM_SOCKETS
8274 ADD_SUBFEATURE (QCtype, Qdatagram);
8275 #endif
8276 #ifdef HAVE_SEQPACKET
8277 ADD_SUBFEATURE (QCtype, Qseqpacket);
8278 #endif
8279 #ifdef HAVE_LOCAL_SOCKETS
8280 ADD_SUBFEATURE (QCfamily, Qlocal);
8281 #endif
8282 ADD_SUBFEATURE (QCfamily, Qipv4);
8283 #ifdef AF_INET6
8284 ADD_SUBFEATURE (QCfamily, Qipv6);
8285 #endif
8286 #ifdef HAVE_GETSOCKNAME
8287 ADD_SUBFEATURE (QCservice, Qt);
8288 #endif
8289 ADD_SUBFEATURE (QCserver, Qt);
8291 for (sopt = socket_options; sopt->name; sopt++)
8292 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8294 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8297 #endif /* subprocesses */
8299 defsubr (&Sget_buffer_process);
8300 defsubr (&Sprocess_inherit_coding_system_flag);
8301 defsubr (&Slist_system_processes);
8302 defsubr (&Sprocess_attributes);