More fixes in the Emacs manual
[emacs.git] / src / process.c
blob8a438cfeb8be72e88df892f92f1da9abada9b35e
1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2018 Free Software
4 Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
22 #include <config.h>
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <errno.h>
27 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
28 #include <sys/file.h>
29 #include <sys/stat.h>
30 #include <unistd.h>
31 #include <fcntl.h>
33 #include "lisp.h"
35 /* Only MS-DOS does not define `subprocesses'. */
36 #ifdef subprocesses
38 #include <sys/socket.h>
39 #include <netdb.h>
40 #include <netinet/in.h>
41 #include <arpa/inet.h>
43 #endif /* subprocesses */
45 #ifdef HAVE_SETRLIMIT
46 # include <sys/resource.h>
48 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
49 NOFILE_LIMIT is the initial limit on the number of open files,
50 which should be restored in child processes. */
51 static struct rlimit nofile_limit;
52 #endif
54 #ifdef subprocesses
56 /* Are local (unix) sockets supported? */
57 #if defined (HAVE_SYS_UN_H)
58 #if !defined (AF_LOCAL) && defined (AF_UNIX)
59 #define AF_LOCAL AF_UNIX
60 #endif
61 #ifdef AF_LOCAL
62 #define HAVE_LOCAL_SOCKETS
63 #include <sys/un.h>
64 #endif
65 #endif
67 #include <sys/ioctl.h>
68 #if defined (HAVE_NET_IF_H)
69 #include <net/if.h>
70 #endif /* HAVE_NET_IF_H */
72 #if defined (HAVE_IFADDRS_H)
73 /* Must be after net/if.h */
74 #include <ifaddrs.h>
76 /* We only use structs from this header when we use getifaddrs. */
77 #if defined (HAVE_NET_IF_DL_H)
78 #include <net/if_dl.h>
79 #endif
81 #endif
83 #ifdef NEED_BSDTTY
84 #include <bsdtty.h>
85 #endif
87 #ifdef USG5_4
88 # include <sys/stream.h>
89 # include <sys/stropts.h>
90 #endif
92 #ifdef HAVE_UTIL_H
93 #include <util.h>
94 #endif
96 #ifdef HAVE_PTY_H
97 #include <pty.h>
98 #endif
100 #include <c-ctype.h>
101 #include <flexmember.h>
102 #include <sig2str.h>
103 #include <verify.h>
105 #endif /* subprocesses */
107 #include "systime.h"
108 #include "systty.h"
110 #include "window.h"
111 #include "character.h"
112 #include "buffer.h"
113 #include "coding.h"
114 #include "process.h"
115 #include "frame.h"
116 #include "termopts.h"
117 #include "keyboard.h"
118 #include "blockinput.h"
119 #include "atimer.h"
120 #include "sysselect.h"
121 #include "syssignal.h"
122 #include "syswait.h"
123 #ifdef HAVE_GNUTLS
124 #include "gnutls.h"
125 #endif
127 #ifdef HAVE_WINDOW_SYSTEM
128 #include TERM_HEADER
129 #endif /* HAVE_WINDOW_SYSTEM */
131 #ifdef HAVE_GLIB
132 #include "xgselect.h"
133 #ifndef WINDOWSNT
134 #include <glib.h>
135 #endif
136 #endif
138 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
139 /* This is 0.1s in nanoseconds. */
140 #define ASYNC_RETRY_NSEC 100000000
141 #endif
143 #ifdef WINDOWSNT
144 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
145 const struct timespec *, const sigset_t *);
146 #endif
148 /* Work around GCC 4.3.0 bug with strict overflow checking; see
149 <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
150 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
151 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
152 # pragma GCC diagnostic ignored "-Wstrict-overflow"
153 #endif
155 /* True if keyboard input is on hold, zero otherwise. */
157 static bool kbd_is_on_hold;
159 /* Nonzero means don't run process sentinels. This is used
160 when exiting. */
161 bool inhibit_sentinels;
163 #ifdef subprocesses
165 #ifndef SOCK_CLOEXEC
166 # define SOCK_CLOEXEC 0
167 #endif
168 #ifndef SOCK_NONBLOCK
169 # define SOCK_NONBLOCK 0
170 #endif
172 /* True if ERRNUM represents an error where the system call would
173 block if a blocking variant were used. */
174 static bool
175 would_block (int errnum)
177 #ifdef EWOULDBLOCK
178 if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
179 return true;
180 #endif
181 return errnum == EAGAIN;
184 #ifndef HAVE_ACCEPT4
186 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
188 static int
189 close_on_exec (int fd)
191 if (0 <= fd)
192 fcntl (fd, F_SETFD, FD_CLOEXEC);
193 return fd;
196 # undef accept4
197 # define accept4(sockfd, addr, addrlen, flags) \
198 process_accept4 (sockfd, addr, addrlen, flags)
199 static int
200 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
202 return close_on_exec (accept (sockfd, addr, addrlen));
205 static int
206 process_socket (int domain, int type, int protocol)
208 return close_on_exec (socket (domain, type, protocol));
210 # undef socket
211 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
212 #endif
214 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
215 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
216 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
217 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
218 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
219 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
221 /* Number of events of change of status of a process. */
222 static EMACS_INT process_tick;
223 /* Number of events for which the user or sentinel has been notified. */
224 static EMACS_INT update_tick;
226 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
227 this system. We need to read full packets, so we need a
228 "non-destructive" select. So we require either native select,
229 or emulation of select using FIONREAD. */
231 #ifndef BROKEN_DATAGRAM_SOCKETS
232 # if defined HAVE_SELECT || defined USABLE_FIONREAD
233 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
234 # define DATAGRAM_SOCKETS
235 # endif
236 # endif
237 #endif
239 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
240 # define HAVE_SEQPACKET
241 #endif
243 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
244 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
245 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
247 /* Number of processes which have a non-zero read_output_delay,
248 and therefore might be delayed for adaptive read buffering. */
250 static int process_output_delay_count;
252 /* True if any process has non-nil read_output_skip. */
254 static bool process_output_skip;
256 static void start_process_unwind (Lisp_Object);
257 static void create_process (Lisp_Object, char **, Lisp_Object);
258 #ifdef USABLE_SIGIO
259 static bool keyboard_bit_set (fd_set *);
260 #endif
261 static void deactivate_process (Lisp_Object);
262 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
263 static int read_process_output (Lisp_Object, int);
264 static void create_pty (Lisp_Object);
265 static void exec_sentinel (Lisp_Object, Lisp_Object);
267 /* Number of bits set in connect_wait_mask. */
268 static int num_pending_connects;
270 /* The largest descriptor currently in use; -1 if none. */
271 static int max_desc;
273 /* Set the external socket descriptor for Emacs to use when
274 `make-network-process' is called with a non-nil
275 `:use-external-socket' option. The value should be either -1, or
276 the file descriptor of a socket that is already bound. */
277 static int external_sock_fd;
279 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
280 static Lisp_Object chan_process[FD_SETSIZE];
281 static void wait_for_socket_fds (Lisp_Object, char const *);
283 /* Alist of elements (NAME . PROCESS). */
284 static Lisp_Object Vprocess_alist;
286 /* Buffered-ahead input char from process, indexed by channel.
287 -1 means empty (no char is buffered).
288 Used on sys V where the only way to tell if there is any
289 output from the process is to read at least one char.
290 Always -1 on systems that support FIONREAD. */
292 static int proc_buffered_char[FD_SETSIZE];
294 /* Table of `struct coding-system' for each process. */
295 static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
296 static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
298 #ifdef DATAGRAM_SOCKETS
299 /* Table of `partner address' for datagram sockets. */
300 static struct sockaddr_and_len {
301 struct sockaddr *sa;
302 ptrdiff_t len;
303 } datagram_address[FD_SETSIZE];
304 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
305 #define DATAGRAM_CONN_P(proc) \
306 (PROCESSP (proc) && \
307 XPROCESS (proc)->infd >= 0 && \
308 datagram_address[XPROCESS (proc)->infd].sa != 0)
309 #else
310 #define DATAGRAM_CONN_P(proc) (0)
311 #endif
313 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
314 a `for' loop which iterates over processes from Vprocess_alist. */
316 #define FOR_EACH_PROCESS(list_var, proc_var) \
317 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
319 /* These setters are used only in this file, so they can be private. */
320 static void
321 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
323 p->buffer = val;
325 static void
326 pset_command (struct Lisp_Process *p, Lisp_Object val)
328 p->command = val;
330 static void
331 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
333 p->decode_coding_system = val;
335 static void
336 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
338 p->decoding_buf = val;
340 static void
341 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
343 p->encode_coding_system = val;
345 static void
346 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
348 p->encoding_buf = val;
350 static void
351 pset_filter (struct Lisp_Process *p, Lisp_Object val)
353 p->filter = NILP (val) ? Qinternal_default_process_filter : val;
355 static void
356 pset_log (struct Lisp_Process *p, Lisp_Object val)
358 p->log = val;
360 static void
361 pset_mark (struct Lisp_Process *p, Lisp_Object val)
363 p->mark = val;
365 static void
366 pset_thread (struct Lisp_Process *p, Lisp_Object val)
368 p->thread = val;
370 static void
371 pset_name (struct Lisp_Process *p, Lisp_Object val)
373 p->name = val;
375 static void
376 pset_plist (struct Lisp_Process *p, Lisp_Object val)
378 p->plist = val;
380 static void
381 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
383 p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
385 static void
386 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
388 p->tty_name = val;
390 static void
391 pset_type (struct Lisp_Process *p, Lisp_Object val)
393 p->type = val;
395 static void
396 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
398 p->write_queue = val;
400 static void
401 pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
403 p->stderrproc = val;
407 static Lisp_Object
408 make_lisp_proc (struct Lisp_Process *p)
410 return make_lisp_ptr (p, Lisp_Vectorlike);
413 enum fd_bits
415 /* Read from file descriptor. */
416 FOR_READ = 1,
417 /* Write to file descriptor. */
418 FOR_WRITE = 2,
419 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
420 set. */
421 KEYBOARD_FD = 4,
422 /* This descriptor refers to a process. */
423 PROCESS_FD = 8,
424 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
425 NON_BLOCKING_CONNECT_FD = 16
428 static struct fd_callback_data
430 fd_callback func;
431 void *data;
432 /* Flags from enum fd_bits. */
433 int flags;
434 /* If this fd is locked to a certain thread, this points to it.
435 Otherwise, this is NULL. If an fd is locked to a thread, then
436 only that thread is permitted to wait on it. */
437 struct thread_state *thread;
438 /* If this fd is currently being selected on by a thread, this
439 points to the thread. Otherwise it is NULL. */
440 struct thread_state *waiting_thread;
441 } fd_callback_info[FD_SETSIZE];
444 /* Add a file descriptor FD to be monitored for when read is possible.
445 When read is possible, call FUNC with argument DATA. */
447 void
448 add_read_fd (int fd, fd_callback func, void *data)
450 add_keyboard_wait_descriptor (fd);
452 fd_callback_info[fd].func = func;
453 fd_callback_info[fd].data = data;
456 static void
457 add_non_keyboard_read_fd (int fd)
459 eassert (fd >= 0 && fd < FD_SETSIZE);
460 eassert (fd_callback_info[fd].func == NULL);
462 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
463 fd_callback_info[fd].flags |= FOR_READ;
464 if (fd > max_desc)
465 max_desc = fd;
468 static void
469 add_process_read_fd (int fd)
471 add_non_keyboard_read_fd (fd);
472 fd_callback_info[fd].flags |= PROCESS_FD;
475 /* Stop monitoring file descriptor FD for when read is possible. */
477 void
478 delete_read_fd (int fd)
480 delete_keyboard_wait_descriptor (fd);
482 if (fd_callback_info[fd].flags == 0)
484 fd_callback_info[fd].func = 0;
485 fd_callback_info[fd].data = 0;
489 /* Add a file descriptor FD to be monitored for when write is possible.
490 When write is possible, call FUNC with argument DATA. */
492 void
493 add_write_fd (int fd, fd_callback func, void *data)
495 eassert (fd >= 0 && fd < FD_SETSIZE);
497 fd_callback_info[fd].func = func;
498 fd_callback_info[fd].data = data;
499 fd_callback_info[fd].flags |= FOR_WRITE;
500 if (fd > max_desc)
501 max_desc = fd;
504 static void
505 add_non_blocking_write_fd (int fd)
507 eassert (fd >= 0 && fd < FD_SETSIZE);
508 eassert (fd_callback_info[fd].func == NULL);
510 fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
511 if (fd > max_desc)
512 max_desc = fd;
513 ++num_pending_connects;
516 static void
517 recompute_max_desc (void)
519 int fd;
521 for (fd = max_desc; fd >= 0; --fd)
523 if (fd_callback_info[fd].flags != 0)
525 max_desc = fd;
526 break;
531 /* Stop monitoring file descriptor FD for when write is possible. */
533 void
534 delete_write_fd (int fd)
536 if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
538 if (--num_pending_connects < 0)
539 emacs_abort ();
541 fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
542 if (fd_callback_info[fd].flags == 0)
544 fd_callback_info[fd].func = 0;
545 fd_callback_info[fd].data = 0;
547 if (fd == max_desc)
548 recompute_max_desc ();
552 static void
553 compute_input_wait_mask (fd_set *mask)
555 int fd;
557 FD_ZERO (mask);
558 for (fd = 0; fd <= max_desc; ++fd)
560 if (fd_callback_info[fd].thread != NULL
561 && fd_callback_info[fd].thread != current_thread)
562 continue;
563 if (fd_callback_info[fd].waiting_thread != NULL
564 && fd_callback_info[fd].waiting_thread != current_thread)
565 continue;
566 if ((fd_callback_info[fd].flags & FOR_READ) != 0)
568 FD_SET (fd, mask);
569 fd_callback_info[fd].waiting_thread = current_thread;
574 static void
575 compute_non_process_wait_mask (fd_set *mask)
577 int fd;
579 FD_ZERO (mask);
580 for (fd = 0; fd <= max_desc; ++fd)
582 if (fd_callback_info[fd].thread != NULL
583 && fd_callback_info[fd].thread != current_thread)
584 continue;
585 if (fd_callback_info[fd].waiting_thread != NULL
586 && fd_callback_info[fd].waiting_thread != current_thread)
587 continue;
588 if ((fd_callback_info[fd].flags & FOR_READ) != 0
589 && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
591 FD_SET (fd, mask);
592 fd_callback_info[fd].waiting_thread = current_thread;
597 static void
598 compute_non_keyboard_wait_mask (fd_set *mask)
600 int fd;
602 FD_ZERO (mask);
603 for (fd = 0; fd <= max_desc; ++fd)
605 if (fd_callback_info[fd].thread != NULL
606 && fd_callback_info[fd].thread != current_thread)
607 continue;
608 if (fd_callback_info[fd].waiting_thread != NULL
609 && fd_callback_info[fd].waiting_thread != current_thread)
610 continue;
611 if ((fd_callback_info[fd].flags & FOR_READ) != 0
612 && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
614 FD_SET (fd, mask);
615 fd_callback_info[fd].waiting_thread = current_thread;
620 static void
621 compute_write_mask (fd_set *mask)
623 int fd;
625 FD_ZERO (mask);
626 for (fd = 0; fd <= max_desc; ++fd)
628 if (fd_callback_info[fd].thread != NULL
629 && fd_callback_info[fd].thread != current_thread)
630 continue;
631 if (fd_callback_info[fd].waiting_thread != NULL
632 && fd_callback_info[fd].waiting_thread != current_thread)
633 continue;
634 if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
636 FD_SET (fd, mask);
637 fd_callback_info[fd].waiting_thread = current_thread;
642 static void
643 clear_waiting_thread_info (void)
645 int fd;
647 for (fd = 0; fd <= max_desc; ++fd)
649 if (fd_callback_info[fd].waiting_thread == current_thread)
650 fd_callback_info[fd].waiting_thread = NULL;
655 /* Compute the Lisp form of the process status, p->status, from
656 the numeric status that was returned by `wait'. */
658 static Lisp_Object status_convert (int);
660 static void
661 update_status (struct Lisp_Process *p)
663 eassert (p->raw_status_new);
664 pset_status (p, status_convert (p->raw_status));
665 p->raw_status_new = 0;
668 /* Convert a process status word in Unix format to
669 the list that we use internally. */
671 static Lisp_Object
672 status_convert (int w)
674 if (WIFSTOPPED (w))
675 return Fcons (Qstop, Fcons (make_number (WSTOPSIG (w)), Qnil));
676 else if (WIFEXITED (w))
677 return Fcons (Qexit, Fcons (make_number (WEXITSTATUS (w)),
678 WCOREDUMP (w) ? Qt : Qnil));
679 else if (WIFSIGNALED (w))
680 return Fcons (Qsignal, Fcons (make_number (WTERMSIG (w)),
681 WCOREDUMP (w) ? Qt : Qnil));
682 else
683 return Qrun;
686 /* True if STATUS is that of a process attempting connection. */
688 static bool
689 connecting_status (Lisp_Object status)
691 return CONSP (status) && EQ (XCAR (status), Qconnect);
694 /* Given a status-list, extract the three pieces of information
695 and store them individually through the three pointers. */
697 static void
698 decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
699 bool *coredump)
701 Lisp_Object tem;
703 if (connecting_status (l))
704 l = XCAR (l);
706 if (SYMBOLP (l))
708 *symbol = l;
709 *code = make_number (0);
710 *coredump = 0;
712 else
714 *symbol = XCAR (l);
715 tem = XCDR (l);
716 *code = XCAR (tem);
717 tem = XCDR (tem);
718 *coredump = !NILP (tem);
722 /* Return a string describing a process status list. */
724 static Lisp_Object
725 status_message (struct Lisp_Process *p)
727 Lisp_Object status = p->status;
728 Lisp_Object symbol, code;
729 bool coredump;
730 Lisp_Object string;
732 decode_status (status, &symbol, &code, &coredump);
734 if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
736 char const *signame;
737 synchronize_system_messages_locale ();
738 signame = strsignal (XFASTINT (code));
739 if (signame == 0)
740 string = build_string ("unknown");
741 else
743 int c1, c2;
745 string = build_unibyte_string (signame);
746 if (! NILP (Vlocale_coding_system))
747 string = (code_convert_string_norecord
748 (string, Vlocale_coding_system, 0));
749 c1 = STRING_CHAR (SDATA (string));
750 c2 = downcase (c1);
751 if (c1 != c2)
752 Faset (string, make_number (0), make_number (c2));
754 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
755 return concat2 (string, suffix);
757 else if (EQ (symbol, Qexit))
759 if (NETCONN1_P (p))
760 return build_string (XFASTINT (code) == 0
761 ? "deleted\n"
762 : "connection broken by remote peer\n");
763 if (XFASTINT (code) == 0)
764 return build_string ("finished\n");
765 AUTO_STRING (prefix, "exited abnormally with code ");
766 string = Fnumber_to_string (code);
767 AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
768 return concat3 (prefix, string, suffix);
770 else if (EQ (symbol, Qfailed))
772 AUTO_STRING (format, "failed with code %s\n");
773 return CALLN (Fformat, format, code);
775 else
776 return Fcopy_sequence (Fsymbol_name (symbol));
779 enum { PTY_NAME_SIZE = 24 };
781 /* Open an available pty, returning a file descriptor.
782 Store into PTY_NAME the file name of the terminal corresponding to the pty.
783 Return -1 on failure. */
785 static int
786 allocate_pty (char pty_name[PTY_NAME_SIZE])
788 #ifdef HAVE_PTYS
789 int fd;
791 #ifdef PTY_ITERATION
792 PTY_ITERATION
793 #else
794 register int c, i;
795 for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
796 for (i = 0; i < 16; i++)
797 #endif
799 #ifdef PTY_NAME_SPRINTF
800 PTY_NAME_SPRINTF
801 #else
802 sprintf (pty_name, "/dev/pty%c%x", c, i);
803 #endif /* no PTY_NAME_SPRINTF */
805 #ifdef PTY_OPEN
806 PTY_OPEN;
807 #else /* no PTY_OPEN */
808 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
809 #endif /* no PTY_OPEN */
811 if (fd >= 0)
813 #ifdef PTY_TTY_NAME_SPRINTF
814 PTY_TTY_NAME_SPRINTF
815 #else
816 sprintf (pty_name, "/dev/tty%c%x", c, i);
817 #endif /* no PTY_TTY_NAME_SPRINTF */
819 /* Set FD's close-on-exec flag. This is needed even if
820 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
821 doesn't require support for that combination.
822 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
823 doesn't work if the close-on-exec flag is set (Bug#20555).
824 Multithreaded platforms where posix_openpt ignores
825 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
826 have a race condition between the PTY_OPEN and here. */
827 fcntl (fd, F_SETFD, FD_CLOEXEC);
829 /* Check to make certain that both sides are available.
830 This avoids a nasty yet stupid bug in rlogins. */
831 if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
833 emacs_close (fd);
834 continue;
836 setup_pty (fd);
837 return fd;
840 #endif /* HAVE_PTYS */
841 return -1;
844 /* Allocate basically initialized process. */
846 static struct Lisp_Process *
847 allocate_process (void)
849 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
852 static Lisp_Object
853 make_process (Lisp_Object name)
855 struct Lisp_Process *p = allocate_process ();
856 /* Initialize Lisp data. Note that allocate_process initializes all
857 Lisp data to nil, so do it only for slots which should not be nil. */
858 pset_status (p, Qrun);
859 pset_mark (p, Fmake_marker ());
860 pset_thread (p, Fcurrent_thread ());
862 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
863 non-Lisp data, so do it only for slots which should not be zero. */
864 p->infd = -1;
865 p->outfd = -1;
866 for (int i = 0; i < PROCESS_OPEN_FDS; i++)
867 p->open_fd[i] = -1;
869 #ifdef HAVE_GNUTLS
870 verify (GNUTLS_STAGE_EMPTY == 0);
871 eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
872 eassert (NILP (p->gnutls_boot_parameters));
873 #endif
875 /* If name is already in use, modify it until it is unused. */
877 Lisp_Object name1 = name;
878 for (printmax_t i = 1; ; i++)
880 Lisp_Object tem = Fget_process (name1);
881 if (NILP (tem))
882 break;
883 char const suffix_fmt[] = "<%"pMd">";
884 char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (printmax_t)];
885 AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
886 name1 = concat2 (name, lsuffix);
888 name = name1;
889 pset_name (p, name);
890 pset_sentinel (p, Qinternal_default_process_sentinel);
891 pset_filter (p, Qinternal_default_process_filter);
892 Lisp_Object val;
893 XSETPROCESS (val, p);
894 Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
895 return val;
898 static void
899 remove_process (register Lisp_Object proc)
901 register Lisp_Object pair;
903 pair = Frassq (proc, Vprocess_alist);
904 Vprocess_alist = Fdelq (pair, Vprocess_alist);
906 deactivate_process (proc);
909 void
910 update_processes_for_thread_death (Lisp_Object dying_thread)
912 Lisp_Object pair;
914 for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
916 Lisp_Object process = XCDR (XCAR (pair));
917 if (EQ (XPROCESS (process)->thread, dying_thread))
919 struct Lisp_Process *proc = XPROCESS (process);
921 pset_thread (proc, Qnil);
922 if (proc->infd >= 0)
923 fd_callback_info[proc->infd].thread = NULL;
924 if (proc->outfd >= 0)
925 fd_callback_info[proc->outfd].thread = NULL;
930 #ifdef HAVE_GETADDRINFO_A
931 static void
932 free_dns_request (Lisp_Object proc)
934 struct Lisp_Process *p = XPROCESS (proc);
936 if (p->dns_request->ar_result)
937 freeaddrinfo (p->dns_request->ar_result);
938 xfree (p->dns_request);
939 p->dns_request = NULL;
941 #endif
944 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
945 doc: /* Return t if OBJECT is a process. */)
946 (Lisp_Object object)
948 return PROCESSP (object) ? Qt : Qnil;
951 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
952 doc: /* Return the process named NAME, or nil if there is none. */)
953 (register Lisp_Object name)
955 if (PROCESSP (name))
956 return name;
957 CHECK_STRING (name);
958 return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
961 /* This is how commands for the user decode process arguments. It
962 accepts a process, a process name, a buffer, a buffer name, or nil.
963 Buffers denote the first process in the buffer, and nil denotes the
964 current buffer. */
966 static Lisp_Object
967 get_process (register Lisp_Object name)
969 register Lisp_Object proc, obj;
970 if (STRINGP (name))
972 obj = Fget_process (name);
973 if (NILP (obj))
974 obj = Fget_buffer (name);
975 if (NILP (obj))
976 error ("Process %s does not exist", SDATA (name));
978 else if (NILP (name))
979 obj = Fcurrent_buffer ();
980 else
981 obj = name;
983 /* Now obj should be either a buffer object or a process object. */
984 if (BUFFERP (obj))
986 if (NILP (BVAR (XBUFFER (obj), name)))
987 error ("Attempt to get process for a dead buffer");
988 proc = Fget_buffer_process (obj);
989 if (NILP (proc))
990 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
992 else
994 CHECK_PROCESS (obj);
995 proc = obj;
997 return proc;
1001 /* Fdelete_process promises to immediately forget about the process, but in
1002 reality, Emacs needs to remember those processes until they have been
1003 treated by the SIGCHLD handler and waitpid has been invoked on them;
1004 otherwise they might fill up the kernel's process table.
1006 Some processes created by call-process are also put onto this list.
1008 Members of this list are (process-ID . filename) pairs. The
1009 process-ID is a number; the filename, if a string, is a file that
1010 needs to be removed after the process exits. */
1011 static Lisp_Object deleted_pid_list;
1013 void
1014 record_deleted_pid (pid_t pid, Lisp_Object filename)
1016 deleted_pid_list = Fcons (Fcons (make_fixnum_or_float (pid), filename),
1017 /* GC treated elements set to nil. */
1018 Fdelq (Qnil, deleted_pid_list));
1022 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 1, 1, 0,
1023 doc: /* Delete PROCESS: kill it and forget about it immediately.
1024 PROCESS may be a process, a buffer, the name of a process or buffer, or
1025 nil, indicating the current buffer's process. */)
1026 (register Lisp_Object process)
1028 register struct Lisp_Process *p;
1030 process = get_process (process);
1031 p = XPROCESS (process);
1033 #ifdef HAVE_GETADDRINFO_A
1034 if (p->dns_request)
1036 /* Cancel the request. Unless shutting down, wait until
1037 completion. Free the request if completely canceled. */
1039 bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
1040 if (!canceled && !inhibit_sentinels)
1042 struct gaicb const *req = p->dns_request;
1043 while (gai_suspend (&req, 1, NULL) != 0)
1044 continue;
1045 canceled = true;
1047 if (canceled)
1048 free_dns_request (process);
1050 #endif
1052 p->raw_status_new = 0;
1053 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1055 pset_status (p, list2 (Qexit, make_number (0)));
1056 p->tick = ++process_tick;
1057 status_notify (p, NULL);
1058 redisplay_preserve_echo_area (13);
1060 else
1062 if (p->alive)
1063 record_kill_process (p, Qnil);
1065 if (p->infd >= 0)
1067 /* Update P's status, since record_kill_process will make the
1068 SIGCHLD handler update deleted_pid_list, not *P. */
1069 Lisp_Object symbol;
1070 if (p->raw_status_new)
1071 update_status (p);
1072 symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
1073 if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
1074 pset_status (p, list2 (Qsignal, make_number (SIGKILL)));
1076 p->tick = ++process_tick;
1077 status_notify (p, NULL);
1078 redisplay_preserve_echo_area (13);
1081 remove_process (process);
1082 return Qnil;
1085 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
1086 doc: /* Return the status of PROCESS.
1087 The returned value is one of the following symbols:
1088 run -- for a process that is running.
1089 stop -- for a process stopped but continuable.
1090 exit -- for a process that has exited.
1091 signal -- for a process that has got a fatal signal.
1092 open -- for a network stream connection that is open.
1093 listen -- for a network stream server that is listening.
1094 closed -- for a network stream connection that is closed.
1095 connect -- when waiting for a non-blocking connection to complete.
1096 failed -- when a non-blocking connection has failed.
1097 nil -- if arg is a process name and no such process exists.
1098 PROCESS may be a process, a buffer, the name of a process, or
1099 nil, indicating the current buffer's process. */)
1100 (register Lisp_Object process)
1102 register struct Lisp_Process *p;
1103 register Lisp_Object status;
1105 if (STRINGP (process))
1106 process = Fget_process (process);
1107 else
1108 process = get_process (process);
1110 if (NILP (process))
1111 return process;
1113 p = XPROCESS (process);
1114 if (p->raw_status_new)
1115 update_status (p);
1116 status = p->status;
1117 if (CONSP (status))
1118 status = XCAR (status);
1119 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1121 if (EQ (status, Qexit))
1122 status = Qclosed;
1123 else if (EQ (p->command, Qt))
1124 status = Qstop;
1125 else if (EQ (status, Qrun))
1126 status = Qopen;
1128 return status;
1131 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
1132 1, 1, 0,
1133 doc: /* Return the exit status of PROCESS or the signal number that killed it.
1134 If PROCESS has not yet exited or died, return 0. */)
1135 (register Lisp_Object process)
1137 CHECK_PROCESS (process);
1138 if (XPROCESS (process)->raw_status_new)
1139 update_status (XPROCESS (process));
1140 if (CONSP (XPROCESS (process)->status))
1141 return XCAR (XCDR (XPROCESS (process)->status));
1142 return make_number (0);
1145 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
1146 doc: /* Return the process id of PROCESS.
1147 This is the pid of the external process which PROCESS uses or talks to.
1148 For a network, serial, and pipe connections, this value is nil. */)
1149 (register Lisp_Object process)
1151 pid_t pid;
1153 CHECK_PROCESS (process);
1154 pid = XPROCESS (process)->pid;
1155 return (pid ? make_fixnum_or_float (pid) : Qnil);
1158 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
1159 doc: /* Return the name of PROCESS, as a string.
1160 This is the name of the program invoked in PROCESS,
1161 possibly modified to make it unique among process names. */)
1162 (register Lisp_Object process)
1164 CHECK_PROCESS (process);
1165 return XPROCESS (process)->name;
1168 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
1169 doc: /* Return the command that was executed to start PROCESS.
1170 This is a list of strings, the first string being the program executed
1171 and the rest of the strings being the arguments given to it.
1172 For a network or serial or pipe connection, this is nil (process is running)
1173 or t (process is stopped). */)
1174 (register Lisp_Object process)
1176 CHECK_PROCESS (process);
1177 return XPROCESS (process)->command;
1180 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 1, 0,
1181 doc: /* Return the name of the terminal PROCESS uses, or nil if none.
1182 This is the terminal that the process itself reads and writes on,
1183 not the name of the pty that Emacs uses to talk with that terminal. */)
1184 (register Lisp_Object process)
1186 CHECK_PROCESS (process);
1187 return XPROCESS (process)->tty_name;
1190 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
1191 2, 2, 0,
1192 doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1193 Return BUFFER. */)
1194 (register Lisp_Object process, Lisp_Object buffer)
1196 struct Lisp_Process *p;
1198 CHECK_PROCESS (process);
1199 if (!NILP (buffer))
1200 CHECK_BUFFER (buffer);
1201 p = XPROCESS (process);
1202 pset_buffer (p, buffer);
1203 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1204 pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
1205 setup_process_coding_systems (process);
1206 return buffer;
1209 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
1210 1, 1, 0,
1211 doc: /* Return the buffer PROCESS is associated with.
1212 The default process filter inserts output from PROCESS into this buffer. */)
1213 (register Lisp_Object process)
1215 CHECK_PROCESS (process);
1216 return XPROCESS (process)->buffer;
1219 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
1220 1, 1, 0,
1221 doc: /* Return the marker for the end of the last output from PROCESS. */)
1222 (register Lisp_Object process)
1224 CHECK_PROCESS (process);
1225 return XPROCESS (process)->mark;
1228 static void
1229 set_process_filter_masks (struct Lisp_Process *p)
1231 if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
1232 delete_read_fd (p->infd);
1233 else if (EQ (p->filter, Qt)
1234 /* Network or serial process not stopped: */
1235 && !EQ (p->command, Qt))
1236 add_process_read_fd (p->infd);
1239 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
1240 2, 2, 0,
1241 doc: /* Give PROCESS the filter function FILTER; nil means default.
1242 A value of t means stop accepting output from the process.
1244 When a process has a non-default filter, its buffer is not used for output.
1245 Instead, each time it does output, the entire string of output is
1246 passed to the filter.
1248 The filter gets two arguments: the process and the string of output.
1249 The string argument is normally a multibyte string, except:
1250 - if the process's input coding system is no-conversion or raw-text,
1251 it is a unibyte string (the non-converted input), or else
1252 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1253 string (the result of converting the decoded input multibyte
1254 string to unibyte with `string-make-unibyte'). */)
1255 (Lisp_Object process, Lisp_Object filter)
1257 CHECK_PROCESS (process);
1258 struct Lisp_Process *p = XPROCESS (process);
1260 /* Don't signal an error if the process's input file descriptor
1261 is closed. This could make debugging Lisp more difficult,
1262 for example when doing something like
1264 (setq process (start-process ...))
1265 (debug)
1266 (set-process-filter process ...) */
1268 if (NILP (filter))
1269 filter = Qinternal_default_process_filter;
1271 pset_filter (p, filter);
1273 if (p->infd >= 0)
1274 set_process_filter_masks (p);
1276 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1277 pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
1278 setup_process_coding_systems (process);
1279 return filter;
1282 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
1283 1, 1, 0,
1284 doc: /* Return the filter function of PROCESS.
1285 See `set-process-filter' for more info on filter functions. */)
1286 (register Lisp_Object process)
1288 CHECK_PROCESS (process);
1289 return XPROCESS (process)->filter;
1292 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
1293 2, 2, 0,
1294 doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
1295 The sentinel is called as a function when the process changes state.
1296 It gets two arguments: the process, and a string describing the change. */)
1297 (register Lisp_Object process, Lisp_Object sentinel)
1299 struct Lisp_Process *p;
1301 CHECK_PROCESS (process);
1302 p = XPROCESS (process);
1304 if (NILP (sentinel))
1305 sentinel = Qinternal_default_process_sentinel;
1307 pset_sentinel (p, sentinel);
1308 if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
1309 pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
1310 return sentinel;
1313 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
1314 1, 1, 0,
1315 doc: /* Return the sentinel of PROCESS.
1316 See `set-process-sentinel' for more info on sentinels. */)
1317 (register Lisp_Object process)
1319 CHECK_PROCESS (process);
1320 return XPROCESS (process)->sentinel;
1323 DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread,
1324 2, 2, 0,
1325 doc: /* Set the locking thread of PROCESS to be THREAD.
1326 If THREAD is nil, the process is unlocked. */)
1327 (Lisp_Object process, Lisp_Object thread)
1329 struct Lisp_Process *proc;
1330 struct thread_state *tstate;
1332 CHECK_PROCESS (process);
1333 if (NILP (thread))
1334 tstate = NULL;
1335 else
1337 CHECK_THREAD (thread);
1338 tstate = XTHREAD (thread);
1341 proc = XPROCESS (process);
1342 pset_thread (proc, thread);
1343 if (proc->infd >= 0)
1344 fd_callback_info[proc->infd].thread = tstate;
1345 if (proc->outfd >= 0)
1346 fd_callback_info[proc->outfd].thread = tstate;
1348 return thread;
1351 DEFUN ("process-thread", Fprocess_thread, Sprocess_thread,
1352 1, 1, 0,
1353 doc: /* Ret the locking thread of PROCESS.
1354 If PROCESS is unlocked, this function returns nil. */)
1355 (Lisp_Object process)
1357 CHECK_PROCESS (process);
1358 return XPROCESS (process)->thread;
1361 DEFUN ("set-process-window-size", Fset_process_window_size,
1362 Sset_process_window_size, 3, 3, 0,
1363 doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1364 Value is t if PROCESS was successfully told about the window size,
1365 nil otherwise. */)
1366 (Lisp_Object process, Lisp_Object height, Lisp_Object width)
1368 CHECK_PROCESS (process);
1370 /* All known platforms store window sizes as 'unsigned short'. */
1371 CHECK_RANGED_INTEGER (height, 0, USHRT_MAX);
1372 CHECK_RANGED_INTEGER (width, 0, USHRT_MAX);
1374 if (NETCONN_P (process)
1375 || XPROCESS (process)->infd < 0
1376 || (set_window_size (XPROCESS (process)->infd,
1377 XINT (height), XINT (width))
1378 < 0))
1379 return Qnil;
1380 else
1381 return Qt;
1384 DEFUN ("set-process-inherit-coding-system-flag",
1385 Fset_process_inherit_coding_system_flag,
1386 Sset_process_inherit_coding_system_flag, 2, 2, 0,
1387 doc: /* Determine whether buffer of PROCESS will inherit coding-system.
1388 If the second argument FLAG is non-nil, then the variable
1389 `buffer-file-coding-system' of the buffer associated with PROCESS
1390 will be bound to the value of the coding system used to decode
1391 the process output.
1393 This is useful when the coding system specified for the process buffer
1394 leaves either the character code conversion or the end-of-line conversion
1395 unspecified, or if the coding system used to decode the process output
1396 is more appropriate for saving the process buffer.
1398 Binding the variable `inherit-process-coding-system' to non-nil before
1399 starting the process is an alternative way of setting the inherit flag
1400 for the process which will run.
1402 This function returns FLAG. */)
1403 (register Lisp_Object process, Lisp_Object flag)
1405 CHECK_PROCESS (process);
1406 XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
1407 return flag;
1410 DEFUN ("set-process-query-on-exit-flag",
1411 Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
1412 2, 2, 0,
1413 doc: /* Specify if query is needed for PROCESS when Emacs is exited.
1414 If the second argument FLAG is non-nil, Emacs will query the user before
1415 exiting or killing a buffer if PROCESS is running. This function
1416 returns FLAG. */)
1417 (register Lisp_Object process, Lisp_Object flag)
1419 CHECK_PROCESS (process);
1420 XPROCESS (process)->kill_without_query = NILP (flag);
1421 return flag;
1424 DEFUN ("process-query-on-exit-flag",
1425 Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
1426 1, 1, 0,
1427 doc: /* Return the current value of query-on-exit flag for PROCESS. */)
1428 (register Lisp_Object process)
1430 CHECK_PROCESS (process);
1431 return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
1434 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
1435 1, 2, 0,
1436 doc: /* Return the contact info of PROCESS; t for a real child.
1437 For a network or serial or pipe connection, the value depends on the
1438 optional KEY arg. If KEY is nil, value is a cons cell of the form
1439 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1440 connection; it is t for a pipe connection. If KEY is t, the complete
1441 contact information for the connection is returned, else the specific
1442 value for the keyword KEY is returned. See `make-network-process',
1443 `make-serial-process', or `make-pipe-process' for the list of keywords.
1444 If PROCESS is a non-blocking network process that hasn't been fully
1445 set up yet, this function will block until socket setup has completed. */)
1446 (Lisp_Object process, Lisp_Object key)
1448 Lisp_Object contact;
1450 CHECK_PROCESS (process);
1451 contact = XPROCESS (process)->childp;
1453 #ifdef DATAGRAM_SOCKETS
1455 if (NETCONN_P (process))
1456 wait_for_socket_fds (process, "process-contact");
1458 if (DATAGRAM_CONN_P (process)
1459 && (EQ (key, Qt) || EQ (key, QCremote)))
1460 contact = Fplist_put (contact, QCremote,
1461 Fprocess_datagram_address (process));
1462 #endif
1464 if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
1465 || EQ (key, Qt))
1466 return contact;
1467 if (NILP (key) && NETCONN_P (process))
1468 return list2 (Fplist_get (contact, QChost),
1469 Fplist_get (contact, QCservice));
1470 if (NILP (key) && SERIALCONN_P (process))
1471 return list2 (Fplist_get (contact, QCport),
1472 Fplist_get (contact, QCspeed));
1473 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1474 if the pipe process is useful for purposes other than receiving
1475 stderr. */
1476 if (NILP (key) && PIPECONN_P (process))
1477 return Qt;
1478 return Fplist_get (contact, key);
1481 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
1482 1, 1, 0,
1483 doc: /* Return the plist of PROCESS. */)
1484 (register Lisp_Object process)
1486 CHECK_PROCESS (process);
1487 return XPROCESS (process)->plist;
1490 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
1491 2, 2, 0,
1492 doc: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1493 (Lisp_Object process, Lisp_Object plist)
1495 CHECK_PROCESS (process);
1496 CHECK_LIST (plist);
1498 pset_plist (XPROCESS (process), plist);
1499 return plist;
1502 #if 0 /* Turned off because we don't currently record this info
1503 in the process. Perhaps add it. */
1504 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1505 doc: /* Return the connection type of PROCESS.
1506 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1507 a socket connection. */)
1508 (Lisp_Object process)
1510 return XPROCESS (process)->type;
1512 #endif
1514 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
1515 doc: /* Return the connection type of PROCESS.
1516 The value is either the symbol `real', `network', `serial', or `pipe'.
1517 PROCESS may be a process, a buffer, the name of a process or buffer, or
1518 nil, indicating the current buffer's process. */)
1519 (Lisp_Object process)
1521 Lisp_Object proc;
1522 proc = get_process (process);
1523 return XPROCESS (proc)->type;
1526 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
1527 1, 2, 0,
1528 doc: /* Convert network ADDRESS from internal format to a string.
1529 A 4 or 5 element vector represents an IPv4 address (with port number).
1530 An 8 or 9 element vector represents an IPv6 address (with port number).
1531 If optional second argument OMIT-PORT is non-nil, don't include a port
1532 number in the string, even when present in ADDRESS.
1533 Return nil if format of ADDRESS is invalid. */)
1534 (Lisp_Object address, Lisp_Object omit_port)
1536 if (NILP (address))
1537 return Qnil;
1539 if (STRINGP (address)) /* AF_LOCAL */
1540 return address;
1542 if (VECTORP (address)) /* AF_INET or AF_INET6 */
1544 register struct Lisp_Vector *p = XVECTOR (address);
1545 ptrdiff_t size = p->header.size;
1546 Lisp_Object args[10];
1547 int nargs, i;
1548 char const *format;
1550 if (size == 4 || (size == 5 && !NILP (omit_port)))
1552 format = "%d.%d.%d.%d";
1553 nargs = 4;
1555 else if (size == 5)
1557 format = "%d.%d.%d.%d:%d";
1558 nargs = 5;
1560 else if (size == 8 || (size == 9 && !NILP (omit_port)))
1562 format = "%x:%x:%x:%x:%x:%x:%x:%x";
1563 nargs = 8;
1565 else if (size == 9)
1567 format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1568 nargs = 9;
1570 else
1571 return Qnil;
1573 AUTO_STRING (format_obj, format);
1574 args[0] = format_obj;
1576 for (i = 0; i < nargs; i++)
1578 if (! RANGED_INTEGERP (0, p->contents[i], 65535))
1579 return Qnil;
1581 if (nargs <= 5 /* IPv4 */
1582 && i < 4 /* host, not port */
1583 && XINT (p->contents[i]) > 255)
1584 return Qnil;
1586 args[i + 1] = p->contents[i];
1589 return Fformat (nargs + 1, args);
1592 if (CONSP (address))
1594 AUTO_STRING (format, "<Family %d>");
1595 return CALLN (Fformat, format, Fcar (address));
1598 return Qnil;
1601 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
1602 doc: /* Return a list of all processes that are Emacs sub-processes. */)
1603 (void)
1605 return Fmapcar (Qcdr, Vprocess_alist);
1608 /* Starting asynchronous inferior processes. */
1610 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
1611 doc: /* Start a program in a subprocess. Return the process object for it.
1613 This is similar to `start-process', but arguments are specified as
1614 keyword/argument pairs. The following arguments are defined:
1616 :name NAME -- NAME is name for process. It is modified if necessary
1617 to make it unique.
1619 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1620 with the process. Process output goes at end of that buffer, unless
1621 you specify an output stream or filter function to handle the output.
1622 BUFFER may be also nil, meaning that this process is not associated
1623 with any buffer.
1625 :command COMMAND -- COMMAND is a list starting with the program file
1626 name, followed by strings to give to the program as arguments.
1628 :coding CODING -- If CODING is a symbol, it specifies the coding
1629 system used for both reading and writing for this process. If CODING
1630 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1631 ENCODING is used for writing.
1633 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1634 the process is running. If BOOL is not given, query before exiting.
1636 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1637 In the stopped state, a process does not accept incoming data, but you
1638 can send outgoing data. The stopped state is cleared by
1639 `continue-process' and set by `stop-process'.
1641 :connection-type TYPE -- TYPE is control type of device used to
1642 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1643 to use a pty, or nil to use the default specified through
1644 `process-connection-type'.
1646 :filter FILTER -- Install FILTER as the process filter.
1648 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1650 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1651 to the standard error of subprocess. Specifying this implies
1652 `:connection-type' is set to `pipe'.
1654 usage: (make-process &rest ARGS) */)
1655 (ptrdiff_t nargs, Lisp_Object *args)
1657 Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
1658 Lisp_Object xstderr, stderrproc;
1659 ptrdiff_t count = SPECPDL_INDEX ();
1661 if (nargs == 0)
1662 return Qnil;
1664 /* Save arguments for process-contact and clone-process. */
1665 contact = Flist (nargs, args);
1667 buffer = Fplist_get (contact, QCbuffer);
1668 if (!NILP (buffer))
1669 buffer = Fget_buffer_create (buffer);
1671 /* Make sure that the child will be able to chdir to the current
1672 buffer's current directory, or its unhandled equivalent. We
1673 can't just have the child check for an error when it does the
1674 chdir, since it's in a vfork. */
1675 current_dir = encode_current_directory ();
1677 name = Fplist_get (contact, QCname);
1678 CHECK_STRING (name);
1680 command = Fplist_get (contact, QCcommand);
1681 if (CONSP (command))
1682 program = XCAR (command);
1683 else
1684 program = Qnil;
1686 if (!NILP (program))
1687 CHECK_STRING (program);
1689 bool query_on_exit = NILP (Fplist_get (contact, QCnoquery));
1691 stderrproc = Qnil;
1692 xstderr = Fplist_get (contact, QCstderr);
1693 if (PROCESSP (xstderr))
1695 if (!PIPECONN_P (xstderr))
1696 error ("Process is not a pipe process");
1697 stderrproc = xstderr;
1699 else if (!NILP (xstderr))
1701 CHECK_STRING (program);
1702 stderrproc = CALLN (Fmake_pipe_process,
1703 QCname,
1704 concat2 (name, build_string (" stderr")),
1705 QCbuffer,
1706 Fget_buffer_create (xstderr),
1707 QCnoquery,
1708 query_on_exit ? Qnil : Qt);
1711 proc = make_process (name);
1712 record_unwind_protect (start_process_unwind, proc);
1714 pset_childp (XPROCESS (proc), Qt);
1715 eassert (NILP (XPROCESS (proc)->plist));
1716 pset_type (XPROCESS (proc), Qreal);
1717 pset_buffer (XPROCESS (proc), buffer);
1718 pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
1719 pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
1720 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1722 if (!query_on_exit)
1723 XPROCESS (proc)->kill_without_query = 1;
1724 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
1725 pset_command (XPROCESS (proc), Qt);
1727 tem = Fplist_get (contact, QCconnection_type);
1728 if (EQ (tem, Qpty))
1729 XPROCESS (proc)->pty_flag = true;
1730 else if (EQ (tem, Qpipe))
1731 XPROCESS (proc)->pty_flag = false;
1732 else if (NILP (tem))
1733 XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
1734 else
1735 report_file_error ("Unknown connection type", tem);
1737 if (!NILP (stderrproc))
1739 pset_stderrproc (XPROCESS (proc), stderrproc);
1741 XPROCESS (proc)->pty_flag = false;
1744 #ifdef HAVE_GNUTLS
1745 /* AKA GNUTLS_INITSTAGE(proc). */
1746 verify (GNUTLS_STAGE_EMPTY == 0);
1747 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1748 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1749 #endif
1751 XPROCESS (proc)->adaptive_read_buffering
1752 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1753 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1755 /* Make the process marker point into the process buffer (if any). */
1756 if (BUFFERP (buffer))
1757 set_marker_both (XPROCESS (proc)->mark, buffer,
1758 BUF_ZV (XBUFFER (buffer)),
1759 BUF_ZV_BYTE (XBUFFER (buffer)));
1761 USE_SAFE_ALLOCA;
1764 /* Decide coding systems for communicating with the process. Here
1765 we don't setup the structure coding_system nor pay attention to
1766 unibyte mode. They are done in create_process. */
1768 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1769 Lisp_Object coding_systems = Qt;
1770 Lisp_Object val, *args2;
1772 tem = Fplist_get (contact, QCcoding);
1773 if (!NILP (tem))
1775 val = tem;
1776 if (CONSP (val))
1777 val = XCAR (val);
1779 else
1780 val = Vcoding_system_for_read;
1781 if (NILP (val))
1783 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1784 Lisp_Object tem2;
1785 SAFE_ALLOCA_LISP (args2, nargs2);
1786 ptrdiff_t i = 0;
1787 args2[i++] = Qstart_process;
1788 args2[i++] = name;
1789 args2[i++] = buffer;
1790 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1791 args2[i++] = XCAR (tem2);
1792 if (!NILP (program))
1793 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1794 if (CONSP (coding_systems))
1795 val = XCAR (coding_systems);
1796 else if (CONSP (Vdefault_process_coding_system))
1797 val = XCAR (Vdefault_process_coding_system);
1799 pset_decode_coding_system (XPROCESS (proc), val);
1801 if (!NILP (tem))
1803 val = tem;
1804 if (CONSP (val))
1805 val = XCDR (val);
1807 else
1808 val = Vcoding_system_for_write;
1809 if (NILP (val))
1811 if (EQ (coding_systems, Qt))
1813 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1814 Lisp_Object tem2;
1815 SAFE_ALLOCA_LISP (args2, nargs2);
1816 ptrdiff_t i = 0;
1817 args2[i++] = Qstart_process;
1818 args2[i++] = name;
1819 args2[i++] = buffer;
1820 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1821 args2[i++] = XCAR (tem2);
1822 if (!NILP (program))
1823 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1825 if (CONSP (coding_systems))
1826 val = XCDR (coding_systems);
1827 else if (CONSP (Vdefault_process_coding_system))
1828 val = XCDR (Vdefault_process_coding_system);
1830 pset_encode_coding_system (XPROCESS (proc), val);
1831 /* Note: At this moment, the above coding system may leave
1832 text-conversion or eol-conversion unspecified. They will be
1833 decided after we read output from the process and decode it by
1834 some coding system, or just before we actually send a text to
1835 the process. */
1839 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1840 eassert (XPROCESS (proc)->decoding_carryover == 0);
1841 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1843 XPROCESS (proc)->inherit_coding_system_flag
1844 = !(NILP (buffer) || !inherit_process_coding_system);
1846 if (!NILP (program))
1848 Lisp_Object program_args = XCDR (command);
1850 /* If program file name is not absolute, search our path for it.
1851 Put the name we will really use in TEM. */
1852 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1853 && !(SCHARS (program) > 1
1854 && IS_DEVICE_SEP (SREF (program, 1))))
1856 tem = Qnil;
1857 openp (Vexec_path, program, Vexec_suffixes, &tem,
1858 make_number (X_OK), false);
1859 if (NILP (tem))
1860 report_file_error ("Searching for program", program);
1861 tem = Fexpand_file_name (tem, Qnil);
1863 else
1865 if (!NILP (Ffile_directory_p (program)))
1866 error ("Specified program for new process is a directory");
1867 tem = program;
1870 /* Remove "/:" from TEM. */
1871 tem = remove_slash_colon (tem);
1873 Lisp_Object arg_encoding = Qnil;
1875 /* Encode the file name and put it in NEW_ARGV.
1876 That's where the child will use it to execute the program. */
1877 tem = list1 (ENCODE_FILE (tem));
1878 ptrdiff_t new_argc = 1;
1880 /* Here we encode arguments by the coding system used for sending
1881 data to the process. We don't support using different coding
1882 systems for encoding arguments and for encoding data sent to the
1883 process. */
1885 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
1887 Lisp_Object arg = XCAR (tem2);
1888 CHECK_STRING (arg);
1889 if (STRING_MULTIBYTE (arg))
1891 if (NILP (arg_encoding))
1892 arg_encoding = (complement_process_encoding_system
1893 (XPROCESS (proc)->encode_coding_system));
1894 arg = code_convert_string_norecord (arg, arg_encoding, 1);
1896 tem = Fcons (arg, tem);
1897 new_argc++;
1900 /* Now that everything is encoded we can collect the strings into
1901 NEW_ARGV. */
1902 char **new_argv;
1903 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
1904 new_argv[new_argc] = 0;
1906 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
1908 new_argv[i] = SSDATA (XCAR (tem));
1909 tem = XCDR (tem);
1912 create_process (proc, new_argv, current_dir);
1914 else
1915 create_pty (proc);
1917 SAFE_FREE ();
1918 return unbind_to (count, proc);
1921 /* If PROC doesn't have its pid set, then an error was signaled and
1922 the process wasn't started successfully, so remove it. */
1923 static void
1924 start_process_unwind (Lisp_Object proc)
1926 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1927 remove_process (proc);
1930 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1932 static void
1933 close_process_fd (int *fd_addr)
1935 int fd = *fd_addr;
1936 if (0 <= fd)
1938 *fd_addr = -1;
1939 emacs_close (fd);
1943 /* Indexes of file descriptors in open_fds. */
1944 enum
1946 /* The pipe from Emacs to its subprocess. */
1947 SUBPROCESS_STDIN,
1948 WRITE_TO_SUBPROCESS,
1950 /* The main pipe from the subprocess to Emacs. */
1951 READ_FROM_SUBPROCESS,
1952 SUBPROCESS_STDOUT,
1954 /* The pipe from the subprocess to Emacs that is closed when the
1955 subprocess execs. */
1956 READ_FROM_EXEC_MONITOR,
1957 EXEC_MONITOR_OUTPUT
1960 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
1962 static void
1963 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1965 struct Lisp_Process *p = XPROCESS (process);
1966 int inchannel, outchannel;
1967 pid_t pid;
1968 int vfork_errno;
1969 int forkin, forkout, forkerr = -1;
1970 bool pty_flag = 0;
1971 char pty_name[PTY_NAME_SIZE];
1972 Lisp_Object lisp_pty_name = Qnil;
1973 sigset_t oldset;
1975 inchannel = outchannel = -1;
1977 if (p->pty_flag)
1978 outchannel = inchannel = allocate_pty (pty_name);
1980 if (inchannel >= 0)
1982 p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
1983 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1984 /* On most USG systems it does not work to open the pty's tty here,
1985 then close it and reopen it in the child. */
1986 /* Don't let this terminal become our controlling terminal
1987 (in case we don't have one). */
1988 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1989 if (forkin < 0)
1990 report_file_error ("Opening pty", Qnil);
1991 p->open_fd[SUBPROCESS_STDIN] = forkin;
1992 #else
1993 forkin = forkout = -1;
1994 #endif /* not USG, or USG_SUBTTY_WORKS */
1995 pty_flag = 1;
1996 lisp_pty_name = build_string (pty_name);
1998 else
2000 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2001 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2002 report_file_error ("Creating pipe", Qnil);
2003 forkin = p->open_fd[SUBPROCESS_STDIN];
2004 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2005 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2006 forkout = p->open_fd[SUBPROCESS_STDOUT];
2008 if (!NILP (p->stderrproc))
2010 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2012 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2014 /* Close unnecessary file descriptors. */
2015 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2016 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2020 #ifndef WINDOWSNT
2021 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2022 report_file_error ("Creating pipe", Qnil);
2023 #endif
2025 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2026 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2028 /* Record this as an active process, with its channels. */
2029 chan_process[inchannel] = process;
2030 p->infd = inchannel;
2031 p->outfd = outchannel;
2033 /* Previously we recorded the tty descriptor used in the subprocess.
2034 It was only used for getting the foreground tty process, so now
2035 we just reopen the device (see emacs_get_tty_pgrp) as this is
2036 more portable (see USG_SUBTTY_WORKS above). */
2038 p->pty_flag = pty_flag;
2039 pset_status (p, Qrun);
2041 if (!EQ (p->command, Qt))
2042 add_process_read_fd (inchannel);
2044 /* This may signal an error. */
2045 setup_process_coding_systems (process);
2047 block_input ();
2048 block_child_signal (&oldset);
2050 #ifndef WINDOWSNT
2051 /* vfork, and prevent local vars from being clobbered by the vfork. */
2052 Lisp_Object volatile current_dir_volatile = current_dir;
2053 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
2054 char **volatile new_argv_volatile = new_argv;
2055 int volatile forkin_volatile = forkin;
2056 int volatile forkout_volatile = forkout;
2057 int volatile forkerr_volatile = forkerr;
2058 struct Lisp_Process *p_volatile = p;
2060 #ifdef DARWIN_OS
2061 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2062 necessary. Also, reset SIGCHLD handling after a vfork, as
2063 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2064 if (pty_flag)
2065 pid = fork ();
2066 else
2068 pid = vfork ();
2069 if (pid == 0)
2070 signal (SIGCHLD, SIG_DFL);
2072 #else
2073 pid = vfork ();
2074 #endif
2076 current_dir = current_dir_volatile;
2077 lisp_pty_name = lisp_pty_name_volatile;
2078 new_argv = new_argv_volatile;
2079 forkin = forkin_volatile;
2080 forkout = forkout_volatile;
2081 forkerr = forkerr_volatile;
2082 p = p_volatile;
2084 pty_flag = p->pty_flag;
2086 if (pid == 0)
2087 #endif /* not WINDOWSNT */
2089 /* Make the pty be the controlling terminal of the process. */
2090 #ifdef HAVE_PTYS
2091 /* First, disconnect its current controlling terminal. */
2092 if (pty_flag)
2093 setsid ();
2094 /* Make the pty's terminal the controlling terminal. */
2095 if (pty_flag && forkin >= 0)
2097 #ifdef TIOCSCTTY
2098 /* We ignore the return value
2099 because faith@cs.unc.edu says that is necessary on Linux. */
2100 ioctl (forkin, TIOCSCTTY, 0);
2101 #endif
2103 #if defined (LDISC1)
2104 if (pty_flag && forkin >= 0)
2106 struct termios t;
2107 tcgetattr (forkin, &t);
2108 t.c_lflag = LDISC1;
2109 if (tcsetattr (forkin, TCSANOW, &t) < 0)
2110 emacs_perror ("create_process/tcsetattr LDISC1");
2112 #else
2113 #if defined (NTTYDISC) && defined (TIOCSETD)
2114 if (pty_flag && forkin >= 0)
2116 /* Use new line discipline. */
2117 int ldisc = NTTYDISC;
2118 ioctl (forkin, TIOCSETD, &ldisc);
2120 #endif
2121 #endif
2122 #ifdef TIOCNOTTY
2123 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2124 can do TIOCSPGRP only to the process's controlling tty. */
2125 if (pty_flag)
2127 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2128 I can't test it since I don't have 4.3. */
2129 int j = emacs_open (DEV_TTY, O_RDWR, 0);
2130 if (j >= 0)
2132 ioctl (j, TIOCNOTTY, 0);
2133 emacs_close (j);
2136 #endif /* TIOCNOTTY */
2138 #if !defined (DONT_REOPEN_PTY)
2139 /*** There is a suggestion that this ought to be a
2140 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2141 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2142 that system does seem to need this code, even though
2143 both TIOCSCTTY is defined. */
2144 /* Now close the pty (if we had it open) and reopen it.
2145 This makes the pty the controlling terminal of the subprocess. */
2146 if (pty_flag)
2149 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2150 would work? */
2151 if (forkin >= 0)
2152 emacs_close (forkin);
2153 forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
2155 if (forkin < 0)
2157 emacs_perror (SSDATA (lisp_pty_name));
2158 _exit (EXIT_CANCELED);
2162 #endif /* not DONT_REOPEN_PTY */
2164 #ifdef SETUP_SLAVE_PTY
2165 if (pty_flag)
2167 SETUP_SLAVE_PTY;
2169 #endif /* SETUP_SLAVE_PTY */
2170 #endif /* HAVE_PTYS */
2172 signal (SIGINT, SIG_DFL);
2173 signal (SIGQUIT, SIG_DFL);
2174 #ifdef SIGPROF
2175 signal (SIGPROF, SIG_DFL);
2176 #endif
2178 /* Emacs ignores SIGPIPE, but the child should not. */
2179 signal (SIGPIPE, SIG_DFL);
2181 /* Stop blocking SIGCHLD in the child. */
2182 unblock_child_signal (&oldset);
2184 if (pty_flag)
2185 child_setup_tty (forkout);
2187 if (forkerr < 0)
2188 forkerr = forkout;
2189 #ifdef WINDOWSNT
2190 pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2191 #else /* not WINDOWSNT */
2192 child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2193 #endif /* not WINDOWSNT */
2196 /* Back in the parent process. */
2198 vfork_errno = errno;
2199 p->pid = pid;
2200 if (pid >= 0)
2201 p->alive = 1;
2203 /* Stop blocking in the parent. */
2204 unblock_child_signal (&oldset);
2205 unblock_input ();
2207 if (pid < 0)
2208 report_file_errno ("Doing vfork", Qnil, vfork_errno);
2209 else
2211 /* vfork succeeded. */
2213 /* Close the pipe ends that the child uses, or the child's pty. */
2214 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2215 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2217 #ifdef WINDOWSNT
2218 register_child (pid, inchannel);
2219 #endif /* WINDOWSNT */
2221 pset_tty_name (p, lisp_pty_name);
2223 #ifndef WINDOWSNT
2224 /* Wait for child_setup to complete in case that vfork is
2225 actually defined as fork. The descriptor
2226 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2227 of a pipe is closed at the child side either by close-on-exec
2228 on successful execve or the _exit call in child_setup. */
2230 char dummy;
2232 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2233 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2234 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2236 #endif
2237 if (!NILP (p->stderrproc))
2239 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2240 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2245 static void
2246 create_pty (Lisp_Object process)
2248 struct Lisp_Process *p = XPROCESS (process);
2249 char pty_name[PTY_NAME_SIZE];
2250 int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
2252 if (pty_fd >= 0)
2254 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2255 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2256 /* On most USG systems it does not work to open the pty's tty here,
2257 then close it and reopen it in the child. */
2258 /* Don't let this terminal become our controlling terminal
2259 (in case we don't have one). */
2260 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2261 if (forkout < 0)
2262 report_file_error ("Opening pty", Qnil);
2263 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2264 #if defined (DONT_REOPEN_PTY)
2265 /* In the case that vfork is defined as fork, the parent process
2266 (Emacs) may send some data before the child process completes
2267 tty options setup. So we setup tty before forking. */
2268 child_setup_tty (forkout);
2269 #endif /* DONT_REOPEN_PTY */
2270 #endif /* not USG, or USG_SUBTTY_WORKS */
2272 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2274 /* Record this as an active process, with its channels.
2275 As a result, child_setup will close Emacs's side of the pipes. */
2276 chan_process[pty_fd] = process;
2277 p->infd = pty_fd;
2278 p->outfd = pty_fd;
2280 /* Previously we recorded the tty descriptor used in the subprocess.
2281 It was only used for getting the foreground tty process, so now
2282 we just reopen the device (see emacs_get_tty_pgrp) as this is
2283 more portable (see USG_SUBTTY_WORKS above). */
2285 p->pty_flag = 1;
2286 pset_status (p, Qrun);
2287 setup_process_coding_systems (process);
2289 add_process_read_fd (pty_fd);
2291 pset_tty_name (p, build_string (pty_name));
2294 p->pid = -2;
2297 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2298 0, MANY, 0,
2299 doc: /* Create and return a bidirectional pipe process.
2301 In Emacs, pipes are represented by process objects, so input and
2302 output work as for subprocesses, and `delete-process' closes a pipe.
2303 However, a pipe process has no process id, it cannot be signaled,
2304 and the status codes are different from normal processes.
2306 Arguments are specified as keyword/argument pairs. The following
2307 arguments are defined:
2309 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2311 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2312 with the process. Process output goes at the end of that buffer,
2313 unless you specify an output stream or filter function to handle the
2314 output. If BUFFER is not given, the value of NAME is used.
2316 :coding CODING -- If CODING is a symbol, it specifies the coding
2317 system used for both reading and writing for this process. If CODING
2318 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2319 ENCODING is used for writing.
2321 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2322 the process is running. If BOOL is not given, query before exiting.
2324 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2325 In the stopped state, a pipe process does not accept incoming data,
2326 but you can send outgoing data. The stopped state is cleared by
2327 `continue-process' and set by `stop-process'.
2329 :filter FILTER -- Install FILTER as the process filter.
2331 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2333 usage: (make-pipe-process &rest ARGS) */)
2334 (ptrdiff_t nargs, Lisp_Object *args)
2336 Lisp_Object proc, contact;
2337 struct Lisp_Process *p;
2338 Lisp_Object name, buffer;
2339 Lisp_Object tem;
2340 ptrdiff_t specpdl_count;
2341 int inchannel, outchannel;
2343 if (nargs == 0)
2344 return Qnil;
2346 contact = Flist (nargs, args);
2348 name = Fplist_get (contact, QCname);
2349 CHECK_STRING (name);
2350 proc = make_process (name);
2351 specpdl_count = SPECPDL_INDEX ();
2352 record_unwind_protect (remove_process, proc);
2353 p = XPROCESS (proc);
2355 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2356 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2357 report_file_error ("Creating pipe", Qnil);
2358 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2359 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2361 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2362 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2364 #ifdef WINDOWSNT
2365 register_aux_fd (inchannel);
2366 #endif
2368 /* Record this as an active process, with its channels. */
2369 chan_process[inchannel] = proc;
2370 p->infd = inchannel;
2371 p->outfd = outchannel;
2373 if (inchannel > max_desc)
2374 max_desc = inchannel;
2376 buffer = Fplist_get (contact, QCbuffer);
2377 if (NILP (buffer))
2378 buffer = name;
2379 buffer = Fget_buffer_create (buffer);
2380 pset_buffer (p, buffer);
2382 pset_childp (p, contact);
2383 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2384 pset_type (p, Qpipe);
2385 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2386 pset_filter (p, Fplist_get (contact, QCfilter));
2387 eassert (NILP (p->log));
2388 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2389 p->kill_without_query = 1;
2390 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2391 pset_command (p, Qt);
2392 eassert (! p->pty_flag);
2394 if (!EQ (p->command, Qt))
2395 add_process_read_fd (inchannel);
2396 p->adaptive_read_buffering
2397 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2398 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2400 /* Make the process marker point into the process buffer (if any). */
2401 if (BUFFERP (buffer))
2402 set_marker_both (p->mark, buffer,
2403 BUF_ZV (XBUFFER (buffer)),
2404 BUF_ZV_BYTE (XBUFFER (buffer)));
2407 /* Setup coding systems for communicating with the network stream. */
2409 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2410 Lisp_Object coding_systems = Qt;
2411 Lisp_Object val;
2413 tem = Fplist_get (contact, QCcoding);
2414 val = Qnil;
2415 if (!NILP (tem))
2417 val = tem;
2418 if (CONSP (val))
2419 val = XCAR (val);
2421 else if (!NILP (Vcoding_system_for_read))
2422 val = Vcoding_system_for_read;
2423 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2424 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2425 /* We dare not decode end-of-line format by setting VAL to
2426 Qraw_text, because the existing Emacs Lisp libraries
2427 assume that they receive bare code including a sequence of
2428 CR LF. */
2429 val = Qnil;
2430 else
2432 if (CONSP (coding_systems))
2433 val = XCAR (coding_systems);
2434 else if (CONSP (Vdefault_process_coding_system))
2435 val = XCAR (Vdefault_process_coding_system);
2436 else
2437 val = Qnil;
2439 pset_decode_coding_system (p, val);
2441 if (!NILP (tem))
2443 val = tem;
2444 if (CONSP (val))
2445 val = XCDR (val);
2447 else if (!NILP (Vcoding_system_for_write))
2448 val = Vcoding_system_for_write;
2449 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2450 val = Qnil;
2451 else
2453 if (CONSP (coding_systems))
2454 val = XCDR (coding_systems);
2455 else if (CONSP (Vdefault_process_coding_system))
2456 val = XCDR (Vdefault_process_coding_system);
2457 else
2458 val = Qnil;
2460 pset_encode_coding_system (p, val);
2462 /* This may signal an error. */
2463 setup_process_coding_systems (proc);
2465 specpdl_ptr = specpdl + specpdl_count;
2467 return proc;
2471 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2472 The address family of sa is not included in the result. */
2474 Lisp_Object
2475 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2477 Lisp_Object address;
2478 ptrdiff_t i;
2479 unsigned char *cp;
2480 struct Lisp_Vector *p;
2482 /* Workaround for a bug in getsockname on BSD: Names bound to
2483 sockets in the UNIX domain are inaccessible; getsockname returns
2484 a zero length name. */
2485 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2486 return empty_unibyte_string;
2488 switch (sa->sa_family)
2490 case AF_INET:
2492 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2493 len = sizeof (sin->sin_addr) + 1;
2494 address = Fmake_vector (make_number (len), Qnil);
2495 p = XVECTOR (address);
2496 p->contents[--len] = make_number (ntohs (sin->sin_port));
2497 cp = (unsigned char *) &sin->sin_addr;
2498 break;
2500 #ifdef AF_INET6
2501 case AF_INET6:
2503 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2504 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2505 len = sizeof (sin6->sin6_addr) / 2 + 1;
2506 address = Fmake_vector (make_number (len), Qnil);
2507 p = XVECTOR (address);
2508 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2509 for (i = 0; i < len; i++)
2510 p->contents[i] = make_number (ntohs (ip6[i]));
2511 return address;
2513 #endif
2514 #ifdef HAVE_LOCAL_SOCKETS
2515 case AF_LOCAL:
2517 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2518 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2519 /* If the first byte is NUL, the name is a Linux abstract
2520 socket name, and the name can contain embedded NULs. If
2521 it's not, we have a NUL-terminated string. Be careful not
2522 to walk past the end of the object looking for the name
2523 terminator, however. */
2524 if (name_length > 0 && sockun->sun_path[0] != '\0')
2526 const char *terminator
2527 = memchr (sockun->sun_path, '\0', name_length);
2529 if (terminator)
2530 name_length = terminator - (const char *) sockun->sun_path;
2533 return make_unibyte_string (sockun->sun_path, name_length);
2535 #endif
2536 default:
2537 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2538 address = Fcons (make_number (sa->sa_family),
2539 Fmake_vector (make_number (len), Qnil));
2540 p = XVECTOR (XCDR (address));
2541 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2542 break;
2545 i = 0;
2546 while (i < len)
2547 p->contents[i++] = make_number (*cp++);
2549 return address;
2552 /* Convert an internal struct addrinfo to a Lisp object. */
2554 static Lisp_Object
2555 conv_addrinfo_to_lisp (struct addrinfo *res)
2557 Lisp_Object protocol = make_number (res->ai_protocol);
2558 eassert (XINT (protocol) == res->ai_protocol);
2559 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2563 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2565 static ptrdiff_t
2566 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2568 struct Lisp_Vector *p;
2570 if (VECTORP (address))
2572 p = XVECTOR (address);
2573 if (p->header.size == 5)
2575 *familyp = AF_INET;
2576 return sizeof (struct sockaddr_in);
2578 #ifdef AF_INET6
2579 else if (p->header.size == 9)
2581 *familyp = AF_INET6;
2582 return sizeof (struct sockaddr_in6);
2584 #endif
2586 #ifdef HAVE_LOCAL_SOCKETS
2587 else if (STRINGP (address))
2589 *familyp = AF_LOCAL;
2590 return sizeof (struct sockaddr_un);
2592 #endif
2593 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2594 && VECTORP (XCDR (address)))
2596 struct sockaddr *sa;
2597 p = XVECTOR (XCDR (address));
2598 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2599 return 0;
2600 *familyp = XINT (XCAR (address));
2601 return p->header.size + sizeof (sa->sa_family);
2603 return 0;
2606 /* Convert an address object (vector or string) to an internal sockaddr.
2608 The address format has been basically validated by
2609 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2610 it could have come from user data. So if FAMILY is not valid,
2611 we return after zeroing *SA. */
2613 static void
2614 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2616 register struct Lisp_Vector *p;
2617 register unsigned char *cp = NULL;
2618 register int i;
2619 EMACS_INT hostport;
2621 memset (sa, 0, len);
2623 if (VECTORP (address))
2625 p = XVECTOR (address);
2626 if (family == AF_INET)
2628 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2629 len = sizeof (sin->sin_addr) + 1;
2630 hostport = XINT (p->contents[--len]);
2631 sin->sin_port = htons (hostport);
2632 cp = (unsigned char *)&sin->sin_addr;
2633 sa->sa_family = family;
2635 #ifdef AF_INET6
2636 else if (family == AF_INET6)
2638 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2639 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2640 len = sizeof (sin6->sin6_addr) / 2 + 1;
2641 hostport = XINT (p->contents[--len]);
2642 sin6->sin6_port = htons (hostport);
2643 for (i = 0; i < len; i++)
2644 if (INTEGERP (p->contents[i]))
2646 int j = XFASTINT (p->contents[i]) & 0xffff;
2647 ip6[i] = ntohs (j);
2649 sa->sa_family = family;
2650 return;
2652 #endif
2653 else
2654 return;
2656 else if (STRINGP (address))
2658 #ifdef HAVE_LOCAL_SOCKETS
2659 if (family == AF_LOCAL)
2661 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2662 cp = SDATA (address);
2663 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2664 sockun->sun_path[i] = *cp++;
2665 sa->sa_family = family;
2667 #endif
2668 return;
2670 else
2672 p = XVECTOR (XCDR (address));
2673 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2676 for (i = 0; i < len; i++)
2677 if (INTEGERP (p->contents[i]))
2678 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2681 #ifdef DATAGRAM_SOCKETS
2682 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2683 1, 1, 0,
2684 doc: /* Get the current datagram address associated with PROCESS.
2685 If PROCESS is a non-blocking network process that hasn't been fully
2686 set up yet, this function will block until socket setup has completed. */)
2687 (Lisp_Object process)
2689 int channel;
2691 CHECK_PROCESS (process);
2693 if (NETCONN_P (process))
2694 wait_for_socket_fds (process, "process-datagram-address");
2696 if (!DATAGRAM_CONN_P (process))
2697 return Qnil;
2699 channel = XPROCESS (process)->infd;
2700 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2701 datagram_address[channel].len);
2704 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2705 2, 2, 0,
2706 doc: /* Set the datagram address for PROCESS to ADDRESS.
2707 Return nil upon error setting address, ADDRESS otherwise.
2709 If PROCESS is a non-blocking network process that hasn't been fully
2710 set up yet, this function will block until socket setup has completed. */)
2711 (Lisp_Object process, Lisp_Object address)
2713 int channel;
2714 int family;
2715 ptrdiff_t len;
2717 CHECK_PROCESS (process);
2719 if (NETCONN_P (process))
2720 wait_for_socket_fds (process, "set-process-datagram-address");
2722 if (!DATAGRAM_CONN_P (process))
2723 return Qnil;
2725 channel = XPROCESS (process)->infd;
2727 len = get_lisp_to_sockaddr_size (address, &family);
2728 if (len == 0 || datagram_address[channel].len != len)
2729 return Qnil;
2730 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2731 return address;
2733 #endif
2736 static const struct socket_options {
2737 /* The name of this option. Should be lowercase version of option
2738 name without SO_ prefix. */
2739 const char *name;
2740 /* Option level SOL_... */
2741 int optlevel;
2742 /* Option number SO_... */
2743 int optnum;
2744 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2745 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2746 } socket_options[] =
2748 #ifdef SO_BINDTODEVICE
2749 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2750 #endif
2751 #ifdef SO_BROADCAST
2752 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2753 #endif
2754 #ifdef SO_DONTROUTE
2755 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2756 #endif
2757 #ifdef SO_KEEPALIVE
2758 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2759 #endif
2760 #ifdef SO_LINGER
2761 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2762 #endif
2763 #ifdef SO_OOBINLINE
2764 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2765 #endif
2766 #ifdef SO_PRIORITY
2767 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2768 #endif
2769 #ifdef SO_REUSEADDR
2770 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2771 #endif
2772 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2775 /* Set option OPT to value VAL on socket S.
2777 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2778 Signals an error if setting a known option fails.
2781 static int
2782 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2784 char *name;
2785 const struct socket_options *sopt;
2786 int ret = 0;
2788 CHECK_SYMBOL (opt);
2790 name = SSDATA (SYMBOL_NAME (opt));
2791 for (sopt = socket_options; sopt->name; sopt++)
2792 if (strcmp (name, sopt->name) == 0)
2793 break;
2795 switch (sopt->opttype)
2797 case SOPT_BOOL:
2799 int optval;
2800 optval = NILP (val) ? 0 : 1;
2801 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2802 &optval, sizeof (optval));
2803 break;
2806 case SOPT_INT:
2808 int optval;
2809 if (TYPE_RANGED_INTEGERP (int, val))
2810 optval = XINT (val);
2811 else
2812 error ("Bad option value for %s", name);
2813 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2814 &optval, sizeof (optval));
2815 break;
2818 #ifdef SO_BINDTODEVICE
2819 case SOPT_IFNAME:
2821 char devname[IFNAMSIZ + 1];
2823 /* This is broken, at least in the Linux 2.4 kernel.
2824 To unbind, the arg must be a zero integer, not the empty string.
2825 This should work on all systems. KFS. 2003-09-23. */
2826 memset (devname, 0, sizeof devname);
2827 if (STRINGP (val))
2829 char *arg = SSDATA (val);
2830 int len = min (strlen (arg), IFNAMSIZ);
2831 memcpy (devname, arg, len);
2833 else if (!NILP (val))
2834 error ("Bad option value for %s", name);
2835 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2836 devname, IFNAMSIZ);
2837 break;
2839 #endif
2841 #ifdef SO_LINGER
2842 case SOPT_LINGER:
2844 struct linger linger;
2846 linger.l_onoff = 1;
2847 linger.l_linger = 0;
2848 if (TYPE_RANGED_INTEGERP (int, val))
2849 linger.l_linger = XINT (val);
2850 else
2851 linger.l_onoff = NILP (val) ? 0 : 1;
2852 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2853 &linger, sizeof (linger));
2854 break;
2856 #endif
2858 default:
2859 return 0;
2862 if (ret < 0)
2864 int setsockopt_errno = errno;
2865 report_file_errno ("Cannot set network option", list2 (opt, val),
2866 setsockopt_errno);
2869 return (1 << sopt->optbit);
2873 DEFUN ("set-network-process-option",
2874 Fset_network_process_option, Sset_network_process_option,
2875 3, 4, 0,
2876 doc: /* For network process PROCESS set option OPTION to value VALUE.
2877 See `make-network-process' for a list of options and values.
2878 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2879 OPTION is not a supported option, return nil instead; otherwise return t.
2881 If PROCESS is a non-blocking network process that hasn't been fully
2882 set up yet, this function will block until socket setup has completed. */)
2883 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2885 int s;
2886 struct Lisp_Process *p;
2888 CHECK_PROCESS (process);
2889 p = XPROCESS (process);
2890 if (!NETCONN1_P (p))
2891 error ("Process is not a network process");
2893 wait_for_socket_fds (process, "set-network-process-option");
2895 s = p->infd;
2896 if (s < 0)
2897 error ("Process is not running");
2899 if (set_socket_option (s, option, value))
2901 pset_childp (p, Fplist_put (p->childp, option, value));
2902 return Qt;
2905 if (NILP (no_error))
2906 error ("Unknown or unsupported option");
2908 return Qnil;
2912 DEFUN ("serial-process-configure",
2913 Fserial_process_configure,
2914 Sserial_process_configure,
2915 0, MANY, 0,
2916 doc: /* Configure speed, bytesize, etc. of a serial process.
2918 Arguments are specified as keyword/argument pairs. Attributes that
2919 are not given are re-initialized from the process's current
2920 configuration (available via the function `process-contact') or set to
2921 reasonable default values. The following arguments are defined:
2923 :process PROCESS
2924 :name NAME
2925 :buffer BUFFER
2926 :port PORT
2927 -- Any of these arguments can be given to identify the process that is
2928 to be configured. If none of these arguments is given, the current
2929 buffer's process is used.
2931 :speed SPEED -- SPEED is the speed of the serial port in bits per
2932 second, also called baud rate. Any value can be given for SPEED, but
2933 most serial ports work only at a few defined values between 1200 and
2934 115200, with 9600 being the most common value. If SPEED is nil, the
2935 serial port is not configured any further, i.e., all other arguments
2936 are ignored. This may be useful for special serial ports such as
2937 Bluetooth-to-serial converters which can only be configured through AT
2938 commands. A value of nil for SPEED can be used only when passed
2939 through `make-serial-process' or `serial-term'.
2941 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2942 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2944 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2945 `odd' (use odd parity), or the symbol `even' (use even parity). If
2946 PARITY is not given, no parity is used.
2948 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2949 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2950 is not given or nil, 1 stopbit is used.
2952 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2953 flowcontrol to be used, which is either nil (don't use flowcontrol),
2954 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2955 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2956 flowcontrol is used.
2958 `serial-process-configure' is called by `make-serial-process' for the
2959 initial configuration of the serial port.
2961 Examples:
2963 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2965 \(serial-process-configure
2966 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2968 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2970 usage: (serial-process-configure &rest ARGS) */)
2971 (ptrdiff_t nargs, Lisp_Object *args)
2973 struct Lisp_Process *p;
2974 Lisp_Object contact = Qnil;
2975 Lisp_Object proc = Qnil;
2977 contact = Flist (nargs, args);
2979 proc = Fplist_get (contact, QCprocess);
2980 if (NILP (proc))
2981 proc = Fplist_get (contact, QCname);
2982 if (NILP (proc))
2983 proc = Fplist_get (contact, QCbuffer);
2984 if (NILP (proc))
2985 proc = Fplist_get (contact, QCport);
2986 proc = get_process (proc);
2987 p = XPROCESS (proc);
2988 if (!EQ (p->type, Qserial))
2989 error ("Not a serial process");
2991 if (NILP (Fplist_get (p->childp, QCspeed)))
2992 return Qnil;
2994 serial_configure (p, contact);
2995 return Qnil;
2998 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2999 0, MANY, 0,
3000 doc: /* Create and return a serial port process.
3002 In Emacs, serial port connections are represented by process objects,
3003 so input and output work as for subprocesses, and `delete-process'
3004 closes a serial port connection. However, a serial process has no
3005 process id, it cannot be signaled, and the status codes are different
3006 from normal processes.
3008 `make-serial-process' creates a process and a buffer, on which you
3009 probably want to use `process-send-string'. Try \\[serial-term] for
3010 an interactive terminal. See below for examples.
3012 Arguments are specified as keyword/argument pairs. The following
3013 arguments are defined:
3015 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3016 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3017 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3018 the backslashes in strings).
3020 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3021 which this function calls.
3023 :name NAME -- NAME is the name of the process. If NAME is not given,
3024 the value of PORT is used.
3026 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3027 with the process. Process output goes at the end of that buffer,
3028 unless you specify an output stream or filter function to handle the
3029 output. If BUFFER is not given, the value of NAME is used.
3031 :coding CODING -- If CODING is a symbol, it specifies the coding
3032 system used for both reading and writing for this process. If CODING
3033 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3034 ENCODING is used for writing.
3036 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3037 the process is running. If BOOL is not given, query before exiting.
3039 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3040 In the stopped state, a serial process does not accept incoming data,
3041 but you can send outgoing data. The stopped state is cleared by
3042 `continue-process' and set by `stop-process'.
3044 :filter FILTER -- Install FILTER as the process filter.
3046 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3048 :plist PLIST -- Install PLIST as the initial plist of the process.
3050 :bytesize
3051 :parity
3052 :stopbits
3053 :flowcontrol
3054 -- This function calls `serial-process-configure' to handle these
3055 arguments.
3057 The original argument list, possibly modified by later configuration,
3058 is available via the function `process-contact'.
3060 Examples:
3062 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3064 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3066 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3068 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3070 usage: (make-serial-process &rest ARGS) */)
3071 (ptrdiff_t nargs, Lisp_Object *args)
3073 int fd = -1;
3074 Lisp_Object proc, contact, port;
3075 struct Lisp_Process *p;
3076 Lisp_Object name, buffer;
3077 Lisp_Object tem, val;
3078 ptrdiff_t specpdl_count;
3080 if (nargs == 0)
3081 return Qnil;
3083 contact = Flist (nargs, args);
3085 port = Fplist_get (contact, QCport);
3086 if (NILP (port))
3087 error ("No port specified");
3088 CHECK_STRING (port);
3090 if (NILP (Fplist_member (contact, QCspeed)))
3091 error (":speed not specified");
3092 if (!NILP (Fplist_get (contact, QCspeed)))
3093 CHECK_NUMBER (Fplist_get (contact, QCspeed));
3095 name = Fplist_get (contact, QCname);
3096 if (NILP (name))
3097 name = port;
3098 CHECK_STRING (name);
3099 proc = make_process (name);
3100 specpdl_count = SPECPDL_INDEX ();
3101 record_unwind_protect (remove_process, proc);
3102 p = XPROCESS (proc);
3104 fd = serial_open (port);
3105 p->open_fd[SUBPROCESS_STDIN] = fd;
3106 p->infd = fd;
3107 p->outfd = fd;
3108 if (fd > max_desc)
3109 max_desc = fd;
3110 chan_process[fd] = proc;
3112 buffer = Fplist_get (contact, QCbuffer);
3113 if (NILP (buffer))
3114 buffer = name;
3115 buffer = Fget_buffer_create (buffer);
3116 pset_buffer (p, buffer);
3118 pset_childp (p, contact);
3119 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3120 pset_type (p, Qserial);
3121 pset_sentinel (p, Fplist_get (contact, QCsentinel));
3122 pset_filter (p, Fplist_get (contact, QCfilter));
3123 eassert (NILP (p->log));
3124 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3125 p->kill_without_query = 1;
3126 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
3127 pset_command (p, Qt);
3128 eassert (! p->pty_flag);
3130 if (!EQ (p->command, Qt))
3131 add_process_read_fd (fd);
3133 if (BUFFERP (buffer))
3135 set_marker_both (p->mark, buffer,
3136 BUF_ZV (XBUFFER (buffer)),
3137 BUF_ZV_BYTE (XBUFFER (buffer)));
3140 tem = Fplist_member (contact, QCcoding);
3141 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3142 tem = Qnil;
3144 val = Qnil;
3145 if (!NILP (tem))
3147 val = XCAR (XCDR (tem));
3148 if (CONSP (val))
3149 val = XCAR (val);
3151 else if (!NILP (Vcoding_system_for_read))
3152 val = Vcoding_system_for_read;
3153 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3154 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3155 val = Qnil;
3156 pset_decode_coding_system (p, val);
3158 val = Qnil;
3159 if (!NILP (tem))
3161 val = XCAR (XCDR (tem));
3162 if (CONSP (val))
3163 val = XCDR (val);
3165 else if (!NILP (Vcoding_system_for_write))
3166 val = Vcoding_system_for_write;
3167 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3168 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3169 val = Qnil;
3170 pset_encode_coding_system (p, val);
3172 setup_process_coding_systems (proc);
3173 pset_decoding_buf (p, empty_unibyte_string);
3174 eassert (p->decoding_carryover == 0);
3175 pset_encoding_buf (p, empty_unibyte_string);
3176 p->inherit_coding_system_flag
3177 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3179 Fserial_process_configure (nargs, args);
3181 specpdl_ptr = specpdl + specpdl_count;
3183 return proc;
3186 static void
3187 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3188 Lisp_Object service, Lisp_Object name)
3190 Lisp_Object tem;
3191 struct Lisp_Process *p = XPROCESS (proc);
3192 Lisp_Object contact = p->childp;
3193 Lisp_Object coding_systems = Qt;
3194 Lisp_Object val;
3196 tem = Fplist_member (contact, QCcoding);
3197 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3198 tem = Qnil; /* No error message (too late!). */
3200 /* Setup coding systems for communicating with the network stream. */
3201 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3203 if (!NILP (tem))
3205 val = XCAR (XCDR (tem));
3206 if (CONSP (val))
3207 val = XCAR (val);
3209 else if (!NILP (Vcoding_system_for_read))
3210 val = Vcoding_system_for_read;
3211 else if ((!NILP (p->buffer)
3212 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3213 || (NILP (p->buffer)
3214 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3215 /* We dare not decode end-of-line format by setting VAL to
3216 Qraw_text, because the existing Emacs Lisp libraries
3217 assume that they receive bare code including a sequence of
3218 CR LF. */
3219 val = Qnil;
3220 else
3222 if (NILP (host) || NILP (service))
3223 coding_systems = Qnil;
3224 else
3225 coding_systems = CALLN (Ffind_operation_coding_system,
3226 Qopen_network_stream, name, p->buffer,
3227 host, service);
3228 if (CONSP (coding_systems))
3229 val = XCAR (coding_systems);
3230 else if (CONSP (Vdefault_process_coding_system))
3231 val = XCAR (Vdefault_process_coding_system);
3232 else
3233 val = Qnil;
3235 pset_decode_coding_system (p, val);
3237 if (!NILP (tem))
3239 val = XCAR (XCDR (tem));
3240 if (CONSP (val))
3241 val = XCDR (val);
3243 else if (!NILP (Vcoding_system_for_write))
3244 val = Vcoding_system_for_write;
3245 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3246 val = Qnil;
3247 else
3249 if (EQ (coding_systems, Qt))
3251 if (NILP (host) || NILP (service))
3252 coding_systems = Qnil;
3253 else
3254 coding_systems = CALLN (Ffind_operation_coding_system,
3255 Qopen_network_stream, name, p->buffer,
3256 host, service);
3258 if (CONSP (coding_systems))
3259 val = XCDR (coding_systems);
3260 else if (CONSP (Vdefault_process_coding_system))
3261 val = XCDR (Vdefault_process_coding_system);
3262 else
3263 val = Qnil;
3265 pset_encode_coding_system (p, val);
3267 pset_decoding_buf (p, empty_unibyte_string);
3268 p->decoding_carryover = 0;
3269 pset_encoding_buf (p, empty_unibyte_string);
3271 p->inherit_coding_system_flag
3272 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3275 #ifdef HAVE_GNUTLS
3276 static void
3277 finish_after_tls_connection (Lisp_Object proc)
3279 struct Lisp_Process *p = XPROCESS (proc);
3280 Lisp_Object contact = p->childp;
3281 Lisp_Object result = Qt;
3283 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3284 result = call3 (Qnsm_verify_connection,
3285 proc,
3286 Fplist_get (contact, QChost),
3287 Fplist_get (contact, QCservice));
3289 if (NILP (result))
3291 pset_status (p, list2 (Qfailed,
3292 build_string ("The Network Security Manager stopped the connections")));
3293 deactivate_process (proc);
3295 else if (p->outfd < 0)
3297 /* The counterparty may have closed the connection (especially
3298 if the NSM prompt above take a long time), so recheck the file
3299 descriptor here. */
3300 pset_status (p, Qfailed);
3301 deactivate_process (proc);
3303 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3305 /* If we cleared the connection wait mask before we did the TLS
3306 setup, then we have to say that the process is finally "open"
3307 here. */
3308 pset_status (p, Qrun);
3309 /* Execute the sentinel here. If we had relied on status_notify
3310 to do it later, it will read input from the process before
3311 calling the sentinel. */
3312 exec_sentinel (proc, build_string ("open\n"));
3315 #endif
3317 static void
3318 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3319 Lisp_Object use_external_socket_p)
3321 ptrdiff_t count = SPECPDL_INDEX ();
3322 int s = -1, outch, inch;
3323 int xerrno = 0;
3324 int family;
3325 struct sockaddr *sa = NULL;
3326 int ret;
3327 ptrdiff_t addrlen;
3328 struct Lisp_Process *p = XPROCESS (proc);
3329 Lisp_Object contact = p->childp;
3330 int optbits = 0;
3331 int socket_to_use = -1;
3333 if (!NILP (use_external_socket_p))
3335 socket_to_use = external_sock_fd;
3337 /* Ensure we don't consume the external socket twice. */
3338 external_sock_fd = -1;
3341 /* Do this in case we never enter the while-loop below. */
3342 s = -1;
3344 while (!NILP (addrinfos))
3346 Lisp_Object addrinfo = XCAR (addrinfos);
3347 addrinfos = XCDR (addrinfos);
3348 int protocol = XINT (XCAR (addrinfo));
3349 Lisp_Object ip_address = XCDR (addrinfo);
3351 #ifdef WINDOWSNT
3352 retry_connect:
3353 #endif
3355 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3356 if (sa)
3357 free (sa);
3358 sa = xmalloc (addrlen);
3359 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3361 s = socket_to_use;
3362 if (s < 0)
3364 int socktype = p->socktype | SOCK_CLOEXEC;
3365 if (p->is_non_blocking_client)
3366 socktype |= SOCK_NONBLOCK;
3367 s = socket (family, socktype, protocol);
3368 if (s < 0)
3370 xerrno = errno;
3371 continue;
3375 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3377 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3378 if (ret < 0)
3380 xerrno = errno;
3381 emacs_close (s);
3382 s = -1;
3383 if (0 <= socket_to_use)
3384 break;
3385 continue;
3389 #ifdef DATAGRAM_SOCKETS
3390 if (!p->is_server && p->socktype == SOCK_DGRAM)
3391 break;
3392 #endif /* DATAGRAM_SOCKETS */
3394 /* Make us close S if quit. */
3395 record_unwind_protect_int (close_file_unwind, s);
3397 /* Parse network options in the arg list. We simply ignore anything
3398 which isn't a known option (including other keywords). An error
3399 is signaled if setting a known option fails. */
3401 Lisp_Object params = contact, key, val;
3403 while (!NILP (params))
3405 key = XCAR (params);
3406 params = XCDR (params);
3407 val = XCAR (params);
3408 params = XCDR (params);
3409 optbits |= set_socket_option (s, key, val);
3413 if (p->is_server)
3415 /* Configure as a server socket. */
3417 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3418 explicit :reuseaddr key to override this. */
3419 #ifdef HAVE_LOCAL_SOCKETS
3420 if (family != AF_LOCAL)
3421 #endif
3422 if (!(optbits & (1 << OPIX_REUSEADDR)))
3424 int optval = 1;
3425 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3426 report_file_error ("Cannot set reuse option on server socket", Qnil);
3429 /* If passed a socket descriptor, it should be already bound. */
3430 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3431 report_file_error ("Cannot bind server socket", Qnil);
3433 #ifdef HAVE_GETSOCKNAME
3434 if (p->port == 0
3435 #ifdef HAVE_LOCAL_SOCKETS
3436 && family != AF_LOCAL
3437 #endif
3440 struct sockaddr_in sa1;
3441 socklen_t len1 = sizeof (sa1);
3442 #ifdef AF_INET6
3443 /* The code below assumes the port is at the same offset
3444 and of the same width in both IPv4 and IPv6
3445 structures, but the standards don't guarantee that,
3446 so verify it here. */
3447 struct sockaddr_in6 sa6;
3448 verify ((offsetof (struct sockaddr_in, sin_port)
3449 == offsetof (struct sockaddr_in6, sin6_port))
3450 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3451 #endif
3452 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3453 if (getsockname (s, psa1, &len1) == 0)
3455 Lisp_Object service = make_number (ntohs (sa1.sin_port));
3456 contact = Fplist_put (contact, QCservice, service);
3457 /* Save the port number so that we can stash it in
3458 the process object later. */
3459 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3460 psa->sin_port = sa1.sin_port;
3463 #endif
3465 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3466 report_file_error ("Cannot listen on server socket", Qnil);
3468 break;
3471 maybe_quit ();
3473 ret = connect (s, sa, addrlen);
3474 xerrno = errno;
3476 if (ret == 0 || xerrno == EISCONN)
3478 /* The unwind-protect will be discarded afterwards. */
3479 break;
3482 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3483 break;
3485 #ifndef WINDOWSNT
3486 if (xerrno == EINTR)
3488 /* Unlike most other syscalls connect() cannot be called
3489 again. (That would return EALREADY.) The proper way to
3490 wait for completion is pselect(). */
3491 int sc;
3492 socklen_t len;
3493 fd_set fdset;
3494 retry_select:
3495 FD_ZERO (&fdset);
3496 FD_SET (s, &fdset);
3497 maybe_quit ();
3498 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3499 if (sc == -1)
3501 if (errno == EINTR)
3502 goto retry_select;
3503 else
3504 report_file_error ("Failed select", Qnil);
3506 eassert (sc > 0);
3508 len = sizeof xerrno;
3509 eassert (FD_ISSET (s, &fdset));
3510 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3511 report_file_error ("Failed getsockopt", Qnil);
3512 if (xerrno == 0)
3513 break;
3514 if (NILP (addrinfos))
3515 report_file_errno ("Failed connect", Qnil, xerrno);
3517 #endif /* !WINDOWSNT */
3519 /* Discard the unwind protect closing S. */
3520 specpdl_ptr = specpdl + count;
3521 emacs_close (s);
3522 s = -1;
3523 if (0 <= socket_to_use)
3524 break;
3526 #ifdef WINDOWSNT
3527 if (xerrno == EINTR)
3528 goto retry_connect;
3529 #endif
3532 if (s >= 0)
3534 #ifdef DATAGRAM_SOCKETS
3535 if (p->socktype == SOCK_DGRAM)
3537 if (datagram_address[s].sa)
3538 emacs_abort ();
3540 datagram_address[s].sa = xmalloc (addrlen);
3541 datagram_address[s].len = addrlen;
3542 if (p->is_server)
3544 Lisp_Object remote;
3545 memset (datagram_address[s].sa, 0, addrlen);
3546 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3548 int rfamily;
3549 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3550 if (rlen != 0 && rfamily == family
3551 && rlen == addrlen)
3552 conv_lisp_to_sockaddr (rfamily, remote,
3553 datagram_address[s].sa, rlen);
3556 else
3557 memcpy (datagram_address[s].sa, sa, addrlen);
3559 #endif
3561 contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
3562 conv_sockaddr_to_lisp (sa, addrlen));
3563 #ifdef HAVE_GETSOCKNAME
3564 if (!p->is_server)
3566 struct sockaddr_storage sa1;
3567 socklen_t len1 = sizeof (sa1);
3568 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3569 if (getsockname (s, psa1, &len1) == 0)
3570 contact = Fplist_put (contact, QClocal,
3571 conv_sockaddr_to_lisp (psa1, len1));
3573 #endif
3576 if (s < 0)
3578 /* If non-blocking got this far - and failed - assume non-blocking is
3579 not supported after all. This is probably a wrong assumption, but
3580 the normal blocking calls to open-network-stream handles this error
3581 better. */
3582 if (p->is_non_blocking_client)
3583 return;
3585 report_file_errno ((p->is_server
3586 ? "make server process failed"
3587 : "make client process failed"),
3588 contact, xerrno);
3591 inch = s;
3592 outch = s;
3594 chan_process[inch] = proc;
3596 fcntl (inch, F_SETFL, O_NONBLOCK);
3598 p = XPROCESS (proc);
3599 p->open_fd[SUBPROCESS_STDIN] = inch;
3600 p->infd = inch;
3601 p->outfd = outch;
3603 /* Discard the unwind protect for closing S, if any. */
3604 specpdl_ptr = specpdl + count;
3606 if (p->is_server && p->socktype != SOCK_DGRAM)
3607 pset_status (p, Qlisten);
3609 /* Make the process marker point into the process buffer (if any). */
3610 if (BUFFERP (p->buffer))
3611 set_marker_both (p->mark, p->buffer,
3612 BUF_ZV (XBUFFER (p->buffer)),
3613 BUF_ZV_BYTE (XBUFFER (p->buffer)));
3615 if (p->is_non_blocking_client)
3617 /* We may get here if connect did succeed immediately. However,
3618 in that case, we still need to signal this like a non-blocking
3619 connection. */
3620 if (! (connecting_status (p->status)
3621 && EQ (XCDR (p->status), addrinfos)))
3622 pset_status (p, Fcons (Qconnect, addrinfos));
3623 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3624 add_non_blocking_write_fd (inch);
3626 else
3627 /* A server may have a client filter setting of Qt, but it must
3628 still listen for incoming connects unless it is stopped. */
3629 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3630 || (EQ (p->status, Qlisten) && NILP (p->command)))
3631 add_process_read_fd (inch);
3633 if (inch > max_desc)
3634 max_desc = inch;
3636 /* Set up the masks based on the process filter. */
3637 set_process_filter_masks (p);
3639 setup_process_coding_systems (proc);
3641 #ifdef HAVE_GNUTLS
3642 /* Continue the asynchronous connection. */
3643 if (!NILP (p->gnutls_boot_parameters))
3645 Lisp_Object boot, params = p->gnutls_boot_parameters;
3647 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3648 p->gnutls_boot_parameters = Qnil;
3650 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3651 /* Run sentinels, etc. */
3652 finish_after_tls_connection (proc);
3653 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3655 deactivate_process (proc);
3656 if (NILP (boot))
3657 pset_status (p, list2 (Qfailed,
3658 build_string ("TLS negotiation failed")));
3659 else
3660 pset_status (p, list2 (Qfailed, boot));
3663 #endif
3667 /* Create a network stream/datagram client/server process. Treated
3668 exactly like a normal process when reading and writing. Primary
3669 differences are in status display and process deletion. A network
3670 connection has no PID; you cannot signal it. All you can do is
3671 stop/continue it and deactivate/close it via delete-process. */
3673 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3674 0, MANY, 0,
3675 doc: /* Create and return a network server or client process.
3677 In Emacs, network connections are represented by process objects, so
3678 input and output work as for subprocesses and `delete-process' closes
3679 a network connection. However, a network process has no process id,
3680 it cannot be signaled, and the status codes are different from normal
3681 processes.
3683 Arguments are specified as keyword/argument pairs. The following
3684 arguments are defined:
3686 :name NAME -- NAME is name for process. It is modified if necessary
3687 to make it unique.
3689 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3690 with the process. Process output goes at end of that buffer, unless
3691 you specify an output stream or filter function to handle the output.
3692 BUFFER may be also nil, meaning that this process is not associated
3693 with any buffer.
3695 :host HOST -- HOST is name of the host to connect to, or its IP
3696 address. The symbol `local' specifies the local host. If specified
3697 for a server process, it must be a valid name or address for the local
3698 host, and only clients connecting to that address will be accepted.
3700 :service SERVICE -- SERVICE is name of the service desired, or an
3701 integer specifying a port number to connect to. If SERVICE is t,
3702 a random port number is selected for the server. A port number can
3703 be specified as an integer string, e.g., "80", as well as an integer.
3705 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3706 stream type connection, `datagram' creates a datagram type connection,
3707 `seqpacket' creates a reliable datagram connection.
3709 :family FAMILY -- FAMILY is the address (and protocol) family for the
3710 service specified by HOST and SERVICE. The default (nil) is to use
3711 whatever address family (IPv4 or IPv6) that is defined for the host
3712 and port number specified by HOST and SERVICE. Other address families
3713 supported are:
3714 local -- for a local (i.e. UNIX) address specified by SERVICE.
3715 ipv4 -- use IPv4 address family only.
3716 ipv6 -- use IPv6 address family only.
3718 :local ADDRESS -- ADDRESS is the local address used for the connection.
3719 This parameter is ignored when opening a client process. When specified
3720 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3722 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3723 connection. This parameter is ignored when opening a stream server
3724 process. For a datagram server process, it specifies the initial
3725 setting of the remote datagram address. When specified for a client
3726 process, the FAMILY, HOST, and SERVICE args are ignored.
3728 The format of ADDRESS depends on the address family:
3729 - An IPv4 address is represented as an vector of integers [A B C D P]
3730 corresponding to numeric IP address A.B.C.D and port number P.
3731 - A local address is represented as a string with the address in the
3732 local address space.
3733 - An "unsupported family" address is represented by a cons (F . AV)
3734 where F is the family number and AV is a vector containing the socket
3735 address data with one element per address data byte. Do not rely on
3736 this format in portable code, as it may depend on implementation
3737 defined constants, data sizes, and data structure alignment.
3739 :coding CODING -- If CODING is a symbol, it specifies the coding
3740 system used for both reading and writing for this process. If CODING
3741 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3742 ENCODING is used for writing.
3744 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3745 process, return without waiting for the connection to complete;
3746 instead, the sentinel function will be called with second arg matching
3747 "open" (if successful) or "failed" when the connect completes.
3748 Default is to use a blocking connect (i.e. wait) for stream type
3749 connections.
3751 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3752 running when Emacs is exited.
3754 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3755 In the stopped state, a server process does not accept new
3756 connections, and a client process does not handle incoming traffic.
3757 The stopped state is cleared by `continue-process' and set by
3758 `stop-process'.
3760 :filter FILTER -- Install FILTER as the process filter.
3762 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3763 process filter are multibyte, otherwise they are unibyte.
3764 If this keyword is not specified, the strings are multibyte if
3765 the default value of `enable-multibyte-characters' is non-nil.
3767 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3769 :log LOG -- Install LOG as the server process log function. This
3770 function is called when the server accepts a network connection from a
3771 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3772 is the server process, CLIENT is the new process for the connection,
3773 and MESSAGE is a string.
3775 :plist PLIST -- Install PLIST as the new process's initial plist.
3777 :tls-parameters LIST -- is a list that should be supplied if you're
3778 opening a TLS connection. The first element is the TLS type (either
3779 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3780 be a keyword list accepted by gnutls-boot (as returned by
3781 `gnutls-boot-parameters').
3783 :server QLEN -- if QLEN is non-nil, create a server process for the
3784 specified FAMILY, SERVICE, and connection type (stream or datagram).
3785 If QLEN is an integer, it is used as the max. length of the server's
3786 pending connection queue (also known as the backlog); the default
3787 queue length is 5. Default is to create a client process.
3789 The following network options can be specified for this connection:
3791 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3792 :dontroute BOOL -- Only send to directly connected hosts.
3793 :keepalive BOOL -- Send keep-alive messages on network stream.
3794 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3795 :oobinline BOOL -- Place out-of-band data in receive data stream.
3796 :priority INT -- Set protocol defined priority for sent packets.
3797 :reuseaddr BOOL -- Allow reusing a recently used local address
3798 (this is allowed by default for a server process).
3799 :bindtodevice NAME -- bind to interface NAME. Using this may require
3800 special privileges on some systems.
3801 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3802 been passed to Emacs. If Emacs wasn't
3803 passed a socket, this option is silently
3804 ignored.
3807 Consult the relevant system programmer's manual pages for more
3808 information on using these options.
3811 A server process will listen for and accept connections from clients.
3812 When a client connection is accepted, a new network process is created
3813 for the connection with the following parameters:
3815 - The client's process name is constructed by concatenating the server
3816 process's NAME and a client identification string.
3817 - If the FILTER argument is non-nil, the client process will not get a
3818 separate process buffer; otherwise, the client's process buffer is a newly
3819 created buffer named after the server process's BUFFER name or process
3820 NAME concatenated with the client identification string.
3821 - The connection type and the process filter and sentinel parameters are
3822 inherited from the server process's TYPE, FILTER and SENTINEL.
3823 - The client process's contact info is set according to the client's
3824 addressing information (typically an IP address and a port number).
3825 - The client process's plist is initialized from the server's plist.
3827 Notice that the FILTER and SENTINEL args are never used directly by
3828 the server process. Also, the BUFFER argument is not used directly by
3829 the server process, but via the optional :log function, accepted (and
3830 failed) connections may be logged in the server process's buffer.
3832 The original argument list, modified with the actual connection
3833 information, is available via the `process-contact' function.
3835 usage: (make-network-process &rest ARGS) */)
3836 (ptrdiff_t nargs, Lisp_Object *args)
3838 Lisp_Object proc;
3839 Lisp_Object contact;
3840 struct Lisp_Process *p;
3841 const char *portstring UNINIT;
3842 ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
3843 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3844 #ifdef HAVE_LOCAL_SOCKETS
3845 struct sockaddr_un address_un;
3846 #endif
3847 EMACS_INT port = 0;
3848 Lisp_Object tem;
3849 Lisp_Object name, buffer, host, service, address;
3850 Lisp_Object filter, sentinel, use_external_socket_p;
3851 Lisp_Object addrinfos = Qnil;
3852 int socktype;
3853 int family = -1;
3854 enum { any_protocol = 0 };
3855 #ifdef HAVE_GETADDRINFO_A
3856 struct gaicb *dns_request = NULL;
3857 #endif
3858 ptrdiff_t count = SPECPDL_INDEX ();
3860 if (nargs == 0)
3861 return Qnil;
3863 /* Save arguments for process-contact and clone-process. */
3864 contact = Flist (nargs, args);
3866 #ifdef WINDOWSNT
3867 /* Ensure socket support is loaded if available. */
3868 init_winsock (TRUE);
3869 #endif
3871 /* :type TYPE (nil: stream, datagram */
3872 tem = Fplist_get (contact, QCtype);
3873 if (NILP (tem))
3874 socktype = SOCK_STREAM;
3875 #ifdef DATAGRAM_SOCKETS
3876 else if (EQ (tem, Qdatagram))
3877 socktype = SOCK_DGRAM;
3878 #endif
3879 #ifdef HAVE_SEQPACKET
3880 else if (EQ (tem, Qseqpacket))
3881 socktype = SOCK_SEQPACKET;
3882 #endif
3883 else
3884 error ("Unsupported connection type");
3886 name = Fplist_get (contact, QCname);
3887 buffer = Fplist_get (contact, QCbuffer);
3888 filter = Fplist_get (contact, QCfilter);
3889 sentinel = Fplist_get (contact, QCsentinel);
3890 use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
3892 CHECK_STRING (name);
3894 /* :local ADDRESS or :remote ADDRESS */
3895 tem = Fplist_get (contact, QCserver);
3896 if (NILP (tem))
3897 address = Fplist_get (contact, QCremote);
3898 else
3899 address = Fplist_get (contact, QClocal);
3900 if (!NILP (address))
3902 host = service = Qnil;
3904 if (!get_lisp_to_sockaddr_size (address, &family))
3905 error ("Malformed :address");
3907 addrinfos = list1 (Fcons (make_number (any_protocol), address));
3908 goto open_socket;
3911 /* :family FAMILY -- nil (for Inet), local, or integer. */
3912 tem = Fplist_get (contact, QCfamily);
3913 if (NILP (tem))
3915 #ifdef AF_INET6
3916 family = AF_UNSPEC;
3917 #else
3918 family = AF_INET;
3919 #endif
3921 #ifdef HAVE_LOCAL_SOCKETS
3922 else if (EQ (tem, Qlocal))
3923 family = AF_LOCAL;
3924 #endif
3925 #ifdef AF_INET6
3926 else if (EQ (tem, Qipv6))
3927 family = AF_INET6;
3928 #endif
3929 else if (EQ (tem, Qipv4))
3930 family = AF_INET;
3931 else if (TYPE_RANGED_INTEGERP (int, tem))
3932 family = XINT (tem);
3933 else
3934 error ("Unknown address family");
3936 /* :service SERVICE -- string, integer (port number), or t (random port). */
3937 service = Fplist_get (contact, QCservice);
3939 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3940 host = Fplist_get (contact, QChost);
3941 if (NILP (host))
3943 /* The "connection" function gets it bind info from the address we're
3944 given, so use this dummy address if nothing is specified. */
3945 #ifdef HAVE_LOCAL_SOCKETS
3946 if (family != AF_LOCAL)
3947 #endif
3948 host = build_string ("127.0.0.1");
3950 else
3952 if (EQ (host, Qlocal))
3953 /* Depending on setup, "localhost" may map to different IPv4 and/or
3954 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3955 host = build_string ("127.0.0.1");
3956 CHECK_STRING (host);
3959 #ifdef HAVE_LOCAL_SOCKETS
3960 if (family == AF_LOCAL)
3962 if (!NILP (host))
3964 message (":family local ignores the :host property");
3965 contact = Fplist_put (contact, QChost, Qnil);
3966 host = Qnil;
3968 CHECK_STRING (service);
3969 if (sizeof address_un.sun_path <= SBYTES (service))
3970 error ("Service name too long");
3971 addrinfos = list1 (Fcons (make_number (any_protocol), service));
3972 goto open_socket;
3974 #endif
3976 /* Slow down polling to every ten seconds.
3977 Some kernels have a bug which causes retrying connect to fail
3978 after a connect. Polling can interfere with gethostbyname too. */
3979 #ifdef POLL_FOR_INPUT
3980 if (socktype != SOCK_DGRAM)
3982 record_unwind_protect_void (run_all_atimers);
3983 bind_polling_period (10);
3985 #endif
3987 if (!NILP (host))
3989 /* SERVICE can either be a string or int.
3990 Convert to a C string for later use by getaddrinfo. */
3991 if (EQ (service, Qt))
3993 portstring = "0";
3994 portstringlen = 1;
3996 else if (INTEGERP (service))
3998 portstring = portbuf;
3999 portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
4001 else
4003 CHECK_STRING (service);
4004 portstring = SSDATA (service);
4005 portstringlen = SBYTES (service);
4009 #ifdef HAVE_GETADDRINFO_A
4010 if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
4012 ptrdiff_t hostlen = SBYTES (host);
4013 struct req
4015 struct gaicb gaicb;
4016 struct addrinfo hints;
4017 char str[FLEXIBLE_ARRAY_MEMBER];
4018 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4019 hostlen + 1 + portstringlen + 1));
4020 dns_request = &req->gaicb;
4021 dns_request->ar_name = req->str;
4022 dns_request->ar_service = req->str + hostlen + 1;
4023 dns_request->ar_request = &req->hints;
4024 dns_request->ar_result = NULL;
4025 memset (&req->hints, 0, sizeof req->hints);
4026 req->hints.ai_family = family;
4027 req->hints.ai_socktype = socktype;
4028 strcpy (req->str, SSDATA (host));
4029 strcpy (req->str + hostlen + 1, portstring);
4031 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4032 if (ret)
4033 error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
4035 goto open_socket;
4037 #endif /* HAVE_GETADDRINFO_A */
4039 /* If we have a host, use getaddrinfo to resolve both host and service.
4040 Otherwise, use getservbyname to lookup the service. */
4042 if (!NILP (host))
4044 struct addrinfo *res, *lres;
4045 int ret;
4047 maybe_quit ();
4049 struct addrinfo hints;
4050 memset (&hints, 0, sizeof hints);
4051 hints.ai_family = family;
4052 hints.ai_socktype = socktype;
4054 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
4055 if (ret)
4056 #ifdef HAVE_GAI_STRERROR
4058 synchronize_system_messages_locale ();
4059 char const *str = gai_strerror (ret);
4060 if (! NILP (Vlocale_coding_system))
4061 str = SSDATA (code_convert_string_norecord
4062 (build_string (str), Vlocale_coding_system, 0));
4063 error ("%s/%s %s", SSDATA (host), portstring, str);
4065 #else
4066 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4067 #endif
4069 for (lres = res; lres; lres = lres->ai_next)
4070 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4072 addrinfos = Fnreverse (addrinfos);
4074 freeaddrinfo (res);
4076 goto open_socket;
4079 /* No hostname has been specified (e.g., a local server process). */
4081 if (EQ (service, Qt))
4082 port = 0;
4083 else if (INTEGERP (service))
4084 port = XINT (service);
4085 else
4087 CHECK_STRING (service);
4089 port = -1;
4090 if (SBYTES (service) != 0)
4092 /* Allow the service to be a string containing the port number,
4093 because that's allowed if you have getaddrbyname. */
4094 char *service_end;
4095 long int lport = strtol (SSDATA (service), &service_end, 10);
4096 if (service_end == SSDATA (service) + SBYTES (service))
4097 port = lport;
4098 else
4100 struct servent *svc_info
4101 = getservbyname (SSDATA (service),
4102 socktype == SOCK_DGRAM ? "udp" : "tcp");
4103 if (svc_info)
4104 port = ntohs (svc_info->s_port);
4109 if (! (0 <= port && port < 1 << 16))
4111 AUTO_STRING (unknown_service, "Unknown service: %s");
4112 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4115 open_socket:
4117 if (!NILP (buffer))
4118 buffer = Fget_buffer_create (buffer);
4120 /* Unwind bind_polling_period. */
4121 unbind_to (count, Qnil);
4123 proc = make_process (name);
4124 record_unwind_protect (remove_process, proc);
4125 p = XPROCESS (proc);
4126 pset_childp (p, contact);
4127 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
4128 pset_type (p, Qnetwork);
4130 pset_buffer (p, buffer);
4131 pset_sentinel (p, sentinel);
4132 pset_filter (p, filter);
4133 pset_log (p, Fplist_get (contact, QClog));
4134 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
4135 p->kill_without_query = 1;
4136 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
4137 pset_command (p, Qt);
4138 eassert (p->pid == 0);
4139 p->backlog = 5;
4140 eassert (! p->is_non_blocking_client);
4141 eassert (! p->is_server);
4142 p->port = port;
4143 p->socktype = socktype;
4144 #ifdef HAVE_GETADDRINFO_A
4145 eassert (! p->dns_request);
4146 #endif
4147 #ifdef HAVE_GNUTLS
4148 tem = Fplist_get (contact, QCtls_parameters);
4149 CHECK_LIST (tem);
4150 p->gnutls_boot_parameters = tem;
4151 #endif
4153 set_network_socket_coding_system (proc, host, service, name);
4155 /* :server BOOL */
4156 tem = Fplist_get (contact, QCserver);
4157 if (!NILP (tem))
4159 /* Don't support network sockets when non-blocking mode is
4160 not available, since a blocked Emacs is not useful. */
4161 p->is_server = true;
4162 if (TYPE_RANGED_INTEGERP (int, tem))
4163 p->backlog = XINT (tem);
4166 /* :nowait BOOL */
4167 if (!p->is_server && socktype != SOCK_DGRAM
4168 && !NILP (Fplist_get (contact, QCnowait)))
4169 p->is_non_blocking_client = true;
4171 bool postpone_connection = false;
4172 #ifdef HAVE_GETADDRINFO_A
4173 /* With async address resolution, the list of addresses is empty, so
4174 postpone connecting to the server. */
4175 if (!p->is_server && NILP (addrinfos))
4177 p->dns_request = dns_request;
4178 p->status = list1 (Qconnect);
4179 postpone_connection = true;
4181 #endif
4182 if (! postpone_connection)
4183 connect_network_socket (proc, addrinfos, use_external_socket_p);
4185 specpdl_ptr = specpdl + count;
4186 return proc;
4190 #ifdef HAVE_NET_IF_H
4192 #ifdef SIOCGIFCONF
4193 static Lisp_Object
4194 network_interface_list (void)
4196 struct ifconf ifconf;
4197 struct ifreq *ifreq;
4198 void *buf = NULL;
4199 ptrdiff_t buf_size = 512;
4200 int s;
4201 Lisp_Object res;
4202 ptrdiff_t count;
4204 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4205 if (s < 0)
4206 return Qnil;
4207 count = SPECPDL_INDEX ();
4208 record_unwind_protect_int (close_file_unwind, s);
4212 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
4213 ifconf.ifc_buf = buf;
4214 ifconf.ifc_len = buf_size;
4215 if (ioctl (s, SIOCGIFCONF, &ifconf))
4217 emacs_close (s);
4218 xfree (buf);
4219 return Qnil;
4222 while (ifconf.ifc_len == buf_size);
4224 res = unbind_to (count, Qnil);
4225 ifreq = ifconf.ifc_req;
4226 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
4228 struct ifreq *ifq = ifreq;
4229 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4230 #define SIZEOF_IFREQ(sif) \
4231 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4232 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4234 int len = SIZEOF_IFREQ (ifq);
4235 #else
4236 int len = sizeof (*ifreq);
4237 #endif
4238 char namebuf[sizeof (ifq->ifr_name) + 1];
4239 ifreq = (struct ifreq *) ((char *) ifreq + len);
4241 if (ifq->ifr_addr.sa_family != AF_INET)
4242 continue;
4244 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
4245 namebuf[sizeof (ifq->ifr_name)] = 0;
4246 res = Fcons (Fcons (build_string (namebuf),
4247 conv_sockaddr_to_lisp (&ifq->ifr_addr,
4248 sizeof (struct sockaddr))),
4249 res);
4252 xfree (buf);
4253 return res;
4255 #endif /* SIOCGIFCONF */
4257 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4259 struct ifflag_def {
4260 int flag_bit;
4261 const char *flag_sym;
4264 static const struct ifflag_def ifflag_table[] = {
4265 #ifdef IFF_UP
4266 { IFF_UP, "up" },
4267 #endif
4268 #ifdef IFF_BROADCAST
4269 { IFF_BROADCAST, "broadcast" },
4270 #endif
4271 #ifdef IFF_DEBUG
4272 { IFF_DEBUG, "debug" },
4273 #endif
4274 #ifdef IFF_LOOPBACK
4275 { IFF_LOOPBACK, "loopback" },
4276 #endif
4277 #ifdef IFF_POINTOPOINT
4278 { IFF_POINTOPOINT, "pointopoint" },
4279 #endif
4280 #ifdef IFF_RUNNING
4281 { IFF_RUNNING, "running" },
4282 #endif
4283 #ifdef IFF_NOARP
4284 { IFF_NOARP, "noarp" },
4285 #endif
4286 #ifdef IFF_PROMISC
4287 { IFF_PROMISC, "promisc" },
4288 #endif
4289 #ifdef IFF_NOTRAILERS
4290 #ifdef NS_IMPL_COCOA
4291 /* Really means smart, notrailers is obsolete. */
4292 { IFF_NOTRAILERS, "smart" },
4293 #else
4294 { IFF_NOTRAILERS, "notrailers" },
4295 #endif
4296 #endif
4297 #ifdef IFF_ALLMULTI
4298 { IFF_ALLMULTI, "allmulti" },
4299 #endif
4300 #ifdef IFF_MASTER
4301 { IFF_MASTER, "master" },
4302 #endif
4303 #ifdef IFF_SLAVE
4304 { IFF_SLAVE, "slave" },
4305 #endif
4306 #ifdef IFF_MULTICAST
4307 { IFF_MULTICAST, "multicast" },
4308 #endif
4309 #ifdef IFF_PORTSEL
4310 { IFF_PORTSEL, "portsel" },
4311 #endif
4312 #ifdef IFF_AUTOMEDIA
4313 { IFF_AUTOMEDIA, "automedia" },
4314 #endif
4315 #ifdef IFF_DYNAMIC
4316 { IFF_DYNAMIC, "dynamic" },
4317 #endif
4318 #ifdef IFF_OACTIVE
4319 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress. */
4320 #endif
4321 #ifdef IFF_SIMPLEX
4322 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4323 #endif
4324 #ifdef IFF_LINK0
4325 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit. */
4326 #endif
4327 #ifdef IFF_LINK1
4328 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit. */
4329 #endif
4330 #ifdef IFF_LINK2
4331 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit. */
4332 #endif
4333 { 0, 0 }
4336 static Lisp_Object
4337 network_interface_info (Lisp_Object ifname)
4339 struct ifreq rq;
4340 Lisp_Object res = Qnil;
4341 Lisp_Object elt;
4342 int s;
4343 bool any = 0;
4344 ptrdiff_t count;
4345 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4346 && defined HAVE_GETIFADDRS && defined LLADDR)
4347 struct ifaddrs *ifap;
4348 #endif
4350 CHECK_STRING (ifname);
4352 if (sizeof rq.ifr_name <= SBYTES (ifname))
4353 error ("interface name too long");
4354 lispstpcpy (rq.ifr_name, ifname);
4356 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4357 if (s < 0)
4358 return Qnil;
4359 count = SPECPDL_INDEX ();
4360 record_unwind_protect_int (close_file_unwind, s);
4362 elt = Qnil;
4363 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4364 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4366 int flags = rq.ifr_flags;
4367 const struct ifflag_def *fp;
4368 int fnum;
4370 /* If flags is smaller than int (i.e. short) it may have the high bit set
4371 due to IFF_MULTICAST. In that case, sign extending it into
4372 an int is wrong. */
4373 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4374 flags = (unsigned short) rq.ifr_flags;
4376 any = 1;
4377 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4379 if (flags & fp->flag_bit)
4381 elt = Fcons (intern (fp->flag_sym), elt);
4382 flags -= fp->flag_bit;
4385 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4387 if (flags & 1)
4389 elt = Fcons (make_number (fnum), elt);
4393 #endif
4394 res = Fcons (elt, res);
4396 elt = Qnil;
4397 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4398 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4400 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4401 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4402 int n;
4404 any = 1;
4405 for (n = 0; n < 6; n++)
4406 p->contents[n] = make_number (((unsigned char *)
4407 &rq.ifr_hwaddr.sa_data[0])
4408 [n]);
4409 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4411 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4412 if (getifaddrs (&ifap) != -1)
4414 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4415 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4416 struct ifaddrs *it;
4418 for (it = ifap; it != NULL; it = it->ifa_next)
4420 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4421 unsigned char linkaddr[6];
4422 int n;
4424 if (it->ifa_addr->sa_family != AF_LINK
4425 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4426 || sdl->sdl_alen != 6)
4427 continue;
4429 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4430 for (n = 0; n < 6; n++)
4431 p->contents[n] = make_number (linkaddr[n]);
4433 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
4434 break;
4437 #ifdef HAVE_FREEIFADDRS
4438 freeifaddrs (ifap);
4439 #endif
4441 #endif /* HAVE_GETIFADDRS && LLADDR */
4443 res = Fcons (elt, res);
4445 elt = Qnil;
4446 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4447 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4449 any = 1;
4450 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4451 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4452 #else
4453 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4454 #endif
4456 #endif
4457 res = Fcons (elt, res);
4459 elt = Qnil;
4460 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4461 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4463 any = 1;
4464 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4466 #endif
4467 res = Fcons (elt, res);
4469 elt = Qnil;
4470 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4471 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4473 any = 1;
4474 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4476 #endif
4477 res = Fcons (elt, res);
4479 return unbind_to (count, any ? res : Qnil);
4481 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4482 #endif /* defined (HAVE_NET_IF_H) */
4484 DEFUN ("network-interface-list", Fnetwork_interface_list,
4485 Snetwork_interface_list, 0, 0, 0,
4486 doc: /* Return an alist of all network interfaces and their network address.
4487 Each element is a cons, the car of which is a string containing the
4488 interface name, and the cdr is the network address in internal
4489 format; see the description of ADDRESS in `make-network-process'.
4491 If the information is not available, return nil. */)
4492 (void)
4494 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4495 return network_interface_list ();
4496 #else
4497 return Qnil;
4498 #endif
4501 DEFUN ("network-interface-info", Fnetwork_interface_info,
4502 Snetwork_interface_info, 1, 1, 0,
4503 doc: /* Return information about network interface named IFNAME.
4504 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4505 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4506 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4507 FLAGS is the current flags of the interface.
4509 Data that is unavailable is returned as nil. */)
4510 (Lisp_Object ifname)
4512 #if ((defined HAVE_NET_IF_H \
4513 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4514 || defined SIOCGIFFLAGS)) \
4515 || defined WINDOWSNT)
4516 return network_interface_info (ifname);
4517 #else
4518 return Qnil;
4519 #endif
4522 /* Turn off input and output for process PROC. */
4524 static void
4525 deactivate_process (Lisp_Object proc)
4527 int inchannel;
4528 struct Lisp_Process *p = XPROCESS (proc);
4529 int i;
4531 #ifdef HAVE_GNUTLS
4532 /* Delete GnuTLS structures in PROC, if any. */
4533 emacs_gnutls_deinit (proc);
4534 #endif /* HAVE_GNUTLS */
4536 if (p->read_output_delay > 0)
4538 if (--process_output_delay_count < 0)
4539 process_output_delay_count = 0;
4540 p->read_output_delay = 0;
4541 p->read_output_skip = 0;
4544 /* Beware SIGCHLD hereabouts. */
4546 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4547 close_process_fd (&p->open_fd[i]);
4549 inchannel = p->infd;
4550 if (inchannel >= 0)
4552 p->infd = -1;
4553 p->outfd = -1;
4554 #ifdef DATAGRAM_SOCKETS
4555 if (DATAGRAM_CHAN_P (inchannel))
4557 xfree (datagram_address[inchannel].sa);
4558 datagram_address[inchannel].sa = 0;
4559 datagram_address[inchannel].len = 0;
4561 #endif
4562 chan_process[inchannel] = Qnil;
4563 delete_read_fd (inchannel);
4564 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4565 delete_write_fd (inchannel);
4566 if (inchannel == max_desc)
4567 recompute_max_desc ();
4572 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4573 0, 4, 0,
4574 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4575 It is given to their filter functions.
4576 Optional argument PROCESS means do not return until output has been
4577 received from PROCESS.
4579 Optional second argument SECONDS and third argument MILLISEC
4580 specify a timeout; return after that much time even if there is
4581 no subprocess output. If SECONDS is a floating point number,
4582 it specifies a fractional number of seconds to wait.
4583 The MILLISEC argument is obsolete and should be avoided.
4585 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4586 from PROCESS only, suspending reading output from other processes.
4587 If JUST-THIS-ONE is an integer, don't run any timers either.
4588 Return non-nil if we received any output from PROCESS (or, if PROCESS
4589 is nil, from any process) before the timeout expired. */)
4590 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4591 Lisp_Object just_this_one)
4593 intmax_t secs;
4594 int nsecs;
4596 if (! NILP (process))
4598 CHECK_PROCESS (process);
4599 struct Lisp_Process *proc = XPROCESS (process);
4601 /* Can't wait for a process that is dedicated to a different
4602 thread. */
4603 if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ()))
4605 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4607 if (STRINGP (proc_thread_name))
4608 error ("Attempt to accept output from process %s locked to thread %s",
4609 SDATA (proc->name), SDATA (proc_thread_name));
4610 else
4611 error ("Attempt to accept output from process %s locked to thread %p",
4612 SDATA (proc->name), XTHREAD (proc->thread));
4615 else
4616 just_this_one = Qnil;
4618 if (!NILP (millisec))
4619 { /* Obsolete calling convention using integers rather than floats. */
4620 CHECK_NUMBER (millisec);
4621 if (NILP (seconds))
4622 seconds = make_float (XINT (millisec) / 1000.0);
4623 else
4625 CHECK_NUMBER (seconds);
4626 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4630 secs = 0;
4631 nsecs = -1;
4633 if (!NILP (seconds))
4635 if (INTEGERP (seconds))
4637 if (XINT (seconds) > 0)
4639 secs = XINT (seconds);
4640 nsecs = 0;
4643 else if (FLOATP (seconds))
4645 if (XFLOAT_DATA (seconds) > 0)
4647 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4648 secs = min (t.tv_sec, WAIT_READING_MAX);
4649 nsecs = t.tv_nsec;
4652 else
4653 wrong_type_argument (Qnumberp, seconds);
4655 else if (! NILP (process))
4656 nsecs = 0;
4658 return
4659 ((wait_reading_process_output (secs, nsecs, 0, 0,
4660 Qnil,
4661 !NILP (process) ? XPROCESS (process) : NULL,
4662 (NILP (just_this_one) ? 0
4663 : !INTEGERP (just_this_one) ? 1 : -1))
4664 <= 0)
4665 ? Qnil : Qt);
4668 /* Accept a connection for server process SERVER on CHANNEL. */
4670 static EMACS_INT connect_counter = 0;
4672 static void
4673 server_accept_connection (Lisp_Object server, int channel)
4675 Lisp_Object buffer;
4676 Lisp_Object contact, host, service;
4677 struct Lisp_Process *ps = XPROCESS (server);
4678 struct Lisp_Process *p;
4679 int s;
4680 union u_sockaddr {
4681 struct sockaddr sa;
4682 struct sockaddr_in in;
4683 #ifdef AF_INET6
4684 struct sockaddr_in6 in6;
4685 #endif
4686 #ifdef HAVE_LOCAL_SOCKETS
4687 struct sockaddr_un un;
4688 #endif
4689 } saddr;
4690 socklen_t len = sizeof saddr;
4691 ptrdiff_t count;
4693 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4695 if (s < 0)
4697 int code = errno;
4698 if (!would_block (code) && !NILP (ps->log))
4699 call3 (ps->log, server, Qnil,
4700 concat3 (build_string ("accept failed with code"),
4701 Fnumber_to_string (make_number (code)),
4702 build_string ("\n")));
4703 return;
4706 count = SPECPDL_INDEX ();
4707 record_unwind_protect_int (close_file_unwind, s);
4709 connect_counter++;
4711 /* Setup a new process to handle the connection. */
4713 /* Generate a unique identification of the caller, and build contact
4714 information for this process. */
4715 host = Qt;
4716 service = Qnil;
4717 Lisp_Object args[11];
4718 int nargs = 0;
4719 AUTO_STRING (procname_format_in, "%s <%d.%d.%d.%d:%d>");
4720 AUTO_STRING (procname_format_in6, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4721 AUTO_STRING (procname_format_default, "%s <%d>");
4722 switch (saddr.sa.sa_family)
4724 case AF_INET:
4726 args[nargs++] = procname_format_in;
4727 nargs++;
4728 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4729 service = make_number (ntohs (saddr.in.sin_port));
4730 for (int i = 0; i < 4; i++)
4731 args[nargs++] = make_number (ip[i]);
4732 args[nargs++] = service;
4734 break;
4736 #ifdef AF_INET6
4737 case AF_INET6:
4739 args[nargs++] = procname_format_in6;
4740 nargs++;
4741 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4742 service = make_number (ntohs (saddr.in.sin_port));
4743 for (int i = 0; i < 8; i++)
4744 args[nargs++] = make_number (ip6[i]);
4745 args[nargs++] = service;
4747 break;
4748 #endif
4750 default:
4751 args[nargs++] = procname_format_default;
4752 nargs++;
4753 args[nargs++] = make_number (connect_counter);
4754 break;
4757 /* Create a new buffer name for this process if it doesn't have a
4758 filter. The new buffer name is based on the buffer name or
4759 process name of the server process concatenated with the caller
4760 identification. */
4762 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4763 || EQ (ps->filter, Qt)))
4764 buffer = Qnil;
4765 else
4767 buffer = ps->buffer;
4768 if (!NILP (buffer))
4769 buffer = Fbuffer_name (buffer);
4770 else
4771 buffer = ps->name;
4772 if (!NILP (buffer))
4774 args[1] = buffer;
4775 buffer = Fget_buffer_create (Fformat (nargs, args));
4779 /* Generate a unique name for the new server process. Combine the
4780 server process name with the caller identification. */
4782 args[1] = ps->name;
4783 Lisp_Object name = Fformat (nargs, args);
4784 Lisp_Object proc = make_process (name);
4786 chan_process[s] = proc;
4788 fcntl (s, F_SETFL, O_NONBLOCK);
4790 p = XPROCESS (proc);
4792 /* Build new contact information for this setup. */
4793 contact = Fcopy_sequence (ps->childp);
4794 contact = Fplist_put (contact, QCserver, Qnil);
4795 contact = Fplist_put (contact, QChost, host);
4796 if (!NILP (service))
4797 contact = Fplist_put (contact, QCservice, service);
4798 contact = Fplist_put (contact, QCremote,
4799 conv_sockaddr_to_lisp (&saddr.sa, len));
4800 #ifdef HAVE_GETSOCKNAME
4801 len = sizeof saddr;
4802 if (getsockname (s, &saddr.sa, &len) == 0)
4803 contact = Fplist_put (contact, QClocal,
4804 conv_sockaddr_to_lisp (&saddr.sa, len));
4805 #endif
4807 pset_childp (p, contact);
4808 pset_plist (p, Fcopy_sequence (ps->plist));
4809 pset_type (p, Qnetwork);
4811 pset_buffer (p, buffer);
4812 pset_sentinel (p, ps->sentinel);
4813 pset_filter (p, ps->filter);
4814 eassert (NILP (p->command));
4815 eassert (p->pid == 0);
4817 /* Discard the unwind protect for closing S. */
4818 specpdl_ptr = specpdl + count;
4820 p->open_fd[SUBPROCESS_STDIN] = s;
4821 p->infd = s;
4822 p->outfd = s;
4823 pset_status (p, Qrun);
4825 /* Client processes for accepted connections are not stopped initially. */
4826 if (!EQ (p->filter, Qt))
4827 add_process_read_fd (s);
4828 if (s > max_desc)
4829 max_desc = s;
4831 /* Setup coding system for new process based on server process.
4832 This seems to be the proper thing to do, as the coding system
4833 of the new process should reflect the settings at the time the
4834 server socket was opened; not the current settings. */
4836 pset_decode_coding_system (p, ps->decode_coding_system);
4837 pset_encode_coding_system (p, ps->encode_coding_system);
4838 setup_process_coding_systems (proc);
4840 pset_decoding_buf (p, empty_unibyte_string);
4841 eassert (p->decoding_carryover == 0);
4842 pset_encoding_buf (p, empty_unibyte_string);
4844 p->inherit_coding_system_flag
4845 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4847 AUTO_STRING (dash, "-");
4848 AUTO_STRING (nl, "\n");
4849 Lisp_Object host_string = STRINGP (host) ? host : dash;
4851 if (!NILP (ps->log))
4853 AUTO_STRING (accept_from, "accept from ");
4854 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
4857 AUTO_STRING (open_from, "open from ");
4858 exec_sentinel (proc, concat3 (open_from, host_string, nl));
4861 #ifdef HAVE_GETADDRINFO_A
4862 static Lisp_Object
4863 check_for_dns (Lisp_Object proc)
4865 struct Lisp_Process *p = XPROCESS (proc);
4866 Lisp_Object addrinfos = Qnil;
4868 /* Sanity check. */
4869 if (! p->dns_request)
4870 return Qnil;
4872 int ret = gai_error (p->dns_request);
4873 if (ret == EAI_INPROGRESS)
4874 return Qt;
4876 /* We got a response. */
4877 if (ret == 0)
4879 struct addrinfo *res;
4881 for (res = p->dns_request->ar_result; res; res = res->ai_next)
4882 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
4884 addrinfos = Fnreverse (addrinfos);
4886 /* The DNS lookup failed. */
4887 else if (connecting_status (p->status))
4889 deactivate_process (proc);
4890 pset_status (p, (list2
4891 (Qfailed,
4892 concat3 (build_string ("Name lookup of "),
4893 build_string (p->dns_request->ar_name),
4894 build_string (" failed")))));
4897 free_dns_request (proc);
4899 /* This process should not already be connected (or killed). */
4900 if (! connecting_status (p->status))
4901 return Qnil;
4903 return addrinfos;
4906 #endif /* HAVE_GETADDRINFO_A */
4908 static void
4909 wait_for_socket_fds (Lisp_Object process, char const *name)
4911 while (XPROCESS (process)->infd < 0
4912 && connecting_status (XPROCESS (process)->status))
4914 add_to_log ("Waiting for socket from %s...", build_string (name));
4915 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4919 static void
4920 wait_while_connecting (Lisp_Object process)
4922 while (connecting_status (XPROCESS (process)->status))
4924 add_to_log ("Waiting for connection...");
4925 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4929 static void
4930 wait_for_tls_negotiation (Lisp_Object process)
4932 #ifdef HAVE_GNUTLS
4933 while (XPROCESS (process)->gnutls_p
4934 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
4936 add_to_log ("Waiting for TLS...");
4937 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4939 #endif
4942 static void
4943 wait_reading_process_output_unwind (int data)
4945 clear_waiting_thread_info ();
4946 waiting_for_user_input_p = data;
4949 /* This is here so breakpoints can be put on it. */
4950 static void
4951 wait_reading_process_output_1 (void)
4955 /* Read and dispose of subprocess output while waiting for timeout to
4956 elapse and/or keyboard input to be available.
4958 TIME_LIMIT is:
4959 timeout in seconds
4960 If negative, gobble data immediately available but don't wait for any.
4962 NSECS is:
4963 an additional duration to wait, measured in nanoseconds
4964 If TIME_LIMIT is zero, then:
4965 If NSECS == 0, there is no limit.
4966 If NSECS > 0, the timeout consists of NSECS only.
4967 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4969 READ_KBD is:
4970 0 to ignore keyboard input, or
4971 1 to return when input is available, or
4972 -1 meaning caller will actually read the input, so don't throw to
4973 the quit handler
4975 DO_DISPLAY means redisplay should be done to show subprocess
4976 output that arrives.
4978 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4979 (and gobble terminal input into the buffer if any arrives).
4981 If WAIT_PROC is specified, wait until something arrives from that
4982 process.
4984 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4985 (suspending output from other processes). A negative value
4986 means don't run any timers either.
4988 Return positive if we received input from WAIT_PROC (or from any
4989 process if WAIT_PROC is null), zero if we attempted to receive
4990 input but got none, and negative if we didn't even try. */
4993 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4994 bool do_display,
4995 Lisp_Object wait_for_cell,
4996 struct Lisp_Process *wait_proc, int just_wait_proc)
4998 int channel, nfds;
4999 fd_set Available;
5000 fd_set Writeok;
5001 bool check_write;
5002 int check_delay;
5003 bool no_avail;
5004 int xerrno;
5005 Lisp_Object proc;
5006 struct timespec timeout, end_time, timer_delay;
5007 struct timespec got_output_end_time = invalid_timespec ();
5008 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
5009 int got_some_output = -1;
5010 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5011 bool retry_for_async;
5012 #endif
5013 ptrdiff_t count = SPECPDL_INDEX ();
5015 /* Close to the current time if known, an invalid timespec otherwise. */
5016 struct timespec now = invalid_timespec ();
5018 eassert (wait_proc == NULL
5019 || EQ (wait_proc->thread, Qnil)
5020 || XTHREAD (wait_proc->thread) == current_thread);
5022 FD_ZERO (&Available);
5023 FD_ZERO (&Writeok);
5025 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5026 && !(CONSP (wait_proc->status)
5027 && EQ (XCAR (wait_proc->status), Qexit)))
5028 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5030 record_unwind_protect_int (wait_reading_process_output_unwind,
5031 waiting_for_user_input_p);
5032 waiting_for_user_input_p = read_kbd;
5034 if (TYPE_MAXIMUM (time_t) < time_limit)
5035 time_limit = TYPE_MAXIMUM (time_t);
5037 if (time_limit < 0 || nsecs < 0)
5038 wait = MINIMUM;
5039 else if (time_limit > 0 || nsecs > 0)
5041 wait = TIMEOUT;
5042 now = current_timespec ();
5043 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5045 else
5046 wait = INFINITY;
5048 while (1)
5050 bool process_skipped = false;
5052 /* If calling from keyboard input, do not quit
5053 since we want to return C-g as an input character.
5054 Otherwise, do pending quit if requested. */
5055 if (read_kbd >= 0)
5056 maybe_quit ();
5057 else if (pending_signals)
5058 process_pending_signals ();
5060 /* Exit now if the cell we're waiting for became non-nil. */
5061 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5062 break;
5064 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5066 Lisp_Object process_list_head, aproc;
5067 struct Lisp_Process *p;
5069 retry_for_async = false;
5070 FOR_EACH_PROCESS(process_list_head, aproc)
5072 p = XPROCESS (aproc);
5074 if (! wait_proc || p == wait_proc)
5076 #ifdef HAVE_GETADDRINFO_A
5077 /* Check for pending DNS requests. */
5078 if (p->dns_request)
5080 Lisp_Object addrinfos = check_for_dns (aproc);
5081 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5082 connect_network_socket (aproc, addrinfos, Qnil);
5083 else
5084 retry_for_async = true;
5086 #endif
5087 #ifdef HAVE_GNUTLS
5088 /* Continue TLS negotiation. */
5089 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5090 && p->is_non_blocking_client)
5092 gnutls_try_handshake (p);
5093 p->gnutls_handshakes_tried++;
5095 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5097 gnutls_verify_boot (aproc, Qnil);
5098 finish_after_tls_connection (aproc);
5100 else
5102 retry_for_async = true;
5103 if (p->gnutls_handshakes_tried
5104 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5106 deactivate_process (aproc);
5107 pset_status (p, list2 (Qfailed,
5108 build_string ("TLS negotiation failed")));
5112 #endif
5116 #endif /* GETADDRINFO_A or GNUTLS */
5118 /* Compute time from now till when time limit is up. */
5119 /* Exit if already run out. */
5120 if (wait == TIMEOUT)
5122 if (!timespec_valid_p (now))
5123 now = current_timespec ();
5124 if (timespec_cmp (end_time, now) <= 0)
5125 break;
5126 timeout = timespec_sub (end_time, now);
5128 else
5129 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5131 /* Normally we run timers here.
5132 But not if wait_for_cell; in those cases,
5133 the wait is supposed to be short,
5134 and those callers cannot handle running arbitrary Lisp code here. */
5135 if (NILP (wait_for_cell)
5136 && just_wait_proc >= 0)
5140 unsigned old_timers_run = timers_run;
5141 struct buffer *old_buffer = current_buffer;
5142 Lisp_Object old_window = selected_window;
5144 timer_delay = timer_check ();
5146 /* If a timer has run, this might have changed buffers
5147 an alike. Make read_key_sequence aware of that. */
5148 if (timers_run != old_timers_run
5149 && (old_buffer != current_buffer
5150 || !EQ (old_window, selected_window))
5151 && waiting_for_user_input_p == -1)
5152 record_asynch_buffer_change ();
5154 if (timers_run != old_timers_run && do_display)
5155 /* We must retry, since a timer may have requeued itself
5156 and that could alter the time_delay. */
5157 redisplay_preserve_echo_area (9);
5158 else
5159 break;
5161 while (!detect_input_pending ());
5163 /* If there is unread keyboard input, also return. */
5164 if (read_kbd != 0
5165 && requeued_events_pending_p ())
5166 break;
5168 /* This is so a breakpoint can be put here. */
5169 if (!timespec_valid_p (timer_delay))
5170 wait_reading_process_output_1 ();
5173 /* Cause C-g and alarm signals to take immediate action,
5174 and cause input available signals to zero out timeout.
5176 It is important that we do this before checking for process
5177 activity. If we get a SIGCHLD after the explicit checks for
5178 process activity, timeout is the only way we will know. */
5179 if (read_kbd < 0)
5180 set_waiting_for_input (&timeout);
5182 /* If status of something has changed, and no input is
5183 available, notify the user of the change right away. After
5184 this explicit check, we'll let the SIGCHLD handler zap
5185 timeout to get our attention. */
5186 if (update_tick != process_tick)
5188 fd_set Atemp;
5189 fd_set Ctemp;
5191 if (kbd_on_hold_p ())
5192 FD_ZERO (&Atemp);
5193 else
5194 compute_input_wait_mask (&Atemp);
5195 compute_write_mask (&Ctemp);
5197 timeout = make_timespec (0, 0);
5198 if ((thread_select (pselect, max_desc + 1,
5199 &Atemp,
5200 (num_pending_connects > 0 ? &Ctemp : NULL),
5201 NULL, &timeout, NULL)
5202 <= 0))
5204 /* It's okay for us to do this and then continue with
5205 the loop, since timeout has already been zeroed out. */
5206 clear_waiting_for_input ();
5207 got_some_output = status_notify (NULL, wait_proc);
5208 if (do_display) redisplay_preserve_echo_area (13);
5212 /* Don't wait for output from a non-running process. Just
5213 read whatever data has already been received. */
5214 if (wait_proc && wait_proc->raw_status_new)
5215 update_status (wait_proc);
5216 if (wait_proc
5217 && ! EQ (wait_proc->status, Qrun)
5218 && ! connecting_status (wait_proc->status))
5220 bool read_some_bytes = false;
5222 clear_waiting_for_input ();
5224 /* If data can be read from the process, do so until exhausted. */
5225 if (wait_proc->infd >= 0)
5227 XSETPROCESS (proc, wait_proc);
5229 while (true)
5231 int nread = read_process_output (proc, wait_proc->infd);
5232 if (nread < 0)
5234 if (errno == EIO || would_block (errno))
5235 break;
5237 else
5239 if (got_some_output < nread)
5240 got_some_output = nread;
5241 if (nread == 0)
5242 break;
5243 read_some_bytes = true;
5248 if (read_some_bytes && do_display)
5249 redisplay_preserve_echo_area (10);
5251 break;
5254 /* Wait till there is something to do. */
5256 if (wait_proc && just_wait_proc)
5258 if (wait_proc->infd < 0) /* Terminated. */
5259 break;
5260 FD_SET (wait_proc->infd, &Available);
5261 check_delay = 0;
5262 check_write = 0;
5264 else if (!NILP (wait_for_cell))
5266 compute_non_process_wait_mask (&Available);
5267 check_delay = 0;
5268 check_write = 0;
5270 else
5272 if (! read_kbd)
5273 compute_non_keyboard_wait_mask (&Available);
5274 else
5275 compute_input_wait_mask (&Available);
5276 compute_write_mask (&Writeok);
5277 check_delay = wait_proc ? 0 : process_output_delay_count;
5278 check_write = true;
5281 /* If frame size has changed or the window is newly mapped,
5282 redisplay now, before we start to wait. There is a race
5283 condition here; if a SIGIO arrives between now and the select
5284 and indicates that a frame is trashed, the select may block
5285 displaying a trashed screen. */
5286 if (frame_garbaged && do_display)
5288 clear_waiting_for_input ();
5289 redisplay_preserve_echo_area (11);
5290 if (read_kbd < 0)
5291 set_waiting_for_input (&timeout);
5294 /* Skip the `select' call if input is available and we're
5295 waiting for keyboard input or a cell change (which can be
5296 triggered by processing X events). In the latter case, set
5297 nfds to 1 to avoid breaking the loop. */
5298 no_avail = 0;
5299 if ((read_kbd || !NILP (wait_for_cell))
5300 && detect_input_pending ())
5302 nfds = read_kbd ? 0 : 1;
5303 no_avail = 1;
5304 FD_ZERO (&Available);
5306 else
5308 /* Set the timeout for adaptive read buffering if any
5309 process has non-zero read_output_skip and non-zero
5310 read_output_delay, and we are not reading output for a
5311 specific process. It is not executed if
5312 Vprocess_adaptive_read_buffering is nil. */
5313 if (process_output_skip && check_delay > 0)
5315 int adaptive_nsecs = timeout.tv_nsec;
5316 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5317 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5318 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5320 proc = chan_process[channel];
5321 if (NILP (proc))
5322 continue;
5323 /* Find minimum non-zero read_output_delay among the
5324 processes with non-zero read_output_skip. */
5325 if (XPROCESS (proc)->read_output_delay > 0)
5327 check_delay--;
5328 if (!XPROCESS (proc)->read_output_skip)
5329 continue;
5330 FD_CLR (channel, &Available);
5331 process_skipped = true;
5332 XPROCESS (proc)->read_output_skip = 0;
5333 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5334 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5337 timeout = make_timespec (0, adaptive_nsecs);
5338 process_output_skip = 0;
5341 /* If we've got some output and haven't limited our timeout
5342 with adaptive read buffering, limit it. */
5343 if (got_some_output > 0 && !process_skipped
5344 && (timeout.tv_sec
5345 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5346 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5349 if (NILP (wait_for_cell) && just_wait_proc >= 0
5350 && timespec_valid_p (timer_delay)
5351 && timespec_cmp (timer_delay, timeout) < 0)
5353 if (!timespec_valid_p (now))
5354 now = current_timespec ();
5355 struct timespec timeout_abs = timespec_add (now, timeout);
5356 if (!timespec_valid_p (got_output_end_time)
5357 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5358 got_output_end_time = timeout_abs;
5359 timeout = timer_delay;
5361 else
5362 got_output_end_time = invalid_timespec ();
5364 /* NOW can become inaccurate if time can pass during pselect. */
5365 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5366 now = invalid_timespec ();
5368 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5369 if (retry_for_async
5370 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5372 timeout.tv_sec = 0;
5373 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5375 #endif
5377 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5378 #if defined HAVE_GLIB && !defined HAVE_NS
5379 nfds = xg_select (max_desc + 1,
5380 &Available, (check_write ? &Writeok : 0),
5381 NULL, &timeout, NULL);
5382 #elif defined HAVE_NS
5383 /* And NS builds call thread_select in ns_select. */
5384 nfds = ns_select (max_desc + 1,
5385 &Available, (check_write ? &Writeok : 0),
5386 NULL, &timeout, NULL);
5387 #else /* !HAVE_GLIB */
5388 nfds = thread_select (pselect, max_desc + 1,
5389 &Available,
5390 (check_write ? &Writeok : 0),
5391 NULL, &timeout, NULL);
5392 #endif /* !HAVE_GLIB */
5394 #ifdef HAVE_GNUTLS
5395 /* GnuTLS buffers data internally. In lowat mode it leaves
5396 some data in the TCP buffers so that select works, but
5397 with custom pull/push functions we need to check if some
5398 data is available in the buffers manually. */
5399 if (nfds == 0)
5401 fd_set tls_available;
5402 int set = 0;
5404 FD_ZERO (&tls_available);
5405 if (! wait_proc)
5407 /* We're not waiting on a specific process, so loop
5408 through all the channels and check for data.
5409 This is a workaround needed for some versions of
5410 the gnutls library -- 2.12.14 has been confirmed
5411 to need it. See
5412 http://comments.gmane.org/gmane.emacs.devel/145074 */
5413 for (channel = 0; channel < FD_SETSIZE; ++channel)
5414 if (! NILP (chan_process[channel]))
5416 struct Lisp_Process *p =
5417 XPROCESS (chan_process[channel]);
5418 if (p && p->gnutls_p && p->gnutls_state
5419 && ((emacs_gnutls_record_check_pending
5420 (p->gnutls_state))
5421 > 0))
5423 nfds++;
5424 eassert (p->infd == channel);
5425 FD_SET (p->infd, &tls_available);
5426 set++;
5430 else
5432 /* Check this specific channel. */
5433 if (wait_proc->gnutls_p /* Check for valid process. */
5434 && wait_proc->gnutls_state
5435 /* Do we have pending data? */
5436 && ((emacs_gnutls_record_check_pending
5437 (wait_proc->gnutls_state))
5438 > 0))
5440 nfds = 1;
5441 eassert (0 <= wait_proc->infd);
5442 /* Set to Available. */
5443 FD_SET (wait_proc->infd, &tls_available);
5444 set++;
5447 if (set)
5448 Available = tls_available;
5450 #endif
5453 xerrno = errno;
5455 /* Make C-g and alarm signals set flags again. */
5456 clear_waiting_for_input ();
5458 /* If we woke up due to SIGWINCH, actually change size now. */
5459 do_pending_window_change (0);
5461 if (nfds == 0)
5463 /* Exit the main loop if we've passed the requested timeout,
5464 or aren't skipping processes and got some output and
5465 haven't lowered our timeout due to timers or SIGIO and
5466 have waited a long amount of time due to repeated
5467 timers. */
5468 struct timespec huge_timespec
5469 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
5470 struct timespec cmp_time = huge_timespec;
5471 if (wait < TIMEOUT)
5472 break;
5473 if (wait == TIMEOUT)
5474 cmp_time = end_time;
5475 if (!process_skipped && got_some_output > 0
5476 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5478 if (!timespec_valid_p (got_output_end_time))
5479 break;
5480 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5481 cmp_time = got_output_end_time;
5483 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5485 now = current_timespec ();
5486 if (timespec_cmp (cmp_time, now) <= 0)
5487 break;
5491 if (nfds < 0)
5493 if (xerrno == EINTR)
5494 no_avail = 1;
5495 else if (xerrno == EBADF)
5496 emacs_abort ();
5497 else
5498 report_file_errno ("Failed select", Qnil, xerrno);
5501 /* Check for keyboard input. */
5502 /* If there is any, return immediately
5503 to give it higher priority than subprocesses. */
5505 if (read_kbd != 0)
5507 unsigned old_timers_run = timers_run;
5508 struct buffer *old_buffer = current_buffer;
5509 Lisp_Object old_window = selected_window;
5510 bool leave = false;
5512 if (detect_input_pending_run_timers (do_display))
5514 swallow_events (do_display);
5515 if (detect_input_pending_run_timers (do_display))
5516 leave = true;
5519 /* If a timer has run, this might have changed buffers
5520 an alike. Make read_key_sequence aware of that. */
5521 if (timers_run != old_timers_run
5522 && waiting_for_user_input_p == -1
5523 && (old_buffer != current_buffer
5524 || !EQ (old_window, selected_window)))
5525 record_asynch_buffer_change ();
5527 if (leave)
5528 break;
5531 /* If there is unread keyboard input, also return. */
5532 if (read_kbd != 0
5533 && requeued_events_pending_p ())
5534 break;
5536 /* If we are not checking for keyboard input now,
5537 do process events (but don't run any timers).
5538 This is so that X events will be processed.
5539 Otherwise they may have to wait until polling takes place.
5540 That would causes delays in pasting selections, for example.
5542 (We used to do this only if wait_for_cell.) */
5543 if (read_kbd == 0 && detect_input_pending ())
5545 swallow_events (do_display);
5546 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5547 if (detect_input_pending ())
5548 break;
5549 #endif
5552 /* Exit now if the cell we're waiting for became non-nil. */
5553 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5554 break;
5556 #ifdef USABLE_SIGIO
5557 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5558 go read it. This can happen with X on BSD after logging out.
5559 In that case, there really is no input and no SIGIO,
5560 but select says there is input. */
5562 if (read_kbd && interrupt_input
5563 && keyboard_bit_set (&Available) && ! noninteractive)
5564 handle_input_available_signal (SIGIO);
5565 #endif
5567 /* If checking input just got us a size-change event from X,
5568 obey it now if we should. */
5569 if (read_kbd || ! NILP (wait_for_cell))
5570 do_pending_window_change (0);
5572 /* Check for data from a process. */
5573 if (no_avail || nfds == 0)
5574 continue;
5576 for (channel = 0; channel <= max_desc; ++channel)
5578 struct fd_callback_data *d = &fd_callback_info[channel];
5579 if (d->func
5580 && ((d->flags & FOR_READ
5581 && FD_ISSET (channel, &Available))
5582 || ((d->flags & FOR_WRITE)
5583 && FD_ISSET (channel, &Writeok))))
5584 d->func (channel, d->data);
5587 for (channel = 0; channel <= max_desc; channel++)
5589 if (FD_ISSET (channel, &Available)
5590 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5591 == PROCESS_FD))
5593 int nread;
5595 /* If waiting for this channel, arrange to return as
5596 soon as no more input to be processed. No more
5597 waiting. */
5598 proc = chan_process[channel];
5599 if (NILP (proc))
5600 continue;
5602 /* If this is a server stream socket, accept connection. */
5603 if (EQ (XPROCESS (proc)->status, Qlisten))
5605 server_accept_connection (proc, channel);
5606 continue;
5609 /* Read data from the process, starting with our
5610 buffered-ahead character if we have one. */
5612 nread = read_process_output (proc, channel);
5613 if ((!wait_proc || wait_proc == XPROCESS (proc))
5614 && got_some_output < nread)
5615 got_some_output = nread;
5616 if (nread > 0)
5618 /* Vacuum up any leftovers without waiting. */
5619 if (wait_proc == XPROCESS (proc))
5620 wait = MINIMUM;
5621 /* Since read_process_output can run a filter,
5622 which can call accept-process-output,
5623 don't try to read from any other processes
5624 before doing the select again. */
5625 FD_ZERO (&Available);
5627 if (do_display)
5628 redisplay_preserve_echo_area (12);
5630 else if (nread == -1 && would_block (errno))
5632 #ifdef WINDOWSNT
5633 /* FIXME: Is this special case still needed? */
5634 /* Note that we cannot distinguish between no input
5635 available now and a closed pipe.
5636 With luck, a closed pipe will be accompanied by
5637 subprocess termination and SIGCHLD. */
5638 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5639 && !PIPECONN_P (proc))
5641 #endif
5642 #ifdef HAVE_PTYS
5643 /* On some OSs with ptys, when the process on one end of
5644 a pty exits, the other end gets an error reading with
5645 errno = EIO instead of getting an EOF (0 bytes read).
5646 Therefore, if we get an error reading and errno =
5647 EIO, just continue, because the child process has
5648 exited and should clean itself up soon (e.g. when we
5649 get a SIGCHLD). */
5650 else if (nread == -1 && errno == EIO)
5652 struct Lisp_Process *p = XPROCESS (proc);
5654 /* Clear the descriptor now, so we only raise the
5655 signal once. */
5656 delete_read_fd (channel);
5658 if (p->pid == -2)
5660 /* If the EIO occurs on a pty, the SIGCHLD handler's
5661 waitpid call will not find the process object to
5662 delete. Do it here. */
5663 p->tick = ++process_tick;
5664 pset_status (p, Qfailed);
5667 #endif /* HAVE_PTYS */
5668 /* If we can detect process termination, don't consider the
5669 process gone just because its pipe is closed. */
5670 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5671 && !PIPECONN_P (proc))
5673 else if (nread == 0 && PIPECONN_P (proc))
5675 /* Preserve status of processes already terminated. */
5676 XPROCESS (proc)->tick = ++process_tick;
5677 deactivate_process (proc);
5678 if (EQ (XPROCESS (proc)->status, Qrun))
5679 pset_status (XPROCESS (proc),
5680 list2 (Qexit, make_number (0)));
5682 else
5684 /* Preserve status of processes already terminated. */
5685 XPROCESS (proc)->tick = ++process_tick;
5686 deactivate_process (proc);
5687 if (XPROCESS (proc)->raw_status_new)
5688 update_status (XPROCESS (proc));
5689 if (EQ (XPROCESS (proc)->status, Qrun))
5690 pset_status (XPROCESS (proc),
5691 list2 (Qexit, make_number (256)));
5694 if (FD_ISSET (channel, &Writeok)
5695 && (fd_callback_info[channel].flags
5696 & NON_BLOCKING_CONNECT_FD) != 0)
5698 struct Lisp_Process *p;
5700 delete_write_fd (channel);
5702 proc = chan_process[channel];
5703 if (NILP (proc))
5704 continue;
5706 p = XPROCESS (proc);
5708 #ifndef WINDOWSNT
5710 socklen_t xlen = sizeof (xerrno);
5711 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5712 xerrno = errno;
5714 #else
5715 /* On MS-Windows, getsockopt clears the error for the
5716 entire process, which may not be the right thing; see
5717 w32.c. Use getpeername instead. */
5719 struct sockaddr pname;
5720 socklen_t pnamelen = sizeof (pname);
5722 /* If connection failed, getpeername will fail. */
5723 xerrno = 0;
5724 if (getpeername (channel, &pname, &pnamelen) < 0)
5726 /* Obtain connect failure code through error slippage. */
5727 char dummy;
5728 xerrno = errno;
5729 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
5730 xerrno = errno;
5733 #endif
5734 if (xerrno)
5736 Lisp_Object addrinfos
5737 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
5738 if (!NILP (addrinfos))
5739 XSETCDR (p->status, XCDR (addrinfos));
5740 else
5742 p->tick = ++process_tick;
5743 pset_status (p, list2 (Qfailed, make_number (xerrno)));
5745 deactivate_process (proc);
5746 if (!NILP (addrinfos))
5747 connect_network_socket (proc, addrinfos, Qnil);
5749 else
5751 #ifdef HAVE_GNUTLS
5752 /* If we have an incompletely set up TLS connection,
5753 then defer the sentinel signaling until
5754 later. */
5755 if (NILP (p->gnutls_boot_parameters)
5756 && !p->gnutls_p)
5757 #endif
5759 pset_status (p, Qrun);
5760 /* Execute the sentinel here. If we had relied on
5761 status_notify to do it later, it will read input
5762 from the process before calling the sentinel. */
5763 exec_sentinel (proc, build_string ("open\n"));
5766 if (0 <= p->infd && !EQ (p->filter, Qt)
5767 && !EQ (p->command, Qt))
5768 add_process_read_fd (p->infd);
5771 } /* End for each file descriptor. */
5772 } /* End while exit conditions not met. */
5774 unbind_to (count, Qnil);
5776 /* If calling from keyboard input, do not quit
5777 since we want to return C-g as an input character.
5778 Otherwise, do pending quit if requested. */
5779 if (read_kbd >= 0)
5781 /* Prevent input_pending from remaining set if we quit. */
5782 clear_input_pending ();
5783 maybe_quit ();
5786 return got_some_output;
5789 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5791 static Lisp_Object
5792 read_process_output_call (Lisp_Object fun_and_args)
5794 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5797 static Lisp_Object
5798 read_process_output_error_handler (Lisp_Object error_val)
5800 cmd_error_internal (error_val, "error in process filter: ");
5801 Vinhibit_quit = Qt;
5802 update_echo_area ();
5803 Fsleep_for (make_number (2), Qnil);
5804 return Qt;
5807 static void
5808 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5809 ssize_t nbytes,
5810 struct coding_system *coding);
5812 /* Read pending output from the process channel,
5813 starting with our buffered-ahead character if we have one.
5814 Yield number of decoded characters read.
5816 This function reads at most 4096 characters.
5817 If you want to read all available subprocess output,
5818 you must call it repeatedly until it returns zero.
5820 The characters read are decoded according to PROC's coding-system
5821 for decoding. */
5823 static int
5824 read_process_output (Lisp_Object proc, int channel)
5826 ssize_t nbytes;
5827 struct Lisp_Process *p = XPROCESS (proc);
5828 struct coding_system *coding = proc_decode_coding_system[channel];
5829 int carryover = p->decoding_carryover;
5830 enum { readmax = 4096 };
5831 ptrdiff_t count = SPECPDL_INDEX ();
5832 Lisp_Object odeactivate;
5833 char chars[sizeof coding->carryover + readmax];
5835 if (carryover)
5836 /* See the comment above. */
5837 memcpy (chars, SDATA (p->decoding_buf), carryover);
5839 #ifdef DATAGRAM_SOCKETS
5840 /* We have a working select, so proc_buffered_char is always -1. */
5841 if (DATAGRAM_CHAN_P (channel))
5843 socklen_t len = datagram_address[channel].len;
5844 nbytes = recvfrom (channel, chars + carryover, readmax,
5845 0, datagram_address[channel].sa, &len);
5847 else
5848 #endif
5850 bool buffered = proc_buffered_char[channel] >= 0;
5851 if (buffered)
5853 chars[carryover] = proc_buffered_char[channel];
5854 proc_buffered_char[channel] = -1;
5856 #ifdef HAVE_GNUTLS
5857 if (p->gnutls_p && p->gnutls_state)
5858 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
5859 readmax - buffered);
5860 else
5861 #endif
5862 nbytes = emacs_read (channel, chars + carryover + buffered,
5863 readmax - buffered);
5864 if (nbytes > 0 && p->adaptive_read_buffering)
5866 int delay = p->read_output_delay;
5867 if (nbytes < 256)
5869 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5871 if (delay == 0)
5872 process_output_delay_count++;
5873 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5876 else if (delay > 0 && nbytes == readmax - buffered)
5878 delay -= READ_OUTPUT_DELAY_INCREMENT;
5879 if (delay == 0)
5880 process_output_delay_count--;
5882 p->read_output_delay = delay;
5883 if (delay)
5885 p->read_output_skip = 1;
5886 process_output_skip = 1;
5889 nbytes += buffered;
5890 nbytes += buffered && nbytes <= 0;
5893 p->decoding_carryover = 0;
5895 /* At this point, NBYTES holds number of bytes just received
5896 (including the one in proc_buffered_char[channel]). */
5897 if (nbytes <= 0)
5899 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5900 return nbytes;
5901 coding->mode |= CODING_MODE_LAST_BLOCK;
5904 /* Now set NBYTES how many bytes we must decode. */
5905 nbytes += carryover;
5907 odeactivate = Vdeactivate_mark;
5908 /* There's no good reason to let process filters change the current
5909 buffer, and many callers of accept-process-output, sit-for, and
5910 friends don't expect current-buffer to be changed from under them. */
5911 record_unwind_current_buffer ();
5913 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5915 /* Handling the process output should not deactivate the mark. */
5916 Vdeactivate_mark = odeactivate;
5918 unbind_to (count, Qnil);
5919 return nbytes;
5922 static void
5923 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5924 ssize_t nbytes,
5925 struct coding_system *coding)
5927 Lisp_Object outstream = p->filter;
5928 Lisp_Object text;
5929 bool outer_running_asynch_code = running_asynch_code;
5930 int waiting = waiting_for_user_input_p;
5932 #if 0
5933 Lisp_Object obuffer, okeymap;
5934 XSETBUFFER (obuffer, current_buffer);
5935 okeymap = BVAR (current_buffer, keymap);
5936 #endif
5938 /* We inhibit quit here instead of just catching it so that
5939 hitting ^G when a filter happens to be running won't screw
5940 it up. */
5941 specbind (Qinhibit_quit, Qt);
5942 specbind (Qlast_nonmenu_event, Qt);
5944 /* In case we get recursively called,
5945 and we already saved the match data nonrecursively,
5946 save the same match data in safely recursive fashion. */
5947 if (outer_running_asynch_code)
5949 Lisp_Object tem;
5950 /* Don't clobber the CURRENT match data, either! */
5951 tem = Fmatch_data (Qnil, Qnil, Qnil);
5952 restore_search_regs ();
5953 record_unwind_save_match_data ();
5954 Fset_match_data (tem, Qt);
5957 /* For speed, if a search happens within this code,
5958 save the match data in a special nonrecursive fashion. */
5959 running_asynch_code = 1;
5961 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5962 text = coding->dst_object;
5963 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5964 /* A new coding system might be found. */
5965 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5967 pset_decode_coding_system (p, Vlast_coding_system_used);
5969 /* Don't call setup_coding_system for
5970 proc_decode_coding_system[channel] here. It is done in
5971 detect_coding called via decode_coding above. */
5973 /* If a coding system for encoding is not yet decided, we set
5974 it as the same as coding-system for decoding.
5976 But, before doing that we must check if
5977 proc_encode_coding_system[p->outfd] surely points to a
5978 valid memory because p->outfd will be changed once EOF is
5979 sent to the process. */
5980 if (NILP (p->encode_coding_system) && p->outfd >= 0
5981 && proc_encode_coding_system[p->outfd])
5983 pset_encode_coding_system
5984 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5985 setup_coding_system (p->encode_coding_system,
5986 proc_encode_coding_system[p->outfd]);
5990 if (coding->carryover_bytes > 0)
5992 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5993 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5994 memcpy (SDATA (p->decoding_buf), coding->carryover,
5995 coding->carryover_bytes);
5996 p->decoding_carryover = coding->carryover_bytes;
5998 if (SBYTES (text) > 0)
5999 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
6000 sometimes it's simply wrong to wrap (e.g. when called from
6001 accept-process-output). */
6002 internal_condition_case_1 (read_process_output_call,
6003 list3 (outstream, make_lisp_proc (p), text),
6004 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6005 read_process_output_error_handler);
6007 /* If we saved the match data nonrecursively, restore it now. */
6008 restore_search_regs ();
6009 running_asynch_code = outer_running_asynch_code;
6011 /* Restore waiting_for_user_input_p as it was
6012 when we were called, in case the filter clobbered it. */
6013 waiting_for_user_input_p = waiting;
6015 #if 0 /* Call record_asynch_buffer_change unconditionally,
6016 because we might have changed minor modes or other things
6017 that affect key bindings. */
6018 if (! EQ (Fcurrent_buffer (), obuffer)
6019 || ! EQ (current_buffer->keymap, okeymap))
6020 #endif
6021 /* But do it only if the caller is actually going to read events.
6022 Otherwise there's no need to make him wake up, and it could
6023 cause trouble (for example it would make sit_for return). */
6024 if (waiting_for_user_input_p == -1)
6025 record_asynch_buffer_change ();
6028 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6029 Sinternal_default_process_filter, 2, 2, 0,
6030 doc: /* Function used as default process filter.
6031 This inserts the process's output into its buffer, if there is one.
6032 Otherwise it discards the output. */)
6033 (Lisp_Object proc, Lisp_Object text)
6035 struct Lisp_Process *p;
6036 ptrdiff_t opoint;
6038 CHECK_PROCESS (proc);
6039 p = XPROCESS (proc);
6040 CHECK_STRING (text);
6042 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6044 Lisp_Object old_read_only;
6045 ptrdiff_t old_begv, old_zv;
6046 ptrdiff_t old_begv_byte, old_zv_byte;
6047 ptrdiff_t before, before_byte;
6048 ptrdiff_t opoint_byte;
6049 struct buffer *b;
6051 Fset_buffer (p->buffer);
6052 opoint = PT;
6053 opoint_byte = PT_BYTE;
6054 old_read_only = BVAR (current_buffer, read_only);
6055 old_begv = BEGV;
6056 old_zv = ZV;
6057 old_begv_byte = BEGV_BYTE;
6058 old_zv_byte = ZV_BYTE;
6060 bset_read_only (current_buffer, Qnil);
6062 /* Insert new output into buffer at the current end-of-output
6063 marker, thus preserving logical ordering of input and output. */
6064 if (XMARKER (p->mark)->buffer)
6065 set_point_from_marker (p->mark);
6066 else
6067 SET_PT_BOTH (ZV, ZV_BYTE);
6068 before = PT;
6069 before_byte = PT_BYTE;
6071 /* If the output marker is outside of the visible region, save
6072 the restriction and widen. */
6073 if (! (BEGV <= PT && PT <= ZV))
6074 Fwiden ();
6076 /* Adjust the multibyteness of TEXT to that of the buffer. */
6077 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6078 != ! STRING_MULTIBYTE (text))
6079 text = (STRING_MULTIBYTE (text)
6080 ? Fstring_as_unibyte (text)
6081 : Fstring_to_multibyte (text));
6082 /* Insert before markers in case we are inserting where
6083 the buffer's mark is, and the user's next command is Meta-y. */
6084 insert_from_string_before_markers (text, 0, 0,
6085 SCHARS (text), SBYTES (text), 0);
6087 /* Make sure the process marker's position is valid when the
6088 process buffer is changed in the signal_after_change above.
6089 W3 is known to do that. */
6090 if (BUFFERP (p->buffer)
6091 && (b = XBUFFER (p->buffer), b != current_buffer))
6092 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6093 else
6094 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6096 update_mode_lines = 23;
6098 /* Make sure opoint and the old restrictions
6099 float ahead of any new text just as point would. */
6100 if (opoint >= before)
6102 opoint += PT - before;
6103 opoint_byte += PT_BYTE - before_byte;
6105 if (old_begv > before)
6107 old_begv += PT - before;
6108 old_begv_byte += PT_BYTE - before_byte;
6110 if (old_zv >= before)
6112 old_zv += PT - before;
6113 old_zv_byte += PT_BYTE - before_byte;
6116 /* If the restriction isn't what it should be, set it. */
6117 if (old_begv != BEGV || old_zv != ZV)
6118 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
6120 bset_read_only (current_buffer, old_read_only);
6121 SET_PT_BOTH (opoint, opoint_byte);
6123 return Qnil;
6126 /* Sending data to subprocess. */
6128 /* In send_process, when a write fails temporarily,
6129 wait_reading_process_output is called. It may execute user code,
6130 e.g. timers, that attempts to write new data to the same process.
6131 We must ensure that data is sent in the right order, and not
6132 interspersed half-completed with other writes (Bug#10815). This is
6133 handled by the write_queue element of struct process. It is a list
6134 with each entry having the form
6136 (string . (offset . length))
6138 where STRING is a lisp string, OFFSET is the offset into the
6139 string's byte sequence from which we should begin to send, and
6140 LENGTH is the number of bytes left to send. */
6142 /* Create a new entry in write_queue.
6143 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6144 BUF is a pointer to the string sequence of the input_obj or a C
6145 string in case of Qt or Qnil. */
6147 static void
6148 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6149 const char *buf, ptrdiff_t len, bool front)
6151 ptrdiff_t offset;
6152 Lisp_Object entry, obj;
6154 if (STRINGP (input_obj))
6156 offset = buf - SSDATA (input_obj);
6157 obj = input_obj;
6159 else
6161 offset = 0;
6162 obj = make_unibyte_string (buf, len);
6165 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
6167 if (front)
6168 pset_write_queue (p, Fcons (entry, p->write_queue));
6169 else
6170 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6173 /* Remove the first element in the write_queue of process P, put its
6174 contents in OBJ, BUF and LEN, and return true. If the
6175 write_queue is empty, return false. */
6177 static bool
6178 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6179 const char **buf, ptrdiff_t *len)
6181 Lisp_Object entry, offset_length;
6182 ptrdiff_t offset;
6184 if (NILP (p->write_queue))
6185 return 0;
6187 entry = XCAR (p->write_queue);
6188 pset_write_queue (p, XCDR (p->write_queue));
6190 *obj = XCAR (entry);
6191 offset_length = XCDR (entry);
6193 *len = XINT (XCDR (offset_length));
6194 offset = XINT (XCAR (offset_length));
6195 *buf = SSDATA (*obj) + offset;
6197 return 1;
6200 /* Send some data to process PROC.
6201 BUF is the beginning of the data; LEN is the number of characters.
6202 OBJECT is the Lisp object that the data comes from. If OBJECT is
6203 nil or t, it means that the data comes from C string.
6205 If OBJECT is not nil, the data is encoded by PROC's coding-system
6206 for encoding before it is sent.
6208 This function can evaluate Lisp code and can garbage collect. */
6210 static void
6211 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6212 Lisp_Object object)
6214 struct Lisp_Process *p = XPROCESS (proc);
6215 ssize_t rv;
6216 struct coding_system *coding;
6218 if (NETCONN_P (proc))
6220 wait_while_connecting (proc);
6221 wait_for_tls_negotiation (proc);
6224 if (p->raw_status_new)
6225 update_status (p);
6226 if (! EQ (p->status, Qrun))
6227 error ("Process %s not running", SDATA (p->name));
6228 if (p->outfd < 0)
6229 error ("Output file descriptor of %s is closed", SDATA (p->name));
6231 coding = proc_encode_coding_system[p->outfd];
6232 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6234 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6235 || (BUFFERP (object)
6236 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6237 || EQ (object, Qt))
6239 pset_encode_coding_system
6240 (p, complement_process_encoding_system (p->encode_coding_system));
6241 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6243 /* The coding system for encoding was changed to raw-text
6244 because we sent a unibyte text previously. Now we are
6245 sending a multibyte text, thus we must encode it by the
6246 original coding system specified for the current process.
6248 Another reason we come here is that the coding system
6249 was just complemented and a new one was returned by
6250 complement_process_encoding_system. */
6251 setup_coding_system (p->encode_coding_system, coding);
6252 Vlast_coding_system_used = p->encode_coding_system;
6254 coding->src_multibyte = 1;
6256 else
6258 coding->src_multibyte = 0;
6259 /* For sending a unibyte text, character code conversion should
6260 not take place but EOL conversion should. So, setup raw-text
6261 or one of the subsidiary if we have not yet done it. */
6262 if (CODING_REQUIRE_ENCODING (coding))
6264 if (CODING_REQUIRE_FLUSHING (coding))
6266 /* But, before changing the coding, we must flush out data. */
6267 coding->mode |= CODING_MODE_LAST_BLOCK;
6268 send_process (proc, "", 0, Qt);
6269 coding->mode &= CODING_MODE_LAST_BLOCK;
6271 setup_coding_system (raw_text_coding_system
6272 (Vlast_coding_system_used),
6273 coding);
6274 coding->src_multibyte = 0;
6277 coding->dst_multibyte = 0;
6279 if (CODING_REQUIRE_ENCODING (coding))
6281 coding->dst_object = Qt;
6282 if (BUFFERP (object))
6284 ptrdiff_t from_byte, from, to;
6285 ptrdiff_t save_pt, save_pt_byte;
6286 struct buffer *cur = current_buffer;
6288 set_buffer_internal (XBUFFER (object));
6289 save_pt = PT, save_pt_byte = PT_BYTE;
6291 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6292 from = BYTE_TO_CHAR (from_byte);
6293 to = BYTE_TO_CHAR (from_byte + len);
6294 TEMP_SET_PT_BOTH (from, from_byte);
6295 encode_coding_object (coding, object, from, from_byte,
6296 to, from_byte + len, Qt);
6297 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6298 set_buffer_internal (cur);
6300 else if (STRINGP (object))
6302 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6303 SBYTES (object), Qt);
6305 else
6307 coding->dst_object = make_unibyte_string (buf, len);
6308 coding->produced = len;
6311 len = coding->produced;
6312 object = coding->dst_object;
6313 buf = SSDATA (object);
6316 /* If there is already data in the write_queue, put the new data
6317 in the back of queue. Otherwise, ignore it. */
6318 if (!NILP (p->write_queue))
6319 write_queue_push (p, object, buf, len, 0);
6321 do /* while !NILP (p->write_queue) */
6323 ptrdiff_t cur_len = -1;
6324 const char *cur_buf;
6325 Lisp_Object cur_object;
6327 /* If write_queue is empty, ignore it. */
6328 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6330 cur_len = len;
6331 cur_buf = buf;
6332 cur_object = object;
6335 while (cur_len > 0)
6337 /* Send this batch, using one or more write calls. */
6338 ptrdiff_t written = 0;
6339 int outfd = p->outfd;
6340 #ifdef DATAGRAM_SOCKETS
6341 if (DATAGRAM_CHAN_P (outfd))
6343 rv = sendto (outfd, cur_buf, cur_len,
6344 0, datagram_address[outfd].sa,
6345 datagram_address[outfd].len);
6346 if (rv >= 0)
6347 written = rv;
6348 else if (errno == EMSGSIZE)
6349 report_file_error ("Sending datagram", proc);
6351 else
6352 #endif
6354 #ifdef HAVE_GNUTLS
6355 if (p->gnutls_p && p->gnutls_state)
6356 written = emacs_gnutls_write (p, cur_buf, cur_len);
6357 else
6358 #endif
6359 written = emacs_write_sig (outfd, cur_buf, cur_len);
6360 rv = (written ? 0 : -1);
6361 if (p->read_output_delay > 0
6362 && p->adaptive_read_buffering == 1)
6364 p->read_output_delay = 0;
6365 process_output_delay_count--;
6366 p->read_output_skip = 0;
6370 if (rv < 0)
6372 if (would_block (errno))
6373 /* Buffer is full. Wait, accepting input;
6374 that may allow the program
6375 to finish doing output and read more. */
6377 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6378 /* A gross hack to work around a bug in FreeBSD.
6379 In the following sequence, read(2) returns
6380 bogus data:
6382 write(2) 1022 bytes
6383 write(2) 954 bytes, get EAGAIN
6384 read(2) 1024 bytes in process_read_output
6385 read(2) 11 bytes in process_read_output
6387 That is, read(2) returns more bytes than have
6388 ever been written successfully. The 1033 bytes
6389 read are the 1022 bytes written successfully
6390 after processing (for example with CRs added if
6391 the terminal is set up that way which it is
6392 here). The same bytes will be seen again in a
6393 later read(2), without the CRs. */
6395 if (errno == EAGAIN)
6397 int flags = FWRITE;
6398 ioctl (p->outfd, TIOCFLUSH, &flags);
6400 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6402 /* Put what we should have written in wait_queue. */
6403 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6404 wait_reading_process_output (0, 20 * 1000 * 1000,
6405 0, 0, Qnil, NULL, 0);
6406 /* Reread queue, to see what is left. */
6407 break;
6409 else if (errno == EPIPE)
6411 p->raw_status_new = 0;
6412 pset_status (p, list2 (Qexit, make_number (256)));
6413 p->tick = ++process_tick;
6414 deactivate_process (proc);
6415 error ("process %s no longer connected to pipe; closed it",
6416 SDATA (p->name));
6418 else
6419 /* This is a real error. */
6420 report_file_error ("Writing to process", proc);
6422 cur_buf += written;
6423 cur_len -= written;
6426 while (!NILP (p->write_queue));
6429 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6430 3, 3, 0,
6431 doc: /* Send current contents of region as input to PROCESS.
6432 PROCESS may be a process, a buffer, the name of a process or buffer, or
6433 nil, indicating the current buffer's process.
6434 Called from program, takes three arguments, PROCESS, START and END.
6435 If the region is more than 500 characters long,
6436 it is sent in several bunches. This may happen even for shorter regions.
6437 Output from processes can arrive in between bunches.
6439 If PROCESS is a non-blocking network process that hasn't been fully
6440 set up yet, this function will block until socket setup has completed. */)
6441 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6443 Lisp_Object proc = get_process (process);
6444 ptrdiff_t start_byte, end_byte;
6446 validate_region (&start, &end);
6448 start_byte = CHAR_TO_BYTE (XINT (start));
6449 end_byte = CHAR_TO_BYTE (XINT (end));
6451 if (XINT (start) < GPT && XINT (end) > GPT)
6452 move_gap_both (XINT (start), start_byte);
6454 if (NETCONN_P (proc))
6455 wait_while_connecting (proc);
6457 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6458 end_byte - start_byte, Fcurrent_buffer ());
6460 return Qnil;
6463 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6464 2, 2, 0,
6465 doc: /* Send PROCESS the contents of STRING as input.
6466 PROCESS may be a process, a buffer, the name of a process or buffer, or
6467 nil, indicating the current buffer's process.
6468 If STRING is more than 500 characters long,
6469 it is sent in several bunches. This may happen even for shorter strings.
6470 Output from processes can arrive in between bunches.
6472 If PROCESS is a non-blocking network process that hasn't been fully
6473 set up yet, this function will block until socket setup has completed. */)
6474 (Lisp_Object process, Lisp_Object string)
6476 CHECK_STRING (string);
6477 Lisp_Object proc = get_process (process);
6478 send_process (proc, SSDATA (string),
6479 SBYTES (string), string);
6480 return Qnil;
6483 /* Return the foreground process group for the tty/pty that
6484 the process P uses. */
6485 static pid_t
6486 emacs_get_tty_pgrp (struct Lisp_Process *p)
6488 pid_t gid = -1;
6490 #ifdef TIOCGPGRP
6491 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6493 int fd;
6494 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6495 master side. Try the slave side. */
6496 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6498 if (fd != -1)
6500 ioctl (fd, TIOCGPGRP, &gid);
6501 emacs_close (fd);
6504 #endif /* defined (TIOCGPGRP ) */
6506 return gid;
6509 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6510 Sprocess_running_child_p, 0, 1, 0,
6511 doc: /* Return non-nil if PROCESS has given the terminal to a
6512 child. If the operating system does not make it possible to find out,
6513 return t. If we can find out, return the numeric ID of the foreground
6514 process group. */)
6515 (Lisp_Object process)
6517 /* Initialize in case ioctl doesn't exist or gives an error,
6518 in a way that will cause returning t. */
6519 Lisp_Object proc = get_process (process);
6520 struct Lisp_Process *p = XPROCESS (proc);
6522 if (!EQ (p->type, Qreal))
6523 error ("Process %s is not a subprocess",
6524 SDATA (p->name));
6525 if (p->infd < 0)
6526 error ("Process %s is not active",
6527 SDATA (p->name));
6529 pid_t gid = emacs_get_tty_pgrp (p);
6531 if (gid == p->pid)
6532 return Qnil;
6533 if (gid != -1)
6534 return make_number (gid);
6535 return Qt;
6538 /* Send a signal number SIGNO to PROCESS.
6539 If CURRENT_GROUP is t, that means send to the process group
6540 that currently owns the terminal being used to communicate with PROCESS.
6541 This is used for various commands in shell mode.
6542 If CURRENT_GROUP is lambda, that means send to the process group
6543 that currently owns the terminal, but only if it is NOT the shell itself.
6545 If NOMSG is false, insert signal-announcements into process's buffers
6546 right away.
6548 If we can, we try to signal PROCESS by sending control characters
6549 down the pty. This allows us to signal inferiors who have changed
6550 their uid, for which kill would return an EPERM error. */
6552 static void
6553 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6554 bool nomsg)
6556 Lisp_Object proc;
6557 struct Lisp_Process *p;
6558 pid_t gid;
6559 bool no_pgrp = 0;
6561 proc = get_process (process);
6562 p = XPROCESS (proc);
6564 if (!EQ (p->type, Qreal))
6565 error ("Process %s is not a subprocess",
6566 SDATA (p->name));
6567 if (p->infd < 0)
6568 error ("Process %s is not active",
6569 SDATA (p->name));
6571 if (!p->pty_flag)
6572 current_group = Qnil;
6574 /* If we are using pgrps, get a pgrp number and make it negative. */
6575 if (NILP (current_group))
6576 /* Send the signal to the shell's process group. */
6577 gid = p->pid;
6578 else
6580 #ifdef SIGNALS_VIA_CHARACTERS
6581 /* If possible, send signals to the entire pgrp
6582 by sending an input character to it. */
6584 struct termios t;
6585 cc_t *sig_char = NULL;
6587 tcgetattr (p->infd, &t);
6589 switch (signo)
6591 case SIGINT:
6592 sig_char = &t.c_cc[VINTR];
6593 break;
6595 case SIGQUIT:
6596 sig_char = &t.c_cc[VQUIT];
6597 break;
6599 case SIGTSTP:
6600 #ifdef VSWTCH
6601 sig_char = &t.c_cc[VSWTCH];
6602 #else
6603 sig_char = &t.c_cc[VSUSP];
6604 #endif
6605 break;
6608 if (sig_char && *sig_char != CDISABLE)
6610 send_process (proc, (char *) sig_char, 1, Qnil);
6611 return;
6613 /* If we can't send the signal with a character,
6614 fall through and send it another way. */
6616 /* The code above may fall through if it can't
6617 handle the signal. */
6618 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6620 #ifdef TIOCGPGRP
6621 /* Get the current pgrp using the tty itself, if we have that.
6622 Otherwise, use the pty to get the pgrp.
6623 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6624 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6625 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6626 His patch indicates that if TIOCGPGRP returns an error, then
6627 we should just assume that p->pid is also the process group id. */
6629 gid = emacs_get_tty_pgrp (p);
6631 if (gid == -1)
6632 /* If we can't get the information, assume
6633 the shell owns the tty. */
6634 gid = p->pid;
6636 /* It is not clear whether anything really can set GID to -1.
6637 Perhaps on some system one of those ioctls can or could do so.
6638 Or perhaps this is vestigial. */
6639 if (gid == -1)
6640 no_pgrp = 1;
6641 #else /* ! defined (TIOCGPGRP) */
6642 /* Can't select pgrps on this system, so we know that
6643 the child itself heads the pgrp. */
6644 gid = p->pid;
6645 #endif /* ! defined (TIOCGPGRP) */
6647 /* If current_group is lambda, and the shell owns the terminal,
6648 don't send any signal. */
6649 if (EQ (current_group, Qlambda) && gid == p->pid)
6650 return;
6653 #ifdef SIGCONT
6654 if (signo == SIGCONT)
6656 p->raw_status_new = 0;
6657 pset_status (p, Qrun);
6658 p->tick = ++process_tick;
6659 if (!nomsg)
6661 status_notify (NULL, NULL);
6662 redisplay_preserve_echo_area (13);
6665 #endif
6667 #ifdef TIOCSIGSEND
6668 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6669 We don't know whether the bug is fixed in later HP-UX versions. */
6670 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6671 return;
6672 #endif
6674 /* If we don't have process groups, send the signal to the immediate
6675 subprocess. That isn't really right, but it's better than any
6676 obvious alternative. */
6677 pid_t pid = no_pgrp ? gid : - gid;
6679 /* Do not kill an already-reaped process, as that could kill an
6680 innocent bystander that happens to have the same process ID. */
6681 sigset_t oldset;
6682 block_child_signal (&oldset);
6683 if (p->alive)
6684 kill (pid, signo);
6685 unblock_child_signal (&oldset);
6688 DEFUN ("internal-default-interrupt-process",
6689 Finternal_default_interrupt_process,
6690 Sinternal_default_interrupt_process, 0, 2, 0,
6691 doc: /* Default function to interrupt process PROCESS.
6692 It shall be the last element in list `interrupt-process-functions'.
6693 See function `interrupt-process' for more details on usage. */)
6694 (Lisp_Object process, Lisp_Object current_group)
6696 process_send_signal (process, SIGINT, current_group, 0);
6697 return process;
6700 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6701 doc: /* Interrupt process PROCESS.
6702 PROCESS may be a process, a buffer, or the name of a process or buffer.
6703 No arg or nil means current buffer's process.
6704 Second arg CURRENT-GROUP non-nil means send signal to
6705 the current process-group of the process's controlling terminal
6706 rather than to the process's own process group.
6707 If the process is a shell, this means interrupt current subjob
6708 rather than the shell.
6710 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6711 don't send the signal.
6713 This function calls the functions of `interrupt-process-functions' in
6714 the order of the list, until one of them returns non-`nil'. */)
6715 (Lisp_Object process, Lisp_Object current_group)
6717 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
6718 process, current_group);
6721 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6722 doc: /* Kill process PROCESS. May be process or name of one.
6723 See function `interrupt-process' for more details on usage. */)
6724 (Lisp_Object process, Lisp_Object current_group)
6726 process_send_signal (process, SIGKILL, current_group, 0);
6727 return process;
6730 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6731 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6732 See function `interrupt-process' for more details on usage. */)
6733 (Lisp_Object process, Lisp_Object current_group)
6735 process_send_signal (process, SIGQUIT, current_group, 0);
6736 return process;
6739 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6740 doc: /* Stop process PROCESS. May be process or name of one.
6741 See function `interrupt-process' for more details on usage.
6742 If PROCESS is a network or serial or pipe connection, inhibit handling
6743 of incoming traffic. */)
6744 (Lisp_Object process, Lisp_Object current_group)
6746 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6747 || PIPECONN_P (process)))
6749 struct Lisp_Process *p;
6751 p = XPROCESS (process);
6752 if (NILP (p->command)
6753 && p->infd >= 0)
6754 delete_read_fd (p->infd);
6755 pset_command (p, Qt);
6756 return process;
6758 #ifndef SIGTSTP
6759 error ("No SIGTSTP support");
6760 #else
6761 process_send_signal (process, SIGTSTP, current_group, 0);
6762 #endif
6763 return process;
6766 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6767 doc: /* Continue process PROCESS. May be process or name of one.
6768 See function `interrupt-process' for more details on usage.
6769 If PROCESS is a network or serial process, resume handling of incoming
6770 traffic. */)
6771 (Lisp_Object process, Lisp_Object current_group)
6773 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6774 || PIPECONN_P (process)))
6776 struct Lisp_Process *p;
6778 p = XPROCESS (process);
6779 if (EQ (p->command, Qt)
6780 && p->infd >= 0
6781 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6783 add_process_read_fd (p->infd);
6784 #ifdef WINDOWSNT
6785 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6786 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6787 #else /* not WINDOWSNT */
6788 tcflush (p->infd, TCIFLUSH);
6789 #endif /* not WINDOWSNT */
6791 pset_command (p, Qnil);
6792 return process;
6794 #ifdef SIGCONT
6795 process_send_signal (process, SIGCONT, current_group, 0);
6796 #else
6797 error ("No SIGCONT support");
6798 #endif
6799 return process;
6802 /* Return the integer value of the signal whose abbreviation is ABBR,
6803 or a negative number if there is no such signal. */
6804 static int
6805 abbr_to_signal (char const *name)
6807 int i, signo;
6808 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
6810 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
6811 name += 3;
6813 for (i = 0; i < sizeof sigbuf; i++)
6815 sigbuf[i] = c_toupper (name[i]);
6816 if (! sigbuf[i])
6817 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
6820 return -1;
6823 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6824 2, 2, "sProcess (name or number): \nnSignal code: ",
6825 doc: /* Send PROCESS the signal with code SIGCODE.
6826 PROCESS may also be a number specifying the process id of the
6827 process to signal; in this case, the process need not be a child of
6828 this Emacs.
6829 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6830 (Lisp_Object process, Lisp_Object sigcode)
6832 pid_t pid;
6833 int signo;
6835 if (STRINGP (process))
6837 Lisp_Object tem = Fget_process (process);
6838 if (NILP (tem))
6840 Lisp_Object process_number
6841 = string_to_number (SSDATA (process), 10, 1);
6842 if (NUMBERP (process_number))
6843 tem = process_number;
6845 process = tem;
6847 else if (!NUMBERP (process))
6848 process = get_process (process);
6850 if (NILP (process))
6851 return process;
6853 if (NUMBERP (process))
6854 CONS_TO_INTEGER (process, pid_t, pid);
6855 else
6857 CHECK_PROCESS (process);
6858 pid = XPROCESS (process)->pid;
6859 if (pid <= 0)
6860 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6863 if (INTEGERP (sigcode))
6865 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
6866 signo = XINT (sigcode);
6868 else
6870 char *name;
6872 CHECK_SYMBOL (sigcode);
6873 name = SSDATA (SYMBOL_NAME (sigcode));
6875 signo = abbr_to_signal (name);
6876 if (signo < 0)
6877 error ("Undefined signal name %s", name);
6880 return make_number (kill (pid, signo));
6883 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6884 doc: /* Make PROCESS see end-of-file in its input.
6885 EOF comes after any text already sent to it.
6886 PROCESS may be a process, a buffer, the name of a process or buffer, or
6887 nil, indicating the current buffer's process.
6888 If PROCESS is a network connection, or is a process communicating
6889 through a pipe (as opposed to a pty), then you cannot send any more
6890 text to PROCESS after you call this function.
6891 If PROCESS is a serial process, wait until all output written to the
6892 process has been transmitted to the serial port. */)
6893 (Lisp_Object process)
6895 Lisp_Object proc;
6896 struct coding_system *coding = NULL;
6897 int outfd;
6899 proc = get_process (process);
6901 if (NETCONN_P (proc))
6902 wait_while_connecting (proc);
6904 if (DATAGRAM_CONN_P (proc))
6905 return process;
6908 outfd = XPROCESS (proc)->outfd;
6909 if (outfd >= 0)
6910 coding = proc_encode_coding_system[outfd];
6912 /* Make sure the process is really alive. */
6913 if (XPROCESS (proc)->raw_status_new)
6914 update_status (XPROCESS (proc));
6915 if (! EQ (XPROCESS (proc)->status, Qrun))
6916 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6918 if (coding && CODING_REQUIRE_FLUSHING (coding))
6920 coding->mode |= CODING_MODE_LAST_BLOCK;
6921 send_process (proc, "", 0, Qnil);
6924 if (XPROCESS (proc)->pty_flag)
6925 send_process (proc, "\004", 1, Qnil);
6926 else if (EQ (XPROCESS (proc)->type, Qserial))
6928 #ifndef WINDOWSNT
6929 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6930 report_file_error ("Failed tcdrain", Qnil);
6931 #endif /* not WINDOWSNT */
6932 /* Do nothing on Windows because writes are blocking. */
6934 else
6936 struct Lisp_Process *p = XPROCESS (proc);
6937 int old_outfd = p->outfd;
6938 int new_outfd;
6940 #ifdef HAVE_SHUTDOWN
6941 /* If this is a network connection, or socketpair is used
6942 for communication with the subprocess, call shutdown to cause EOF.
6943 (In some old system, shutdown to socketpair doesn't work.
6944 Then we just can't win.) */
6945 if (0 <= old_outfd
6946 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
6947 shutdown (old_outfd, 1);
6948 #endif
6949 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
6950 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6951 if (new_outfd < 0)
6952 report_file_error ("Opening null device", Qnil);
6953 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
6954 p->outfd = new_outfd;
6956 if (!proc_encode_coding_system[new_outfd])
6957 proc_encode_coding_system[new_outfd]
6958 = xmalloc (sizeof (struct coding_system));
6959 if (old_outfd >= 0)
6961 *proc_encode_coding_system[new_outfd]
6962 = *proc_encode_coding_system[old_outfd];
6963 memset (proc_encode_coding_system[old_outfd], 0,
6964 sizeof (struct coding_system));
6966 else
6967 setup_coding_system (p->encode_coding_system,
6968 proc_encode_coding_system[new_outfd]);
6970 return process;
6973 /* The main Emacs thread records child processes in three places:
6975 - Vprocess_alist, for asynchronous subprocesses, which are child
6976 processes visible to Lisp.
6978 - deleted_pid_list, for child processes invisible to Lisp,
6979 typically because of delete-process. These are recorded so that
6980 the processes can be reaped when they exit, so that the operating
6981 system's process table is not cluttered by zombies.
6983 - the local variable PID in Fcall_process, call_process_cleanup and
6984 call_process_kill, for synchronous subprocesses.
6985 record_unwind_protect is used to make sure this process is not
6986 forgotten: if the user interrupts call-process and the child
6987 process refuses to exit immediately even with two C-g's,
6988 call_process_kill adds PID's contents to deleted_pid_list before
6989 returning.
6991 The main Emacs thread invokes waitpid only on child processes that
6992 it creates and that have not been reaped. This avoid races on
6993 platforms such as GTK, where other threads create their own
6994 subprocesses which the main thread should not reap. For example,
6995 if the main thread attempted to reap an already-reaped child, it
6996 might inadvertently reap a GTK-created process that happened to
6997 have the same process ID. */
6999 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
7000 its own SIGCHLD handling. On POSIXish systems, glib needs this to
7001 keep track of its own children. GNUstep is similar. */
7003 static void dummy_handler (int sig) {}
7004 static signal_handler_t volatile lib_child_handler;
7006 /* Handle a SIGCHLD signal by looking for known child processes of
7007 Emacs whose status have changed. For each one found, record its
7008 new status.
7010 All we do is change the status; we do not run sentinels or print
7011 notifications. That is saved for the next time keyboard input is
7012 done, in order to avoid timing errors.
7014 ** WARNING: this can be called during garbage collection.
7015 Therefore, it must not be fooled by the presence of mark bits in
7016 Lisp objects.
7018 ** USG WARNING: Although it is not obvious from the documentation
7019 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7020 signal() before executing at least one wait(), otherwise the
7021 handler will be called again, resulting in an infinite loop. The
7022 relevant portion of the documentation reads "SIGCLD signals will be
7023 queued and the signal-catching function will be continually
7024 reentered until the queue is empty". Invoking signal() causes the
7025 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7026 Inc.
7028 ** Malloc WARNING: This should never call malloc either directly or
7029 indirectly; if it does, that is a bug. */
7031 static void
7032 handle_child_signal (int sig)
7034 Lisp_Object tail, proc;
7036 /* Find the process that signaled us, and record its status. */
7038 /* The process can have been deleted by Fdelete_process, or have
7039 been started asynchronously by Fcall_process. */
7040 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7042 bool all_pids_are_fixnums
7043 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7044 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7045 Lisp_Object head = XCAR (tail);
7046 Lisp_Object xpid;
7047 if (! CONSP (head))
7048 continue;
7049 xpid = XCAR (head);
7050 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
7052 pid_t deleted_pid;
7053 if (INTEGERP (xpid))
7054 deleted_pid = XINT (xpid);
7055 else
7056 deleted_pid = XFLOAT_DATA (xpid);
7057 if (child_status_changed (deleted_pid, 0, 0))
7059 if (STRINGP (XCDR (head)))
7060 unlink (SSDATA (XCDR (head)));
7061 XSETCAR (tail, Qnil);
7066 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7067 FOR_EACH_PROCESS (tail, proc)
7069 struct Lisp_Process *p = XPROCESS (proc);
7070 int status;
7072 if (p->alive
7073 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7075 /* Change the status of the process that was found. */
7076 p->tick = ++process_tick;
7077 p->raw_status = status;
7078 p->raw_status_new = 1;
7080 /* If process has terminated, stop waiting for its output. */
7081 if (WIFSIGNALED (status) || WIFEXITED (status))
7083 bool clear_desc_flag = 0;
7084 p->alive = 0;
7085 if (p->infd >= 0)
7086 clear_desc_flag = 1;
7088 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7089 if (clear_desc_flag)
7090 delete_read_fd (p->infd);
7095 lib_child_handler (sig);
7096 #ifdef NS_IMPL_GNUSTEP
7097 /* NSTask in GNUstep sets its child handler each time it is called.
7098 So we must re-set ours. */
7099 catch_child_signal ();
7100 #endif
7103 static void
7104 deliver_child_signal (int sig)
7106 deliver_process_signal (sig, handle_child_signal);
7110 static Lisp_Object
7111 exec_sentinel_error_handler (Lisp_Object error_val)
7113 /* Make sure error_val is a cons cell, as all the rest of error
7114 handling expects that, and will barf otherwise. */
7115 if (!CONSP (error_val))
7116 error_val = Fcons (Qerror, error_val);
7117 cmd_error_internal (error_val, "error in process sentinel: ");
7118 Vinhibit_quit = Qt;
7119 update_echo_area ();
7120 Fsleep_for (make_number (2), Qnil);
7121 return Qt;
7124 static void
7125 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
7127 Lisp_Object sentinel, odeactivate;
7128 struct Lisp_Process *p = XPROCESS (proc);
7129 ptrdiff_t count = SPECPDL_INDEX ();
7130 bool outer_running_asynch_code = running_asynch_code;
7131 int waiting = waiting_for_user_input_p;
7133 if (inhibit_sentinels)
7134 return;
7136 odeactivate = Vdeactivate_mark;
7137 #if 0
7138 Lisp_Object obuffer, okeymap;
7139 XSETBUFFER (obuffer, current_buffer);
7140 okeymap = BVAR (current_buffer, keymap);
7141 #endif
7143 /* There's no good reason to let sentinels change the current
7144 buffer, and many callers of accept-process-output, sit-for, and
7145 friends don't expect current-buffer to be changed from under them. */
7146 record_unwind_current_buffer ();
7148 sentinel = p->sentinel;
7150 /* Inhibit quit so that random quits don't screw up a running filter. */
7151 specbind (Qinhibit_quit, Qt);
7152 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
7154 /* In case we get recursively called,
7155 and we already saved the match data nonrecursively,
7156 save the same match data in safely recursive fashion. */
7157 if (outer_running_asynch_code)
7159 Lisp_Object tem;
7160 tem = Fmatch_data (Qnil, Qnil, Qnil);
7161 restore_search_regs ();
7162 record_unwind_save_match_data ();
7163 Fset_match_data (tem, Qt);
7166 /* For speed, if a search happens within this code,
7167 save the match data in a special nonrecursive fashion. */
7168 running_asynch_code = 1;
7170 internal_condition_case_1 (read_process_output_call,
7171 list3 (sentinel, proc, reason),
7172 !NILP (Vdebug_on_error) ? Qnil : Qerror,
7173 exec_sentinel_error_handler);
7175 /* If we saved the match data nonrecursively, restore it now. */
7176 restore_search_regs ();
7177 running_asynch_code = outer_running_asynch_code;
7179 Vdeactivate_mark = odeactivate;
7181 /* Restore waiting_for_user_input_p as it was
7182 when we were called, in case the filter clobbered it. */
7183 waiting_for_user_input_p = waiting;
7185 #if 0
7186 if (! EQ (Fcurrent_buffer (), obuffer)
7187 || ! EQ (current_buffer->keymap, okeymap))
7188 #endif
7189 /* But do it only if the caller is actually going to read events.
7190 Otherwise there's no need to make him wake up, and it could
7191 cause trouble (for example it would make sit_for return). */
7192 if (waiting_for_user_input_p == -1)
7193 record_asynch_buffer_change ();
7195 unbind_to (count, Qnil);
7198 /* Report all recent events of a change in process status
7199 (either run the sentinel or output a message).
7200 This is usually done while Emacs is waiting for keyboard input
7201 but can be done at other times.
7203 Return positive if any input was received from WAIT_PROC (or from
7204 any process if WAIT_PROC is null), zero if input was attempted but
7205 none received, and negative if we didn't even try. */
7207 static int
7208 status_notify (struct Lisp_Process *deleting_process,
7209 struct Lisp_Process *wait_proc)
7211 Lisp_Object proc;
7212 Lisp_Object tail, msg;
7213 int got_some_output = -1;
7215 tail = Qnil;
7216 msg = Qnil;
7218 /* Set this now, so that if new processes are created by sentinels
7219 that we run, we get called again to handle their status changes. */
7220 update_tick = process_tick;
7222 FOR_EACH_PROCESS (tail, proc)
7224 Lisp_Object symbol;
7225 register struct Lisp_Process *p = XPROCESS (proc);
7227 if (p->tick != p->update_tick)
7229 p->update_tick = p->tick;
7231 /* If process is still active, read any output that remains. */
7232 while (! EQ (p->filter, Qt)
7233 && ! connecting_status (p->status)
7234 && ! EQ (p->status, Qlisten)
7235 /* Network or serial process not stopped: */
7236 && ! EQ (p->command, Qt)
7237 && p->infd >= 0
7238 && p != deleting_process)
7240 int nread = read_process_output (proc, p->infd);
7241 if ((!wait_proc || wait_proc == XPROCESS (proc))
7242 && got_some_output < nread)
7243 got_some_output = nread;
7244 if (nread <= 0)
7245 break;
7248 /* Get the text to use for the message. */
7249 if (p->raw_status_new)
7250 update_status (p);
7251 msg = status_message (p);
7253 /* If process is terminated, deactivate it or delete it. */
7254 symbol = p->status;
7255 if (CONSP (p->status))
7256 symbol = XCAR (p->status);
7258 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
7259 || EQ (symbol, Qclosed))
7261 if (delete_exited_processes)
7262 remove_process (proc);
7263 else
7264 deactivate_process (proc);
7267 /* The actions above may have further incremented p->tick.
7268 So set p->update_tick again so that an error in the sentinel will
7269 not cause this code to be run again. */
7270 p->update_tick = p->tick;
7271 /* Now output the message suitably. */
7272 exec_sentinel (proc, msg);
7273 if (BUFFERP (p->buffer))
7274 /* In case it uses %s in mode-line-format. */
7275 bset_update_mode_line (XBUFFER (p->buffer));
7277 } /* end for */
7279 return got_some_output;
7282 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
7283 Sinternal_default_process_sentinel, 2, 2, 0,
7284 doc: /* Function used as default sentinel for processes.
7285 This inserts a status message into the process's buffer, if there is one. */)
7286 (Lisp_Object proc, Lisp_Object msg)
7288 Lisp_Object buffer, symbol;
7289 struct Lisp_Process *p;
7290 CHECK_PROCESS (proc);
7291 p = XPROCESS (proc);
7292 buffer = p->buffer;
7293 symbol = p->status;
7294 if (CONSP (symbol))
7295 symbol = XCAR (symbol);
7297 if (!EQ (symbol, Qrun) && !NILP (buffer))
7299 Lisp_Object tem;
7300 struct buffer *old = current_buffer;
7301 ptrdiff_t opoint, opoint_byte;
7302 ptrdiff_t before, before_byte;
7304 /* Avoid error if buffer is deleted
7305 (probably that's why the process is dead, too). */
7306 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
7307 return Qnil;
7308 Fset_buffer (buffer);
7310 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7311 msg = (code_convert_string_norecord
7312 (msg, Vlocale_coding_system, 1));
7314 opoint = PT;
7315 opoint_byte = PT_BYTE;
7316 /* Insert new output into buffer
7317 at the current end-of-output marker,
7318 thus preserving logical ordering of input and output. */
7319 if (XMARKER (p->mark)->buffer)
7320 Fgoto_char (p->mark);
7321 else
7322 SET_PT_BOTH (ZV, ZV_BYTE);
7324 before = PT;
7325 before_byte = PT_BYTE;
7327 tem = BVAR (current_buffer, read_only);
7328 bset_read_only (current_buffer, Qnil);
7329 insert_string ("\nProcess ");
7330 { /* FIXME: temporary kludge. */
7331 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
7332 insert_string (" ");
7333 Finsert (1, &msg);
7334 bset_read_only (current_buffer, tem);
7335 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7337 if (opoint >= before)
7338 SET_PT_BOTH (opoint + (PT - before),
7339 opoint_byte + (PT_BYTE - before_byte));
7340 else
7341 SET_PT_BOTH (opoint, opoint_byte);
7343 set_buffer_internal (old);
7345 return Qnil;
7349 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7350 Sset_process_coding_system, 1, 3, 0,
7351 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
7352 DECODING will be used to decode subprocess output and ENCODING to
7353 encode subprocess input. */)
7354 (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
7356 CHECK_PROCESS (process);
7358 struct Lisp_Process *p = XPROCESS (process);
7360 Fcheck_coding_system (decoding);
7361 Fcheck_coding_system (encoding);
7362 encoding = coding_inherit_eol_type (encoding, Qnil);
7363 pset_decode_coding_system (p, decoding);
7364 pset_encode_coding_system (p, encoding);
7366 /* If the sockets haven't been set up yet, the final setup part of
7367 this will be called asynchronously. */
7368 if (p->infd < 0 || p->outfd < 0)
7369 return Qnil;
7371 setup_process_coding_systems (process);
7373 return Qnil;
7376 DEFUN ("process-coding-system",
7377 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7378 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7379 (register Lisp_Object process)
7381 CHECK_PROCESS (process);
7382 return Fcons (XPROCESS (process)->decode_coding_system,
7383 XPROCESS (process)->encode_coding_system);
7386 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
7387 Sset_process_filter_multibyte, 2, 2, 0,
7388 doc: /* Set multibyteness of the strings given to PROCESS's filter.
7389 If FLAG is non-nil, the filter is given multibyte strings.
7390 If FLAG is nil, the filter is given unibyte strings. In this case,
7391 all character code conversion except for end-of-line conversion is
7392 suppressed. */)
7393 (Lisp_Object process, Lisp_Object flag)
7395 CHECK_PROCESS (process);
7397 struct Lisp_Process *p = XPROCESS (process);
7398 if (NILP (flag))
7399 pset_decode_coding_system
7400 (p, raw_text_coding_system (p->decode_coding_system));
7402 /* If the sockets haven't been set up yet, the final setup part of
7403 this will be called asynchronously. */
7404 if (p->infd < 0 || p->outfd < 0)
7405 return Qnil;
7407 setup_process_coding_systems (process);
7409 return Qnil;
7412 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
7413 Sprocess_filter_multibyte_p, 1, 1, 0,
7414 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7415 (Lisp_Object process)
7417 CHECK_PROCESS (process);
7418 struct Lisp_Process *p = XPROCESS (process);
7419 if (p->infd < 0)
7420 return Qnil;
7421 struct coding_system *coding = proc_decode_coding_system[p->infd];
7422 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
7428 # ifdef HAVE_GPM
7430 void
7431 add_gpm_wait_descriptor (int desc)
7433 add_keyboard_wait_descriptor (desc);
7436 void
7437 delete_gpm_wait_descriptor (int desc)
7439 delete_keyboard_wait_descriptor (desc);
7442 # endif
7444 # ifdef USABLE_SIGIO
7446 /* Return true if *MASK has a bit set
7447 that corresponds to one of the keyboard input descriptors. */
7449 static bool
7450 keyboard_bit_set (fd_set *mask)
7452 int fd;
7454 for (fd = 0; fd <= max_desc; fd++)
7455 if (FD_ISSET (fd, mask)
7456 && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
7457 == (FOR_READ | KEYBOARD_FD)))
7458 return 1;
7460 return 0;
7462 # endif
7464 #else /* not subprocesses */
7466 /* This is referenced in thread.c:run_thread (which is never actually
7467 called, since threads are not enabled for this configuration. */
7468 void
7469 update_processes_for_thread_death (Lisp_Object dying_thread)
7473 /* Defined in msdos.c. */
7474 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7475 struct timespec *, void *);
7477 /* Implementation of wait_reading_process_output, assuming that there
7478 are no subprocesses. Used only by the MS-DOS build.
7480 Wait for timeout to elapse and/or keyboard input to be available.
7482 TIME_LIMIT is:
7483 timeout in seconds
7484 If negative, gobble data immediately available but don't wait for any.
7486 NSECS is:
7487 an additional duration to wait, measured in nanoseconds
7488 If TIME_LIMIT is zero, then:
7489 If NSECS == 0, there is no limit.
7490 If NSECS > 0, the timeout consists of NSECS only.
7491 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7493 READ_KBD is:
7494 0 to ignore keyboard input, or
7495 1 to return when input is available, or
7496 -1 means caller will actually read the input, so don't throw to
7497 the quit handler.
7499 see full version for other parameters. We know that wait_proc will
7500 always be NULL, since `subprocesses' isn't defined.
7502 DO_DISPLAY means redisplay should be done to show subprocess
7503 output that arrives.
7505 Return -1 signifying we got no output and did not try. */
7508 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7509 bool do_display,
7510 Lisp_Object wait_for_cell,
7511 struct Lisp_Process *wait_proc, int just_wait_proc)
7513 register int nfds;
7514 struct timespec end_time, timeout;
7515 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
7517 if (TYPE_MAXIMUM (time_t) < time_limit)
7518 time_limit = TYPE_MAXIMUM (time_t);
7520 if (time_limit < 0 || nsecs < 0)
7521 wait = MINIMUM;
7522 else if (time_limit > 0 || nsecs > 0)
7524 wait = TIMEOUT;
7525 end_time = timespec_add (current_timespec (),
7526 make_timespec (time_limit, nsecs));
7528 else
7529 wait = INFINITY;
7531 /* Turn off periodic alarms (in case they are in use)
7532 and then turn off any other atimers,
7533 because the select emulator uses alarms. */
7534 stop_polling ();
7535 turn_on_atimers (0);
7537 while (1)
7539 bool timeout_reduced_for_timers = false;
7540 fd_set waitchannels;
7541 int xerrno;
7543 /* If calling from keyboard input, do not quit
7544 since we want to return C-g as an input character.
7545 Otherwise, do pending quit if requested. */
7546 if (read_kbd >= 0)
7547 maybe_quit ();
7549 /* Exit now if the cell we're waiting for became non-nil. */
7550 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7551 break;
7553 /* Compute time from now till when time limit is up. */
7554 /* Exit if already run out. */
7555 if (wait == TIMEOUT)
7557 struct timespec now = current_timespec ();
7558 if (timespec_cmp (end_time, now) <= 0)
7559 break;
7560 timeout = timespec_sub (end_time, now);
7562 else
7563 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7565 /* If our caller will not immediately handle keyboard events,
7566 run timer events directly.
7567 (Callers that will immediately read keyboard events
7568 call timer_delay on their own.) */
7569 if (NILP (wait_for_cell))
7571 struct timespec timer_delay;
7575 unsigned old_timers_run = timers_run;
7576 timer_delay = timer_check ();
7577 if (timers_run != old_timers_run && do_display)
7578 /* We must retry, since a timer may have requeued itself
7579 and that could alter the time delay. */
7580 redisplay_preserve_echo_area (14);
7581 else
7582 break;
7584 while (!detect_input_pending ());
7586 /* If there is unread keyboard input, also return. */
7587 if (read_kbd != 0
7588 && requeued_events_pending_p ())
7589 break;
7591 if (timespec_valid_p (timer_delay))
7593 if (timespec_cmp (timer_delay, timeout) < 0)
7595 timeout = timer_delay;
7596 timeout_reduced_for_timers = true;
7601 /* Cause C-g and alarm signals to take immediate action,
7602 and cause input available signals to zero out timeout. */
7603 if (read_kbd < 0)
7604 set_waiting_for_input (&timeout);
7606 /* If a frame has been newly mapped and needs updating,
7607 reprocess its display stuff. */
7608 if (frame_garbaged && do_display)
7610 clear_waiting_for_input ();
7611 redisplay_preserve_echo_area (15);
7612 if (read_kbd < 0)
7613 set_waiting_for_input (&timeout);
7616 /* Wait till there is something to do. */
7617 FD_ZERO (&waitchannels);
7618 if (read_kbd && detect_input_pending ())
7619 nfds = 0;
7620 else
7622 if (read_kbd || !NILP (wait_for_cell))
7623 FD_SET (0, &waitchannels);
7624 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
7627 xerrno = errno;
7629 /* Make C-g and alarm signals set flags again. */
7630 clear_waiting_for_input ();
7632 /* If we woke up due to SIGWINCH, actually change size now. */
7633 do_pending_window_change (0);
7635 if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
7636 /* We waited the full specified time, so return now. */
7637 break;
7639 if (nfds == -1)
7641 /* If the system call was interrupted, then go around the
7642 loop again. */
7643 if (xerrno == EINTR)
7644 FD_ZERO (&waitchannels);
7645 else
7646 report_file_errno ("Failed select", Qnil, xerrno);
7649 /* Check for keyboard input. */
7651 if (read_kbd
7652 && detect_input_pending_run_timers (do_display))
7654 swallow_events (do_display);
7655 if (detect_input_pending_run_timers (do_display))
7656 break;
7659 /* If there is unread keyboard input, also return. */
7660 if (read_kbd
7661 && requeued_events_pending_p ())
7662 break;
7664 /* If wait_for_cell. check for keyboard input
7665 but don't run any timers.
7666 ??? (It seems wrong to me to check for keyboard
7667 input at all when wait_for_cell, but the code
7668 has been this way since July 1994.
7669 Try changing this after version 19.31.) */
7670 if (! NILP (wait_for_cell)
7671 && detect_input_pending ())
7673 swallow_events (do_display);
7674 if (detect_input_pending ())
7675 break;
7678 /* Exit now if the cell we're waiting for became non-nil. */
7679 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7680 break;
7683 start_polling ();
7685 return -1;
7688 #endif /* not subprocesses */
7690 /* The following functions are needed even if async subprocesses are
7691 not supported. Some of them are no-op stubs in that case. */
7693 #ifdef HAVE_TIMERFD
7695 /* Add FD, which is a descriptor returned by timerfd_create,
7696 to the set of non-keyboard input descriptors. */
7698 void
7699 add_timer_wait_descriptor (int fd)
7701 add_read_fd (fd, timerfd_callback, NULL);
7702 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
7705 #endif /* HAVE_TIMERFD */
7707 /* If program file NAME starts with /: for quoting a magic
7708 name, remove that, preserving the multibyteness of NAME. */
7710 Lisp_Object
7711 remove_slash_colon (Lisp_Object name)
7713 return
7714 (SREF (name, 0) == '/' && SREF (name, 1) == ':'
7715 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
7716 SBYTES (name) - 2, STRING_MULTIBYTE (name))
7717 : name);
7720 /* Add DESC to the set of keyboard input descriptors. */
7722 void
7723 add_keyboard_wait_descriptor (int desc)
7725 #ifdef subprocesses /* Actually means "not MSDOS". */
7726 eassert (desc >= 0 && desc < FD_SETSIZE);
7727 fd_callback_info[desc].flags &= ~PROCESS_FD;
7728 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
7729 if (desc > max_desc)
7730 max_desc = desc;
7731 #endif
7734 /* From now on, do not expect DESC to give keyboard input. */
7736 void
7737 delete_keyboard_wait_descriptor (int desc)
7739 #ifdef subprocesses
7740 eassert (desc >= 0 && desc < FD_SETSIZE);
7742 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
7744 if (desc == max_desc)
7745 recompute_max_desc ();
7746 #endif
7749 /* Setup coding systems of PROCESS. */
7751 void
7752 setup_process_coding_systems (Lisp_Object process)
7754 #ifdef subprocesses
7755 struct Lisp_Process *p = XPROCESS (process);
7756 int inch = p->infd;
7757 int outch = p->outfd;
7758 Lisp_Object coding_system;
7760 if (inch < 0 || outch < 0)
7761 return;
7763 if (!proc_decode_coding_system[inch])
7764 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
7765 coding_system = p->decode_coding_system;
7766 if (EQ (p->filter, Qinternal_default_process_filter)
7767 && BUFFERP (p->buffer))
7769 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
7770 coding_system = raw_text_coding_system (coding_system);
7772 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7774 if (!proc_encode_coding_system[outch])
7775 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
7776 setup_coding_system (p->encode_coding_system,
7777 proc_encode_coding_system[outch]);
7778 #endif
7781 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7782 doc: /* Return the (or a) live process associated with BUFFER.
7783 BUFFER may be a buffer or the name of one.
7784 Return nil if all processes associated with BUFFER have been
7785 deleted or killed. */)
7786 (register Lisp_Object buffer)
7788 #ifdef subprocesses
7789 register Lisp_Object buf, tail, proc;
7791 if (NILP (buffer)) return Qnil;
7792 buf = Fget_buffer (buffer);
7793 if (NILP (buf)) return Qnil;
7795 FOR_EACH_PROCESS (tail, proc)
7796 if (EQ (XPROCESS (proc)->buffer, buf))
7797 return proc;
7798 #endif /* subprocesses */
7799 return Qnil;
7802 DEFUN ("process-inherit-coding-system-flag",
7803 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7804 1, 1, 0,
7805 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7806 If this flag is t, `buffer-file-coding-system' of the buffer
7807 associated with PROCESS will inherit the coding system used to decode
7808 the process output. */)
7809 (register Lisp_Object process)
7811 #ifdef subprocesses
7812 CHECK_PROCESS (process);
7813 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7814 #else
7815 /* Ignore the argument and return the value of
7816 inherit-process-coding-system. */
7817 return inherit_process_coding_system ? Qt : Qnil;
7818 #endif
7821 /* Kill all processes associated with `buffer'.
7822 If `buffer' is nil, kill all processes. */
7824 void
7825 kill_buffer_processes (Lisp_Object buffer)
7827 #ifdef subprocesses
7828 Lisp_Object tail, proc;
7830 FOR_EACH_PROCESS (tail, proc)
7831 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
7833 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
7834 Fdelete_process (proc);
7835 else if (XPROCESS (proc)->infd >= 0)
7836 process_send_signal (proc, SIGHUP, Qnil, 1);
7838 #else /* subprocesses */
7839 /* Since we have no subprocesses, this does nothing. */
7840 #endif /* subprocesses */
7843 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
7844 Swaiting_for_user_input_p, 0, 0, 0,
7845 doc: /* Return non-nil if Emacs is waiting for input from the user.
7846 This is intended for use by asynchronous process output filters and sentinels. */)
7847 (void)
7849 #ifdef subprocesses
7850 return (waiting_for_user_input_p ? Qt : Qnil);
7851 #else
7852 return Qnil;
7853 #endif
7856 /* Stop reading input from keyboard sources. */
7858 void
7859 hold_keyboard_input (void)
7861 kbd_is_on_hold = 1;
7864 /* Resume reading input from keyboard sources. */
7866 void
7867 unhold_keyboard_input (void)
7869 kbd_is_on_hold = 0;
7872 /* Return true if keyboard input is on hold, zero otherwise. */
7874 bool
7875 kbd_on_hold_p (void)
7877 return kbd_is_on_hold;
7881 /* Enumeration of and access to system processes a-la ps(1). */
7883 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7884 0, 0, 0,
7885 doc: /* Return a list of numerical process IDs of all running processes.
7886 If this functionality is unsupported, return nil.
7888 See `process-attributes' for getting attributes of a process given its ID. */)
7889 (void)
7891 return list_system_processes ();
7894 DEFUN ("process-attributes", Fprocess_attributes,
7895 Sprocess_attributes, 1, 1, 0,
7896 doc: /* Return attributes of the process given by its PID, a number.
7898 Value is an alist where each element is a cons cell of the form
7900 (KEY . VALUE)
7902 If this functionality is unsupported, the value is nil.
7904 See `list-system-processes' for getting a list of all process IDs.
7906 The KEYs of the attributes that this function may return are listed
7907 below, together with the type of the associated VALUE (in parentheses).
7908 Not all platforms support all of these attributes; unsupported
7909 attributes will not appear in the returned alist.
7910 Unless explicitly indicated otherwise, numbers can have either
7911 integer or floating point values.
7913 euid -- Effective user User ID of the process (number)
7914 user -- User name corresponding to euid (string)
7915 egid -- Effective user Group ID of the process (number)
7916 group -- Group name corresponding to egid (string)
7917 comm -- Command name (executable name only) (string)
7918 state -- Process state code, such as "S", "R", or "T" (string)
7919 ppid -- Parent process ID (number)
7920 pgrp -- Process group ID (number)
7921 sess -- Session ID, i.e. process ID of session leader (number)
7922 ttname -- Controlling tty name (string)
7923 tpgid -- ID of foreground process group on the process's tty (number)
7924 minflt -- number of minor page faults (number)
7925 majflt -- number of major page faults (number)
7926 cminflt -- cumulative number of minor page faults (number)
7927 cmajflt -- cumulative number of major page faults (number)
7928 utime -- user time used by the process, in (current-time) format,
7929 which is a list of integers (HIGH LOW USEC PSEC)
7930 stime -- system time used by the process (current-time)
7931 time -- sum of utime and stime (current-time)
7932 cutime -- user time used by the process and its children (current-time)
7933 cstime -- system time used by the process and its children (current-time)
7934 ctime -- sum of cutime and cstime (current-time)
7935 pri -- priority of the process (number)
7936 nice -- nice value of the process (number)
7937 thcount -- process thread count (number)
7938 start -- time the process started (current-time)
7939 vsize -- virtual memory size of the process in KB's (number)
7940 rss -- resident set size of the process in KB's (number)
7941 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7942 pcpu -- percents of CPU time used by the process (floating-point number)
7943 pmem -- percents of total physical memory used by process's resident set
7944 (floating-point number)
7945 args -- command line which invoked the process (string). */)
7946 ( Lisp_Object pid)
7948 return system_process_attributes (pid);
7951 #ifdef subprocesses
7952 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7953 Invoke this after init_process_emacs, and after glib and/or GNUstep
7954 futz with the SIGCHLD handler, but before Emacs forks any children.
7955 This function's caller should block SIGCHLD. */
7957 void
7958 catch_child_signal (void)
7960 struct sigaction action, old_action;
7961 sigset_t oldset;
7962 emacs_sigaction_init (&action, deliver_child_signal);
7963 block_child_signal (&oldset);
7964 sigaction (SIGCHLD, &action, &old_action);
7965 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7966 || ! (old_action.sa_flags & SA_SIGINFO));
7968 if (old_action.sa_handler != deliver_child_signal)
7969 lib_child_handler
7970 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7971 ? dummy_handler
7972 : old_action.sa_handler);
7973 unblock_child_signal (&oldset);
7975 #endif /* subprocesses */
7977 /* Limit the number of open files to the value it had at startup. */
7979 void
7980 restore_nofile_limit (void)
7982 #ifdef HAVE_SETRLIMIT
7983 if (FD_SETSIZE < nofile_limit.rlim_cur)
7984 setrlimit (RLIMIT_NOFILE, &nofile_limit);
7985 #endif
7989 /* This is not called "init_process" because that is the name of a
7990 Mach system call, so it would cause problems on Darwin systems. */
7991 void
7992 init_process_emacs (int sockfd)
7994 #ifdef subprocesses
7995 int i;
7997 inhibit_sentinels = 0;
7999 #ifndef CANNOT_DUMP
8000 if (! noninteractive || initialized)
8001 #endif
8003 #if defined HAVE_GLIB && !defined WINDOWSNT
8004 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
8005 this should always fail, but is enough to initialize glib's
8006 private SIGCHLD handler, allowing catch_child_signal to copy
8007 it into lib_child_handler. */
8008 g_source_unref (g_child_watch_source_new (getpid ()));
8009 #endif
8010 catch_child_signal ();
8013 #ifdef HAVE_SETRLIMIT
8014 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8015 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
8016 nofile_limit.rlim_cur = 0;
8017 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8019 struct rlimit rlim = nofile_limit;
8020 rlim.rlim_cur = FD_SETSIZE;
8021 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8022 nofile_limit.rlim_cur = 0;
8024 #endif
8026 external_sock_fd = sockfd;
8027 max_desc = -1;
8028 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8030 num_pending_connects = 0;
8032 process_output_delay_count = 0;
8033 process_output_skip = 0;
8035 /* Don't do this, it caused infinite select loops. The display
8036 method should call add_keyboard_wait_descriptor on stdin if it
8037 needs that. */
8038 #if 0
8039 FD_SET (0, &input_wait_mask);
8040 #endif
8042 Vprocess_alist = Qnil;
8043 deleted_pid_list = Qnil;
8044 for (i = 0; i < FD_SETSIZE; i++)
8046 chan_process[i] = Qnil;
8047 proc_buffered_char[i] = -1;
8049 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8050 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8051 #ifdef DATAGRAM_SOCKETS
8052 memset (datagram_address, 0, sizeof datagram_address);
8053 #endif
8055 #if defined (DARWIN_OS)
8056 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8057 processes. As such, we only change the default value. */
8058 if (initialized)
8060 char const *release = (STRINGP (Voperating_system_release)
8061 ? SSDATA (Voperating_system_release)
8062 : 0);
8063 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
8064 Vprocess_connection_type = Qnil;
8067 #endif
8068 #endif /* subprocesses */
8069 kbd_is_on_hold = 0;
8072 void
8073 syms_of_process (void)
8075 #ifdef subprocesses
8077 DEFSYM (Qprocessp, "processp");
8078 DEFSYM (Qrun, "run");
8079 DEFSYM (Qstop, "stop");
8080 DEFSYM (Qsignal, "signal");
8082 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8083 here again. */
8085 DEFSYM (Qopen, "open");
8086 DEFSYM (Qclosed, "closed");
8087 DEFSYM (Qconnect, "connect");
8088 DEFSYM (Qfailed, "failed");
8089 DEFSYM (Qlisten, "listen");
8090 DEFSYM (Qlocal, "local");
8091 DEFSYM (Qipv4, "ipv4");
8092 #ifdef AF_INET6
8093 DEFSYM (Qipv6, "ipv6");
8094 #endif
8095 DEFSYM (Qdatagram, "datagram");
8096 DEFSYM (Qseqpacket, "seqpacket");
8098 DEFSYM (QCport, ":port");
8099 DEFSYM (QCspeed, ":speed");
8100 DEFSYM (QCprocess, ":process");
8102 DEFSYM (QCbytesize, ":bytesize");
8103 DEFSYM (QCstopbits, ":stopbits");
8104 DEFSYM (QCparity, ":parity");
8105 DEFSYM (Qodd, "odd");
8106 DEFSYM (Qeven, "even");
8107 DEFSYM (QCflowcontrol, ":flowcontrol");
8108 DEFSYM (Qhw, "hw");
8109 DEFSYM (Qsw, "sw");
8110 DEFSYM (QCsummary, ":summary");
8112 DEFSYM (Qreal, "real");
8113 DEFSYM (Qnetwork, "network");
8114 DEFSYM (Qserial, "serial");
8115 DEFSYM (QCbuffer, ":buffer");
8116 DEFSYM (QChost, ":host");
8117 DEFSYM (QCservice, ":service");
8118 DEFSYM (QClocal, ":local");
8119 DEFSYM (QCremote, ":remote");
8120 DEFSYM (QCcoding, ":coding");
8121 DEFSYM (QCserver, ":server");
8122 DEFSYM (QCnowait, ":nowait");
8123 DEFSYM (QCsentinel, ":sentinel");
8124 DEFSYM (QCuse_external_socket, ":use-external-socket");
8125 DEFSYM (QCtls_parameters, ":tls-parameters");
8126 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8127 DEFSYM (QClog, ":log");
8128 DEFSYM (QCnoquery, ":noquery");
8129 DEFSYM (QCstop, ":stop");
8130 DEFSYM (QCplist, ":plist");
8131 DEFSYM (QCcommand, ":command");
8132 DEFSYM (QCconnection_type, ":connection-type");
8133 DEFSYM (QCstderr, ":stderr");
8134 DEFSYM (Qpty, "pty");
8135 DEFSYM (Qpipe, "pipe");
8137 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8139 staticpro (&Vprocess_alist);
8140 staticpro (&deleted_pid_list);
8142 #endif /* subprocesses */
8144 DEFSYM (QCname, ":name");
8145 DEFSYM (QCtype, ":type");
8147 DEFSYM (Qeuid, "euid");
8148 DEFSYM (Qegid, "egid");
8149 DEFSYM (Quser, "user");
8150 DEFSYM (Qgroup, "group");
8151 DEFSYM (Qcomm, "comm");
8152 DEFSYM (Qstate, "state");
8153 DEFSYM (Qppid, "ppid");
8154 DEFSYM (Qpgrp, "pgrp");
8155 DEFSYM (Qsess, "sess");
8156 DEFSYM (Qttname, "ttname");
8157 DEFSYM (Qtpgid, "tpgid");
8158 DEFSYM (Qminflt, "minflt");
8159 DEFSYM (Qmajflt, "majflt");
8160 DEFSYM (Qcminflt, "cminflt");
8161 DEFSYM (Qcmajflt, "cmajflt");
8162 DEFSYM (Qutime, "utime");
8163 DEFSYM (Qstime, "stime");
8164 DEFSYM (Qtime, "time");
8165 DEFSYM (Qcutime, "cutime");
8166 DEFSYM (Qcstime, "cstime");
8167 DEFSYM (Qctime, "ctime");
8168 #ifdef subprocesses
8169 DEFSYM (Qinternal_default_process_sentinel,
8170 "internal-default-process-sentinel");
8171 DEFSYM (Qinternal_default_process_filter,
8172 "internal-default-process-filter");
8173 #endif
8174 DEFSYM (Qpri, "pri");
8175 DEFSYM (Qnice, "nice");
8176 DEFSYM (Qthcount, "thcount");
8177 DEFSYM (Qstart, "start");
8178 DEFSYM (Qvsize, "vsize");
8179 DEFSYM (Qrss, "rss");
8180 DEFSYM (Qetime, "etime");
8181 DEFSYM (Qpcpu, "pcpu");
8182 DEFSYM (Qpmem, "pmem");
8183 DEFSYM (Qargs, "args");
8185 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8186 doc: /* Non-nil means delete processes immediately when they exit.
8187 A value of nil means don't delete them until `list-processes' is run. */);
8189 delete_exited_processes = 1;
8191 #ifdef subprocesses
8192 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8193 doc: /* Control type of device used to communicate with subprocesses.
8194 Values are nil to use a pipe, or t or `pty' to use a pty.
8195 The value has no effect if the system has no ptys or if all ptys are busy:
8196 then a pipe is used in any case.
8197 The value takes effect when `start-process' is called. */);
8198 Vprocess_connection_type = Qt;
8200 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8201 doc: /* If non-nil, improve receive buffering by delaying after short reads.
8202 On some systems, when Emacs reads the output from a subprocess, the output data
8203 is read in very small blocks, potentially resulting in very poor performance.
8204 This behavior can be remedied to some extent by setting this variable to a
8205 non-nil value, as it will automatically delay reading from such processes, to
8206 allow them to produce more output before Emacs tries to read it.
8207 If the value is t, the delay is reset after each write to the process; any other
8208 non-nil value means that the delay is not reset on write.
8209 The variable takes effect when `start-process' is called. */);
8210 Vprocess_adaptive_read_buffering = Qt;
8212 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8213 doc: /* List of functions to be called for `interrupt-process'.
8214 The arguments of the functions are the same as for `interrupt-process'.
8215 These functions are called in the order of the list, until one of them
8216 returns non-`nil'. */);
8217 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8219 DEFSYM (Qinternal_default_interrupt_process,
8220 "internal-default-interrupt-process");
8221 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8223 defsubr (&Sprocessp);
8224 defsubr (&Sget_process);
8225 defsubr (&Sdelete_process);
8226 defsubr (&Sprocess_status);
8227 defsubr (&Sprocess_exit_status);
8228 defsubr (&Sprocess_id);
8229 defsubr (&Sprocess_name);
8230 defsubr (&Sprocess_tty_name);
8231 defsubr (&Sprocess_command);
8232 defsubr (&Sset_process_buffer);
8233 defsubr (&Sprocess_buffer);
8234 defsubr (&Sprocess_mark);
8235 defsubr (&Sset_process_filter);
8236 defsubr (&Sprocess_filter);
8237 defsubr (&Sset_process_sentinel);
8238 defsubr (&Sprocess_sentinel);
8239 defsubr (&Sset_process_thread);
8240 defsubr (&Sprocess_thread);
8241 defsubr (&Sset_process_window_size);
8242 defsubr (&Sset_process_inherit_coding_system_flag);
8243 defsubr (&Sset_process_query_on_exit_flag);
8244 defsubr (&Sprocess_query_on_exit_flag);
8245 defsubr (&Sprocess_contact);
8246 defsubr (&Sprocess_plist);
8247 defsubr (&Sset_process_plist);
8248 defsubr (&Sprocess_list);
8249 defsubr (&Smake_process);
8250 defsubr (&Smake_pipe_process);
8251 defsubr (&Sserial_process_configure);
8252 defsubr (&Smake_serial_process);
8253 defsubr (&Sset_network_process_option);
8254 defsubr (&Smake_network_process);
8255 defsubr (&Sformat_network_address);
8256 defsubr (&Snetwork_interface_list);
8257 defsubr (&Snetwork_interface_info);
8258 #ifdef DATAGRAM_SOCKETS
8259 defsubr (&Sprocess_datagram_address);
8260 defsubr (&Sset_process_datagram_address);
8261 #endif
8262 defsubr (&Saccept_process_output);
8263 defsubr (&Sprocess_send_region);
8264 defsubr (&Sprocess_send_string);
8265 defsubr (&Sinternal_default_interrupt_process);
8266 defsubr (&Sinterrupt_process);
8267 defsubr (&Skill_process);
8268 defsubr (&Squit_process);
8269 defsubr (&Sstop_process);
8270 defsubr (&Scontinue_process);
8271 defsubr (&Sprocess_running_child_p);
8272 defsubr (&Sprocess_send_eof);
8273 defsubr (&Ssignal_process);
8274 defsubr (&Swaiting_for_user_input_p);
8275 defsubr (&Sprocess_type);
8276 defsubr (&Sinternal_default_process_sentinel);
8277 defsubr (&Sinternal_default_process_filter);
8278 defsubr (&Sset_process_coding_system);
8279 defsubr (&Sprocess_coding_system);
8280 defsubr (&Sset_process_filter_multibyte);
8281 defsubr (&Sprocess_filter_multibyte_p);
8284 Lisp_Object subfeatures = Qnil;
8285 const struct socket_options *sopt;
8287 #define ADD_SUBFEATURE(key, val) \
8288 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8290 ADD_SUBFEATURE (QCnowait, Qt);
8291 #ifdef DATAGRAM_SOCKETS
8292 ADD_SUBFEATURE (QCtype, Qdatagram);
8293 #endif
8294 #ifdef HAVE_SEQPACKET
8295 ADD_SUBFEATURE (QCtype, Qseqpacket);
8296 #endif
8297 #ifdef HAVE_LOCAL_SOCKETS
8298 ADD_SUBFEATURE (QCfamily, Qlocal);
8299 #endif
8300 ADD_SUBFEATURE (QCfamily, Qipv4);
8301 #ifdef AF_INET6
8302 ADD_SUBFEATURE (QCfamily, Qipv6);
8303 #endif
8304 #ifdef HAVE_GETSOCKNAME
8305 ADD_SUBFEATURE (QCservice, Qt);
8306 #endif
8307 ADD_SUBFEATURE (QCserver, Qt);
8309 for (sopt = socket_options; sopt->name; sopt++)
8310 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8312 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8315 #endif /* subprocesses */
8317 defsubr (&Sget_buffer_process);
8318 defsubr (&Sprocess_inherit_coding_system_flag);
8319 defsubr (&Slist_system_processes);
8320 defsubr (&Sprocess_attributes);