Fix the MSDOS build.
[emacs.git] / src / process.c
blobfc46e7433281999e455b02fa9e5bca5dcb31de30
1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2017 Free Software
4 Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <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 stderrproc = Qnil;
1690 xstderr = Fplist_get (contact, QCstderr);
1691 if (PROCESSP (xstderr))
1693 if (!PIPECONN_P (xstderr))
1694 error ("Process is not a pipe process");
1695 stderrproc = xstderr;
1697 else if (!NILP (xstderr))
1699 CHECK_STRING (program);
1700 stderrproc = CALLN (Fmake_pipe_process,
1701 QCname,
1702 concat2 (name, build_string (" stderr")),
1703 QCbuffer,
1704 Fget_buffer_create (xstderr));
1707 proc = make_process (name);
1708 record_unwind_protect (start_process_unwind, proc);
1710 pset_childp (XPROCESS (proc), Qt);
1711 eassert (NILP (XPROCESS (proc)->plist));
1712 pset_type (XPROCESS (proc), Qreal);
1713 pset_buffer (XPROCESS (proc), buffer);
1714 pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
1715 pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
1716 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1718 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
1719 XPROCESS (proc)->kill_without_query = 1;
1720 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
1721 pset_command (XPROCESS (proc), Qt);
1723 tem = Fplist_get (contact, QCconnection_type);
1724 if (EQ (tem, Qpty))
1725 XPROCESS (proc)->pty_flag = true;
1726 else if (EQ (tem, Qpipe))
1727 XPROCESS (proc)->pty_flag = false;
1728 else if (NILP (tem))
1729 XPROCESS (proc)->pty_flag = !NILP (Vprocess_connection_type);
1730 else
1731 report_file_error ("Unknown connection type", tem);
1733 if (!NILP (stderrproc))
1735 pset_stderrproc (XPROCESS (proc), stderrproc);
1737 XPROCESS (proc)->pty_flag = false;
1740 #ifdef HAVE_GNUTLS
1741 /* AKA GNUTLS_INITSTAGE(proc). */
1742 verify (GNUTLS_STAGE_EMPTY == 0);
1743 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1744 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1745 #endif
1747 XPROCESS (proc)->adaptive_read_buffering
1748 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1749 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1751 /* Make the process marker point into the process buffer (if any). */
1752 if (BUFFERP (buffer))
1753 set_marker_both (XPROCESS (proc)->mark, buffer,
1754 BUF_ZV (XBUFFER (buffer)),
1755 BUF_ZV_BYTE (XBUFFER (buffer)));
1757 USE_SAFE_ALLOCA;
1760 /* Decide coding systems for communicating with the process. Here
1761 we don't setup the structure coding_system nor pay attention to
1762 unibyte mode. They are done in create_process. */
1764 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1765 Lisp_Object coding_systems = Qt;
1766 Lisp_Object val, *args2;
1768 tem = Fplist_get (contact, QCcoding);
1769 if (!NILP (tem))
1771 val = tem;
1772 if (CONSP (val))
1773 val = XCAR (val);
1775 else
1776 val = Vcoding_system_for_read;
1777 if (NILP (val))
1779 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1780 Lisp_Object tem2;
1781 SAFE_ALLOCA_LISP (args2, nargs2);
1782 ptrdiff_t i = 0;
1783 args2[i++] = Qstart_process;
1784 args2[i++] = name;
1785 args2[i++] = buffer;
1786 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1787 args2[i++] = XCAR (tem2);
1788 if (!NILP (program))
1789 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1790 if (CONSP (coding_systems))
1791 val = XCAR (coding_systems);
1792 else if (CONSP (Vdefault_process_coding_system))
1793 val = XCAR (Vdefault_process_coding_system);
1795 pset_decode_coding_system (XPROCESS (proc), val);
1797 if (!NILP (tem))
1799 val = tem;
1800 if (CONSP (val))
1801 val = XCDR (val);
1803 else
1804 val = Vcoding_system_for_write;
1805 if (NILP (val))
1807 if (EQ (coding_systems, Qt))
1809 ptrdiff_t nargs2 = 3 + XINT (Flength (command));
1810 Lisp_Object tem2;
1811 SAFE_ALLOCA_LISP (args2, nargs2);
1812 ptrdiff_t i = 0;
1813 args2[i++] = Qstart_process;
1814 args2[i++] = name;
1815 args2[i++] = buffer;
1816 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1817 args2[i++] = XCAR (tem2);
1818 if (!NILP (program))
1819 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1821 if (CONSP (coding_systems))
1822 val = XCDR (coding_systems);
1823 else if (CONSP (Vdefault_process_coding_system))
1824 val = XCDR (Vdefault_process_coding_system);
1826 pset_encode_coding_system (XPROCESS (proc), val);
1827 /* Note: At this moment, the above coding system may leave
1828 text-conversion or eol-conversion unspecified. They will be
1829 decided after we read output from the process and decode it by
1830 some coding system, or just before we actually send a text to
1831 the process. */
1835 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1836 eassert (XPROCESS (proc)->decoding_carryover == 0);
1837 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1839 XPROCESS (proc)->inherit_coding_system_flag
1840 = !(NILP (buffer) || !inherit_process_coding_system);
1842 if (!NILP (program))
1844 Lisp_Object program_args = XCDR (command);
1846 /* If program file name is not absolute, search our path for it.
1847 Put the name we will really use in TEM. */
1848 if (!IS_DIRECTORY_SEP (SREF (program, 0))
1849 && !(SCHARS (program) > 1
1850 && IS_DEVICE_SEP (SREF (program, 1))))
1852 tem = Qnil;
1853 openp (Vexec_path, program, Vexec_suffixes, &tem,
1854 make_number (X_OK), false);
1855 if (NILP (tem))
1856 report_file_error ("Searching for program", program);
1857 tem = Fexpand_file_name (tem, Qnil);
1859 else
1861 if (!NILP (Ffile_directory_p (program)))
1862 error ("Specified program for new process is a directory");
1863 tem = program;
1866 /* Remove "/:" from TEM. */
1867 tem = remove_slash_colon (tem);
1869 Lisp_Object arg_encoding = Qnil;
1871 /* Encode the file name and put it in NEW_ARGV.
1872 That's where the child will use it to execute the program. */
1873 tem = list1 (ENCODE_FILE (tem));
1874 ptrdiff_t new_argc = 1;
1876 /* Here we encode arguments by the coding system used for sending
1877 data to the process. We don't support using different coding
1878 systems for encoding arguments and for encoding data sent to the
1879 process. */
1881 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
1883 Lisp_Object arg = XCAR (tem2);
1884 CHECK_STRING (arg);
1885 if (STRING_MULTIBYTE (arg))
1887 if (NILP (arg_encoding))
1888 arg_encoding = (complement_process_encoding_system
1889 (XPROCESS (proc)->encode_coding_system));
1890 arg = code_convert_string_norecord (arg, arg_encoding, 1);
1892 tem = Fcons (arg, tem);
1893 new_argc++;
1896 /* Now that everything is encoded we can collect the strings into
1897 NEW_ARGV. */
1898 char **new_argv;
1899 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
1900 new_argv[new_argc] = 0;
1902 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
1904 new_argv[i] = SSDATA (XCAR (tem));
1905 tem = XCDR (tem);
1908 create_process (proc, new_argv, current_dir);
1910 else
1911 create_pty (proc);
1913 SAFE_FREE ();
1914 return unbind_to (count, proc);
1917 /* If PROC doesn't have its pid set, then an error was signaled and
1918 the process wasn't started successfully, so remove it. */
1919 static void
1920 start_process_unwind (Lisp_Object proc)
1922 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
1923 remove_process (proc);
1926 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1928 static void
1929 close_process_fd (int *fd_addr)
1931 int fd = *fd_addr;
1932 if (0 <= fd)
1934 *fd_addr = -1;
1935 emacs_close (fd);
1939 /* Indexes of file descriptors in open_fds. */
1940 enum
1942 /* The pipe from Emacs to its subprocess. */
1943 SUBPROCESS_STDIN,
1944 WRITE_TO_SUBPROCESS,
1946 /* The main pipe from the subprocess to Emacs. */
1947 READ_FROM_SUBPROCESS,
1948 SUBPROCESS_STDOUT,
1950 /* The pipe from the subprocess to Emacs that is closed when the
1951 subprocess execs. */
1952 READ_FROM_EXEC_MONITOR,
1953 EXEC_MONITOR_OUTPUT
1956 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
1958 static void
1959 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
1961 struct Lisp_Process *p = XPROCESS (process);
1962 int inchannel, outchannel;
1963 pid_t pid;
1964 int vfork_errno;
1965 int forkin, forkout, forkerr = -1;
1966 bool pty_flag = 0;
1967 char pty_name[PTY_NAME_SIZE];
1968 Lisp_Object lisp_pty_name = Qnil;
1969 sigset_t oldset;
1971 inchannel = outchannel = -1;
1973 if (p->pty_flag)
1974 outchannel = inchannel = allocate_pty (pty_name);
1976 if (inchannel >= 0)
1978 p->open_fd[READ_FROM_SUBPROCESS] = inchannel;
1979 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1980 /* On most USG systems it does not work to open the pty's tty here,
1981 then close it and reopen it in the child. */
1982 /* Don't let this terminal become our controlling terminal
1983 (in case we don't have one). */
1984 forkout = forkin = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
1985 if (forkin < 0)
1986 report_file_error ("Opening pty", Qnil);
1987 p->open_fd[SUBPROCESS_STDIN] = forkin;
1988 #else
1989 forkin = forkout = -1;
1990 #endif /* not USG, or USG_SUBTTY_WORKS */
1991 pty_flag = 1;
1992 lisp_pty_name = build_string (pty_name);
1994 else
1996 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
1997 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
1998 report_file_error ("Creating pipe", Qnil);
1999 forkin = p->open_fd[SUBPROCESS_STDIN];
2000 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2001 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2002 forkout = p->open_fd[SUBPROCESS_STDOUT];
2004 if (!NILP (p->stderrproc))
2006 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2008 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2010 /* Close unnecessary file descriptors. */
2011 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2012 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2016 #ifndef WINDOWSNT
2017 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2018 report_file_error ("Creating pipe", Qnil);
2019 #endif
2021 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2022 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2024 /* Record this as an active process, with its channels. */
2025 chan_process[inchannel] = process;
2026 p->infd = inchannel;
2027 p->outfd = outchannel;
2029 /* Previously we recorded the tty descriptor used in the subprocess.
2030 It was only used for getting the foreground tty process, so now
2031 we just reopen the device (see emacs_get_tty_pgrp) as this is
2032 more portable (see USG_SUBTTY_WORKS above). */
2034 p->pty_flag = pty_flag;
2035 pset_status (p, Qrun);
2037 if (!EQ (p->command, Qt))
2038 add_process_read_fd (inchannel);
2040 /* This may signal an error. */
2041 setup_process_coding_systems (process);
2043 block_input ();
2044 block_child_signal (&oldset);
2046 #ifndef WINDOWSNT
2047 /* vfork, and prevent local vars from being clobbered by the vfork. */
2048 Lisp_Object volatile current_dir_volatile = current_dir;
2049 Lisp_Object volatile lisp_pty_name_volatile = lisp_pty_name;
2050 char **volatile new_argv_volatile = new_argv;
2051 int volatile forkin_volatile = forkin;
2052 int volatile forkout_volatile = forkout;
2053 int volatile forkerr_volatile = forkerr;
2054 struct Lisp_Process *p_volatile = p;
2056 #ifdef DARWIN_OS
2057 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2058 necessary. Also, reset SIGCHLD handling after a vfork, as
2059 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2060 if (pty_flag)
2061 pid = fork ();
2062 else
2064 pid = vfork ();
2065 if (pid == 0)
2066 signal (SIGCHLD, SIG_DFL);
2068 #else
2069 pid = vfork ();
2070 #endif
2072 current_dir = current_dir_volatile;
2073 lisp_pty_name = lisp_pty_name_volatile;
2074 new_argv = new_argv_volatile;
2075 forkin = forkin_volatile;
2076 forkout = forkout_volatile;
2077 forkerr = forkerr_volatile;
2078 p = p_volatile;
2080 pty_flag = p->pty_flag;
2082 if (pid == 0)
2083 #endif /* not WINDOWSNT */
2085 /* Make the pty be the controlling terminal of the process. */
2086 #ifdef HAVE_PTYS
2087 /* First, disconnect its current controlling terminal. */
2088 if (pty_flag)
2089 setsid ();
2090 /* Make the pty's terminal the controlling terminal. */
2091 if (pty_flag && forkin >= 0)
2093 #ifdef TIOCSCTTY
2094 /* We ignore the return value
2095 because faith@cs.unc.edu says that is necessary on Linux. */
2096 ioctl (forkin, TIOCSCTTY, 0);
2097 #endif
2099 #if defined (LDISC1)
2100 if (pty_flag && forkin >= 0)
2102 struct termios t;
2103 tcgetattr (forkin, &t);
2104 t.c_lflag = LDISC1;
2105 if (tcsetattr (forkin, TCSANOW, &t) < 0)
2106 emacs_perror ("create_process/tcsetattr LDISC1");
2108 #else
2109 #if defined (NTTYDISC) && defined (TIOCSETD)
2110 if (pty_flag && forkin >= 0)
2112 /* Use new line discipline. */
2113 int ldisc = NTTYDISC;
2114 ioctl (forkin, TIOCSETD, &ldisc);
2116 #endif
2117 #endif
2118 #ifdef TIOCNOTTY
2119 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2120 can do TIOCSPGRP only to the process's controlling tty. */
2121 if (pty_flag)
2123 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2124 I can't test it since I don't have 4.3. */
2125 int j = emacs_open (DEV_TTY, O_RDWR, 0);
2126 if (j >= 0)
2128 ioctl (j, TIOCNOTTY, 0);
2129 emacs_close (j);
2132 #endif /* TIOCNOTTY */
2134 #if !defined (DONT_REOPEN_PTY)
2135 /*** There is a suggestion that this ought to be a
2136 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2137 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2138 that system does seem to need this code, even though
2139 both TIOCSCTTY is defined. */
2140 /* Now close the pty (if we had it open) and reopen it.
2141 This makes the pty the controlling terminal of the subprocess. */
2142 if (pty_flag)
2145 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2146 would work? */
2147 if (forkin >= 0)
2148 emacs_close (forkin);
2149 forkout = forkin = emacs_open (SSDATA (lisp_pty_name), O_RDWR, 0);
2151 if (forkin < 0)
2153 emacs_perror (SSDATA (lisp_pty_name));
2154 _exit (EXIT_CANCELED);
2158 #endif /* not DONT_REOPEN_PTY */
2160 #ifdef SETUP_SLAVE_PTY
2161 if (pty_flag)
2163 SETUP_SLAVE_PTY;
2165 #endif /* SETUP_SLAVE_PTY */
2166 #endif /* HAVE_PTYS */
2168 signal (SIGINT, SIG_DFL);
2169 signal (SIGQUIT, SIG_DFL);
2170 #ifdef SIGPROF
2171 signal (SIGPROF, SIG_DFL);
2172 #endif
2174 /* Emacs ignores SIGPIPE, but the child should not. */
2175 signal (SIGPIPE, SIG_DFL);
2177 /* Stop blocking SIGCHLD in the child. */
2178 unblock_child_signal (&oldset);
2180 if (pty_flag)
2181 child_setup_tty (forkout);
2183 if (forkerr < 0)
2184 forkerr = forkout;
2185 #ifdef WINDOWSNT
2186 pid = child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2187 #else /* not WINDOWSNT */
2188 child_setup (forkin, forkout, forkerr, new_argv, 1, current_dir);
2189 #endif /* not WINDOWSNT */
2192 /* Back in the parent process. */
2194 vfork_errno = errno;
2195 p->pid = pid;
2196 if (pid >= 0)
2197 p->alive = 1;
2199 /* Stop blocking in the parent. */
2200 unblock_child_signal (&oldset);
2201 unblock_input ();
2203 if (pid < 0)
2204 report_file_errno ("Doing vfork", Qnil, vfork_errno);
2205 else
2207 /* vfork succeeded. */
2209 /* Close the pipe ends that the child uses, or the child's pty. */
2210 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2211 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2213 #ifdef WINDOWSNT
2214 register_child (pid, inchannel);
2215 #endif /* WINDOWSNT */
2217 pset_tty_name (p, lisp_pty_name);
2219 #ifndef WINDOWSNT
2220 /* Wait for child_setup to complete in case that vfork is
2221 actually defined as fork. The descriptor
2222 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2223 of a pipe is closed at the child side either by close-on-exec
2224 on successful execve or the _exit call in child_setup. */
2226 char dummy;
2228 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2229 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2230 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2232 #endif
2233 if (!NILP (p->stderrproc))
2235 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2236 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2241 static void
2242 create_pty (Lisp_Object process)
2244 struct Lisp_Process *p = XPROCESS (process);
2245 char pty_name[PTY_NAME_SIZE];
2246 int pty_fd = !p->pty_flag ? -1 : allocate_pty (pty_name);
2248 if (pty_fd >= 0)
2250 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2251 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2252 /* On most USG systems it does not work to open the pty's tty here,
2253 then close it and reopen it in the child. */
2254 /* Don't let this terminal become our controlling terminal
2255 (in case we don't have one). */
2256 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2257 if (forkout < 0)
2258 report_file_error ("Opening pty", Qnil);
2259 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2260 #if defined (DONT_REOPEN_PTY)
2261 /* In the case that vfork is defined as fork, the parent process
2262 (Emacs) may send some data before the child process completes
2263 tty options setup. So we setup tty before forking. */
2264 child_setup_tty (forkout);
2265 #endif /* DONT_REOPEN_PTY */
2266 #endif /* not USG, or USG_SUBTTY_WORKS */
2268 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2270 /* Record this as an active process, with its channels.
2271 As a result, child_setup will close Emacs's side of the pipes. */
2272 chan_process[pty_fd] = process;
2273 p->infd = pty_fd;
2274 p->outfd = pty_fd;
2276 /* Previously we recorded the tty descriptor used in the subprocess.
2277 It was only used for getting the foreground tty process, so now
2278 we just reopen the device (see emacs_get_tty_pgrp) as this is
2279 more portable (see USG_SUBTTY_WORKS above). */
2281 p->pty_flag = 1;
2282 pset_status (p, Qrun);
2283 setup_process_coding_systems (process);
2285 add_process_read_fd (pty_fd);
2287 pset_tty_name (p, build_string (pty_name));
2290 p->pid = -2;
2293 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2294 0, MANY, 0,
2295 doc: /* Create and return a bidirectional pipe process.
2297 In Emacs, pipes are represented by process objects, so input and
2298 output work as for subprocesses, and `delete-process' closes a pipe.
2299 However, a pipe process has no process id, it cannot be signaled,
2300 and the status codes are different from normal processes.
2302 Arguments are specified as keyword/argument pairs. The following
2303 arguments are defined:
2305 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2307 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2308 with the process. Process output goes at the end of that buffer,
2309 unless you specify an output stream or filter function to handle the
2310 output. If BUFFER is not given, the value of NAME is used.
2312 :coding CODING -- If CODING is a symbol, it specifies the coding
2313 system used for both reading and writing for this process. If CODING
2314 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2315 ENCODING is used for writing.
2317 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2318 the process is running. If BOOL is not given, query before exiting.
2320 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2321 In the stopped state, a pipe process does not accept incoming data,
2322 but you can send outgoing data. The stopped state is cleared by
2323 `continue-process' and set by `stop-process'.
2325 :filter FILTER -- Install FILTER as the process filter.
2327 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2329 usage: (make-pipe-process &rest ARGS) */)
2330 (ptrdiff_t nargs, Lisp_Object *args)
2332 Lisp_Object proc, contact;
2333 struct Lisp_Process *p;
2334 Lisp_Object name, buffer;
2335 Lisp_Object tem;
2336 ptrdiff_t specpdl_count;
2337 int inchannel, outchannel;
2339 if (nargs == 0)
2340 return Qnil;
2342 contact = Flist (nargs, args);
2344 name = Fplist_get (contact, QCname);
2345 CHECK_STRING (name);
2346 proc = make_process (name);
2347 specpdl_count = SPECPDL_INDEX ();
2348 record_unwind_protect (remove_process, proc);
2349 p = XPROCESS (proc);
2351 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2352 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2353 report_file_error ("Creating pipe", Qnil);
2354 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2355 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2357 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2358 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2360 #ifdef WINDOWSNT
2361 register_aux_fd (inchannel);
2362 #endif
2364 /* Record this as an active process, with its channels. */
2365 chan_process[inchannel] = proc;
2366 p->infd = inchannel;
2367 p->outfd = outchannel;
2369 if (inchannel > max_desc)
2370 max_desc = inchannel;
2372 buffer = Fplist_get (contact, QCbuffer);
2373 if (NILP (buffer))
2374 buffer = name;
2375 buffer = Fget_buffer_create (buffer);
2376 pset_buffer (p, buffer);
2378 pset_childp (p, contact);
2379 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
2380 pset_type (p, Qpipe);
2381 pset_sentinel (p, Fplist_get (contact, QCsentinel));
2382 pset_filter (p, Fplist_get (contact, QCfilter));
2383 eassert (NILP (p->log));
2384 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
2385 p->kill_without_query = 1;
2386 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
2387 pset_command (p, Qt);
2388 eassert (! p->pty_flag);
2390 if (!EQ (p->command, Qt))
2391 add_process_read_fd (inchannel);
2392 p->adaptive_read_buffering
2393 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2394 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2396 /* Make the process marker point into the process buffer (if any). */
2397 if (BUFFERP (buffer))
2398 set_marker_both (p->mark, buffer,
2399 BUF_ZV (XBUFFER (buffer)),
2400 BUF_ZV_BYTE (XBUFFER (buffer)));
2403 /* Setup coding systems for communicating with the network stream. */
2405 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2406 Lisp_Object coding_systems = Qt;
2407 Lisp_Object val;
2409 tem = Fplist_get (contact, QCcoding);
2410 val = Qnil;
2411 if (!NILP (tem))
2413 val = tem;
2414 if (CONSP (val))
2415 val = XCAR (val);
2417 else if (!NILP (Vcoding_system_for_read))
2418 val = Vcoding_system_for_read;
2419 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2420 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2421 /* We dare not decode end-of-line format by setting VAL to
2422 Qraw_text, because the existing Emacs Lisp libraries
2423 assume that they receive bare code including a sequence of
2424 CR LF. */
2425 val = Qnil;
2426 else
2428 if (CONSP (coding_systems))
2429 val = XCAR (coding_systems);
2430 else if (CONSP (Vdefault_process_coding_system))
2431 val = XCAR (Vdefault_process_coding_system);
2432 else
2433 val = Qnil;
2435 pset_decode_coding_system (p, val);
2437 if (!NILP (tem))
2439 val = tem;
2440 if (CONSP (val))
2441 val = XCDR (val);
2443 else if (!NILP (Vcoding_system_for_write))
2444 val = Vcoding_system_for_write;
2445 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2446 val = Qnil;
2447 else
2449 if (CONSP (coding_systems))
2450 val = XCDR (coding_systems);
2451 else if (CONSP (Vdefault_process_coding_system))
2452 val = XCDR (Vdefault_process_coding_system);
2453 else
2454 val = Qnil;
2456 pset_encode_coding_system (p, val);
2458 /* This may signal an error. */
2459 setup_process_coding_systems (proc);
2461 specpdl_ptr = specpdl + specpdl_count;
2463 return proc;
2467 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2468 The address family of sa is not included in the result. */
2470 Lisp_Object
2471 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2473 Lisp_Object address;
2474 ptrdiff_t i;
2475 unsigned char *cp;
2476 struct Lisp_Vector *p;
2478 /* Workaround for a bug in getsockname on BSD: Names bound to
2479 sockets in the UNIX domain are inaccessible; getsockname returns
2480 a zero length name. */
2481 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2482 return empty_unibyte_string;
2484 switch (sa->sa_family)
2486 case AF_INET:
2488 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2489 len = sizeof (sin->sin_addr) + 1;
2490 address = Fmake_vector (make_number (len), Qnil);
2491 p = XVECTOR (address);
2492 p->contents[--len] = make_number (ntohs (sin->sin_port));
2493 cp = (unsigned char *) &sin->sin_addr;
2494 break;
2496 #ifdef AF_INET6
2497 case AF_INET6:
2499 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2500 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2501 len = sizeof (sin6->sin6_addr) / 2 + 1;
2502 address = Fmake_vector (make_number (len), Qnil);
2503 p = XVECTOR (address);
2504 p->contents[--len] = make_number (ntohs (sin6->sin6_port));
2505 for (i = 0; i < len; i++)
2506 p->contents[i] = make_number (ntohs (ip6[i]));
2507 return address;
2509 #endif
2510 #ifdef HAVE_LOCAL_SOCKETS
2511 case AF_LOCAL:
2513 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2514 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2515 /* If the first byte is NUL, the name is a Linux abstract
2516 socket name, and the name can contain embedded NULs. If
2517 it's not, we have a NUL-terminated string. Be careful not
2518 to walk past the end of the object looking for the name
2519 terminator, however. */
2520 if (name_length > 0 && sockun->sun_path[0] != '\0')
2522 const char *terminator
2523 = memchr (sockun->sun_path, '\0', name_length);
2525 if (terminator)
2526 name_length = terminator - (const char *) sockun->sun_path;
2529 return make_unibyte_string (sockun->sun_path, name_length);
2531 #endif
2532 default:
2533 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2534 address = Fcons (make_number (sa->sa_family),
2535 Fmake_vector (make_number (len), Qnil));
2536 p = XVECTOR (XCDR (address));
2537 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2538 break;
2541 i = 0;
2542 while (i < len)
2543 p->contents[i++] = make_number (*cp++);
2545 return address;
2548 /* Convert an internal struct addrinfo to a Lisp object. */
2550 static Lisp_Object
2551 conv_addrinfo_to_lisp (struct addrinfo *res)
2553 Lisp_Object protocol = make_number (res->ai_protocol);
2554 eassert (XINT (protocol) == res->ai_protocol);
2555 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2559 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2561 static ptrdiff_t
2562 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2564 struct Lisp_Vector *p;
2566 if (VECTORP (address))
2568 p = XVECTOR (address);
2569 if (p->header.size == 5)
2571 *familyp = AF_INET;
2572 return sizeof (struct sockaddr_in);
2574 #ifdef AF_INET6
2575 else if (p->header.size == 9)
2577 *familyp = AF_INET6;
2578 return sizeof (struct sockaddr_in6);
2580 #endif
2582 #ifdef HAVE_LOCAL_SOCKETS
2583 else if (STRINGP (address))
2585 *familyp = AF_LOCAL;
2586 return sizeof (struct sockaddr_un);
2588 #endif
2589 else if (CONSP (address) && TYPE_RANGED_INTEGERP (int, XCAR (address))
2590 && VECTORP (XCDR (address)))
2592 struct sockaddr *sa;
2593 p = XVECTOR (XCDR (address));
2594 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2595 return 0;
2596 *familyp = XINT (XCAR (address));
2597 return p->header.size + sizeof (sa->sa_family);
2599 return 0;
2602 /* Convert an address object (vector or string) to an internal sockaddr.
2604 The address format has been basically validated by
2605 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2606 it could have come from user data. So if FAMILY is not valid,
2607 we return after zeroing *SA. */
2609 static void
2610 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2612 register struct Lisp_Vector *p;
2613 register unsigned char *cp = NULL;
2614 register int i;
2615 EMACS_INT hostport;
2617 memset (sa, 0, len);
2619 if (VECTORP (address))
2621 p = XVECTOR (address);
2622 if (family == AF_INET)
2624 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2625 len = sizeof (sin->sin_addr) + 1;
2626 hostport = XINT (p->contents[--len]);
2627 sin->sin_port = htons (hostport);
2628 cp = (unsigned char *)&sin->sin_addr;
2629 sa->sa_family = family;
2631 #ifdef AF_INET6
2632 else if (family == AF_INET6)
2634 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2635 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2636 len = sizeof (sin6->sin6_addr) / 2 + 1;
2637 hostport = XINT (p->contents[--len]);
2638 sin6->sin6_port = htons (hostport);
2639 for (i = 0; i < len; i++)
2640 if (INTEGERP (p->contents[i]))
2642 int j = XFASTINT (p->contents[i]) & 0xffff;
2643 ip6[i] = ntohs (j);
2645 sa->sa_family = family;
2646 return;
2648 #endif
2649 else
2650 return;
2652 else if (STRINGP (address))
2654 #ifdef HAVE_LOCAL_SOCKETS
2655 if (family == AF_LOCAL)
2657 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2658 cp = SDATA (address);
2659 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2660 sockun->sun_path[i] = *cp++;
2661 sa->sa_family = family;
2663 #endif
2664 return;
2666 else
2668 p = XVECTOR (XCDR (address));
2669 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2672 for (i = 0; i < len; i++)
2673 if (INTEGERP (p->contents[i]))
2674 *cp++ = XFASTINT (p->contents[i]) & 0xff;
2677 #ifdef DATAGRAM_SOCKETS
2678 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2679 1, 1, 0,
2680 doc: /* Get the current datagram address associated with PROCESS.
2681 If PROCESS is a non-blocking network process that hasn't been fully
2682 set up yet, this function will block until socket setup has completed. */)
2683 (Lisp_Object process)
2685 int channel;
2687 CHECK_PROCESS (process);
2689 if (NETCONN_P (process))
2690 wait_for_socket_fds (process, "process-datagram-address");
2692 if (!DATAGRAM_CONN_P (process))
2693 return Qnil;
2695 channel = XPROCESS (process)->infd;
2696 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2697 datagram_address[channel].len);
2700 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2701 2, 2, 0,
2702 doc: /* Set the datagram address for PROCESS to ADDRESS.
2703 Return nil upon error setting address, ADDRESS otherwise.
2705 If PROCESS is a non-blocking network process that hasn't been fully
2706 set up yet, this function will block until socket setup has completed. */)
2707 (Lisp_Object process, Lisp_Object address)
2709 int channel;
2710 int family;
2711 ptrdiff_t len;
2713 CHECK_PROCESS (process);
2715 if (NETCONN_P (process))
2716 wait_for_socket_fds (process, "set-process-datagram-address");
2718 if (!DATAGRAM_CONN_P (process))
2719 return Qnil;
2721 channel = XPROCESS (process)->infd;
2723 len = get_lisp_to_sockaddr_size (address, &family);
2724 if (len == 0 || datagram_address[channel].len != len)
2725 return Qnil;
2726 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2727 return address;
2729 #endif
2732 static const struct socket_options {
2733 /* The name of this option. Should be lowercase version of option
2734 name without SO_ prefix. */
2735 const char *name;
2736 /* Option level SOL_... */
2737 int optlevel;
2738 /* Option number SO_... */
2739 int optnum;
2740 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2741 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2742 } socket_options[] =
2744 #ifdef SO_BINDTODEVICE
2745 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2746 #endif
2747 #ifdef SO_BROADCAST
2748 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2749 #endif
2750 #ifdef SO_DONTROUTE
2751 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2752 #endif
2753 #ifdef SO_KEEPALIVE
2754 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2755 #endif
2756 #ifdef SO_LINGER
2757 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2758 #endif
2759 #ifdef SO_OOBINLINE
2760 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2761 #endif
2762 #ifdef SO_PRIORITY
2763 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2764 #endif
2765 #ifdef SO_REUSEADDR
2766 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2767 #endif
2768 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2771 /* Set option OPT to value VAL on socket S.
2773 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2774 Signals an error if setting a known option fails.
2777 static int
2778 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2780 char *name;
2781 const struct socket_options *sopt;
2782 int ret = 0;
2784 CHECK_SYMBOL (opt);
2786 name = SSDATA (SYMBOL_NAME (opt));
2787 for (sopt = socket_options; sopt->name; sopt++)
2788 if (strcmp (name, sopt->name) == 0)
2789 break;
2791 switch (sopt->opttype)
2793 case SOPT_BOOL:
2795 int optval;
2796 optval = NILP (val) ? 0 : 1;
2797 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2798 &optval, sizeof (optval));
2799 break;
2802 case SOPT_INT:
2804 int optval;
2805 if (TYPE_RANGED_INTEGERP (int, val))
2806 optval = XINT (val);
2807 else
2808 error ("Bad option value for %s", name);
2809 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2810 &optval, sizeof (optval));
2811 break;
2814 #ifdef SO_BINDTODEVICE
2815 case SOPT_IFNAME:
2817 char devname[IFNAMSIZ + 1];
2819 /* This is broken, at least in the Linux 2.4 kernel.
2820 To unbind, the arg must be a zero integer, not the empty string.
2821 This should work on all systems. KFS. 2003-09-23. */
2822 memset (devname, 0, sizeof devname);
2823 if (STRINGP (val))
2825 char *arg = SSDATA (val);
2826 int len = min (strlen (arg), IFNAMSIZ);
2827 memcpy (devname, arg, len);
2829 else if (!NILP (val))
2830 error ("Bad option value for %s", name);
2831 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2832 devname, IFNAMSIZ);
2833 break;
2835 #endif
2837 #ifdef SO_LINGER
2838 case SOPT_LINGER:
2840 struct linger linger;
2842 linger.l_onoff = 1;
2843 linger.l_linger = 0;
2844 if (TYPE_RANGED_INTEGERP (int, val))
2845 linger.l_linger = XINT (val);
2846 else
2847 linger.l_onoff = NILP (val) ? 0 : 1;
2848 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2849 &linger, sizeof (linger));
2850 break;
2852 #endif
2854 default:
2855 return 0;
2858 if (ret < 0)
2860 int setsockopt_errno = errno;
2861 report_file_errno ("Cannot set network option", list2 (opt, val),
2862 setsockopt_errno);
2865 return (1 << sopt->optbit);
2869 DEFUN ("set-network-process-option",
2870 Fset_network_process_option, Sset_network_process_option,
2871 3, 4, 0,
2872 doc: /* For network process PROCESS set option OPTION to value VALUE.
2873 See `make-network-process' for a list of options and values.
2874 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2875 OPTION is not a supported option, return nil instead; otherwise return t.
2877 If PROCESS is a non-blocking network process that hasn't been fully
2878 set up yet, this function will block until socket setup has completed. */)
2879 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2881 int s;
2882 struct Lisp_Process *p;
2884 CHECK_PROCESS (process);
2885 p = XPROCESS (process);
2886 if (!NETCONN1_P (p))
2887 error ("Process is not a network process");
2889 wait_for_socket_fds (process, "set-network-process-option");
2891 s = p->infd;
2892 if (s < 0)
2893 error ("Process is not running");
2895 if (set_socket_option (s, option, value))
2897 pset_childp (p, Fplist_put (p->childp, option, value));
2898 return Qt;
2901 if (NILP (no_error))
2902 error ("Unknown or unsupported option");
2904 return Qnil;
2908 DEFUN ("serial-process-configure",
2909 Fserial_process_configure,
2910 Sserial_process_configure,
2911 0, MANY, 0,
2912 doc: /* Configure speed, bytesize, etc. of a serial process.
2914 Arguments are specified as keyword/argument pairs. Attributes that
2915 are not given are re-initialized from the process's current
2916 configuration (available via the function `process-contact') or set to
2917 reasonable default values. The following arguments are defined:
2919 :process PROCESS
2920 :name NAME
2921 :buffer BUFFER
2922 :port PORT
2923 -- Any of these arguments can be given to identify the process that is
2924 to be configured. If none of these arguments is given, the current
2925 buffer's process is used.
2927 :speed SPEED -- SPEED is the speed of the serial port in bits per
2928 second, also called baud rate. Any value can be given for SPEED, but
2929 most serial ports work only at a few defined values between 1200 and
2930 115200, with 9600 being the most common value. If SPEED is nil, the
2931 serial port is not configured any further, i.e., all other arguments
2932 are ignored. This may be useful for special serial ports such as
2933 Bluetooth-to-serial converters which can only be configured through AT
2934 commands. A value of nil for SPEED can be used only when passed
2935 through `make-serial-process' or `serial-term'.
2937 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2938 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2940 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2941 `odd' (use odd parity), or the symbol `even' (use even parity). If
2942 PARITY is not given, no parity is used.
2944 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2945 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2946 is not given or nil, 1 stopbit is used.
2948 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2949 flowcontrol to be used, which is either nil (don't use flowcontrol),
2950 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2951 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2952 flowcontrol is used.
2954 `serial-process-configure' is called by `make-serial-process' for the
2955 initial configuration of the serial port.
2957 Examples:
2959 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2961 \(serial-process-configure
2962 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2964 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2966 usage: (serial-process-configure &rest ARGS) */)
2967 (ptrdiff_t nargs, Lisp_Object *args)
2969 struct Lisp_Process *p;
2970 Lisp_Object contact = Qnil;
2971 Lisp_Object proc = Qnil;
2973 contact = Flist (nargs, args);
2975 proc = Fplist_get (contact, QCprocess);
2976 if (NILP (proc))
2977 proc = Fplist_get (contact, QCname);
2978 if (NILP (proc))
2979 proc = Fplist_get (contact, QCbuffer);
2980 if (NILP (proc))
2981 proc = Fplist_get (contact, QCport);
2982 proc = get_process (proc);
2983 p = XPROCESS (proc);
2984 if (!EQ (p->type, Qserial))
2985 error ("Not a serial process");
2987 if (NILP (Fplist_get (p->childp, QCspeed)))
2988 return Qnil;
2990 serial_configure (p, contact);
2991 return Qnil;
2994 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
2995 0, MANY, 0,
2996 doc: /* Create and return a serial port process.
2998 In Emacs, serial port connections are represented by process objects,
2999 so input and output work as for subprocesses, and `delete-process'
3000 closes a serial port connection. However, a serial process has no
3001 process id, it cannot be signaled, and the status codes are different
3002 from normal processes.
3004 `make-serial-process' creates a process and a buffer, on which you
3005 probably want to use `process-send-string'. Try \\[serial-term] for
3006 an interactive terminal. See below for examples.
3008 Arguments are specified as keyword/argument pairs. The following
3009 arguments are defined:
3011 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3012 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3013 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3014 the backslashes in strings).
3016 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3017 which this function calls.
3019 :name NAME -- NAME is the name of the process. If NAME is not given,
3020 the value of PORT is used.
3022 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3023 with the process. Process output goes at the end of that buffer,
3024 unless you specify an output stream or filter function to handle the
3025 output. If BUFFER is not given, the value of NAME is used.
3027 :coding CODING -- If CODING is a symbol, it specifies the coding
3028 system used for both reading and writing for this process. If CODING
3029 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3030 ENCODING is used for writing.
3032 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3033 the process is running. If BOOL is not given, query before exiting.
3035 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3036 In the stopped state, a serial process does not accept incoming data,
3037 but you can send outgoing data. The stopped state is cleared by
3038 `continue-process' and set by `stop-process'.
3040 :filter FILTER -- Install FILTER as the process filter.
3042 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3044 :plist PLIST -- Install PLIST as the initial plist of the process.
3046 :bytesize
3047 :parity
3048 :stopbits
3049 :flowcontrol
3050 -- This function calls `serial-process-configure' to handle these
3051 arguments.
3053 The original argument list, possibly modified by later configuration,
3054 is available via the function `process-contact'.
3056 Examples:
3058 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3060 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3062 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3064 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3066 usage: (make-serial-process &rest ARGS) */)
3067 (ptrdiff_t nargs, Lisp_Object *args)
3069 int fd = -1;
3070 Lisp_Object proc, contact, port;
3071 struct Lisp_Process *p;
3072 Lisp_Object name, buffer;
3073 Lisp_Object tem, val;
3074 ptrdiff_t specpdl_count;
3076 if (nargs == 0)
3077 return Qnil;
3079 contact = Flist (nargs, args);
3081 port = Fplist_get (contact, QCport);
3082 if (NILP (port))
3083 error ("No port specified");
3084 CHECK_STRING (port);
3086 if (NILP (Fplist_member (contact, QCspeed)))
3087 error (":speed not specified");
3088 if (!NILP (Fplist_get (contact, QCspeed)))
3089 CHECK_NUMBER (Fplist_get (contact, QCspeed));
3091 name = Fplist_get (contact, QCname);
3092 if (NILP (name))
3093 name = port;
3094 CHECK_STRING (name);
3095 proc = make_process (name);
3096 specpdl_count = SPECPDL_INDEX ();
3097 record_unwind_protect (remove_process, proc);
3098 p = XPROCESS (proc);
3100 fd = serial_open (port);
3101 p->open_fd[SUBPROCESS_STDIN] = fd;
3102 p->infd = fd;
3103 p->outfd = fd;
3104 if (fd > max_desc)
3105 max_desc = fd;
3106 chan_process[fd] = proc;
3108 buffer = Fplist_get (contact, QCbuffer);
3109 if (NILP (buffer))
3110 buffer = name;
3111 buffer = Fget_buffer_create (buffer);
3112 pset_buffer (p, buffer);
3114 pset_childp (p, contact);
3115 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
3116 pset_type (p, Qserial);
3117 pset_sentinel (p, Fplist_get (contact, QCsentinel));
3118 pset_filter (p, Fplist_get (contact, QCfilter));
3119 eassert (NILP (p->log));
3120 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
3121 p->kill_without_query = 1;
3122 if (tem = Fplist_get (contact, QCstop), !NILP (tem))
3123 pset_command (p, Qt);
3124 eassert (! p->pty_flag);
3126 if (!EQ (p->command, Qt))
3127 add_process_read_fd (fd);
3129 if (BUFFERP (buffer))
3131 set_marker_both (p->mark, buffer,
3132 BUF_ZV (XBUFFER (buffer)),
3133 BUF_ZV_BYTE (XBUFFER (buffer)));
3136 tem = Fplist_member (contact, QCcoding);
3137 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3138 tem = Qnil;
3140 val = Qnil;
3141 if (!NILP (tem))
3143 val = XCAR (XCDR (tem));
3144 if (CONSP (val))
3145 val = XCAR (val);
3147 else if (!NILP (Vcoding_system_for_read))
3148 val = Vcoding_system_for_read;
3149 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3150 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3151 val = Qnil;
3152 pset_decode_coding_system (p, val);
3154 val = Qnil;
3155 if (!NILP (tem))
3157 val = XCAR (XCDR (tem));
3158 if (CONSP (val))
3159 val = XCDR (val);
3161 else if (!NILP (Vcoding_system_for_write))
3162 val = Vcoding_system_for_write;
3163 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3164 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3165 val = Qnil;
3166 pset_encode_coding_system (p, val);
3168 setup_process_coding_systems (proc);
3169 pset_decoding_buf (p, empty_unibyte_string);
3170 eassert (p->decoding_carryover == 0);
3171 pset_encoding_buf (p, empty_unibyte_string);
3172 p->inherit_coding_system_flag
3173 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3175 Fserial_process_configure (nargs, args);
3177 specpdl_ptr = specpdl + specpdl_count;
3179 return proc;
3182 static void
3183 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3184 Lisp_Object service, Lisp_Object name)
3186 Lisp_Object tem;
3187 struct Lisp_Process *p = XPROCESS (proc);
3188 Lisp_Object contact = p->childp;
3189 Lisp_Object coding_systems = Qt;
3190 Lisp_Object val;
3192 tem = Fplist_member (contact, QCcoding);
3193 if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem))))
3194 tem = Qnil; /* No error message (too late!). */
3196 /* Setup coding systems for communicating with the network stream. */
3197 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3199 if (!NILP (tem))
3201 val = XCAR (XCDR (tem));
3202 if (CONSP (val))
3203 val = XCAR (val);
3205 else if (!NILP (Vcoding_system_for_read))
3206 val = Vcoding_system_for_read;
3207 else if ((!NILP (p->buffer)
3208 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3209 || (NILP (p->buffer)
3210 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3211 /* We dare not decode end-of-line format by setting VAL to
3212 Qraw_text, because the existing Emacs Lisp libraries
3213 assume that they receive bare code including a sequence of
3214 CR LF. */
3215 val = Qnil;
3216 else
3218 if (NILP (host) || NILP (service))
3219 coding_systems = Qnil;
3220 else
3221 coding_systems = CALLN (Ffind_operation_coding_system,
3222 Qopen_network_stream, name, p->buffer,
3223 host, service);
3224 if (CONSP (coding_systems))
3225 val = XCAR (coding_systems);
3226 else if (CONSP (Vdefault_process_coding_system))
3227 val = XCAR (Vdefault_process_coding_system);
3228 else
3229 val = Qnil;
3231 pset_decode_coding_system (p, val);
3233 if (!NILP (tem))
3235 val = XCAR (XCDR (tem));
3236 if (CONSP (val))
3237 val = XCDR (val);
3239 else if (!NILP (Vcoding_system_for_write))
3240 val = Vcoding_system_for_write;
3241 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3242 val = Qnil;
3243 else
3245 if (EQ (coding_systems, Qt))
3247 if (NILP (host) || NILP (service))
3248 coding_systems = Qnil;
3249 else
3250 coding_systems = CALLN (Ffind_operation_coding_system,
3251 Qopen_network_stream, name, p->buffer,
3252 host, service);
3254 if (CONSP (coding_systems))
3255 val = XCDR (coding_systems);
3256 else if (CONSP (Vdefault_process_coding_system))
3257 val = XCDR (Vdefault_process_coding_system);
3258 else
3259 val = Qnil;
3261 pset_encode_coding_system (p, val);
3263 pset_decoding_buf (p, empty_unibyte_string);
3264 p->decoding_carryover = 0;
3265 pset_encoding_buf (p, empty_unibyte_string);
3267 p->inherit_coding_system_flag
3268 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3271 #ifdef HAVE_GNUTLS
3272 static void
3273 finish_after_tls_connection (Lisp_Object proc)
3275 struct Lisp_Process *p = XPROCESS (proc);
3276 Lisp_Object contact = p->childp;
3277 Lisp_Object result = Qt;
3279 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3280 result = call3 (Qnsm_verify_connection,
3281 proc,
3282 Fplist_get (contact, QChost),
3283 Fplist_get (contact, QCservice));
3285 if (NILP (result))
3287 pset_status (p, list2 (Qfailed,
3288 build_string ("The Network Security Manager stopped the connections")));
3289 deactivate_process (proc);
3291 else if (p->outfd < 0)
3293 /* The counterparty may have closed the connection (especially
3294 if the NSM prompt above take a long time), so recheck the file
3295 descriptor here. */
3296 pset_status (p, Qfailed);
3297 deactivate_process (proc);
3299 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3301 /* If we cleared the connection wait mask before we did the TLS
3302 setup, then we have to say that the process is finally "open"
3303 here. */
3304 pset_status (p, Qrun);
3305 /* Execute the sentinel here. If we had relied on status_notify
3306 to do it later, it will read input from the process before
3307 calling the sentinel. */
3308 exec_sentinel (proc, build_string ("open\n"));
3311 #endif
3313 static void
3314 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3315 Lisp_Object use_external_socket_p)
3317 ptrdiff_t count = SPECPDL_INDEX ();
3318 int s = -1, outch, inch;
3319 int xerrno = 0;
3320 int family;
3321 struct sockaddr *sa = NULL;
3322 int ret;
3323 ptrdiff_t addrlen;
3324 struct Lisp_Process *p = XPROCESS (proc);
3325 Lisp_Object contact = p->childp;
3326 int optbits = 0;
3327 int socket_to_use = -1;
3329 if (!NILP (use_external_socket_p))
3331 socket_to_use = external_sock_fd;
3333 /* Ensure we don't consume the external socket twice. */
3334 external_sock_fd = -1;
3337 /* Do this in case we never enter the while-loop below. */
3338 s = -1;
3340 while (!NILP (addrinfos))
3342 Lisp_Object addrinfo = XCAR (addrinfos);
3343 addrinfos = XCDR (addrinfos);
3344 int protocol = XINT (XCAR (addrinfo));
3345 Lisp_Object ip_address = XCDR (addrinfo);
3347 #ifdef WINDOWSNT
3348 retry_connect:
3349 #endif
3351 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3352 if (sa)
3353 free (sa);
3354 sa = xmalloc (addrlen);
3355 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3357 s = socket_to_use;
3358 if (s < 0)
3360 int socktype = p->socktype | SOCK_CLOEXEC;
3361 if (p->is_non_blocking_client)
3362 socktype |= SOCK_NONBLOCK;
3363 s = socket (family, socktype, protocol);
3364 if (s < 0)
3366 xerrno = errno;
3367 continue;
3371 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3373 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3374 if (ret < 0)
3376 xerrno = errno;
3377 emacs_close (s);
3378 s = -1;
3379 if (0 <= socket_to_use)
3380 break;
3381 continue;
3385 #ifdef DATAGRAM_SOCKETS
3386 if (!p->is_server && p->socktype == SOCK_DGRAM)
3387 break;
3388 #endif /* DATAGRAM_SOCKETS */
3390 /* Make us close S if quit. */
3391 record_unwind_protect_int (close_file_unwind, s);
3393 /* Parse network options in the arg list. We simply ignore anything
3394 which isn't a known option (including other keywords). An error
3395 is signaled if setting a known option fails. */
3397 Lisp_Object params = contact, key, val;
3399 while (!NILP (params))
3401 key = XCAR (params);
3402 params = XCDR (params);
3403 val = XCAR (params);
3404 params = XCDR (params);
3405 optbits |= set_socket_option (s, key, val);
3409 if (p->is_server)
3411 /* Configure as a server socket. */
3413 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3414 explicit :reuseaddr key to override this. */
3415 #ifdef HAVE_LOCAL_SOCKETS
3416 if (family != AF_LOCAL)
3417 #endif
3418 if (!(optbits & (1 << OPIX_REUSEADDR)))
3420 int optval = 1;
3421 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3422 report_file_error ("Cannot set reuse option on server socket", Qnil);
3425 /* If passed a socket descriptor, it should be already bound. */
3426 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3427 report_file_error ("Cannot bind server socket", Qnil);
3429 #ifdef HAVE_GETSOCKNAME
3430 if (p->port == 0
3431 #ifdef HAVE_LOCAL_SOCKETS
3432 && family != AF_LOCAL
3433 #endif
3436 struct sockaddr_in sa1;
3437 socklen_t len1 = sizeof (sa1);
3438 #ifdef AF_INET6
3439 /* The code below assumes the port is at the same offset
3440 and of the same width in both IPv4 and IPv6
3441 structures, but the standards don't guarantee that,
3442 so verify it here. */
3443 struct sockaddr_in6 sa6;
3444 verify ((offsetof (struct sockaddr_in, sin_port)
3445 == offsetof (struct sockaddr_in6, sin6_port))
3446 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3447 #endif
3448 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3449 if (getsockname (s, psa1, &len1) == 0)
3451 Lisp_Object service = make_number (ntohs (sa1.sin_port));
3452 contact = Fplist_put (contact, QCservice, service);
3453 /* Save the port number so that we can stash it in
3454 the process object later. */
3455 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3456 psa->sin_port = sa1.sin_port;
3459 #endif
3461 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3462 report_file_error ("Cannot listen on server socket", Qnil);
3464 break;
3467 maybe_quit ();
3469 ret = connect (s, sa, addrlen);
3470 xerrno = errno;
3472 if (ret == 0 || xerrno == EISCONN)
3474 /* The unwind-protect will be discarded afterwards. */
3475 break;
3478 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3479 break;
3481 #ifndef WINDOWSNT
3482 if (xerrno == EINTR)
3484 /* Unlike most other syscalls connect() cannot be called
3485 again. (That would return EALREADY.) The proper way to
3486 wait for completion is pselect(). */
3487 int sc;
3488 socklen_t len;
3489 fd_set fdset;
3490 retry_select:
3491 FD_ZERO (&fdset);
3492 FD_SET (s, &fdset);
3493 maybe_quit ();
3494 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3495 if (sc == -1)
3497 if (errno == EINTR)
3498 goto retry_select;
3499 else
3500 report_file_error ("Failed select", Qnil);
3502 eassert (sc > 0);
3504 len = sizeof xerrno;
3505 eassert (FD_ISSET (s, &fdset));
3506 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3507 report_file_error ("Failed getsockopt", Qnil);
3508 if (xerrno == 0)
3509 break;
3510 if (NILP (addrinfos))
3511 report_file_errno ("Failed connect", Qnil, xerrno);
3513 #endif /* !WINDOWSNT */
3515 /* Discard the unwind protect closing S. */
3516 specpdl_ptr = specpdl + count;
3517 emacs_close (s);
3518 s = -1;
3519 if (0 <= socket_to_use)
3520 break;
3522 #ifdef WINDOWSNT
3523 if (xerrno == EINTR)
3524 goto retry_connect;
3525 #endif
3528 if (s >= 0)
3530 #ifdef DATAGRAM_SOCKETS
3531 if (p->socktype == SOCK_DGRAM)
3533 if (datagram_address[s].sa)
3534 emacs_abort ();
3536 datagram_address[s].sa = xmalloc (addrlen);
3537 datagram_address[s].len = addrlen;
3538 if (p->is_server)
3540 Lisp_Object remote;
3541 memset (datagram_address[s].sa, 0, addrlen);
3542 if (remote = Fplist_get (contact, QCremote), !NILP (remote))
3544 int rfamily;
3545 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3546 if (rlen != 0 && rfamily == family
3547 && rlen == addrlen)
3548 conv_lisp_to_sockaddr (rfamily, remote,
3549 datagram_address[s].sa, rlen);
3552 else
3553 memcpy (datagram_address[s].sa, sa, addrlen);
3555 #endif
3557 contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
3558 conv_sockaddr_to_lisp (sa, addrlen));
3559 #ifdef HAVE_GETSOCKNAME
3560 if (!p->is_server)
3562 struct sockaddr_storage sa1;
3563 socklen_t len1 = sizeof (sa1);
3564 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3565 if (getsockname (s, psa1, &len1) == 0)
3566 contact = Fplist_put (contact, QClocal,
3567 conv_sockaddr_to_lisp (psa1, len1));
3569 #endif
3572 if (s < 0)
3574 /* If non-blocking got this far - and failed - assume non-blocking is
3575 not supported after all. This is probably a wrong assumption, but
3576 the normal blocking calls to open-network-stream handles this error
3577 better. */
3578 if (p->is_non_blocking_client)
3579 return;
3581 report_file_errno ((p->is_server
3582 ? "make server process failed"
3583 : "make client process failed"),
3584 contact, xerrno);
3587 inch = s;
3588 outch = s;
3590 chan_process[inch] = proc;
3592 fcntl (inch, F_SETFL, O_NONBLOCK);
3594 p = XPROCESS (proc);
3595 p->open_fd[SUBPROCESS_STDIN] = inch;
3596 p->infd = inch;
3597 p->outfd = outch;
3599 /* Discard the unwind protect for closing S, if any. */
3600 specpdl_ptr = specpdl + count;
3602 if (p->is_server && p->socktype != SOCK_DGRAM)
3603 pset_status (p, Qlisten);
3605 /* Make the process marker point into the process buffer (if any). */
3606 if (BUFFERP (p->buffer))
3607 set_marker_both (p->mark, p->buffer,
3608 BUF_ZV (XBUFFER (p->buffer)),
3609 BUF_ZV_BYTE (XBUFFER (p->buffer)));
3611 if (p->is_non_blocking_client)
3613 /* We may get here if connect did succeed immediately. However,
3614 in that case, we still need to signal this like a non-blocking
3615 connection. */
3616 if (! (connecting_status (p->status)
3617 && EQ (XCDR (p->status), addrinfos)))
3618 pset_status (p, Fcons (Qconnect, addrinfos));
3619 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3620 add_non_blocking_write_fd (inch);
3622 else
3623 /* A server may have a client filter setting of Qt, but it must
3624 still listen for incoming connects unless it is stopped. */
3625 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3626 || (EQ (p->status, Qlisten) && NILP (p->command)))
3627 add_process_read_fd (inch);
3629 if (inch > max_desc)
3630 max_desc = inch;
3632 /* Set up the masks based on the process filter. */
3633 set_process_filter_masks (p);
3635 setup_process_coding_systems (proc);
3637 #ifdef HAVE_GNUTLS
3638 /* Continue the asynchronous connection. */
3639 if (!NILP (p->gnutls_boot_parameters))
3641 Lisp_Object boot, params = p->gnutls_boot_parameters;
3643 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3644 p->gnutls_boot_parameters = Qnil;
3646 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3647 /* Run sentinels, etc. */
3648 finish_after_tls_connection (proc);
3649 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3651 deactivate_process (proc);
3652 if (NILP (boot))
3653 pset_status (p, list2 (Qfailed,
3654 build_string ("TLS negotiation failed")));
3655 else
3656 pset_status (p, list2 (Qfailed, boot));
3659 #endif
3663 /* Create a network stream/datagram client/server process. Treated
3664 exactly like a normal process when reading and writing. Primary
3665 differences are in status display and process deletion. A network
3666 connection has no PID; you cannot signal it. All you can do is
3667 stop/continue it and deactivate/close it via delete-process. */
3669 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3670 0, MANY, 0,
3671 doc: /* Create and return a network server or client process.
3673 In Emacs, network connections are represented by process objects, so
3674 input and output work as for subprocesses and `delete-process' closes
3675 a network connection. However, a network process has no process id,
3676 it cannot be signaled, and the status codes are different from normal
3677 processes.
3679 Arguments are specified as keyword/argument pairs. The following
3680 arguments are defined:
3682 :name NAME -- NAME is name for process. It is modified if necessary
3683 to make it unique.
3685 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3686 with the process. Process output goes at end of that buffer, unless
3687 you specify an output stream or filter function to handle the output.
3688 BUFFER may be also nil, meaning that this process is not associated
3689 with any buffer.
3691 :host HOST -- HOST is name of the host to connect to, or its IP
3692 address. The symbol `local' specifies the local host. If specified
3693 for a server process, it must be a valid name or address for the local
3694 host, and only clients connecting to that address will be accepted.
3696 :service SERVICE -- SERVICE is name of the service desired, or an
3697 integer specifying a port number to connect to. If SERVICE is t,
3698 a random port number is selected for the server. A port number can
3699 be specified as an integer string, e.g., "80", as well as an integer.
3701 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3702 stream type connection, `datagram' creates a datagram type connection,
3703 `seqpacket' creates a reliable datagram connection.
3705 :family FAMILY -- FAMILY is the address (and protocol) family for the
3706 service specified by HOST and SERVICE. The default (nil) is to use
3707 whatever address family (IPv4 or IPv6) that is defined for the host
3708 and port number specified by HOST and SERVICE. Other address families
3709 supported are:
3710 local -- for a local (i.e. UNIX) address specified by SERVICE.
3711 ipv4 -- use IPv4 address family only.
3712 ipv6 -- use IPv6 address family only.
3714 :local ADDRESS -- ADDRESS is the local address used for the connection.
3715 This parameter is ignored when opening a client process. When specified
3716 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3718 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3719 connection. This parameter is ignored when opening a stream server
3720 process. For a datagram server process, it specifies the initial
3721 setting of the remote datagram address. When specified for a client
3722 process, the FAMILY, HOST, and SERVICE args are ignored.
3724 The format of ADDRESS depends on the address family:
3725 - An IPv4 address is represented as an vector of integers [A B C D P]
3726 corresponding to numeric IP address A.B.C.D and port number P.
3727 - A local address is represented as a string with the address in the
3728 local address space.
3729 - An "unsupported family" address is represented by a cons (F . AV)
3730 where F is the family number and AV is a vector containing the socket
3731 address data with one element per address data byte. Do not rely on
3732 this format in portable code, as it may depend on implementation
3733 defined constants, data sizes, and data structure alignment.
3735 :coding CODING -- If CODING is a symbol, it specifies the coding
3736 system used for both reading and writing for this process. If CODING
3737 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3738 ENCODING is used for writing.
3740 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3741 process, return without waiting for the connection to complete;
3742 instead, the sentinel function will be called with second arg matching
3743 "open" (if successful) or "failed" when the connect completes.
3744 Default is to use a blocking connect (i.e. wait) for stream type
3745 connections.
3747 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3748 running when Emacs is exited.
3750 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3751 In the stopped state, a server process does not accept new
3752 connections, and a client process does not handle incoming traffic.
3753 The stopped state is cleared by `continue-process' and set by
3754 `stop-process'.
3756 :filter FILTER -- Install FILTER as the process filter.
3758 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3759 process filter are multibyte, otherwise they are unibyte.
3760 If this keyword is not specified, the strings are multibyte if
3761 the default value of `enable-multibyte-characters' is non-nil.
3763 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3765 :log LOG -- Install LOG as the server process log function. This
3766 function is called when the server accepts a network connection from a
3767 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3768 is the server process, CLIENT is the new process for the connection,
3769 and MESSAGE is a string.
3771 :plist PLIST -- Install PLIST as the new process's initial plist.
3773 :tls-parameters LIST -- is a list that should be supplied if you're
3774 opening a TLS connection. The first element is the TLS type (either
3775 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3776 be a keyword list accepted by gnutls-boot (as returned by
3777 `gnutls-boot-parameters').
3779 :server QLEN -- if QLEN is non-nil, create a server process for the
3780 specified FAMILY, SERVICE, and connection type (stream or datagram).
3781 If QLEN is an integer, it is used as the max. length of the server's
3782 pending connection queue (also known as the backlog); the default
3783 queue length is 5. Default is to create a client process.
3785 The following network options can be specified for this connection:
3787 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3788 :dontroute BOOL -- Only send to directly connected hosts.
3789 :keepalive BOOL -- Send keep-alive messages on network stream.
3790 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3791 :oobinline BOOL -- Place out-of-band data in receive data stream.
3792 :priority INT -- Set protocol defined priority for sent packets.
3793 :reuseaddr BOOL -- Allow reusing a recently used local address
3794 (this is allowed by default for a server process).
3795 :bindtodevice NAME -- bind to interface NAME. Using this may require
3796 special privileges on some systems.
3797 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3798 been passed to Emacs. If Emacs wasn't
3799 passed a socket, this option is silently
3800 ignored.
3803 Consult the relevant system programmer's manual pages for more
3804 information on using these options.
3807 A server process will listen for and accept connections from clients.
3808 When a client connection is accepted, a new network process is created
3809 for the connection with the following parameters:
3811 - The client's process name is constructed by concatenating the server
3812 process's NAME and a client identification string.
3813 - If the FILTER argument is non-nil, the client process will not get a
3814 separate process buffer; otherwise, the client's process buffer is a newly
3815 created buffer named after the server process's BUFFER name or process
3816 NAME concatenated with the client identification string.
3817 - The connection type and the process filter and sentinel parameters are
3818 inherited from the server process's TYPE, FILTER and SENTINEL.
3819 - The client process's contact info is set according to the client's
3820 addressing information (typically an IP address and a port number).
3821 - The client process's plist is initialized from the server's plist.
3823 Notice that the FILTER and SENTINEL args are never used directly by
3824 the server process. Also, the BUFFER argument is not used directly by
3825 the server process, but via the optional :log function, accepted (and
3826 failed) connections may be logged in the server process's buffer.
3828 The original argument list, modified with the actual connection
3829 information, is available via the `process-contact' function.
3831 usage: (make-network-process &rest ARGS) */)
3832 (ptrdiff_t nargs, Lisp_Object *args)
3834 Lisp_Object proc;
3835 Lisp_Object contact;
3836 struct Lisp_Process *p;
3837 const char *portstring UNINIT;
3838 ptrdiff_t portstringlen ATTRIBUTE_UNUSED;
3839 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3840 #ifdef HAVE_LOCAL_SOCKETS
3841 struct sockaddr_un address_un;
3842 #endif
3843 EMACS_INT port = 0;
3844 Lisp_Object tem;
3845 Lisp_Object name, buffer, host, service, address;
3846 Lisp_Object filter, sentinel, use_external_socket_p;
3847 Lisp_Object addrinfos = Qnil;
3848 int socktype;
3849 int family = -1;
3850 enum { any_protocol = 0 };
3851 #ifdef HAVE_GETADDRINFO_A
3852 struct gaicb *dns_request = NULL;
3853 #endif
3854 ptrdiff_t count = SPECPDL_INDEX ();
3856 if (nargs == 0)
3857 return Qnil;
3859 /* Save arguments for process-contact and clone-process. */
3860 contact = Flist (nargs, args);
3862 #ifdef WINDOWSNT
3863 /* Ensure socket support is loaded if available. */
3864 init_winsock (TRUE);
3865 #endif
3867 /* :type TYPE (nil: stream, datagram */
3868 tem = Fplist_get (contact, QCtype);
3869 if (NILP (tem))
3870 socktype = SOCK_STREAM;
3871 #ifdef DATAGRAM_SOCKETS
3872 else if (EQ (tem, Qdatagram))
3873 socktype = SOCK_DGRAM;
3874 #endif
3875 #ifdef HAVE_SEQPACKET
3876 else if (EQ (tem, Qseqpacket))
3877 socktype = SOCK_SEQPACKET;
3878 #endif
3879 else
3880 error ("Unsupported connection type");
3882 name = Fplist_get (contact, QCname);
3883 buffer = Fplist_get (contact, QCbuffer);
3884 filter = Fplist_get (contact, QCfilter);
3885 sentinel = Fplist_get (contact, QCsentinel);
3886 use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
3888 CHECK_STRING (name);
3890 /* :local ADDRESS or :remote ADDRESS */
3891 tem = Fplist_get (contact, QCserver);
3892 if (NILP (tem))
3893 address = Fplist_get (contact, QCremote);
3894 else
3895 address = Fplist_get (contact, QClocal);
3896 if (!NILP (address))
3898 host = service = Qnil;
3900 if (!get_lisp_to_sockaddr_size (address, &family))
3901 error ("Malformed :address");
3903 addrinfos = list1 (Fcons (make_number (any_protocol), address));
3904 goto open_socket;
3907 /* :family FAMILY -- nil (for Inet), local, or integer. */
3908 tem = Fplist_get (contact, QCfamily);
3909 if (NILP (tem))
3911 #ifdef AF_INET6
3912 family = AF_UNSPEC;
3913 #else
3914 family = AF_INET;
3915 #endif
3917 #ifdef HAVE_LOCAL_SOCKETS
3918 else if (EQ (tem, Qlocal))
3919 family = AF_LOCAL;
3920 #endif
3921 #ifdef AF_INET6
3922 else if (EQ (tem, Qipv6))
3923 family = AF_INET6;
3924 #endif
3925 else if (EQ (tem, Qipv4))
3926 family = AF_INET;
3927 else if (TYPE_RANGED_INTEGERP (int, tem))
3928 family = XINT (tem);
3929 else
3930 error ("Unknown address family");
3932 /* :service SERVICE -- string, integer (port number), or t (random port). */
3933 service = Fplist_get (contact, QCservice);
3935 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3936 host = Fplist_get (contact, QChost);
3937 if (NILP (host))
3939 /* The "connection" function gets it bind info from the address we're
3940 given, so use this dummy address if nothing is specified. */
3941 #ifdef HAVE_LOCAL_SOCKETS
3942 if (family != AF_LOCAL)
3943 #endif
3944 host = build_string ("127.0.0.1");
3946 else
3948 if (EQ (host, Qlocal))
3949 /* Depending on setup, "localhost" may map to different IPv4 and/or
3950 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3951 host = build_string ("127.0.0.1");
3952 CHECK_STRING (host);
3955 #ifdef HAVE_LOCAL_SOCKETS
3956 if (family == AF_LOCAL)
3958 if (!NILP (host))
3960 message (":family local ignores the :host property");
3961 contact = Fplist_put (contact, QChost, Qnil);
3962 host = Qnil;
3964 CHECK_STRING (service);
3965 if (sizeof address_un.sun_path <= SBYTES (service))
3966 error ("Service name too long");
3967 addrinfos = list1 (Fcons (make_number (any_protocol), service));
3968 goto open_socket;
3970 #endif
3972 /* Slow down polling to every ten seconds.
3973 Some kernels have a bug which causes retrying connect to fail
3974 after a connect. Polling can interfere with gethostbyname too. */
3975 #ifdef POLL_FOR_INPUT
3976 if (socktype != SOCK_DGRAM)
3978 record_unwind_protect_void (run_all_atimers);
3979 bind_polling_period (10);
3981 #endif
3983 if (!NILP (host))
3985 /* SERVICE can either be a string or int.
3986 Convert to a C string for later use by getaddrinfo. */
3987 if (EQ (service, Qt))
3989 portstring = "0";
3990 portstringlen = 1;
3992 else if (INTEGERP (service))
3994 portstring = portbuf;
3995 portstringlen = sprintf (portbuf, "%"pI"d", XINT (service));
3997 else
3999 CHECK_STRING (service);
4000 portstring = SSDATA (service);
4001 portstringlen = SBYTES (service);
4005 #ifdef HAVE_GETADDRINFO_A
4006 if (!NILP (host) && !NILP (Fplist_get (contact, QCnowait)))
4008 ptrdiff_t hostlen = SBYTES (host);
4009 struct req
4011 struct gaicb gaicb;
4012 struct addrinfo hints;
4013 char str[FLEXIBLE_ARRAY_MEMBER];
4014 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4015 hostlen + 1 + portstringlen + 1));
4016 dns_request = &req->gaicb;
4017 dns_request->ar_name = req->str;
4018 dns_request->ar_service = req->str + hostlen + 1;
4019 dns_request->ar_request = &req->hints;
4020 dns_request->ar_result = NULL;
4021 memset (&req->hints, 0, sizeof req->hints);
4022 req->hints.ai_family = family;
4023 req->hints.ai_socktype = socktype;
4024 strcpy (req->str, SSDATA (host));
4025 strcpy (req->str + hostlen + 1, portstring);
4027 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4028 if (ret)
4029 error ("%s/%s getaddrinfo_a error %d", SSDATA (host), portstring, ret);
4031 goto open_socket;
4033 #endif /* HAVE_GETADDRINFO_A */
4035 /* If we have a host, use getaddrinfo to resolve both host and service.
4036 Otherwise, use getservbyname to lookup the service. */
4038 if (!NILP (host))
4040 struct addrinfo *res, *lres;
4041 int ret;
4043 maybe_quit ();
4045 struct addrinfo hints;
4046 memset (&hints, 0, sizeof hints);
4047 hints.ai_family = family;
4048 hints.ai_socktype = socktype;
4050 ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
4051 if (ret)
4052 #ifdef HAVE_GAI_STRERROR
4054 synchronize_system_messages_locale ();
4055 char const *str = gai_strerror (ret);
4056 if (! NILP (Vlocale_coding_system))
4057 str = SSDATA (code_convert_string_norecord
4058 (build_string (str), Vlocale_coding_system, 0));
4059 error ("%s/%s %s", SSDATA (host), portstring, str);
4061 #else
4062 error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
4063 #endif
4065 for (lres = res; lres; lres = lres->ai_next)
4066 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4068 addrinfos = Fnreverse (addrinfos);
4070 freeaddrinfo (res);
4072 goto open_socket;
4075 /* No hostname has been specified (e.g., a local server process). */
4077 if (EQ (service, Qt))
4078 port = 0;
4079 else if (INTEGERP (service))
4080 port = XINT (service);
4081 else
4083 CHECK_STRING (service);
4085 port = -1;
4086 if (SBYTES (service) != 0)
4088 /* Allow the service to be a string containing the port number,
4089 because that's allowed if you have getaddrbyname. */
4090 char *service_end;
4091 long int lport = strtol (SSDATA (service), &service_end, 10);
4092 if (service_end == SSDATA (service) + SBYTES (service))
4093 port = lport;
4094 else
4096 struct servent *svc_info
4097 = getservbyname (SSDATA (service),
4098 socktype == SOCK_DGRAM ? "udp" : "tcp");
4099 if (svc_info)
4100 port = ntohs (svc_info->s_port);
4105 if (! (0 <= port && port < 1 << 16))
4107 AUTO_STRING (unknown_service, "Unknown service: %s");
4108 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4111 open_socket:
4113 if (!NILP (buffer))
4114 buffer = Fget_buffer_create (buffer);
4116 /* Unwind bind_polling_period. */
4117 unbind_to (count, Qnil);
4119 proc = make_process (name);
4120 record_unwind_protect (remove_process, proc);
4121 p = XPROCESS (proc);
4122 pset_childp (p, contact);
4123 pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
4124 pset_type (p, Qnetwork);
4126 pset_buffer (p, buffer);
4127 pset_sentinel (p, sentinel);
4128 pset_filter (p, filter);
4129 pset_log (p, Fplist_get (contact, QClog));
4130 if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
4131 p->kill_without_query = 1;
4132 if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
4133 pset_command (p, Qt);
4134 eassert (p->pid == 0);
4135 p->backlog = 5;
4136 eassert (! p->is_non_blocking_client);
4137 eassert (! p->is_server);
4138 p->port = port;
4139 p->socktype = socktype;
4140 #ifdef HAVE_GETADDRINFO_A
4141 eassert (! p->dns_request);
4142 #endif
4143 #ifdef HAVE_GNUTLS
4144 tem = Fplist_get (contact, QCtls_parameters);
4145 CHECK_LIST (tem);
4146 p->gnutls_boot_parameters = tem;
4147 #endif
4149 set_network_socket_coding_system (proc, host, service, name);
4151 /* :server BOOL */
4152 tem = Fplist_get (contact, QCserver);
4153 if (!NILP (tem))
4155 /* Don't support network sockets when non-blocking mode is
4156 not available, since a blocked Emacs is not useful. */
4157 p->is_server = true;
4158 if (TYPE_RANGED_INTEGERP (int, tem))
4159 p->backlog = XINT (tem);
4162 /* :nowait BOOL */
4163 if (!p->is_server && socktype != SOCK_DGRAM
4164 && !NILP (Fplist_get (contact, QCnowait)))
4165 p->is_non_blocking_client = true;
4167 bool postpone_connection = false;
4168 #ifdef HAVE_GETADDRINFO_A
4169 /* With async address resolution, the list of addresses is empty, so
4170 postpone connecting to the server. */
4171 if (!p->is_server && NILP (addrinfos))
4173 p->dns_request = dns_request;
4174 p->status = list1 (Qconnect);
4175 postpone_connection = true;
4177 #endif
4178 if (! postpone_connection)
4179 connect_network_socket (proc, addrinfos, use_external_socket_p);
4181 specpdl_ptr = specpdl + count;
4182 return proc;
4186 #ifdef HAVE_NET_IF_H
4188 #ifdef SIOCGIFCONF
4189 static Lisp_Object
4190 network_interface_list (void)
4192 struct ifconf ifconf;
4193 struct ifreq *ifreq;
4194 void *buf = NULL;
4195 ptrdiff_t buf_size = 512;
4196 int s;
4197 Lisp_Object res;
4198 ptrdiff_t count;
4200 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4201 if (s < 0)
4202 return Qnil;
4203 count = SPECPDL_INDEX ();
4204 record_unwind_protect_int (close_file_unwind, s);
4208 buf = xpalloc (buf, &buf_size, 1, INT_MAX, 1);
4209 ifconf.ifc_buf = buf;
4210 ifconf.ifc_len = buf_size;
4211 if (ioctl (s, SIOCGIFCONF, &ifconf))
4213 emacs_close (s);
4214 xfree (buf);
4215 return Qnil;
4218 while (ifconf.ifc_len == buf_size);
4220 res = unbind_to (count, Qnil);
4221 ifreq = ifconf.ifc_req;
4222 while ((char *) ifreq < (char *) ifconf.ifc_req + ifconf.ifc_len)
4224 struct ifreq *ifq = ifreq;
4225 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4226 #define SIZEOF_IFREQ(sif) \
4227 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4228 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4230 int len = SIZEOF_IFREQ (ifq);
4231 #else
4232 int len = sizeof (*ifreq);
4233 #endif
4234 char namebuf[sizeof (ifq->ifr_name) + 1];
4235 ifreq = (struct ifreq *) ((char *) ifreq + len);
4237 if (ifq->ifr_addr.sa_family != AF_INET)
4238 continue;
4240 memcpy (namebuf, ifq->ifr_name, sizeof (ifq->ifr_name));
4241 namebuf[sizeof (ifq->ifr_name)] = 0;
4242 res = Fcons (Fcons (build_string (namebuf),
4243 conv_sockaddr_to_lisp (&ifq->ifr_addr,
4244 sizeof (struct sockaddr))),
4245 res);
4248 xfree (buf);
4249 return res;
4251 #endif /* SIOCGIFCONF */
4253 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4255 struct ifflag_def {
4256 int flag_bit;
4257 const char *flag_sym;
4260 static const struct ifflag_def ifflag_table[] = {
4261 #ifdef IFF_UP
4262 { IFF_UP, "up" },
4263 #endif
4264 #ifdef IFF_BROADCAST
4265 { IFF_BROADCAST, "broadcast" },
4266 #endif
4267 #ifdef IFF_DEBUG
4268 { IFF_DEBUG, "debug" },
4269 #endif
4270 #ifdef IFF_LOOPBACK
4271 { IFF_LOOPBACK, "loopback" },
4272 #endif
4273 #ifdef IFF_POINTOPOINT
4274 { IFF_POINTOPOINT, "pointopoint" },
4275 #endif
4276 #ifdef IFF_RUNNING
4277 { IFF_RUNNING, "running" },
4278 #endif
4279 #ifdef IFF_NOARP
4280 { IFF_NOARP, "noarp" },
4281 #endif
4282 #ifdef IFF_PROMISC
4283 { IFF_PROMISC, "promisc" },
4284 #endif
4285 #ifdef IFF_NOTRAILERS
4286 #ifdef NS_IMPL_COCOA
4287 /* Really means smart, notrailers is obsolete. */
4288 { IFF_NOTRAILERS, "smart" },
4289 #else
4290 { IFF_NOTRAILERS, "notrailers" },
4291 #endif
4292 #endif
4293 #ifdef IFF_ALLMULTI
4294 { IFF_ALLMULTI, "allmulti" },
4295 #endif
4296 #ifdef IFF_MASTER
4297 { IFF_MASTER, "master" },
4298 #endif
4299 #ifdef IFF_SLAVE
4300 { IFF_SLAVE, "slave" },
4301 #endif
4302 #ifdef IFF_MULTICAST
4303 { IFF_MULTICAST, "multicast" },
4304 #endif
4305 #ifdef IFF_PORTSEL
4306 { IFF_PORTSEL, "portsel" },
4307 #endif
4308 #ifdef IFF_AUTOMEDIA
4309 { IFF_AUTOMEDIA, "automedia" },
4310 #endif
4311 #ifdef IFF_DYNAMIC
4312 { IFF_DYNAMIC, "dynamic" },
4313 #endif
4314 #ifdef IFF_OACTIVE
4315 { IFF_OACTIVE, "oactive" }, /* OpenBSD: transmission in progress. */
4316 #endif
4317 #ifdef IFF_SIMPLEX
4318 { IFF_SIMPLEX, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4319 #endif
4320 #ifdef IFF_LINK0
4321 { IFF_LINK0, "link0" }, /* OpenBSD: per link layer defined bit. */
4322 #endif
4323 #ifdef IFF_LINK1
4324 { IFF_LINK1, "link1" }, /* OpenBSD: per link layer defined bit. */
4325 #endif
4326 #ifdef IFF_LINK2
4327 { IFF_LINK2, "link2" }, /* OpenBSD: per link layer defined bit. */
4328 #endif
4329 { 0, 0 }
4332 static Lisp_Object
4333 network_interface_info (Lisp_Object ifname)
4335 struct ifreq rq;
4336 Lisp_Object res = Qnil;
4337 Lisp_Object elt;
4338 int s;
4339 bool any = 0;
4340 ptrdiff_t count;
4341 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4342 && defined HAVE_GETIFADDRS && defined LLADDR)
4343 struct ifaddrs *ifap;
4344 #endif
4346 CHECK_STRING (ifname);
4348 if (sizeof rq.ifr_name <= SBYTES (ifname))
4349 error ("interface name too long");
4350 lispstpcpy (rq.ifr_name, ifname);
4352 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4353 if (s < 0)
4354 return Qnil;
4355 count = SPECPDL_INDEX ();
4356 record_unwind_protect_int (close_file_unwind, s);
4358 elt = Qnil;
4359 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4360 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4362 int flags = rq.ifr_flags;
4363 const struct ifflag_def *fp;
4364 int fnum;
4366 /* If flags is smaller than int (i.e. short) it may have the high bit set
4367 due to IFF_MULTICAST. In that case, sign extending it into
4368 an int is wrong. */
4369 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4370 flags = (unsigned short) rq.ifr_flags;
4372 any = 1;
4373 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4375 if (flags & fp->flag_bit)
4377 elt = Fcons (intern (fp->flag_sym), elt);
4378 flags -= fp->flag_bit;
4381 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4383 if (flags & 1)
4385 elt = Fcons (make_number (fnum), elt);
4389 #endif
4390 res = Fcons (elt, res);
4392 elt = Qnil;
4393 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4394 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4396 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4397 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4398 int n;
4400 any = 1;
4401 for (n = 0; n < 6; n++)
4402 p->contents[n] = make_number (((unsigned char *)
4403 &rq.ifr_hwaddr.sa_data[0])
4404 [n]);
4405 elt = Fcons (make_number (rq.ifr_hwaddr.sa_family), hwaddr);
4407 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4408 if (getifaddrs (&ifap) != -1)
4410 Lisp_Object hwaddr = Fmake_vector (make_number (6), Qnil);
4411 register struct Lisp_Vector *p = XVECTOR (hwaddr);
4412 struct ifaddrs *it;
4414 for (it = ifap; it != NULL; it = it->ifa_next)
4416 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4417 unsigned char linkaddr[6];
4418 int n;
4420 if (it->ifa_addr->sa_family != AF_LINK
4421 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4422 || sdl->sdl_alen != 6)
4423 continue;
4425 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4426 for (n = 0; n < 6; n++)
4427 p->contents[n] = make_number (linkaddr[n]);
4429 elt = Fcons (make_number (it->ifa_addr->sa_family), hwaddr);
4430 break;
4433 #ifdef HAVE_FREEIFADDRS
4434 freeifaddrs (ifap);
4435 #endif
4437 #endif /* HAVE_GETIFADDRS && LLADDR */
4439 res = Fcons (elt, res);
4441 elt = Qnil;
4442 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4443 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4445 any = 1;
4446 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4447 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4448 #else
4449 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4450 #endif
4452 #endif
4453 res = Fcons (elt, res);
4455 elt = Qnil;
4456 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4457 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4459 any = 1;
4460 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof (rq.ifr_broadaddr));
4462 #endif
4463 res = Fcons (elt, res);
4465 elt = Qnil;
4466 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4467 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4469 any = 1;
4470 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4472 #endif
4473 res = Fcons (elt, res);
4475 return unbind_to (count, any ? res : Qnil);
4477 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4478 #endif /* defined (HAVE_NET_IF_H) */
4480 DEFUN ("network-interface-list", Fnetwork_interface_list,
4481 Snetwork_interface_list, 0, 0, 0,
4482 doc: /* Return an alist of all network interfaces and their network address.
4483 Each element is a cons, the car of which is a string containing the
4484 interface name, and the cdr is the network address in internal
4485 format; see the description of ADDRESS in `make-network-process'.
4487 If the information is not available, return nil. */)
4488 (void)
4490 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4491 return network_interface_list ();
4492 #else
4493 return Qnil;
4494 #endif
4497 DEFUN ("network-interface-info", Fnetwork_interface_info,
4498 Snetwork_interface_info, 1, 1, 0,
4499 doc: /* Return information about network interface named IFNAME.
4500 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4501 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4502 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4503 FLAGS is the current flags of the interface.
4505 Data that is unavailable is returned as nil. */)
4506 (Lisp_Object ifname)
4508 #if ((defined HAVE_NET_IF_H \
4509 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4510 || defined SIOCGIFFLAGS)) \
4511 || defined WINDOWSNT)
4512 return network_interface_info (ifname);
4513 #else
4514 return Qnil;
4515 #endif
4518 /* Turn off input and output for process PROC. */
4520 static void
4521 deactivate_process (Lisp_Object proc)
4523 int inchannel;
4524 struct Lisp_Process *p = XPROCESS (proc);
4525 int i;
4527 #ifdef HAVE_GNUTLS
4528 /* Delete GnuTLS structures in PROC, if any. */
4529 emacs_gnutls_deinit (proc);
4530 #endif /* HAVE_GNUTLS */
4532 if (p->read_output_delay > 0)
4534 if (--process_output_delay_count < 0)
4535 process_output_delay_count = 0;
4536 p->read_output_delay = 0;
4537 p->read_output_skip = 0;
4540 /* Beware SIGCHLD hereabouts. */
4542 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4543 close_process_fd (&p->open_fd[i]);
4545 inchannel = p->infd;
4546 if (inchannel >= 0)
4548 p->infd = -1;
4549 p->outfd = -1;
4550 #ifdef DATAGRAM_SOCKETS
4551 if (DATAGRAM_CHAN_P (inchannel))
4553 xfree (datagram_address[inchannel].sa);
4554 datagram_address[inchannel].sa = 0;
4555 datagram_address[inchannel].len = 0;
4557 #endif
4558 chan_process[inchannel] = Qnil;
4559 delete_read_fd (inchannel);
4560 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4561 delete_write_fd (inchannel);
4562 if (inchannel == max_desc)
4563 recompute_max_desc ();
4568 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4569 0, 4, 0,
4570 doc: /* Allow any pending output from subprocesses to be read by Emacs.
4571 It is given to their filter functions.
4572 Optional argument PROCESS means do not return until output has been
4573 received from PROCESS.
4575 Optional second argument SECONDS and third argument MILLISEC
4576 specify a timeout; return after that much time even if there is
4577 no subprocess output. If SECONDS is a floating point number,
4578 it specifies a fractional number of seconds to wait.
4579 The MILLISEC argument is obsolete and should be avoided.
4581 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4582 from PROCESS only, suspending reading output from other processes.
4583 If JUST-THIS-ONE is an integer, don't run any timers either.
4584 Return non-nil if we received any output from PROCESS (or, if PROCESS
4585 is nil, from any process) before the timeout expired. */)
4586 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4587 Lisp_Object just_this_one)
4589 intmax_t secs;
4590 int nsecs;
4592 if (! NILP (process))
4594 CHECK_PROCESS (process);
4595 struct Lisp_Process *proc = XPROCESS (process);
4597 /* Can't wait for a process that is dedicated to a different
4598 thread. */
4599 if (!EQ (proc->thread, Qnil) && !EQ (proc->thread, Fcurrent_thread ()))
4601 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4603 if (STRINGP (proc_thread_name))
4604 error ("Attempt to accept output from process %s locked to thread %s",
4605 SDATA (proc->name), SDATA (proc_thread_name));
4606 else
4607 error ("Attempt to accept output from process %s locked to thread %p",
4608 SDATA (proc->name), XTHREAD (proc->thread));
4611 else
4612 just_this_one = Qnil;
4614 if (!NILP (millisec))
4615 { /* Obsolete calling convention using integers rather than floats. */
4616 CHECK_NUMBER (millisec);
4617 if (NILP (seconds))
4618 seconds = make_float (XINT (millisec) / 1000.0);
4619 else
4621 CHECK_NUMBER (seconds);
4622 seconds = make_float (XINT (millisec) / 1000.0 + XINT (seconds));
4626 secs = 0;
4627 nsecs = -1;
4629 if (!NILP (seconds))
4631 if (INTEGERP (seconds))
4633 if (XINT (seconds) > 0)
4635 secs = XINT (seconds);
4636 nsecs = 0;
4639 else if (FLOATP (seconds))
4641 if (XFLOAT_DATA (seconds) > 0)
4643 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4644 secs = min (t.tv_sec, WAIT_READING_MAX);
4645 nsecs = t.tv_nsec;
4648 else
4649 wrong_type_argument (Qnumberp, seconds);
4651 else if (! NILP (process))
4652 nsecs = 0;
4654 return
4655 ((wait_reading_process_output (secs, nsecs, 0, 0,
4656 Qnil,
4657 !NILP (process) ? XPROCESS (process) : NULL,
4658 (NILP (just_this_one) ? 0
4659 : !INTEGERP (just_this_one) ? 1 : -1))
4660 <= 0)
4661 ? Qnil : Qt);
4664 /* Accept a connection for server process SERVER on CHANNEL. */
4666 static EMACS_INT connect_counter = 0;
4668 static void
4669 server_accept_connection (Lisp_Object server, int channel)
4671 Lisp_Object buffer;
4672 Lisp_Object contact, host, service;
4673 struct Lisp_Process *ps = XPROCESS (server);
4674 struct Lisp_Process *p;
4675 int s;
4676 union u_sockaddr {
4677 struct sockaddr sa;
4678 struct sockaddr_in in;
4679 #ifdef AF_INET6
4680 struct sockaddr_in6 in6;
4681 #endif
4682 #ifdef HAVE_LOCAL_SOCKETS
4683 struct sockaddr_un un;
4684 #endif
4685 } saddr;
4686 socklen_t len = sizeof saddr;
4687 ptrdiff_t count;
4689 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4691 if (s < 0)
4693 int code = errno;
4694 if (!would_block (code) && !NILP (ps->log))
4695 call3 (ps->log, server, Qnil,
4696 concat3 (build_string ("accept failed with code"),
4697 Fnumber_to_string (make_number (code)),
4698 build_string ("\n")));
4699 return;
4702 count = SPECPDL_INDEX ();
4703 record_unwind_protect_int (close_file_unwind, s);
4705 connect_counter++;
4707 /* Setup a new process to handle the connection. */
4709 /* Generate a unique identification of the caller, and build contact
4710 information for this process. */
4711 host = Qt;
4712 service = Qnil;
4713 Lisp_Object args[11];
4714 int nargs = 0;
4715 AUTO_STRING (procname_format_in, "%s <%d.%d.%d.%d:%d>");
4716 AUTO_STRING (procname_format_in6, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4717 AUTO_STRING (procname_format_default, "%s <%d>");
4718 switch (saddr.sa.sa_family)
4720 case AF_INET:
4722 args[nargs++] = procname_format_in;
4723 nargs++;
4724 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4725 service = make_number (ntohs (saddr.in.sin_port));
4726 for (int i = 0; i < 4; i++)
4727 args[nargs++] = make_number (ip[i]);
4728 args[nargs++] = service;
4730 break;
4732 #ifdef AF_INET6
4733 case AF_INET6:
4735 args[nargs++] = procname_format_in6;
4736 nargs++;
4737 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4738 service = make_number (ntohs (saddr.in.sin_port));
4739 for (int i = 0; i < 8; i++)
4740 args[nargs++] = make_number (ip6[i]);
4741 args[nargs++] = service;
4743 break;
4744 #endif
4746 default:
4747 args[nargs++] = procname_format_default;
4748 nargs++;
4749 args[nargs++] = make_number (connect_counter);
4750 break;
4753 /* Create a new buffer name for this process if it doesn't have a
4754 filter. The new buffer name is based on the buffer name or
4755 process name of the server process concatenated with the caller
4756 identification. */
4758 if (!(EQ (ps->filter, Qinternal_default_process_filter)
4759 || EQ (ps->filter, Qt)))
4760 buffer = Qnil;
4761 else
4763 buffer = ps->buffer;
4764 if (!NILP (buffer))
4765 buffer = Fbuffer_name (buffer);
4766 else
4767 buffer = ps->name;
4768 if (!NILP (buffer))
4770 args[1] = buffer;
4771 buffer = Fget_buffer_create (Fformat (nargs, args));
4775 /* Generate a unique name for the new server process. Combine the
4776 server process name with the caller identification. */
4778 args[1] = ps->name;
4779 Lisp_Object name = Fformat (nargs, args);
4780 Lisp_Object proc = make_process (name);
4782 chan_process[s] = proc;
4784 fcntl (s, F_SETFL, O_NONBLOCK);
4786 p = XPROCESS (proc);
4788 /* Build new contact information for this setup. */
4789 contact = Fcopy_sequence (ps->childp);
4790 contact = Fplist_put (contact, QCserver, Qnil);
4791 contact = Fplist_put (contact, QChost, host);
4792 if (!NILP (service))
4793 contact = Fplist_put (contact, QCservice, service);
4794 contact = Fplist_put (contact, QCremote,
4795 conv_sockaddr_to_lisp (&saddr.sa, len));
4796 #ifdef HAVE_GETSOCKNAME
4797 len = sizeof saddr;
4798 if (getsockname (s, &saddr.sa, &len) == 0)
4799 contact = Fplist_put (contact, QClocal,
4800 conv_sockaddr_to_lisp (&saddr.sa, len));
4801 #endif
4803 pset_childp (p, contact);
4804 pset_plist (p, Fcopy_sequence (ps->plist));
4805 pset_type (p, Qnetwork);
4807 pset_buffer (p, buffer);
4808 pset_sentinel (p, ps->sentinel);
4809 pset_filter (p, ps->filter);
4810 eassert (NILP (p->command));
4811 eassert (p->pid == 0);
4813 /* Discard the unwind protect for closing S. */
4814 specpdl_ptr = specpdl + count;
4816 p->open_fd[SUBPROCESS_STDIN] = s;
4817 p->infd = s;
4818 p->outfd = s;
4819 pset_status (p, Qrun);
4821 /* Client processes for accepted connections are not stopped initially. */
4822 if (!EQ (p->filter, Qt))
4823 add_process_read_fd (s);
4824 if (s > max_desc)
4825 max_desc = s;
4827 /* Setup coding system for new process based on server process.
4828 This seems to be the proper thing to do, as the coding system
4829 of the new process should reflect the settings at the time the
4830 server socket was opened; not the current settings. */
4832 pset_decode_coding_system (p, ps->decode_coding_system);
4833 pset_encode_coding_system (p, ps->encode_coding_system);
4834 setup_process_coding_systems (proc);
4836 pset_decoding_buf (p, empty_unibyte_string);
4837 eassert (p->decoding_carryover == 0);
4838 pset_encoding_buf (p, empty_unibyte_string);
4840 p->inherit_coding_system_flag
4841 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
4843 AUTO_STRING (dash, "-");
4844 AUTO_STRING (nl, "\n");
4845 Lisp_Object host_string = STRINGP (host) ? host : dash;
4847 if (!NILP (ps->log))
4849 AUTO_STRING (accept_from, "accept from ");
4850 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
4853 AUTO_STRING (open_from, "open from ");
4854 exec_sentinel (proc, concat3 (open_from, host_string, nl));
4857 #ifdef HAVE_GETADDRINFO_A
4858 static Lisp_Object
4859 check_for_dns (Lisp_Object proc)
4861 struct Lisp_Process *p = XPROCESS (proc);
4862 Lisp_Object addrinfos = Qnil;
4864 /* Sanity check. */
4865 if (! p->dns_request)
4866 return Qnil;
4868 int ret = gai_error (p->dns_request);
4869 if (ret == EAI_INPROGRESS)
4870 return Qt;
4872 /* We got a response. */
4873 if (ret == 0)
4875 struct addrinfo *res;
4877 for (res = p->dns_request->ar_result; res; res = res->ai_next)
4878 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
4880 addrinfos = Fnreverse (addrinfos);
4882 /* The DNS lookup failed. */
4883 else if (connecting_status (p->status))
4885 deactivate_process (proc);
4886 pset_status (p, (list2
4887 (Qfailed,
4888 concat3 (build_string ("Name lookup of "),
4889 build_string (p->dns_request->ar_name),
4890 build_string (" failed")))));
4893 free_dns_request (proc);
4895 /* This process should not already be connected (or killed). */
4896 if (! connecting_status (p->status))
4897 return Qnil;
4899 return addrinfos;
4902 #endif /* HAVE_GETADDRINFO_A */
4904 static void
4905 wait_for_socket_fds (Lisp_Object process, char const *name)
4907 while (XPROCESS (process)->infd < 0
4908 && connecting_status (XPROCESS (process)->status))
4910 add_to_log ("Waiting for socket from %s...", build_string (name));
4911 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4915 static void
4916 wait_while_connecting (Lisp_Object process)
4918 while (connecting_status (XPROCESS (process)->status))
4920 add_to_log ("Waiting for connection...");
4921 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4925 static void
4926 wait_for_tls_negotiation (Lisp_Object process)
4928 #ifdef HAVE_GNUTLS
4929 while (XPROCESS (process)->gnutls_p
4930 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
4932 add_to_log ("Waiting for TLS...");
4933 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
4935 #endif
4938 static void
4939 wait_reading_process_output_unwind (int data)
4941 clear_waiting_thread_info ();
4942 waiting_for_user_input_p = data;
4945 /* This is here so breakpoints can be put on it. */
4946 static void
4947 wait_reading_process_output_1 (void)
4951 /* Read and dispose of subprocess output while waiting for timeout to
4952 elapse and/or keyboard input to be available.
4954 TIME_LIMIT is:
4955 timeout in seconds
4956 If negative, gobble data immediately available but don't wait for any.
4958 NSECS is:
4959 an additional duration to wait, measured in nanoseconds
4960 If TIME_LIMIT is zero, then:
4961 If NSECS == 0, there is no limit.
4962 If NSECS > 0, the timeout consists of NSECS only.
4963 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4965 READ_KBD is:
4966 0 to ignore keyboard input, or
4967 1 to return when input is available, or
4968 -1 meaning caller will actually read the input, so don't throw to
4969 the quit handler
4971 DO_DISPLAY means redisplay should be done to show subprocess
4972 output that arrives.
4974 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4975 (and gobble terminal input into the buffer if any arrives).
4977 If WAIT_PROC is specified, wait until something arrives from that
4978 process.
4980 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4981 (suspending output from other processes). A negative value
4982 means don't run any timers either.
4984 Return positive if we received input from WAIT_PROC (or from any
4985 process if WAIT_PROC is null), zero if we attempted to receive
4986 input but got none, and negative if we didn't even try. */
4989 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
4990 bool do_display,
4991 Lisp_Object wait_for_cell,
4992 struct Lisp_Process *wait_proc, int just_wait_proc)
4994 int channel, nfds;
4995 fd_set Available;
4996 fd_set Writeok;
4997 bool check_write;
4998 int check_delay;
4999 bool no_avail;
5000 int xerrno;
5001 Lisp_Object proc;
5002 struct timespec timeout, end_time, timer_delay;
5003 struct timespec got_output_end_time = invalid_timespec ();
5004 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
5005 int got_some_output = -1;
5006 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5007 bool retry_for_async;
5008 #endif
5009 ptrdiff_t count = SPECPDL_INDEX ();
5011 /* Close to the current time if known, an invalid timespec otherwise. */
5012 struct timespec now = invalid_timespec ();
5014 eassert (wait_proc == NULL
5015 || EQ (wait_proc->thread, Qnil)
5016 || XTHREAD (wait_proc->thread) == current_thread);
5018 FD_ZERO (&Available);
5019 FD_ZERO (&Writeok);
5021 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5022 && !(CONSP (wait_proc->status)
5023 && EQ (XCAR (wait_proc->status), Qexit)))
5024 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5026 record_unwind_protect_int (wait_reading_process_output_unwind,
5027 waiting_for_user_input_p);
5028 waiting_for_user_input_p = read_kbd;
5030 if (TYPE_MAXIMUM (time_t) < time_limit)
5031 time_limit = TYPE_MAXIMUM (time_t);
5033 if (time_limit < 0 || nsecs < 0)
5034 wait = MINIMUM;
5035 else if (time_limit > 0 || nsecs > 0)
5037 wait = TIMEOUT;
5038 now = current_timespec ();
5039 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5041 else
5042 wait = INFINITY;
5044 while (1)
5046 bool process_skipped = false;
5048 /* If calling from keyboard input, do not quit
5049 since we want to return C-g as an input character.
5050 Otherwise, do pending quit if requested. */
5051 if (read_kbd >= 0)
5052 maybe_quit ();
5053 else if (pending_signals)
5054 process_pending_signals ();
5056 /* Exit now if the cell we're waiting for became non-nil. */
5057 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5058 break;
5060 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5062 Lisp_Object process_list_head, aproc;
5063 struct Lisp_Process *p;
5065 retry_for_async = false;
5066 FOR_EACH_PROCESS(process_list_head, aproc)
5068 p = XPROCESS (aproc);
5070 if (! wait_proc || p == wait_proc)
5072 #ifdef HAVE_GETADDRINFO_A
5073 /* Check for pending DNS requests. */
5074 if (p->dns_request)
5076 Lisp_Object addrinfos = check_for_dns (aproc);
5077 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5078 connect_network_socket (aproc, addrinfos, Qnil);
5079 else
5080 retry_for_async = true;
5082 #endif
5083 #ifdef HAVE_GNUTLS
5084 /* Continue TLS negotiation. */
5085 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5086 && p->is_non_blocking_client)
5088 gnutls_try_handshake (p);
5089 p->gnutls_handshakes_tried++;
5091 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5093 gnutls_verify_boot (aproc, Qnil);
5094 finish_after_tls_connection (aproc);
5096 else
5098 retry_for_async = true;
5099 if (p->gnutls_handshakes_tried
5100 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5102 deactivate_process (aproc);
5103 pset_status (p, list2 (Qfailed,
5104 build_string ("TLS negotiation failed")));
5108 #endif
5112 #endif /* GETADDRINFO_A or GNUTLS */
5114 /* Compute time from now till when time limit is up. */
5115 /* Exit if already run out. */
5116 if (wait == TIMEOUT)
5118 if (!timespec_valid_p (now))
5119 now = current_timespec ();
5120 if (timespec_cmp (end_time, now) <= 0)
5121 break;
5122 timeout = timespec_sub (end_time, now);
5124 else
5125 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5127 /* Normally we run timers here.
5128 But not if wait_for_cell; in those cases,
5129 the wait is supposed to be short,
5130 and those callers cannot handle running arbitrary Lisp code here. */
5131 if (NILP (wait_for_cell)
5132 && just_wait_proc >= 0)
5136 unsigned old_timers_run = timers_run;
5137 struct buffer *old_buffer = current_buffer;
5138 Lisp_Object old_window = selected_window;
5140 timer_delay = timer_check ();
5142 /* If a timer has run, this might have changed buffers
5143 an alike. Make read_key_sequence aware of that. */
5144 if (timers_run != old_timers_run
5145 && (old_buffer != current_buffer
5146 || !EQ (old_window, selected_window))
5147 && waiting_for_user_input_p == -1)
5148 record_asynch_buffer_change ();
5150 if (timers_run != old_timers_run && do_display)
5151 /* We must retry, since a timer may have requeued itself
5152 and that could alter the time_delay. */
5153 redisplay_preserve_echo_area (9);
5154 else
5155 break;
5157 while (!detect_input_pending ());
5159 /* If there is unread keyboard input, also return. */
5160 if (read_kbd != 0
5161 && requeued_events_pending_p ())
5162 break;
5164 /* This is so a breakpoint can be put here. */
5165 if (!timespec_valid_p (timer_delay))
5166 wait_reading_process_output_1 ();
5169 /* Cause C-g and alarm signals to take immediate action,
5170 and cause input available signals to zero out timeout.
5172 It is important that we do this before checking for process
5173 activity. If we get a SIGCHLD after the explicit checks for
5174 process activity, timeout is the only way we will know. */
5175 if (read_kbd < 0)
5176 set_waiting_for_input (&timeout);
5178 /* If status of something has changed, and no input is
5179 available, notify the user of the change right away. After
5180 this explicit check, we'll let the SIGCHLD handler zap
5181 timeout to get our attention. */
5182 if (update_tick != process_tick)
5184 fd_set Atemp;
5185 fd_set Ctemp;
5187 if (kbd_on_hold_p ())
5188 FD_ZERO (&Atemp);
5189 else
5190 compute_input_wait_mask (&Atemp);
5191 compute_write_mask (&Ctemp);
5193 timeout = make_timespec (0, 0);
5194 if ((thread_select (pselect, max_desc + 1,
5195 &Atemp,
5196 (num_pending_connects > 0 ? &Ctemp : NULL),
5197 NULL, &timeout, NULL)
5198 <= 0))
5200 /* It's okay for us to do this and then continue with
5201 the loop, since timeout has already been zeroed out. */
5202 clear_waiting_for_input ();
5203 got_some_output = status_notify (NULL, wait_proc);
5204 if (do_display) redisplay_preserve_echo_area (13);
5208 /* Don't wait for output from a non-running process. Just
5209 read whatever data has already been received. */
5210 if (wait_proc && wait_proc->raw_status_new)
5211 update_status (wait_proc);
5212 if (wait_proc
5213 && ! EQ (wait_proc->status, Qrun)
5214 && ! connecting_status (wait_proc->status))
5216 bool read_some_bytes = false;
5218 clear_waiting_for_input ();
5220 /* If data can be read from the process, do so until exhausted. */
5221 if (wait_proc->infd >= 0)
5223 XSETPROCESS (proc, wait_proc);
5225 while (true)
5227 int nread = read_process_output (proc, wait_proc->infd);
5228 if (nread < 0)
5230 if (errno == EIO || would_block (errno))
5231 break;
5233 else
5235 if (got_some_output < nread)
5236 got_some_output = nread;
5237 if (nread == 0)
5238 break;
5239 read_some_bytes = true;
5244 if (read_some_bytes && do_display)
5245 redisplay_preserve_echo_area (10);
5247 break;
5250 /* Wait till there is something to do. */
5252 if (wait_proc && just_wait_proc)
5254 if (wait_proc->infd < 0) /* Terminated. */
5255 break;
5256 FD_SET (wait_proc->infd, &Available);
5257 check_delay = 0;
5258 check_write = 0;
5260 else if (!NILP (wait_for_cell))
5262 compute_non_process_wait_mask (&Available);
5263 check_delay = 0;
5264 check_write = 0;
5266 else
5268 if (! read_kbd)
5269 compute_non_keyboard_wait_mask (&Available);
5270 else
5271 compute_input_wait_mask (&Available);
5272 compute_write_mask (&Writeok);
5273 check_delay = wait_proc ? 0 : process_output_delay_count;
5274 check_write = true;
5277 /* If frame size has changed or the window is newly mapped,
5278 redisplay now, before we start to wait. There is a race
5279 condition here; if a SIGIO arrives between now and the select
5280 and indicates that a frame is trashed, the select may block
5281 displaying a trashed screen. */
5282 if (frame_garbaged && do_display)
5284 clear_waiting_for_input ();
5285 redisplay_preserve_echo_area (11);
5286 if (read_kbd < 0)
5287 set_waiting_for_input (&timeout);
5290 /* Skip the `select' call if input is available and we're
5291 waiting for keyboard input or a cell change (which can be
5292 triggered by processing X events). In the latter case, set
5293 nfds to 1 to avoid breaking the loop. */
5294 no_avail = 0;
5295 if ((read_kbd || !NILP (wait_for_cell))
5296 && detect_input_pending ())
5298 nfds = read_kbd ? 0 : 1;
5299 no_avail = 1;
5300 FD_ZERO (&Available);
5302 else
5304 /* Set the timeout for adaptive read buffering if any
5305 process has non-zero read_output_skip and non-zero
5306 read_output_delay, and we are not reading output for a
5307 specific process. It is not executed if
5308 Vprocess_adaptive_read_buffering is nil. */
5309 if (process_output_skip && check_delay > 0)
5311 int adaptive_nsecs = timeout.tv_nsec;
5312 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5313 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5314 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5316 proc = chan_process[channel];
5317 if (NILP (proc))
5318 continue;
5319 /* Find minimum non-zero read_output_delay among the
5320 processes with non-zero read_output_skip. */
5321 if (XPROCESS (proc)->read_output_delay > 0)
5323 check_delay--;
5324 if (!XPROCESS (proc)->read_output_skip)
5325 continue;
5326 FD_CLR (channel, &Available);
5327 process_skipped = true;
5328 XPROCESS (proc)->read_output_skip = 0;
5329 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5330 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5333 timeout = make_timespec (0, adaptive_nsecs);
5334 process_output_skip = 0;
5337 /* If we've got some output and haven't limited our timeout
5338 with adaptive read buffering, limit it. */
5339 if (got_some_output > 0 && !process_skipped
5340 && (timeout.tv_sec
5341 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5342 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5345 if (NILP (wait_for_cell) && just_wait_proc >= 0
5346 && timespec_valid_p (timer_delay)
5347 && timespec_cmp (timer_delay, timeout) < 0)
5349 if (!timespec_valid_p (now))
5350 now = current_timespec ();
5351 struct timespec timeout_abs = timespec_add (now, timeout);
5352 if (!timespec_valid_p (got_output_end_time)
5353 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5354 got_output_end_time = timeout_abs;
5355 timeout = timer_delay;
5357 else
5358 got_output_end_time = invalid_timespec ();
5360 /* NOW can become inaccurate if time can pass during pselect. */
5361 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5362 now = invalid_timespec ();
5364 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5365 if (retry_for_async
5366 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5368 timeout.tv_sec = 0;
5369 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5371 #endif
5373 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5374 #if defined HAVE_GLIB && !defined HAVE_NS
5375 nfds = xg_select (max_desc + 1,
5376 &Available, (check_write ? &Writeok : 0),
5377 NULL, &timeout, NULL);
5378 #elif defined HAVE_NS
5379 /* And NS builds call thread_select in ns_select. */
5380 nfds = ns_select (max_desc + 1,
5381 &Available, (check_write ? &Writeok : 0),
5382 NULL, &timeout, NULL);
5383 #else /* !HAVE_GLIB */
5384 nfds = thread_select (pselect, max_desc + 1,
5385 &Available,
5386 (check_write ? &Writeok : 0),
5387 NULL, &timeout, NULL);
5388 #endif /* !HAVE_GLIB */
5390 #ifdef HAVE_GNUTLS
5391 /* GnuTLS buffers data internally. In lowat mode it leaves
5392 some data in the TCP buffers so that select works, but
5393 with custom pull/push functions we need to check if some
5394 data is available in the buffers manually. */
5395 if (nfds == 0)
5397 fd_set tls_available;
5398 int set = 0;
5400 FD_ZERO (&tls_available);
5401 if (! wait_proc)
5403 /* We're not waiting on a specific process, so loop
5404 through all the channels and check for data.
5405 This is a workaround needed for some versions of
5406 the gnutls library -- 2.12.14 has been confirmed
5407 to need it. See
5408 http://comments.gmane.org/gmane.emacs.devel/145074 */
5409 for (channel = 0; channel < FD_SETSIZE; ++channel)
5410 if (! NILP (chan_process[channel]))
5412 struct Lisp_Process *p =
5413 XPROCESS (chan_process[channel]);
5414 if (p && p->gnutls_p && p->gnutls_state
5415 && ((emacs_gnutls_record_check_pending
5416 (p->gnutls_state))
5417 > 0))
5419 nfds++;
5420 eassert (p->infd == channel);
5421 FD_SET (p->infd, &tls_available);
5422 set++;
5426 else
5428 /* Check this specific channel. */
5429 if (wait_proc->gnutls_p /* Check for valid process. */
5430 && wait_proc->gnutls_state
5431 /* Do we have pending data? */
5432 && ((emacs_gnutls_record_check_pending
5433 (wait_proc->gnutls_state))
5434 > 0))
5436 nfds = 1;
5437 eassert (0 <= wait_proc->infd);
5438 /* Set to Available. */
5439 FD_SET (wait_proc->infd, &tls_available);
5440 set++;
5443 if (set)
5444 Available = tls_available;
5446 #endif
5449 xerrno = errno;
5451 /* Make C-g and alarm signals set flags again. */
5452 clear_waiting_for_input ();
5454 /* If we woke up due to SIGWINCH, actually change size now. */
5455 do_pending_window_change (0);
5457 if (nfds == 0)
5459 /* Exit the main loop if we've passed the requested timeout,
5460 or aren't skipping processes and got some output and
5461 haven't lowered our timeout due to timers or SIGIO and
5462 have waited a long amount of time due to repeated
5463 timers. */
5464 struct timespec huge_timespec
5465 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION);
5466 struct timespec cmp_time = huge_timespec;
5467 if (wait < TIMEOUT)
5468 break;
5469 if (wait == TIMEOUT)
5470 cmp_time = end_time;
5471 if (!process_skipped && got_some_output > 0
5472 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5474 if (!timespec_valid_p (got_output_end_time))
5475 break;
5476 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5477 cmp_time = got_output_end_time;
5479 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5481 now = current_timespec ();
5482 if (timespec_cmp (cmp_time, now) <= 0)
5483 break;
5487 if (nfds < 0)
5489 if (xerrno == EINTR)
5490 no_avail = 1;
5491 else if (xerrno == EBADF)
5492 emacs_abort ();
5493 else
5494 report_file_errno ("Failed select", Qnil, xerrno);
5497 /* Check for keyboard input. */
5498 /* If there is any, return immediately
5499 to give it higher priority than subprocesses. */
5501 if (read_kbd != 0)
5503 unsigned old_timers_run = timers_run;
5504 struct buffer *old_buffer = current_buffer;
5505 Lisp_Object old_window = selected_window;
5506 bool leave = false;
5508 if (detect_input_pending_run_timers (do_display))
5510 swallow_events (do_display);
5511 if (detect_input_pending_run_timers (do_display))
5512 leave = true;
5515 /* If a timer has run, this might have changed buffers
5516 an alike. Make read_key_sequence aware of that. */
5517 if (timers_run != old_timers_run
5518 && waiting_for_user_input_p == -1
5519 && (old_buffer != current_buffer
5520 || !EQ (old_window, selected_window)))
5521 record_asynch_buffer_change ();
5523 if (leave)
5524 break;
5527 /* If there is unread keyboard input, also return. */
5528 if (read_kbd != 0
5529 && requeued_events_pending_p ())
5530 break;
5532 /* If we are not checking for keyboard input now,
5533 do process events (but don't run any timers).
5534 This is so that X events will be processed.
5535 Otherwise they may have to wait until polling takes place.
5536 That would causes delays in pasting selections, for example.
5538 (We used to do this only if wait_for_cell.) */
5539 if (read_kbd == 0 && detect_input_pending ())
5541 swallow_events (do_display);
5542 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5543 if (detect_input_pending ())
5544 break;
5545 #endif
5548 /* Exit now if the cell we're waiting for became non-nil. */
5549 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5550 break;
5552 #ifdef USABLE_SIGIO
5553 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5554 go read it. This can happen with X on BSD after logging out.
5555 In that case, there really is no input and no SIGIO,
5556 but select says there is input. */
5558 if (read_kbd && interrupt_input
5559 && keyboard_bit_set (&Available) && ! noninteractive)
5560 handle_input_available_signal (SIGIO);
5561 #endif
5563 /* If checking input just got us a size-change event from X,
5564 obey it now if we should. */
5565 if (read_kbd || ! NILP (wait_for_cell))
5566 do_pending_window_change (0);
5568 /* Check for data from a process. */
5569 if (no_avail || nfds == 0)
5570 continue;
5572 for (channel = 0; channel <= max_desc; ++channel)
5574 struct fd_callback_data *d = &fd_callback_info[channel];
5575 if (d->func
5576 && ((d->flags & FOR_READ
5577 && FD_ISSET (channel, &Available))
5578 || ((d->flags & FOR_WRITE)
5579 && FD_ISSET (channel, &Writeok))))
5580 d->func (channel, d->data);
5583 for (channel = 0; channel <= max_desc; channel++)
5585 if (FD_ISSET (channel, &Available)
5586 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5587 == PROCESS_FD))
5589 int nread;
5591 /* If waiting for this channel, arrange to return as
5592 soon as no more input to be processed. No more
5593 waiting. */
5594 proc = chan_process[channel];
5595 if (NILP (proc))
5596 continue;
5598 /* If this is a server stream socket, accept connection. */
5599 if (EQ (XPROCESS (proc)->status, Qlisten))
5601 server_accept_connection (proc, channel);
5602 continue;
5605 /* Read data from the process, starting with our
5606 buffered-ahead character if we have one. */
5608 nread = read_process_output (proc, channel);
5609 if ((!wait_proc || wait_proc == XPROCESS (proc))
5610 && got_some_output < nread)
5611 got_some_output = nread;
5612 if (nread > 0)
5614 /* Vacuum up any leftovers without waiting. */
5615 if (wait_proc == XPROCESS (proc))
5616 wait = MINIMUM;
5617 /* Since read_process_output can run a filter,
5618 which can call accept-process-output,
5619 don't try to read from any other processes
5620 before doing the select again. */
5621 FD_ZERO (&Available);
5623 if (do_display)
5624 redisplay_preserve_echo_area (12);
5626 else if (nread == -1 && would_block (errno))
5628 #ifdef WINDOWSNT
5629 /* FIXME: Is this special case still needed? */
5630 /* Note that we cannot distinguish between no input
5631 available now and a closed pipe.
5632 With luck, a closed pipe will be accompanied by
5633 subprocess termination and SIGCHLD. */
5634 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5635 && !PIPECONN_P (proc))
5637 #endif
5638 #ifdef HAVE_PTYS
5639 /* On some OSs with ptys, when the process on one end of
5640 a pty exits, the other end gets an error reading with
5641 errno = EIO instead of getting an EOF (0 bytes read).
5642 Therefore, if we get an error reading and errno =
5643 EIO, just continue, because the child process has
5644 exited and should clean itself up soon (e.g. when we
5645 get a SIGCHLD). */
5646 else if (nread == -1 && errno == EIO)
5648 struct Lisp_Process *p = XPROCESS (proc);
5650 /* Clear the descriptor now, so we only raise the
5651 signal once. */
5652 delete_read_fd (channel);
5654 if (p->pid == -2)
5656 /* If the EIO occurs on a pty, the SIGCHLD handler's
5657 waitpid call will not find the process object to
5658 delete. Do it here. */
5659 p->tick = ++process_tick;
5660 pset_status (p, Qfailed);
5663 #endif /* HAVE_PTYS */
5664 /* If we can detect process termination, don't consider the
5665 process gone just because its pipe is closed. */
5666 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5667 && !PIPECONN_P (proc))
5669 else if (nread == 0 && PIPECONN_P (proc))
5671 /* Preserve status of processes already terminated. */
5672 XPROCESS (proc)->tick = ++process_tick;
5673 deactivate_process (proc);
5674 if (EQ (XPROCESS (proc)->status, Qrun))
5675 pset_status (XPROCESS (proc),
5676 list2 (Qexit, make_number (0)));
5678 else
5680 /* Preserve status of processes already terminated. */
5681 XPROCESS (proc)->tick = ++process_tick;
5682 deactivate_process (proc);
5683 if (XPROCESS (proc)->raw_status_new)
5684 update_status (XPROCESS (proc));
5685 if (EQ (XPROCESS (proc)->status, Qrun))
5686 pset_status (XPROCESS (proc),
5687 list2 (Qexit, make_number (256)));
5690 if (FD_ISSET (channel, &Writeok)
5691 && (fd_callback_info[channel].flags
5692 & NON_BLOCKING_CONNECT_FD) != 0)
5694 struct Lisp_Process *p;
5696 delete_write_fd (channel);
5698 proc = chan_process[channel];
5699 if (NILP (proc))
5700 continue;
5702 p = XPROCESS (proc);
5704 #ifndef WINDOWSNT
5706 socklen_t xlen = sizeof (xerrno);
5707 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5708 xerrno = errno;
5710 #else
5711 /* On MS-Windows, getsockopt clears the error for the
5712 entire process, which may not be the right thing; see
5713 w32.c. Use getpeername instead. */
5715 struct sockaddr pname;
5716 socklen_t pnamelen = sizeof (pname);
5718 /* If connection failed, getpeername will fail. */
5719 xerrno = 0;
5720 if (getpeername (channel, &pname, &pnamelen) < 0)
5722 /* Obtain connect failure code through error slippage. */
5723 char dummy;
5724 xerrno = errno;
5725 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
5726 xerrno = errno;
5729 #endif
5730 if (xerrno)
5732 Lisp_Object addrinfos
5733 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
5734 if (!NILP (addrinfos))
5735 XSETCDR (p->status, XCDR (addrinfos));
5736 else
5738 p->tick = ++process_tick;
5739 pset_status (p, list2 (Qfailed, make_number (xerrno)));
5741 deactivate_process (proc);
5742 if (!NILP (addrinfos))
5743 connect_network_socket (proc, addrinfos, Qnil);
5745 else
5747 #ifdef HAVE_GNUTLS
5748 /* If we have an incompletely set up TLS connection,
5749 then defer the sentinel signaling until
5750 later. */
5751 if (NILP (p->gnutls_boot_parameters)
5752 && !p->gnutls_p)
5753 #endif
5755 pset_status (p, Qrun);
5756 /* Execute the sentinel here. If we had relied on
5757 status_notify to do it later, it will read input
5758 from the process before calling the sentinel. */
5759 exec_sentinel (proc, build_string ("open\n"));
5762 if (0 <= p->infd && !EQ (p->filter, Qt)
5763 && !EQ (p->command, Qt))
5764 add_process_read_fd (p->infd);
5767 } /* End for each file descriptor. */
5768 } /* End while exit conditions not met. */
5770 unbind_to (count, Qnil);
5772 /* If calling from keyboard input, do not quit
5773 since we want to return C-g as an input character.
5774 Otherwise, do pending quit if requested. */
5775 if (read_kbd >= 0)
5777 /* Prevent input_pending from remaining set if we quit. */
5778 clear_input_pending ();
5779 maybe_quit ();
5782 return got_some_output;
5785 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5787 static Lisp_Object
5788 read_process_output_call (Lisp_Object fun_and_args)
5790 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
5793 static Lisp_Object
5794 read_process_output_error_handler (Lisp_Object error_val)
5796 cmd_error_internal (error_val, "error in process filter: ");
5797 Vinhibit_quit = Qt;
5798 update_echo_area ();
5799 Fsleep_for (make_number (2), Qnil);
5800 return Qt;
5803 static void
5804 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5805 ssize_t nbytes,
5806 struct coding_system *coding);
5808 /* Read pending output from the process channel,
5809 starting with our buffered-ahead character if we have one.
5810 Yield number of decoded characters read.
5812 This function reads at most 4096 characters.
5813 If you want to read all available subprocess output,
5814 you must call it repeatedly until it returns zero.
5816 The characters read are decoded according to PROC's coding-system
5817 for decoding. */
5819 static int
5820 read_process_output (Lisp_Object proc, int channel)
5822 ssize_t nbytes;
5823 struct Lisp_Process *p = XPROCESS (proc);
5824 struct coding_system *coding = proc_decode_coding_system[channel];
5825 int carryover = p->decoding_carryover;
5826 enum { readmax = 4096 };
5827 ptrdiff_t count = SPECPDL_INDEX ();
5828 Lisp_Object odeactivate;
5829 char chars[sizeof coding->carryover + readmax];
5831 if (carryover)
5832 /* See the comment above. */
5833 memcpy (chars, SDATA (p->decoding_buf), carryover);
5835 #ifdef DATAGRAM_SOCKETS
5836 /* We have a working select, so proc_buffered_char is always -1. */
5837 if (DATAGRAM_CHAN_P (channel))
5839 socklen_t len = datagram_address[channel].len;
5840 nbytes = recvfrom (channel, chars + carryover, readmax,
5841 0, datagram_address[channel].sa, &len);
5843 else
5844 #endif
5846 bool buffered = proc_buffered_char[channel] >= 0;
5847 if (buffered)
5849 chars[carryover] = proc_buffered_char[channel];
5850 proc_buffered_char[channel] = -1;
5852 #ifdef HAVE_GNUTLS
5853 if (p->gnutls_p && p->gnutls_state)
5854 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
5855 readmax - buffered);
5856 else
5857 #endif
5858 nbytes = emacs_read (channel, chars + carryover + buffered,
5859 readmax - buffered);
5860 if (nbytes > 0 && p->adaptive_read_buffering)
5862 int delay = p->read_output_delay;
5863 if (nbytes < 256)
5865 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
5867 if (delay == 0)
5868 process_output_delay_count++;
5869 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
5872 else if (delay > 0 && nbytes == readmax - buffered)
5874 delay -= READ_OUTPUT_DELAY_INCREMENT;
5875 if (delay == 0)
5876 process_output_delay_count--;
5878 p->read_output_delay = delay;
5879 if (delay)
5881 p->read_output_skip = 1;
5882 process_output_skip = 1;
5885 nbytes += buffered;
5886 nbytes += buffered && nbytes <= 0;
5889 p->decoding_carryover = 0;
5891 /* At this point, NBYTES holds number of bytes just received
5892 (including the one in proc_buffered_char[channel]). */
5893 if (nbytes <= 0)
5895 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
5896 return nbytes;
5897 coding->mode |= CODING_MODE_LAST_BLOCK;
5900 /* Now set NBYTES how many bytes we must decode. */
5901 nbytes += carryover;
5903 odeactivate = Vdeactivate_mark;
5904 /* There's no good reason to let process filters change the current
5905 buffer, and many callers of accept-process-output, sit-for, and
5906 friends don't expect current-buffer to be changed from under them. */
5907 record_unwind_current_buffer ();
5909 read_and_dispose_of_process_output (p, chars, nbytes, coding);
5911 /* Handling the process output should not deactivate the mark. */
5912 Vdeactivate_mark = odeactivate;
5914 unbind_to (count, Qnil);
5915 return nbytes;
5918 static void
5919 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
5920 ssize_t nbytes,
5921 struct coding_system *coding)
5923 Lisp_Object outstream = p->filter;
5924 Lisp_Object text;
5925 bool outer_running_asynch_code = running_asynch_code;
5926 int waiting = waiting_for_user_input_p;
5928 #if 0
5929 Lisp_Object obuffer, okeymap;
5930 XSETBUFFER (obuffer, current_buffer);
5931 okeymap = BVAR (current_buffer, keymap);
5932 #endif
5934 /* We inhibit quit here instead of just catching it so that
5935 hitting ^G when a filter happens to be running won't screw
5936 it up. */
5937 specbind (Qinhibit_quit, Qt);
5938 specbind (Qlast_nonmenu_event, Qt);
5940 /* In case we get recursively called,
5941 and we already saved the match data nonrecursively,
5942 save the same match data in safely recursive fashion. */
5943 if (outer_running_asynch_code)
5945 Lisp_Object tem;
5946 /* Don't clobber the CURRENT match data, either! */
5947 tem = Fmatch_data (Qnil, Qnil, Qnil);
5948 restore_search_regs ();
5949 record_unwind_save_match_data ();
5950 Fset_match_data (tem, Qt);
5953 /* For speed, if a search happens within this code,
5954 save the match data in a special nonrecursive fashion. */
5955 running_asynch_code = 1;
5957 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
5958 text = coding->dst_object;
5959 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
5960 /* A new coding system might be found. */
5961 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
5963 pset_decode_coding_system (p, Vlast_coding_system_used);
5965 /* Don't call setup_coding_system for
5966 proc_decode_coding_system[channel] here. It is done in
5967 detect_coding called via decode_coding above. */
5969 /* If a coding system for encoding is not yet decided, we set
5970 it as the same as coding-system for decoding.
5972 But, before doing that we must check if
5973 proc_encode_coding_system[p->outfd] surely points to a
5974 valid memory because p->outfd will be changed once EOF is
5975 sent to the process. */
5976 if (NILP (p->encode_coding_system) && p->outfd >= 0
5977 && proc_encode_coding_system[p->outfd])
5979 pset_encode_coding_system
5980 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
5981 setup_coding_system (p->encode_coding_system,
5982 proc_encode_coding_system[p->outfd]);
5986 if (coding->carryover_bytes > 0)
5988 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
5989 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
5990 memcpy (SDATA (p->decoding_buf), coding->carryover,
5991 coding->carryover_bytes);
5992 p->decoding_carryover = coding->carryover_bytes;
5994 if (SBYTES (text) > 0)
5995 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5996 sometimes it's simply wrong to wrap (e.g. when called from
5997 accept-process-output). */
5998 internal_condition_case_1 (read_process_output_call,
5999 list3 (outstream, make_lisp_proc (p), text),
6000 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6001 read_process_output_error_handler);
6003 /* If we saved the match data nonrecursively, restore it now. */
6004 restore_search_regs ();
6005 running_asynch_code = outer_running_asynch_code;
6007 /* Restore waiting_for_user_input_p as it was
6008 when we were called, in case the filter clobbered it. */
6009 waiting_for_user_input_p = waiting;
6011 #if 0 /* Call record_asynch_buffer_change unconditionally,
6012 because we might have changed minor modes or other things
6013 that affect key bindings. */
6014 if (! EQ (Fcurrent_buffer (), obuffer)
6015 || ! EQ (current_buffer->keymap, okeymap))
6016 #endif
6017 /* But do it only if the caller is actually going to read events.
6018 Otherwise there's no need to make him wake up, and it could
6019 cause trouble (for example it would make sit_for return). */
6020 if (waiting_for_user_input_p == -1)
6021 record_asynch_buffer_change ();
6024 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6025 Sinternal_default_process_filter, 2, 2, 0,
6026 doc: /* Function used as default process filter.
6027 This inserts the process's output into its buffer, if there is one.
6028 Otherwise it discards the output. */)
6029 (Lisp_Object proc, Lisp_Object text)
6031 struct Lisp_Process *p;
6032 ptrdiff_t opoint;
6034 CHECK_PROCESS (proc);
6035 p = XPROCESS (proc);
6036 CHECK_STRING (text);
6038 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6040 Lisp_Object old_read_only;
6041 ptrdiff_t old_begv, old_zv;
6042 ptrdiff_t old_begv_byte, old_zv_byte;
6043 ptrdiff_t before, before_byte;
6044 ptrdiff_t opoint_byte;
6045 struct buffer *b;
6047 Fset_buffer (p->buffer);
6048 opoint = PT;
6049 opoint_byte = PT_BYTE;
6050 old_read_only = BVAR (current_buffer, read_only);
6051 old_begv = BEGV;
6052 old_zv = ZV;
6053 old_begv_byte = BEGV_BYTE;
6054 old_zv_byte = ZV_BYTE;
6056 bset_read_only (current_buffer, Qnil);
6058 /* Insert new output into buffer at the current end-of-output
6059 marker, thus preserving logical ordering of input and output. */
6060 if (XMARKER (p->mark)->buffer)
6061 set_point_from_marker (p->mark);
6062 else
6063 SET_PT_BOTH (ZV, ZV_BYTE);
6064 before = PT;
6065 before_byte = PT_BYTE;
6067 /* If the output marker is outside of the visible region, save
6068 the restriction and widen. */
6069 if (! (BEGV <= PT && PT <= ZV))
6070 Fwiden ();
6072 /* Adjust the multibyteness of TEXT to that of the buffer. */
6073 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6074 != ! STRING_MULTIBYTE (text))
6075 text = (STRING_MULTIBYTE (text)
6076 ? Fstring_as_unibyte (text)
6077 : Fstring_to_multibyte (text));
6078 /* Insert before markers in case we are inserting where
6079 the buffer's mark is, and the user's next command is Meta-y. */
6080 insert_from_string_before_markers (text, 0, 0,
6081 SCHARS (text), SBYTES (text), 0);
6083 /* Make sure the process marker's position is valid when the
6084 process buffer is changed in the signal_after_change above.
6085 W3 is known to do that. */
6086 if (BUFFERP (p->buffer)
6087 && (b = XBUFFER (p->buffer), b != current_buffer))
6088 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6089 else
6090 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6092 update_mode_lines = 23;
6094 /* Make sure opoint and the old restrictions
6095 float ahead of any new text just as point would. */
6096 if (opoint >= before)
6098 opoint += PT - before;
6099 opoint_byte += PT_BYTE - before_byte;
6101 if (old_begv > before)
6103 old_begv += PT - before;
6104 old_begv_byte += PT_BYTE - before_byte;
6106 if (old_zv >= before)
6108 old_zv += PT - before;
6109 old_zv_byte += PT_BYTE - before_byte;
6112 /* If the restriction isn't what it should be, set it. */
6113 if (old_begv != BEGV || old_zv != ZV)
6114 Fnarrow_to_region (make_number (old_begv), make_number (old_zv));
6116 bset_read_only (current_buffer, old_read_only);
6117 SET_PT_BOTH (opoint, opoint_byte);
6119 return Qnil;
6122 /* Sending data to subprocess. */
6124 /* In send_process, when a write fails temporarily,
6125 wait_reading_process_output is called. It may execute user code,
6126 e.g. timers, that attempts to write new data to the same process.
6127 We must ensure that data is sent in the right order, and not
6128 interspersed half-completed with other writes (Bug#10815). This is
6129 handled by the write_queue element of struct process. It is a list
6130 with each entry having the form
6132 (string . (offset . length))
6134 where STRING is a lisp string, OFFSET is the offset into the
6135 string's byte sequence from which we should begin to send, and
6136 LENGTH is the number of bytes left to send. */
6138 /* Create a new entry in write_queue.
6139 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6140 BUF is a pointer to the string sequence of the input_obj or a C
6141 string in case of Qt or Qnil. */
6143 static void
6144 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6145 const char *buf, ptrdiff_t len, bool front)
6147 ptrdiff_t offset;
6148 Lisp_Object entry, obj;
6150 if (STRINGP (input_obj))
6152 offset = buf - SSDATA (input_obj);
6153 obj = input_obj;
6155 else
6157 offset = 0;
6158 obj = make_unibyte_string (buf, len);
6161 entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
6163 if (front)
6164 pset_write_queue (p, Fcons (entry, p->write_queue));
6165 else
6166 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6169 /* Remove the first element in the write_queue of process P, put its
6170 contents in OBJ, BUF and LEN, and return true. If the
6171 write_queue is empty, return false. */
6173 static bool
6174 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6175 const char **buf, ptrdiff_t *len)
6177 Lisp_Object entry, offset_length;
6178 ptrdiff_t offset;
6180 if (NILP (p->write_queue))
6181 return 0;
6183 entry = XCAR (p->write_queue);
6184 pset_write_queue (p, XCDR (p->write_queue));
6186 *obj = XCAR (entry);
6187 offset_length = XCDR (entry);
6189 *len = XINT (XCDR (offset_length));
6190 offset = XINT (XCAR (offset_length));
6191 *buf = SSDATA (*obj) + offset;
6193 return 1;
6196 /* Send some data to process PROC.
6197 BUF is the beginning of the data; LEN is the number of characters.
6198 OBJECT is the Lisp object that the data comes from. If OBJECT is
6199 nil or t, it means that the data comes from C string.
6201 If OBJECT is not nil, the data is encoded by PROC's coding-system
6202 for encoding before it is sent.
6204 This function can evaluate Lisp code and can garbage collect. */
6206 static void
6207 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6208 Lisp_Object object)
6210 struct Lisp_Process *p = XPROCESS (proc);
6211 ssize_t rv;
6212 struct coding_system *coding;
6214 if (NETCONN_P (proc))
6216 wait_while_connecting (proc);
6217 wait_for_tls_negotiation (proc);
6220 if (p->raw_status_new)
6221 update_status (p);
6222 if (! EQ (p->status, Qrun))
6223 error ("Process %s not running", SDATA (p->name));
6224 if (p->outfd < 0)
6225 error ("Output file descriptor of %s is closed", SDATA (p->name));
6227 coding = proc_encode_coding_system[p->outfd];
6228 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6230 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6231 || (BUFFERP (object)
6232 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6233 || EQ (object, Qt))
6235 pset_encode_coding_system
6236 (p, complement_process_encoding_system (p->encode_coding_system));
6237 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6239 /* The coding system for encoding was changed to raw-text
6240 because we sent a unibyte text previously. Now we are
6241 sending a multibyte text, thus we must encode it by the
6242 original coding system specified for the current process.
6244 Another reason we come here is that the coding system
6245 was just complemented and a new one was returned by
6246 complement_process_encoding_system. */
6247 setup_coding_system (p->encode_coding_system, coding);
6248 Vlast_coding_system_used = p->encode_coding_system;
6250 coding->src_multibyte = 1;
6252 else
6254 coding->src_multibyte = 0;
6255 /* For sending a unibyte text, character code conversion should
6256 not take place but EOL conversion should. So, setup raw-text
6257 or one of the subsidiary if we have not yet done it. */
6258 if (CODING_REQUIRE_ENCODING (coding))
6260 if (CODING_REQUIRE_FLUSHING (coding))
6262 /* But, before changing the coding, we must flush out data. */
6263 coding->mode |= CODING_MODE_LAST_BLOCK;
6264 send_process (proc, "", 0, Qt);
6265 coding->mode &= CODING_MODE_LAST_BLOCK;
6267 setup_coding_system (raw_text_coding_system
6268 (Vlast_coding_system_used),
6269 coding);
6270 coding->src_multibyte = 0;
6273 coding->dst_multibyte = 0;
6275 if (CODING_REQUIRE_ENCODING (coding))
6277 coding->dst_object = Qt;
6278 if (BUFFERP (object))
6280 ptrdiff_t from_byte, from, to;
6281 ptrdiff_t save_pt, save_pt_byte;
6282 struct buffer *cur = current_buffer;
6284 set_buffer_internal (XBUFFER (object));
6285 save_pt = PT, save_pt_byte = PT_BYTE;
6287 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6288 from = BYTE_TO_CHAR (from_byte);
6289 to = BYTE_TO_CHAR (from_byte + len);
6290 TEMP_SET_PT_BOTH (from, from_byte);
6291 encode_coding_object (coding, object, from, from_byte,
6292 to, from_byte + len, Qt);
6293 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6294 set_buffer_internal (cur);
6296 else if (STRINGP (object))
6298 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6299 SBYTES (object), Qt);
6301 else
6303 coding->dst_object = make_unibyte_string (buf, len);
6304 coding->produced = len;
6307 len = coding->produced;
6308 object = coding->dst_object;
6309 buf = SSDATA (object);
6312 /* If there is already data in the write_queue, put the new data
6313 in the back of queue. Otherwise, ignore it. */
6314 if (!NILP (p->write_queue))
6315 write_queue_push (p, object, buf, len, 0);
6317 do /* while !NILP (p->write_queue) */
6319 ptrdiff_t cur_len = -1;
6320 const char *cur_buf;
6321 Lisp_Object cur_object;
6323 /* If write_queue is empty, ignore it. */
6324 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6326 cur_len = len;
6327 cur_buf = buf;
6328 cur_object = object;
6331 while (cur_len > 0)
6333 /* Send this batch, using one or more write calls. */
6334 ptrdiff_t written = 0;
6335 int outfd = p->outfd;
6336 #ifdef DATAGRAM_SOCKETS
6337 if (DATAGRAM_CHAN_P (outfd))
6339 rv = sendto (outfd, cur_buf, cur_len,
6340 0, datagram_address[outfd].sa,
6341 datagram_address[outfd].len);
6342 if (rv >= 0)
6343 written = rv;
6344 else if (errno == EMSGSIZE)
6345 report_file_error ("Sending datagram", proc);
6347 else
6348 #endif
6350 #ifdef HAVE_GNUTLS
6351 if (p->gnutls_p && p->gnutls_state)
6352 written = emacs_gnutls_write (p, cur_buf, cur_len);
6353 else
6354 #endif
6355 written = emacs_write_sig (outfd, cur_buf, cur_len);
6356 rv = (written ? 0 : -1);
6357 if (p->read_output_delay > 0
6358 && p->adaptive_read_buffering == 1)
6360 p->read_output_delay = 0;
6361 process_output_delay_count--;
6362 p->read_output_skip = 0;
6366 if (rv < 0)
6368 if (would_block (errno))
6369 /* Buffer is full. Wait, accepting input;
6370 that may allow the program
6371 to finish doing output and read more. */
6373 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6374 /* A gross hack to work around a bug in FreeBSD.
6375 In the following sequence, read(2) returns
6376 bogus data:
6378 write(2) 1022 bytes
6379 write(2) 954 bytes, get EAGAIN
6380 read(2) 1024 bytes in process_read_output
6381 read(2) 11 bytes in process_read_output
6383 That is, read(2) returns more bytes than have
6384 ever been written successfully. The 1033 bytes
6385 read are the 1022 bytes written successfully
6386 after processing (for example with CRs added if
6387 the terminal is set up that way which it is
6388 here). The same bytes will be seen again in a
6389 later read(2), without the CRs. */
6391 if (errno == EAGAIN)
6393 int flags = FWRITE;
6394 ioctl (p->outfd, TIOCFLUSH, &flags);
6396 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6398 /* Put what we should have written in wait_queue. */
6399 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6400 wait_reading_process_output (0, 20 * 1000 * 1000,
6401 0, 0, Qnil, NULL, 0);
6402 /* Reread queue, to see what is left. */
6403 break;
6405 else if (errno == EPIPE)
6407 p->raw_status_new = 0;
6408 pset_status (p, list2 (Qexit, make_number (256)));
6409 p->tick = ++process_tick;
6410 deactivate_process (proc);
6411 error ("process %s no longer connected to pipe; closed it",
6412 SDATA (p->name));
6414 else
6415 /* This is a real error. */
6416 report_file_error ("Writing to process", proc);
6418 cur_buf += written;
6419 cur_len -= written;
6422 while (!NILP (p->write_queue));
6425 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6426 3, 3, 0,
6427 doc: /* Send current contents of region as input to PROCESS.
6428 PROCESS may be a process, a buffer, the name of a process or buffer, or
6429 nil, indicating the current buffer's process.
6430 Called from program, takes three arguments, PROCESS, START and END.
6431 If the region is more than 500 characters long,
6432 it is sent in several bunches. This may happen even for shorter regions.
6433 Output from processes can arrive in between bunches.
6435 If PROCESS is a non-blocking network process that hasn't been fully
6436 set up yet, this function will block until socket setup has completed. */)
6437 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6439 Lisp_Object proc = get_process (process);
6440 ptrdiff_t start_byte, end_byte;
6442 validate_region (&start, &end);
6444 start_byte = CHAR_TO_BYTE (XINT (start));
6445 end_byte = CHAR_TO_BYTE (XINT (end));
6447 if (XINT (start) < GPT && XINT (end) > GPT)
6448 move_gap_both (XINT (start), start_byte);
6450 if (NETCONN_P (proc))
6451 wait_while_connecting (proc);
6453 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6454 end_byte - start_byte, Fcurrent_buffer ());
6456 return Qnil;
6459 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6460 2, 2, 0,
6461 doc: /* Send PROCESS the contents of STRING as input.
6462 PROCESS may be a process, a buffer, the name of a process or buffer, or
6463 nil, indicating the current buffer's process.
6464 If STRING is more than 500 characters long,
6465 it is sent in several bunches. This may happen even for shorter strings.
6466 Output from processes can arrive in between bunches.
6468 If PROCESS is a non-blocking network process that hasn't been fully
6469 set up yet, this function will block until socket setup has completed. */)
6470 (Lisp_Object process, Lisp_Object string)
6472 CHECK_STRING (string);
6473 Lisp_Object proc = get_process (process);
6474 send_process (proc, SSDATA (string),
6475 SBYTES (string), string);
6476 return Qnil;
6479 /* Return the foreground process group for the tty/pty that
6480 the process P uses. */
6481 static pid_t
6482 emacs_get_tty_pgrp (struct Lisp_Process *p)
6484 pid_t gid = -1;
6486 #ifdef TIOCGPGRP
6487 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6489 int fd;
6490 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6491 master side. Try the slave side. */
6492 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6494 if (fd != -1)
6496 ioctl (fd, TIOCGPGRP, &gid);
6497 emacs_close (fd);
6500 #endif /* defined (TIOCGPGRP ) */
6502 return gid;
6505 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6506 Sprocess_running_child_p, 0, 1, 0,
6507 doc: /* Return non-nil if PROCESS has given the terminal to a
6508 child. If the operating system does not make it possible to find out,
6509 return t. If we can find out, return the numeric ID of the foreground
6510 process group. */)
6511 (Lisp_Object process)
6513 /* Initialize in case ioctl doesn't exist or gives an error,
6514 in a way that will cause returning t. */
6515 Lisp_Object proc = get_process (process);
6516 struct Lisp_Process *p = XPROCESS (proc);
6518 if (!EQ (p->type, Qreal))
6519 error ("Process %s is not a subprocess",
6520 SDATA (p->name));
6521 if (p->infd < 0)
6522 error ("Process %s is not active",
6523 SDATA (p->name));
6525 pid_t gid = emacs_get_tty_pgrp (p);
6527 if (gid == p->pid)
6528 return Qnil;
6529 if (gid != -1)
6530 return make_number (gid);
6531 return Qt;
6534 /* Send a signal number SIGNO to PROCESS.
6535 If CURRENT_GROUP is t, that means send to the process group
6536 that currently owns the terminal being used to communicate with PROCESS.
6537 This is used for various commands in shell mode.
6538 If CURRENT_GROUP is lambda, that means send to the process group
6539 that currently owns the terminal, but only if it is NOT the shell itself.
6541 If NOMSG is false, insert signal-announcements into process's buffers
6542 right away.
6544 If we can, we try to signal PROCESS by sending control characters
6545 down the pty. This allows us to signal inferiors who have changed
6546 their uid, for which kill would return an EPERM error. */
6548 static void
6549 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6550 bool nomsg)
6552 Lisp_Object proc;
6553 struct Lisp_Process *p;
6554 pid_t gid;
6555 bool no_pgrp = 0;
6557 proc = get_process (process);
6558 p = XPROCESS (proc);
6560 if (!EQ (p->type, Qreal))
6561 error ("Process %s is not a subprocess",
6562 SDATA (p->name));
6563 if (p->infd < 0)
6564 error ("Process %s is not active",
6565 SDATA (p->name));
6567 if (!p->pty_flag)
6568 current_group = Qnil;
6570 /* If we are using pgrps, get a pgrp number and make it negative. */
6571 if (NILP (current_group))
6572 /* Send the signal to the shell's process group. */
6573 gid = p->pid;
6574 else
6576 #ifdef SIGNALS_VIA_CHARACTERS
6577 /* If possible, send signals to the entire pgrp
6578 by sending an input character to it. */
6580 struct termios t;
6581 cc_t *sig_char = NULL;
6583 tcgetattr (p->infd, &t);
6585 switch (signo)
6587 case SIGINT:
6588 sig_char = &t.c_cc[VINTR];
6589 break;
6591 case SIGQUIT:
6592 sig_char = &t.c_cc[VQUIT];
6593 break;
6595 case SIGTSTP:
6596 #ifdef VSWTCH
6597 sig_char = &t.c_cc[VSWTCH];
6598 #else
6599 sig_char = &t.c_cc[VSUSP];
6600 #endif
6601 break;
6604 if (sig_char && *sig_char != CDISABLE)
6606 send_process (proc, (char *) sig_char, 1, Qnil);
6607 return;
6609 /* If we can't send the signal with a character,
6610 fall through and send it another way. */
6612 /* The code above may fall through if it can't
6613 handle the signal. */
6614 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6616 #ifdef TIOCGPGRP
6617 /* Get the current pgrp using the tty itself, if we have that.
6618 Otherwise, use the pty to get the pgrp.
6619 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6620 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6621 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6622 His patch indicates that if TIOCGPGRP returns an error, then
6623 we should just assume that p->pid is also the process group id. */
6625 gid = emacs_get_tty_pgrp (p);
6627 if (gid == -1)
6628 /* If we can't get the information, assume
6629 the shell owns the tty. */
6630 gid = p->pid;
6632 /* It is not clear whether anything really can set GID to -1.
6633 Perhaps on some system one of those ioctls can or could do so.
6634 Or perhaps this is vestigial. */
6635 if (gid == -1)
6636 no_pgrp = 1;
6637 #else /* ! defined (TIOCGPGRP) */
6638 /* Can't select pgrps on this system, so we know that
6639 the child itself heads the pgrp. */
6640 gid = p->pid;
6641 #endif /* ! defined (TIOCGPGRP) */
6643 /* If current_group is lambda, and the shell owns the terminal,
6644 don't send any signal. */
6645 if (EQ (current_group, Qlambda) && gid == p->pid)
6646 return;
6649 #ifdef SIGCONT
6650 if (signo == SIGCONT)
6652 p->raw_status_new = 0;
6653 pset_status (p, Qrun);
6654 p->tick = ++process_tick;
6655 if (!nomsg)
6657 status_notify (NULL, NULL);
6658 redisplay_preserve_echo_area (13);
6661 #endif
6663 #ifdef TIOCSIGSEND
6664 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6665 We don't know whether the bug is fixed in later HP-UX versions. */
6666 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6667 return;
6668 #endif
6670 /* If we don't have process groups, send the signal to the immediate
6671 subprocess. That isn't really right, but it's better than any
6672 obvious alternative. */
6673 pid_t pid = no_pgrp ? gid : - gid;
6675 /* Do not kill an already-reaped process, as that could kill an
6676 innocent bystander that happens to have the same process ID. */
6677 sigset_t oldset;
6678 block_child_signal (&oldset);
6679 if (p->alive)
6680 kill (pid, signo);
6681 unblock_child_signal (&oldset);
6684 DEFUN ("internal-default-interrupt-process",
6685 Finternal_default_interrupt_process,
6686 Sinternal_default_interrupt_process, 0, 2, 0,
6687 doc: /* Default function to interrupt process PROCESS.
6688 It shall be the last element in list `interrupt-process-functions'.
6689 See function `interrupt-process' for more details on usage. */)
6690 (Lisp_Object process, Lisp_Object current_group)
6692 process_send_signal (process, SIGINT, current_group, 0);
6693 return process;
6696 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
6697 doc: /* Interrupt process PROCESS.
6698 PROCESS may be a process, a buffer, or the name of a process or buffer.
6699 No arg or nil means current buffer's process.
6700 Second arg CURRENT-GROUP non-nil means send signal to
6701 the current process-group of the process's controlling terminal
6702 rather than to the process's own process group.
6703 If the process is a shell, this means interrupt current subjob
6704 rather than the shell.
6706 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6707 don't send the signal.
6709 This function calls the functions of `interrupt-process-functions' in
6710 the order of the list, until one of them returns non-`nil'. */)
6711 (Lisp_Object process, Lisp_Object current_group)
6713 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
6714 process, current_group);
6717 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2, 0,
6718 doc: /* Kill process PROCESS. May be process or name of one.
6719 See function `interrupt-process' for more details on usage. */)
6720 (Lisp_Object process, Lisp_Object current_group)
6722 process_send_signal (process, SIGKILL, current_group, 0);
6723 return process;
6726 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
6727 doc: /* Send QUIT signal to process PROCESS. May be process or name of one.
6728 See function `interrupt-process' for more details on usage. */)
6729 (Lisp_Object process, Lisp_Object current_group)
6731 process_send_signal (process, SIGQUIT, current_group, 0);
6732 return process;
6735 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
6736 doc: /* Stop process PROCESS. May be process or name of one.
6737 See function `interrupt-process' for more details on usage.
6738 If PROCESS is a network or serial or pipe connection, inhibit handling
6739 of incoming traffic. */)
6740 (Lisp_Object process, Lisp_Object current_group)
6742 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6743 || PIPECONN_P (process)))
6745 struct Lisp_Process *p;
6747 p = XPROCESS (process);
6748 if (NILP (p->command)
6749 && p->infd >= 0)
6750 delete_read_fd (p->infd);
6751 pset_command (p, Qt);
6752 return process;
6754 #ifndef SIGTSTP
6755 error ("No SIGTSTP support");
6756 #else
6757 process_send_signal (process, SIGTSTP, current_group, 0);
6758 #endif
6759 return process;
6762 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
6763 doc: /* Continue process PROCESS. May be process or name of one.
6764 See function `interrupt-process' for more details on usage.
6765 If PROCESS is a network or serial process, resume handling of incoming
6766 traffic. */)
6767 (Lisp_Object process, Lisp_Object current_group)
6769 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
6770 || PIPECONN_P (process)))
6772 struct Lisp_Process *p;
6774 p = XPROCESS (process);
6775 if (EQ (p->command, Qt)
6776 && p->infd >= 0
6777 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
6779 add_process_read_fd (p->infd);
6780 #ifdef WINDOWSNT
6781 if (fd_info[ p->infd ].flags & FILE_SERIAL)
6782 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
6783 #else /* not WINDOWSNT */
6784 tcflush (p->infd, TCIFLUSH);
6785 #endif /* not WINDOWSNT */
6787 pset_command (p, Qnil);
6788 return process;
6790 #ifdef SIGCONT
6791 process_send_signal (process, SIGCONT, current_group, 0);
6792 #else
6793 error ("No SIGCONT support");
6794 #endif
6795 return process;
6798 /* Return the integer value of the signal whose abbreviation is ABBR,
6799 or a negative number if there is no such signal. */
6800 static int
6801 abbr_to_signal (char const *name)
6803 int i, signo;
6804 char sigbuf[20]; /* Large enough for all valid signal abbreviations. */
6806 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
6807 name += 3;
6809 for (i = 0; i < sizeof sigbuf; i++)
6811 sigbuf[i] = c_toupper (name[i]);
6812 if (! sigbuf[i])
6813 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
6816 return -1;
6819 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
6820 2, 2, "sProcess (name or number): \nnSignal code: ",
6821 doc: /* Send PROCESS the signal with code SIGCODE.
6822 PROCESS may also be a number specifying the process id of the
6823 process to signal; in this case, the process need not be a child of
6824 this Emacs.
6825 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6826 (Lisp_Object process, Lisp_Object sigcode)
6828 pid_t pid;
6829 int signo;
6831 if (STRINGP (process))
6833 Lisp_Object tem = Fget_process (process);
6834 if (NILP (tem))
6836 Lisp_Object process_number
6837 = string_to_number (SSDATA (process), 10, 1);
6838 if (NUMBERP (process_number))
6839 tem = process_number;
6841 process = tem;
6843 else if (!NUMBERP (process))
6844 process = get_process (process);
6846 if (NILP (process))
6847 return process;
6849 if (NUMBERP (process))
6850 CONS_TO_INTEGER (process, pid_t, pid);
6851 else
6853 CHECK_PROCESS (process);
6854 pid = XPROCESS (process)->pid;
6855 if (pid <= 0)
6856 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
6859 if (INTEGERP (sigcode))
6861 CHECK_TYPE_RANGED_INTEGER (int, sigcode);
6862 signo = XINT (sigcode);
6864 else
6866 char *name;
6868 CHECK_SYMBOL (sigcode);
6869 name = SSDATA (SYMBOL_NAME (sigcode));
6871 signo = abbr_to_signal (name);
6872 if (signo < 0)
6873 error ("Undefined signal name %s", name);
6876 return make_number (kill (pid, signo));
6879 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
6880 doc: /* Make PROCESS see end-of-file in its input.
6881 EOF comes after any text already sent to it.
6882 PROCESS may be a process, a buffer, the name of a process or buffer, or
6883 nil, indicating the current buffer's process.
6884 If PROCESS is a network connection, or is a process communicating
6885 through a pipe (as opposed to a pty), then you cannot send any more
6886 text to PROCESS after you call this function.
6887 If PROCESS is a serial process, wait until all output written to the
6888 process has been transmitted to the serial port. */)
6889 (Lisp_Object process)
6891 Lisp_Object proc;
6892 struct coding_system *coding = NULL;
6893 int outfd;
6895 proc = get_process (process);
6897 if (NETCONN_P (proc))
6898 wait_while_connecting (proc);
6900 if (DATAGRAM_CONN_P (proc))
6901 return process;
6904 outfd = XPROCESS (proc)->outfd;
6905 if (outfd >= 0)
6906 coding = proc_encode_coding_system[outfd];
6908 /* Make sure the process is really alive. */
6909 if (XPROCESS (proc)->raw_status_new)
6910 update_status (XPROCESS (proc));
6911 if (! EQ (XPROCESS (proc)->status, Qrun))
6912 error ("Process %s not running", SDATA (XPROCESS (proc)->name));
6914 if (coding && CODING_REQUIRE_FLUSHING (coding))
6916 coding->mode |= CODING_MODE_LAST_BLOCK;
6917 send_process (proc, "", 0, Qnil);
6920 if (XPROCESS (proc)->pty_flag)
6921 send_process (proc, "\004", 1, Qnil);
6922 else if (EQ (XPROCESS (proc)->type, Qserial))
6924 #ifndef WINDOWSNT
6925 if (tcdrain (XPROCESS (proc)->outfd) != 0)
6926 report_file_error ("Failed tcdrain", Qnil);
6927 #endif /* not WINDOWSNT */
6928 /* Do nothing on Windows because writes are blocking. */
6930 else
6932 struct Lisp_Process *p = XPROCESS (proc);
6933 int old_outfd = p->outfd;
6934 int new_outfd;
6936 #ifdef HAVE_SHUTDOWN
6937 /* If this is a network connection, or socketpair is used
6938 for communication with the subprocess, call shutdown to cause EOF.
6939 (In some old system, shutdown to socketpair doesn't work.
6940 Then we just can't win.) */
6941 if (0 <= old_outfd
6942 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
6943 shutdown (old_outfd, 1);
6944 #endif
6945 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
6946 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
6947 if (new_outfd < 0)
6948 report_file_error ("Opening null device", Qnil);
6949 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
6950 p->outfd = new_outfd;
6952 if (!proc_encode_coding_system[new_outfd])
6953 proc_encode_coding_system[new_outfd]
6954 = xmalloc (sizeof (struct coding_system));
6955 if (old_outfd >= 0)
6957 *proc_encode_coding_system[new_outfd]
6958 = *proc_encode_coding_system[old_outfd];
6959 memset (proc_encode_coding_system[old_outfd], 0,
6960 sizeof (struct coding_system));
6962 else
6963 setup_coding_system (p->encode_coding_system,
6964 proc_encode_coding_system[new_outfd]);
6966 return process;
6969 /* The main Emacs thread records child processes in three places:
6971 - Vprocess_alist, for asynchronous subprocesses, which are child
6972 processes visible to Lisp.
6974 - deleted_pid_list, for child processes invisible to Lisp,
6975 typically because of delete-process. These are recorded so that
6976 the processes can be reaped when they exit, so that the operating
6977 system's process table is not cluttered by zombies.
6979 - the local variable PID in Fcall_process, call_process_cleanup and
6980 call_process_kill, for synchronous subprocesses.
6981 record_unwind_protect is used to make sure this process is not
6982 forgotten: if the user interrupts call-process and the child
6983 process refuses to exit immediately even with two C-g's,
6984 call_process_kill adds PID's contents to deleted_pid_list before
6985 returning.
6987 The main Emacs thread invokes waitpid only on child processes that
6988 it creates and that have not been reaped. This avoid races on
6989 platforms such as GTK, where other threads create their own
6990 subprocesses which the main thread should not reap. For example,
6991 if the main thread attempted to reap an already-reaped child, it
6992 might inadvertently reap a GTK-created process that happened to
6993 have the same process ID. */
6995 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6996 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6997 keep track of its own children. GNUstep is similar. */
6999 static void dummy_handler (int sig) {}
7000 static signal_handler_t volatile lib_child_handler;
7002 /* Handle a SIGCHLD signal by looking for known child processes of
7003 Emacs whose status have changed. For each one found, record its
7004 new status.
7006 All we do is change the status; we do not run sentinels or print
7007 notifications. That is saved for the next time keyboard input is
7008 done, in order to avoid timing errors.
7010 ** WARNING: this can be called during garbage collection.
7011 Therefore, it must not be fooled by the presence of mark bits in
7012 Lisp objects.
7014 ** USG WARNING: Although it is not obvious from the documentation
7015 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7016 signal() before executing at least one wait(), otherwise the
7017 handler will be called again, resulting in an infinite loop. The
7018 relevant portion of the documentation reads "SIGCLD signals will be
7019 queued and the signal-catching function will be continually
7020 reentered until the queue is empty". Invoking signal() causes the
7021 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7022 Inc.
7024 ** Malloc WARNING: This should never call malloc either directly or
7025 indirectly; if it does, that is a bug. */
7027 static void
7028 handle_child_signal (int sig)
7030 Lisp_Object tail, proc;
7032 /* Find the process that signaled us, and record its status. */
7034 /* The process can have been deleted by Fdelete_process, or have
7035 been started asynchronously by Fcall_process. */
7036 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7038 bool all_pids_are_fixnums
7039 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7040 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7041 Lisp_Object head = XCAR (tail);
7042 Lisp_Object xpid;
7043 if (! CONSP (head))
7044 continue;
7045 xpid = XCAR (head);
7046 if (all_pids_are_fixnums ? INTEGERP (xpid) : NUMBERP (xpid))
7048 pid_t deleted_pid;
7049 if (INTEGERP (xpid))
7050 deleted_pid = XINT (xpid);
7051 else
7052 deleted_pid = XFLOAT_DATA (xpid);
7053 if (child_status_changed (deleted_pid, 0, 0))
7055 if (STRINGP (XCDR (head)))
7056 unlink (SSDATA (XCDR (head)));
7057 XSETCAR (tail, Qnil);
7062 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7063 FOR_EACH_PROCESS (tail, proc)
7065 struct Lisp_Process *p = XPROCESS (proc);
7066 int status;
7068 if (p->alive
7069 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7071 /* Change the status of the process that was found. */
7072 p->tick = ++process_tick;
7073 p->raw_status = status;
7074 p->raw_status_new = 1;
7076 /* If process has terminated, stop waiting for its output. */
7077 if (WIFSIGNALED (status) || WIFEXITED (status))
7079 bool clear_desc_flag = 0;
7080 p->alive = 0;
7081 if (p->infd >= 0)
7082 clear_desc_flag = 1;
7084 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7085 if (clear_desc_flag)
7086 delete_read_fd (p->infd);
7091 lib_child_handler (sig);
7092 #ifdef NS_IMPL_GNUSTEP
7093 /* NSTask in GNUstep sets its child handler each time it is called.
7094 So we must re-set ours. */
7095 catch_child_signal ();
7096 #endif
7099 static void
7100 deliver_child_signal (int sig)
7102 deliver_process_signal (sig, handle_child_signal);
7106 static Lisp_Object
7107 exec_sentinel_error_handler (Lisp_Object error_val)
7109 /* Make sure error_val is a cons cell, as all the rest of error
7110 handling expects that, and will barf otherwise. */
7111 if (!CONSP (error_val))
7112 error_val = Fcons (Qerror, error_val);
7113 cmd_error_internal (error_val, "error in process sentinel: ");
7114 Vinhibit_quit = Qt;
7115 update_echo_area ();
7116 Fsleep_for (make_number (2), Qnil);
7117 return Qt;
7120 static void
7121 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
7123 Lisp_Object sentinel, odeactivate;
7124 struct Lisp_Process *p = XPROCESS (proc);
7125 ptrdiff_t count = SPECPDL_INDEX ();
7126 bool outer_running_asynch_code = running_asynch_code;
7127 int waiting = waiting_for_user_input_p;
7129 if (inhibit_sentinels)
7130 return;
7132 odeactivate = Vdeactivate_mark;
7133 #if 0
7134 Lisp_Object obuffer, okeymap;
7135 XSETBUFFER (obuffer, current_buffer);
7136 okeymap = BVAR (current_buffer, keymap);
7137 #endif
7139 /* There's no good reason to let sentinels change the current
7140 buffer, and many callers of accept-process-output, sit-for, and
7141 friends don't expect current-buffer to be changed from under them. */
7142 record_unwind_current_buffer ();
7144 sentinel = p->sentinel;
7146 /* Inhibit quit so that random quits don't screw up a running filter. */
7147 specbind (Qinhibit_quit, Qt);
7148 specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef */
7150 /* In case we get recursively called,
7151 and we already saved the match data nonrecursively,
7152 save the same match data in safely recursive fashion. */
7153 if (outer_running_asynch_code)
7155 Lisp_Object tem;
7156 tem = Fmatch_data (Qnil, Qnil, Qnil);
7157 restore_search_regs ();
7158 record_unwind_save_match_data ();
7159 Fset_match_data (tem, Qt);
7162 /* For speed, if a search happens within this code,
7163 save the match data in a special nonrecursive fashion. */
7164 running_asynch_code = 1;
7166 internal_condition_case_1 (read_process_output_call,
7167 list3 (sentinel, proc, reason),
7168 !NILP (Vdebug_on_error) ? Qnil : Qerror,
7169 exec_sentinel_error_handler);
7171 /* If we saved the match data nonrecursively, restore it now. */
7172 restore_search_regs ();
7173 running_asynch_code = outer_running_asynch_code;
7175 Vdeactivate_mark = odeactivate;
7177 /* Restore waiting_for_user_input_p as it was
7178 when we were called, in case the filter clobbered it. */
7179 waiting_for_user_input_p = waiting;
7181 #if 0
7182 if (! EQ (Fcurrent_buffer (), obuffer)
7183 || ! EQ (current_buffer->keymap, okeymap))
7184 #endif
7185 /* But do it only if the caller is actually going to read events.
7186 Otherwise there's no need to make him wake up, and it could
7187 cause trouble (for example it would make sit_for return). */
7188 if (waiting_for_user_input_p == -1)
7189 record_asynch_buffer_change ();
7191 unbind_to (count, Qnil);
7194 /* Report all recent events of a change in process status
7195 (either run the sentinel or output a message).
7196 This is usually done while Emacs is waiting for keyboard input
7197 but can be done at other times.
7199 Return positive if any input was received from WAIT_PROC (or from
7200 any process if WAIT_PROC is null), zero if input was attempted but
7201 none received, and negative if we didn't even try. */
7203 static int
7204 status_notify (struct Lisp_Process *deleting_process,
7205 struct Lisp_Process *wait_proc)
7207 Lisp_Object proc;
7208 Lisp_Object tail, msg;
7209 int got_some_output = -1;
7211 tail = Qnil;
7212 msg = Qnil;
7214 /* Set this now, so that if new processes are created by sentinels
7215 that we run, we get called again to handle their status changes. */
7216 update_tick = process_tick;
7218 FOR_EACH_PROCESS (tail, proc)
7220 Lisp_Object symbol;
7221 register struct Lisp_Process *p = XPROCESS (proc);
7223 if (p->tick != p->update_tick)
7225 p->update_tick = p->tick;
7227 /* If process is still active, read any output that remains. */
7228 while (! EQ (p->filter, Qt)
7229 && ! connecting_status (p->status)
7230 && ! EQ (p->status, Qlisten)
7231 /* Network or serial process not stopped: */
7232 && ! EQ (p->command, Qt)
7233 && p->infd >= 0
7234 && p != deleting_process)
7236 int nread = read_process_output (proc, p->infd);
7237 if ((!wait_proc || wait_proc == XPROCESS (proc))
7238 && got_some_output < nread)
7239 got_some_output = nread;
7240 if (nread <= 0)
7241 break;
7244 /* Get the text to use for the message. */
7245 if (p->raw_status_new)
7246 update_status (p);
7247 msg = status_message (p);
7249 /* If process is terminated, deactivate it or delete it. */
7250 symbol = p->status;
7251 if (CONSP (p->status))
7252 symbol = XCAR (p->status);
7254 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
7255 || EQ (symbol, Qclosed))
7257 if (delete_exited_processes)
7258 remove_process (proc);
7259 else
7260 deactivate_process (proc);
7263 /* The actions above may have further incremented p->tick.
7264 So set p->update_tick again so that an error in the sentinel will
7265 not cause this code to be run again. */
7266 p->update_tick = p->tick;
7267 /* Now output the message suitably. */
7268 exec_sentinel (proc, msg);
7269 if (BUFFERP (p->buffer))
7270 /* In case it uses %s in mode-line-format. */
7271 bset_update_mode_line (XBUFFER (p->buffer));
7273 } /* end for */
7275 return got_some_output;
7278 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
7279 Sinternal_default_process_sentinel, 2, 2, 0,
7280 doc: /* Function used as default sentinel for processes.
7281 This inserts a status message into the process's buffer, if there is one. */)
7282 (Lisp_Object proc, Lisp_Object msg)
7284 Lisp_Object buffer, symbol;
7285 struct Lisp_Process *p;
7286 CHECK_PROCESS (proc);
7287 p = XPROCESS (proc);
7288 buffer = p->buffer;
7289 symbol = p->status;
7290 if (CONSP (symbol))
7291 symbol = XCAR (symbol);
7293 if (!EQ (symbol, Qrun) && !NILP (buffer))
7295 Lisp_Object tem;
7296 struct buffer *old = current_buffer;
7297 ptrdiff_t opoint, opoint_byte;
7298 ptrdiff_t before, before_byte;
7300 /* Avoid error if buffer is deleted
7301 (probably that's why the process is dead, too). */
7302 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
7303 return Qnil;
7304 Fset_buffer (buffer);
7306 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7307 msg = (code_convert_string_norecord
7308 (msg, Vlocale_coding_system, 1));
7310 opoint = PT;
7311 opoint_byte = PT_BYTE;
7312 /* Insert new output into buffer
7313 at the current end-of-output marker,
7314 thus preserving logical ordering of input and output. */
7315 if (XMARKER (p->mark)->buffer)
7316 Fgoto_char (p->mark);
7317 else
7318 SET_PT_BOTH (ZV, ZV_BYTE);
7320 before = PT;
7321 before_byte = PT_BYTE;
7323 tem = BVAR (current_buffer, read_only);
7324 bset_read_only (current_buffer, Qnil);
7325 insert_string ("\nProcess ");
7326 { /* FIXME: temporary kludge. */
7327 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
7328 insert_string (" ");
7329 Finsert (1, &msg);
7330 bset_read_only (current_buffer, tem);
7331 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7333 if (opoint >= before)
7334 SET_PT_BOTH (opoint + (PT - before),
7335 opoint_byte + (PT_BYTE - before_byte));
7336 else
7337 SET_PT_BOTH (opoint, opoint_byte);
7339 set_buffer_internal (old);
7341 return Qnil;
7345 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7346 Sset_process_coding_system, 1, 3, 0,
7347 doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
7348 DECODING will be used to decode subprocess output and ENCODING to
7349 encode subprocess input. */)
7350 (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
7352 CHECK_PROCESS (process);
7354 struct Lisp_Process *p = XPROCESS (process);
7356 Fcheck_coding_system (decoding);
7357 Fcheck_coding_system (encoding);
7358 encoding = coding_inherit_eol_type (encoding, Qnil);
7359 pset_decode_coding_system (p, decoding);
7360 pset_encode_coding_system (p, encoding);
7362 /* If the sockets haven't been set up yet, the final setup part of
7363 this will be called asynchronously. */
7364 if (p->infd < 0 || p->outfd < 0)
7365 return Qnil;
7367 setup_process_coding_systems (process);
7369 return Qnil;
7372 DEFUN ("process-coding-system",
7373 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7374 doc: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7375 (register Lisp_Object process)
7377 CHECK_PROCESS (process);
7378 return Fcons (XPROCESS (process)->decode_coding_system,
7379 XPROCESS (process)->encode_coding_system);
7382 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte,
7383 Sset_process_filter_multibyte, 2, 2, 0,
7384 doc: /* Set multibyteness of the strings given to PROCESS's filter.
7385 If FLAG is non-nil, the filter is given multibyte strings.
7386 If FLAG is nil, the filter is given unibyte strings. In this case,
7387 all character code conversion except for end-of-line conversion is
7388 suppressed. */)
7389 (Lisp_Object process, Lisp_Object flag)
7391 CHECK_PROCESS (process);
7393 struct Lisp_Process *p = XPROCESS (process);
7394 if (NILP (flag))
7395 pset_decode_coding_system
7396 (p, raw_text_coding_system (p->decode_coding_system));
7398 /* If the sockets haven't been set up yet, the final setup part of
7399 this will be called asynchronously. */
7400 if (p->infd < 0 || p->outfd < 0)
7401 return Qnil;
7403 setup_process_coding_systems (process);
7405 return Qnil;
7408 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p,
7409 Sprocess_filter_multibyte_p, 1, 1, 0,
7410 doc: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7411 (Lisp_Object process)
7413 CHECK_PROCESS (process);
7414 struct Lisp_Process *p = XPROCESS (process);
7415 if (p->infd < 0)
7416 return Qnil;
7417 struct coding_system *coding = proc_decode_coding_system[p->infd];
7418 return (CODING_FOR_UNIBYTE (coding) ? Qnil : Qt);
7424 # ifdef HAVE_GPM
7426 void
7427 add_gpm_wait_descriptor (int desc)
7429 add_keyboard_wait_descriptor (desc);
7432 void
7433 delete_gpm_wait_descriptor (int desc)
7435 delete_keyboard_wait_descriptor (desc);
7438 # endif
7440 # ifdef USABLE_SIGIO
7442 /* Return true if *MASK has a bit set
7443 that corresponds to one of the keyboard input descriptors. */
7445 static bool
7446 keyboard_bit_set (fd_set *mask)
7448 int fd;
7450 for (fd = 0; fd <= max_desc; fd++)
7451 if (FD_ISSET (fd, mask)
7452 && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
7453 == (FOR_READ | KEYBOARD_FD)))
7454 return 1;
7456 return 0;
7458 # endif
7460 #else /* not subprocesses */
7462 /* This is referenced in thread.c:run_thread (which is never actually
7463 called, since threads are not enabled for this configuration. */
7464 void
7465 update_processes_for_thread_death (Lisp_Object dying_thread)
7469 /* Defined in msdos.c. */
7470 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7471 struct timespec *, void *);
7473 /* Implementation of wait_reading_process_output, assuming that there
7474 are no subprocesses. Used only by the MS-DOS build.
7476 Wait for timeout to elapse and/or keyboard input to be available.
7478 TIME_LIMIT is:
7479 timeout in seconds
7480 If negative, gobble data immediately available but don't wait for any.
7482 NSECS is:
7483 an additional duration to wait, measured in nanoseconds
7484 If TIME_LIMIT is zero, then:
7485 If NSECS == 0, there is no limit.
7486 If NSECS > 0, the timeout consists of NSECS only.
7487 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7489 READ_KBD is:
7490 0 to ignore keyboard input, or
7491 1 to return when input is available, or
7492 -1 means caller will actually read the input, so don't throw to
7493 the quit handler.
7495 see full version for other parameters. We know that wait_proc will
7496 always be NULL, since `subprocesses' isn't defined.
7498 DO_DISPLAY means redisplay should be done to show subprocess
7499 output that arrives.
7501 Return -1 signifying we got no output and did not try. */
7504 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7505 bool do_display,
7506 Lisp_Object wait_for_cell,
7507 struct Lisp_Process *wait_proc, int just_wait_proc)
7509 register int nfds;
7510 struct timespec end_time, timeout;
7511 enum { MINIMUM = -1, TIMEOUT, INFINITY } wait;
7513 if (TYPE_MAXIMUM (time_t) < time_limit)
7514 time_limit = TYPE_MAXIMUM (time_t);
7516 if (time_limit < 0 || nsecs < 0)
7517 wait = MINIMUM;
7518 else if (time_limit > 0 || nsecs > 0)
7520 wait = TIMEOUT;
7521 end_time = timespec_add (current_timespec (),
7522 make_timespec (time_limit, nsecs));
7524 else
7525 wait = INFINITY;
7527 /* Turn off periodic alarms (in case they are in use)
7528 and then turn off any other atimers,
7529 because the select emulator uses alarms. */
7530 stop_polling ();
7531 turn_on_atimers (0);
7533 while (1)
7535 bool timeout_reduced_for_timers = false;
7536 fd_set waitchannels;
7537 int xerrno;
7539 /* If calling from keyboard input, do not quit
7540 since we want to return C-g as an input character.
7541 Otherwise, do pending quit if requested. */
7542 if (read_kbd >= 0)
7543 maybe_quit ();
7545 /* Exit now if the cell we're waiting for became non-nil. */
7546 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7547 break;
7549 /* Compute time from now till when time limit is up. */
7550 /* Exit if already run out. */
7551 if (wait == TIMEOUT)
7553 struct timespec now = current_timespec ();
7554 if (timespec_cmp (end_time, now) <= 0)
7555 break;
7556 timeout = timespec_sub (end_time, now);
7558 else
7559 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7561 /* If our caller will not immediately handle keyboard events,
7562 run timer events directly.
7563 (Callers that will immediately read keyboard events
7564 call timer_delay on their own.) */
7565 if (NILP (wait_for_cell))
7567 struct timespec timer_delay;
7571 unsigned old_timers_run = timers_run;
7572 timer_delay = timer_check ();
7573 if (timers_run != old_timers_run && do_display)
7574 /* We must retry, since a timer may have requeued itself
7575 and that could alter the time delay. */
7576 redisplay_preserve_echo_area (14);
7577 else
7578 break;
7580 while (!detect_input_pending ());
7582 /* If there is unread keyboard input, also return. */
7583 if (read_kbd != 0
7584 && requeued_events_pending_p ())
7585 break;
7587 if (timespec_valid_p (timer_delay))
7589 if (timespec_cmp (timer_delay, timeout) < 0)
7591 timeout = timer_delay;
7592 timeout_reduced_for_timers = true;
7597 /* Cause C-g and alarm signals to take immediate action,
7598 and cause input available signals to zero out timeout. */
7599 if (read_kbd < 0)
7600 set_waiting_for_input (&timeout);
7602 /* If a frame has been newly mapped and needs updating,
7603 reprocess its display stuff. */
7604 if (frame_garbaged && do_display)
7606 clear_waiting_for_input ();
7607 redisplay_preserve_echo_area (15);
7608 if (read_kbd < 0)
7609 set_waiting_for_input (&timeout);
7612 /* Wait till there is something to do. */
7613 FD_ZERO (&waitchannels);
7614 if (read_kbd && detect_input_pending ())
7615 nfds = 0;
7616 else
7618 if (read_kbd || !NILP (wait_for_cell))
7619 FD_SET (0, &waitchannels);
7620 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
7623 xerrno = errno;
7625 /* Make C-g and alarm signals set flags again. */
7626 clear_waiting_for_input ();
7628 /* If we woke up due to SIGWINCH, actually change size now. */
7629 do_pending_window_change (0);
7631 if (wait < INFINITY && nfds == 0 && ! timeout_reduced_for_timers)
7632 /* We waited the full specified time, so return now. */
7633 break;
7635 if (nfds == -1)
7637 /* If the system call was interrupted, then go around the
7638 loop again. */
7639 if (xerrno == EINTR)
7640 FD_ZERO (&waitchannels);
7641 else
7642 report_file_errno ("Failed select", Qnil, xerrno);
7645 /* Check for keyboard input. */
7647 if (read_kbd
7648 && detect_input_pending_run_timers (do_display))
7650 swallow_events (do_display);
7651 if (detect_input_pending_run_timers (do_display))
7652 break;
7655 /* If there is unread keyboard input, also return. */
7656 if (read_kbd
7657 && requeued_events_pending_p ())
7658 break;
7660 /* If wait_for_cell. check for keyboard input
7661 but don't run any timers.
7662 ??? (It seems wrong to me to check for keyboard
7663 input at all when wait_for_cell, but the code
7664 has been this way since July 1994.
7665 Try changing this after version 19.31.) */
7666 if (! NILP (wait_for_cell)
7667 && detect_input_pending ())
7669 swallow_events (do_display);
7670 if (detect_input_pending ())
7671 break;
7674 /* Exit now if the cell we're waiting for became non-nil. */
7675 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7676 break;
7679 start_polling ();
7681 return -1;
7684 #endif /* not subprocesses */
7686 /* The following functions are needed even if async subprocesses are
7687 not supported. Some of them are no-op stubs in that case. */
7689 #ifdef HAVE_TIMERFD
7691 /* Add FD, which is a descriptor returned by timerfd_create,
7692 to the set of non-keyboard input descriptors. */
7694 void
7695 add_timer_wait_descriptor (int fd)
7697 add_read_fd (fd, timerfd_callback, NULL);
7698 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
7701 #endif /* HAVE_TIMERFD */
7703 /* If program file NAME starts with /: for quoting a magic
7704 name, remove that, preserving the multibyteness of NAME. */
7706 Lisp_Object
7707 remove_slash_colon (Lisp_Object name)
7709 return
7710 (SREF (name, 0) == '/' && SREF (name, 1) == ':'
7711 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
7712 SBYTES (name) - 2, STRING_MULTIBYTE (name))
7713 : name);
7716 /* Add DESC to the set of keyboard input descriptors. */
7718 void
7719 add_keyboard_wait_descriptor (int desc)
7721 #ifdef subprocesses /* Actually means "not MSDOS". */
7722 eassert (desc >= 0 && desc < FD_SETSIZE);
7723 fd_callback_info[desc].flags &= ~PROCESS_FD;
7724 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
7725 if (desc > max_desc)
7726 max_desc = desc;
7727 #endif
7730 /* From now on, do not expect DESC to give keyboard input. */
7732 void
7733 delete_keyboard_wait_descriptor (int desc)
7735 #ifdef subprocesses
7736 eassert (desc >= 0 && desc < FD_SETSIZE);
7738 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
7740 if (desc == max_desc)
7741 recompute_max_desc ();
7742 #endif
7745 /* Setup coding systems of PROCESS. */
7747 void
7748 setup_process_coding_systems (Lisp_Object process)
7750 #ifdef subprocesses
7751 struct Lisp_Process *p = XPROCESS (process);
7752 int inch = p->infd;
7753 int outch = p->outfd;
7754 Lisp_Object coding_system;
7756 if (inch < 0 || outch < 0)
7757 return;
7759 if (!proc_decode_coding_system[inch])
7760 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
7761 coding_system = p->decode_coding_system;
7762 if (EQ (p->filter, Qinternal_default_process_filter)
7763 && BUFFERP (p->buffer))
7765 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
7766 coding_system = raw_text_coding_system (coding_system);
7768 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
7770 if (!proc_encode_coding_system[outch])
7771 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
7772 setup_coding_system (p->encode_coding_system,
7773 proc_encode_coding_system[outch]);
7774 #endif
7777 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
7778 doc: /* Return the (or a) live process associated with BUFFER.
7779 BUFFER may be a buffer or the name of one.
7780 Return nil if all processes associated with BUFFER have been
7781 deleted or killed. */)
7782 (register Lisp_Object buffer)
7784 #ifdef subprocesses
7785 register Lisp_Object buf, tail, proc;
7787 if (NILP (buffer)) return Qnil;
7788 buf = Fget_buffer (buffer);
7789 if (NILP (buf)) return Qnil;
7791 FOR_EACH_PROCESS (tail, proc)
7792 if (EQ (XPROCESS (proc)->buffer, buf))
7793 return proc;
7794 #endif /* subprocesses */
7795 return Qnil;
7798 DEFUN ("process-inherit-coding-system-flag",
7799 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
7800 1, 1, 0,
7801 doc: /* Return the value of inherit-coding-system flag for PROCESS.
7802 If this flag is t, `buffer-file-coding-system' of the buffer
7803 associated with PROCESS will inherit the coding system used to decode
7804 the process output. */)
7805 (register Lisp_Object process)
7807 #ifdef subprocesses
7808 CHECK_PROCESS (process);
7809 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
7810 #else
7811 /* Ignore the argument and return the value of
7812 inherit-process-coding-system. */
7813 return inherit_process_coding_system ? Qt : Qnil;
7814 #endif
7817 /* Kill all processes associated with `buffer'.
7818 If `buffer' is nil, kill all processes. */
7820 void
7821 kill_buffer_processes (Lisp_Object buffer)
7823 #ifdef subprocesses
7824 Lisp_Object tail, proc;
7826 FOR_EACH_PROCESS (tail, proc)
7827 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
7829 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
7830 Fdelete_process (proc);
7831 else if (XPROCESS (proc)->infd >= 0)
7832 process_send_signal (proc, SIGHUP, Qnil, 1);
7834 #else /* subprocesses */
7835 /* Since we have no subprocesses, this does nothing. */
7836 #endif /* subprocesses */
7839 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
7840 Swaiting_for_user_input_p, 0, 0, 0,
7841 doc: /* Return non-nil if Emacs is waiting for input from the user.
7842 This is intended for use by asynchronous process output filters and sentinels. */)
7843 (void)
7845 #ifdef subprocesses
7846 return (waiting_for_user_input_p ? Qt : Qnil);
7847 #else
7848 return Qnil;
7849 #endif
7852 /* Stop reading input from keyboard sources. */
7854 void
7855 hold_keyboard_input (void)
7857 kbd_is_on_hold = 1;
7860 /* Resume reading input from keyboard sources. */
7862 void
7863 unhold_keyboard_input (void)
7865 kbd_is_on_hold = 0;
7868 /* Return true if keyboard input is on hold, zero otherwise. */
7870 bool
7871 kbd_on_hold_p (void)
7873 return kbd_is_on_hold;
7877 /* Enumeration of and access to system processes a-la ps(1). */
7879 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
7880 0, 0, 0,
7881 doc: /* Return a list of numerical process IDs of all running processes.
7882 If this functionality is unsupported, return nil.
7884 See `process-attributes' for getting attributes of a process given its ID. */)
7885 (void)
7887 return list_system_processes ();
7890 DEFUN ("process-attributes", Fprocess_attributes,
7891 Sprocess_attributes, 1, 1, 0,
7892 doc: /* Return attributes of the process given by its PID, a number.
7894 Value is an alist where each element is a cons cell of the form
7896 (KEY . VALUE)
7898 If this functionality is unsupported, the value is nil.
7900 See `list-system-processes' for getting a list of all process IDs.
7902 The KEYs of the attributes that this function may return are listed
7903 below, together with the type of the associated VALUE (in parentheses).
7904 Not all platforms support all of these attributes; unsupported
7905 attributes will not appear in the returned alist.
7906 Unless explicitly indicated otherwise, numbers can have either
7907 integer or floating point values.
7909 euid -- Effective user User ID of the process (number)
7910 user -- User name corresponding to euid (string)
7911 egid -- Effective user Group ID of the process (number)
7912 group -- Group name corresponding to egid (string)
7913 comm -- Command name (executable name only) (string)
7914 state -- Process state code, such as "S", "R", or "T" (string)
7915 ppid -- Parent process ID (number)
7916 pgrp -- Process group ID (number)
7917 sess -- Session ID, i.e. process ID of session leader (number)
7918 ttname -- Controlling tty name (string)
7919 tpgid -- ID of foreground process group on the process's tty (number)
7920 minflt -- number of minor page faults (number)
7921 majflt -- number of major page faults (number)
7922 cminflt -- cumulative number of minor page faults (number)
7923 cmajflt -- cumulative number of major page faults (number)
7924 utime -- user time used by the process, in (current-time) format,
7925 which is a list of integers (HIGH LOW USEC PSEC)
7926 stime -- system time used by the process (current-time)
7927 time -- sum of utime and stime (current-time)
7928 cutime -- user time used by the process and its children (current-time)
7929 cstime -- system time used by the process and its children (current-time)
7930 ctime -- sum of cutime and cstime (current-time)
7931 pri -- priority of the process (number)
7932 nice -- nice value of the process (number)
7933 thcount -- process thread count (number)
7934 start -- time the process started (current-time)
7935 vsize -- virtual memory size of the process in KB's (number)
7936 rss -- resident set size of the process in KB's (number)
7937 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7938 pcpu -- percents of CPU time used by the process (floating-point number)
7939 pmem -- percents of total physical memory used by process's resident set
7940 (floating-point number)
7941 args -- command line which invoked the process (string). */)
7942 ( Lisp_Object pid)
7944 return system_process_attributes (pid);
7947 #ifdef subprocesses
7948 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7949 Invoke this after init_process_emacs, and after glib and/or GNUstep
7950 futz with the SIGCHLD handler, but before Emacs forks any children.
7951 This function's caller should block SIGCHLD. */
7953 void
7954 catch_child_signal (void)
7956 struct sigaction action, old_action;
7957 sigset_t oldset;
7958 emacs_sigaction_init (&action, deliver_child_signal);
7959 block_child_signal (&oldset);
7960 sigaction (SIGCHLD, &action, &old_action);
7961 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7962 || ! (old_action.sa_flags & SA_SIGINFO));
7964 if (old_action.sa_handler != deliver_child_signal)
7965 lib_child_handler
7966 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
7967 ? dummy_handler
7968 : old_action.sa_handler);
7969 unblock_child_signal (&oldset);
7971 #endif /* subprocesses */
7973 /* Limit the number of open files to the value it had at startup. */
7975 void
7976 restore_nofile_limit (void)
7978 #ifdef HAVE_SETRLIMIT
7979 if (FD_SETSIZE < nofile_limit.rlim_cur)
7980 setrlimit (RLIMIT_NOFILE, &nofile_limit);
7981 #endif
7985 /* This is not called "init_process" because that is the name of a
7986 Mach system call, so it would cause problems on Darwin systems. */
7987 void
7988 init_process_emacs (int sockfd)
7990 #ifdef subprocesses
7991 int i;
7993 inhibit_sentinels = 0;
7995 #ifndef CANNOT_DUMP
7996 if (! noninteractive || initialized)
7997 #endif
7999 #if defined HAVE_GLIB && !defined WINDOWSNT
8000 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
8001 this should always fail, but is enough to initialize glib's
8002 private SIGCHLD handler, allowing catch_child_signal to copy
8003 it into lib_child_handler. */
8004 g_source_unref (g_child_watch_source_new (getpid ()));
8005 #endif
8006 catch_child_signal ();
8009 #ifdef HAVE_SETRLIMIT
8010 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8011 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
8012 nofile_limit.rlim_cur = 0;
8013 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8015 struct rlimit rlim = nofile_limit;
8016 rlim.rlim_cur = FD_SETSIZE;
8017 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8018 nofile_limit.rlim_cur = 0;
8020 #endif
8022 external_sock_fd = sockfd;
8023 max_desc = -1;
8024 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8026 num_pending_connects = 0;
8028 process_output_delay_count = 0;
8029 process_output_skip = 0;
8031 /* Don't do this, it caused infinite select loops. The display
8032 method should call add_keyboard_wait_descriptor on stdin if it
8033 needs that. */
8034 #if 0
8035 FD_SET (0, &input_wait_mask);
8036 #endif
8038 Vprocess_alist = Qnil;
8039 deleted_pid_list = Qnil;
8040 for (i = 0; i < FD_SETSIZE; i++)
8042 chan_process[i] = Qnil;
8043 proc_buffered_char[i] = -1;
8045 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8046 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8047 #ifdef DATAGRAM_SOCKETS
8048 memset (datagram_address, 0, sizeof datagram_address);
8049 #endif
8051 #if defined (DARWIN_OS)
8052 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8053 processes. As such, we only change the default value. */
8054 if (initialized)
8056 char const *release = (STRINGP (Voperating_system_release)
8057 ? SSDATA (Voperating_system_release)
8058 : 0);
8059 if (!release || !release[0] || (release[0] < '7' && release[1] == '.')) {
8060 Vprocess_connection_type = Qnil;
8063 #endif
8064 #endif /* subprocesses */
8065 kbd_is_on_hold = 0;
8068 void
8069 syms_of_process (void)
8071 #ifdef subprocesses
8073 DEFSYM (Qprocessp, "processp");
8074 DEFSYM (Qrun, "run");
8075 DEFSYM (Qstop, "stop");
8076 DEFSYM (Qsignal, "signal");
8078 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8079 here again. */
8081 DEFSYM (Qopen, "open");
8082 DEFSYM (Qclosed, "closed");
8083 DEFSYM (Qconnect, "connect");
8084 DEFSYM (Qfailed, "failed");
8085 DEFSYM (Qlisten, "listen");
8086 DEFSYM (Qlocal, "local");
8087 DEFSYM (Qipv4, "ipv4");
8088 #ifdef AF_INET6
8089 DEFSYM (Qipv6, "ipv6");
8090 #endif
8091 DEFSYM (Qdatagram, "datagram");
8092 DEFSYM (Qseqpacket, "seqpacket");
8094 DEFSYM (QCport, ":port");
8095 DEFSYM (QCspeed, ":speed");
8096 DEFSYM (QCprocess, ":process");
8098 DEFSYM (QCbytesize, ":bytesize");
8099 DEFSYM (QCstopbits, ":stopbits");
8100 DEFSYM (QCparity, ":parity");
8101 DEFSYM (Qodd, "odd");
8102 DEFSYM (Qeven, "even");
8103 DEFSYM (QCflowcontrol, ":flowcontrol");
8104 DEFSYM (Qhw, "hw");
8105 DEFSYM (Qsw, "sw");
8106 DEFSYM (QCsummary, ":summary");
8108 DEFSYM (Qreal, "real");
8109 DEFSYM (Qnetwork, "network");
8110 DEFSYM (Qserial, "serial");
8111 DEFSYM (QCbuffer, ":buffer");
8112 DEFSYM (QChost, ":host");
8113 DEFSYM (QCservice, ":service");
8114 DEFSYM (QClocal, ":local");
8115 DEFSYM (QCremote, ":remote");
8116 DEFSYM (QCcoding, ":coding");
8117 DEFSYM (QCserver, ":server");
8118 DEFSYM (QCnowait, ":nowait");
8119 DEFSYM (QCsentinel, ":sentinel");
8120 DEFSYM (QCuse_external_socket, ":use-external-socket");
8121 DEFSYM (QCtls_parameters, ":tls-parameters");
8122 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8123 DEFSYM (QClog, ":log");
8124 DEFSYM (QCnoquery, ":noquery");
8125 DEFSYM (QCstop, ":stop");
8126 DEFSYM (QCplist, ":plist");
8127 DEFSYM (QCcommand, ":command");
8128 DEFSYM (QCconnection_type, ":connection-type");
8129 DEFSYM (QCstderr, ":stderr");
8130 DEFSYM (Qpty, "pty");
8131 DEFSYM (Qpipe, "pipe");
8133 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8135 staticpro (&Vprocess_alist);
8136 staticpro (&deleted_pid_list);
8138 #endif /* subprocesses */
8140 DEFSYM (QCname, ":name");
8141 DEFSYM (QCtype, ":type");
8143 DEFSYM (Qeuid, "euid");
8144 DEFSYM (Qegid, "egid");
8145 DEFSYM (Quser, "user");
8146 DEFSYM (Qgroup, "group");
8147 DEFSYM (Qcomm, "comm");
8148 DEFSYM (Qstate, "state");
8149 DEFSYM (Qppid, "ppid");
8150 DEFSYM (Qpgrp, "pgrp");
8151 DEFSYM (Qsess, "sess");
8152 DEFSYM (Qttname, "ttname");
8153 DEFSYM (Qtpgid, "tpgid");
8154 DEFSYM (Qminflt, "minflt");
8155 DEFSYM (Qmajflt, "majflt");
8156 DEFSYM (Qcminflt, "cminflt");
8157 DEFSYM (Qcmajflt, "cmajflt");
8158 DEFSYM (Qutime, "utime");
8159 DEFSYM (Qstime, "stime");
8160 DEFSYM (Qtime, "time");
8161 DEFSYM (Qcutime, "cutime");
8162 DEFSYM (Qcstime, "cstime");
8163 DEFSYM (Qctime, "ctime");
8164 #ifdef subprocesses
8165 DEFSYM (Qinternal_default_process_sentinel,
8166 "internal-default-process-sentinel");
8167 DEFSYM (Qinternal_default_process_filter,
8168 "internal-default-process-filter");
8169 #endif
8170 DEFSYM (Qpri, "pri");
8171 DEFSYM (Qnice, "nice");
8172 DEFSYM (Qthcount, "thcount");
8173 DEFSYM (Qstart, "start");
8174 DEFSYM (Qvsize, "vsize");
8175 DEFSYM (Qrss, "rss");
8176 DEFSYM (Qetime, "etime");
8177 DEFSYM (Qpcpu, "pcpu");
8178 DEFSYM (Qpmem, "pmem");
8179 DEFSYM (Qargs, "args");
8181 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8182 doc: /* Non-nil means delete processes immediately when they exit.
8183 A value of nil means don't delete them until `list-processes' is run. */);
8185 delete_exited_processes = 1;
8187 #ifdef subprocesses
8188 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8189 doc: /* Control type of device used to communicate with subprocesses.
8190 Values are nil to use a pipe, or t or `pty' to use a pty.
8191 The value has no effect if the system has no ptys or if all ptys are busy:
8192 then a pipe is used in any case.
8193 The value takes effect when `start-process' is called. */);
8194 Vprocess_connection_type = Qt;
8196 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8197 doc: /* If non-nil, improve receive buffering by delaying after short reads.
8198 On some systems, when Emacs reads the output from a subprocess, the output data
8199 is read in very small blocks, potentially resulting in very poor performance.
8200 This behavior can be remedied to some extent by setting this variable to a
8201 non-nil value, as it will automatically delay reading from such processes, to
8202 allow them to produce more output before Emacs tries to read it.
8203 If the value is t, the delay is reset after each write to the process; any other
8204 non-nil value means that the delay is not reset on write.
8205 The variable takes effect when `start-process' is called. */);
8206 Vprocess_adaptive_read_buffering = Qt;
8208 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8209 doc: /* List of functions to be called for `interrupt-process'.
8210 The arguments of the functions are the same as for `interrupt-process'.
8211 These functions are called in the order of the list, until one of them
8212 returns non-`nil'. */);
8213 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8215 DEFSYM (Qinternal_default_interrupt_process,
8216 "internal-default-interrupt-process");
8217 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8219 defsubr (&Sprocessp);
8220 defsubr (&Sget_process);
8221 defsubr (&Sdelete_process);
8222 defsubr (&Sprocess_status);
8223 defsubr (&Sprocess_exit_status);
8224 defsubr (&Sprocess_id);
8225 defsubr (&Sprocess_name);
8226 defsubr (&Sprocess_tty_name);
8227 defsubr (&Sprocess_command);
8228 defsubr (&Sset_process_buffer);
8229 defsubr (&Sprocess_buffer);
8230 defsubr (&Sprocess_mark);
8231 defsubr (&Sset_process_filter);
8232 defsubr (&Sprocess_filter);
8233 defsubr (&Sset_process_sentinel);
8234 defsubr (&Sprocess_sentinel);
8235 defsubr (&Sset_process_thread);
8236 defsubr (&Sprocess_thread);
8237 defsubr (&Sset_process_window_size);
8238 defsubr (&Sset_process_inherit_coding_system_flag);
8239 defsubr (&Sset_process_query_on_exit_flag);
8240 defsubr (&Sprocess_query_on_exit_flag);
8241 defsubr (&Sprocess_contact);
8242 defsubr (&Sprocess_plist);
8243 defsubr (&Sset_process_plist);
8244 defsubr (&Sprocess_list);
8245 defsubr (&Smake_process);
8246 defsubr (&Smake_pipe_process);
8247 defsubr (&Sserial_process_configure);
8248 defsubr (&Smake_serial_process);
8249 defsubr (&Sset_network_process_option);
8250 defsubr (&Smake_network_process);
8251 defsubr (&Sformat_network_address);
8252 defsubr (&Snetwork_interface_list);
8253 defsubr (&Snetwork_interface_info);
8254 #ifdef DATAGRAM_SOCKETS
8255 defsubr (&Sprocess_datagram_address);
8256 defsubr (&Sset_process_datagram_address);
8257 #endif
8258 defsubr (&Saccept_process_output);
8259 defsubr (&Sprocess_send_region);
8260 defsubr (&Sprocess_send_string);
8261 defsubr (&Sinternal_default_interrupt_process);
8262 defsubr (&Sinterrupt_process);
8263 defsubr (&Skill_process);
8264 defsubr (&Squit_process);
8265 defsubr (&Sstop_process);
8266 defsubr (&Scontinue_process);
8267 defsubr (&Sprocess_running_child_p);
8268 defsubr (&Sprocess_send_eof);
8269 defsubr (&Ssignal_process);
8270 defsubr (&Swaiting_for_user_input_p);
8271 defsubr (&Sprocess_type);
8272 defsubr (&Sinternal_default_process_sentinel);
8273 defsubr (&Sinternal_default_process_filter);
8274 defsubr (&Sset_process_coding_system);
8275 defsubr (&Sprocess_coding_system);
8276 defsubr (&Sset_process_filter_multibyte);
8277 defsubr (&Sprocess_filter_multibyte_p);
8280 Lisp_Object subfeatures = Qnil;
8281 const struct socket_options *sopt;
8283 #define ADD_SUBFEATURE(key, val) \
8284 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8286 ADD_SUBFEATURE (QCnowait, Qt);
8287 #ifdef DATAGRAM_SOCKETS
8288 ADD_SUBFEATURE (QCtype, Qdatagram);
8289 #endif
8290 #ifdef HAVE_SEQPACKET
8291 ADD_SUBFEATURE (QCtype, Qseqpacket);
8292 #endif
8293 #ifdef HAVE_LOCAL_SOCKETS
8294 ADD_SUBFEATURE (QCfamily, Qlocal);
8295 #endif
8296 ADD_SUBFEATURE (QCfamily, Qipv4);
8297 #ifdef AF_INET6
8298 ADD_SUBFEATURE (QCfamily, Qipv6);
8299 #endif
8300 #ifdef HAVE_GETSOCKNAME
8301 ADD_SUBFEATURE (QCservice, Qt);
8302 #endif
8303 ADD_SUBFEATURE (QCserver, Qt);
8305 for (sopt = socket_options; sopt->name; sopt++)
8306 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8308 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8311 #endif /* subprocesses */
8313 defsubr (&Sget_buffer_process);
8314 defsubr (&Sprocess_inherit_coding_system_flag);
8315 defsubr (&Slist_system_processes);
8316 defsubr (&Sprocess_attributes);