root/src/process.c

DEFINITIONS

1. would_block
2. close_on_exec
3. accept4
4. process_socket
5. pset_buffer
6. pset_command
7. pset_decode_coding_system
8. pset_decoding_buf
9. pset_encode_coding_system
10. pset_encoding_buf
11. pset_filter
12. pset_log
13. pset_mark
14. pset_thread
15. pset_name
16. pset_plist
17. pset_sentinel
18. pset_tty_name
19. pset_type
20. pset_write_queue
21. pset_stderrproc
22. make_lisp_proc
23. add_read_fd
24. add_non_keyboard_read_fd
25. add_process_read_fd
26. delete_read_fd
27. add_write_fd
28. add_non_blocking_write_fd
29. recompute_max_desc
30. delete_write_fd
31. compute_input_wait_mask
32. compute_non_process_wait_mask
33. compute_non_keyboard_wait_mask
34. compute_write_mask
35. clear_waiting_thread_info
36. kbd_is_ours
37. update_status
38. status_convert
39. connecting_status
40. decode_status
41. status_message
42. allocate_pty
43. allocate_process
44. make_process
45. remove_process
46. update_processes_for_thread_death
47. free_dns_request
48. DEFUN
49. DEFUN
50. get_process
51. record_deleted_pid
52. DEFUN
53. DEFUN
54. DEFUN
55. DEFUN
56. DEFUN
57. DEFUN
58. update_process_mark
59. DEFUN
60. DEFUN
61. set_process_filter_masks
62. is_pty_from_symbol
63. DEFUN
64. DEFUN
65. DEFUN
66. DEFUN
67. DEFUN
68. DEFUN
69. DEFUN
70. DEFUN
71. start_process_unwind
72. close_process_fd
73. dissociate_controlling_tty
74. create_process
75. create_pty
76. conv_sockaddr_to_lisp
77. conv_addrinfo_to_lisp
78. get_lisp_to_sockaddr_size
79. conv_lisp_to_sockaddr
80. DEFUN
81. set_socket_option
82. set_network_socket_coding_system
83. finish_after_tls_connection
84. connect_network_socket
85. network_interface_list
86. network_interface_info
87. DEFUN
88. network_lookup_address_info_1
89. deactivate_process
90. server_accept_connection
91. check_for_dns
92. wait_for_socket_fds
93. wait_while_connecting
94. wait_for_tls_negotiation
95. wait_reading_process_output_unwind
96. wait_reading_process_output_1
97. wait_reading_process_output
98. read_process_output_call
99. read_process_output_error_handler
100. read_process_output
101. read_and_dispose_of_process_output
102. write_queue_push
103. write_queue_pop
104. send_process
105. emacs_get_tty_pgrp
106. DEFUN
107. process_send_signal
108. abbr_to_signal
109. DEFUN
110. child_signal_init
111. child_signal_read
112. child_signal_notify
113. dummy_handler
114. handle_child_signal
115. deliver_child_signal
116. exec_sentinel_error_handler
117. exec_sentinel
118. status_notify
119. DEFUN
120. add_gpm_wait_descriptor
121. delete_gpm_wait_descriptor
122. keyboard_bit_set
123. update_processes_for_thread_death
124. wait_reading_process_output
125. add_timer_wait_descriptor
126. remove_slash_colon
127. add_keyboard_wait_descriptor
128. delete_keyboard_wait_descriptor
129. setup_process_coding_systems
130. DEFUN
131. DEFUN
132. kill_buffer_processes
133. DEFUN
134. hold_keyboard_input
135. unhold_keyboard_input
136. kbd_on_hold_p
137. DEFUN
138. DEFUN
139. DEFUN
140. DEFUN
141. catch_child_signal
142. restore_nofile_limit
143. open_channel_for_module
144. init_process_emacs
145. syms_of_process

     1 /* Asynchronous subprocess control for GNU Emacs.
     2 
     3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2023 Free Software
     4 Foundation, Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     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.
    12 
    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.
    17 
    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/>.  */
    20 
    21 
    22 #include <config.h>
    23 
    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>
    32 
    33 #include "lisp.h"
    34 
    35 /* Only MS-DOS does not define `subprocesses'.  */
    36 #ifdef subprocesses
    37 
    38 #include <sys/socket.h>
    39 #include <netdb.h>
    40 #include <netinet/in.h>
    41 #include <arpa/inet.h>
    42 
    43 #else
    44 #define PIPECONN_P(p) false
    45 #define PIPECONN1_P(p) false
    46 #endif
    47 
    48 #ifdef HAVE_SETRLIMIT
    49 # include <sys/resource.h>
    50 
    51 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
    52    NOFILE_LIMIT is the initial limit on the number of open files,
    53    which should be restored in child processes.  */
    54 static struct rlimit nofile_limit;
    55 #endif
    56 
    57 #ifdef subprocesses
    58 
    59 /* Are local (unix) sockets supported?  */
    60 #if defined (HAVE_SYS_UN_H)
    61 #if !defined (AF_LOCAL) && defined (AF_UNIX)
    62 #define AF_LOCAL AF_UNIX
    63 #endif
    64 #ifdef AF_LOCAL
    65 #define HAVE_LOCAL_SOCKETS
    66 #include <sys/un.h>
    67 #endif
    68 #endif
    69 
    70 #include <sys/ioctl.h>
    71 #if defined (HAVE_NET_IF_H)
    72 #include <net/if.h>
    73 #endif /* HAVE_NET_IF_H */
    74 
    75 #if defined (HAVE_IFADDRS_H)
    76 /* Must be after net/if.h */
    77 #include <ifaddrs.h>
    78 
    79 /* We only use structs from this header when we use getifaddrs.  */
    80 #if defined (HAVE_NET_IF_DL_H)
    81 #include <net/if_dl.h>
    82 #endif
    83 
    84 #endif
    85 
    86 #ifdef HAVE_UTIL_H
    87 #include <util.h>
    88 #endif
    89 
    90 #ifdef HAVE_PTY_H
    91 #include <pty.h>
    92 #endif
    93 
    94 #include <c-ctype.h>
    95 #include <flexmember.h>
    96 #include <nproc.h>
    97 #include <sig2str.h>
    98 #include <verify.h>
    99 
   100 #endif  /* subprocesses */
   101 
   102 #include "systime.h"
   103 #include "systty.h"
   104 
   105 #include "window.h"
   106 #include "character.h"
   107 #include "buffer.h"
   108 #include "coding.h"
   109 #include "process.h"
   110 #include "frame.h"
   111 #include "termopts.h"
   112 #include "keyboard.h"
   113 #include "blockinput.h"
   114 #include "atimer.h"
   115 #include "sysselect.h"
   116 #include "syssignal.h"
   117 #include "syswait.h"
   118 #ifdef HAVE_GNUTLS
   119 #include "gnutls.h"
   120 #endif
   121 
   122 #ifdef HAVE_WINDOW_SYSTEM
   123 #include TERM_HEADER
   124 #endif /* HAVE_WINDOW_SYSTEM */
   125 
   126 #ifdef HAVE_GLIB
   127 #include "xgselect.h"
   128 #ifndef WINDOWSNT
   129 #include <glib.h>
   130 #endif
   131 #endif
   132 
   133 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
   134 /* This is 0.1s in nanoseconds. */
   135 #define ASYNC_RETRY_NSEC 100000000
   136 #endif
   137 
   138 #ifdef WINDOWSNT
   139 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
   140                        const struct timespec *, const sigset_t *);
   141 #endif
   142 
   143 /* Work around GCC 4.3.0 bug with strict overflow checking; see
   144    <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
   145    This bug appears to be fixed in GCC 5.1, so don't work around it there.  */
   146 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
   147 # pragma GCC diagnostic ignored "-Wstrict-overflow"
   148 #endif
   149 
   150 /* True if keyboard input is on hold, zero otherwise.  */
   151 
   152 static bool kbd_is_on_hold;
   153 
   154 /* Nonzero means don't run process sentinels.  This is used
   155    when exiting.  */
   156 bool inhibit_sentinels;
   157 
   158 #ifdef subprocesses
   159 union u_sockaddr
   160 {
   161   struct sockaddr sa;
   162   struct sockaddr_in in;
   163 #ifdef AF_INET6
   164   struct sockaddr_in6 in6;
   165 #endif
   166 #ifdef HAVE_LOCAL_SOCKETS
   167   struct sockaddr_un un;
   168 #endif
   169 };
   170 
   171 #ifndef SOCK_CLOEXEC
   172 # define SOCK_CLOEXEC 0
   173 #endif
   174 #ifndef SOCK_NONBLOCK
   175 # define SOCK_NONBLOCK 0
   176 #endif
   177 
   178 /* True if ERRNUM represents an error where the system call would
   179    block if a blocking variant were used.  */
   180 static bool
   181 would_block (int errnum)
   182 {
   183 #ifdef EWOULDBLOCK
   184   if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
   185     return true;
   186 #endif
   187   return errnum == EAGAIN;
   188 }
   189 
   190 #ifndef HAVE_ACCEPT4
   191 
   192 /* Emulate GNU/Linux accept4 and socket well enough for this module.  */
   193 
   194 static int
   195 close_on_exec (int fd)
   196 {
   197   if (0 <= fd)
   198     fcntl (fd, F_SETFD, FD_CLOEXEC);
   199   return fd;
   200 }
   201 
   202 # undef accept4
   203 # define accept4(sockfd, addr, addrlen, flags) \
   204     process_accept4 (sockfd, addr, addrlen, flags)
   205 static int
   206 accept4 (int sockfd, struct sockaddr *addr, socklen_t *addrlen, int flags)
   207 {
   208   return close_on_exec (accept (sockfd, addr, addrlen));
   209 }
   210 
   211 static int
   212 process_socket (int domain, int type, int protocol)
   213 {
   214   return close_on_exec (socket (domain, type, protocol));
   215 }
   216 # undef socket
   217 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
   218 #endif
   219 
   220 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
   221 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
   222 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
   223 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
   224 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
   225 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
   226 
   227 /* Number of events of change of status of a process.  */
   228 static EMACS_INT process_tick;
   229 /* Number of events for which the user or sentinel has been notified.  */
   230 static EMACS_INT update_tick;
   231 
   232 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
   233    this system.  We need to read full packets, so we need a
   234    "non-destructive" select.  So we require either native select,
   235    or emulation of select using FIONREAD.  */
   236 
   237 #ifndef BROKEN_DATAGRAM_SOCKETS
   238 # if defined HAVE_SELECT || defined USABLE_FIONREAD
   239 #  if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
   240 #   define DATAGRAM_SOCKETS
   241 #  endif
   242 # endif
   243 #endif
   244 
   245 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
   246 # define HAVE_SEQPACKET
   247 #endif
   248 
   249 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_HZ / 100)
   250 #define READ_OUTPUT_DELAY_MAX       (READ_OUTPUT_DELAY_INCREMENT * 5)
   251 #define READ_OUTPUT_DELAY_MAX_MAX   (READ_OUTPUT_DELAY_INCREMENT * 7)
   252 
   253 /* Number of processes which have a non-zero read_output_delay,
   254    and therefore might be delayed for adaptive read buffering.  */
   255 
   256 static int process_output_delay_count;
   257 
   258 /* True if any process has non-nil read_output_skip.  */
   259 
   260 static bool process_output_skip;
   261 
   262 static void start_process_unwind (Lisp_Object);
   263 static void create_process (Lisp_Object, char **, Lisp_Object);
   264 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
   265 static bool keyboard_bit_set (fd_set *);
   266 #endif
   267 static void deactivate_process (Lisp_Object);
   268 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
   269 static int read_process_output (Lisp_Object, int);
   270 static void create_pty (Lisp_Object);
   271 static void exec_sentinel (Lisp_Object, Lisp_Object);
   272 
   273 static Lisp_Object
   274 network_lookup_address_info_1 (Lisp_Object host, const char *service,
   275                                struct addrinfo *hints, struct addrinfo **res);
   276 
   277 /* Number of bits set in connect_wait_mask.  */
   278 static int num_pending_connects;
   279 
   280 /* The largest descriptor currently in use; -1 if none.  */
   281 static int max_desc;
   282 
   283 /* Set the external socket descriptor for Emacs to use when
   284    `make-network-process' is called with a non-nil
   285    `:use-external-socket' option.  The value should be either -1, or
   286    the file descriptor of a socket that is already bound.  */
   287 static int external_sock_fd;
   288 
   289 /* File descriptor that becomes readable when we receive SIGCHLD.  */
   290 static int child_signal_read_fd = -1;
   291 /* The write end thereof.  The SIGCHLD handler writes to this file
   292    descriptor to notify `wait_reading_process_output' of process
   293    status changes.  */
   294 static int child_signal_write_fd = -1;
   295 #ifndef WINDOWSNT
   296 static void child_signal_read (int, void *);
   297 #endif
   298 static void child_signal_notify (void);
   299 
   300 /* Indexed by descriptor, gives the process (if any) for that descriptor.  */
   301 static Lisp_Object chan_process[FD_SETSIZE];
   302 static void wait_for_socket_fds (Lisp_Object, char const *);
   303 
   304 /* Alist of elements (NAME . PROCESS).  */
   305 static Lisp_Object Vprocess_alist;
   306 
   307 /* Buffered-ahead input char from process, indexed by channel.
   308    -1 means empty (no char is buffered).
   309    Used on sys V where the only way to tell if there is any
   310    output from the process is to read at least one char.
   311    Always -1 on systems that support FIONREAD.  */
   312 
   313 static int proc_buffered_char[FD_SETSIZE];
   314 
   315 /* Table of `struct coding-system' for each process.  */
   316 static struct coding_system *proc_decode_coding_system[FD_SETSIZE];
   317 static struct coding_system *proc_encode_coding_system[FD_SETSIZE];
   318 
   319 #ifdef DATAGRAM_SOCKETS
   320 /* Table of `partner address' for datagram sockets.  */
   321 static struct sockaddr_and_len {
   322   struct sockaddr *sa;
   323   ptrdiff_t len;
   324 } datagram_address[FD_SETSIZE];
   325 #define DATAGRAM_CHAN_P(chan)   (datagram_address[chan].sa != 0)
   326 #define DATAGRAM_CONN_P(proc)                                           \
   327   (PROCESSP (proc) &&                                                   \
   328    XPROCESS (proc)->infd >= 0 &&                                        \
   329    datagram_address[XPROCESS (proc)->infd].sa != 0)
   330 #else
   331 #define DATAGRAM_CONN_P(proc)   (0)
   332 #endif
   333 
   334 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
   335    a `for' loop which iterates over processes from Vprocess_alist.  */
   336 
   337 #define FOR_EACH_PROCESS(list_var, proc_var)                    \
   338   FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
   339 
   340 /* These setters are used only in this file, so they can be private.  */
   341 static void
   342 pset_buffer (struct Lisp_Process *p, Lisp_Object val)
   343 {
   344   p->buffer = val;
   345 }
   346 static void
   347 pset_command (struct Lisp_Process *p, Lisp_Object val)
   348 {
   349   p->command = val;
   350 }
   351 static void
   352 pset_decode_coding_system (struct Lisp_Process *p, Lisp_Object val)
   353 {
   354   p->decode_coding_system = val;
   355 }
   356 static void
   357 pset_decoding_buf (struct Lisp_Process *p, Lisp_Object val)
   358 {
   359   p->decoding_buf = val;
   360 }
   361 static void
   362 pset_encode_coding_system (struct Lisp_Process *p, Lisp_Object val)
   363 {
   364   p->encode_coding_system = val;
   365 }
   366 static void
   367 pset_encoding_buf (struct Lisp_Process *p, Lisp_Object val)
   368 {
   369   p->encoding_buf = val;
   370 }
   371 static void
   372 pset_filter (struct Lisp_Process *p, Lisp_Object val)
   373 {
   374   p->filter = NILP (val) ? Qinternal_default_process_filter : val;
   375 }
   376 static void
   377 pset_log (struct Lisp_Process *p, Lisp_Object val)
   378 {
   379   p->log = val;
   380 }
   381 static void
   382 pset_mark (struct Lisp_Process *p, Lisp_Object val)
   383 {
   384   p->mark = val;
   385 }
   386 static void
   387 pset_thread (struct Lisp_Process *p, Lisp_Object val)
   388 {
   389   p->thread = val;
   390 }
   391 static void
   392 pset_name (struct Lisp_Process *p, Lisp_Object val)
   393 {
   394   p->name = val;
   395 }
   396 static void
   397 pset_plist (struct Lisp_Process *p, Lisp_Object val)
   398 {
   399   p->plist = val;
   400 }
   401 static void
   402 pset_sentinel (struct Lisp_Process *p, Lisp_Object val)
   403 {
   404   p->sentinel = NILP (val) ? Qinternal_default_process_sentinel : val;
   405 }
   406 static void
   407 pset_tty_name (struct Lisp_Process *p, Lisp_Object val)
   408 {
   409   p->tty_name = val;
   410 }
   411 static void
   412 pset_type (struct Lisp_Process *p, Lisp_Object val)
   413 {
   414   p->type = val;
   415 }
   416 static void
   417 pset_write_queue (struct Lisp_Process *p, Lisp_Object val)
   418 {
   419   p->write_queue = val;
   420 }
   421 static void
   422 pset_stderrproc (struct Lisp_Process *p, Lisp_Object val)
   423 {
   424   p->stderrproc = val;
   425 }
   426 
   427 
   428 static Lisp_Object
   429 make_lisp_proc (struct Lisp_Process *p)
   430 {
   431   return make_lisp_ptr (p, Lisp_Vectorlike);
   432 }
   433 
   434 enum fd_bits
   435 {
   436   /* Read from file descriptor.  */
   437   FOR_READ = 1,
   438   /* Write to file descriptor.  */
   439   FOR_WRITE = 2,
   440   /* This descriptor refers to a keyboard.  Only valid if FOR_READ is
   441      set.  */
   442   KEYBOARD_FD = 4,
   443   /* This descriptor refers to a process.  */
   444   PROCESS_FD = 8,
   445   /* A non-blocking connect.  Only valid if FOR_WRITE is set.  */
   446   NON_BLOCKING_CONNECT_FD = 16
   447 };
   448 
   449 static struct fd_callback_data
   450 {
   451   fd_callback func;
   452   void *data;
   453   /* Flags from enum fd_bits.  */
   454   int flags;
   455   /* If this fd is locked to a certain thread, this points to it.
   456      Otherwise, this is NULL.  If an fd is locked to a thread, then
   457      only that thread is permitted to wait on it.  */
   458   struct thread_state *thread;
   459   /* If this fd is currently being selected on by a thread, this
   460      points to the thread.  Otherwise it is NULL.  */
   461   struct thread_state *waiting_thread;
   462 } fd_callback_info[FD_SETSIZE];
   463 
   464 
   465 /* Add a file descriptor FD to be monitored for when read is possible.
   466    When read is possible, call FUNC with argument DATA.  */
   467 
   468 void
   469 add_read_fd (int fd, fd_callback func, void *data)
   470 {
   471   add_keyboard_wait_descriptor (fd);
   472 
   473   eassert (0 <= fd && fd < FD_SETSIZE);
   474   fd_callback_info[fd].func = func;
   475   fd_callback_info[fd].data = data;
   476 }
   477 
   478 void
   479 add_non_keyboard_read_fd (int fd, fd_callback func, void *data)
   480 {
   481   add_read_fd(fd, func, data);
   482   fd_callback_info[fd].flags &= ~KEYBOARD_FD;
   483 }
   484 
   485 static void
   486 add_process_read_fd (int fd)
   487 {
   488   eassert (fd >= 0 && fd < FD_SETSIZE);
   489   eassert (fd_callback_info[fd].func == NULL);
   490 
   491   fd_callback_info[fd].flags &= ~KEYBOARD_FD;
   492   fd_callback_info[fd].flags |= FOR_READ;
   493   if (fd > max_desc)
   494     max_desc = fd;
   495   eassert (0 <= fd && fd < FD_SETSIZE);
   496   fd_callback_info[fd].flags |= PROCESS_FD;
   497 }
   498 
   499 /* Stop monitoring file descriptor FD for when read is possible.  */
   500 
   501 void
   502 delete_read_fd (int fd)
   503 {
   504   delete_keyboard_wait_descriptor (fd);
   505 
   506   eassert (0 <= fd && fd < FD_SETSIZE);
   507   if (fd_callback_info[fd].flags == 0)
   508     {
   509       fd_callback_info[fd].func = 0;
   510       fd_callback_info[fd].data = 0;
   511     }
   512 }
   513 
   514 /* Add a file descriptor FD to be monitored for when write is possible.
   515    When write is possible, call FUNC with argument DATA.  */
   516 
   517 void
   518 add_write_fd (int fd, fd_callback func, void *data)
   519 {
   520   eassert (fd >= 0 && fd < FD_SETSIZE);
   521 
   522   fd_callback_info[fd].func = func;
   523   fd_callback_info[fd].data = data;
   524   fd_callback_info[fd].flags |= FOR_WRITE;
   525   if (fd > max_desc)
   526     max_desc = fd;
   527 }
   528 
   529 static void
   530 add_non_blocking_write_fd (int fd)
   531 {
   532   eassert (fd >= 0 && fd < FD_SETSIZE);
   533   eassert (fd_callback_info[fd].func == NULL);
   534 
   535   fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
   536   if (fd > max_desc)
   537     max_desc = fd;
   538   ++num_pending_connects;
   539 }
   540 
   541 static void
   542 recompute_max_desc (void)
   543 {
   544   int fd;
   545 
   546   eassert (max_desc < FD_SETSIZE);
   547   for (fd = max_desc; fd >= 0; --fd)
   548     {
   549       if (fd_callback_info[fd].flags != 0)
   550         {
   551           max_desc = fd;
   552           break;
   553         }
   554     }
   555   eassert (max_desc < FD_SETSIZE);
   556 }
   557 
   558 /* Stop monitoring file descriptor FD for when write is possible.  */
   559 
   560 void
   561 delete_write_fd (int fd)
   562 {
   563   eassert (0 <= fd && fd < FD_SETSIZE);
   564   if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
   565     {
   566       if (--num_pending_connects < 0)
   567         emacs_abort ();
   568     }
   569   fd_callback_info[fd].flags &= ~(FOR_WRITE | NON_BLOCKING_CONNECT_FD);
   570   if (fd_callback_info[fd].flags == 0)
   571     {
   572       fd_callback_info[fd].func = 0;
   573       fd_callback_info[fd].data = 0;
   574 
   575       if (fd == max_desc)
   576         recompute_max_desc ();
   577     }
   578 }
   579 
   580 static void
   581 compute_input_wait_mask (fd_set *mask)
   582 {
   583   int fd;
   584 
   585   FD_ZERO (mask);
   586   eassert (max_desc < FD_SETSIZE);
   587   for (fd = 0; fd <= max_desc; ++fd)
   588     {
   589       if (fd_callback_info[fd].thread != NULL
   590           && fd_callback_info[fd].thread != current_thread)
   591         continue;
   592       if (fd_callback_info[fd].waiting_thread != NULL
   593           && fd_callback_info[fd].waiting_thread != current_thread)
   594         continue;
   595       if ((fd_callback_info[fd].flags & FOR_READ) != 0)
   596         {
   597           FD_SET (fd, mask);
   598           fd_callback_info[fd].waiting_thread = current_thread;
   599         }
   600     }
   601 }
   602 
   603 static void
   604 compute_non_process_wait_mask (fd_set *mask)
   605 {
   606   int fd;
   607 
   608   FD_ZERO (mask);
   609   eassert (max_desc < FD_SETSIZE);
   610   for (fd = 0; fd <= max_desc; ++fd)
   611     {
   612       if (fd_callback_info[fd].thread != NULL
   613           && fd_callback_info[fd].thread != current_thread)
   614         continue;
   615       if (fd_callback_info[fd].waiting_thread != NULL
   616           && fd_callback_info[fd].waiting_thread != current_thread)
   617         continue;
   618       if ((fd_callback_info[fd].flags & FOR_READ) != 0
   619           && (fd_callback_info[fd].flags & PROCESS_FD) == 0)
   620         {
   621           FD_SET (fd, mask);
   622           fd_callback_info[fd].waiting_thread = current_thread;
   623         }
   624     }
   625 }
   626 
   627 static void
   628 compute_non_keyboard_wait_mask (fd_set *mask)
   629 {
   630   int fd;
   631 
   632   FD_ZERO (mask);
   633   eassert (max_desc < FD_SETSIZE);
   634   for (fd = 0; fd <= max_desc; ++fd)
   635     {
   636       if (fd_callback_info[fd].thread != NULL
   637           && fd_callback_info[fd].thread != current_thread)
   638         continue;
   639       if (fd_callback_info[fd].waiting_thread != NULL
   640           && fd_callback_info[fd].waiting_thread != current_thread)
   641         continue;
   642       if ((fd_callback_info[fd].flags & FOR_READ) != 0
   643           && (fd_callback_info[fd].flags & KEYBOARD_FD) == 0)
   644         {
   645           FD_SET (fd, mask);
   646           fd_callback_info[fd].waiting_thread = current_thread;
   647         }
   648     }
   649 }
   650 
   651 static void
   652 compute_write_mask (fd_set *mask)
   653 {
   654   int fd;
   655 
   656   FD_ZERO (mask);
   657   eassert (max_desc < FD_SETSIZE);
   658   for (fd = 0; fd <= max_desc; ++fd)
   659     {
   660       if (fd_callback_info[fd].thread != NULL
   661           && fd_callback_info[fd].thread != current_thread)
   662         continue;
   663       if (fd_callback_info[fd].waiting_thread != NULL
   664           && fd_callback_info[fd].waiting_thread != current_thread)
   665         continue;
   666       if ((fd_callback_info[fd].flags & FOR_WRITE) != 0)
   667         {
   668           FD_SET (fd, mask);
   669           fd_callback_info[fd].waiting_thread = current_thread;
   670         }
   671     }
   672 }
   673 
   674 static void
   675 clear_waiting_thread_info (void)
   676 {
   677   int fd;
   678 
   679   eassert (max_desc < FD_SETSIZE);
   680   for (fd = 0; fd <= max_desc; ++fd)
   681     {
   682       if (fd_callback_info[fd].waiting_thread == current_thread)
   683         fd_callback_info[fd].waiting_thread = NULL;
   684     }
   685 }
   686 
   687 /* Return TRUE if the keyboard descriptor is being monitored by the
   688    current thread, FALSE otherwise.  */
   689 static bool
   690 kbd_is_ours (void)
   691 {
   692   for (int fd = 0; fd <= max_desc; ++fd)
   693     {
   694       if (fd_callback_info[fd].waiting_thread != current_thread)
   695         continue;
   696       if ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
   697           == (FOR_READ | KEYBOARD_FD))
   698         return true;
   699     }
   700   return false;
   701 }
   702 
   703 
   704 /* Compute the Lisp form of the process status, p->status, from
   705    the numeric status that was returned by `wait'.  */
   706 
   707 static Lisp_Object status_convert (int);
   708 
   709 static void
   710 update_status (struct Lisp_Process *p)
   711 {
   712   eassert (p->raw_status_new);
   713   pset_status (p, status_convert (p->raw_status));
   714   p->raw_status_new = 0;
   715 }
   716 
   717 /*  Convert a process status word in Unix format to
   718     the list that we use internally.  */
   719 
   720 static Lisp_Object
   721 status_convert (int w)
   722 {
   723   if (WIFSTOPPED (w))
   724     return Fcons (Qstop, Fcons (make_fixnum (WSTOPSIG (w)), Qnil));
   725   else if (WIFEXITED (w))
   726     return Fcons (Qexit, Fcons (make_fixnum (WEXITSTATUS (w)), Qnil));
   727   else if (WIFSIGNALED (w))
   728     return Fcons (Qsignal, Fcons (make_fixnum (WTERMSIG (w)),
   729                                   WCOREDUMP (w) ? Qt : Qnil));
   730   else
   731     return Qrun;
   732 }
   733 
   734 /* True if STATUS is that of a process attempting connection.  */
   735 
   736 static bool
   737 connecting_status (Lisp_Object status)
   738 {
   739   return CONSP (status) && EQ (XCAR (status), Qconnect);
   740 }
   741 
   742 /* Given a status-list, extract the three pieces of information
   743    and store them individually through the three pointers.  */
   744 
   745 static void
   746 decode_status (Lisp_Object l, Lisp_Object *symbol, Lisp_Object *code,
   747                bool *coredump)
   748 {
   749   Lisp_Object tem;
   750 
   751   if (connecting_status (l))
   752     l = XCAR (l);
   753 
   754   if (SYMBOLP (l))
   755     {
   756       *symbol = l;
   757       *code = make_fixnum (0);
   758       *coredump = 0;
   759     }
   760   else
   761     {
   762       *symbol = XCAR (l);
   763       tem = XCDR (l);
   764       *code = XCAR (tem);
   765       tem = XCDR (tem);
   766       *coredump = !NILP (tem);
   767     }
   768 }
   769 
   770 /* Return a string describing a process status list.  */
   771 
   772 static Lisp_Object
   773 status_message (struct Lisp_Process *p)
   774 {
   775   Lisp_Object status = p->status;
   776   Lisp_Object symbol, code;
   777   bool coredump;
   778   Lisp_Object string;
   779 
   780   decode_status (status, &symbol, &code, &coredump);
   781 
   782   if (EQ (symbol, Qsignal) || EQ (symbol, Qstop))
   783     {
   784       char const *signame;
   785       synchronize_system_messages_locale ();
   786       signame = strsignal (XFIXNAT (code));
   787       if (signame == 0)
   788         string = build_string ("unknown");
   789       else
   790         {
   791           int c1, c2;
   792 
   793           string = build_unibyte_string (signame);
   794           if (! NILP (Vlocale_coding_system))
   795             string = (code_convert_string_norecord
   796                       (string, Vlocale_coding_system, 0));
   797           c1 = STRING_CHAR (SDATA (string));
   798           c2 = downcase (c1);
   799           if (c1 != c2)
   800             Faset (string, make_fixnum (0), make_fixnum (c2));
   801         }
   802       AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
   803       return concat2 (string, suffix);
   804     }
   805   else if (EQ (symbol, Qexit))
   806     {
   807       if (NETCONN1_P (p))
   808         return build_string (XFIXNAT (code) == 0
   809                              ? "deleted\n"
   810                              : "connection broken by remote peer\n");
   811       if (XFIXNAT (code) == 0)
   812         return build_string ("finished\n");
   813       AUTO_STRING (prefix, "exited abnormally with code ");
   814       string = Fnumber_to_string (code);
   815       AUTO_STRING (suffix, coredump ? " (core dumped)\n" : "\n");
   816       return concat3 (prefix, string, suffix);
   817     }
   818   else if (EQ (symbol, Qfailed))
   819     {
   820       AUTO_STRING (format, "failed with code %s\n");
   821       return CALLN (Fformat, format, code);
   822     }
   823   else
   824     return Fcopy_sequence (Fsymbol_name (symbol));
   825 }
   826 
   827 enum { PTY_NAME_SIZE = 24 };
   828 
   829 /* Open an available pty, returning a file descriptor.
   830    Store into PTY_NAME the file name of the terminal corresponding to the pty.
   831    Return -1 on failure.  */
   832 
   833 static int
   834 allocate_pty (char pty_name[PTY_NAME_SIZE])
   835 {
   836 #ifdef HAVE_PTYS
   837   int fd;
   838 
   839 #ifdef PTY_ITERATION
   840   PTY_ITERATION
   841 #else
   842   register int c, i;
   843   for (c = FIRST_PTY_LETTER; c <= 'z'; c++)
   844     for (i = 0; i < 16; i++)
   845 #endif
   846       {
   847 #ifdef PTY_NAME_SPRINTF
   848         PTY_NAME_SPRINTF
   849 #else
   850         sprintf (pty_name, "/dev/pty%c%x", c, i);
   851 #endif /* no PTY_NAME_SPRINTF */
   852 
   853 #ifdef PTY_OPEN
   854         PTY_OPEN;
   855 #else /* no PTY_OPEN */
   856         fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
   857 #endif /* no PTY_OPEN */
   858 
   859         if (fd >= 0)
   860           {
   861 #ifdef PTY_TTY_NAME_SPRINTF
   862             PTY_TTY_NAME_SPRINTF
   863 #else
   864             sprintf (pty_name, "/dev/tty%c%x", c, i);
   865 #endif /* no PTY_TTY_NAME_SPRINTF */
   866 
   867             /* Set FD's close-on-exec flag.  This is needed even if
   868                PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
   869                doesn't require support for that combination.
   870                Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
   871                doesn't work if the close-on-exec flag is set (Bug#20555).
   872                Multithreaded platforms where posix_openpt ignores
   873                O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
   874                have a race condition between the PTY_OPEN and here.  */
   875             fcntl (fd, F_SETFD, FD_CLOEXEC);
   876 
   877             /* Check to make certain that both sides are available.
   878                This avoids a nasty yet stupid bug in rlogins.  */
   879             if (faccessat (AT_FDCWD, pty_name, R_OK | W_OK, AT_EACCESS) != 0)
   880               {
   881                 emacs_close (fd);
   882                 continue;
   883               }
   884             setup_pty (fd);
   885             return fd;
   886           }
   887       }
   888 #endif /* HAVE_PTYS */
   889   return -1;
   890 }
   891 
   892 /* Allocate basically initialized process.  */
   893 
   894 static struct Lisp_Process *
   895 allocate_process (void)
   896 {
   897   return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process, thread,
   898                                        PVEC_PROCESS);
   899 }
   900 
   901 static Lisp_Object
   902 make_process (Lisp_Object name)
   903 {
   904   struct Lisp_Process *p = allocate_process ();
   905   /* Initialize Lisp data.  Note that allocate_process initializes all
   906      Lisp data to nil, so do it only for slots which should not be nil.  */
   907   pset_status (p, Qrun);
   908   pset_mark (p, Fmake_marker ());
   909   pset_thread (p, Fcurrent_thread ());
   910 
   911   /* Initialize non-Lisp data.  Note that allocate_process zeroes out all
   912      non-Lisp data, so do it only for slots which should not be zero.  */
   913   p->infd = -1;
   914   p->outfd = -1;
   915   for (int i = 0; i < PROCESS_OPEN_FDS; i++)
   916     p->open_fd[i] = -1;
   917 
   918 #ifdef HAVE_GNUTLS
   919   verify (GNUTLS_STAGE_EMPTY == 0);
   920   eassert (p->gnutls_initstage == GNUTLS_STAGE_EMPTY);
   921   eassert (NILP (p->gnutls_boot_parameters));
   922 #endif
   923 
   924   /* If name is already in use, modify it until it is unused.  */
   925 
   926   Lisp_Object name1 = name;
   927   for (intmax_t i = 1; ; i++)
   928     {
   929       Lisp_Object tem = Fget_process (name1);
   930       if (NILP (tem))
   931         break;
   932       char const suffix_fmt[] = "<%"PRIdMAX">";
   933       char suffix[sizeof suffix_fmt + INT_STRLEN_BOUND (i)];
   934       AUTO_STRING_WITH_LEN (lsuffix, suffix, sprintf (suffix, suffix_fmt, i));
   935       name1 = concat2 (name, lsuffix);
   936     }
   937   name = name1;
   938   pset_name (p, name);
   939   pset_sentinel (p, Qinternal_default_process_sentinel);
   940   pset_filter (p, Qinternal_default_process_filter);
   941   Lisp_Object val;
   942   XSETPROCESS (val, p);
   943   Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist);
   944   return val;
   945 }
   946 
   947 static void
   948 remove_process (register Lisp_Object proc)
   949 {
   950   register Lisp_Object pair;
   951 
   952   pair = Frassq (proc, Vprocess_alist);
   953   Vprocess_alist = Fdelq (pair, Vprocess_alist);
   954 
   955   deactivate_process (proc);
   956 }
   957 
   958 void
   959 update_processes_for_thread_death (Lisp_Object dying_thread)
   960 {
   961   Lisp_Object pair;
   962 
   963   for (pair = Vprocess_alist; !NILP (pair); pair = XCDR (pair))
   964     {
   965       Lisp_Object process = XCDR (XCAR (pair));
   966       if (EQ (XPROCESS (process)->thread, dying_thread))
   967         {
   968           struct Lisp_Process *proc = XPROCESS (process);
   969 
   970           pset_thread (proc, Qnil);
   971           eassert (proc->infd < FD_SETSIZE);
   972           if (proc->infd >= 0)
   973             fd_callback_info[proc->infd].thread = NULL;
   974           eassert (proc->outfd < FD_SETSIZE);
   975           if (proc->outfd >= 0)
   976             fd_callback_info[proc->outfd].thread = NULL;
   977         }
   978     }
   979 }
   980 
   981 #ifdef HAVE_GETADDRINFO_A
   982 static void
   983 free_dns_request (Lisp_Object proc)
   984 {
   985   struct Lisp_Process *p = XPROCESS (proc);
   986 
   987   if (p->dns_request->ar_result)
   988     freeaddrinfo (p->dns_request->ar_result);
   989   xfree (p->dns_request);
   990   p->dns_request = NULL;
   991 }
   992 #endif
   993 
   994 
   995 DEFUN ("processp", Fprocessp, Sprocessp, 1, 1, 0,
   996        doc: /* Return t if OBJECT is a process.  */)
   997   (Lisp_Object object)
   998 {
   999   return PROCESSP (object) ? Qt : Qnil;
  1000 }
  1001 
  1002 DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
  1003        doc: /* Return the process named NAME, or nil if there is none.  */)
  1004   (register Lisp_Object name)
  1005 {
  1006   if (PROCESSP (name))
  1007     return name;
  1008   CHECK_STRING (name);
  1009   return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
  1010 }
  1011 
  1012 /* This is how commands for the user decode process arguments.  It
  1013    accepts a process, a process name, a buffer, a buffer name, or nil.
  1014    Buffers denote the first process in the buffer, and nil denotes the
  1015    current buffer.  */
  1016 
  1017 static Lisp_Object
  1018 get_process (register Lisp_Object name)
  1019 {
  1020   register Lisp_Object proc, obj;
  1021   if (STRINGP (name))
  1022     {
  1023       obj = Fget_process (name);
  1024       if (NILP (obj))
  1025         obj = Fget_buffer (name);
  1026       if (NILP (obj))
  1027         error ("Process %s does not exist", SDATA (name));
  1028     }
  1029   else if (NILP (name))
  1030     obj = Fcurrent_buffer ();
  1031   else
  1032     obj = name;
  1033 
  1034   /* Now obj should be either a buffer object or a process object.  */
  1035   if (BUFFERP (obj))
  1036     {
  1037       if (NILP (BVAR (XBUFFER (obj), name)))
  1038         error ("Attempt to get process for a dead buffer");
  1039       proc = Fget_buffer_process (obj);
  1040       if (NILP (proc))
  1041         error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name)));
  1042     }
  1043   else
  1044     {
  1045       CHECK_PROCESS (obj);
  1046       proc = obj;
  1047     }
  1048   return proc;
  1049 }
  1050 
  1051 
  1052 /* Fdelete_process promises to immediately forget about the process, but in
  1053    reality, Emacs needs to remember those processes until they have been
  1054    treated by the SIGCHLD handler and waitpid has been invoked on them;
  1055    otherwise they might fill up the kernel's process table.
  1056 
  1057    Some processes created by call-process are also put onto this list.
  1058 
  1059    Members of this list are (process-ID . filename) pairs.  The
  1060    process-ID is a number; the filename, if a string, is a file that
  1061    needs to be removed after the process exits.  */
  1062 static Lisp_Object deleted_pid_list;
  1063 
  1064 void
  1065 record_deleted_pid (pid_t pid, Lisp_Object filename)
  1066 {
  1067   deleted_pid_list = Fcons (Fcons (INT_TO_INTEGER (pid), filename),
  1068                             /* GC treated elements set to nil.  */
  1069                             Fdelq (Qnil, deleted_pid_list));
  1070 
  1071 }
  1072 
  1073 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 0, 1,
  1074        "(list 'message)",
  1075        doc: /* Delete PROCESS: kill it and forget about it immediately.
  1076 PROCESS may be a process, a buffer, the name of a process or buffer, or
  1077 nil, indicating the current buffer's process.
  1078 
  1079 Interactively, it will kill the current buffer's process.  */)
  1080   (register Lisp_Object process)
  1081 {
  1082   register struct Lisp_Process *p;
  1083   bool mess = false;
  1084 
  1085   /* We use this to see whether we were called interactively.  */
  1086   if (EQ (process, Qmessage))
  1087     {
  1088       mess = true;
  1089       process = Qnil;
  1090     }
  1091 
  1092   process = get_process (process);
  1093   p = XPROCESS (process);
  1094 
  1095 #ifdef HAVE_GETADDRINFO_A
  1096   if (p->dns_request)
  1097     {
  1098       /* Cancel the request.  Unless shutting down, wait until
  1099          completion.  Free the request if completely canceled. */
  1100 
  1101       bool canceled = gai_cancel (p->dns_request) != EAI_NOTCANCELED;
  1102       if (!canceled && !inhibit_sentinels)
  1103         {
  1104           struct gaicb const *req = p->dns_request;
  1105           while (gai_suspend (&req, 1, NULL) != 0)
  1106             continue;
  1107           canceled = true;
  1108         }
  1109       if (canceled)
  1110         free_dns_request (process);
  1111     }
  1112 #endif
  1113 
  1114   p->raw_status_new = 0;
  1115   if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
  1116     {
  1117       pset_status (p, list2 (Qexit, make_fixnum (0)));
  1118       p->tick = ++process_tick;
  1119       status_notify (p, NULL);
  1120       redisplay_preserve_echo_area (13);
  1121     }
  1122   else
  1123     {
  1124       if (p->alive)
  1125         record_kill_process (p, Qnil);
  1126 
  1127       if (p->infd >= 0)
  1128         {
  1129           /* Update P's status, since record_kill_process will make the
  1130              SIGCHLD handler update deleted_pid_list, not *P.  */
  1131           Lisp_Object symbol;
  1132           if (p->raw_status_new)
  1133             update_status (p);
  1134           symbol = CONSP (p->status) ? XCAR (p->status) : p->status;
  1135           if (! (EQ (symbol, Qsignal) || EQ (symbol, Qexit)))
  1136             pset_status (p, list2 (Qsignal, make_fixnum (SIGKILL)));
  1137 
  1138           p->tick = ++process_tick;
  1139           status_notify (p, NULL);
  1140           redisplay_preserve_echo_area (13);
  1141         }
  1142     }
  1143   remove_process (process);
  1144   if (mess)
  1145     message ("Deleted process");
  1146   return Qnil;
  1147 }
  1148 
  1149 DEFUN ("process-status", Fprocess_status, Sprocess_status, 1, 1, 0,
  1150        doc: /* Return the status of PROCESS.
  1151 The returned value is one of the following symbols:
  1152 run  -- for a process that is running.
  1153 stop -- for a process stopped but continuable.
  1154 exit -- for a process that has exited.
  1155 signal -- for a process that has got a fatal signal.
  1156 open -- for a network stream connection that is open.
  1157 listen -- for a network stream server that is listening.
  1158 closed -- for a network stream connection that is closed.
  1159 connect -- when waiting for a non-blocking connection to complete.
  1160 failed -- when a non-blocking connection has failed.
  1161 nil -- if arg is a process name and no such process exists.
  1162 PROCESS may be a process, a buffer, the name of a process, or
  1163 nil, indicating the current buffer's process.  */)
  1164   (register Lisp_Object process)
  1165 {
  1166   register struct Lisp_Process *p;
  1167   register Lisp_Object status;
  1168 
  1169   if (STRINGP (process))
  1170     process = Fget_process (process);
  1171   else
  1172     process = get_process (process);
  1173 
  1174   if (NILP (process))
  1175     return process;
  1176 
  1177   p = XPROCESS (process);
  1178   if (p->raw_status_new)
  1179     update_status (p);
  1180   status = p->status;
  1181   if (CONSP (status))
  1182     status = XCAR (status);
  1183   if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
  1184     {
  1185       if (EQ (status, Qexit))
  1186         status = Qclosed;
  1187       else if (EQ (p->command, Qt))
  1188         status = Qstop;
  1189       else if (EQ (status, Qrun))
  1190         status = Qopen;
  1191     }
  1192   return status;
  1193 }
  1194 
  1195 DEFUN ("process-exit-status", Fprocess_exit_status, Sprocess_exit_status,
  1196        1, 1, 0,
  1197        doc: /* Return the exit status of PROCESS or the signal number that killed it.
  1198 If PROCESS has not yet exited or died, return 0.  */)
  1199   (register Lisp_Object process)
  1200 {
  1201   CHECK_PROCESS (process);
  1202   if (XPROCESS (process)->raw_status_new)
  1203     update_status (XPROCESS (process));
  1204   if (CONSP (XPROCESS (process)->status))
  1205     return XCAR (XCDR (XPROCESS (process)->status));
  1206   return make_fixnum (0);
  1207 }
  1208 
  1209 DEFUN ("process-id", Fprocess_id, Sprocess_id, 1, 1, 0,
  1210        doc: /* Return the process id of PROCESS.
  1211 This is the pid of the external process which PROCESS uses or talks to,
  1212 an integer.
  1213 For a network, serial, and pipe connections, this value is nil.  */)
  1214   (register Lisp_Object process)
  1215 {
  1216   pid_t pid;
  1217 
  1218   CHECK_PROCESS (process);
  1219   pid = XPROCESS (process)->pid;
  1220   return pid ? INT_TO_INTEGER (pid) : Qnil;
  1221 }
  1222 
  1223 DEFUN ("process-name", Fprocess_name, Sprocess_name, 1, 1, 0,
  1224        doc: /* Return the name of PROCESS, as a string.
  1225 This is the name of the program invoked in PROCESS,
  1226 possibly modified to make it unique among process names.  */)
  1227   (register Lisp_Object process)
  1228 {
  1229   CHECK_PROCESS (process);
  1230   return XPROCESS (process)->name;
  1231 }
  1232 
  1233 DEFUN ("process-command", Fprocess_command, Sprocess_command, 1, 1, 0,
  1234        doc: /* Return the command that was executed to start PROCESS.
  1235 This is a list of strings, the first string being the program executed
  1236 and the rest of the strings being the arguments given to it.
  1237 For a network or serial or pipe connection, this is nil (process is running)
  1238 or t (process is stopped).  */)
  1239   (register Lisp_Object process)
  1240 {
  1241   CHECK_PROCESS (process);
  1242   return XPROCESS (process)->command;
  1243 }
  1244 
  1245 DEFUN ("process-tty-name", Fprocess_tty_name, Sprocess_tty_name, 1, 2, 0,
  1246        doc: /* Return the name of the terminal PROCESS uses, or nil if none.
  1247 This is the terminal that the process itself reads and writes on,
  1248 not the name of the pty that Emacs uses to talk with that terminal.
  1249 
  1250 If STREAM is nil, return the terminal name if any of PROCESS's
  1251 standard streams use a terminal for communication.  If STREAM is one
  1252 of `stdin', `stdout', or `stderr', return the name of the terminal
  1253 PROCESS uses for that stream specifically, or nil if that stream
  1254 communicates via a pipe.  */)
  1255   (register Lisp_Object process, Lisp_Object stream)
  1256 {
  1257   CHECK_PROCESS (process);
  1258   register struct Lisp_Process *p = XPROCESS (process);
  1259 
  1260   if (NILP (stream))
  1261     return p->tty_name;
  1262   else if (EQ (stream, Qstdin))
  1263     return p->pty_in ? p->tty_name : Qnil;
  1264   else if (EQ (stream, Qstdout))
  1265     return p->pty_out ? p->tty_name : Qnil;
  1266   else if (EQ (stream, Qstderr))
  1267     return p->pty_out && NILP (p->stderrproc) ? p->tty_name : Qnil;
  1268   else
  1269     signal_error ("Unknown stream", stream);
  1270 }
  1271 
  1272 static void
  1273 update_process_mark (struct Lisp_Process *p)
  1274 {
  1275   Lisp_Object buffer = p->buffer;
  1276   if (BUFFERP (buffer))
  1277     set_marker_both (p->mark, buffer,
  1278                      BUF_ZV (XBUFFER (buffer)),
  1279                      BUF_ZV_BYTE (XBUFFER (buffer)));
  1280 }
  1281 
  1282 DEFUN ("set-process-buffer", Fset_process_buffer, Sset_process_buffer,
  1283        2, 2, 0,
  1284        doc: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
  1285 Return BUFFER.  */)
  1286   (register Lisp_Object process, Lisp_Object buffer)
  1287 {
  1288   struct Lisp_Process *p;
  1289 
  1290   CHECK_PROCESS (process);
  1291   if (!NILP (buffer))
  1292     CHECK_BUFFER (buffer);
  1293   p = XPROCESS (process);
  1294   if (!EQ (p->buffer, buffer))
  1295     {
  1296       pset_buffer (p, buffer);
  1297       update_process_mark (p);
  1298     }
  1299   if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
  1300     pset_childp (p, plist_put (p->childp, QCbuffer, buffer));
  1301   setup_process_coding_systems (process);
  1302   return buffer;
  1303 }
  1304 
  1305 DEFUN ("process-buffer", Fprocess_buffer, Sprocess_buffer,
  1306        1, 1, 0,
  1307        doc: /* Return the buffer PROCESS is associated with.
  1308 The default process filter inserts output from PROCESS into this buffer.  */)
  1309   (register Lisp_Object process)
  1310 {
  1311   CHECK_PROCESS (process);
  1312   return XPROCESS (process)->buffer;
  1313 }
  1314 
  1315 DEFUN ("process-mark", Fprocess_mark, Sprocess_mark,
  1316        1, 1, 0,
  1317        doc: /* Return the marker for the end of the last output from PROCESS.  */)
  1318   (register Lisp_Object process)
  1319 {
  1320   CHECK_PROCESS (process);
  1321   return XPROCESS (process)->mark;
  1322 }
  1323 
  1324 static void
  1325 set_process_filter_masks (struct Lisp_Process *p)
  1326 {
  1327   if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
  1328     delete_read_fd (p->infd);
  1329   else if (EQ (p->filter, Qt)
  1330            /* Network or serial process not stopped:  */
  1331            && !EQ (p->command, Qt))
  1332     add_process_read_fd (p->infd);
  1333 }
  1334 
  1335 static bool
  1336 is_pty_from_symbol (Lisp_Object symbol)
  1337 {
  1338   if (EQ (symbol, Qpty))
  1339     return true;
  1340   else if (EQ (symbol, Qpipe))
  1341     return false;
  1342   else if (NILP (symbol))
  1343     return !NILP (Vprocess_connection_type);
  1344   else
  1345     report_file_error ("Unknown connection type", symbol);
  1346 }
  1347 
  1348 DEFUN ("set-process-filter", Fset_process_filter, Sset_process_filter,
  1349        2, 2, 0,
  1350        doc: /* Give PROCESS the filter function FILTER; nil means default.
  1351 A value of t means stop accepting output from the process.
  1352 
  1353 When a process has a non-default filter, its buffer is not used for output.
  1354 Instead, each time it does output, the entire string of output is
  1355 passed to the filter.
  1356 
  1357 The filter gets two arguments: the process and the string of output.
  1358 The string argument is normally a multibyte string, except:
  1359 - if the process's input coding system is no-conversion or raw-text,
  1360   it is a unibyte string (the non-converted input).  */)
  1361   (Lisp_Object process, Lisp_Object filter)
  1362 {
  1363   CHECK_PROCESS (process);
  1364   struct Lisp_Process *p = XPROCESS (process);
  1365 
  1366   /* Don't signal an error if the process's input file descriptor
  1367      is closed.  This could make debugging Lisp more difficult,
  1368      for example when doing something like
  1369 
  1370      (setq process (start-process ...))
  1371      (debug)
  1372      (set-process-filter process ...)  */
  1373 
  1374   if (NILP (filter))
  1375     filter = Qinternal_default_process_filter;
  1376 
  1377   if (p->infd >= 0)
  1378     {
  1379       /* If filter WILL be t, stop reading output.  */
  1380       if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
  1381         delete_read_fd (p->infd);
  1382       else if (/* If filter WAS t, then resume reading output.  */
  1383                EQ (p->filter, Qt)
  1384                /* Network or serial process not stopped:  */
  1385                && !EQ (p->command, Qt))
  1386         add_process_read_fd (p->infd);
  1387     }
  1388 
  1389   pset_filter (p, filter);
  1390 
  1391   if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
  1392     pset_childp (p, plist_put (p->childp, QCfilter, filter));
  1393   setup_process_coding_systems (process);
  1394   return filter;
  1395 }
  1396 
  1397 DEFUN ("process-filter", Fprocess_filter, Sprocess_filter,
  1398        1, 1, 0,
  1399        doc: /* Return the filter function of PROCESS.
  1400 See `set-process-filter' for more info on filter functions.  */)
  1401   (register Lisp_Object process)
  1402 {
  1403   CHECK_PROCESS (process);
  1404   return XPROCESS (process)->filter;
  1405 }
  1406 
  1407 DEFUN ("set-process-sentinel", Fset_process_sentinel, Sset_process_sentinel,
  1408        2, 2, 0,
  1409        doc: /* Give PROCESS the sentinel SENTINEL; nil for default.
  1410 The sentinel is called as a function when the process changes state.
  1411 It gets two arguments: the process, and a string describing the change.  */)
  1412   (register Lisp_Object process, Lisp_Object sentinel)
  1413 {
  1414   struct Lisp_Process *p;
  1415 
  1416   CHECK_PROCESS (process);
  1417   p = XPROCESS (process);
  1418 
  1419   if (NILP (sentinel))
  1420     sentinel = Qinternal_default_process_sentinel;
  1421 
  1422   pset_sentinel (p, sentinel);
  1423   if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
  1424     pset_childp (p, plist_put (p->childp, QCsentinel, sentinel));
  1425   return sentinel;
  1426 }
  1427 
  1428 DEFUN ("process-sentinel", Fprocess_sentinel, Sprocess_sentinel,
  1429        1, 1, 0,
  1430        doc: /* Return the sentinel of PROCESS.
  1431 See `set-process-sentinel' for more info on sentinels.  */)
  1432   (register Lisp_Object process)
  1433 {
  1434   CHECK_PROCESS (process);
  1435   return XPROCESS (process)->sentinel;
  1436 }
  1437 
  1438 DEFUN ("set-process-thread", Fset_process_thread, Sset_process_thread,
  1439        2, 2, 0,
  1440        doc: /* Set the locking thread of PROCESS to be THREAD.
  1441 If THREAD is nil, the process is unlocked.  */)
  1442   (Lisp_Object process, Lisp_Object thread)
  1443 {
  1444   struct Lisp_Process *proc;
  1445   struct thread_state *tstate;
  1446 
  1447   CHECK_PROCESS (process);
  1448   if (NILP (thread))
  1449     tstate = NULL;
  1450   else
  1451     {
  1452       CHECK_THREAD (thread);
  1453       tstate = XTHREAD (thread);
  1454     }
  1455 
  1456   proc = XPROCESS (process);
  1457   pset_thread (proc, thread);
  1458   eassert (proc->infd < FD_SETSIZE);
  1459   if (proc->infd >= 0)
  1460     fd_callback_info[proc->infd].thread = tstate;
  1461   eassert (proc->outfd < FD_SETSIZE);
  1462   if (proc->outfd >= 0)
  1463     fd_callback_info[proc->outfd].thread = tstate;
  1464 
  1465   return thread;
  1466 }
  1467 
  1468 DEFUN ("process-thread", Fprocess_thread, Sprocess_thread,
  1469        1, 1, 0,
  1470        doc: /* Return the locking thread of PROCESS.
  1471 If PROCESS is unlocked, this function returns nil.  */)
  1472   (Lisp_Object process)
  1473 {
  1474   CHECK_PROCESS (process);
  1475   return XPROCESS (process)->thread;
  1476 }
  1477 
  1478 DEFUN ("set-process-window-size", Fset_process_window_size,
  1479        Sset_process_window_size, 3, 3, 0,
  1480        doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
  1481 Value is t if PROCESS was successfully told about the window size,
  1482 nil otherwise.  */)
  1483   (Lisp_Object process, Lisp_Object height, Lisp_Object width)
  1484 {
  1485   CHECK_PROCESS (process);
  1486 
  1487   /* All known platforms store window sizes as 'unsigned short'.  */
  1488   unsigned short h = check_uinteger_max (height, USHRT_MAX);
  1489   unsigned short w = check_uinteger_max (width, USHRT_MAX);
  1490 
  1491   if (NETCONN_P (process)
  1492       || XPROCESS (process)->infd < 0
  1493       || set_window_size (XPROCESS (process)->infd, h, w) < 0)
  1494     return Qnil;
  1495   else
  1496     return Qt;
  1497 }
  1498 
  1499 DEFUN ("set-process-inherit-coding-system-flag",
  1500        Fset_process_inherit_coding_system_flag,
  1501        Sset_process_inherit_coding_system_flag, 2, 2, 0,
  1502        doc: /* Determine whether buffer of PROCESS will inherit coding-system.
  1503 If the second argument FLAG is non-nil, then the variable
  1504 `buffer-file-coding-system' of the buffer associated with PROCESS
  1505 will be bound to the value of the coding system used to decode
  1506 the process output.
  1507 
  1508 This is useful when the coding system specified for the process buffer
  1509 leaves either the character code conversion or the end-of-line conversion
  1510 unspecified, or if the coding system used to decode the process output
  1511 is more appropriate for saving the process buffer.
  1512 
  1513 Binding the variable `inherit-process-coding-system' to non-nil before
  1514 starting the process is an alternative way of setting the inherit flag
  1515 for the process which will run.
  1516 
  1517 This function returns FLAG.  */)
  1518   (register Lisp_Object process, Lisp_Object flag)
  1519 {
  1520   CHECK_PROCESS (process);
  1521   XPROCESS (process)->inherit_coding_system_flag = !NILP (flag);
  1522   return flag;
  1523 }
  1524 
  1525 DEFUN ("set-process-query-on-exit-flag",
  1526        Fset_process_query_on_exit_flag, Sset_process_query_on_exit_flag,
  1527        2, 2, 0,
  1528        doc: /* Specify if query is needed for PROCESS when Emacs is exited.
  1529 If the second argument FLAG is non-nil, Emacs will query the user before
  1530 exiting or killing a buffer if PROCESS is running.  This function
  1531 returns FLAG.  */)
  1532   (register Lisp_Object process, Lisp_Object flag)
  1533 {
  1534   CHECK_PROCESS (process);
  1535   XPROCESS (process)->kill_without_query = NILP (flag);
  1536   return flag;
  1537 }
  1538 
  1539 DEFUN ("process-query-on-exit-flag",
  1540        Fprocess_query_on_exit_flag, Sprocess_query_on_exit_flag,
  1541        1, 1, 0,
  1542        doc: /* Return the current value of query-on-exit flag for PROCESS.  */)
  1543   (register Lisp_Object process)
  1544 {
  1545   CHECK_PROCESS (process);
  1546   return (XPROCESS (process)->kill_without_query ? Qnil : Qt);
  1547 }
  1548 
  1549 DEFUN ("process-contact", Fprocess_contact, Sprocess_contact,
  1550        1, 3, 0,
  1551        doc: /* Return the contact info of PROCESS; t for a real child.
  1552 For a network or serial or pipe connection, the value depends on the
  1553 optional KEY arg.  If KEY is nil, value is a cons cell of the form
  1554 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
  1555 connection; it is t for a pipe connection.  If KEY is t, the complete
  1556 contact information for the connection is returned, else the specific
  1557 value for the keyword KEY is returned.  See `make-network-process',
  1558 `make-serial-process', or `make-pipe-process' for the list of keywords.
  1559 
  1560 If PROCESS is a non-blocking network process that hasn't been fully
  1561 set up yet, this function will block until socket setup has completed.
  1562 If the optional NO-BLOCK parameter is specified, return nil instead of
  1563 waiting for the process to be fully set up.*/)
  1564   (Lisp_Object process, Lisp_Object key, Lisp_Object no_block)
  1565 {
  1566   Lisp_Object contact;
  1567 
  1568   CHECK_PROCESS (process);
  1569   contact = XPROCESS (process)->childp;
  1570 
  1571 #ifdef DATAGRAM_SOCKETS
  1572 
  1573   if (NETCONN_P (process) && XPROCESS (process)->infd < 0)
  1574     {
  1575       /* Usually wait for the network process to finish being set
  1576        * up. */
  1577       if (!NILP (no_block))
  1578         return Qnil;
  1579 
  1580       wait_for_socket_fds (process, "process-contact");
  1581     }
  1582 
  1583   if (DATAGRAM_CONN_P (process)
  1584       && (EQ (key, Qt) || EQ (key, QCremote)))
  1585     contact = plist_put (contact, QCremote,
  1586                          Fprocess_datagram_address (process));
  1587 #endif
  1588 
  1589   if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
  1590       || EQ (key, Qt))
  1591     return contact;
  1592   if (NILP (key) && NETCONN_P (process))
  1593     return list2 (plist_get (contact, QChost),
  1594                   plist_get (contact, QCservice));
  1595   if (NILP (key) && SERIALCONN_P (process))
  1596     return list2 (plist_get (contact, QCport),
  1597                   plist_get (contact, QCspeed));
  1598   /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
  1599      if the pipe process is useful for purposes other than receiving
  1600      stderr.  */
  1601   if (NILP (key) && PIPECONN_P (process))
  1602     return Qt;
  1603   return plist_get (contact, key);
  1604 }
  1605 
  1606 DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
  1607        1, 1, 0,
  1608        doc: /* Return the plist of PROCESS.  */)
  1609   (register Lisp_Object process)
  1610 {
  1611   CHECK_PROCESS (process);
  1612   return XPROCESS (process)->plist;
  1613 }
  1614 
  1615 DEFUN ("set-process-plist", Fset_process_plist, Sset_process_plist,
  1616        2, 2, 0,
  1617        doc: /* Replace the plist of PROCESS with PLIST.  Return PLIST.  */)
  1618   (Lisp_Object process, Lisp_Object plist)
  1619 {
  1620   CHECK_PROCESS (process);
  1621   CHECK_LIST (plist);
  1622 
  1623   pset_plist (XPROCESS (process), plist);
  1624   return plist;
  1625 }
  1626 
  1627 #if 0 /* Turned off because we don't currently record this info
  1628          in the process.  Perhaps add it.  */
  1629 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
  1630        doc: /* Return the connection type of PROCESS.
  1631 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
  1632 a socket connection.  */)
  1633   (Lisp_Object process)
  1634 {
  1635   return XPROCESS (process)->type;
  1636 }
  1637 #endif
  1638 
  1639 DEFUN ("process-type", Fprocess_type, Sprocess_type, 1, 1, 0,
  1640        doc: /* Return the connection type of PROCESS.
  1641 The value is either the symbol `real', `network', `serial', or `pipe'.
  1642 PROCESS may be a process, a buffer, the name of a process or buffer, or
  1643 nil, indicating the current buffer's process.  */)
  1644   (Lisp_Object process)
  1645 {
  1646   Lisp_Object proc;
  1647   proc = get_process (process);
  1648   return XPROCESS (proc)->type;
  1649 }
  1650 
  1651 DEFUN ("format-network-address", Fformat_network_address, Sformat_network_address,
  1652        1, 2, 0,
  1653        doc: /* Convert network ADDRESS from internal format to a string.
  1654 A 4 or 5 element vector represents an IPv4 address (with port number).
  1655 An 8 or 9 element vector represents an IPv6 address (with port number).
  1656 If optional second argument OMIT-PORT is non-nil, don't include a port
  1657 number in the string, even when present in ADDRESS.
  1658 Return nil if format of ADDRESS is invalid.  */)
  1659   (Lisp_Object address, Lisp_Object omit_port)
  1660 {
  1661   if (NILP (address))
  1662     return Qnil;
  1663 
  1664   if (STRINGP (address))  /* AF_LOCAL */
  1665     return address;
  1666 
  1667   if (VECTORP (address))  /* AF_INET or AF_INET6 */
  1668     {
  1669       register struct Lisp_Vector *p = XVECTOR (address);
  1670       ptrdiff_t size = p->header.size;
  1671       Lisp_Object args[10];
  1672       int nargs, i;
  1673       char const *format;
  1674 
  1675       if (size == 4 || (size == 5 && !NILP (omit_port)))
  1676         {
  1677           format = "%d.%d.%d.%d";
  1678           nargs = 4;
  1679         }
  1680       else if (size == 5)
  1681         {
  1682           format = "%d.%d.%d.%d:%d";
  1683           nargs = 5;
  1684         }
  1685       else if (size == 8 || (size == 9 && !NILP (omit_port)))
  1686         {
  1687           format = "%x:%x:%x:%x:%x:%x:%x:%x";
  1688           nargs = 8;
  1689         }
  1690       else if (size == 9)
  1691         {
  1692           format = "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
  1693           nargs = 9;
  1694         }
  1695       else
  1696         return Qnil;
  1697 
  1698       AUTO_STRING (format_obj, format);
  1699       args[0] = format_obj;
  1700 
  1701       for (i = 0; i < nargs; i++)
  1702         {
  1703           if (! RANGED_FIXNUMP (0, p->contents[i], 65535))
  1704             return Qnil;
  1705 
  1706           if (nargs <= 5         /* IPv4 */
  1707               && i < 4           /* host, not port */
  1708               && XFIXNUM (p->contents[i]) > 255)
  1709             return Qnil;
  1710 
  1711           args[i + 1] = p->contents[i];
  1712         }
  1713 
  1714       return Fformat (nargs + 1, args);
  1715     }
  1716 
  1717   if (CONSP (address))
  1718     {
  1719       AUTO_STRING (format, "<Family %d>");
  1720       return CALLN (Fformat, format, Fcar (address));
  1721     }
  1722 
  1723   return Qnil;
  1724 }
  1725 
  1726 DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
  1727        doc: /* Return a list of all processes that are Emacs sub-processes.  */)
  1728   (void)
  1729 {
  1730   return Fmapcar (Qcdr, Vprocess_alist);
  1731 }
  1732 
  1733 
  1734 /* Starting asynchronous inferior processes.  */
  1735 
  1736 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
  1737        doc: /* Start a program in a subprocess.  Return the process object for it.
  1738 
  1739 This is similar to `start-process', but arguments are specified as
  1740 keyword/argument pairs.  The following arguments are defined:
  1741 
  1742 :name NAME -- NAME is name for process.  It is modified if necessary
  1743 to make it unique.
  1744 
  1745 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
  1746 with the process.  Process output goes at end of that buffer, unless
  1747 you specify a filter function to handle the output.  BUFFER may be
  1748 also nil, meaning that this process is not associated with any buffer.
  1749 
  1750 :command COMMAND -- COMMAND is a list starting with the program file
  1751 name, followed by strings to give to the program as arguments.  If the
  1752 program file name is not an absolute file name, `make-process' will
  1753 look for the program file name in `exec-path' (which is a list of
  1754 directories).
  1755 
  1756 :coding CODING -- If CODING is a symbol, it specifies the coding
  1757 system used for both reading and writing for this process.  If CODING
  1758 is a cons (DECODING . ENCODING), DECODING is used for reading, and
  1759 ENCODING is used for writing.
  1760 
  1761 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
  1762 the process is running.  If BOOL is not given, query before exiting.
  1763 
  1764 :stop BOOL -- BOOL must be nil.  The `:stop' key is ignored otherwise
  1765 and is retained for compatibility with other process types such as
  1766 pipe processes.  Asynchronous subprocesses never start in the
  1767 `stopped' state.  Use `stop-process' and `continue-process' to send
  1768 signals to stop and continue a process.
  1769 
  1770 :connection-type TYPE -- TYPE is control type of device used to
  1771 communicate with subprocesses.  Values are `pipe' to use a pipe, `pty'
  1772 to use a pty, or nil to use the default specified through
  1773 `process-connection-type'.  If TYPE is a cons (INPUT . OUTPUT), then
  1774 INPUT will be used for standard input and OUTPUT for standard output
  1775 (and standard error if `:stderr' is nil).
  1776 
  1777 :filter FILTER -- Install FILTER as the process filter.
  1778 
  1779 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
  1780 
  1781 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
  1782 to the standard error of subprocess.  When specifying this, the
  1783 subprocess's standard error will always communicate via a pipe, no
  1784 matter the value of `:connection-type'.  If STDERR is nil, standard error
  1785 is mixed with standard output and sent to BUFFER or FILTER.  (Note
  1786 that specifying :stderr will create a new, separate (but associated)
  1787 process, with its own filter and sentinel.  See
  1788 Info node `(elisp) Asynchronous Processes' for more details.)
  1789 
  1790 :file-handler FILE-HANDLER -- If FILE-HANDLER is non-nil, then look
  1791 for a file name handler for the current buffer's `default-directory'
  1792 and invoke that file name handler to make the process.  If there is no
  1793 such handler, proceed as if FILE-HANDLER were nil.
  1794 
  1795 usage: (make-process &rest ARGS)  */)
  1796   (ptrdiff_t nargs, Lisp_Object *args)
  1797 {
  1798   Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
  1799   Lisp_Object xstderr, stderrproc;
  1800   specpdl_ref count = SPECPDL_INDEX ();
  1801 
  1802   if (nargs == 0)
  1803     return Qnil;
  1804 
  1805   /* Save arguments for process-contact and clone-process.  */
  1806   contact = Flist (nargs, args);
  1807 
  1808   if (!NILP (plist_get (contact, QCfile_handler)))
  1809     {
  1810       Lisp_Object file_handler
  1811         = Ffind_file_name_handler (BVAR (current_buffer, directory),
  1812                                    Qmake_process);
  1813       if (!NILP (file_handler))
  1814         return CALLN (Fapply, file_handler, Qmake_process, contact);
  1815     }
  1816 
  1817   buffer = plist_get (contact, QCbuffer);
  1818   if (!NILP (buffer))
  1819     buffer = Fget_buffer_create (buffer, Qnil);
  1820 
  1821   /* Make sure that the child will be able to chdir to the current
  1822      buffer's current directory, or its unhandled equivalent.  We
  1823      can't just have the child check for an error when it does the
  1824      chdir, since it's in a vfork.  */
  1825   current_dir = get_current_directory (true);
  1826 
  1827   name = plist_get (contact, QCname);
  1828   CHECK_STRING (name);
  1829 
  1830   command = plist_get (contact, QCcommand);
  1831   if (CONSP (command))
  1832     program = XCAR (command);
  1833   else
  1834     program = Qnil;
  1835 
  1836   if (!NILP (program))
  1837     CHECK_STRING (program);
  1838 
  1839   bool query_on_exit = NILP (plist_get (contact, QCnoquery));
  1840 
  1841   stderrproc = Qnil;
  1842   xstderr = plist_get (contact, QCstderr);
  1843   if (PROCESSP (xstderr))
  1844     {
  1845       if (!PIPECONN_P (xstderr))
  1846         error ("Process is not a pipe process");
  1847       stderrproc = xstderr;
  1848     }
  1849   else if (!NILP (xstderr))
  1850     {
  1851       CHECK_STRING (program);
  1852       stderrproc = CALLN (Fmake_pipe_process,
  1853                           QCname,
  1854                           concat2 (name, build_string (" stderr")),
  1855                           QCbuffer,
  1856                           Fget_buffer_create (xstderr, Qnil),
  1857                           QCnoquery,
  1858                           query_on_exit ? Qnil : Qt);
  1859     }
  1860 
  1861   proc = make_process (name);
  1862   record_unwind_protect (start_process_unwind, proc);
  1863 
  1864   pset_childp (XPROCESS (proc), Qt);
  1865   eassert (NILP (XPROCESS (proc)->plist));
  1866   pset_type (XPROCESS (proc), Qreal);
  1867   pset_buffer (XPROCESS (proc), buffer);
  1868   pset_sentinel (XPROCESS (proc), plist_get (contact, QCsentinel));
  1869   pset_filter (XPROCESS (proc), plist_get (contact, QCfilter));
  1870   pset_command (XPROCESS (proc), Fcopy_sequence (command));
  1871 
  1872   if (!query_on_exit)
  1873     XPROCESS (proc)->kill_without_query = 1;
  1874   tem = plist_get (contact, QCstop);
  1875   /* Normal processes can't be started in a stopped state, see
  1876      Bug#30460.  */
  1877   CHECK_TYPE (NILP (tem), Qnull, tem);
  1878 
  1879   tem = plist_get (contact, QCconnection_type);
  1880   if (CONSP (tem))
  1881     {
  1882       XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem));
  1883       XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem));
  1884     }
  1885   else
  1886     {
  1887       XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
  1888         is_pty_from_symbol (tem);
  1889     }
  1890 
  1891   if (!NILP (stderrproc))
  1892     pset_stderrproc (XPROCESS (proc), stderrproc);
  1893 
  1894 #ifdef HAVE_GNUTLS
  1895   /* AKA GNUTLS_INITSTAGE(proc).  */
  1896   verify (GNUTLS_STAGE_EMPTY == 0);
  1897   eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
  1898   eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
  1899 #endif
  1900 
  1901   XPROCESS (proc)->adaptive_read_buffering
  1902     = (NILP (Vprocess_adaptive_read_buffering) ? 0
  1903        : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
  1904 
  1905   /* Make the process marker point into the process buffer (if any).  */
  1906   update_process_mark (XPROCESS (proc));
  1907 
  1908   USE_SAFE_ALLOCA;
  1909 
  1910   {
  1911     /* Decide coding systems for communicating with the process.  Here
  1912        we don't setup the structure coding_system nor pay attention to
  1913        unibyte mode.  They are done in create_process.  */
  1914 
  1915     /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
  1916     Lisp_Object coding_systems = Qt;
  1917     Lisp_Object val, *args2;
  1918 
  1919     tem = plist_get (contact, QCcoding);
  1920     if (!NILP (tem))
  1921       {
  1922         val = tem;
  1923         if (CONSP (val))
  1924           val = XCAR (val);
  1925       }
  1926     else
  1927       val = Vcoding_system_for_read;
  1928     if (NILP (val))
  1929       {
  1930         ptrdiff_t nargs2 = 3 + list_length (command);
  1931         Lisp_Object tem2;
  1932         SAFE_ALLOCA_LISP (args2, nargs2);
  1933         ptrdiff_t i = 0;
  1934         args2[i++] = Qstart_process;
  1935         args2[i++] = name;
  1936         args2[i++] = buffer;
  1937         for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
  1938           args2[i++] = XCAR (tem2);
  1939         if (!NILP (program))
  1940           coding_systems = Ffind_operation_coding_system (nargs2, args2);
  1941         if (CONSP (coding_systems))
  1942           val = XCAR (coding_systems);
  1943         else if (CONSP (Vdefault_process_coding_system))
  1944           val = XCAR (Vdefault_process_coding_system);
  1945       }
  1946     pset_decode_coding_system (XPROCESS (proc), val);
  1947 
  1948     if (!NILP (tem))
  1949       {
  1950         val = tem;
  1951         if (CONSP (val))
  1952           val = XCDR (val);
  1953       }
  1954     else
  1955       val = Vcoding_system_for_write;
  1956     if (NILP (val))
  1957       {
  1958         if (EQ (coding_systems, Qt))
  1959           {
  1960             ptrdiff_t nargs2 = 3 + list_length (command);
  1961             Lisp_Object tem2;
  1962             SAFE_ALLOCA_LISP (args2, nargs2);
  1963             ptrdiff_t i = 0;
  1964             args2[i++] = Qstart_process;
  1965             args2[i++] = name;
  1966             args2[i++] = buffer;
  1967             for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
  1968               args2[i++] = XCAR (tem2);
  1969             if (!NILP (program))
  1970               coding_systems = Ffind_operation_coding_system (nargs2, args2);
  1971           }
  1972         if (CONSP (coding_systems))
  1973           val = XCDR (coding_systems);
  1974         else if (CONSP (Vdefault_process_coding_system))
  1975           val = XCDR (Vdefault_process_coding_system);
  1976       }
  1977     pset_encode_coding_system (XPROCESS (proc), val);
  1978     /* Note: At this moment, the above coding system may leave
  1979        text-conversion or eol-conversion unspecified.  They will be
  1980        decided after we read output from the process and decode it by
  1981        some coding system, or just before we actually send a text to
  1982        the process.  */
  1983   }
  1984 
  1985 
  1986   pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
  1987   eassert (XPROCESS (proc)->decoding_carryover == 0);
  1988   pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
  1989 
  1990   XPROCESS (proc)->inherit_coding_system_flag
  1991     = !(NILP (buffer) || !inherit_process_coding_system);
  1992 
  1993   if (!NILP (program))
  1994     {
  1995       Lisp_Object program_args = XCDR (command);
  1996 
  1997       /* If program file name is not absolute, search our path for it.
  1998          Put the name we will really use in TEM.  */
  1999       if (!IS_DIRECTORY_SEP (SREF (program, 0))
  2000           && !(SCHARS (program) > 1
  2001                && IS_DEVICE_SEP (SREF (program, 1))))
  2002         {
  2003           tem = Qnil;
  2004           openp (Vexec_path, program, Vexec_suffixes, &tem,
  2005                  make_fixnum (X_OK), false, false);
  2006           if (NILP (tem))
  2007             report_file_error ("Searching for program", program);
  2008           tem = Fexpand_file_name (tem, Qnil);
  2009         }
  2010       else
  2011         {
  2012           if (!NILP (Ffile_directory_p (program)))
  2013             error ("Specified program for new process is a directory");
  2014           tem = program;
  2015         }
  2016 
  2017       /* Remove "/:" from TEM.  */
  2018       tem = remove_slash_colon (tem);
  2019 
  2020       Lisp_Object arg_encoding = Qnil;
  2021 
  2022       /* Encode the file name and put it in NEW_ARGV.
  2023          That's where the child will use it to execute the program.  */
  2024       tem = list1 (ENCODE_FILE (tem));
  2025       ptrdiff_t new_argc = 1;
  2026 
  2027       /* Here we encode arguments by the coding system used for sending
  2028          data to the process.  We don't support using different coding
  2029          systems for encoding arguments and for encoding data sent to the
  2030          process.  */
  2031 
  2032       for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
  2033         {
  2034           Lisp_Object arg = XCAR (tem2);
  2035           CHECK_STRING (arg);
  2036           if (STRING_MULTIBYTE (arg))
  2037             {
  2038               if (NILP (arg_encoding))
  2039                 arg_encoding = (complement_process_encoding_system
  2040                                 (XPROCESS (proc)->encode_coding_system));
  2041               arg = code_convert_string_norecord (arg, arg_encoding, 1);
  2042             }
  2043           tem = Fcons (arg, tem);
  2044           new_argc++;
  2045         }
  2046 
  2047       /* Now that everything is encoded we can collect the strings into
  2048          NEW_ARGV.  */
  2049       char **new_argv;
  2050       SAFE_NALLOCA (new_argv, 1, new_argc + 1);
  2051       new_argv[new_argc] = 0;
  2052 
  2053       for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
  2054         {
  2055           new_argv[i] = SSDATA (XCAR (tem));
  2056           tem = XCDR (tem);
  2057         }
  2058 
  2059       create_process (proc, new_argv, current_dir);
  2060     }
  2061   else
  2062     create_pty (proc);
  2063 
  2064   return SAFE_FREE_UNBIND_TO (count, proc);
  2065 }
  2066 
  2067 /* If PROC doesn't have its pid set, then an error was signaled and
  2068    the process wasn't started successfully, so remove it.  */
  2069 static void
  2070 start_process_unwind (Lisp_Object proc)
  2071 {
  2072   if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
  2073     remove_process (proc);
  2074 }
  2075 
  2076 /* If *FD_ADDR is nonnegative, close it, and mark it as closed.  */
  2077 
  2078 static void
  2079 close_process_fd (int *fd_addr)
  2080 {
  2081   int fd = *fd_addr;
  2082   if (0 <= fd)
  2083     {
  2084       *fd_addr = -1;
  2085       emacs_close (fd);
  2086     }
  2087 }
  2088 
  2089 void
  2090 dissociate_controlling_tty (void)
  2091 {
  2092   if (setsid () < 0)
  2093     {
  2094 #ifdef TIOCNOTTY
  2095       /* Needed on Darwin after vfork, since setsid fails in a vforked
  2096          child that has not execed.
  2097          I wonder: would just ioctl (fd, TIOCNOTTY, 0) work here, for
  2098          some fd that the caller already has?  */
  2099       int ttyfd = emacs_open (DEV_TTY, O_RDWR, 0);
  2100       if (0 <= ttyfd)
  2101         {
  2102           ioctl (ttyfd, TIOCNOTTY, 0);
  2103           emacs_close (ttyfd);
  2104         }
  2105 #endif
  2106     }
  2107 }
  2108 
  2109 /* Indexes of file descriptors in open_fds.  */
  2110 enum
  2111   {
  2112     /* The pipe from Emacs to its subprocess.  */
  2113     SUBPROCESS_STDIN,
  2114     WRITE_TO_SUBPROCESS,
  2115 
  2116     /* The main pipe from the subprocess to Emacs.  */
  2117     READ_FROM_SUBPROCESS,
  2118     SUBPROCESS_STDOUT,
  2119 
  2120     /* The pipe from the subprocess to Emacs that is closed when the
  2121        subprocess execs.  */
  2122     READ_FROM_EXEC_MONITOR,
  2123     EXEC_MONITOR_OUTPUT
  2124   };
  2125 
  2126 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
  2127 
  2128 static void
  2129 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
  2130 {
  2131   struct Lisp_Process *p = XPROCESS (process);
  2132   int inchannel = -1, outchannel = -1;
  2133   pid_t pid = -1;
  2134   int vfork_errno;
  2135   int forkin, forkout, forkerr = -1;
  2136   bool pty_in = false, pty_out = false;
  2137   char pty_name[PTY_NAME_SIZE];
  2138   Lisp_Object lisp_pty_name = Qnil;
  2139   int ptychannel = -1, pty_tty = -1;
  2140   sigset_t oldset;
  2141 
  2142   /* Ensure that the SIGCHLD handler can notify
  2143      `wait_reading_process_output'.  */
  2144   child_signal_init ();
  2145 
  2146   if (p->pty_in || p->pty_out)
  2147     ptychannel = allocate_pty (pty_name);
  2148 
  2149   if (ptychannel >= 0)
  2150     {
  2151 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
  2152       /* On most USG systems it does not work to open the pty's tty here,
  2153          then close it and reopen it in the child.  */
  2154       /* Don't let this terminal become our controlling terminal
  2155          (in case we don't have one).  */
  2156       pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
  2157       if (pty_tty < 0)
  2158         report_file_error ("Opening pty", Qnil);
  2159 #endif /* not USG, or USG_SUBTTY_WORKS */
  2160       pty_in = p->pty_in;
  2161       pty_out = p->pty_out;
  2162       lisp_pty_name = build_string (pty_name);
  2163     }
  2164 
  2165   /* Set up stdin for the child process.  */
  2166   if (ptychannel >= 0 && p->pty_in)
  2167     {
  2168       p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
  2169       outchannel = ptychannel;
  2170     }
  2171   else
  2172     {
  2173       if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
  2174         report_file_error ("Creating pipe", Qnil);
  2175       forkin = p->open_fd[SUBPROCESS_STDIN];
  2176       outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
  2177     }
  2178 
  2179   /* Set up stdout for the child process.  */
  2180   if (ptychannel >= 0 && p->pty_out)
  2181     {
  2182       forkout = pty_tty;
  2183       p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
  2184     }
  2185   else
  2186     {
  2187       if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
  2188         report_file_error ("Creating pipe", Qnil);
  2189       inchannel = p->open_fd[READ_FROM_SUBPROCESS];
  2190       forkout = p->open_fd[SUBPROCESS_STDOUT];
  2191 
  2192 #if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
  2193       fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
  2194 #endif
  2195     }
  2196 
  2197   if (!NILP (p->stderrproc))
  2198     {
  2199       struct Lisp_Process *pp = XPROCESS (p->stderrproc);
  2200 
  2201       forkerr = pp->open_fd[SUBPROCESS_STDOUT];
  2202 
  2203       /* Close unnecessary file descriptors.  */
  2204       close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
  2205       close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
  2206     }
  2207 
  2208   if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
  2209     report_file_errno ("Creating pipe", Qnil, EMFILE);
  2210 
  2211 #ifndef WINDOWSNT
  2212   if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
  2213     report_file_error ("Creating pipe", Qnil);
  2214 #endif
  2215 
  2216   fcntl (inchannel, F_SETFL, O_NONBLOCK);
  2217   fcntl (outchannel, F_SETFL, O_NONBLOCK);
  2218 
  2219   /* Record this as an active process, with its channels.  */
  2220   eassert (0 <= inchannel && inchannel < FD_SETSIZE);
  2221   chan_process[inchannel] = process;
  2222   p->infd = inchannel;
  2223   p->outfd = outchannel;
  2224 
  2225   /* Previously we recorded the tty descriptor used in the subprocess.
  2226      It was only used for getting the foreground tty process, so now
  2227      we just reopen the device (see emacs_get_tty_pgrp) as this is
  2228      more portable (see USG_SUBTTY_WORKS above).  */
  2229 
  2230   p->pty_in = pty_in;
  2231   p->pty_out = pty_out;
  2232   pset_status (p, Qrun);
  2233 
  2234   if (!EQ (p->command, Qt)
  2235       && !EQ (p->filter, Qt))
  2236     add_process_read_fd (inchannel);
  2237 
  2238   specpdl_ref count = SPECPDL_INDEX ();
  2239 
  2240   /* This may signal an error.  */
  2241   setup_process_coding_systems (process);
  2242   char **env = make_environment_block (current_dir);
  2243 
  2244   block_input ();
  2245   block_child_signal (&oldset);
  2246 
  2247   pty_in = p->pty_in;
  2248   pty_out = p->pty_out;
  2249   eassert ((pty_in || pty_out) == ! NILP (lisp_pty_name));
  2250 
  2251   vfork_errno
  2252     = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
  2253                    SSDATA (current_dir),
  2254                    pty_in || pty_out ? SSDATA (lisp_pty_name) : NULL,
  2255                    pty_in, pty_out, &oldset);
  2256 
  2257   eassert ((vfork_errno == 0) == (0 < pid));
  2258 
  2259   p->pid = pid;
  2260   if (pid >= 0)
  2261     p->alive = 1;
  2262 
  2263   /* Stop blocking in the parent.  */
  2264   unblock_child_signal (&oldset);
  2265   unblock_input ();
  2266 
  2267   /* Environment block no longer needed.  */
  2268   unbind_to (count, Qnil);
  2269 
  2270   if (pid < 0)
  2271     report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno);
  2272   else
  2273     {
  2274       /* vfork succeeded.  */
  2275 
  2276       /* Close the pipe ends that the child uses, or the child's pty.  */
  2277       close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
  2278       close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
  2279 
  2280 #ifdef WINDOWSNT
  2281       register_child (pid, inchannel);
  2282 #endif /* WINDOWSNT */
  2283 
  2284       pset_tty_name (p, lisp_pty_name);
  2285 
  2286 #ifndef WINDOWSNT
  2287       /* Wait for child_setup to complete in case that vfork is
  2288          actually defined as fork.  The descriptor
  2289          XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
  2290          of a pipe is closed at the child side either by close-on-exec
  2291          on successful execve or the _exit call in child_setup.  */
  2292       {
  2293         char dummy;
  2294 
  2295         close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
  2296         emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
  2297         close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
  2298       }
  2299 #endif
  2300       if (!NILP (p->stderrproc))
  2301         {
  2302           struct Lisp_Process *pp = XPROCESS (p->stderrproc);
  2303           close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
  2304         }
  2305     }
  2306 }
  2307 
  2308 static void
  2309 create_pty (Lisp_Object process)
  2310 {
  2311   struct Lisp_Process *p = XPROCESS (process);
  2312   char pty_name[PTY_NAME_SIZE];
  2313   int pty_fd = !(p->pty_in || p->pty_out) ? -1 : allocate_pty (pty_name);
  2314 
  2315   if (pty_fd >= 0)
  2316     {
  2317       p->open_fd[SUBPROCESS_STDIN] = pty_fd;
  2318       if (FD_SETSIZE <= pty_fd)
  2319         report_file_errno ("Opening pty", Qnil, EMFILE);
  2320 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
  2321       /* On most USG systems it does not work to open the pty's tty here,
  2322          then close it and reopen it in the child.  */
  2323       /* Don't let this terminal become our controlling terminal
  2324          (in case we don't have one).  */
  2325       int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
  2326       if (forkout < 0)
  2327         report_file_error ("Opening pty", Qnil);
  2328       p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
  2329 #if defined (DONT_REOPEN_PTY)
  2330       /* In the case that vfork is defined as fork, the parent process
  2331          (Emacs) may send some data before the child process completes
  2332          tty options setup.  So we setup tty before forking.  */
  2333       child_setup_tty (forkout);
  2334 #endif /* DONT_REOPEN_PTY */
  2335 #endif /* not USG, or USG_SUBTTY_WORKS */
  2336 
  2337       fcntl (pty_fd, F_SETFL, O_NONBLOCK);
  2338 
  2339       /* Record this as an active process, with its channels.
  2340          As a result, child_setup will close Emacs's side of the pipes.  */
  2341       eassert (0 <= pty_fd && pty_fd < FD_SETSIZE);
  2342       chan_process[pty_fd] = process;
  2343       p->infd = pty_fd;
  2344       p->outfd = pty_fd;
  2345 
  2346       /* Previously we recorded the tty descriptor used in the subprocess.
  2347          It was only used for getting the foreground tty process, so now
  2348          we just reopen the device (see emacs_get_tty_pgrp) as this is
  2349          more portable (see USG_SUBTTY_WORKS above).  */
  2350 
  2351       p->pty_in = p->pty_out = true;
  2352       pset_status (p, Qrun);
  2353       setup_process_coding_systems (process);
  2354 
  2355       if (!EQ (p->filter, Qt))
  2356         add_process_read_fd (pty_fd);
  2357 
  2358       pset_tty_name (p, build_string (pty_name));
  2359     }
  2360 
  2361   p->pid = -2;
  2362 }
  2363 
  2364 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
  2365        0, MANY, 0,
  2366        doc: /* Create and return a bidirectional pipe process.
  2367 
  2368 In Emacs, pipes are represented by process objects, so input and
  2369 output work as for subprocesses, and `delete-process' closes a pipe.
  2370 However, a pipe process has no process id, it cannot be signaled,
  2371 and the status codes are different from normal processes.
  2372 
  2373 Arguments are specified as keyword/argument pairs.  The following
  2374 arguments are defined:
  2375 
  2376 :name NAME -- NAME is the name of the process.  It is modified if necessary to make it unique.
  2377 
  2378 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
  2379 with the process.  Process output goes at the end of that buffer,
  2380 unless you specify a filter function to handle the output.  If BUFFER
  2381 is not given, the value of NAME is used.
  2382 
  2383 :coding CODING -- If CODING is a symbol, it specifies the coding
  2384 system used for both reading and writing for this process.  If CODING
  2385 is a cons (DECODING . ENCODING), DECODING is used for reading, and
  2386 ENCODING is used for writing.
  2387 
  2388 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
  2389 the process is running.  If BOOL is not given, query before exiting.
  2390 
  2391 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
  2392 In the stopped state, a pipe process does not accept incoming data,
  2393 but you can send outgoing data.  The stopped state is cleared by
  2394 `continue-process' and set by `stop-process'.
  2395 
  2396 :filter FILTER -- Install FILTER as the process filter.
  2397 
  2398 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
  2399 
  2400 usage:  (make-pipe-process &rest ARGS)  */)
  2401   (ptrdiff_t nargs, Lisp_Object *args)
  2402 {
  2403   Lisp_Object proc, contact;
  2404   struct Lisp_Process *p;
  2405   Lisp_Object name, buffer;
  2406   Lisp_Object tem;
  2407   int inchannel, outchannel;
  2408 
  2409   if (nargs == 0)
  2410     return Qnil;
  2411 
  2412   contact = Flist (nargs, args);
  2413 
  2414   name = plist_get (contact, QCname);
  2415   CHECK_STRING (name);
  2416   proc = make_process (name);
  2417   specpdl_ref specpdl_count = SPECPDL_INDEX ();
  2418   record_unwind_protect (remove_process, proc);
  2419   p = XPROCESS (proc);
  2420 
  2421   if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
  2422       || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
  2423     report_file_error ("Creating pipe", Qnil);
  2424   outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
  2425   inchannel = p->open_fd[READ_FROM_SUBPROCESS];
  2426 
  2427   if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
  2428     report_file_errno ("Creating pipe", Qnil, EMFILE);
  2429 
  2430   fcntl (inchannel, F_SETFL, O_NONBLOCK);
  2431   fcntl (outchannel, F_SETFL, O_NONBLOCK);
  2432 
  2433 #ifdef WINDOWSNT
  2434   register_aux_fd (inchannel);
  2435 #endif
  2436 
  2437   /* Record this as an active process, with its channels.  */
  2438   eassert (0 <= inchannel && inchannel < FD_SETSIZE);
  2439   chan_process[inchannel] = proc;
  2440   p->infd = inchannel;
  2441   p->outfd = outchannel;
  2442 
  2443   if (inchannel > max_desc)
  2444     max_desc = inchannel;
  2445 
  2446   buffer = plist_get (contact, QCbuffer);
  2447   if (NILP (buffer))
  2448     buffer = name;
  2449   buffer = Fget_buffer_create (buffer, Qnil);
  2450   pset_buffer (p, buffer);
  2451 
  2452   pset_childp (p, contact);
  2453   pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
  2454   pset_type (p, Qpipe);
  2455   pset_sentinel (p, plist_get (contact, QCsentinel));
  2456   pset_filter (p, plist_get (contact, QCfilter));
  2457   eassert (NILP (p->log));
  2458   if (tem = plist_get (contact, QCnoquery), !NILP (tem))
  2459     p->kill_without_query = 1;
  2460   if (tem = plist_get (contact, QCstop), !NILP (tem))
  2461     pset_command (p, Qt);
  2462   eassert (! p->pty_in && ! p->pty_out);
  2463 
  2464   if (!EQ (p->command, Qt)
  2465       && !EQ (p->filter, Qt))
  2466     add_process_read_fd (inchannel);
  2467   p->adaptive_read_buffering
  2468     = (NILP (Vprocess_adaptive_read_buffering) ? 0
  2469        : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
  2470 
  2471   /* Make the process marker point into the process buffer (if any).  */
  2472   update_process_mark (p);
  2473 
  2474   {
  2475     /* Setup coding systems for communicating with the network stream.  */
  2476 
  2477     /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
  2478     Lisp_Object coding_systems = Qt;
  2479     Lisp_Object val;
  2480 
  2481     tem = plist_get (contact, QCcoding);
  2482     val = Qnil;
  2483     if (!NILP (tem))
  2484       {
  2485         val = tem;
  2486         if (CONSP (val))
  2487           val = XCAR (val);
  2488       }
  2489     else if (!NILP (Vcoding_system_for_read))
  2490       val = Vcoding_system_for_read;
  2491     else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
  2492              || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
  2493       /* We dare not decode end-of-line format by setting VAL to
  2494          Qraw_text, because the existing Emacs Lisp libraries
  2495          assume that they receive bare code including a sequence of
  2496          CR LF.  */
  2497       val = Qnil;
  2498     else
  2499       {
  2500         if (CONSP (coding_systems))
  2501           val = XCAR (coding_systems);
  2502         else if (CONSP (Vdefault_process_coding_system))
  2503           val = XCAR (Vdefault_process_coding_system);
  2504         else
  2505           val = Qnil;
  2506       }
  2507     pset_decode_coding_system (p, val);
  2508 
  2509     if (!NILP (tem))
  2510       {
  2511         val = tem;
  2512         if (CONSP (val))
  2513           val = XCDR (val);
  2514       }
  2515     else if (!NILP (Vcoding_system_for_write))
  2516       val = Vcoding_system_for_write;
  2517     else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  2518       val = Qnil;
  2519     else
  2520       {
  2521         if (CONSP (coding_systems))
  2522           val = XCDR (coding_systems);
  2523         else if (CONSP (Vdefault_process_coding_system))
  2524           val = XCDR (Vdefault_process_coding_system);
  2525         else
  2526           val = Qnil;
  2527       }
  2528     pset_encode_coding_system (p, val);
  2529   }
  2530   /* This may signal an error.  */
  2531   setup_process_coding_systems (proc);
  2532 
  2533   pset_decoding_buf (p, empty_unibyte_string);
  2534   eassert (p->decoding_carryover == 0);
  2535   pset_encoding_buf (p, empty_unibyte_string);
  2536 
  2537   specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
  2538 
  2539   return proc;
  2540 }
  2541 
  2542 
  2543 /* Convert an internal struct sockaddr to a lisp object (vector or string).
  2544    The address family of sa is not included in the result.  */
  2545 
  2546 Lisp_Object
  2547 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
  2548 {
  2549   Lisp_Object address;
  2550   unsigned char *cp;
  2551   struct Lisp_Vector *p;
  2552 
  2553   /* Workaround for a bug in getsockname on BSD: Names bound to
  2554      sockets in the UNIX domain are inaccessible; getsockname returns
  2555      a zero length name.  */
  2556   if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
  2557     return empty_unibyte_string;
  2558 
  2559   switch (sa->sa_family)
  2560     {
  2561     case AF_INET:
  2562       {
  2563         DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
  2564         len = sizeof (sin->sin_addr) + 1;
  2565         address = make_uninit_vector (len);
  2566         p = XVECTOR (address);
  2567         p->contents[--len] = make_fixnum (ntohs (sin->sin_port));
  2568         cp = (unsigned char *) &sin->sin_addr;
  2569         break;
  2570       }
  2571 #ifdef AF_INET6
  2572     case AF_INET6:
  2573       {
  2574         DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
  2575         DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
  2576         len = sizeof (sin6->sin6_addr) / 2 + 1;
  2577         address = make_uninit_vector (len);
  2578         p = XVECTOR (address);
  2579         p->contents[--len] = make_fixnum (ntohs (sin6->sin6_port));
  2580         for (ptrdiff_t i = 0; i < len; i++)
  2581           p->contents[i] = make_fixnum (ntohs (ip6[i]));
  2582         return address;
  2583       }
  2584 #endif
  2585 #ifdef HAVE_LOCAL_SOCKETS
  2586     case AF_LOCAL:
  2587       {
  2588         DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
  2589         ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
  2590         /* If the first byte is NUL, the name is a Linux abstract
  2591            socket name, and the name can contain embedded NULs.  If
  2592            it's not, we have a NUL-terminated string.  Be careful not
  2593            to walk past the end of the object looking for the name
  2594            terminator, however.  */
  2595         if (name_length > 0 && sockun->sun_path[0] != '\0')
  2596           {
  2597             const char *terminator
  2598               = memchr (sockun->sun_path, '\0', name_length);
  2599 
  2600             if (terminator)
  2601               name_length = terminator - (const char *) sockun->sun_path;
  2602           }
  2603 
  2604         return make_unibyte_string (sockun->sun_path, name_length);
  2605       }
  2606 #endif
  2607     default:
  2608       len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
  2609       address = Fcons (make_fixnum (sa->sa_family), make_nil_vector (len));
  2610       p = XVECTOR (XCDR (address));
  2611       cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
  2612       break;
  2613     }
  2614 
  2615   for (ptrdiff_t i = 0; i < len; i++)
  2616     p->contents[i] = make_fixnum (*cp++);
  2617 
  2618   return address;
  2619 }
  2620 
  2621 /* Convert an internal struct addrinfo to a Lisp object.  */
  2622 
  2623 static Lisp_Object
  2624 conv_addrinfo_to_lisp (struct addrinfo *res)
  2625 {
  2626   Lisp_Object protocol = make_fixnum (res->ai_protocol);
  2627   eassert (XFIXNUM (protocol) == res->ai_protocol);
  2628   return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
  2629 }
  2630 
  2631 
  2632 /* Get family and required size for sockaddr structure to hold ADDRESS.  */
  2633 
  2634 static ptrdiff_t
  2635 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
  2636 {
  2637   struct Lisp_Vector *p;
  2638 
  2639   if (VECTORP (address))
  2640     {
  2641       p = XVECTOR (address);
  2642       if (p->header.size == 5)
  2643         {
  2644           *familyp = AF_INET;
  2645           return sizeof (struct sockaddr_in);
  2646         }
  2647 #ifdef AF_INET6
  2648       else if (p->header.size == 9)
  2649         {
  2650           *familyp = AF_INET6;
  2651           return sizeof (struct sockaddr_in6);
  2652         }
  2653 #endif
  2654     }
  2655 #ifdef HAVE_LOCAL_SOCKETS
  2656   else if (STRINGP (address))
  2657     {
  2658       *familyp = AF_LOCAL;
  2659       return sizeof (struct sockaddr_un);
  2660     }
  2661 #endif
  2662   else if (CONSP (address) && TYPE_RANGED_FIXNUMP (int, XCAR (address))
  2663            && VECTORP (XCDR (address)))
  2664     {
  2665       struct sockaddr *sa;
  2666       p = XVECTOR (XCDR (address));
  2667       if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
  2668         return 0;
  2669       *familyp = XFIXNUM (XCAR (address));
  2670       return p->header.size + sizeof (sa->sa_family);
  2671     }
  2672   return 0;
  2673 }
  2674 
  2675 /* Convert an address object (vector or string) to an internal sockaddr.
  2676 
  2677    The address format has been basically validated by
  2678    get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
  2679    it could have come from user data.  So if FAMILY is not valid,
  2680    we return after zeroing *SA.  */
  2681 
  2682 static void
  2683 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
  2684 {
  2685   register struct Lisp_Vector *p;
  2686   register unsigned char *cp = NULL;
  2687   register int i;
  2688   EMACS_INT hostport;
  2689 
  2690   memset (sa, 0, len);
  2691 
  2692   if (VECTORP (address))
  2693     {
  2694       p = XVECTOR (address);
  2695       if (family == AF_INET)
  2696         {
  2697           DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
  2698           len = sizeof (sin->sin_addr) + 1;
  2699           hostport = XFIXNUM (p->contents[--len]);
  2700           sin->sin_port = htons (hostport);
  2701           cp = (unsigned char *)&sin->sin_addr;
  2702           sa->sa_family = family;
  2703         }
  2704 #ifdef AF_INET6
  2705       else if (family == AF_INET6)
  2706         {
  2707           DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
  2708           DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
  2709           len = sizeof (sin6->sin6_addr) / 2 + 1;
  2710           hostport = XFIXNUM (p->contents[--len]);
  2711           sin6->sin6_port = htons (hostport);
  2712           for (i = 0; i < len; i++)
  2713             if (FIXNUMP (p->contents[i]))
  2714               {
  2715                 int j = XFIXNUM (p->contents[i]) & 0xffff;
  2716                 ip6[i] = ntohs (j);
  2717               }
  2718           sa->sa_family = family;
  2719           return;
  2720         }
  2721 #endif
  2722       else
  2723         return;
  2724     }
  2725   else if (STRINGP (address))
  2726     {
  2727 #ifdef HAVE_LOCAL_SOCKETS
  2728       if (family == AF_LOCAL)
  2729         {
  2730           DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
  2731           cp = SDATA (address);
  2732           for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
  2733             sockun->sun_path[i] = *cp++;
  2734           sa->sa_family = family;
  2735         }
  2736 #endif
  2737       return;
  2738     }
  2739   else
  2740     {
  2741       p = XVECTOR (XCDR (address));
  2742       cp = (unsigned char *)sa + sizeof (sa->sa_family);
  2743     }
  2744 
  2745   for (i = 0; i < len; i++)
  2746     if (FIXNUMP (p->contents[i]))
  2747       *cp++ = XFIXNAT (p->contents[i]) & 0xff;
  2748 }
  2749 
  2750 #ifdef DATAGRAM_SOCKETS
  2751 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
  2752        1, 1, 0,
  2753        doc: /* Get the current datagram address associated with PROCESS.
  2754 If PROCESS is a non-blocking network process that hasn't been fully
  2755 set up yet, this function will block until socket setup has completed.  */)
  2756   (Lisp_Object process)
  2757 {
  2758   int channel;
  2759 
  2760   CHECK_PROCESS (process);
  2761 
  2762   if (NETCONN_P (process))
  2763     wait_for_socket_fds (process, "process-datagram-address");
  2764 
  2765   if (!DATAGRAM_CONN_P (process))
  2766     return Qnil;
  2767 
  2768   channel = XPROCESS (process)->infd;
  2769   eassert (0 <= channel && channel < FD_SETSIZE);
  2770   return conv_sockaddr_to_lisp (datagram_address[channel].sa,
  2771                                 datagram_address[channel].len);
  2772 }
  2773 
  2774 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
  2775        2, 2, 0,
  2776        doc: /* Set the datagram address for PROCESS to ADDRESS.
  2777 Return nil upon error setting address, ADDRESS otherwise.
  2778 
  2779 If PROCESS is a non-blocking network process that hasn't been fully
  2780 set up yet, this function will block until socket setup has completed.  */)
  2781   (Lisp_Object process, Lisp_Object address)
  2782 {
  2783   int channel;
  2784   int family;
  2785   ptrdiff_t len;
  2786 
  2787   CHECK_PROCESS (process);
  2788 
  2789   if (NETCONN_P (process))
  2790     wait_for_socket_fds (process, "set-process-datagram-address");
  2791 
  2792   if (!DATAGRAM_CONN_P (process))
  2793     return Qnil;
  2794 
  2795   channel = XPROCESS (process)->infd;
  2796 
  2797   len = get_lisp_to_sockaddr_size (address, &family);
  2798   eassert (0 <= channel && channel < FD_SETSIZE);
  2799   if (len == 0 || datagram_address[channel].len != len)
  2800     return Qnil;
  2801   conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
  2802   return address;
  2803 }
  2804 #endif
  2805 
  2806 
  2807 static const struct socket_options {
  2808   /* The name of this option.  Should be lowercase version of option
  2809      name without SO_ prefix.  */
  2810   const char *name;
  2811   /* Option level SOL_...  */
  2812   int optlevel;
  2813   /* Option number SO_...  */
  2814   int optnum;
  2815   enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
  2816   enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
  2817 } socket_options[] =
  2818   {
  2819 #ifdef SO_BINDTODEVICE
  2820     { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
  2821 #endif
  2822 #ifdef SO_BROADCAST
  2823     { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
  2824 #endif
  2825 #ifdef SO_DONTROUTE
  2826     { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
  2827 #endif
  2828 #ifdef SO_KEEPALIVE
  2829     { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
  2830 #endif
  2831 #ifdef SO_LINGER
  2832     { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
  2833 #endif
  2834 #ifdef SO_OOBINLINE
  2835     { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
  2836 #endif
  2837 #ifdef SO_PRIORITY
  2838     { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
  2839 #endif
  2840 #ifdef SO_REUSEADDR
  2841     { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
  2842 #endif
  2843     { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
  2844   };
  2845 
  2846 /* Set option OPT to value VAL on socket S.
  2847 
  2848    Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
  2849    Signals an error if setting a known option fails.
  2850 */
  2851 
  2852 static int
  2853 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
  2854 {
  2855   char *name;
  2856   const struct socket_options *sopt;
  2857   int ret = 0;
  2858 
  2859   CHECK_SYMBOL (opt);
  2860 
  2861   name = SSDATA (SYMBOL_NAME (opt));
  2862   for (sopt = socket_options; sopt->name; sopt++)
  2863     if (strcmp (name, sopt->name) == 0)
  2864       break;
  2865 
  2866   switch (sopt->opttype)
  2867     {
  2868     case SOPT_BOOL:
  2869       {
  2870         int optval;
  2871         optval = NILP (val) ? 0 : 1;
  2872         ret = setsockopt (s, sopt->optlevel, sopt->optnum,
  2873                           &optval, sizeof (optval));
  2874         break;
  2875       }
  2876 
  2877     case SOPT_INT:
  2878       {
  2879         int optval;
  2880         if (TYPE_RANGED_FIXNUMP (int, val))
  2881           optval = XFIXNUM (val);
  2882         else
  2883           error ("Bad option value for %s", name);
  2884         ret = setsockopt (s, sopt->optlevel, sopt->optnum,
  2885                           &optval, sizeof (optval));
  2886         break;
  2887       }
  2888 
  2889 #ifdef SO_BINDTODEVICE
  2890     case SOPT_IFNAME:
  2891       {
  2892         char devname[IFNAMSIZ + 1];
  2893 
  2894         /* This is broken, at least in the Linux 2.4 kernel.
  2895            To unbind, the arg must be a zero integer, not the empty string.
  2896            This should work on all systems.   KFS. 2003-09-23.  */
  2897         memset (devname, 0, sizeof devname);
  2898         if (STRINGP (val))
  2899           memcpy (devname, SDATA (val), min (SBYTES (val), IFNAMSIZ));
  2900         else if (!NILP (val))
  2901           error ("Bad option value for %s", name);
  2902         ret = setsockopt (s, sopt->optlevel, sopt->optnum,
  2903                           devname, IFNAMSIZ);
  2904         break;
  2905       }
  2906 #endif
  2907 
  2908 #ifdef SO_LINGER
  2909     case SOPT_LINGER:
  2910       {
  2911         struct linger linger;
  2912 
  2913         linger.l_onoff = 1;
  2914         linger.l_linger = 0;
  2915         if (TYPE_RANGED_FIXNUMP (int, val))
  2916           linger.l_linger = XFIXNUM (val);
  2917         else
  2918           linger.l_onoff = NILP (val) ? 0 : 1;
  2919         ret = setsockopt (s, sopt->optlevel, sopt->optnum,
  2920                           &linger, sizeof (linger));
  2921         break;
  2922       }
  2923 #endif
  2924 
  2925     default:
  2926       return 0;
  2927     }
  2928 
  2929   if (ret < 0)
  2930     {
  2931       int setsockopt_errno = errno;
  2932       report_file_errno ("Cannot set network option", list2 (opt, val),
  2933                          setsockopt_errno);
  2934     }
  2935 
  2936   return (1 << sopt->optbit);
  2937 }
  2938 
  2939 
  2940 DEFUN ("set-network-process-option",
  2941        Fset_network_process_option, Sset_network_process_option,
  2942        3, 4, 0,
  2943        doc: /* For network process PROCESS set option OPTION to value VALUE.
  2944 See `make-network-process' for a list of options and values.
  2945 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
  2946 OPTION is not a supported option, return nil instead; otherwise return t.
  2947 
  2948 If PROCESS is a non-blocking network process that hasn't been fully
  2949 set up yet, this function will block until socket setup has completed. */)
  2950   (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
  2951 {
  2952   int s;
  2953   struct Lisp_Process *p;
  2954 
  2955   CHECK_PROCESS (process);
  2956   p = XPROCESS (process);
  2957   if (!NETCONN1_P (p))
  2958     error ("Process is not a network process");
  2959 
  2960   wait_for_socket_fds (process, "set-network-process-option");
  2961 
  2962   s = p->infd;
  2963   if (s < 0)
  2964     error ("Process is not running");
  2965 
  2966   if (set_socket_option (s, option, value))
  2967     {
  2968       pset_childp (p, plist_put (p->childp, option, value));
  2969       return Qt;
  2970     }
  2971 
  2972   if (NILP (no_error))
  2973     error ("Unknown or unsupported option");
  2974 
  2975   return Qnil;
  2976 }
  2977 
  2978 
  2979 DEFUN ("serial-process-configure",
  2980        Fserial_process_configure,
  2981        Sserial_process_configure,
  2982        0, MANY, 0,
  2983        doc: /* Configure speed, bytesize, etc. of a serial process.
  2984 
  2985 Arguments are specified as keyword/argument pairs.  Attributes that
  2986 are not given are re-initialized from the process's current
  2987 configuration (available via the function `process-contact') or set to
  2988 reasonable default values.  The following arguments are defined:
  2989 
  2990 :process PROCESS
  2991 :name NAME
  2992 :buffer BUFFER
  2993 :port PORT
  2994 -- Any of these arguments can be given to identify the process that is
  2995 to be configured.  If none of these arguments is given, the current
  2996 buffer's process is used.
  2997 
  2998 :speed SPEED -- SPEED is the speed of the serial port in bits per
  2999 second, also called baud rate.  Any value can be given for SPEED, but
  3000 most serial ports work only at a few defined values between 1200 and
  3001 115200, with 9600 being the most common value.  If SPEED is nil, the
  3002 serial port is not configured any further, i.e., all other arguments
  3003 are ignored.  This may be useful for special serial ports such as
  3004 Bluetooth-to-serial converters which can only be configured through AT
  3005 commands.  A value of nil for SPEED can be used only when passed
  3006 through `make-serial-process' or `serial-term'.
  3007 
  3008 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
  3009 can be 7 or 8.  If BYTESIZE is not given or nil, a value of 8 is used.
  3010 
  3011 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
  3012 `odd' (use odd parity), or the symbol `even' (use even parity).  If
  3013 PARITY is not given, no parity is used.
  3014 
  3015 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
  3016 terminate a byte transmission.  STOPBITS can be 1 or 2.  If STOPBITS
  3017 is not given or nil, 1 stopbit is used.
  3018 
  3019 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
  3020 flowcontrol to be used, which is either nil (don't use flowcontrol),
  3021 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
  3022 \(use XON/XOFF software flowcontrol).  If FLOWCONTROL is not given, no
  3023 flowcontrol is used.
  3024 
  3025 `serial-process-configure' is called by `make-serial-process' for the
  3026 initial configuration of the serial port.
  3027 
  3028 Examples:
  3029 
  3030 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
  3031 
  3032 \(serial-process-configure
  3033     :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
  3034 
  3035 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
  3036 
  3037 usage: (serial-process-configure &rest ARGS)  */)
  3038   (ptrdiff_t nargs, Lisp_Object *args)
  3039 {
  3040   struct Lisp_Process *p;
  3041   Lisp_Object contact = Qnil;
  3042   Lisp_Object proc = Qnil;
  3043 
  3044   contact = Flist (nargs, args);
  3045 
  3046   proc = plist_get (contact, QCprocess);
  3047   if (NILP (proc))
  3048     proc = plist_get (contact, QCname);
  3049   if (NILP (proc))
  3050     proc = plist_get (contact, QCbuffer);
  3051   if (NILP (proc))
  3052     proc = plist_get (contact, QCport);
  3053   proc = get_process (proc);
  3054   p = XPROCESS (proc);
  3055   if (!EQ (p->type, Qserial))
  3056     error ("Not a serial process");
  3057 
  3058   if (NILP (plist_get (p->childp, QCspeed)))
  3059     return Qnil;
  3060 
  3061   serial_configure (p, contact);
  3062   return Qnil;
  3063 }
  3064 
  3065 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
  3066        0, MANY, 0,
  3067        doc: /* Create and return a serial port process.
  3068 
  3069 In Emacs, serial port connections are represented by process objects,
  3070 so input and output work as for subprocesses, and `delete-process'
  3071 closes a serial port connection.  However, a serial process has no
  3072 process id, it cannot be signaled, and the status codes are different
  3073 from normal processes.
  3074 
  3075 `make-serial-process' creates a process and a buffer, on which you
  3076 probably want to use `process-send-string'.  Try \\[serial-term] for
  3077 an interactive terminal.  See below for examples.
  3078 
  3079 Arguments are specified as keyword/argument pairs.  The following
  3080 arguments are defined:
  3081 
  3082 :port PORT -- (mandatory) PORT is the path or name of the serial port.
  3083 For example, this could be "/dev/ttyS0" on Unix.  On Windows, this
  3084 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
  3085 the backslashes in strings).
  3086 
  3087 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
  3088 which this function calls.
  3089 
  3090 :name NAME -- NAME is the name of the process.  If NAME is not given,
  3091 the value of PORT is used.
  3092 
  3093 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
  3094 with the process.  Process output goes at the end of that buffer,
  3095 unless you specify a filter function to handle the output.  If BUFFER
  3096 is not given, the value of NAME is used.
  3097 
  3098 :coding CODING -- If CODING is a symbol, it specifies the coding
  3099 system used for both reading and writing for this process.  If CODING
  3100 is a cons (DECODING . ENCODING), DECODING is used for reading, and
  3101 ENCODING is used for writing.
  3102 
  3103 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
  3104 the process is running.  If BOOL is not given, query before exiting.
  3105 
  3106 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
  3107 In the stopped state, a serial process does not accept incoming data,
  3108 but you can send outgoing data.  The stopped state is cleared by
  3109 `continue-process' and set by `stop-process'.
  3110 
  3111 :filter FILTER -- Install FILTER as the process filter.
  3112 
  3113 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
  3114 
  3115 :plist PLIST -- Install PLIST as the initial plist of the process.
  3116 
  3117 :bytesize
  3118 :parity
  3119 :stopbits
  3120 :flowcontrol
  3121 -- This function calls `serial-process-configure' to handle these
  3122 arguments.
  3123 
  3124 The original argument list, possibly modified by later configuration,
  3125 is available via the function `process-contact'.
  3126 
  3127 Examples:
  3128 
  3129 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
  3130 
  3131 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
  3132 
  3133 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
  3134 
  3135 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
  3136 
  3137 usage:  (make-serial-process &rest ARGS)  */)
  3138   (ptrdiff_t nargs, Lisp_Object *args)
  3139 {
  3140   int fd = -1;
  3141   Lisp_Object proc, contact, port;
  3142   struct Lisp_Process *p;
  3143   Lisp_Object name, buffer;
  3144   Lisp_Object tem, val;
  3145 
  3146   if (nargs == 0)
  3147     return Qnil;
  3148 
  3149   contact = Flist (nargs, args);
  3150 
  3151   port = plist_get (contact, QCport);
  3152   if (NILP (port))
  3153     error ("No port specified");
  3154   CHECK_STRING (port);
  3155 
  3156   if (NILP (plist_member (contact, QCspeed)))
  3157     error (":speed not specified");
  3158   if (!NILP (plist_get (contact, QCspeed)))
  3159     CHECK_FIXNUM (plist_get (contact, QCspeed));
  3160 
  3161   name = plist_get (contact, QCname);
  3162   if (NILP (name))
  3163     name = port;
  3164   CHECK_STRING (name);
  3165   proc = make_process (name);
  3166   specpdl_ref specpdl_count = SPECPDL_INDEX ();
  3167   record_unwind_protect (remove_process, proc);
  3168   p = XPROCESS (proc);
  3169 
  3170   fd = serial_open (port);
  3171   p->open_fd[SUBPROCESS_STDIN] = fd;
  3172   if (FD_SETSIZE <= fd)
  3173     report_file_errno ("Opening serial port", port, EMFILE);
  3174   p->infd = fd;
  3175   p->outfd = fd;
  3176   if (fd > max_desc)
  3177     max_desc = fd;
  3178   eassert (0 <= fd && fd < FD_SETSIZE);
  3179   chan_process[fd] = proc;
  3180 
  3181   buffer = plist_get (contact, QCbuffer);
  3182   if (NILP (buffer))
  3183     buffer = name;
  3184   buffer = Fget_buffer_create (buffer, Qnil);
  3185   pset_buffer (p, buffer);
  3186 
  3187   pset_childp (p, contact);
  3188   pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
  3189   pset_type (p, Qserial);
  3190   pset_sentinel (p, plist_get (contact, QCsentinel));
  3191   pset_filter (p, plist_get (contact, QCfilter));
  3192   eassert (NILP (p->log));
  3193   if (tem = plist_get (contact, QCnoquery), !NILP (tem))
  3194     p->kill_without_query = 1;
  3195   if (tem = plist_get (contact, QCstop), !NILP (tem))
  3196     pset_command (p, Qt);
  3197   eassert (! p->pty_in && ! p->pty_out);
  3198 
  3199   if (!EQ (p->command, Qt)
  3200       && !EQ (p->filter, Qt))
  3201     add_process_read_fd (fd);
  3202 
  3203   update_process_mark (p);
  3204 
  3205   tem = plist_get (contact, QCcoding);
  3206 
  3207   val = Qnil;
  3208   if (!NILP (tem))
  3209     {
  3210       val = tem;
  3211       if (CONSP (val))
  3212         val = XCAR (val);
  3213     }
  3214   else if (!NILP (Vcoding_system_for_read))
  3215     val = Vcoding_system_for_read;
  3216   else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
  3217            || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
  3218     val = Qnil;
  3219   pset_decode_coding_system (p, val);
  3220 
  3221   val = Qnil;
  3222   if (!NILP (tem))
  3223     {
  3224       val = tem;
  3225       if (CONSP (val))
  3226         val = XCDR (val);
  3227     }
  3228   else if (!NILP (Vcoding_system_for_write))
  3229     val = Vcoding_system_for_write;
  3230   else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
  3231            || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
  3232     val = Qnil;
  3233   pset_encode_coding_system (p, val);
  3234 
  3235   setup_process_coding_systems (proc);
  3236   pset_decoding_buf (p, empty_unibyte_string);
  3237   eassert (p->decoding_carryover == 0);
  3238   pset_encoding_buf (p, empty_unibyte_string);
  3239   p->inherit_coding_system_flag
  3240     = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
  3241 
  3242   Fserial_process_configure (nargs, args);
  3243 
  3244   specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
  3245 
  3246   return proc;
  3247 }
  3248 
  3249 static void
  3250 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
  3251                                   Lisp_Object service, Lisp_Object name)
  3252 {
  3253   Lisp_Object tem;
  3254   struct Lisp_Process *p = XPROCESS (proc);
  3255   Lisp_Object contact = p->childp;
  3256   Lisp_Object coding_systems = Qt;
  3257   Lisp_Object val;
  3258 
  3259   tem = plist_get (contact, QCcoding);
  3260 
  3261   /* Setup coding systems for communicating with the network stream.  */
  3262   /* Qt denotes we have not yet called Ffind_operation_coding_system.  */
  3263 
  3264   if (!NILP (tem))
  3265     {
  3266       val = tem;
  3267       if (CONSP (val))
  3268         val = XCAR (val);
  3269     }
  3270   else if (!NILP (Vcoding_system_for_read))
  3271     val = Vcoding_system_for_read;
  3272   else if ((!NILP (p->buffer)
  3273             && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
  3274            || (NILP (p->buffer)
  3275                && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
  3276     /* We dare not decode end-of-line format by setting VAL to
  3277        Qraw_text, because the existing Emacs Lisp libraries
  3278        assume that they receive bare code including a sequence of
  3279        CR LF.  */
  3280     val = Qnil;
  3281   else
  3282     {
  3283       if (NILP (host) || NILP (service))
  3284         coding_systems = Qnil;
  3285       else
  3286         coding_systems = CALLN (Ffind_operation_coding_system,
  3287                                 Qopen_network_stream, name, p->buffer,
  3288                                 host, service);
  3289       if (CONSP (coding_systems))
  3290         val = XCAR (coding_systems);
  3291       else if (CONSP (Vdefault_process_coding_system))
  3292         val = XCAR (Vdefault_process_coding_system);
  3293       else
  3294         val = Qnil;
  3295     }
  3296   pset_decode_coding_system (p, val);
  3297 
  3298   if (!NILP (tem))
  3299     {
  3300       val = tem;
  3301       if (CONSP (val))
  3302         val = XCDR (val);
  3303     }
  3304   else if (!NILP (Vcoding_system_for_write))
  3305     val = Vcoding_system_for_write;
  3306   else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  3307     val = Qnil;
  3308   else
  3309     {
  3310       if (EQ (coding_systems, Qt))
  3311         {
  3312           if (NILP (host) || NILP (service))
  3313             coding_systems = Qnil;
  3314           else
  3315             coding_systems = CALLN (Ffind_operation_coding_system,
  3316                                     Qopen_network_stream, name, p->buffer,
  3317                                     host, service);
  3318         }
  3319       if (CONSP (coding_systems))
  3320         val = XCDR (coding_systems);
  3321       else if (CONSP (Vdefault_process_coding_system))
  3322         val = XCDR (Vdefault_process_coding_system);
  3323       else
  3324         val = Qnil;
  3325     }
  3326   pset_encode_coding_system (p, val);
  3327 
  3328   pset_decoding_buf (p, empty_unibyte_string);
  3329   p->decoding_carryover = 0;
  3330   pset_encoding_buf (p, empty_unibyte_string);
  3331 
  3332   p->inherit_coding_system_flag
  3333     = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
  3334 }
  3335 
  3336 #ifdef HAVE_GNUTLS
  3337 static void
  3338 finish_after_tls_connection (Lisp_Object proc)
  3339 {
  3340   struct Lisp_Process *p = XPROCESS (proc);
  3341   Lisp_Object contact = p->childp;
  3342   Lisp_Object result = Qt;
  3343 
  3344   if (!NILP (Ffboundp (Qnsm_verify_connection)))
  3345     result = call3 (Qnsm_verify_connection,
  3346                     proc,
  3347                     plist_get (contact, QChost),
  3348                     plist_get (contact, QCservice));
  3349 
  3350   eassert (p->outfd < FD_SETSIZE);
  3351   if (NILP (result))
  3352     {
  3353       pset_status (p, list2 (Qfailed,
  3354                              build_string ("The Network Security Manager stopped the connections")));
  3355       deactivate_process (proc);
  3356     }
  3357   else if (p->outfd < 0)
  3358     {
  3359       /* The counterparty may have closed the connection (especially
  3360          if the NSM prompt above take a long time), so recheck the file
  3361          descriptor here. */
  3362       pset_status (p, Qfailed);
  3363       deactivate_process (proc);
  3364     }
  3365   else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
  3366     {
  3367       /* If we cleared the connection wait mask before we did the TLS
  3368          setup, then we have to say that the process is finally "open"
  3369          here. */
  3370       pset_status (p, Qrun);
  3371       /* Execute the sentinel here.  If we had relied on status_notify
  3372          to do it later, it will read input from the process before
  3373          calling the sentinel.  */
  3374       exec_sentinel (proc, build_string ("open\n"));
  3375     }
  3376 }
  3377 #endif
  3378 
  3379 static void
  3380 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
  3381                         Lisp_Object use_external_socket_p)
  3382 {
  3383   int s = -1, outch, inch;
  3384   int xerrno = 0;
  3385   int family;
  3386   int ret;
  3387   ptrdiff_t addrlen UNINIT;
  3388   struct Lisp_Process *p = XPROCESS (proc);
  3389   Lisp_Object contact = p->childp;
  3390   int optbits = 0;
  3391   int socket_to_use = -1;
  3392 
  3393   if (!NILP (use_external_socket_p))
  3394     {
  3395       socket_to_use = external_sock_fd;
  3396       eassert (socket_to_use < FD_SETSIZE);
  3397 
  3398       /* Ensure we don't consume the external socket twice.  */
  3399       external_sock_fd = -1;
  3400     }
  3401 
  3402   /* Do this in case we never enter the while-loop below.  */
  3403   s = -1;
  3404 
  3405   struct sockaddr *sa = NULL;
  3406   specpdl_ref count = SPECPDL_INDEX ();
  3407   record_unwind_protect_nothing ();
  3408   specpdl_ref count1 = SPECPDL_INDEX ();
  3409 
  3410   while (!NILP (addrinfos))
  3411     {
  3412       Lisp_Object addrinfo = XCAR (addrinfos);
  3413       addrinfos = XCDR (addrinfos);
  3414       int protocol = XFIXNUM (XCAR (addrinfo));
  3415       Lisp_Object ip_address = XCDR (addrinfo);
  3416 
  3417 #ifdef WINDOWSNT
  3418     retry_connect:
  3419 #endif
  3420 
  3421       addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
  3422       sa = xrealloc (sa, addrlen);
  3423       set_unwind_protect_ptr (count, xfree, sa);
  3424       conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
  3425 
  3426       s = socket_to_use;
  3427       if (s < 0)
  3428         {
  3429           int socktype = p->socktype | SOCK_CLOEXEC;
  3430           if (p->is_non_blocking_client)
  3431             socktype |= SOCK_NONBLOCK;
  3432           s = socket (family, socktype, protocol);
  3433           if (s < 0)
  3434             {
  3435               xerrno = errno;
  3436               continue;
  3437             }
  3438           /* Reject file descriptors that would be too large.  */
  3439           if (FD_SETSIZE <= s)
  3440             {
  3441               emacs_close (s);
  3442               s = -1;
  3443               xerrno = EMFILE;
  3444               continue;
  3445             }
  3446         }
  3447 
  3448       if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
  3449         {
  3450           ret = fcntl (s, F_SETFL, O_NONBLOCK);
  3451           if (ret < 0)
  3452             {
  3453               xerrno = errno;
  3454               emacs_close (s);
  3455               s = -1;
  3456               if (0 <= socket_to_use)
  3457                 break;
  3458               continue;
  3459             }
  3460         }
  3461 
  3462 #ifdef DATAGRAM_SOCKETS
  3463       if (!p->is_server && p->socktype == SOCK_DGRAM)
  3464         break;
  3465 #endif /* DATAGRAM_SOCKETS */
  3466 
  3467       /* Make us close S if quit.  */
  3468       record_unwind_protect_int (close_file_unwind, s);
  3469 
  3470       /* Parse network options in the arg list.  We simply ignore anything
  3471          which isn't a known option (including other keywords).  An error
  3472          is signaled if setting a known option fails.  */
  3473       {
  3474         Lisp_Object params = contact, key, val;
  3475 
  3476         while (!NILP (params))
  3477           {
  3478             key = XCAR (params);
  3479             params = XCDR (params);
  3480             val = XCAR (params);
  3481             params = XCDR (params);
  3482             optbits |= set_socket_option (s, key, val);
  3483           }
  3484       }
  3485 
  3486       if (p->is_server)
  3487         {
  3488           /* Configure as a server socket.  */
  3489 
  3490           /* SO_REUSEADDR = 1 is default for server sockets; must specify
  3491              explicit :reuseaddr key to override this.  */
  3492 #ifdef HAVE_LOCAL_SOCKETS
  3493           if (family != AF_LOCAL)
  3494 #endif
  3495             if (!(optbits & (1 << OPIX_REUSEADDR)))
  3496               {
  3497                 int optval = 1;
  3498                 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
  3499                   report_file_error ("Cannot set reuse option on server socket", Qnil);
  3500               }
  3501 
  3502           /* If passed a socket descriptor, it should be already bound. */
  3503           if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
  3504             report_file_error ("Cannot bind server socket", Qnil);
  3505 
  3506 #ifdef HAVE_GETSOCKNAME
  3507           if (p->port == 0
  3508 #ifdef HAVE_LOCAL_SOCKETS
  3509               && family != AF_LOCAL
  3510 #endif
  3511               )
  3512             {
  3513               struct sockaddr_in sa1;
  3514               socklen_t len1 = sizeof (sa1);
  3515 #ifdef AF_INET6
  3516               /* The code below assumes the port is at the same offset
  3517                  and of the same width in both IPv4 and IPv6
  3518                  structures, but the standards don't guarantee that,
  3519                  so verify it here.  */
  3520               struct sockaddr_in6 sa6;
  3521               verify ((offsetof (struct sockaddr_in, sin_port)
  3522                        == offsetof (struct sockaddr_in6, sin6_port))
  3523                       && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
  3524 #endif
  3525               DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
  3526               if (getsockname (s, psa1, &len1) == 0)
  3527                 {
  3528                   Lisp_Object service = make_fixnum (ntohs (sa1.sin_port));
  3529                   contact = plist_put (contact, QCservice, service);
  3530                   /* Save the port number so that we can stash it in
  3531                      the process object later.  */
  3532                   DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
  3533                   psa->sin_port = sa1.sin_port;
  3534                 }
  3535             }
  3536 #endif
  3537 
  3538           if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
  3539             report_file_error ("Cannot listen on server socket", Qnil);
  3540 
  3541           break;
  3542         }
  3543 
  3544       maybe_quit ();
  3545 
  3546       ret = connect (s, sa, addrlen);
  3547       xerrno = errno;
  3548 
  3549       if (ret == 0 || xerrno == EISCONN)
  3550         {
  3551           /* The unwind-protect will be discarded afterwards.  */
  3552           break;
  3553         }
  3554 
  3555       if (p->is_non_blocking_client && xerrno == EINPROGRESS)
  3556         break;
  3557 
  3558 #ifndef WINDOWSNT
  3559       if (xerrno == EINTR)
  3560         {
  3561           /* Unlike most other syscalls connect() cannot be called
  3562              again.  (That would return EALREADY.)  The proper way to
  3563              wait for completion is pselect().  */
  3564           int sc;
  3565           socklen_t len;
  3566           fd_set fdset;
  3567         retry_select:
  3568           FD_ZERO (&fdset);
  3569           FD_SET (s, &fdset);
  3570           maybe_quit ();
  3571           sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
  3572           if (sc == -1)
  3573             {
  3574               if (errno == EINTR)
  3575                 goto retry_select;
  3576               else
  3577                 report_file_error ("Failed select", Qnil);
  3578             }
  3579           eassert (sc > 0);
  3580 
  3581           len = sizeof xerrno;
  3582           eassert (FD_ISSET (s, &fdset));
  3583           if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
  3584             report_file_error ("Failed getsockopt", Qnil);
  3585           if (xerrno == 0)
  3586             break;
  3587           if (NILP (addrinfos))
  3588             report_file_errno ("Failed connect", Qnil, xerrno);
  3589         }
  3590 #endif /* !WINDOWSNT */
  3591 
  3592       /* Discard the unwind protect closing S.  */
  3593       specpdl_ptr = specpdl_ref_to_ptr (count1);
  3594       emacs_close (s);
  3595       s = -1;
  3596       if (0 <= socket_to_use)
  3597         break;
  3598 
  3599 #ifdef WINDOWSNT
  3600       if (xerrno == EINTR)
  3601         goto retry_connect;
  3602 #endif
  3603     }
  3604 
  3605   if (s >= 0)
  3606     {
  3607 #ifdef DATAGRAM_SOCKETS
  3608       if (p->socktype == SOCK_DGRAM)
  3609         {
  3610           eassert (0 <= s && s < FD_SETSIZE);
  3611           if (datagram_address[s].sa)
  3612             emacs_abort ();
  3613 
  3614           datagram_address[s].sa = xmalloc (addrlen);
  3615           datagram_address[s].len = addrlen;
  3616           if (p->is_server)
  3617             {
  3618               Lisp_Object remote;
  3619               memset (datagram_address[s].sa, 0, addrlen);
  3620               if (remote = plist_get (contact, QCremote), !NILP (remote))
  3621                 {
  3622                   int rfamily;
  3623                   ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
  3624                   if (rlen != 0 && rfamily == family
  3625                       && rlen == addrlen)
  3626                     conv_lisp_to_sockaddr (rfamily, remote,
  3627                                            datagram_address[s].sa, rlen);
  3628                 }
  3629             }
  3630           else
  3631             memcpy (datagram_address[s].sa, sa, addrlen);
  3632         }
  3633 #endif
  3634 
  3635       contact = plist_put (contact, p->is_server? QClocal: QCremote,
  3636                            conv_sockaddr_to_lisp (sa, addrlen));
  3637 #ifdef HAVE_GETSOCKNAME
  3638       if (!p->is_server)
  3639         {
  3640           struct sockaddr_storage sa1;
  3641           socklen_t len1 = sizeof (sa1);
  3642           DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
  3643           if (getsockname (s, psa1, &len1) == 0)
  3644             contact = plist_put (contact, QClocal,
  3645                                  conv_sockaddr_to_lisp (psa1, len1));
  3646         }
  3647 #endif
  3648     }
  3649 
  3650   if (s < 0)
  3651     {
  3652       const char *err = (p->is_server
  3653                          ? "make server process failed"
  3654                          : "make client process failed");
  3655 
  3656       /* If non-blocking got this far - and failed - assume non-blocking is
  3657          not supported after all.  This is probably a wrong assumption, but
  3658          the normal blocking calls to open-network-stream handles this error
  3659          better.  */
  3660       if (p->is_non_blocking_client)
  3661         {
  3662           Lisp_Object data = get_file_errno_data (err, contact, xerrno);
  3663 
  3664           pset_status (p, list2 (Qfailed, data));
  3665           unbind_to (count, Qnil);
  3666           return;
  3667         }
  3668 
  3669       report_file_errno (err, contact, xerrno);
  3670     }
  3671 
  3672   inch = s;
  3673   outch = s;
  3674 
  3675   eassert (0 <= inch && inch < FD_SETSIZE);
  3676   chan_process[inch] = proc;
  3677 
  3678   fcntl (inch, F_SETFL, O_NONBLOCK);
  3679 
  3680   p = XPROCESS (proc);
  3681   p->open_fd[SUBPROCESS_STDIN] = inch;
  3682   p->infd  = inch;
  3683   p->outfd = outch;
  3684 
  3685   /* Discard the unwind protect for closing S, if any.  */
  3686   specpdl_ptr = specpdl_ref_to_ptr (count1);
  3687 
  3688   if (p->is_server && p->socktype != SOCK_DGRAM)
  3689     pset_status (p, Qlisten);
  3690 
  3691   /* Make the process marker point into the process buffer (if any).  */
  3692   update_process_mark (p);
  3693 
  3694   if (p->is_non_blocking_client)
  3695     {
  3696       /* We may get here if connect did succeed immediately.  However,
  3697          in that case, we still need to signal this like a non-blocking
  3698          connection.  */
  3699       if (! (connecting_status (p->status)
  3700              && EQ (XCDR (p->status), addrinfos)))
  3701         pset_status (p, Fcons (Qconnect, addrinfos));
  3702       eassert (0 <= inch && inch < FD_SETSIZE);
  3703       if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
  3704         add_non_blocking_write_fd (inch);
  3705     }
  3706   else
  3707     /* A server may have a client filter setting of Qt, but it must
  3708        still listen for incoming connects unless it is stopped.  */
  3709     if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
  3710         || (EQ (p->status, Qlisten) && NILP (p->command)))
  3711       add_process_read_fd (inch);
  3712 
  3713   if (inch > max_desc)
  3714     max_desc = inch;
  3715 
  3716   /* Set up the masks based on the process filter. */
  3717   set_process_filter_masks (p);
  3718 
  3719   setup_process_coding_systems (proc);
  3720 
  3721 #ifdef HAVE_GNUTLS
  3722   /* Continue the asynchronous connection. */
  3723   if (!NILP (p->gnutls_boot_parameters))
  3724     {
  3725       Lisp_Object boot, params = p->gnutls_boot_parameters;
  3726 
  3727       boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
  3728 
  3729       if (p->gnutls_initstage == GNUTLS_STAGE_READY)
  3730         {
  3731           p->gnutls_boot_parameters = Qnil;
  3732           /* Run sentinels, etc. */
  3733           finish_after_tls_connection (proc);
  3734         }
  3735       else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
  3736         {
  3737           deactivate_process (proc);
  3738           if (NILP (boot))
  3739             pset_status (p, list2 (Qfailed,
  3740                                    build_string ("TLS negotiation failed")));
  3741           else
  3742             pset_status (p, list2 (Qfailed, boot));
  3743         }
  3744     }
  3745 #endif
  3746 
  3747   unbind_to (count, Qnil);
  3748 }
  3749 
  3750 /* Create a network stream/datagram client/server process.  Treated
  3751    exactly like a normal process when reading and writing.  Primary
  3752    differences are in status display and process deletion.  A network
  3753    connection has no PID; you cannot signal it.  All you can do is
  3754    stop/continue it and deactivate/close it via delete-process.  */
  3755 
  3756 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
  3757        0, MANY, 0,
  3758        doc: /* Create and return a network server or client process.
  3759 
  3760 In Emacs, network connections are represented by process objects, so
  3761 input and output work as for subprocesses and `delete-process' closes
  3762 a network connection.  However, a network process has no process id,
  3763 it cannot be signaled, and the status codes are different from normal
  3764 processes.
  3765 
  3766 Arguments are specified as keyword/argument pairs.  The following
  3767 arguments are defined:
  3768 
  3769 :name NAME -- NAME is name for process.  It is modified if necessary
  3770 to make it unique.
  3771 
  3772 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
  3773 with the process.  Process output goes at end of that buffer, unless
  3774 you specify a filter function to handle the output.  BUFFER may be
  3775 also nil, meaning that this process is not associated with any buffer.
  3776 
  3777 :host HOST -- HOST is name of the host to connect to, or its IP
  3778 address.  The symbol `local' specifies the local host.  If specified
  3779 for a server process, it must be a valid name or address for the local
  3780 host, and only clients connecting to that address will be accepted.
  3781 If all interfaces should be bound, an address of \"0.0.0.0\" (for
  3782 IPv4) or \"::\" (for IPv6) can be used.  (On some operating systems,
  3783 using \"::\" listens on both IPv4 and IPv6.)  `local' will use IPv4 by
  3784 default, use a FAMILY of `ipv6' to override this.
  3785 
  3786 :service SERVICE -- SERVICE is name of the service desired, or an
  3787 integer specifying a port number to connect to.  If SERVICE is t,
  3788 a random port number is selected for the server.  A port number can
  3789 be specified as an integer string, e.g., "80", as well as an integer.
  3790 
  3791 :type TYPE -- TYPE is the type of connection.  The default (nil) is a
  3792 stream type connection, `datagram' creates a datagram type connection,
  3793 `seqpacket' creates a reliable datagram connection.
  3794 
  3795 :family FAMILY -- FAMILY is the address (and protocol) family for the
  3796 service specified by HOST and SERVICE.  The default (nil) is to use
  3797 whatever address family (IPv4 or IPv6) that is defined for the host
  3798 and port number specified by HOST and SERVICE.  Other address families
  3799 supported are:
  3800   local -- for a local (i.e. UNIX) address specified by SERVICE.
  3801   ipv4  -- use IPv4 address family only.
  3802   ipv6  -- use IPv6 address family only.
  3803 
  3804 :local ADDRESS -- ADDRESS is the local address used for the connection.
  3805 This parameter is ignored when opening a client process. When specified
  3806 for a server process, the FAMILY, HOST and SERVICE args are ignored.
  3807 
  3808 :remote ADDRESS -- ADDRESS is the remote partner's address for the
  3809 connection.  This parameter is ignored when opening a stream server
  3810 process.  For a datagram server process, it specifies the initial
  3811 setting of the remote datagram address.  When specified for a client
  3812 process, the FAMILY, HOST, and SERVICE args are ignored.
  3813 
  3814 The format of ADDRESS depends on the address family:
  3815 - An IPv4 address is represented as a vector of integers [A B C D P]
  3816 corresponding to numeric IP address A.B.C.D and port number P.
  3817 - An IPv6 address has the same format as an IPv4 address but with 9
  3818 elements rather than 5.
  3819 - A local address is represented as a string with the address in the
  3820 local address space.
  3821 - An "unsupported family" address is represented by a cons (F . AV)
  3822 where F is the family number and AV is a vector containing the socket
  3823 address data with one element per address data byte.  Do not rely on
  3824 this format in portable code, as it may depend on implementation
  3825 defined constants, data sizes, and data structure alignment.
  3826 
  3827 :coding CODING -- If CODING is a symbol, it specifies the coding
  3828 system used for both reading and writing for this process.  If CODING
  3829 is a cons (DECODING . ENCODING), DECODING is used for reading, and
  3830 ENCODING is used for writing.
  3831 
  3832 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
  3833 process, return without waiting for the connection to complete;
  3834 instead, the sentinel function will be called with second arg matching
  3835 "open" (if successful) or "failed" when the connect completes.
  3836 Default is to use a blocking connect (i.e. wait) for stream type
  3837 connections.
  3838 
  3839 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
  3840 running when Emacs is exited.
  3841 
  3842 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
  3843 In the stopped state, a server process does not accept new
  3844 connections, and a client process does not handle incoming traffic.
  3845 The stopped state is cleared by `continue-process' and set by
  3846 `stop-process'.
  3847 
  3848 :filter FILTER -- Install FILTER as the process filter.
  3849 
  3850 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
  3851 process filter are multibyte, otherwise they are unibyte.
  3852 If this keyword is not specified, the strings are multibyte.
  3853 
  3854 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
  3855 
  3856 :log LOG -- Install LOG as the server process log function.  This
  3857 function is called when the server accepts a network connection from a
  3858 client.  The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
  3859 is the server process, CLIENT is the new process for the connection,
  3860 and MESSAGE is a string.
  3861 
  3862 :plist PLIST -- Install PLIST as the new process's initial plist.
  3863 
  3864 :tls-parameters LIST -- is a list that should be supplied if you're
  3865 opening a TLS connection.  The first element is the TLS type (either
  3866 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
  3867 be a keyword list accepted by gnutls-boot (as returned by
  3868 `gnutls-boot-parameters').
  3869 
  3870 :server QLEN -- if QLEN is non-nil, create a server process for the
  3871 specified FAMILY, SERVICE, and connection type (stream or datagram).
  3872 If QLEN is an integer, it is used as the max. length of the server's
  3873 pending connection queue (also known as the backlog); the default
  3874 queue length is 5.  Default is to create a client process.
  3875 
  3876 The following network options can be specified for this connection:
  3877 
  3878 :broadcast BOOL    -- Allow send and receive of datagram broadcasts.
  3879 :dontroute BOOL    -- Only send to directly connected hosts.
  3880 :keepalive BOOL    -- Send keep-alive messages on network stream.
  3881 :linger BOOL or TIMEOUT -- Send queued messages before closing.
  3882 :oobinline BOOL    -- Place out-of-band data in receive data stream.
  3883 :priority INT      -- Set protocol defined priority for sent packets.
  3884 :reuseaddr BOOL    -- Allow reusing a recently used local address
  3885                       (this is allowed by default for a server process).
  3886 :bindtodevice NAME -- bind to interface NAME.  Using this may require
  3887                       special privileges on some systems.
  3888 :use-external-socket BOOL -- Use any pre-allocated sockets that have
  3889                              been passed to Emacs.  If Emacs wasn't
  3890                              passed a socket, this option is silently
  3891                              ignored.
  3892 
  3893 
  3894 Consult the relevant system programmer's manual pages for more
  3895 information on using these options.
  3896 
  3897 
  3898 A server process will listen for and accept connections from clients.
  3899 When a client connection is accepted, a new network process is created
  3900 for the connection with the following parameters:
  3901 
  3902 - The client's process name is constructed by concatenating the server
  3903 process's NAME and a client identification string.
  3904 - If the FILTER argument is non-nil, the client process will not get a
  3905 separate process buffer; otherwise, the client's process buffer is a newly
  3906 created buffer named after the server process's BUFFER name or process
  3907 NAME concatenated with the client identification string.
  3908 - The connection type and the process filter and sentinel parameters are
  3909 inherited from the server process's TYPE, FILTER and SENTINEL.
  3910 - The client process's contact info is set according to the client's
  3911 addressing information (typically an IP address and a port number).
  3912 - The client process's plist is initialized from the server's plist.
  3913 
  3914 Notice that the FILTER and SENTINEL args are never used directly by
  3915 the server process.  Also, the BUFFER argument is not used directly by
  3916 the server process, but via the optional :log function, accepted (and
  3917 failed) connections may be logged in the server process's buffer.
  3918 
  3919 The original argument list, modified with the actual connection
  3920 information, is available via the `process-contact' function.
  3921 
  3922 usage: (make-network-process &rest ARGS)  */)
  3923   (ptrdiff_t nargs, Lisp_Object *args)
  3924 {
  3925   Lisp_Object proc;
  3926   Lisp_Object contact;
  3927   struct Lisp_Process *p;
  3928   const char *portstring UNINIT;
  3929   char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
  3930 #ifdef HAVE_LOCAL_SOCKETS
  3931   struct sockaddr_un address_un;
  3932 #endif
  3933   EMACS_INT port = 0;
  3934   Lisp_Object tem;
  3935   Lisp_Object name, buffer, host, service, address;
  3936   Lisp_Object filter, sentinel, use_external_socket_p;
  3937   Lisp_Object addrinfos = Qnil;
  3938   int socktype;
  3939   int family = -1;
  3940   enum { any_protocol = 0 };
  3941 #ifdef HAVE_GETADDRINFO_A
  3942   struct gaicb *dns_request = NULL;
  3943 #endif
  3944   specpdl_ref count = SPECPDL_INDEX ();
  3945 
  3946   if (nargs == 0)
  3947     return Qnil;
  3948 
  3949   /* Save arguments for process-contact and clone-process.  */
  3950   contact = Flist (nargs, args);
  3951 
  3952 #ifdef WINDOWSNT
  3953   /* Ensure socket support is loaded if available.  */
  3954   init_winsock (TRUE);
  3955 #endif
  3956 
  3957   /* :type TYPE  (nil: stream, datagram */
  3958   tem = plist_get (contact, QCtype);
  3959   if (NILP (tem))
  3960     socktype = SOCK_STREAM;
  3961 #ifdef DATAGRAM_SOCKETS
  3962   else if (EQ (tem, Qdatagram))
  3963     socktype = SOCK_DGRAM;
  3964 #endif
  3965 #ifdef HAVE_SEQPACKET
  3966   else if (EQ (tem, Qseqpacket))
  3967     socktype = SOCK_SEQPACKET;
  3968 #endif
  3969   else
  3970     error ("Unsupported connection type");
  3971 
  3972   name = plist_get (contact, QCname);
  3973   buffer = plist_get (contact, QCbuffer);
  3974   filter = plist_get (contact, QCfilter);
  3975   sentinel = plist_get (contact, QCsentinel);
  3976   use_external_socket_p = plist_get (contact, QCuse_external_socket);
  3977   Lisp_Object server = plist_get (contact, QCserver);
  3978   bool nowait = !NILP (plist_get (contact, QCnowait));
  3979 
  3980   if (!NILP (server) && nowait)
  3981     error ("`:server' is incompatible with `:nowait'");
  3982   CHECK_STRING (name);
  3983 
  3984   /* :local ADDRESS or :remote ADDRESS */
  3985   if (NILP (server))
  3986     address = plist_get (contact, QCremote);
  3987   else
  3988     address = plist_get (contact, QClocal);
  3989   if (!NILP (address))
  3990     {
  3991       host = service = Qnil;
  3992 
  3993       if (!get_lisp_to_sockaddr_size (address, &family))
  3994         error ("Malformed :address");
  3995 
  3996       addrinfos = list1 (Fcons (make_fixnum (any_protocol), address));
  3997       goto open_socket;
  3998     }
  3999 
  4000   /* :family FAMILY -- nil (for Inet), local, or integer.  */
  4001   tem = plist_get (contact, QCfamily);
  4002   if (NILP (tem))
  4003     {
  4004 #ifdef AF_INET6
  4005       family = AF_UNSPEC;
  4006 #else
  4007       family = AF_INET;
  4008 #endif
  4009     }
  4010 #ifdef HAVE_LOCAL_SOCKETS
  4011   else if (EQ (tem, Qlocal))
  4012     family = AF_LOCAL;
  4013 #endif
  4014 #ifdef AF_INET6
  4015   else if (EQ (tem, Qipv6))
  4016     family = AF_INET6;
  4017 #endif
  4018   else if (EQ (tem, Qipv4))
  4019     family = AF_INET;
  4020   else if (TYPE_RANGED_FIXNUMP (int, tem))
  4021     family = XFIXNUM (tem);
  4022   else
  4023     error ("Unknown address family");
  4024 
  4025   /* :service SERVICE -- string, integer (port number), or t (random port).  */
  4026   service = plist_get (contact, QCservice);
  4027 
  4028   /* :host HOST -- hostname, ip address, or 'local for localhost.  */
  4029   host = plist_get (contact, QChost);
  4030   if (NILP (host))
  4031     {
  4032       /* The "connection" function gets it bind info from the address we're
  4033          given, so use this dummy address if nothing is specified. */
  4034 #ifdef HAVE_LOCAL_SOCKETS
  4035       if (family != AF_LOCAL)
  4036 #endif
  4037         {
  4038 #ifdef AF_INET6
  4039         if (family == AF_INET6)
  4040           host = build_string ("::1");
  4041         else
  4042 #endif
  4043           host = build_string ("127.0.0.1");
  4044         }
  4045     }
  4046   else
  4047     {
  4048       if (EQ (host, Qlocal))
  4049         {
  4050         /* Depending on setup, "localhost" may map to different IPv4 and/or
  4051            IPv6 addresses, so it's better to be explicit (Bug#6781).  */
  4052 #ifdef AF_INET6
  4053         if (family == AF_INET6)
  4054           host = build_string ("::1");
  4055         else
  4056 #endif
  4057           host = build_string ("127.0.0.1");
  4058         }
  4059       CHECK_STRING (host);
  4060     }
  4061 
  4062 #ifdef HAVE_LOCAL_SOCKETS
  4063   if (family == AF_LOCAL)
  4064     {
  4065       if (!NILP (host))
  4066         {
  4067           message (":family local ignores the :host property");
  4068           contact = plist_put (contact, QChost, Qnil);
  4069           host = Qnil;
  4070         }
  4071       CHECK_STRING (service);
  4072       if (sizeof address_un.sun_path <= SBYTES (service))
  4073         error ("Service name too long");
  4074       addrinfos = list1 (Fcons (make_fixnum (any_protocol), service));
  4075       goto open_socket;
  4076     }
  4077 #endif
  4078 
  4079   /* Slow down polling to every ten seconds.
  4080      Some kernels have a bug which causes retrying connect to fail
  4081      after a connect.  Polling can interfere with gethostbyname too.  */
  4082 #ifdef POLL_FOR_INPUT
  4083   if (socktype != SOCK_DGRAM)
  4084     {
  4085       record_unwind_protect_void (run_all_atimers);
  4086       bind_polling_period (10);
  4087     }
  4088 #endif
  4089 
  4090   if (!NILP (host))
  4091     {
  4092       MAYBE_UNUSED ptrdiff_t portstringlen;
  4093 
  4094       /* SERVICE can either be a string or int.
  4095          Convert to a C string for later use by getaddrinfo.  */
  4096       if (EQ (service, Qt))
  4097         {
  4098           portstring = "0";
  4099           portstringlen = 1;
  4100         }
  4101       else if (FIXNUMP (service))
  4102         {
  4103           portstring = portbuf;
  4104           portstringlen = sprintf (portbuf, "%"pI"d", XFIXNUM (service));
  4105         }
  4106       else
  4107         {
  4108           CHECK_STRING (service);
  4109           portstring = SSDATA (service);
  4110           portstringlen = SBYTES (service);
  4111         }
  4112 
  4113 #ifdef HAVE_GETADDRINFO_A
  4114       if (nowait)
  4115         {
  4116           ptrdiff_t hostlen = SBYTES (host);
  4117           struct req
  4118           {
  4119             struct gaicb gaicb;
  4120             struct addrinfo hints;
  4121             char str[FLEXIBLE_ARRAY_MEMBER];
  4122           } *req = xmalloc (FLEXSIZEOF (struct req, str,
  4123                                         hostlen + 1 + portstringlen + 1));
  4124           dns_request = &req->gaicb;
  4125           dns_request->ar_name = req->str;
  4126           dns_request->ar_service = req->str + hostlen + 1;
  4127           dns_request->ar_request = &req->hints;
  4128           dns_request->ar_result = NULL;
  4129           memset (&req->hints, 0, sizeof req->hints);
  4130           req->hints.ai_family = family;
  4131           req->hints.ai_socktype = socktype;
  4132           strcpy (req->str, SSDATA (host));
  4133           strcpy (req->str + hostlen + 1, portstring);
  4134 
  4135           int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
  4136           if (ret)
  4137             error ("%s/%s getaddrinfo_a error %d",
  4138                    SSDATA (host), portstring, ret);
  4139 
  4140           goto open_socket;
  4141         }
  4142 #endif /* HAVE_GETADDRINFO_A */
  4143     }
  4144 
  4145   /* If we have a host, use getaddrinfo to resolve both host and service.
  4146      Otherwise, use getservbyname to lookup the service.  */
  4147 
  4148   if (!NILP (host))
  4149     {
  4150       struct addrinfo *res, *lres;
  4151       Lisp_Object msg;
  4152 
  4153       maybe_quit ();
  4154 
  4155       struct addrinfo hints;
  4156       memset (&hints, 0, sizeof hints);
  4157       hints.ai_family = family;
  4158       hints.ai_socktype = socktype;
  4159 
  4160       msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
  4161       if (!EQ (msg, Qt))
  4162         error ("%s", SSDATA (msg));
  4163 
  4164       for (lres = res; lres; lres = lres->ai_next)
  4165         addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
  4166 
  4167       addrinfos = Fnreverse (addrinfos);
  4168 
  4169       freeaddrinfo (res);
  4170 
  4171       goto open_socket;
  4172     }
  4173 
  4174   /* No hostname has been specified (e.g., a local server process).  */
  4175 
  4176   if (EQ (service, Qt))
  4177     port = 0;
  4178   else if (FIXNUMP (service))
  4179     port = XFIXNUM (service);
  4180   else
  4181     {
  4182       CHECK_STRING (service);
  4183 
  4184       port = -1;
  4185       if (SBYTES (service) != 0)
  4186         {
  4187           /* Allow the service to be a string containing the port number,
  4188              because that's allowed if you have getaddrbyname.  */
  4189           char *service_end;
  4190           long int lport = strtol (SSDATA (service), &service_end, 10);
  4191           if (service_end == SSDATA (service) + SBYTES (service))
  4192             port = lport;
  4193           else
  4194             {
  4195               struct servent *svc_info
  4196                 = getservbyname (SSDATA (service),
  4197                                  socktype == SOCK_DGRAM ? "udp" : "tcp");
  4198               if (svc_info)
  4199                 port = ntohs (svc_info->s_port);
  4200             }
  4201         }
  4202     }
  4203 
  4204   if (! (0 <= port && port < 1 << 16))
  4205     {
  4206       AUTO_STRING (unknown_service, "Unknown service: %s");
  4207       xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
  4208     }
  4209 
  4210  open_socket:
  4211 
  4212   if (!NILP (buffer))
  4213     buffer = Fget_buffer_create (buffer, Qnil);
  4214 
  4215   /* Unwind bind_polling_period.  */
  4216   unbind_to (count, Qnil);
  4217 
  4218   proc = make_process (name);
  4219   record_unwind_protect (remove_process, proc);
  4220   p = XPROCESS (proc);
  4221   pset_childp (p, contact);
  4222   pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
  4223   pset_type (p, Qnetwork);
  4224 
  4225   pset_buffer (p, buffer);
  4226   pset_sentinel (p, sentinel);
  4227   pset_filter (p, filter);
  4228   pset_log (p, plist_get (contact, QClog));
  4229   if (tem = plist_get (contact, QCnoquery), !NILP (tem))
  4230     p->kill_without_query = 1;
  4231   if ((tem = plist_get (contact, QCstop), !NILP (tem)))
  4232     pset_command (p, Qt);
  4233   eassert (p->pid == 0);
  4234   p->backlog = 5;
  4235   eassert (! p->is_non_blocking_client);
  4236   eassert (! p->is_server);
  4237   p->port = port;
  4238   p->socktype = socktype;
  4239 #ifdef HAVE_GETADDRINFO_A
  4240   eassert (! p->dns_request);
  4241 #endif
  4242 #ifdef HAVE_GNUTLS
  4243   tem = plist_get (contact, QCtls_parameters);
  4244   CHECK_LIST (tem);
  4245   p->gnutls_boot_parameters = tem;
  4246 #endif
  4247 
  4248   set_network_socket_coding_system (proc, host, service, name);
  4249 
  4250   /* :server QLEN */
  4251   p->is_server = !NILP (server);
  4252   if (TYPE_RANGED_FIXNUMP (int, server))
  4253     p->backlog = XFIXNUM (server);
  4254 
  4255   /* :nowait BOOL */
  4256   if (!p->is_server && socktype != SOCK_DGRAM && nowait)
  4257     p->is_non_blocking_client = true;
  4258 
  4259   bool postpone_connection = false;
  4260 #ifdef HAVE_GETADDRINFO_A
  4261   /* With async address resolution, the list of addresses is empty, so
  4262      postpone connecting to the server. */
  4263   if (!p->is_server && NILP (addrinfos))
  4264     {
  4265       p->dns_request = dns_request;
  4266       p->status = list1 (Qconnect);
  4267       postpone_connection = true;
  4268     }
  4269 #endif
  4270   if (! postpone_connection)
  4271     connect_network_socket (proc, addrinfos, use_external_socket_p);
  4272 
  4273   specpdl_ptr = specpdl_ref_to_ptr (count);
  4274   return proc;
  4275 }
  4276 
  4277 
  4278 
  4279 #ifdef HAVE_GETIFADDRS
  4280 static Lisp_Object
  4281 network_interface_list (bool full, unsigned short match)
  4282 {
  4283   Lisp_Object res = Qnil;
  4284   struct ifaddrs *ifap;
  4285 
  4286   if (getifaddrs (&ifap) == -1)
  4287     return Qnil;
  4288 
  4289   for (struct ifaddrs *it = ifap; it != NULL; it = it->ifa_next)
  4290     {
  4291       int len;
  4292       int addr_len;
  4293       uint32_t *maskp;
  4294       uint32_t *addrp;
  4295       Lisp_Object elt = Qnil;
  4296 
  4297       /* BSD can allegedly return interfaces with a NULL address.  */
  4298       if (it->ifa_addr == NULL)
  4299         continue;
  4300       if (match && it->ifa_addr->sa_family != match)
  4301         continue;
  4302       if (it->ifa_addr->sa_family == AF_INET)
  4303         {
  4304           DECLARE_POINTER_ALIAS (sin1, struct sockaddr_in, it->ifa_netmask);
  4305           maskp = (uint32_t *)&sin1->sin_addr;
  4306           DECLARE_POINTER_ALIAS (sin2, struct sockaddr_in, it->ifa_addr);
  4307           addrp = (uint32_t *)&sin2->sin_addr;
  4308           len = sizeof (struct sockaddr_in);
  4309           addr_len = 1;
  4310         }
  4311 #ifdef AF_INET6
  4312       else if (it->ifa_addr->sa_family == AF_INET6)
  4313         {
  4314           DECLARE_POINTER_ALIAS (sin6_1, struct sockaddr_in6, it->ifa_netmask);
  4315           maskp = (uint32_t *) &sin6_1->sin6_addr;
  4316           DECLARE_POINTER_ALIAS (sin6_2, struct sockaddr_in6, it->ifa_addr);
  4317           addrp = (uint32_t *) &sin6_2->sin6_addr;
  4318           len = sizeof (struct sockaddr_in6);
  4319           addr_len = 4;
  4320         }
  4321 #endif
  4322       else
  4323         continue;
  4324 
  4325       Lisp_Object addr = conv_sockaddr_to_lisp (it->ifa_addr, len);
  4326 
  4327       if (full)
  4328         {
  4329           elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt);
  4330           /* There is an it->ifa_broadaddr field, but its contents are
  4331              unreliable, so always calculate the broadcast address from
  4332              the address and the netmask.  */
  4333           int i;
  4334           uint32_t mask;
  4335           for (i = 0; i < addr_len; i++)
  4336             {
  4337               mask = maskp[i];
  4338               maskp[i] = (addrp[i] & mask) | ~mask;
  4339             }
  4340           elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt);
  4341           elt = Fcons (addr, elt);
  4342         }
  4343       else
  4344         {
  4345           elt = addr;
  4346         }
  4347       res = Fcons (Fcons (build_string (it->ifa_name), elt), res);
  4348     }
  4349 #ifdef HAVE_FREEIFADDRS
  4350   freeifaddrs (ifap);
  4351 #endif
  4352 
  4353   return res;
  4354 }
  4355 #endif  /* HAVE_GETIFADDRS */
  4356 
  4357 #ifdef HAVE_NET_IF_H
  4358 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
  4359 
  4360 struct ifflag_def {
  4361   int flag_bit;
  4362   const char *flag_sym;
  4363 };
  4364 
  4365 static const struct ifflag_def ifflag_table[] = {
  4366 #ifdef IFF_UP
  4367   { IFF_UP,             "up" },
  4368 #endif
  4369 #ifdef IFF_BROADCAST
  4370   { IFF_BROADCAST,      "broadcast" },
  4371 #endif
  4372 #ifdef IFF_DEBUG
  4373   { IFF_DEBUG,          "debug" },
  4374 #endif
  4375 #ifdef IFF_LOOPBACK
  4376   { IFF_LOOPBACK,       "loopback" },
  4377 #endif
  4378 #ifdef IFF_POINTOPOINT
  4379   { IFF_POINTOPOINT,    "pointopoint" },
  4380 #endif
  4381 #ifdef IFF_RUNNING
  4382   { IFF_RUNNING,        "running" },
  4383 #endif
  4384 #ifdef IFF_NOARP
  4385   { IFF_NOARP,          "noarp" },
  4386 #endif
  4387 #ifdef IFF_PROMISC
  4388   { IFF_PROMISC,        "promisc" },
  4389 #endif
  4390 #ifdef IFF_NOTRAILERS
  4391 #ifdef NS_IMPL_COCOA
  4392   /* Really means smart, notrailers is obsolete.  */
  4393   { IFF_NOTRAILERS,     "smart" },
  4394 #else
  4395   { IFF_NOTRAILERS,     "notrailers" },
  4396 #endif
  4397 #endif
  4398 #ifdef IFF_ALLMULTI
  4399   { IFF_ALLMULTI,       "allmulti" },
  4400 #endif
  4401 #ifdef IFF_MASTER
  4402   { IFF_MASTER,         "master" },
  4403 #endif
  4404 #ifdef IFF_SLAVE
  4405   { IFF_SLAVE,          "slave" },
  4406 #endif
  4407 #ifdef IFF_MULTICAST
  4408   { IFF_MULTICAST,      "multicast" },
  4409 #endif
  4410 #ifdef IFF_PORTSEL
  4411   { IFF_PORTSEL,        "portsel" },
  4412 #endif
  4413 #ifdef IFF_AUTOMEDIA
  4414   { IFF_AUTOMEDIA,      "automedia" },
  4415 #endif
  4416 #ifdef IFF_DYNAMIC
  4417   { IFF_DYNAMIC,        "dynamic" },
  4418 #endif
  4419 #ifdef IFF_OACTIVE
  4420   { IFF_OACTIVE,        "oactive" }, /* OpenBSD: transmission in progress.  */
  4421 #endif
  4422 #ifdef IFF_SIMPLEX
  4423   { IFF_SIMPLEX,        "simplex" }, /* OpenBSD: can't hear own transmissions.  */
  4424 #endif
  4425 #ifdef IFF_LINK0
  4426   { IFF_LINK0,          "link0" }, /* OpenBSD: per link layer defined bit.  */
  4427 #endif
  4428 #ifdef IFF_LINK1
  4429   { IFF_LINK1,          "link1" }, /* OpenBSD: per link layer defined bit.  */
  4430 #endif
  4431 #ifdef IFF_LINK2
  4432   { IFF_LINK2,          "link2" }, /* OpenBSD: per link layer defined bit.  */
  4433 #endif
  4434   { 0, 0 }
  4435 };
  4436 
  4437 static Lisp_Object
  4438 network_interface_info (Lisp_Object ifname)
  4439 {
  4440   struct ifreq rq;
  4441   Lisp_Object res = Qnil;
  4442   Lisp_Object elt;
  4443   int s;
  4444   bool any = false;
  4445 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR)  \
  4446      && defined HAVE_GETIFADDRS && defined LLADDR)
  4447   struct ifaddrs *ifap;
  4448 #endif
  4449 
  4450   CHECK_STRING (ifname);
  4451 
  4452   if (sizeof rq.ifr_name <= SBYTES (ifname))
  4453     error ("interface name too long");
  4454   lispstpcpy (rq.ifr_name, ifname);
  4455 
  4456   s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
  4457   if (s < 0)
  4458     return Qnil;
  4459   specpdl_ref count = SPECPDL_INDEX ();
  4460   record_unwind_protect_int (close_file_unwind, s);
  4461 
  4462   elt = Qnil;
  4463 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
  4464   if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
  4465     {
  4466       int flags = rq.ifr_flags;
  4467       const struct ifflag_def *fp;
  4468       int fnum;
  4469 
  4470       /* If flags is smaller than int (i.e. short) it may have the high bit set
  4471          due to IFF_MULTICAST.  In that case, sign extending it into
  4472          an int is wrong.  */
  4473       if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
  4474         flags = (unsigned short) rq.ifr_flags;
  4475 
  4476       any = true;
  4477       for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
  4478         {
  4479           if (flags & fp->flag_bit)
  4480             {
  4481               elt = Fcons (intern (fp->flag_sym), elt);
  4482               flags -= fp->flag_bit;
  4483             }
  4484         }
  4485       for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
  4486         {
  4487           if (flags & 1)
  4488             {
  4489               elt = Fcons (make_fixnum (fnum), elt);
  4490             }
  4491         }
  4492     }
  4493 #endif
  4494   res = Fcons (elt, res);
  4495 
  4496   elt = Qnil;
  4497 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
  4498   if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
  4499     {
  4500       Lisp_Object hwaddr = make_uninit_vector (6);
  4501       struct Lisp_Vector *p = XVECTOR (hwaddr);
  4502 
  4503       any = true;
  4504       for (int n = 0; n < 6; n++)
  4505         p->contents[n] = make_fixnum (((unsigned char *)
  4506                                        &rq.ifr_hwaddr.sa_data[0])
  4507                                       [n]);
  4508       elt = Fcons (make_fixnum (rq.ifr_hwaddr.sa_family), hwaddr);
  4509     }
  4510 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
  4511   if (getifaddrs (&ifap) != -1)
  4512     {
  4513       Lisp_Object hwaddr = make_nil_vector (6);
  4514       struct Lisp_Vector *p = XVECTOR (hwaddr);
  4515 
  4516       for (struct ifaddrs *it = ifap; it != NULL; it = it->ifa_next)
  4517         {
  4518           DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
  4519           unsigned char linkaddr[6];
  4520           int n;
  4521 
  4522           if (it->ifa_addr->sa_family != AF_LINK
  4523               || strcmp (it->ifa_name, SSDATA (ifname)) != 0
  4524               || sdl->sdl_alen != 6)
  4525             continue;
  4526 
  4527           memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
  4528           for (n = 0; n < 6; n++)
  4529             p->contents[n] = make_fixnum (linkaddr[n]);
  4530 
  4531           elt = Fcons (make_fixnum (it->ifa_addr->sa_family), hwaddr);
  4532           break;
  4533         }
  4534     }
  4535 #ifdef HAVE_FREEIFADDRS
  4536   freeifaddrs (ifap);
  4537 #endif
  4538 
  4539 #endif /* HAVE_GETIFADDRS && LLADDR */
  4540 
  4541   res = Fcons (elt, res);
  4542 
  4543   elt = Qnil;
  4544 #if (defined SIOCGIFNETMASK \
  4545      && (defined HAVE_STRUCT_IFREQ_IFR_NETMASK \
  4546          || defined HAVE_STRUCT_IFREQ_IFR_ADDR))
  4547   if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
  4548     {
  4549       any = true;
  4550 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
  4551       elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
  4552 #else
  4553       elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
  4554 #endif
  4555     }
  4556 #endif
  4557   res = Fcons (elt, res);
  4558 
  4559   elt = Qnil;
  4560 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
  4561   if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
  4562     {
  4563       any = true;
  4564       elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof rq.ifr_broadaddr);
  4565     }
  4566 #endif
  4567   res = Fcons (elt, res);
  4568 
  4569   elt = Qnil;
  4570 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
  4571   if (ioctl (s, SIOCGIFADDR, &rq) == 0)
  4572     {
  4573       any = true;
  4574       elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
  4575     }
  4576 #endif
  4577   res = Fcons (elt, res);
  4578 
  4579   return unbind_to (count, any ? res : Qnil);
  4580 }
  4581 #endif  /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
  4582 #endif  /* defined (HAVE_NET_IF_H) */
  4583 
  4584 DEFUN ("network-interface-list", Fnetwork_interface_list,
  4585        Snetwork_interface_list, 0, 2, 0,
  4586        doc: /* Return an alist of all network interfaces and their network address.
  4587 Each element is cons of the form (IFNAME . IP) where IFNAME is a
  4588 string containing the interface name, and IP is the network address in
  4589 internal format; see the description of ADDRESS in
  4590 `make-network-process'.  The interface name is not guaranteed to be
  4591 unique.
  4592 
  4593 Optional parameter FULL non-nil means return all IP address info for
  4594 each interface.  Each element is then a list of the form
  4595     (IFNAME IP BCAST MASK)
  4596 where IFNAME is the interface name, IP the IP address,
  4597 BCAST the broadcast address, and MASK the network mask.
  4598 
  4599 Optional parameter FAMILY controls the type of addresses to return.
  4600 The default of nil means both IPv4 and IPv6, symbol `ipv4' means IPv4
  4601 only, symbol `ipv6' means IPv6 only.
  4602 
  4603 See also `network-interface-info', which is limited to IPv4 only.
  4604 
  4605 If the information is not available, return nil.  */)
  4606   (Lisp_Object full, Lisp_Object family)
  4607 {
  4608 #if defined HAVE_GETIFADDRS || defined WINDOWSNT
  4609   unsigned short match;
  4610   bool full_info = false;
  4611 
  4612   if (! NILP (full))
  4613     full_info = true;
  4614   if (NILP (family))
  4615     match = 0;
  4616   else if (EQ (family, Qipv4))
  4617     match = AF_INET;
  4618 #ifdef AF_INET6
  4619   else if (EQ (family, Qipv6))
  4620     match = AF_INET6;
  4621 #endif
  4622   else
  4623     error ("Unsupported address family");
  4624   return network_interface_list (full_info, match);
  4625 #else
  4626   return Qnil;
  4627 #endif
  4628 }
  4629 
  4630 DEFUN ("network-interface-info", Fnetwork_interface_info,
  4631        Snetwork_interface_info, 1, 1, 0,
  4632        doc: /* Return information about network interface named IFNAME.
  4633 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
  4634 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
  4635 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
  4636 FLAGS is the current flags of the interface.
  4637 
  4638 Data that is unavailable is returned as nil.  */)
  4639   (Lisp_Object ifname)
  4640 {
  4641 #if ((defined HAVE_NET_IF_H                            \
  4642       && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
  4643           || defined SIOCGIFFLAGS))                    \
  4644      || defined WINDOWSNT)
  4645   return network_interface_info (ifname);
  4646 #else
  4647   return Qnil;
  4648 #endif
  4649 }
  4650 
  4651 static Lisp_Object
  4652 network_lookup_address_info_1 (Lisp_Object host, const char *service,
  4653                                struct addrinfo *hints, struct addrinfo **res)
  4654 {
  4655   Lisp_Object msg = Qt;
  4656   int ret;
  4657 
  4658   if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
  4659     error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
  4660            SSDATA (host));
  4661 
  4662 #ifdef WINDOWSNT
  4663   /* Ensure socket support is loaded if available.  */
  4664   init_winsock (TRUE);
  4665 #endif
  4666 
  4667   ret = getaddrinfo (SSDATA (host), service, hints, res);
  4668   if (ret)
  4669     {
  4670       if (service == NULL)
  4671         service = "0";
  4672 #ifdef HAVE_GAI_STRERROR
  4673       synchronize_system_messages_locale ();
  4674       char const *str = gai_strerror (ret);
  4675       if (! NILP (Vlocale_coding_system))
  4676         str = SSDATA (code_convert_string_norecord
  4677                       (build_string (str), Vlocale_coding_system, 0));
  4678       AUTO_STRING (format, "%s/%s %s");
  4679       msg = CALLN (Fformat, format, host, build_string (service),
  4680                    build_string (str));
  4681 #else
  4682       AUTO_STRING (format, "%s/%s getaddrinfo error %d");
  4683       msg = CALLN (Fformat, format, host, build_string (service),
  4684                    make_int (ret));
  4685 #endif
  4686     }
  4687    return msg;
  4688 }
  4689 
  4690 DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
  4691        Snetwork_lookup_address_info, 1, 3, 0,
  4692        doc: /* Look up Internet Protocol (IP) address info of NAME.
  4693 Optional argument FAMILY controls whether to look up IPv4 or IPv6
  4694 addresses.  The default of nil means both, symbol `ipv4' means IPv4
  4695 only, symbol `ipv6' means IPv6 only.
  4696 Optional argument HINTS allows specifying the hints passed to the
  4697 underlying library call.  The only supported value is `numeric', which
  4698 means treat NAME as a numeric IP address.  This also suppresses DNS
  4699 traffic.
  4700 Return a list of addresses, or nil if none were found.  Each address
  4701 is a vector of integers, as per the description of ADDRESS in
  4702 `make-network-process'.  In case of error log the error message
  4703 returned from the lookup.  */)
  4704   (Lisp_Object name, Lisp_Object family, Lisp_Object hint)
  4705 {
  4706   Lisp_Object addresses = Qnil;
  4707   Lisp_Object msg = Qnil;
  4708 
  4709   struct addrinfo *res, *lres;
  4710   struct addrinfo hints;
  4711 
  4712   memset (&hints, 0, sizeof hints);
  4713   if (NILP (family))
  4714     hints.ai_family = AF_UNSPEC;
  4715   else if (EQ (family, Qipv4))
  4716     hints.ai_family = AF_INET;
  4717 #ifdef AF_INET6
  4718   else if (EQ (family, Qipv6))
  4719     hints.ai_family = AF_INET6;
  4720 #endif
  4721   else
  4722     error ("Unsupported family");
  4723   hints.ai_socktype = SOCK_DGRAM;
  4724 
  4725   if (EQ (hint, Qnumeric))
  4726     hints.ai_flags = AI_NUMERICHOST;
  4727   else if (!NILP (hint))
  4728     error ("Unsupported hints value");
  4729 
  4730   msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
  4731   if (!EQ (msg, Qt))
  4732     message ("%s", SSDATA(msg));
  4733   else
  4734     {
  4735       for (lres = res; lres; lres = lres->ai_next)
  4736         {
  4737 #ifndef AF_INET6
  4738           if (lres->ai_family != AF_INET)
  4739             continue;
  4740 #endif
  4741           addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr,
  4742                                                     lres->ai_addrlen),
  4743                              addresses);
  4744         }
  4745       addresses = Fnreverse (addresses);
  4746 
  4747       freeaddrinfo (res);
  4748     }
  4749   return addresses;
  4750 }
  4751 
  4752 /* Turn off input and output for process PROC.  */
  4753 
  4754 static void
  4755 deactivate_process (Lisp_Object proc)
  4756 {
  4757   int inchannel;
  4758   struct Lisp_Process *p = XPROCESS (proc);
  4759   int i;
  4760 
  4761 #ifdef HAVE_GNUTLS
  4762   /* Delete GnuTLS structures in PROC, if any.  */
  4763   emacs_gnutls_deinit (proc);
  4764 #endif /* HAVE_GNUTLS */
  4765 
  4766   if (p->read_output_delay > 0)
  4767     {
  4768       if (--process_output_delay_count < 0)
  4769         process_output_delay_count = 0;
  4770       p->read_output_delay = 0;
  4771       p->read_output_skip = 0;
  4772     }
  4773 
  4774   /* Beware SIGCHLD hereabouts.  */
  4775 
  4776   for (i = 0; i < PROCESS_OPEN_FDS; i++)
  4777     close_process_fd (&p->open_fd[i]);
  4778 
  4779   inchannel = p->infd;
  4780   eassert (inchannel < FD_SETSIZE);
  4781   if (inchannel >= 0)
  4782     {
  4783       p->infd  = -1;
  4784       p->outfd = -1;
  4785 #ifdef DATAGRAM_SOCKETS
  4786       if (DATAGRAM_CHAN_P (inchannel))
  4787         {
  4788           xfree (datagram_address[inchannel].sa);
  4789           datagram_address[inchannel].sa = 0;
  4790           datagram_address[inchannel].len = 0;
  4791         }
  4792 #endif
  4793       chan_process[inchannel] = Qnil;
  4794       delete_read_fd (inchannel);
  4795       if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
  4796         delete_write_fd (inchannel);
  4797       if (inchannel == max_desc)
  4798         recompute_max_desc ();
  4799     }
  4800 }
  4801 
  4802 
  4803 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
  4804        0, 4, 0,
  4805        doc: /* Allow any pending output from subprocesses to be read by Emacs.
  4806 It is given to their filter functions.
  4807 Optional argument PROCESS means to return only after output is
  4808 received from PROCESS or PROCESS closes the connection.
  4809 
  4810 Optional second argument SECONDS and third argument MILLISEC
  4811 specify a timeout; return after that much time even if there is
  4812 no subprocess output.  If SECONDS is a floating point number,
  4813 it specifies a fractional number of seconds to wait.
  4814 The MILLISEC argument is obsolete and should be avoided.
  4815 
  4816 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
  4817 from PROCESS only, suspending reading output from other processes.
  4818 If JUST-THIS-ONE is an integer, don't run any timers either.
  4819 Return non-nil if we received any output from PROCESS (or, if PROCESS
  4820 is nil, from any process) before the timeout expired or the
  4821 corresponding connection was closed.  */)
  4822   (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
  4823    Lisp_Object just_this_one)
  4824 {
  4825   intmax_t secs;
  4826   int nsecs;
  4827 
  4828   if (! NILP (process))
  4829     {
  4830       CHECK_PROCESS (process);
  4831       struct Lisp_Process *proc = XPROCESS (process);
  4832 
  4833       /* Can't wait for a process that is dedicated to a different
  4834          thread.  */
  4835       if (!NILP (proc->thread) && !BASE_EQ (proc->thread, Fcurrent_thread ()))
  4836         {
  4837           Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
  4838 
  4839           error ("Attempt to accept output from process %s locked to thread %s",
  4840                  SDATA (proc->name),
  4841                  STRINGP (proc_thread_name)
  4842                  ? SDATA (proc_thread_name)
  4843                  : SDATA (Fprin1_to_string (proc->thread, Qt, Qnil)));
  4844         }
  4845     }
  4846   else
  4847     just_this_one = Qnil;
  4848 
  4849   if (!NILP (millisec))
  4850     { /* Obsolete calling convention using integers rather than floats.  */
  4851       CHECK_FIXNUM (millisec);
  4852       if (NILP (seconds))
  4853         seconds = make_float (XFIXNUM (millisec) / 1000.0);
  4854       else
  4855         {
  4856           CHECK_FIXNUM (seconds);
  4857           seconds = make_float (XFIXNUM (millisec) / 1000.0 + XFIXNUM (seconds));
  4858         }
  4859     }
  4860 
  4861   secs = 0;
  4862   nsecs = -1;
  4863 
  4864   if (!NILP (seconds))
  4865     {
  4866       if (FIXNUMP (seconds))
  4867         {
  4868           if (XFIXNUM (seconds) > 0)
  4869             {
  4870               secs = XFIXNUM (seconds);
  4871               nsecs = 0;
  4872             }
  4873         }
  4874       else if (FLOATP (seconds))
  4875         {
  4876           if (XFLOAT_DATA (seconds) > 0)
  4877             {
  4878               struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
  4879               secs = min (t.tv_sec, WAIT_READING_MAX);
  4880               nsecs = t.tv_nsec;
  4881             }
  4882         }
  4883       else
  4884         wrong_type_argument (Qnumberp, seconds);
  4885     }
  4886   else if (! NILP (process))
  4887     nsecs = 0;
  4888 
  4889   return
  4890     ((wait_reading_process_output (secs, nsecs, 0, 0,
  4891                                    Qnil,
  4892                                    !NILP (process) ? XPROCESS (process) : NULL,
  4893                                    (NILP (just_this_one) ? 0
  4894                                     : !FIXNUMP (just_this_one) ? 1 : -1))
  4895       <= 0)
  4896      ? Qnil : Qt);
  4897 }
  4898 
  4899 /* Accept a connection for server process SERVER on CHANNEL.  */
  4900 
  4901 static EMACS_INT connect_counter = 0;
  4902 
  4903 static void
  4904 server_accept_connection (Lisp_Object server, int channel)
  4905 {
  4906   Lisp_Object buffer;
  4907   Lisp_Object contact, host, service;
  4908   struct Lisp_Process *ps = XPROCESS (server);
  4909   struct Lisp_Process *p;
  4910   int s;
  4911   union u_sockaddr saddr;
  4912   socklen_t len = sizeof saddr;
  4913 
  4914   s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
  4915 
  4916   if (FD_SETSIZE <= s)
  4917     {
  4918       emacs_close (s);
  4919       s = -1;
  4920       errno = EMFILE;
  4921     }
  4922 
  4923   if (s < 0)
  4924     {
  4925       int code = errno;
  4926       if (!would_block (code) && !NILP (ps->log))
  4927         call3 (ps->log, server, Qnil,
  4928                concat3 (build_string ("accept failed with code"),
  4929                         Fnumber_to_string (make_fixnum (code)),
  4930                         build_string ("\n")));
  4931       return;
  4932     }
  4933 
  4934   specpdl_ref count = SPECPDL_INDEX ();
  4935   record_unwind_protect_int (close_file_unwind, s);
  4936 
  4937   connect_counter++;
  4938 
  4939   /* Setup a new process to handle the connection.  */
  4940 
  4941   /* Generate a unique identification of the caller, and build contact
  4942      information for this process.  */
  4943   host = Qt;
  4944   service = Qnil;
  4945   Lisp_Object args[11];
  4946   int nargs = 0;
  4947   #define HOST_FORMAT_IN "%d.%d.%d.%d"
  4948   #define HOST_FORMAT_IN6 "%x:%x:%x:%x:%x:%x:%x:%x"
  4949   AUTO_STRING (host_format_in, HOST_FORMAT_IN);
  4950   AUTO_STRING (host_format_in6, HOST_FORMAT_IN6);
  4951   AUTO_STRING (procname_format_in, "%s <"HOST_FORMAT_IN":%d>");
  4952   AUTO_STRING (procname_format_in6, "%s <["HOST_FORMAT_IN6"]:%d>");
  4953   AUTO_STRING (procname_format_default, "%s <%d>");
  4954   switch (saddr.sa.sa_family)
  4955     {
  4956     case AF_INET:
  4957       {
  4958         args[nargs++] = procname_format_in;
  4959         args[nargs++] = host_format_in;
  4960         unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
  4961         service = make_fixnum (ntohs (saddr.in.sin_port));
  4962         for (int i = 0; i < 4; i++)
  4963           args[nargs++] = make_fixnum (ip[i]);
  4964         host = Fformat (5, args + 1);
  4965         args[nargs++] = service;
  4966       }
  4967       break;
  4968 
  4969 #ifdef AF_INET6
  4970     case AF_INET6:
  4971       {
  4972         args[nargs++] = procname_format_in6;
  4973         args[nargs++] = host_format_in6;
  4974         DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
  4975         service = make_fixnum (ntohs (saddr.in.sin_port));
  4976         for (int i = 0; i < 8; i++)
  4977           args[nargs++] = make_fixnum (ip6[i]);
  4978         host = Fformat (9, args + 1);
  4979         args[nargs++] = service;
  4980       }
  4981       break;
  4982 #endif
  4983 
  4984     default:
  4985       args[nargs++] = procname_format_default;
  4986       nargs++;
  4987       args[nargs++] = make_fixnum (connect_counter);
  4988       break;
  4989     }
  4990 
  4991   /* Create a new buffer name for this process if it doesn't have a
  4992      filter.  The new buffer name is based on the buffer name or
  4993      process name of the server process concatenated with the caller
  4994      identification.  */
  4995 
  4996   if (!(EQ (ps->filter, Qinternal_default_process_filter)
  4997         || EQ (ps->filter, Qt)))
  4998     buffer = Qnil;
  4999   else
  5000     {
  5001       buffer = ps->buffer;
  5002       if (!NILP (buffer))
  5003         buffer = Fbuffer_name (buffer);
  5004       else
  5005         buffer = ps->name;
  5006       if (!NILP (buffer))
  5007         {
  5008           args[1] = buffer;
  5009           buffer = Fget_buffer_create (Fformat (nargs, args), Qnil);
  5010         }
  5011     }
  5012 
  5013   /* Generate a unique name for the new server process.  Combine the
  5014      server process name with the caller identification.  */
  5015 
  5016   args[1] = ps->name;
  5017   Lisp_Object name = Fformat (nargs, args);
  5018   Lisp_Object proc = make_process (name);
  5019 
  5020   eassert (0 <= s && s < FD_SETSIZE);
  5021   chan_process[s] = proc;
  5022 
  5023   fcntl (s, F_SETFL, O_NONBLOCK);
  5024 
  5025   p = XPROCESS (proc);
  5026 
  5027   /* Build new contact information for this setup.  */
  5028   contact = Fcopy_sequence (ps->childp);
  5029   contact = plist_put (contact, QCserver, Qnil);
  5030   contact = plist_put (contact, QChost, host);
  5031   if (!NILP (service))
  5032     contact = plist_put (contact, QCservice, service);
  5033   contact = plist_put (contact, QCremote,
  5034                        conv_sockaddr_to_lisp (&saddr.sa, len));
  5035 #ifdef HAVE_GETSOCKNAME
  5036   len = sizeof saddr;
  5037   if (getsockname (s, &saddr.sa, &len) == 0)
  5038     contact = plist_put (contact, QClocal,
  5039                          conv_sockaddr_to_lisp (&saddr.sa, len));
  5040 #endif
  5041 
  5042   pset_childp (p, contact);
  5043   pset_plist (p, Fcopy_sequence (ps->plist));
  5044   pset_type (p, Qnetwork);
  5045 
  5046   pset_buffer (p, buffer);
  5047   pset_sentinel (p, ps->sentinel);
  5048   pset_filter (p, ps->filter);
  5049   eassert (NILP (p->command));
  5050   eassert (p->pid == 0);
  5051 
  5052   /* Discard the unwind protect for closing S.  */
  5053   specpdl_ptr = specpdl_ref_to_ptr (count);
  5054 
  5055   p->open_fd[SUBPROCESS_STDIN] = s;
  5056   p->infd  = s;
  5057   p->outfd = s;
  5058   pset_status (p, Qrun);
  5059 
  5060   /* Client processes for accepted connections are not stopped initially.  */
  5061   if (!EQ (p->filter, Qt))
  5062     add_process_read_fd (s);
  5063   if (s > max_desc)
  5064     max_desc = s;
  5065 
  5066   /* Setup coding system for new process based on server process.
  5067      This seems to be the proper thing to do, as the coding system
  5068      of the new process should reflect the settings at the time the
  5069      server socket was opened; not the current settings.  */
  5070 
  5071   pset_decode_coding_system (p, ps->decode_coding_system);
  5072   pset_encode_coding_system (p, ps->encode_coding_system);
  5073   setup_process_coding_systems (proc);
  5074 
  5075   pset_decoding_buf (p, empty_unibyte_string);
  5076   eassert (p->decoding_carryover == 0);
  5077   pset_encoding_buf (p, empty_unibyte_string);
  5078 
  5079   p->inherit_coding_system_flag
  5080     = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
  5081 
  5082   AUTO_STRING (dash, "-");
  5083   AUTO_STRING (nl, "\n");
  5084   Lisp_Object host_string = STRINGP (host) ? host : dash;
  5085 
  5086   if (!NILP (ps->log))
  5087     {
  5088       AUTO_STRING (accept_from, "accept from ");
  5089       call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
  5090     }
  5091 
  5092   AUTO_STRING (open_from, "open from ");
  5093   exec_sentinel (proc, concat3 (open_from, host_string, nl));
  5094 }
  5095 
  5096 #ifdef HAVE_GETADDRINFO_A
  5097 static Lisp_Object
  5098 check_for_dns (Lisp_Object proc)
  5099 {
  5100   struct Lisp_Process *p = XPROCESS (proc);
  5101   Lisp_Object addrinfos = Qnil;
  5102 
  5103   /* Sanity check. */
  5104   if (! p->dns_request)
  5105     return Qnil;
  5106 
  5107   int ret = gai_error (p->dns_request);
  5108   if (ret == EAI_INPROGRESS)
  5109     return Qt;
  5110 
  5111   /* We got a response. */
  5112   if (ret == 0)
  5113     {
  5114       struct addrinfo *res;
  5115 
  5116       for (res = p->dns_request->ar_result; res; res = res->ai_next)
  5117         addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
  5118 
  5119       addrinfos = Fnreverse (addrinfos);
  5120     }
  5121   /* The DNS lookup failed. */
  5122   else if (connecting_status (p->status))
  5123     {
  5124       deactivate_process (proc);
  5125       pset_status (p, (list2
  5126                        (Qfailed,
  5127                         concat3 (build_string ("Name lookup of "),
  5128                                  build_string (p->dns_request->ar_name),
  5129                                  build_string (" failed")))));
  5130     }
  5131 
  5132   free_dns_request (proc);
  5133 
  5134   /* This process should not already be connected (or killed). */
  5135   if (! connecting_status (p->status))
  5136     return Qnil;
  5137 
  5138   return addrinfos;
  5139 }
  5140 
  5141 #endif /* HAVE_GETADDRINFO_A */
  5142 
  5143 static void
  5144 wait_for_socket_fds (Lisp_Object process, char const *name)
  5145 {
  5146   while (XPROCESS (process)->infd < 0
  5147          && connecting_status (XPROCESS (process)->status))
  5148     {
  5149       add_to_log ("Waiting for socket from %s...", build_string (name));
  5150       wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
  5151     }
  5152 }
  5153 
  5154 static void
  5155 wait_while_connecting (Lisp_Object process)
  5156 {
  5157   while (connecting_status (XPROCESS (process)->status))
  5158     {
  5159       add_to_log ("Waiting for connection...");
  5160       wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
  5161     }
  5162 }
  5163 
  5164 static void
  5165 wait_for_tls_negotiation (Lisp_Object process)
  5166 {
  5167 #ifdef HAVE_GNUTLS
  5168   while (XPROCESS (process)->gnutls_p
  5169          && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
  5170     {
  5171       add_to_log ("Waiting for TLS...");
  5172       wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
  5173     }
  5174 #endif
  5175 }
  5176 
  5177 static void
  5178 wait_reading_process_output_unwind (int data)
  5179 {
  5180   clear_waiting_thread_info ();
  5181   waiting_for_user_input_p = data;
  5182 }
  5183 
  5184 /* This is here so breakpoints can be put on it.  */
  5185 static void
  5186 wait_reading_process_output_1 (void)
  5187 {
  5188 }
  5189 
  5190 /* Read and dispose of subprocess output while waiting for timeout to
  5191    elapse and/or keyboard input to be available.
  5192 
  5193    TIME_LIMIT is:
  5194      timeout in seconds
  5195      If negative, gobble data immediately available but don't wait for any.
  5196 
  5197    NSECS is:
  5198      an additional duration to wait, measured in nanoseconds
  5199      If TIME_LIMIT is zero, then:
  5200        If NSECS == 0, there is no limit.
  5201        If NSECS > 0, the timeout consists of NSECS only.
  5202        If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
  5203 
  5204    READ_KBD is:
  5205      0 to ignore keyboard input, or
  5206      1 to return when input is available, or
  5207     -1 meaning caller will actually read the input, so don't throw to
  5208        the quit handler
  5209 
  5210    DO_DISPLAY means redisplay should be done to show subprocess
  5211      output that arrives.
  5212 
  5213    If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
  5214      (and gobble terminal input into the buffer if any arrives).
  5215 
  5216    If WAIT_PROC is specified, wait until something arrives from that
  5217      process.
  5218 
  5219    If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
  5220      (suspending output from other processes).  A negative value
  5221      means don't run any timers either.
  5222 
  5223    Return positive if we received input from WAIT_PROC (or from any
  5224    process if WAIT_PROC is null), zero if we attempted to receive
  5225    input but got none, and negative if we didn't even try.  */
  5226 
  5227 int
  5228 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
  5229                              bool do_display,
  5230                              Lisp_Object wait_for_cell,
  5231                              struct Lisp_Process *wait_proc, int just_wait_proc)
  5232 {
  5233   static int last_read_channel = -1;
  5234   int channel, nfds;
  5235   fd_set Available;
  5236   fd_set Writeok;
  5237   bool check_write;
  5238   int check_delay;
  5239   bool no_avail;
  5240   int xerrno;
  5241   Lisp_Object proc;
  5242   struct timespec timeout, end_time, timer_delay;
  5243   struct timespec got_output_end_time = invalid_timespec ();
  5244   enum { MINIMUM = -1, TIMEOUT, FOREVER } wait;
  5245   int got_some_output = -1;
  5246   uintmax_t prev_wait_proc_nbytes_read = wait_proc ? wait_proc->nbytes_read : 0;
  5247 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
  5248   bool retry_for_async;
  5249 #endif
  5250   specpdl_ref count = SPECPDL_INDEX ();
  5251 
  5252   /* Close to the current time if known, an invalid timespec otherwise.  */
  5253   struct timespec now = invalid_timespec ();
  5254 
  5255   eassert (wait_proc == NULL
  5256            || NILP (wait_proc->thread)
  5257            || XTHREAD (wait_proc->thread) == current_thread);
  5258 
  5259   FD_ZERO (&Available);
  5260   FD_ZERO (&Writeok);
  5261 
  5262   if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
  5263       && !(CONSP (wait_proc->status)
  5264            && EQ (XCAR (wait_proc->status), Qexit)))
  5265     message1 ("Blocking call to accept-process-output with quit inhibited!!");
  5266 
  5267   record_unwind_protect_int (wait_reading_process_output_unwind,
  5268                              waiting_for_user_input_p);
  5269   waiting_for_user_input_p = read_kbd;
  5270 
  5271   if (TYPE_MAXIMUM (time_t) < time_limit)
  5272     time_limit = TYPE_MAXIMUM (time_t);
  5273 
  5274   if (time_limit < 0 || nsecs < 0)
  5275     wait = MINIMUM;
  5276   else if (time_limit > 0 || nsecs > 0)
  5277     {
  5278       wait = TIMEOUT;
  5279       now = current_timespec ();
  5280       end_time = timespec_add (now, make_timespec (time_limit, nsecs));
  5281     }
  5282   else
  5283     wait = FOREVER;
  5284 
  5285   while (1)
  5286     {
  5287       bool process_skipped = false;
  5288       bool wrapped;
  5289       int channel_start;
  5290 
  5291       /* If calling from keyboard input, do not quit
  5292          since we want to return C-g as an input character.
  5293          Otherwise, do pending quit if requested.  */
  5294       if (read_kbd >= 0)
  5295         maybe_quit ();
  5296       else if (pending_signals)
  5297         process_pending_signals ();
  5298 
  5299       /* Exit now if the cell we're waiting for became non-nil.  */
  5300       if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
  5301         break;
  5302 
  5303       eassert (max_desc < FD_SETSIZE);
  5304 
  5305 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
  5306       {
  5307         Lisp_Object process_list_head, aproc;
  5308         struct Lisp_Process *p;
  5309 
  5310         retry_for_async = false;
  5311         FOR_EACH_PROCESS(process_list_head, aproc)
  5312           {
  5313             p = XPROCESS (aproc);
  5314 
  5315             if (! wait_proc || p == wait_proc)
  5316               {
  5317 #ifdef HAVE_GETADDRINFO_A
  5318                 /* Check for pending DNS requests. */
  5319                 if (p->dns_request)
  5320                   {
  5321                     Lisp_Object addrinfos = check_for_dns (aproc);
  5322                     if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
  5323                       connect_network_socket (aproc, addrinfos, Qnil);
  5324                     else
  5325                       retry_for_async = true;
  5326                   }
  5327 #endif
  5328 #ifdef HAVE_GNUTLS
  5329                 /* Continue TLS negotiation. */
  5330                 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
  5331                     && p->is_non_blocking_client
  5332                     /* Don't proceed until we have established a connection. */
  5333                     && !(fd_callback_info[p->outfd].flags
  5334                          & NON_BLOCKING_CONNECT_FD))
  5335                   {
  5336                     gnutls_try_handshake (p);
  5337                     p->gnutls_handshakes_tried++;
  5338 
  5339                     if (p->gnutls_initstage == GNUTLS_STAGE_READY)
  5340                       {
  5341                         gnutls_verify_boot (aproc, Qnil);
  5342                         finish_after_tls_connection (aproc);
  5343                       }
  5344                     else
  5345                       {
  5346                         retry_for_async = true;
  5347                         if (p->gnutls_handshakes_tried
  5348                             > GNUTLS_EMACS_HANDSHAKES_LIMIT)
  5349                           {
  5350                             deactivate_process (aproc);
  5351                             pset_status (p, list2 (Qfailed,
  5352                                                    build_string ("TLS negotiation failed")));
  5353                           }
  5354                       }
  5355                   }
  5356 #endif
  5357               }
  5358           }
  5359       }
  5360 #endif /* GETADDRINFO_A or GNUTLS */
  5361 
  5362       /* Compute time from now till when time limit is up.  */
  5363       /* Exit if already run out.  */
  5364       if (wait == TIMEOUT)
  5365         {
  5366           if (!timespec_valid_p (now))
  5367             now = current_timespec ();
  5368           if (timespec_cmp (end_time, now) <= 0)
  5369             break;
  5370           timeout = timespec_sub (end_time, now);
  5371         }
  5372       else
  5373         timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
  5374 
  5375       /* Normally we run timers here.
  5376          But not if wait_for_cell; in those cases,
  5377          the wait is supposed to be short,
  5378          and those callers cannot handle running arbitrary Lisp code here.  */
  5379       if (NILP (wait_for_cell)
  5380           && just_wait_proc >= 0)
  5381         {
  5382           do
  5383             {
  5384               unsigned old_timers_run = timers_run;
  5385 
  5386               timer_delay = timer_check ();
  5387 
  5388               if (timers_run != old_timers_run && do_display)
  5389                 /* We must retry, since a timer may have requeued itself
  5390                    and that could alter the time_delay.  */
  5391                 redisplay_preserve_echo_area (9);
  5392               else
  5393                 break;
  5394             }
  5395           while (!detect_input_pending ());
  5396 
  5397           /* If there is unread keyboard input, also return.  */
  5398           if (read_kbd != 0
  5399               && requeued_events_pending_p ())
  5400             break;
  5401 
  5402           /* This is so a breakpoint can be put here.  */
  5403           if (!timespec_valid_p (timer_delay))
  5404               wait_reading_process_output_1 ();
  5405         }
  5406 
  5407       /* Cause C-g signals to take immediate action,
  5408          and cause input available signals to zero out timeout.
  5409 
  5410          It is important that we do this before checking for process
  5411          activity.  If we get a SIGCHLD after the explicit checks for
  5412          process activity, timeout is the only way we will know.  */
  5413       if (read_kbd < 0 && kbd_is_ours ())
  5414         set_waiting_for_input (&timeout);
  5415 
  5416       /* If status of something has changed, and no input is
  5417          available, notify the user of the change right away.  After
  5418          this explicit check, we'll let the SIGCHLD handler zap
  5419          timeout to get our attention.  */
  5420       if (update_tick != process_tick)
  5421         {
  5422           fd_set Atemp;
  5423           fd_set Ctemp;
  5424 
  5425           if (kbd_on_hold_p ())
  5426             FD_ZERO (&Atemp);
  5427           else
  5428             compute_input_wait_mask (&Atemp);
  5429           compute_write_mask (&Ctemp);
  5430 
  5431           /* If a process status has changed, the child signal pipe
  5432              will likely be readable.  We want to ignore it for now,
  5433              because otherwise we wouldn't run into a timeout
  5434              below.  */
  5435           int fd = child_signal_read_fd;
  5436           eassert (fd < FD_SETSIZE);
  5437           if (0 <= fd)
  5438             FD_CLR (fd, &Atemp);
  5439 
  5440           timeout = make_timespec (0, 0);
  5441           if ((thread_select (pselect, max_desc + 1,
  5442                               &Atemp,
  5443                               (num_pending_connects > 0 ? &Ctemp : NULL),
  5444                               NULL, &timeout, NULL)
  5445                <= 0))
  5446             {
  5447               /* It's okay for us to do this and then continue with
  5448                  the loop, since timeout has already been zeroed out.  */
  5449               clear_waiting_for_input ();
  5450               got_some_output = status_notify (NULL, wait_proc);
  5451               if (do_display) redisplay_preserve_echo_area (13);
  5452             }
  5453         }
  5454 
  5455       /* Don't wait for output from a non-running process.  Just
  5456          read whatever data has already been received.  */
  5457       if (wait_proc && wait_proc->raw_status_new)
  5458         update_status (wait_proc);
  5459       if (wait_proc
  5460           && ! EQ (wait_proc->status, Qrun)
  5461           && ! connecting_status (wait_proc->status))
  5462         {
  5463           bool read_some_bytes = false;
  5464 
  5465           clear_waiting_for_input ();
  5466 
  5467           /* If data can be read from the process, do so until exhausted.  */
  5468           if (wait_proc->infd >= 0)
  5469             {
  5470               unsigned int count = 0;
  5471               XSETPROCESS (proc, wait_proc);
  5472 
  5473               while (true)
  5474                 {
  5475                   int nread = read_process_output (proc, wait_proc->infd);
  5476                   rarely_quit (++count);
  5477                   if (nread < 0)
  5478                     {
  5479                       if (errno != EINTR)
  5480                         break;
  5481                     }
  5482                   else
  5483                     {
  5484                       if (got_some_output < nread)
  5485                         got_some_output = nread;
  5486                       if (nread == 0)
  5487                         break;
  5488                       read_some_bytes = true;
  5489                     }
  5490                 }
  5491             }
  5492 
  5493           if (read_some_bytes && do_display)
  5494             redisplay_preserve_echo_area (10);
  5495 
  5496           break;
  5497         }
  5498 
  5499       /* Wait till there is something to do.  */
  5500 
  5501       if (wait_proc && just_wait_proc)
  5502         {
  5503           if (wait_proc->infd < 0)  /* Terminated.  */
  5504             break;
  5505           FD_SET (wait_proc->infd, &Available);
  5506           check_delay = 0;
  5507           check_write = 0;
  5508         }
  5509       else if (!NILP (wait_for_cell))
  5510         {
  5511           compute_non_process_wait_mask (&Available);
  5512           check_delay = 0;
  5513           check_write = 0;
  5514         }
  5515       else
  5516         {
  5517           if (! read_kbd)
  5518             compute_non_keyboard_wait_mask (&Available);
  5519           else
  5520             compute_input_wait_mask (&Available);
  5521           compute_write_mask (&Writeok);
  5522           check_delay = wait_proc ? 0 : process_output_delay_count;
  5523           check_write = true;
  5524         }
  5525 
  5526       /* We have to be informed when we receive a SIGCHLD signal for
  5527          an asynchronous process.  Otherwise this might deadlock if we
  5528          receive a SIGCHLD during `pselect'.  */
  5529       int child_fd = child_signal_read_fd;
  5530       eassert (child_fd < FD_SETSIZE);
  5531       if (0 <= child_fd)
  5532         FD_SET (child_fd, &Available);
  5533 
  5534       /* If frame size has changed or the window is newly mapped,
  5535          redisplay now, before we start to wait.  There is a race
  5536          condition here; if a SIGIO arrives between now and the select
  5537          and indicates that a frame is trashed, the select may block
  5538          displaying a trashed screen.  */
  5539       if (frame_garbaged && do_display)
  5540         {
  5541           clear_waiting_for_input ();
  5542           redisplay_preserve_echo_area (11);
  5543           if (read_kbd < 0 && kbd_is_ours ())
  5544             set_waiting_for_input (&timeout);
  5545         }
  5546 
  5547       /* Skip the `select' call if input is available and we're
  5548          waiting for keyboard input or a cell change (which can be
  5549          triggered by processing X events).  In the latter case, set
  5550          nfds to 1 to avoid breaking the loop.  */
  5551       no_avail = 0;
  5552       if ((read_kbd
  5553            /* The following code doesn't make any sense for just the
  5554               wait_for_cell case, because detect_input_pending returns
  5555               whether or not the keyboard buffer isn't empty or there
  5556               is mouse movement.  Any keyboard input that arrives
  5557               while waiting for a cell will cause the select call to
  5558               be skipped, and gobble_input to be called even when
  5559               there is no input available from the terminal itself.
  5560               Skipping the call to select also causes the timeout to
  5561               be ignored.  (bug#46935) */
  5562            /* || !NILP (wait_for_cell) */)
  5563           && detect_input_pending ())
  5564         {
  5565           nfds = read_kbd ? 0 : 1;
  5566           no_avail = 1;
  5567           FD_ZERO (&Available);
  5568         }
  5569       else
  5570         {
  5571 #ifdef HAVE_GNUTLS
  5572           int tls_nfds;
  5573           fd_set tls_available;
  5574 #endif
  5575           /* Set the timeout for adaptive read buffering if any
  5576              process has non-zero read_output_skip and non-zero
  5577              read_output_delay, and we are not reading output for a
  5578              specific process.  It is not executed if
  5579              Vprocess_adaptive_read_buffering is nil.  */
  5580           if (process_output_skip && check_delay > 0)
  5581             {
  5582               int adaptive_nsecs = timeout.tv_nsec;
  5583               if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
  5584                 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
  5585               for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
  5586                 {
  5587                   proc = chan_process[channel];
  5588                   if (NILP (proc))
  5589                     continue;
  5590                   /* Find minimum non-zero read_output_delay among the
  5591                      processes with non-zero read_output_skip.  */
  5592                   if (XPROCESS (proc)->read_output_delay > 0)
  5593                     {
  5594                       check_delay--;
  5595                       if (!XPROCESS (proc)->read_output_skip)
  5596                         continue;
  5597                       FD_CLR (channel, &Available);
  5598                       process_skipped = true;
  5599                       XPROCESS (proc)->read_output_skip = 0;
  5600                       if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
  5601                         adaptive_nsecs = XPROCESS (proc)->read_output_delay;
  5602                     }
  5603                 }
  5604               timeout = make_timespec (0, adaptive_nsecs);
  5605               process_output_skip = 0;
  5606             }
  5607 
  5608           /* If we've got some output and haven't limited our timeout
  5609              with adaptive read buffering, limit it. */
  5610           if (got_some_output > 0 && !process_skipped
  5611               && (timeout.tv_sec
  5612                   || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
  5613             timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
  5614 
  5615 
  5616           if (NILP (wait_for_cell) && just_wait_proc >= 0
  5617               && timespec_valid_p (timer_delay)
  5618               && timespec_cmp (timer_delay, timeout) < 0)
  5619             {
  5620               if (!timespec_valid_p (now))
  5621                 now = current_timespec ();
  5622               struct timespec timeout_abs = timespec_add (now, timeout);
  5623               if (!timespec_valid_p (got_output_end_time)
  5624                   || timespec_cmp (timeout_abs, got_output_end_time) < 0)
  5625                 got_output_end_time = timeout_abs;
  5626               timeout = timer_delay;
  5627             }
  5628           else
  5629             got_output_end_time = invalid_timespec ();
  5630 
  5631           /* NOW can become inaccurate if time can pass during pselect.  */
  5632           if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
  5633             now = invalid_timespec ();
  5634 
  5635 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
  5636           if (retry_for_async
  5637               && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
  5638             {
  5639               timeout.tv_sec = 0;
  5640               timeout.tv_nsec = ASYNC_RETRY_NSEC;
  5641             }
  5642 #endif
  5643 
  5644 #ifdef HAVE_GNUTLS
  5645           /* GnuTLS buffers data internally. We need to check if some
  5646              data is available in the buffers manually before the select.
  5647              And if so, we need to skip the select which could block. */
  5648           FD_ZERO (&tls_available);
  5649           tls_nfds = 0;
  5650           for (channel = 0; channel < FD_SETSIZE; ++channel)
  5651             if (! NILP (chan_process[channel])
  5652                 && FD_ISSET (channel, &Available))
  5653               {
  5654                 struct Lisp_Process *p = XPROCESS (chan_process[channel]);
  5655                 if (p
  5656                     && p->gnutls_p && p->gnutls_state
  5657                     && emacs_gnutls_record_check_pending (p->gnutls_state) > 0)
  5658                   {
  5659                     tls_nfds++;
  5660                     eassert (p->infd == channel);
  5661                     FD_SET (p->infd, &tls_available);
  5662                   }
  5663               }
  5664           /* If wait_proc is somebody else, we have to wait in select
  5665              as usual.  Otherwise, clobber the timeout. */
  5666           if (tls_nfds > 0
  5667               && (!wait_proc ||
  5668                   (wait_proc->infd >= 0
  5669                    && FD_ISSET (wait_proc->infd, &tls_available))))
  5670             timeout = make_timespec (0, 0);
  5671 #endif
  5672 
  5673 #if !defined USABLE_SIGIO && !defined WINDOWSNT
  5674           /* If we're polling for input, don't get stuck in select for
  5675              more than 25 msec. */
  5676           struct timespec short_timeout = make_timespec (0, 25000000);
  5677           if ((read_kbd || !NILP (wait_for_cell))
  5678               && timespec_cmp (short_timeout, timeout) < 0)
  5679             timeout = short_timeout;
  5680 #endif
  5681 
  5682           /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c.  */
  5683 #if defined HAVE_GLIB && !defined HAVE_NS
  5684           nfds = xg_select (max_desc + 1,
  5685                             &Available, (check_write ? &Writeok : 0),
  5686                             NULL, &timeout, NULL);
  5687 #elif defined HAVE_NS
  5688           /* And NS builds call thread_select in ns_select. */
  5689           nfds = ns_select (max_desc + 1,
  5690                             &Available, (check_write ? &Writeok : 0),
  5691                             NULL, &timeout, NULL);
  5692 #else  /* !HAVE_GLIB */
  5693           nfds = thread_select (pselect, max_desc + 1,
  5694                                 &Available,
  5695                                 (check_write ? &Writeok : 0),
  5696                                 NULL, &timeout, NULL);
  5697 #endif  /* !HAVE_GLIB */
  5698 
  5699 #ifdef HAVE_GNUTLS
  5700           /* Merge tls_available into Available. */
  5701           if (tls_nfds > 0)
  5702             {
  5703               if (nfds == 0 || (nfds < 0 && errno == EINTR))
  5704                 {
  5705                   /* Fast path, just copy. */
  5706                   nfds = tls_nfds;
  5707                   Available = tls_available;
  5708                 }
  5709               else if (nfds > 0)
  5710                 /* Slow path, merge one by one.  Note: nfds does not need
  5711                    to be accurate, just positive is enough. */
  5712                 for (channel = 0; channel < FD_SETSIZE; ++channel)
  5713                   if (FD_ISSET(channel, &tls_available))
  5714                     FD_SET(channel, &Available);
  5715             }
  5716 #endif
  5717         }
  5718 
  5719       xerrno = errno;
  5720 
  5721       /* Make C-g and alarm signals set flags again.  */
  5722       clear_waiting_for_input ();
  5723 
  5724       /*  If we woke up due to SIGWINCH, actually change size now.  */
  5725       do_pending_window_change (0);
  5726 
  5727       if (nfds == 0)
  5728         {
  5729           /* Exit the main loop if we've passed the requested timeout,
  5730              or have read some bytes from our wait_proc (either directly
  5731              in this call or indirectly through timers / process filters),
  5732              or aren't skipping processes and got some output and
  5733              haven't lowered our timeout due to timers or SIGIO and
  5734              have waited a long amount of time due to repeated
  5735              timers.  */
  5736           struct timespec huge_timespec
  5737             = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_HZ);
  5738           struct timespec cmp_time = huge_timespec;
  5739           if (wait < TIMEOUT
  5740               || (wait_proc
  5741                   && wait_proc->nbytes_read != prev_wait_proc_nbytes_read))
  5742             break;
  5743           if (wait == TIMEOUT)
  5744             cmp_time = end_time;
  5745           if (!process_skipped && got_some_output > 0
  5746               && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
  5747             {
  5748               if (!timespec_valid_p (got_output_end_time))
  5749                 break;
  5750               if (timespec_cmp (got_output_end_time, cmp_time) < 0)
  5751                 cmp_time = got_output_end_time;
  5752             }
  5753           if (timespec_cmp (cmp_time, huge_timespec) < 0)
  5754             {
  5755               now = current_timespec ();
  5756               if (timespec_cmp (cmp_time, now) <= 0)
  5757                 break;
  5758             }
  5759         }
  5760 
  5761       if (nfds < 0)
  5762         {
  5763           if (xerrno == EINTR)
  5764             no_avail = 1;
  5765           else if (xerrno == EBADF)
  5766             emacs_abort ();
  5767           else
  5768             report_file_errno ("Failed select", Qnil, xerrno);
  5769         }
  5770 
  5771       /* Check for keyboard input.  */
  5772       /* If there is any, return immediately
  5773          to give it higher priority than subprocesses.  */
  5774 
  5775       if (read_kbd != 0)
  5776         {
  5777           bool leave = false;
  5778 
  5779           if (detect_input_pending_run_timers (do_display))
  5780             {
  5781               swallow_events (do_display);
  5782               if (detect_input_pending_run_timers (do_display))
  5783                 leave = true;
  5784             }
  5785 
  5786           if (leave)
  5787             break;
  5788         }
  5789 
  5790       /* If there is unread keyboard input, also return.  */
  5791       if (read_kbd != 0
  5792           && requeued_events_pending_p ())
  5793         break;
  5794 
  5795       /* If we are not checking for keyboard input now,
  5796          do process events (but don't run any timers).
  5797          This is so that X events will be processed.
  5798          Otherwise they may have to wait until polling takes place.
  5799          That would causes delays in pasting selections, for example.
  5800 
  5801          (We used to do this only if wait_for_cell.)  */
  5802       if (read_kbd == 0 && detect_input_pending ())
  5803         {
  5804           swallow_events (do_display);
  5805 #if 0  /* Exiting when read_kbd doesn't request that seems wrong, though.  */
  5806           if (detect_input_pending ())
  5807             break;
  5808 #endif
  5809         }
  5810 
  5811       /* Exit now if the cell we're waiting for became non-nil.  */
  5812       if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
  5813         break;
  5814 
  5815 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
  5816       /* If we think we have keyboard input waiting, but didn't get SIGIO,
  5817          go read it.  This can happen with X on BSD after logging out.
  5818          In that case, there really is no input and no SIGIO,
  5819          but select says there is input.  */
  5820 
  5821       if (read_kbd && interrupt_input
  5822           && keyboard_bit_set (&Available) && ! noninteractive)
  5823 #ifdef USABLE_SIGIO
  5824         handle_input_available_signal (SIGIO);
  5825 #else
  5826         handle_input_available_signal (SIGPOLL);
  5827 #endif
  5828 #endif
  5829 
  5830       /* If checking input just got us a size-change event from X,
  5831          obey it now if we should.  */
  5832       if (read_kbd || ! NILP (wait_for_cell))
  5833         do_pending_window_change (0);
  5834 
  5835       /* Check for data from a process.  */
  5836       if (no_avail || nfds == 0)
  5837         continue;
  5838 
  5839       for (channel = 0; channel <= max_desc; ++channel)
  5840         {
  5841           struct fd_callback_data *d = &fd_callback_info[channel];
  5842           if (d->func
  5843               && ((d->flags & FOR_READ
  5844                    && FD_ISSET (channel, &Available))
  5845                   || ((d->flags & FOR_WRITE)
  5846                       && FD_ISSET (channel, &Writeok))))
  5847             d->func (channel, d->data);
  5848         }
  5849 
  5850       /* Do round robin if `process-pritoritize-lower-fds' is nil. */
  5851       channel_start
  5852         = process_prioritize_lower_fds ? 0 : last_read_channel + 1;
  5853 
  5854       for (channel = channel_start, wrapped = false;
  5855            !wrapped || (channel < channel_start && channel <= max_desc);
  5856            channel++)
  5857         {
  5858           if (channel > max_desc)
  5859             {
  5860               wrapped = true;
  5861               channel = -1;
  5862               continue;
  5863             }
  5864 
  5865           if (FD_ISSET (channel, &Available)
  5866               && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
  5867                   == PROCESS_FD))
  5868             {
  5869               int nread;
  5870 
  5871               /* If waiting for this channel, arrange to return as
  5872                  soon as no more input to be processed.  No more
  5873                  waiting.  */
  5874               proc = chan_process[channel];
  5875               if (NILP (proc))
  5876                 continue;
  5877 
  5878               /* If this is a server stream socket, accept connection.  */
  5879               if (EQ (XPROCESS (proc)->status, Qlisten))
  5880                 {
  5881                   server_accept_connection (proc, channel);
  5882                   continue;
  5883                 }
  5884 
  5885               /* Read data from the process, starting with our
  5886                  buffered-ahead character if we have one.  */
  5887 
  5888               nread = read_process_output (proc, channel);
  5889               if ((!wait_proc || wait_proc == XPROCESS (proc))
  5890                   && got_some_output < nread)
  5891                 got_some_output = nread;
  5892               if (nread > 0)
  5893                 {
  5894                   /* Vacuum up any leftovers without waiting.  */
  5895                   if (wait_proc == XPROCESS (proc))
  5896                     wait = MINIMUM;
  5897                   /* Since read_process_output can run a filter,
  5898                      which can call accept-process-output,
  5899                      don't try to read from any other processes
  5900                      before doing the select again.  */
  5901                   FD_ZERO (&Available);
  5902                   last_read_channel = channel;
  5903 
  5904                   if (do_display)
  5905                     redisplay_preserve_echo_area (12);
  5906                 }
  5907               else if (nread == -1 && would_block (errno))
  5908                 ;
  5909 #ifdef HAVE_PTYS
  5910               /* On some OSs with ptys, when the process on one end of
  5911                  a pty exits, the other end gets an error reading with
  5912                  errno = EIO instead of getting an EOF (0 bytes read).
  5913                  Therefore, if we get an error reading and errno =
  5914                  EIO, just continue, because the child process has
  5915                  exited and should clean itself up soon (e.g. when we
  5916                  get a SIGCHLD).  */
  5917               else if (nread == -1 && errno == EIO)
  5918                 {
  5919                   struct Lisp_Process *p = XPROCESS (proc);
  5920 
  5921                   /* Clear the descriptor now, so we only raise the
  5922                      signal once.  */
  5923                   delete_read_fd (channel);
  5924 
  5925                   if (p->pid == -2)
  5926                     {
  5927                       /* If the EIO occurs on a pty, the SIGCHLD handler's
  5928                          waitpid call will not find the process object to
  5929                          delete.  Do it here.  */
  5930                       p->tick = ++process_tick;
  5931                       pset_status (p, Qfailed);
  5932                     }
  5933                 }
  5934 #endif /* HAVE_PTYS */
  5935               /* If we can detect process termination, don't consider the
  5936                  process gone just because its pipe is closed.  */
  5937               else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
  5938                        && !PIPECONN_P (proc))
  5939                 ;
  5940               else if (nread == 0 && PIPECONN_P (proc))
  5941                 {
  5942                   /* Preserve status of processes already terminated.  */
  5943                   XPROCESS (proc)->tick = ++process_tick;
  5944                   deactivate_process (proc);
  5945                   if (EQ (XPROCESS (proc)->status, Qrun))
  5946                     pset_status (XPROCESS (proc),
  5947                                  list2 (Qexit, make_fixnum (0)));
  5948                 }
  5949               else
  5950                 {
  5951                   /* Preserve status of processes already terminated.  */
  5952                   XPROCESS (proc)->tick = ++process_tick;
  5953                   deactivate_process (proc);
  5954                   if (XPROCESS (proc)->raw_status_new)
  5955                     update_status (XPROCESS (proc));
  5956                   if (EQ (XPROCESS (proc)->status, Qrun))
  5957                     pset_status (XPROCESS (proc),
  5958                                  list2 (Qexit, make_fixnum (256)));
  5959                 }
  5960             }
  5961           if (FD_ISSET (channel, &Writeok)
  5962               && (fd_callback_info[channel].flags
  5963                   & NON_BLOCKING_CONNECT_FD) != 0)
  5964             {
  5965               struct Lisp_Process *p;
  5966 
  5967               delete_write_fd (channel);
  5968 
  5969               proc = chan_process[channel];
  5970               if (NILP (proc))
  5971                 continue;
  5972 
  5973               p = XPROCESS (proc);
  5974 
  5975 #ifndef WINDOWSNT
  5976               {
  5977                 socklen_t xlen = sizeof (xerrno);
  5978                 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
  5979                   xerrno = errno;
  5980               }
  5981 #else
  5982               /* On MS-Windows, getsockopt clears the error for the
  5983                  entire process, which may not be the right thing; see
  5984                  w32.c.  Use getpeername instead.  */
  5985               {
  5986                 struct sockaddr pname;
  5987                 socklen_t pnamelen = sizeof (pname);
  5988 
  5989                 /* If connection failed, getpeername will fail.  */
  5990                 xerrno = 0;
  5991                 if (getpeername (channel, &pname, &pnamelen) < 0)
  5992                   {
  5993                     /* Obtain connect failure code through error slippage.  */
  5994                     char dummy;
  5995                     xerrno = errno;
  5996                     if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
  5997                       xerrno = errno;
  5998                   }
  5999               }
  6000 #endif
  6001               if (xerrno)
  6002                 {
  6003                   Lisp_Object addrinfos
  6004                     = connecting_status (p->status) ? XCDR (p->status) : Qnil;
  6005                   if (!NILP (addrinfos))
  6006                     XSETCDR (p->status, XCDR (addrinfos));
  6007                   else
  6008                     {
  6009                       p->tick = ++process_tick;
  6010                       pset_status (p, list2 (Qfailed, make_fixnum (xerrno)));
  6011                     }
  6012                   deactivate_process (proc);
  6013                   if (!NILP (addrinfos))
  6014                     connect_network_socket (proc, addrinfos, Qnil);
  6015                 }
  6016               else
  6017                 {
  6018 #ifdef HAVE_GNUTLS
  6019                   /* If we have an incompletely set up TLS connection,
  6020                      then defer the sentinel signaling until
  6021                      later. */
  6022                   if (NILP (p->gnutls_boot_parameters)
  6023                       && !p->gnutls_p)
  6024 #endif
  6025                     {
  6026                       pset_status (p, Qrun);
  6027                       /* Execute the sentinel here.  If we had relied on
  6028                          status_notify to do it later, it will read input
  6029                          from the process before calling the sentinel.  */
  6030                       exec_sentinel (proc, build_string ("open\n"));
  6031                     }
  6032 
  6033                   if (0 <= p->infd && !EQ (p->filter, Qt)
  6034                       && !EQ (p->command, Qt))
  6035                     add_process_read_fd (p->infd);
  6036                 }
  6037             }
  6038         }                       /* End for each file descriptor.  */
  6039     }                           /* End while exit conditions not met.  */
  6040 
  6041   unbind_to (count, Qnil);
  6042 
  6043   /* If calling from keyboard input, do not quit
  6044      since we want to return C-g as an input character.
  6045      Otherwise, do pending quit if requested.  */
  6046   if (read_kbd >= 0)
  6047     {
  6048       /* Prevent input_pending from remaining set if we quit.  */
  6049       clear_input_pending ();
  6050       maybe_quit ();
  6051     }
  6052 
  6053   /* Timers and/or process filters that we have run could have themselves called
  6054      `accept-process-output' (and by that indirectly this function), thus
  6055      possibly reading some (or all) output of wait_proc without us noticing it.
  6056      This could potentially lead to an endless wait (dealt with earlier in the
  6057      function) and/or a wrong return value (dealt with here).  */
  6058   if (wait_proc && wait_proc->nbytes_read != prev_wait_proc_nbytes_read)
  6059     got_some_output = min (INT_MAX, (wait_proc->nbytes_read
  6060                                      - prev_wait_proc_nbytes_read));
  6061 
  6062   return got_some_output;
  6063 }
  6064 
  6065 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS.  */
  6066 
  6067 static Lisp_Object
  6068 read_process_output_call (Lisp_Object fun_and_args)
  6069 {
  6070   return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
  6071 }
  6072 
  6073 static Lisp_Object
  6074 read_process_output_error_handler (Lisp_Object error_val)
  6075 {
  6076   cmd_error_internal (error_val, "error in process filter: ");
  6077   Vinhibit_quit = Qt;
  6078   update_echo_area ();
  6079   if (process_error_pause_time > 0)
  6080     Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
  6081   return Qt;
  6082 }
  6083 
  6084 static void
  6085 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
  6086                                     ssize_t nbytes,
  6087                                     struct coding_system *coding);
  6088 
  6089 /* Read pending output from the process channel,
  6090    starting with our buffered-ahead character if we have one.
  6091    Yield number of decoded characters read,
  6092    or -1 (setting errno) if there is a read error.
  6093 
  6094    This function reads at most read_process_output_max bytes.
  6095    If you want to read all available subprocess output,
  6096    you must call it repeatedly until it returns zero.
  6097 
  6098    The characters read are decoded according to PROC's coding-system
  6099    for decoding.  */
  6100 
  6101 static int
  6102 read_process_output (Lisp_Object proc, int channel)
  6103 {
  6104   ssize_t nbytes;
  6105   struct Lisp_Process *p = XPROCESS (proc);
  6106   eassert (0 <= channel && channel < FD_SETSIZE);
  6107   struct coding_system *coding = proc_decode_coding_system[channel];
  6108   int carryover = p->decoding_carryover;
  6109   ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
  6110   specpdl_ref count = SPECPDL_INDEX ();
  6111   Lisp_Object odeactivate;
  6112   char *chars;
  6113 
  6114   USE_SAFE_ALLOCA;
  6115   chars = SAFE_ALLOCA (sizeof coding->carryover + readmax);
  6116 
  6117   if (carryover)
  6118     /* See the comment above.  */
  6119     memcpy (chars, SDATA (p->decoding_buf), carryover);
  6120 
  6121 #ifdef DATAGRAM_SOCKETS
  6122   /* We have a working select, so proc_buffered_char is always -1.  */
  6123   if (DATAGRAM_CHAN_P (channel))
  6124     {
  6125       socklen_t len = datagram_address[channel].len;
  6126       do
  6127         nbytes = recvfrom (channel, chars + carryover, readmax,
  6128                            0, datagram_address[channel].sa, &len);
  6129       while (nbytes < 0 && errno == EINTR);
  6130     }
  6131   else
  6132 #endif
  6133     {
  6134       bool buffered = proc_buffered_char[channel] >= 0;
  6135       if (buffered)
  6136         {
  6137           chars[carryover] = proc_buffered_char[channel];
  6138           proc_buffered_char[channel] = -1;
  6139         }
  6140 #ifdef HAVE_GNUTLS
  6141       if (p->gnutls_p && p->gnutls_state)
  6142         nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
  6143                                     readmax - buffered);
  6144       else
  6145 #endif
  6146         nbytes = emacs_read (channel, chars + carryover + buffered,
  6147                              readmax - buffered);
  6148       if (nbytes > 0 && p->adaptive_read_buffering)
  6149         {
  6150           int delay = p->read_output_delay;
  6151           if (nbytes < 256)
  6152             {
  6153               if (delay < READ_OUTPUT_DELAY_MAX_MAX)
  6154                 {
  6155                   if (delay == 0)
  6156                     process_output_delay_count++;
  6157                   delay += READ_OUTPUT_DELAY_INCREMENT * 2;
  6158                 }
  6159             }
  6160           else if (delay > 0 && nbytes == readmax - buffered)
  6161             {
  6162               delay -= READ_OUTPUT_DELAY_INCREMENT;
  6163               if (delay == 0)
  6164                 process_output_delay_count--;
  6165             }
  6166           p->read_output_delay = delay;
  6167           if (delay)
  6168             {
  6169               p->read_output_skip = 1;
  6170               process_output_skip = 1;
  6171             }
  6172         }
  6173       nbytes += buffered;
  6174       nbytes += buffered && nbytes <= 0;
  6175     }
  6176 
  6177   p->decoding_carryover = 0;
  6178 
  6179   if (nbytes <= 0)
  6180     {
  6181       if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
  6182         {
  6183           SAFE_FREE_UNBIND_TO (count, Qnil);
  6184           return nbytes;
  6185         }
  6186       coding->mode |= CODING_MODE_LAST_BLOCK;
  6187     }
  6188 
  6189   /* At this point, NBYTES holds number of bytes just received
  6190      (including the one in proc_buffered_char[channel]).  */
  6191 
  6192   /* Ignore carryover, it's been added by a previous iteration already.  */
  6193   p->nbytes_read += nbytes;
  6194 
  6195   /* Now set NBYTES how many bytes we must decode.  */
  6196   nbytes += carryover;
  6197 
  6198   odeactivate = Vdeactivate_mark;
  6199   /* There's no good reason to let process filters change the current
  6200      buffer, and many callers of accept-process-output, sit-for, and
  6201      friends don't expect current-buffer to be changed from under them.  */
  6202   record_unwind_current_buffer ();
  6203 
  6204   read_and_dispose_of_process_output (p, chars, nbytes, coding);
  6205 
  6206   /* Handling the process output should not deactivate the mark.  */
  6207   Vdeactivate_mark = odeactivate;
  6208 
  6209   SAFE_FREE_UNBIND_TO (count, Qnil);
  6210   return nbytes;
  6211 }
  6212 
  6213 static void
  6214 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
  6215                                     ssize_t nbytes,
  6216                                     struct coding_system *coding)
  6217 {
  6218   Lisp_Object outstream = p->filter;
  6219   Lisp_Object text;
  6220   bool outer_running_asynch_code = running_asynch_code;
  6221   int waiting = waiting_for_user_input_p;
  6222 
  6223 #if 0
  6224   Lisp_Object obuffer, okeymap;
  6225   XSETBUFFER (obuffer, current_buffer);
  6226   okeymap = BVAR (current_buffer, keymap);
  6227 #endif
  6228 
  6229   /* We inhibit quit here instead of just catching it so that
  6230      hitting ^G when a filter happens to be running won't screw
  6231      it up.  */
  6232   specbind (Qinhibit_quit, Qt);
  6233   specbind (Qlast_nonmenu_event, Qt);
  6234 
  6235   /* In case we get recursively called,
  6236      and we already saved the match data nonrecursively,
  6237      save the same match data in safely recursive fashion.  */
  6238   if (outer_running_asynch_code)
  6239     {
  6240       Lisp_Object tem;
  6241       /* Don't clobber the CURRENT match data, either!  */
  6242       tem = Fmatch_data (Qnil, Qnil, Qnil);
  6243       restore_search_regs ();
  6244       record_unwind_save_match_data ();
  6245       Fset_match_data (tem, Qt);
  6246     }
  6247 
  6248   /* For speed, if a search happens within this code,
  6249      save the match data in a special nonrecursive fashion.  */
  6250   running_asynch_code = 1;
  6251 
  6252   decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
  6253   text = coding->dst_object;
  6254   Vlast_coding_system_used = CODING_ID_NAME (coding->id);
  6255   /* A new coding system might be found.  */
  6256   if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
  6257     {
  6258       pset_decode_coding_system (p, Vlast_coding_system_used);
  6259 
  6260       /* Don't call setup_coding_system for
  6261          proc_decode_coding_system[channel] here.  It is done in
  6262          detect_coding called via decode_coding above.  */
  6263 
  6264       /* If a coding system for encoding is not yet decided, we set
  6265          it as the same as coding-system for decoding.
  6266 
  6267          But, before doing that we must check if
  6268          proc_encode_coding_system[p->outfd] surely points to a
  6269          valid memory because p->outfd will be changed once EOF is
  6270          sent to the process.  */
  6271       eassert (p->outfd < FD_SETSIZE);
  6272       if (NILP (p->encode_coding_system) && p->outfd >= 0
  6273           && proc_encode_coding_system[p->outfd])
  6274         {
  6275           pset_encode_coding_system
  6276             (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
  6277           setup_coding_system (p->encode_coding_system,
  6278                                proc_encode_coding_system[p->outfd]);
  6279         }
  6280     }
  6281 
  6282   if (coding->carryover_bytes > 0)
  6283     {
  6284       if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
  6285         pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
  6286       memcpy (SDATA (p->decoding_buf), coding->carryover,
  6287               coding->carryover_bytes);
  6288       p->decoding_carryover = coding->carryover_bytes;
  6289     }
  6290   if (SBYTES (text) > 0)
  6291     /* FIXME: It's wrong to wrap or not based on debug-on-error, and
  6292        sometimes it's simply wrong to wrap (e.g. when called from
  6293        accept-process-output).  */
  6294     internal_condition_case_1 (read_process_output_call,
  6295                                list3 (outstream, make_lisp_proc (p), text),
  6296                                !NILP (Vdebug_on_error) ? Qnil : Qerror,
  6297                                read_process_output_error_handler);
  6298 
  6299   /* If we saved the match data nonrecursively, restore it now.  */
  6300   restore_search_regs ();
  6301   running_asynch_code = outer_running_asynch_code;
  6302 
  6303   /* Restore waiting_for_user_input_p as it was
  6304      when we were called, in case the filter clobbered it.  */
  6305   waiting_for_user_input_p = waiting;
  6306 }
  6307 
  6308 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
  6309        Sinternal_default_process_filter, 2, 2, 0,
  6310        doc: /* Function used as default process filter.
  6311 This inserts the process's output into its buffer, if there is one.
  6312 Otherwise it discards the output.  */)
  6313   (Lisp_Object proc, Lisp_Object text)
  6314 {
  6315   struct Lisp_Process *p;
  6316   ptrdiff_t opoint;
  6317 
  6318   CHECK_PROCESS (proc);
  6319   p = XPROCESS (proc);
  6320   CHECK_STRING (text);
  6321 
  6322   if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
  6323     {
  6324       Lisp_Object old_read_only;
  6325       ptrdiff_t old_begv, old_zv;
  6326       ptrdiff_t before, before_byte;
  6327       ptrdiff_t opoint_byte;
  6328       struct buffer *b;
  6329 
  6330       Fset_buffer (p->buffer);
  6331       opoint = PT;
  6332       opoint_byte = PT_BYTE;
  6333       old_read_only = BVAR (current_buffer, read_only);
  6334       old_begv = BEGV;
  6335       old_zv = ZV;
  6336 
  6337       bset_read_only (current_buffer, Qnil);
  6338 
  6339       /* Insert new output into buffer at the current end-of-output
  6340          marker, thus preserving logical ordering of input and output.  */
  6341       if (XMARKER (p->mark)->buffer)
  6342         set_point_from_marker (p->mark);
  6343       else
  6344         SET_PT_BOTH (ZV, ZV_BYTE);
  6345       before = PT;
  6346       before_byte = PT_BYTE;
  6347 
  6348       /* If the output marker is outside of the visible region, save
  6349          the restriction and widen.  */
  6350       if (! (BEGV <= PT && PT <= ZV))
  6351         Fwiden ();
  6352 
  6353       /* Adjust the multibyteness of TEXT to that of the buffer.  */
  6354       if (NILP (BVAR (current_buffer, enable_multibyte_characters))
  6355           != ! STRING_MULTIBYTE (text))
  6356         text = (STRING_MULTIBYTE (text)
  6357                 ? Fstring_as_unibyte (text)
  6358                 : Fstring_to_multibyte (text));
  6359       /* Insert before markers in case we are inserting where
  6360          the buffer's mark is, and the user's next command is Meta-y.  */
  6361       insert_from_string_before_markers (text, 0, 0,
  6362                                          SCHARS (text), SBYTES (text), 0);
  6363 
  6364       /* Make sure the process marker's position is valid when the
  6365          process buffer is changed in the signal_after_change above.
  6366          W3 is known to do that.  */
  6367       if (BUFFERP (p->buffer)
  6368           && (b = XBUFFER (p->buffer), b != current_buffer))
  6369         set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
  6370       else
  6371         set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
  6372 
  6373       update_mode_lines = 23;
  6374 
  6375       /* Make sure opoint and the old restrictions
  6376          float ahead of any new text just as point would.  */
  6377       if (opoint >= before)
  6378         {
  6379           opoint += PT - before;
  6380           opoint_byte += PT_BYTE - before_byte;
  6381         }
  6382       if (old_begv > before)
  6383         old_begv += PT - before;
  6384       if (old_zv >= before)
  6385         old_zv += PT - before;
  6386 
  6387       /* If the restriction isn't what it should be, set it.  */
  6388       if (old_begv != BEGV || old_zv != ZV)
  6389         Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv));
  6390 
  6391       bset_read_only (current_buffer, old_read_only);
  6392       SET_PT_BOTH (opoint, opoint_byte);
  6393     }
  6394   return Qnil;
  6395 }
  6396 
  6397 /* Sending data to subprocess.  */
  6398 
  6399 /* In send_process, when a write fails temporarily,
  6400    wait_reading_process_output is called.  It may execute user code,
  6401    e.g. timers, that attempts to write new data to the same process.
  6402    We must ensure that data is sent in the right order, and not
  6403    interspersed half-completed with other writes (Bug#10815).  This is
  6404    handled by the write_queue element of struct process.  It is a list
  6405    with each entry having the form
  6406 
  6407    (string . (offset . length))
  6408 
  6409    where STRING is a lisp string, OFFSET is the offset into the
  6410    string's byte sequence from which we should begin to send, and
  6411    LENGTH is the number of bytes left to send.  */
  6412 
  6413 /* Create a new entry in write_queue.
  6414    INPUT_OBJ should be a buffer, string Qt, or Qnil.
  6415    BUF is a pointer to the string sequence of the input_obj or a C
  6416    string in case of Qt or Qnil.  */
  6417 
  6418 static void
  6419 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
  6420                   const char *buf, ptrdiff_t len, bool front)
  6421 {
  6422   ptrdiff_t offset;
  6423   Lisp_Object entry, obj;
  6424 
  6425   if (STRINGP (input_obj))
  6426     {
  6427       offset = buf - SSDATA (input_obj);
  6428       obj = input_obj;
  6429     }
  6430   else
  6431     {
  6432       offset = 0;
  6433       obj = make_unibyte_string (buf, len);
  6434     }
  6435 
  6436   entry = Fcons (obj, Fcons (make_fixnum (offset), make_fixnum (len)));
  6437 
  6438   if (front)
  6439     pset_write_queue (p, Fcons (entry, p->write_queue));
  6440   else
  6441     pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
  6442 }
  6443 
  6444 /* Remove the first element in the write_queue of process P, put its
  6445    contents in OBJ, BUF and LEN, and return true.  If the
  6446    write_queue is empty, return false.  */
  6447 
  6448 static bool
  6449 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
  6450                  const char **buf, ptrdiff_t *len)
  6451 {
  6452   Lisp_Object entry, offset_length;
  6453   ptrdiff_t offset;
  6454 
  6455   if (NILP (p->write_queue))
  6456     return 0;
  6457 
  6458   entry = XCAR (p->write_queue);
  6459   pset_write_queue (p, XCDR (p->write_queue));
  6460 
  6461   *obj = XCAR (entry);
  6462   offset_length = XCDR (entry);
  6463 
  6464   *len = XFIXNUM (XCDR (offset_length));
  6465   offset = XFIXNUM (XCAR (offset_length));
  6466   *buf = SSDATA (*obj) + offset;
  6467 
  6468   return 1;
  6469 }
  6470 
  6471 /* Send some data to process PROC.
  6472    BUF is the beginning of the data; LEN is the number of characters.
  6473    OBJECT is the Lisp object that the data comes from.  If OBJECT is
  6474    nil or t, it means that the data comes from C string.
  6475 
  6476    If OBJECT is not nil, the data is encoded by PROC's coding-system
  6477    for encoding before it is sent.
  6478 
  6479    This function can evaluate Lisp code and can garbage collect.  */
  6480 
  6481 static void
  6482 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
  6483               Lisp_Object object)
  6484 {
  6485   struct Lisp_Process *p = XPROCESS (proc);
  6486   ssize_t rv;
  6487   struct coding_system *coding;
  6488 
  6489   if (NETCONN_P (proc))
  6490     {
  6491       wait_while_connecting (proc);
  6492       wait_for_tls_negotiation (proc);
  6493     }
  6494 
  6495   if (p->raw_status_new)
  6496     update_status (p);
  6497   if (! EQ (p->status, Qrun))
  6498     error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p)));
  6499   if (p->outfd < 0)
  6500     error ("Output file descriptor of %s is closed", SDATA (p->name));
  6501 
  6502   eassert (p->outfd < FD_SETSIZE);
  6503   coding = proc_encode_coding_system[p->outfd];
  6504   Vlast_coding_system_used = CODING_ID_NAME (coding->id);
  6505 
  6506   if ((STRINGP (object) && STRING_MULTIBYTE (object))
  6507       || (BUFFERP (object)
  6508           && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
  6509       || EQ (object, Qt))
  6510     {
  6511       pset_encode_coding_system
  6512         (p, complement_process_encoding_system (p->encode_coding_system));
  6513       if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
  6514         {
  6515           /* The coding system for encoding was changed to raw-text
  6516              because we sent a unibyte text previously.  Now we are
  6517              sending a multibyte text, thus we must encode it by the
  6518              original coding system specified for the current process.
  6519 
  6520              Another reason we come here is that the coding system
  6521              was just complemented and a new one was returned by
  6522              complement_process_encoding_system.  */
  6523           setup_coding_system (p->encode_coding_system, coding);
  6524           Vlast_coding_system_used = p->encode_coding_system;
  6525         }
  6526       coding->src_multibyte = 1;
  6527     }
  6528   else
  6529     {
  6530       coding->src_multibyte = 0;
  6531       /* For sending a unibyte text, character code conversion should
  6532          not take place but EOL conversion should.  So, setup raw-text
  6533          or one of the subsidiary if we have not yet done it.  */
  6534       if (CODING_REQUIRE_ENCODING (coding))
  6535         {
  6536           if (CODING_REQUIRE_FLUSHING (coding))
  6537             {
  6538               /* But, before changing the coding, we must flush out data.  */
  6539               coding->mode |= CODING_MODE_LAST_BLOCK;
  6540               send_process (proc, "", 0, Qt);
  6541               coding->mode &= CODING_MODE_LAST_BLOCK;
  6542             }
  6543           setup_coding_system (raw_text_coding_system
  6544                                (Vlast_coding_system_used),
  6545                                coding);
  6546           coding->src_multibyte = 0;
  6547         }
  6548     }
  6549   coding->dst_multibyte = 0;
  6550 
  6551   if (CODING_REQUIRE_ENCODING (coding))
  6552     {
  6553       coding->dst_object = Qt;
  6554       if (BUFFERP (object))
  6555         {
  6556           ptrdiff_t from_byte, from, to;
  6557           ptrdiff_t save_pt, save_pt_byte;
  6558           struct buffer *cur = current_buffer;
  6559 
  6560           set_buffer_internal (XBUFFER (object));
  6561           save_pt = PT, save_pt_byte = PT_BYTE;
  6562 
  6563           from_byte = PTR_BYTE_POS ((unsigned char *) buf);
  6564           from = BYTE_TO_CHAR (from_byte);
  6565           to = BYTE_TO_CHAR (from_byte + len);
  6566           TEMP_SET_PT_BOTH (from, from_byte);
  6567           encode_coding_object (coding, object, from, from_byte,
  6568                                 to, from_byte + len, Qt);
  6569           TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
  6570           set_buffer_internal (cur);
  6571         }
  6572       else if (STRINGP (object))
  6573         {
  6574           encode_coding_object (coding, object, 0, 0, SCHARS (object),
  6575                                 SBYTES (object), Qt);
  6576         }
  6577       else
  6578         {
  6579           coding->dst_object = make_unibyte_string (buf, len);
  6580           coding->produced = len;
  6581         }
  6582 
  6583       len = coding->produced;
  6584       object = coding->dst_object;
  6585       buf = SSDATA (object);
  6586     }
  6587 
  6588   /* If there is already data in the write_queue, put the new data
  6589      in the back of queue.  Otherwise, ignore it.  */
  6590   if (!NILP (p->write_queue))
  6591     write_queue_push (p, object, buf, len, 0);
  6592 
  6593   do   /* while !NILP (p->write_queue) */
  6594     {
  6595       ptrdiff_t cur_len = -1;
  6596       const char *cur_buf;
  6597       Lisp_Object cur_object;
  6598 
  6599       /* If write_queue is empty, ignore it.  */
  6600       if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
  6601         {
  6602           cur_len = len;
  6603           cur_buf = buf;
  6604           cur_object = object;
  6605         }
  6606 
  6607       while (cur_len > 0)
  6608         {
  6609           /* Send this batch, using one or more write calls.  */
  6610           ptrdiff_t written = 0;
  6611           int outfd = p->outfd;
  6612           if (outfd < 0)
  6613             error ("Output file descriptor of %s is closed",
  6614                    SDATA (p->name));
  6615           eassert (0 <= outfd && outfd < FD_SETSIZE);
  6616 #ifdef DATAGRAM_SOCKETS
  6617           if (DATAGRAM_CHAN_P (outfd))
  6618             {
  6619               while (true)
  6620                 {
  6621                   rv = sendto (outfd, cur_buf, cur_len, 0,
  6622                                datagram_address[outfd].sa,
  6623                                datagram_address[outfd].len);
  6624                   if (! (rv < 0 && errno == EINTR))
  6625                     break;
  6626                   if (pending_signals)
  6627                     process_pending_signals ();
  6628                 }
  6629 
  6630               if (rv >= 0)
  6631                 written = rv;
  6632               else if (errno == EMSGSIZE)
  6633                 report_file_error ("Sending datagram", proc);
  6634             }
  6635           else
  6636 #endif
  6637             {
  6638 #ifdef HAVE_GNUTLS
  6639               if (p->gnutls_p && p->gnutls_state)
  6640                 written = emacs_gnutls_write (p, cur_buf, cur_len);
  6641               else
  6642 #endif
  6643                 written = emacs_write_sig (outfd, cur_buf, cur_len);
  6644               rv = (written ? 0 : -1);
  6645               if (p->read_output_delay > 0
  6646                   && p->adaptive_read_buffering == 1)
  6647                 {
  6648                   p->read_output_delay = 0;
  6649                   process_output_delay_count--;
  6650                   p->read_output_skip = 0;
  6651                 }
  6652             }
  6653 
  6654           if (rv < 0)
  6655             {
  6656               if (would_block (errno))
  6657                 /* Buffer is full.  Wait, accepting input;
  6658                    that may allow the program
  6659                    to finish doing output and read more.  */
  6660                 {
  6661 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
  6662                   /* A gross hack to work around a bug in FreeBSD.
  6663                      In the following sequence, read(2) returns
  6664                      bogus data:
  6665 
  6666                      write(2)    1022 bytes
  6667                      write(2)   954 bytes, get EAGAIN
  6668                      read(2)   1024 bytes in process_read_output
  6669                      read(2)     11 bytes in process_read_output
  6670 
  6671                      That is, read(2) returns more bytes than have
  6672                      ever been written successfully.  The 1033 bytes
  6673                      read are the 1022 bytes written successfully
  6674                      after processing (for example with CRs added if
  6675                      the terminal is set up that way which it is
  6676                      here).  The same bytes will be seen again in a
  6677                      later read(2), without the CRs.  */
  6678 
  6679                   if (errno == EAGAIN)
  6680                     {
  6681                       int flags = FWRITE;
  6682                       ioctl (p->outfd, TIOCFLUSH, &flags);
  6683                     }
  6684 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
  6685 
  6686                   /* Put what we should have written in write_queue.  */
  6687                   write_queue_push (p, cur_object, cur_buf, cur_len, 1);
  6688                   wait_reading_process_output (0, 20 * 1000 * 1000,
  6689                                                0, 0, Qnil, NULL, 0);
  6690                   /* Reread queue, to see what is left.  */
  6691                   break;
  6692                 }
  6693               else if (errno == EPIPE)
  6694                 {
  6695                   p->raw_status_new = 0;
  6696                   pset_status (p, list2 (Qexit, make_fixnum (256)));
  6697                   p->tick = ++process_tick;
  6698                   deactivate_process (proc);
  6699                   error ("process %s no longer connected to pipe; closed it",
  6700                          SDATA (p->name));
  6701                 }
  6702               else
  6703                 /* This is a real error.  */
  6704                 report_file_error ("Writing to process", proc);
  6705             }
  6706           cur_buf += written;
  6707           cur_len -= written;
  6708         }
  6709     }
  6710   while (!NILP (p->write_queue));
  6711 }
  6712 
  6713 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
  6714        3, 3, 0,
  6715        doc: /* Send current contents of region as input to PROCESS.
  6716 PROCESS may be a process, a buffer, the name of a process or buffer, or
  6717 nil, indicating the current buffer's process.
  6718 Called from program, takes three arguments, PROCESS, START and END.
  6719 If the region is larger than the input buffer of the process (the
  6720 length of which depends on the process connection type and the
  6721 operating system), it is sent in several bunches.  This may happen
  6722 even for shorter regions.  Output from processes can arrive in between
  6723 bunches.
  6724 
  6725 If PROCESS is a non-blocking network process that hasn't been fully
  6726 set up yet, this function will block until socket setup has completed.  */)
  6727   (Lisp_Object process, Lisp_Object start, Lisp_Object end)
  6728 {
  6729   Lisp_Object proc = get_process (process);
  6730   ptrdiff_t start_byte, end_byte;
  6731 
  6732   validate_region (&start, &end);
  6733 
  6734   start_byte = CHAR_TO_BYTE (XFIXNUM (start));
  6735   end_byte = CHAR_TO_BYTE (XFIXNUM (end));
  6736 
  6737   if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
  6738     move_gap_both (XFIXNUM (start), start_byte);
  6739 
  6740   if (NETCONN_P (proc))
  6741     wait_while_connecting (proc);
  6742 
  6743   send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
  6744                 end_byte - start_byte, Fcurrent_buffer ());
  6745 
  6746   return Qnil;
  6747 }
  6748 
  6749 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
  6750        2, 2, 0,
  6751        doc: /* Send PROCESS the contents of STRING as input.
  6752 PROCESS may be a process, a buffer, the name of a process or buffer, or
  6753 nil, indicating the current buffer's process.
  6754 If STRING is larger than the input buffer of the process (the length
  6755 of which depends on the process connection type and the operating
  6756 system), it is sent in several bunches.  This may happen even for
  6757 shorter strings.  Output from processes can arrive in between bunches.
  6758 
  6759 If PROCESS is a non-blocking network process that hasn't been fully
  6760 set up yet, this function will block until socket setup has completed.  */)
  6761   (Lisp_Object process, Lisp_Object string)
  6762 {
  6763   CHECK_STRING (string);
  6764   Lisp_Object proc = get_process (process);
  6765   send_process (proc, SSDATA (string),
  6766                 SBYTES (string), string);
  6767   return Qnil;
  6768 }
  6769 
  6770 /* Return the foreground process group for the tty/pty that
  6771    the process P uses.  */
  6772 static pid_t
  6773 emacs_get_tty_pgrp (struct Lisp_Process *p)
  6774 {
  6775   pid_t gid = -1;
  6776 
  6777 #ifdef TIOCGPGRP
  6778   if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
  6779     {
  6780       int fd;
  6781       /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
  6782          master side.  Try the slave side.  */
  6783       fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
  6784 
  6785       if (fd != -1)
  6786         {
  6787           ioctl (fd, TIOCGPGRP, &gid);
  6788           emacs_close (fd);
  6789         }
  6790     }
  6791 #endif /* defined (TIOCGPGRP ) */
  6792 
  6793   return gid;
  6794 }
  6795 
  6796 DEFUN ("process-running-child-p", Fprocess_running_child_p,
  6797        Sprocess_running_child_p, 0, 1, 0,
  6798        doc: /* Return non-nil if PROCESS has given control of its terminal to a child.
  6799 If the operating system does not make it possible to find out, return t.
  6800 If it's possible to find out, return the numeric ID of the foreground
  6801 process group if PROCESS did give control of its terminal to a
  6802 child process, and return nil if it didn't.
  6803 
  6804 PROCESS must be a real subprocess, not a connection.  */)
  6805   (Lisp_Object process)
  6806 {
  6807   /* Initialize in case ioctl doesn't exist or gives an error,
  6808      in a way that will cause returning t.  */
  6809   Lisp_Object proc = get_process (process);
  6810   struct Lisp_Process *p = XPROCESS (proc);
  6811 
  6812   if (!EQ (p->type, Qreal))
  6813     error ("Process %s is not a subprocess",
  6814            SDATA (p->name));
  6815   if (p->infd < 0)
  6816     error ("Process %s is not active",
  6817            SDATA (p->name));
  6818 
  6819   pid_t gid = emacs_get_tty_pgrp (p);
  6820 
  6821   if (gid == p->pid)
  6822     return Qnil;
  6823   if (gid != -1)
  6824     return make_fixnum (gid);
  6825   return Qt;
  6826 }
  6827 
  6828 /* Send a signal number SIGNO to PROCESS.
  6829    If CURRENT_GROUP is t, that means send to the process group
  6830    that currently owns the terminal being used to communicate with PROCESS.
  6831    This is used for various commands in shell mode.
  6832    If CURRENT_GROUP is lambda, that means send to the process group
  6833    that currently owns the terminal, but only if it is NOT the shell itself.
  6834 
  6835    If NOMSG is false, insert signal-announcements into process's buffers
  6836    right away.
  6837 
  6838    If we can, we try to signal PROCESS by sending control characters
  6839    down the pty.  This allows us to signal inferiors who have changed
  6840    their uid, for which kill would return an EPERM error.  */
  6841 
  6842 static void
  6843 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
  6844                      bool nomsg)
  6845 {
  6846   Lisp_Object proc;
  6847   struct Lisp_Process *p;
  6848   pid_t gid;
  6849   bool no_pgrp = 0;
  6850 
  6851   proc = get_process (process);
  6852   p = XPROCESS (proc);
  6853 
  6854   if (!EQ (p->type, Qreal))
  6855     error ("Process %s is not a subprocess",
  6856            SDATA (p->name));
  6857   if (p->infd < 0)
  6858     error ("Process %s is not active",
  6859            SDATA (p->name));
  6860 
  6861   if (! p->pty_in)
  6862     current_group = Qnil;
  6863 
  6864   /* If we are using pgrps, get a pgrp number and make it negative.  */
  6865   if (NILP (current_group))
  6866     /* Send the signal to the shell's process group.  */
  6867     gid = p->pid;
  6868   else
  6869     {
  6870 #ifdef SIGNALS_VIA_CHARACTERS
  6871       /* If possible, send signals to the entire pgrp
  6872          by sending an input character to it.  */
  6873 
  6874       struct termios t;
  6875       cc_t *sig_char = NULL;
  6876 
  6877       tcgetattr (p->infd, &t);
  6878 
  6879       switch (signo)
  6880         {
  6881         case SIGINT:
  6882           sig_char = &t.c_cc[VINTR];
  6883           break;
  6884 
  6885         case SIGQUIT:
  6886           sig_char = &t.c_cc[VQUIT];
  6887           break;
  6888 
  6889         case SIGTSTP:
  6890 #ifdef VSWTCH
  6891           sig_char = &t.c_cc[VSWTCH];
  6892 #else
  6893           sig_char = &t.c_cc[VSUSP];
  6894 #endif
  6895           break;
  6896         }
  6897 
  6898       if (sig_char && *sig_char != CDISABLE)
  6899         {
  6900           send_process (proc, (char *) sig_char, 1, Qnil);
  6901           return;
  6902         }
  6903       /* If we can't send the signal with a character,
  6904          fall through and send it another way.  */
  6905 
  6906       /* The code above may fall through if it can't
  6907          handle the signal.  */
  6908 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
  6909 
  6910 #ifdef TIOCGPGRP
  6911       /* Get the current pgrp using the tty itself, if we have that.
  6912          Otherwise, use the pty to get the pgrp.
  6913          On pfa systems, saka@pfu.fujitsu.co.JP writes:
  6914          "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
  6915          But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
  6916          His patch indicates that if TIOCGPGRP returns an error, then
  6917          we should just assume that p->pid is also the process group id.  */
  6918 
  6919       gid = emacs_get_tty_pgrp (p);
  6920 
  6921       if (gid == -1)
  6922         /* If we can't get the information, assume
  6923            the shell owns the tty.  */
  6924         gid = p->pid;
  6925 
  6926       /* It is not clear whether anything really can set GID to -1.
  6927          Perhaps on some system one of those ioctls can or could do so.
  6928          Or perhaps this is vestigial.  */
  6929       if (gid == -1)
  6930         no_pgrp = 1;
  6931 #else  /* ! defined (TIOCGPGRP) */
  6932       /* Can't select pgrps on this system, so we know that
  6933          the child itself heads the pgrp.  */
  6934       gid = p->pid;
  6935 #endif /* ! defined (TIOCGPGRP) */
  6936 
  6937       /* If current_group is lambda, and the shell owns the terminal,
  6938          don't send any signal.  */
  6939       if (EQ (current_group, Qlambda) && gid == p->pid)
  6940         return;
  6941     }
  6942 
  6943 #ifdef SIGCONT
  6944   if (signo == SIGCONT)
  6945     {
  6946       p->raw_status_new = 0;
  6947       pset_status (p, Qrun);
  6948       p->tick = ++process_tick;
  6949       if (!nomsg)
  6950         {
  6951           status_notify (NULL, NULL);
  6952           redisplay_preserve_echo_area (13);
  6953         }
  6954     }
  6955 #endif
  6956 
  6957 #ifdef TIOCSIGSEND
  6958   /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
  6959      We don't know whether the bug is fixed in later HP-UX versions.  */
  6960   if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
  6961     return;
  6962 #endif
  6963 
  6964   /* If we don't have process groups, send the signal to the immediate
  6965      subprocess.  That isn't really right, but it's better than any
  6966      obvious alternative.  */
  6967   pid_t pid = no_pgrp ? gid : - gid;
  6968 
  6969   /* Do not kill an already-reaped process, as that could kill an
  6970      innocent bystander that happens to have the same process ID.  */
  6971   sigset_t oldset;
  6972   block_child_signal (&oldset);
  6973   if (p->alive)
  6974     kill (pid, signo);
  6975   unblock_child_signal (&oldset);
  6976 }
  6977 
  6978 DEFUN ("internal-default-interrupt-process",
  6979        Finternal_default_interrupt_process,
  6980        Sinternal_default_interrupt_process, 0, 2, 0,
  6981        doc: /* Default function to interrupt process PROCESS.
  6982 It shall be the last element in list `interrupt-process-functions'.
  6983 See function `interrupt-process' for more details on usage.  */)
  6984   (Lisp_Object process, Lisp_Object current_group)
  6985 {
  6986   process_send_signal (process, SIGINT, current_group, 0);
  6987   return process;
  6988 }
  6989 
  6990 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
  6991        doc: /* Interrupt process PROCESS.
  6992 PROCESS may be a process, a buffer, or the name of a process or buffer.
  6993 No arg or nil means current buffer's process.
  6994 Second arg CURRENT-GROUP non-nil means send signal to
  6995 the current process-group of the process's controlling terminal
  6996 rather than to the process's own process group.
  6997 If the process is a shell, this means interrupt current subjob
  6998 rather than the shell.
  6999 
  7000 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
  7001 don't send the signal.
  7002 
  7003 This function calls the functions of `interrupt-process-functions' in
  7004 the order of the list, until one of them returns non-nil.  */)
  7005   (Lisp_Object process, Lisp_Object current_group)
  7006 {
  7007   return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
  7008                 process, current_group);
  7009 }
  7010 
  7011 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2,
  7012        "(list (read-process-name \"Kill process\"))",
  7013        doc: /* Kill process PROCESS.  May be process or name of one.
  7014 See function `interrupt-process' for more details on usage.  */)
  7015   (Lisp_Object process, Lisp_Object current_group)
  7016 {
  7017   process_send_signal (process, SIGKILL, current_group, 0);
  7018   return process;
  7019 }
  7020 
  7021 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
  7022        doc: /* Send QUIT signal to process PROCESS.  May be process or name of one.
  7023 See function `interrupt-process' for more details on usage.  */)
  7024   (Lisp_Object process, Lisp_Object current_group)
  7025 {
  7026   process_send_signal (process, SIGQUIT, current_group, 0);
  7027   return process;
  7028 }
  7029 
  7030 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
  7031        doc: /* Stop process PROCESS.  May be process or name of one.
  7032 See function `interrupt-process' for more details on usage.
  7033 If PROCESS is a network or serial or pipe connection, inhibit handling
  7034 of incoming traffic.  */)
  7035   (Lisp_Object process, Lisp_Object current_group)
  7036 {
  7037   if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
  7038                              || PIPECONN_P (process)))
  7039     {
  7040       struct Lisp_Process *p;
  7041 
  7042       p = XPROCESS (process);
  7043       if (NILP (p->command)
  7044           && p->infd >= 0)
  7045         delete_read_fd (p->infd);
  7046       pset_command (p, Qt);
  7047       return process;
  7048     }
  7049 #ifndef SIGTSTP
  7050   error ("No SIGTSTP support");
  7051 #else
  7052   process_send_signal (process, SIGTSTP, current_group, 0);
  7053 #endif
  7054   return process;
  7055 }
  7056 
  7057 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
  7058        doc: /* Continue process PROCESS.  May be process or name of one.
  7059 See function `interrupt-process' for more details on usage.
  7060 If PROCESS is a network or serial process, resume handling of incoming
  7061 traffic.  */)
  7062   (Lisp_Object process, Lisp_Object current_group)
  7063 {
  7064   if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
  7065                              || PIPECONN_P (process)))
  7066     {
  7067       struct Lisp_Process *p;
  7068 
  7069       p = XPROCESS (process);
  7070       eassert (p->infd < FD_SETSIZE);
  7071       if (EQ (p->command, Qt)
  7072           && p->infd >= 0
  7073           && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
  7074         {
  7075           add_process_read_fd (p->infd);
  7076 #ifdef WINDOWSNT
  7077           if (fd_info[ p->infd ].flags & FILE_SERIAL)
  7078             PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
  7079 #else /* not WINDOWSNT */
  7080           tcflush (p->infd, TCIFLUSH);
  7081 #endif /* not WINDOWSNT */
  7082         }
  7083       pset_command (p, Qnil);
  7084       return process;
  7085     }
  7086 #ifdef SIGCONT
  7087     process_send_signal (process, SIGCONT, current_group, 0);
  7088 #else
  7089     error ("No SIGCONT support");
  7090 #endif
  7091   return process;
  7092 }
  7093 
  7094 /* Return the integer value of the signal whose abbreviation is ABBR,
  7095    or a negative number if there is no such signal.  */
  7096 static int
  7097 abbr_to_signal (char const *name)
  7098 {
  7099   int i, signo;
  7100   char sigbuf[20]; /* Large enough for all valid signal abbreviations.  */
  7101 
  7102   if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
  7103     name += 3;
  7104 
  7105   for (i = 0; i < sizeof sigbuf; i++)
  7106     {
  7107       sigbuf[i] = c_toupper (name[i]);
  7108       if (! sigbuf[i])
  7109         return str2sig (sigbuf, &signo) == 0 ? signo : -1;
  7110     }
  7111 
  7112   return -1;
  7113 }
  7114 
  7115 DEFUN ("internal-default-signal-process",
  7116        Finternal_default_signal_process,
  7117        Sinternal_default_signal_process, 2, 3, 0,
  7118        doc: /* Default function to send PROCESS the signal with code SIGCODE.
  7119 It shall be the last element in list `signal-process-functions'.
  7120 See function `signal-process' for more details on usage.  */)
  7121   (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
  7122 {
  7123   pid_t pid;
  7124   int signo;
  7125 
  7126   if (STRINGP (process))
  7127     {
  7128       Lisp_Object tem = Fget_process (process);
  7129       if (NILP (tem))
  7130         {
  7131           ptrdiff_t len;
  7132           tem = string_to_number (SSDATA (process), 10, &len);
  7133           if (NILP (tem) || len != SBYTES (process))
  7134             return Qnil;
  7135         }
  7136       process = tem;
  7137     }
  7138   else if (!NUMBERP (process))
  7139     process = get_process (process);
  7140 
  7141   if (NILP (process))
  7142     return process;
  7143 
  7144   if (NUMBERP (process))
  7145     CONS_TO_INTEGER (process, pid_t, pid);
  7146   else
  7147     {
  7148       CHECK_PROCESS (process);
  7149       pid = XPROCESS (process)->pid;
  7150       if (pid <= 0)
  7151         error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
  7152     }
  7153 
  7154   if (FIXNUMP (sigcode))
  7155     signo = check_integer_range (sigcode, INT_MIN, INT_MAX);
  7156   else
  7157     {
  7158       char *name;
  7159 
  7160       CHECK_SYMBOL (sigcode);
  7161       name = SSDATA (SYMBOL_NAME (sigcode));
  7162 
  7163       signo = abbr_to_signal (name);
  7164       if (signo < 0)
  7165         error ("Undefined signal name %s", name);
  7166     }
  7167 
  7168   return make_fixnum (kill (pid, signo));
  7169 }
  7170 
  7171 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
  7172        2, 3, "(list (read-string \"Process (name or number): \") (read-signal-name))",
  7173        doc: /* Send PROCESS the signal with code SIGCODE.
  7174 PROCESS may also be a number specifying the process id of the
  7175 process to signal; in this case, the process need not be a child of
  7176 this Emacs.
  7177 If PROCESS is a process object which contains the property
  7178 `remote-pid', or PROCESS is a number and REMOTE is a remote file name,
  7179 PROCESS is interpreted as process on the respective remote host, which
  7180 will be the process to signal.
  7181 SIGCODE may be an integer, or a symbol whose name is a signal name.  */)
  7182   (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
  7183 {
  7184   return CALLN (Frun_hook_with_args_until_success, Qsignal_process_functions,
  7185                 process, sigcode, remote);
  7186 }
  7187 
  7188 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
  7189        doc: /* Make PROCESS see end-of-file in its input.
  7190 EOF comes after any text already sent to it.
  7191 PROCESS may be a process, a buffer, the name of a process or buffer, or
  7192 nil, indicating the current buffer's process.
  7193 If PROCESS is a network connection, or is a process communicating
  7194 through a pipe (as opposed to a pty), then you cannot send any more
  7195 text to PROCESS after you call this function.
  7196 If PROCESS is a serial process, wait until all output written to the
  7197 process has been transmitted to the serial port.  */)
  7198   (Lisp_Object process)
  7199 {
  7200   Lisp_Object proc;
  7201   struct coding_system *coding = NULL;
  7202   int outfd;
  7203 
  7204   proc = get_process (process);
  7205 
  7206   if (NETCONN_P (proc))
  7207     wait_while_connecting (proc);
  7208 
  7209   if (DATAGRAM_CONN_P (proc))
  7210     return process;
  7211 
  7212 
  7213   outfd = XPROCESS (proc)->outfd;
  7214   eassert (outfd < FD_SETSIZE);
  7215   if (outfd >= 0)
  7216     coding = proc_encode_coding_system[outfd];
  7217 
  7218   /* Make sure the process is really alive.  */
  7219   if (XPROCESS (proc)->raw_status_new)
  7220     update_status (XPROCESS (proc));
  7221   if (! EQ (XPROCESS (proc)->status, Qrun))
  7222     error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc))));
  7223 
  7224   if (coding && CODING_REQUIRE_FLUSHING (coding))
  7225     {
  7226       coding->mode |= CODING_MODE_LAST_BLOCK;
  7227       send_process (proc, "", 0, Qnil);
  7228     }
  7229 
  7230   if (XPROCESS (proc)->pty_in)
  7231     send_process (proc, "\004", 1, Qnil);
  7232   else if (EQ (XPROCESS (proc)->type, Qserial))
  7233     {
  7234 #ifndef WINDOWSNT
  7235       if (tcdrain (XPROCESS (proc)->outfd) != 0)
  7236         report_file_error ("Failed tcdrain", Qnil);
  7237 #endif /* not WINDOWSNT */
  7238       /* Do nothing on Windows because writes are blocking.  */
  7239     }
  7240   else
  7241     {
  7242       struct Lisp_Process *p = XPROCESS (proc);
  7243       int old_outfd = p->outfd;
  7244       int new_outfd;
  7245 
  7246 #ifdef HAVE_SHUTDOWN
  7247       /* If this is a network connection, or socketpair is used
  7248          for communication with the subprocess, call shutdown to cause EOF.
  7249          (In some old system, shutdown to socketpair doesn't work.
  7250          Then we just can't win.)  */
  7251       if (0 <= old_outfd
  7252           && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
  7253         shutdown (old_outfd, 1);
  7254 #endif
  7255       close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
  7256       new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
  7257       if (new_outfd < 0)
  7258         report_file_error ("Opening null device", Qnil);
  7259       p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
  7260       p->outfd = new_outfd;
  7261 
  7262       eassert (0 <= new_outfd && new_outfd < FD_SETSIZE);
  7263       if (!proc_encode_coding_system[new_outfd])
  7264         proc_encode_coding_system[new_outfd]
  7265           = xmalloc (sizeof (struct coding_system));
  7266       if (old_outfd >= 0)
  7267         {
  7268           eassert (old_outfd < FD_SETSIZE);
  7269           *proc_encode_coding_system[new_outfd]
  7270             = *proc_encode_coding_system[old_outfd];
  7271           memset (proc_encode_coding_system[old_outfd], 0,
  7272                   sizeof (struct coding_system));
  7273         }
  7274       else
  7275         setup_coding_system (p->encode_coding_system,
  7276                              proc_encode_coding_system[new_outfd]);
  7277     }
  7278   return process;
  7279 }
  7280 
  7281 /* The main Emacs thread records child processes in three places:
  7282 
  7283    - Vprocess_alist, for asynchronous subprocesses, which are child
  7284      processes visible to Lisp.
  7285 
  7286    - deleted_pid_list, for child processes invisible to Lisp,
  7287      typically because of delete-process.  These are recorded so that
  7288      the processes can be reaped when they exit, so that the operating
  7289      system's process table is not cluttered by zombies.
  7290 
  7291    - the local variable PID in Fcall_process, call_process_cleanup and
  7292      call_process_kill, for synchronous subprocesses.
  7293      record_unwind_protect is used to make sure this process is not
  7294      forgotten: if the user interrupts call-process and the child
  7295      process refuses to exit immediately even with two C-g's,
  7296      call_process_kill adds PID's contents to deleted_pid_list before
  7297      returning.
  7298 
  7299    The main Emacs thread invokes waitpid only on child processes that
  7300    it creates and that have not been reaped.  This avoid races on
  7301    platforms such as GTK, where other threads create their own
  7302    subprocesses which the main thread should not reap.  For example,
  7303    if the main thread attempted to reap an already-reaped child, it
  7304    might inadvertently reap a GTK-created process that happened to
  7305    have the same process ID.
  7306 
  7307    To avoid a deadlock when receiving SIGCHLD while
  7308    'wait_reading_process_output' is in 'pselect', the SIGCHLD handler
  7309    will notify the `pselect' using a self-pipe.  The deadlock could
  7310    occur if SIGCHLD is delivered outside of the 'pselect' call, in
  7311    which case 'pselect' will not be interrupted by the signal, and
  7312    will therefore wait on the process's output descriptor for the
  7313    output that will never come.
  7314 
  7315    WINDOWSNT doesn't need this facility because its 'pselect'
  7316    emulation (see 'sys_select' in w32proc.c) waits on a subprocess
  7317    handle, which becomes signaled when the process exits, and also
  7318    because that emulation delays the delivery of the simulated SIGCHLD
  7319    until all the output from the subprocess has been consumed.  */
  7320 
  7321 /* FIXME: On Unix-like systems that have a proper 'pselect'
  7322    (HAVE_PSELECT), we should block SIGCHLD in
  7323    'wait_reading_process_output' and pass a non-NULL signal mask to
  7324    'pselect' to avoid the need for the self-pipe.  */
  7325 
  7326 /* Set up `child_signal_read_fd' and `child_signal_write_fd'.  */
  7327 
  7328 void
  7329 child_signal_init (void)
  7330 {
  7331   /* Either both are initialized, or both are uninitialized.  */
  7332   eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
  7333 
  7334 #ifndef WINDOWSNT
  7335   if (0 <= child_signal_read_fd)
  7336     return; /* already done */
  7337 
  7338   int fds[2];
  7339   if (emacs_pipe (fds) < 0)
  7340     report_file_error ("Creating pipe for child signal", Qnil);
  7341   if (FD_SETSIZE <= fds[0])
  7342     {
  7343       /* Since we need to `pselect' on the read end, it has to fit
  7344          into an `fd_set'.  */
  7345       emacs_close (fds[0]);
  7346       emacs_close (fds[1]);
  7347       report_file_errno ("Creating pipe for child signal", Qnil,
  7348                          EMFILE);
  7349     }
  7350 
  7351   /* We leave the file descriptors open until the Emacs process
  7352      exits.  */
  7353   eassert (0 <= fds[0]);
  7354   eassert (0 <= fds[1]);
  7355   if (fcntl (fds[0], F_SETFL, O_NONBLOCK) != 0)
  7356     emacs_perror ("fcntl");
  7357   if (fcntl (fds[1], F_SETFL, O_NONBLOCK) != 0)
  7358     emacs_perror ("fcntl");
  7359   add_read_fd (fds[0], child_signal_read, NULL);
  7360   fd_callback_info[fds[0]].flags &= ~KEYBOARD_FD;
  7361   child_signal_read_fd = fds[0];
  7362   child_signal_write_fd = fds[1];
  7363 #endif  /* !WINDOWSNT */
  7364 }
  7365 
  7366 #ifndef WINDOWSNT
  7367 /* Consume a process status change.  */
  7368 
  7369 static void
  7370 child_signal_read (int fd, void *data)
  7371 {
  7372   eassert (0 <= fd);
  7373   eassert (fd == child_signal_read_fd);
  7374   char dummy;
  7375   if (emacs_read (fd, &dummy, 1) < 0 && errno != EAGAIN)
  7376     emacs_perror ("reading from child signal FD");
  7377 }
  7378 #endif  /* !WINDOWSNT */
  7379 
  7380 /* Notify `wait_reading_process_output' of a process status
  7381    change.  */
  7382 
  7383 static void
  7384 child_signal_notify (void)
  7385 {
  7386 #ifndef WINDOWSNT
  7387   int fd = child_signal_write_fd;
  7388   eassert (0 <= fd);
  7389   char dummy = 0;
  7390   if (emacs_write (fd, &dummy, 1) != 1)
  7391     emacs_perror ("writing to child signal FD");
  7392 #endif
  7393 }
  7394 
  7395 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
  7396    its own SIGCHLD handling.  On POSIXish systems lacking
  7397    pidfd_open+waitid or using Glib 2.73.1-, Glib needs this to
  7398    keep track of its own children.  GNUstep is similar.  */
  7399 
  7400 static void dummy_handler (int sig) {}
  7401 static signal_handler_t volatile lib_child_handler;
  7402 
  7403 /* Handle a SIGCHLD signal by looking for known child processes of
  7404    Emacs whose status have changed.  For each one found, record its
  7405    new status.
  7406 
  7407    All we do is change the status; we do not run sentinels or print
  7408    notifications.  That is saved for the next time keyboard input is
  7409    done, in order to avoid timing errors.
  7410 
  7411    ** WARNING: this can be called during garbage collection.
  7412    Therefore, it must not be fooled by the presence of mark bits in
  7413    Lisp objects.
  7414 
  7415    ** USG WARNING: Although it is not obvious from the documentation
  7416    in signal(2), on a USG system the SIGCLD handler MUST NOT call
  7417    signal() before executing at least one wait(), otherwise the
  7418    handler will be called again, resulting in an infinite loop.  The
  7419    relevant portion of the documentation reads "SIGCLD signals will be
  7420    queued and the signal-catching function will be continually
  7421    reentered until the queue is empty".  Invoking signal() causes the
  7422    kernel to reexamine the SIGCLD queue.  Fred Fish, UniSoft Systems
  7423    Inc.
  7424 
  7425    ** Malloc WARNING: This should never call malloc either directly or
  7426    indirectly; if it does, that is a bug.  */
  7427 
  7428 static void
  7429 handle_child_signal (int sig)
  7430 {
  7431   Lisp_Object tail, proc;
  7432   bool changed = false;
  7433 
  7434   /* Find the process that signaled us, and record its status.  */
  7435 
  7436   /* The process can have been deleted by Fdelete_process, or have
  7437      been started asynchronously by Fcall_process.  */
  7438   for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
  7439     {
  7440       bool all_pids_are_fixnums
  7441         = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
  7442            && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
  7443       Lisp_Object head = XCAR (tail);
  7444       Lisp_Object xpid;
  7445       if (! CONSP (head))
  7446         continue;
  7447       xpid = XCAR (head);
  7448       if (all_pids_are_fixnums ? FIXNUMP (xpid) : INTEGERP (xpid))
  7449         {
  7450           intmax_t deleted_pid;
  7451           bool ok = integer_to_intmax (xpid, &deleted_pid);
  7452           eassert (ok);
  7453           if (child_status_changed (deleted_pid, 0, 0))
  7454             {
  7455               changed = true;
  7456               if (STRINGP (XCDR (head)))
  7457                 unlink (SSDATA (XCDR (head)));
  7458               XSETCAR (tail, Qnil);
  7459             }
  7460         }
  7461     }
  7462 
  7463   /* Otherwise, if it is asynchronous, it is in Vprocess_alist.  */
  7464   FOR_EACH_PROCESS (tail, proc)
  7465     {
  7466       struct Lisp_Process *p = XPROCESS (proc);
  7467       int status;
  7468 
  7469       if (p->alive
  7470           && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
  7471         {
  7472           /* Change the status of the process that was found.  */
  7473           changed = true;
  7474           p->tick = ++process_tick;
  7475           p->raw_status = status;
  7476           p->raw_status_new = 1;
  7477 
  7478           /* If process has terminated, stop waiting for its output.  */
  7479           if (WIFSIGNALED (status) || WIFEXITED (status))
  7480             {
  7481               bool clear_desc_flag = 0;
  7482               p->alive = 0;
  7483               if (p->infd >= 0)
  7484                 clear_desc_flag = 1;
  7485 
  7486               /* clear_desc_flag avoids a compiler bug in Microsoft C.  */
  7487               if (clear_desc_flag)
  7488                 delete_read_fd (p->infd);
  7489             }
  7490         }
  7491     }
  7492 
  7493   if (changed)
  7494     /* Wake up `wait_reading_process_output'.  */
  7495     child_signal_notify ();
  7496 
  7497   lib_child_handler (sig);
  7498 #ifdef NS_IMPL_GNUSTEP
  7499   /* NSTask in GNUstep sets its child handler each time it is called.
  7500      So we must re-set ours.  */
  7501   catch_child_signal ();
  7502 #endif
  7503 }
  7504 
  7505 static void
  7506 deliver_child_signal (int sig)
  7507 {
  7508   deliver_process_signal (sig, handle_child_signal);
  7509 }
  7510 
  7511 
  7512 static Lisp_Object
  7513 exec_sentinel_error_handler (Lisp_Object error_val)
  7514 {
  7515   /* Make sure error_val is a cons cell, as all the rest of error
  7516      handling expects that, and will barf otherwise.  */
  7517   if (!CONSP (error_val))
  7518     error_val = Fcons (Qerror, error_val);
  7519   cmd_error_internal (error_val, "error in process sentinel: ");
  7520   Vinhibit_quit = Qt;
  7521   update_echo_area ();
  7522   if (process_error_pause_time > 0)
  7523     Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
  7524   return Qt;
  7525 }
  7526 
  7527 static void
  7528 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
  7529 {
  7530   Lisp_Object sentinel, odeactivate;
  7531   struct Lisp_Process *p = XPROCESS (proc);
  7532   specpdl_ref count = SPECPDL_INDEX ();
  7533   bool outer_running_asynch_code = running_asynch_code;
  7534   int waiting = waiting_for_user_input_p;
  7535 
  7536   if (inhibit_sentinels)
  7537     return;
  7538 
  7539   odeactivate = Vdeactivate_mark;
  7540 #if 0
  7541   Lisp_Object obuffer, okeymap;
  7542   XSETBUFFER (obuffer, current_buffer);
  7543   okeymap = BVAR (current_buffer, keymap);
  7544 #endif
  7545 
  7546   /* There's no good reason to let sentinels change the current
  7547      buffer, and many callers of accept-process-output, sit-for, and
  7548      friends don't expect current-buffer to be changed from under them.  */
  7549   record_unwind_current_buffer ();
  7550 
  7551   sentinel = p->sentinel;
  7552 
  7553   /* Inhibit quit so that random quits don't screw up a running filter.  */
  7554   specbind (Qinhibit_quit, Qt);
  7555   specbind (Qlast_nonmenu_event, Qt); /* Why? --Stef  */
  7556 
  7557   /* In case we get recursively called,
  7558      and we already saved the match data nonrecursively,
  7559      save the same match data in safely recursive fashion.  */
  7560   if (outer_running_asynch_code)
  7561     {
  7562       Lisp_Object tem;
  7563       tem = Fmatch_data (Qnil, Qnil, Qnil);
  7564       restore_search_regs ();
  7565       record_unwind_save_match_data ();
  7566       Fset_match_data (tem, Qt);
  7567     }
  7568 
  7569   /* For speed, if a search happens within this code,
  7570      save the match data in a special nonrecursive fashion.  */
  7571   running_asynch_code = 1;
  7572 
  7573   internal_condition_case_1 (read_process_output_call,
  7574                              list3 (sentinel, proc, reason),
  7575                              !NILP (Vdebug_on_error) ? Qnil : Qerror,
  7576                              exec_sentinel_error_handler);
  7577 
  7578   /* If we saved the match data nonrecursively, restore it now.  */
  7579   restore_search_regs ();
  7580   running_asynch_code = outer_running_asynch_code;
  7581 
  7582   Vdeactivate_mark = odeactivate;
  7583 
  7584   /* Restore waiting_for_user_input_p as it was
  7585      when we were called, in case the filter clobbered it.  */
  7586   waiting_for_user_input_p = waiting;
  7587 
  7588   unbind_to (count, Qnil);
  7589 }
  7590 
  7591 /* Report all recent events of a change in process status
  7592    (either run the sentinel or output a message).
  7593    This is usually done while Emacs is waiting for keyboard input
  7594    but can be done at other times.
  7595 
  7596    Return positive if any input was received from WAIT_PROC (or from
  7597    any process if WAIT_PROC is null), zero if input was attempted but
  7598    none received, and negative if we didn't even try.  */
  7599 
  7600 static int
  7601 status_notify (struct Lisp_Process *deleting_process,
  7602                struct Lisp_Process *wait_proc)
  7603 {
  7604   Lisp_Object proc;
  7605   Lisp_Object tail, msg;
  7606   int got_some_output = -1;
  7607 
  7608   tail = Qnil;
  7609   msg = Qnil;
  7610 
  7611   /* Set this now, so that if new processes are created by sentinels
  7612      that we run, we get called again to handle their status changes.  */
  7613   update_tick = process_tick;
  7614 
  7615   FOR_EACH_PROCESS (tail, proc)
  7616     {
  7617       Lisp_Object symbol;
  7618       register struct Lisp_Process *p = XPROCESS (proc);
  7619 
  7620       if (p->tick != p->update_tick)
  7621         {
  7622           p->update_tick = p->tick;
  7623 
  7624           /* If process is still active, read any output that remains.  */
  7625           while (! EQ (p->filter, Qt)
  7626                  && ! connecting_status (p->status)
  7627                  && ! EQ (p->status, Qlisten)
  7628                  /* Network or serial process not stopped:  */
  7629                  && ! EQ (p->command, Qt)
  7630                  && p->infd >= 0
  7631                  && p != deleting_process)
  7632             {
  7633               int nread = read_process_output (proc, p->infd);
  7634               if ((!wait_proc || wait_proc == XPROCESS (proc))
  7635                   && got_some_output < nread)
  7636                 got_some_output = nread;
  7637               if (nread <= 0)
  7638                 break;
  7639             }
  7640 
  7641           /* Get the text to use for the message.  */
  7642           if (p->raw_status_new)
  7643             update_status (p);
  7644           msg = status_message (p);
  7645 
  7646           /* If process is terminated, deactivate it or delete it.  */
  7647           symbol = p->status;
  7648           if (CONSP (p->status))
  7649             symbol = XCAR (p->status);
  7650 
  7651           if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
  7652               || EQ (symbol, Qclosed))
  7653             {
  7654               if (delete_exited_processes)
  7655                 remove_process (proc);
  7656               else
  7657                 deactivate_process (proc);
  7658             }
  7659 
  7660           /* The actions above may have further incremented p->tick.
  7661              So set p->update_tick again so that an error in the sentinel will
  7662              not cause this code to be run again.  */
  7663           p->update_tick = p->tick;
  7664           /* Now output the message suitably.  */
  7665           exec_sentinel (proc, msg);
  7666           if (BUFFERP (p->buffer))
  7667             /* In case it uses %s in mode-line-format.  */
  7668             bset_update_mode_line (XBUFFER (p->buffer));
  7669         }
  7670     } /* end for */
  7671 
  7672   return got_some_output;
  7673 }
  7674 
  7675 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
  7676        Sinternal_default_process_sentinel, 2, 2, 0,
  7677        doc: /* Function used as default sentinel for processes.
  7678 This inserts a status message into the process's buffer, if there is one.  */)
  7679      (Lisp_Object proc, Lisp_Object msg)
  7680 {
  7681   Lisp_Object buffer, symbol;
  7682   struct Lisp_Process *p;
  7683   CHECK_PROCESS (proc);
  7684   p = XPROCESS (proc);
  7685   buffer = p->buffer;
  7686   symbol = p->status;
  7687   if (CONSP (symbol))
  7688     symbol = XCAR (symbol);
  7689 
  7690   if (!EQ (symbol, Qrun) && !NILP (buffer))
  7691     {
  7692       Lisp_Object tem;
  7693       struct buffer *old = current_buffer;
  7694       ptrdiff_t opoint, opoint_byte;
  7695       ptrdiff_t before, before_byte;
  7696 
  7697       /* Avoid error if buffer is deleted
  7698          (probably that's why the process is dead, too).  */
  7699       if (!BUFFER_LIVE_P (XBUFFER (buffer)))
  7700         return Qnil;
  7701       Fset_buffer (buffer);
  7702 
  7703       if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
  7704         msg = (code_convert_string_norecord
  7705                (msg, Vlocale_coding_system, 1));
  7706 
  7707       opoint = PT;
  7708       opoint_byte = PT_BYTE;
  7709       /* Insert new output into buffer
  7710          at the current end-of-output marker,
  7711          thus preserving logical ordering of input and output.  */
  7712       if (XMARKER (p->mark)->buffer)
  7713         Fgoto_char (p->mark);
  7714       else
  7715         SET_PT_BOTH (ZV, ZV_BYTE);
  7716 
  7717       before = PT;
  7718       before_byte = PT_BYTE;
  7719 
  7720       tem = BVAR (current_buffer, read_only);
  7721       bset_read_only (current_buffer, Qnil);
  7722       insert_string ("\nProcess ");
  7723       { /* FIXME: temporary kludge.  */
  7724         Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
  7725       insert_string (" ");
  7726       Finsert (1, &msg);
  7727       bset_read_only (current_buffer, tem);
  7728       set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
  7729 
  7730       if (opoint >= before)
  7731         SET_PT_BOTH (opoint + (PT - before),
  7732                      opoint_byte + (PT_BYTE - before_byte));
  7733       else
  7734         SET_PT_BOTH (opoint, opoint_byte);
  7735 
  7736       set_buffer_internal (old);
  7737     }
  7738   return Qnil;
  7739 }
  7740 
  7741 
  7742 DEFUN ("set-process-coding-system", Fset_process_coding_system,
  7743        Sset_process_coding_system, 1, 3, 0,
  7744        doc: /* Set coding systems of PROCESS to DECODING and ENCODING.
  7745 DECODING will be used to decode subprocess output and ENCODING to
  7746 encode subprocess input. */)
  7747   (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
  7748 {
  7749   CHECK_PROCESS (process);
  7750 
  7751   struct Lisp_Process *p = XPROCESS (process);
  7752 
  7753   Fcheck_coding_system (decoding);
  7754   Fcheck_coding_system (encoding);
  7755   encoding = coding_inherit_eol_type (encoding, Qnil);
  7756   pset_decode_coding_system (p, decoding);
  7757   pset_encode_coding_system (p, encoding);
  7758 
  7759   /* If the sockets haven't been set up yet, the final setup part of
  7760      this will be called asynchronously. */
  7761   if (p->infd < 0 || p->outfd < 0)
  7762     return Qnil;
  7763 
  7764   setup_process_coding_systems (process);
  7765 
  7766   return Qnil;
  7767 }
  7768 
  7769 DEFUN ("process-coding-system",
  7770        Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
  7771        doc: /* Return a cons of coding systems for decoding and encoding of PROCESS.  */)
  7772   (register Lisp_Object process)
  7773 {
  7774   CHECK_PROCESS (process);
  7775   return Fcons (XPROCESS (process)->decode_coding_system,
  7776                 XPROCESS (process)->encode_coding_system);
  7777 }
  7778 
  7779 
  7780 
  7781 
  7782 # ifdef HAVE_GPM
  7783 
  7784 void
  7785 add_gpm_wait_descriptor (int desc)
  7786 {
  7787   add_keyboard_wait_descriptor (desc);
  7788 }
  7789 
  7790 void
  7791 delete_gpm_wait_descriptor (int desc)
  7792 {
  7793   delete_keyboard_wait_descriptor (desc);
  7794 }
  7795 
  7796 # endif
  7797 
  7798 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
  7799 
  7800 /* Return true if *MASK has a bit set
  7801    that corresponds to one of the keyboard input descriptors.  */
  7802 
  7803 static bool
  7804 keyboard_bit_set (fd_set *mask)
  7805 {
  7806   int fd;
  7807 
  7808   eassert (max_desc < FD_SETSIZE);
  7809   for (fd = 0; fd <= max_desc; fd++)
  7810     if (FD_ISSET (fd, mask)
  7811         && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
  7812             == (FOR_READ | KEYBOARD_FD)))
  7813       return 1;
  7814 
  7815   return 0;
  7816 }
  7817 # endif
  7818 
  7819 #else  /* not subprocesses */
  7820 
  7821 /* This is referenced in thread.c:run_thread (which is never actually
  7822    called, since threads are not enabled for this configuration.  */
  7823 void
  7824 update_processes_for_thread_death (Lisp_Object dying_thread)
  7825 {
  7826 }
  7827 
  7828 /* Defined in msdos.c.  */
  7829 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
  7830                        struct timespec *, void *);
  7831 
  7832 /* Implementation of wait_reading_process_output, assuming that there
  7833    are no subprocesses.  Used only by the MS-DOS build.
  7834 
  7835    Wait for timeout to elapse and/or keyboard input to be available.
  7836 
  7837    TIME_LIMIT is:
  7838      timeout in seconds
  7839      If negative, gobble data immediately available but don't wait for any.
  7840 
  7841    NSECS is:
  7842      an additional duration to wait, measured in nanoseconds
  7843      If TIME_LIMIT is zero, then:
  7844        If NSECS == 0, there is no limit.
  7845        If NSECS > 0, the timeout consists of NSECS only.
  7846        If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
  7847 
  7848    READ_KBD is:
  7849      0 to ignore keyboard input, or
  7850      1 to return when input is available, or
  7851      -1 means caller will actually read the input, so don't throw to
  7852        the quit handler.
  7853 
  7854    see full version for other parameters. We know that wait_proc will
  7855      always be NULL, since `subprocesses' isn't defined.
  7856 
  7857    DO_DISPLAY means redisplay should be done to show subprocess
  7858    output that arrives.
  7859 
  7860    Return -1 signifying we got no output and did not try.  */
  7861 
  7862 int
  7863 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
  7864                              bool do_display,
  7865                              Lisp_Object wait_for_cell,
  7866                              struct Lisp_Process *wait_proc, int just_wait_proc)
  7867 {
  7868   register int nfds;
  7869   struct timespec end_time, timeout;
  7870   enum { MINIMUM = -1, TIMEOUT, FOREVER } wait;
  7871 
  7872   if (TYPE_MAXIMUM (time_t) < time_limit)
  7873     time_limit = TYPE_MAXIMUM (time_t);
  7874 
  7875   if (time_limit < 0 || nsecs < 0)
  7876     wait = MINIMUM;
  7877   else if (time_limit > 0 || nsecs > 0)
  7878     {
  7879       wait = TIMEOUT;
  7880       end_time = timespec_add (current_timespec (),
  7881                                make_timespec (time_limit, nsecs));
  7882     }
  7883   else
  7884     wait = FOREVER;
  7885 
  7886   /* Turn off periodic alarms (in case they are in use)
  7887      and then turn off any other atimers,
  7888      because the select emulator uses alarms.  */
  7889   stop_polling ();
  7890   turn_on_atimers (0);
  7891 
  7892   while (1)
  7893     {
  7894       bool timeout_reduced_for_timers = false;
  7895       fd_set waitchannels;
  7896       int xerrno;
  7897 
  7898       /* If calling from keyboard input, do not quit
  7899          since we want to return C-g as an input character.
  7900          Otherwise, do pending quit if requested.  */
  7901       if (read_kbd >= 0)
  7902         maybe_quit ();
  7903 
  7904       /* Exit now if the cell we're waiting for became non-nil.  */
  7905       if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
  7906         break;
  7907 
  7908       /* Compute time from now till when time limit is up.  */
  7909       /* Exit if already run out.  */
  7910       if (wait == TIMEOUT)
  7911         {
  7912           struct timespec now = current_timespec ();
  7913           if (timespec_cmp (end_time, now) <= 0)
  7914             break;
  7915           timeout = timespec_sub (end_time, now);
  7916         }
  7917       else
  7918         timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
  7919 
  7920       /* If our caller will not immediately handle keyboard events,
  7921          run timer events directly.
  7922          (Callers that will immediately read keyboard events
  7923          call timer_delay on their own.)  */
  7924       if (NILP (wait_for_cell))
  7925         {
  7926           struct timespec timer_delay;
  7927 
  7928           do
  7929             {
  7930               unsigned old_timers_run = timers_run;
  7931               timer_delay = timer_check ();
  7932               if (timers_run != old_timers_run && do_display)
  7933                 /* We must retry, since a timer may have requeued itself
  7934                    and that could alter the time delay.  */
  7935                 redisplay_preserve_echo_area (14);
  7936               else
  7937                 break;
  7938             }
  7939           while (!detect_input_pending ());
  7940 
  7941           /* If there is unread keyboard input, also return.  */
  7942           if (read_kbd != 0
  7943               && requeued_events_pending_p ())
  7944             break;
  7945 
  7946           if (timespec_valid_p (timer_delay))
  7947             {
  7948               if (timespec_cmp (timer_delay, timeout) < 0)
  7949                 {
  7950                   timeout = timer_delay;
  7951                   timeout_reduced_for_timers = true;
  7952                 }
  7953             }
  7954         }
  7955 
  7956       /* Cause C-g and alarm signals to take immediate action,
  7957          and cause input available signals to zero out timeout.  */
  7958       if (read_kbd < 0)
  7959         set_waiting_for_input (&timeout);
  7960 
  7961       /* If a frame has been newly mapped and needs updating,
  7962          reprocess its display stuff.  */
  7963       if (frame_garbaged && do_display)
  7964         {
  7965           clear_waiting_for_input ();
  7966           redisplay_preserve_echo_area (15);
  7967           if (read_kbd < 0)
  7968             set_waiting_for_input (&timeout);
  7969         }
  7970 
  7971       /* Wait till there is something to do.  */
  7972       FD_ZERO (&waitchannels);
  7973       if (read_kbd && detect_input_pending ())
  7974         nfds = 0;
  7975       else
  7976         {
  7977           if (read_kbd || !NILP (wait_for_cell))
  7978             FD_SET (0, &waitchannels);
  7979           nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
  7980         }
  7981 
  7982       xerrno = errno;
  7983 
  7984       /* Make C-g and alarm signals set flags again.  */
  7985       clear_waiting_for_input ();
  7986 
  7987       /*  If we woke up due to SIGWINCH, actually change size now.  */
  7988       do_pending_window_change (0);
  7989 
  7990       if (wait < FOREVER && nfds == 0 && ! timeout_reduced_for_timers)
  7991         /* We waited the full specified time, so return now.  */
  7992         break;
  7993 
  7994       if (nfds == -1)
  7995         {
  7996           /* If the system call was interrupted, then go around the
  7997              loop again.  */
  7998           if (xerrno == EINTR)
  7999             FD_ZERO (&waitchannels);
  8000           else
  8001             report_file_errno ("Failed select", Qnil, xerrno);
  8002         }
  8003 
  8004       /* Check for keyboard input.  */
  8005 
  8006       if (read_kbd
  8007           && detect_input_pending_run_timers (do_display))
  8008         {
  8009           swallow_events (do_display);
  8010           if (detect_input_pending_run_timers (do_display))
  8011             break;
  8012         }
  8013 
  8014       /* If there is unread keyboard input, also return.  */
  8015       if (read_kbd
  8016           && requeued_events_pending_p ())
  8017         break;
  8018 
  8019       /* If wait_for_cell. check for keyboard input
  8020          but don't run any timers.
  8021          ??? (It seems wrong to me to check for keyboard
  8022          input at all when wait_for_cell, but the code
  8023          has been this way since July 1994.
  8024          Try changing this after version 19.31.)  */
  8025       if (! NILP (wait_for_cell)
  8026           && detect_input_pending ())
  8027         {
  8028           swallow_events (do_display);
  8029           if (detect_input_pending ())
  8030             break;
  8031         }
  8032 
  8033       /* Exit now if the cell we're waiting for became non-nil.  */
  8034       if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
  8035         break;
  8036     }
  8037 
  8038   start_polling ();
  8039 
  8040   return -1;
  8041 }
  8042 
  8043 #endif  /* not subprocesses */
  8044 
  8045 /* The following functions are needed even if async subprocesses are
  8046    not supported.  Some of them are no-op stubs in that case.  */
  8047 
  8048 #ifdef HAVE_TIMERFD
  8049 
  8050 /* Add FD, which is a descriptor returned by timerfd_create,
  8051    to the set of non-keyboard input descriptors.  */
  8052 
  8053 void
  8054 add_timer_wait_descriptor (int fd)
  8055 {
  8056   eassert (0 <= fd && fd < FD_SETSIZE);
  8057   add_read_fd (fd, timerfd_callback, NULL);
  8058   fd_callback_info[fd].flags &= ~KEYBOARD_FD;
  8059 }
  8060 
  8061 #endif /* HAVE_TIMERFD */
  8062 
  8063 /* If program file NAME starts with /: for quoting a magic
  8064    name, remove that, preserving the multibyteness of NAME.  */
  8065 
  8066 Lisp_Object
  8067 remove_slash_colon (Lisp_Object name)
  8068 {
  8069   return
  8070     (SREF (name, 0) == '/' && SREF (name, 1) == ':'
  8071      ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
  8072                               SBYTES (name) - 2, STRING_MULTIBYTE (name))
  8073      : name);
  8074 }
  8075 
  8076 /* Add DESC to the set of keyboard input descriptors.  */
  8077 
  8078 void
  8079 add_keyboard_wait_descriptor (int desc)
  8080 {
  8081 #ifdef subprocesses /* Actually means "not MSDOS".  */
  8082   eassert (desc >= 0 && desc < FD_SETSIZE);
  8083   fd_callback_info[desc].flags &= ~PROCESS_FD;
  8084   fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
  8085   if (desc > max_desc)
  8086     max_desc = desc;
  8087 #endif
  8088 }
  8089 
  8090 /* From now on, do not expect DESC to give keyboard input.  */
  8091 
  8092 void
  8093 delete_keyboard_wait_descriptor (int desc)
  8094 {
  8095 #ifdef subprocesses
  8096   eassert (desc >= 0 && desc < FD_SETSIZE);
  8097 
  8098   fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
  8099 
  8100   if (desc == max_desc)
  8101     recompute_max_desc ();
  8102 #endif
  8103 }
  8104 
  8105 /* Setup coding systems of PROCESS.  */
  8106 
  8107 void
  8108 setup_process_coding_systems (Lisp_Object process)
  8109 {
  8110 #ifdef subprocesses
  8111   struct Lisp_Process *p = XPROCESS (process);
  8112   int inch = p->infd;
  8113   int outch = p->outfd;
  8114   Lisp_Object coding_system;
  8115 
  8116   if (inch < 0 || outch < 0)
  8117     return;
  8118 
  8119   eassert (0 <= inch && inch < FD_SETSIZE);
  8120   if (!proc_decode_coding_system[inch])
  8121     proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
  8122   coding_system = p->decode_coding_system;
  8123   if (EQ (p->filter, Qinternal_default_process_filter)
  8124       && BUFFERP (p->buffer))
  8125     {
  8126       if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
  8127         coding_system = raw_text_coding_system (coding_system);
  8128     }
  8129   setup_coding_system (coding_system, proc_decode_coding_system[inch]);
  8130 
  8131   eassert (0 <= outch && outch < FD_SETSIZE);
  8132   if (!proc_encode_coding_system[outch])
  8133     proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
  8134   setup_coding_system (p->encode_coding_system,
  8135                        proc_encode_coding_system[outch]);
  8136 #endif
  8137 }
  8138 
  8139 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
  8140        doc: /* Return the (or a) live process associated with BUFFER.
  8141 BUFFER may be a buffer or the name of one.
  8142 Return nil if all processes associated with BUFFER have been
  8143 deleted or killed.  */)
  8144   (register Lisp_Object buffer)
  8145 {
  8146 #ifdef subprocesses
  8147   register Lisp_Object buf, tail, proc;
  8148 
  8149   if (NILP (buffer)) return Qnil;
  8150   buf = Fget_buffer (buffer);
  8151   if (NILP (buf)) return Qnil;
  8152 
  8153   FOR_EACH_PROCESS (tail, proc)
  8154     if (EQ (XPROCESS (proc)->buffer, buf))
  8155       return proc;
  8156 #endif  /* subprocesses */
  8157   return Qnil;
  8158 }
  8159 
  8160 DEFUN ("process-inherit-coding-system-flag",
  8161        Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
  8162        1, 1, 0,
  8163        doc: /* Return the value of inherit-coding-system flag for PROCESS.
  8164 If this flag is t, `buffer-file-coding-system' of the buffer
  8165 associated with PROCESS will inherit the coding system used to decode
  8166 the process output.  */)
  8167   (register Lisp_Object process)
  8168 {
  8169 #ifdef subprocesses
  8170   CHECK_PROCESS (process);
  8171   return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
  8172 #else
  8173   /* Ignore the argument and return the value of
  8174      inherit-process-coding-system.  */
  8175   return inherit_process_coding_system ? Qt : Qnil;
  8176 #endif
  8177 }
  8178 
  8179 /* Kill all processes associated with `buffer'.
  8180    If `buffer' is nil, kill all processes.  */
  8181 
  8182 void
  8183 kill_buffer_processes (Lisp_Object buffer)
  8184 {
  8185 #ifdef subprocesses
  8186   Lisp_Object tail, proc;
  8187 
  8188   FOR_EACH_PROCESS (tail, proc)
  8189     if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
  8190       {
  8191         if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
  8192           Fdelete_process (proc);
  8193         else if (XPROCESS (proc)->infd >= 0)
  8194           process_send_signal (proc, SIGHUP, Qnil, 1);
  8195       }
  8196 #else  /* subprocesses */
  8197   /* Since we have no subprocesses, this does nothing.  */
  8198 #endif /* subprocesses */
  8199 }
  8200 
  8201 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
  8202        Swaiting_for_user_input_p, 0, 0, 0,
  8203        doc: /* Return non-nil if Emacs is waiting for input from the user.
  8204 This is intended for use by asynchronous process output filters and sentinels.  */)
  8205   (void)
  8206 {
  8207 #ifdef subprocesses
  8208   return (waiting_for_user_input_p ? Qt : Qnil);
  8209 #else
  8210   return Qnil;
  8211 #endif
  8212 }
  8213 
  8214 /* Stop reading input from keyboard sources.  */
  8215 
  8216 void
  8217 hold_keyboard_input (void)
  8218 {
  8219   kbd_is_on_hold = 1;
  8220 }
  8221 
  8222 /* Resume reading input from keyboard sources.  */
  8223 
  8224 void
  8225 unhold_keyboard_input (void)
  8226 {
  8227   kbd_is_on_hold = 0;
  8228 }
  8229 
  8230 /* Return true if keyboard input is on hold, zero otherwise.  */
  8231 
  8232 bool
  8233 kbd_on_hold_p (void)
  8234 {
  8235   return kbd_is_on_hold;
  8236 }
  8237 
  8238 
  8239 /* Enumeration of and access to system processes a-la ps(1).  */
  8240 
  8241 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
  8242        0, 0, 0,
  8243        doc: /* Return a list of numerical process IDs of all running processes.
  8244 If this functionality is unsupported, return nil.
  8245 If `default-directory' is remote, return process IDs of the respective remote host.
  8246 
  8247 See `process-attributes' for getting attributes of a process given its ID.  */)
  8248   (void)
  8249 {
  8250   Lisp_Object handler
  8251     = Ffind_file_name_handler (BVAR (current_buffer, directory),
  8252                                Qlist_system_processes);
  8253   if (!NILP (handler))
  8254     return call1 (handler, Qlist_system_processes);
  8255 
  8256   return list_system_processes ();
  8257 }
  8258 
  8259 DEFUN ("process-attributes", Fprocess_attributes,
  8260        Sprocess_attributes, 1, 1, 0,
  8261        doc: /* Return attributes of the process given by its PID, a number.
  8262 If `default-directory' is remote, PID is regarded as process
  8263 identifier on the respective remote host.
  8264 
  8265 Value is an alist where each element is a cons cell of the form
  8266 
  8267     (KEY . VALUE)
  8268 
  8269 If this functionality is unsupported, the value is nil.
  8270 
  8271 See `list-system-processes' for getting a list of all process IDs.
  8272 
  8273 The KEYs of the attributes that this function may return are listed
  8274 below, together with the type of the associated VALUE (in parentheses).
  8275 Not all platforms support all of these attributes; unsupported
  8276 attributes will not appear in the returned alist.
  8277 Unless explicitly indicated otherwise, numbers can have either
  8278 integer or floating point values.
  8279 
  8280  euid    -- Effective user User ID of the process (number)
  8281  user    -- User name corresponding to euid (string)
  8282  egid    -- Effective user Group ID of the process (number)
  8283  group   -- Group name corresponding to egid (string)
  8284  comm    -- Command name (executable name only) (string)
  8285  state   -- Process state code, such as "S", "R", or "T" (string)
  8286  ppid    -- Parent process ID (number)
  8287  pgrp    -- Process group ID (number)
  8288  sess    -- Session ID, i.e. process ID of session leader (number)
  8289  ttname  -- Controlling tty name (string)
  8290  tpgid   -- ID of foreground process group on the process's tty (number)
  8291  minflt  -- number of minor page faults (number)
  8292  majflt  -- number of major page faults (number)
  8293  cminflt -- cumulative number of minor page faults (number)
  8294  cmajflt -- cumulative number of major page faults (number)
  8295  utime   -- user time used by the process, in `current-time' format
  8296  stime   -- system time used by the process (current-time)
  8297  time    -- sum of utime and stime (current-time)
  8298  cutime  -- user time used by the process and its children (current-time)
  8299  cstime  -- system time used by the process and its children (current-time)
  8300  ctime   -- sum of cutime and cstime (current-time)
  8301  pri     -- priority of the process (number)
  8302  nice    -- nice value of the process (number)
  8303  thcount -- process thread count (number)
  8304  start   -- time the process started (current-time)
  8305  vsize   -- virtual memory size of the process in KB's (number)
  8306  rss     -- resident set size of the process in KB's (number)
  8307  etime   -- elapsed time the process is running (current-time)
  8308  pcpu    -- percents of CPU time used by the process (floating-point number)
  8309  pmem    -- percents of total physical memory used by process's resident set
  8310               (floating-point number)
  8311  args    -- command line which invoked the process (string).  */)
  8312   ( Lisp_Object pid)
  8313 {
  8314   Lisp_Object handler
  8315     = Ffind_file_name_handler (BVAR (current_buffer, directory),
  8316                                Qprocess_attributes);
  8317   if (!NILP (handler))
  8318     return call2 (handler, Qprocess_attributes, pid);
  8319 
  8320   return system_process_attributes (pid);
  8321 }
  8322 
  8323 DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0,
  8324        doc: /* Return the number of processors, a positive integer.
  8325 Each usable thread execution unit counts as a processor.
  8326 By default, count the number of available processors,
  8327 overridable via the OMP_NUM_THREADS environment variable.
  8328 If optional argument QUERY is `current', ignore OMP_NUM_THREADS.
  8329 If QUERY is `all', also count processors not available.  */)
  8330   (Lisp_Object query)
  8331 {
  8332 #ifndef MSDOS
  8333   return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL
  8334                                     : EQ (query, Qcurrent) ? NPROC_CURRENT
  8335                                     : NPROC_CURRENT_OVERRIDABLE));
  8336 #else
  8337   return make_fixnum (1);
  8338 #endif
  8339 }
  8340 
  8341 DEFUN ("signal-names", Fsignal_names, Ssignal_names, 0, 0, 0,
  8342        doc: /* Return a list of known signal names on this system.  */)
  8343   (void)
  8344 {
  8345 #ifndef MSDOS
  8346   int i;
  8347   char name[SIG2STR_MAX];
  8348   Lisp_Object names = Qnil;
  8349 
  8350   for (i = 0; i <= SIGNUM_BOUND; ++i)
  8351     {
  8352       if (!sig2str (i, name))
  8353         names = Fcons (build_string (name), names);
  8354     }
  8355 
  8356   return names;
  8357 #else
  8358   return Qnil;
  8359 #endif
  8360 }
  8361 
  8362 #ifdef subprocesses
  8363 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
  8364    Invoke this after init_process_emacs, and after Glib and/or GNUstep
  8365    futz with the SIGCHLD handler, but before Emacs forks any children.
  8366    This function's caller should block SIGCHLD.  */
  8367 
  8368 void
  8369 catch_child_signal (void)
  8370 {
  8371   struct sigaction action, old_action;
  8372   sigset_t oldset;
  8373   emacs_sigaction_init (&action, deliver_child_signal);
  8374   block_child_signal (&oldset);
  8375   sigaction (SIGCHLD, &action, &old_action);
  8376   eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
  8377            || ! (old_action.sa_flags & SA_SIGINFO));
  8378 
  8379   if (old_action.sa_handler != deliver_child_signal)
  8380     lib_child_handler
  8381       = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
  8382          ? dummy_handler
  8383          : old_action.sa_handler);
  8384   unblock_child_signal (&oldset);
  8385 }
  8386 #endif  /* subprocesses */
  8387 
  8388 /* Limit the number of open files to the value it had at startup.  */
  8389 
  8390 void
  8391 restore_nofile_limit (void)
  8392 {
  8393 #ifdef HAVE_SETRLIMIT
  8394   if (FD_SETSIZE < nofile_limit.rlim_cur)
  8395     setrlimit (RLIMIT_NOFILE, &nofile_limit);
  8396 #endif
  8397 }
  8398 
  8399 int
  8400 open_channel_for_module (Lisp_Object process)
  8401 {
  8402   CHECK_PROCESS (process);
  8403   CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
  8404 #ifndef MSDOS
  8405   int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
  8406   if (fd == -1)
  8407     report_file_error ("Cannot duplicate file descriptor", Qnil);
  8408   return fd;
  8409 #else
  8410   /* PIPECONN_P returning true shouldn't be possible on MSDOS.  */
  8411   emacs_abort ();
  8412 #endif
  8413 }
  8414 
  8415 
  8416 /* This is not called "init_process" because that is the name of a
  8417    Mach system call, so it would cause problems on Darwin systems.  */
  8418 void
  8419 init_process_emacs (int sockfd)
  8420 {
  8421 #ifdef subprocesses
  8422   int i;
  8423 
  8424   inhibit_sentinels = 0;
  8425 
  8426   if (!will_dump_with_unexec_p ())
  8427     {
  8428 #if defined HAVE_GLIB && !defined WINDOWSNT
  8429       /* Tickle Glib's child-handling code.  Ask Glib to install a
  8430          watch source for Emacs itself which will initialize glib's
  8431          private SIGCHLD handler, allowing catch_child_signal to copy
  8432          it into lib_child_handler.  This is a hacky workaround to get
  8433          glib's g_unix_signal_handler into lib_child_handler.
  8434 
  8435          In Glib 2.37.5 (2013), commit 2e471acf changed Glib to
  8436          always install a signal handler when g_child_watch_source_new
  8437          is called and not just the first time it's called, and to
  8438          reset signal handlers to SIG_DFL when it no longer has a
  8439          watcher on that signal.  Arrange for Emacs's signal handler
  8440          to be reinstalled even if this happens.
  8441 
  8442          In Glib 2.73.2 (2022), commit f615eef4 changed Glib again,
  8443          to not install a signal handler if the system supports
  8444          pidfd_open and waitid (as in Linux kernel 5.3+).  The hacky
  8445          workaround is not needed in this case.  */
  8446       GSource *source = g_child_watch_source_new (getpid ());
  8447       catch_child_signal ();
  8448       g_source_unref (source);
  8449 
  8450       if (lib_child_handler != dummy_handler)
  8451         {
  8452           /* The hacky workaround is needed on this platform.  */
  8453           signal_handler_t lib_child_handler_glib = lib_child_handler;
  8454           catch_child_signal ();
  8455           eassert (lib_child_handler == dummy_handler);
  8456           lib_child_handler = lib_child_handler_glib;
  8457         }
  8458 #else
  8459       catch_child_signal ();
  8460 #endif
  8461     }
  8462 
  8463 #ifdef HAVE_SETRLIMIT
  8464   /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself.  */
  8465   if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
  8466     nofile_limit.rlim_cur = 0;
  8467   else if (FD_SETSIZE < nofile_limit.rlim_cur)
  8468     {
  8469       struct rlimit rlim = nofile_limit;
  8470       rlim.rlim_cur = FD_SETSIZE;
  8471       if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
  8472         nofile_limit.rlim_cur = 0;
  8473     }
  8474 #endif
  8475 
  8476   external_sock_fd = sockfd;
  8477   Lisp_Object sockname = Qnil;
  8478 # if HAVE_GETSOCKNAME
  8479   if (0 <= sockfd)
  8480     {
  8481       union u_sockaddr sa;
  8482       socklen_t salen = sizeof sa;
  8483       if (getsockname (sockfd, &sa.sa, &salen) == 0)
  8484         sockname = conv_sockaddr_to_lisp (&sa.sa, salen);
  8485     }
  8486 # endif
  8487   Vinternal__daemon_sockname = sockname;
  8488 
  8489   max_desc = -1;
  8490   memset (fd_callback_info, 0, sizeof (fd_callback_info));
  8491 
  8492   num_pending_connects = 0;
  8493 
  8494   process_output_delay_count = 0;
  8495   process_output_skip = 0;
  8496 
  8497   /* Don't do this, it caused infinite select loops.  The display
  8498      method should call add_keyboard_wait_descriptor on stdin if it
  8499      needs that.  */
  8500 #if 0
  8501   FD_SET (0, &input_wait_mask);
  8502 #endif
  8503 
  8504   Vprocess_alist = Qnil;
  8505   deleted_pid_list = Qnil;
  8506   for (i = 0; i < FD_SETSIZE; i++)
  8507     {
  8508       chan_process[i] = Qnil;
  8509       proc_buffered_char[i] = -1;
  8510     }
  8511   memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
  8512   memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
  8513 #ifdef DATAGRAM_SOCKETS
  8514   memset (datagram_address, 0, sizeof datagram_address);
  8515 #endif
  8516 
  8517 #endif  /* subprocesses */
  8518   kbd_is_on_hold = 0;
  8519 }
  8520 
  8521 void
  8522 syms_of_process (void)
  8523 {
  8524   DEFSYM (Qmake_process, "make-process");
  8525   DEFSYM (Qlist_system_processes, "list-system-processes");
  8526   DEFSYM (Qprocess_attributes, "process-attributes");
  8527 
  8528 #ifdef subprocesses
  8529 
  8530   DEFSYM (Qprocessp, "processp");
  8531   DEFSYM (Qrun, "run");
  8532   DEFSYM (Qstop, "stop");
  8533   DEFSYM (Qsignal, "signal");
  8534 
  8535   /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
  8536      here again.  */
  8537 
  8538   DEFSYM (Qopen, "open");
  8539   DEFSYM (Qclosed, "closed");
  8540   DEFSYM (Qconnect, "connect");
  8541   DEFSYM (Qfailed, "failed");
  8542   DEFSYM (Qlisten, "listen");
  8543   DEFSYM (Qlocal, "local");
  8544   DEFSYM (Qipv4, "ipv4");
  8545 #ifdef AF_INET6
  8546   DEFSYM (Qipv6, "ipv6");
  8547 #endif
  8548   DEFSYM (Qnumeric, "numeric");
  8549   DEFSYM (Qdatagram, "datagram");
  8550   DEFSYM (Qseqpacket, "seqpacket");
  8551 
  8552   DEFSYM (QCport, ":port");
  8553   DEFSYM (QCspeed, ":speed");
  8554   DEFSYM (QCprocess, ":process");
  8555 
  8556   DEFSYM (QCbytesize, ":bytesize");
  8557   DEFSYM (QCstopbits, ":stopbits");
  8558   DEFSYM (QCparity, ":parity");
  8559   DEFSYM (Qodd, "odd");
  8560   DEFSYM (Qeven, "even");
  8561   DEFSYM (QCflowcontrol, ":flowcontrol");
  8562   DEFSYM (Qhw, "hw");
  8563   DEFSYM (Qsw, "sw");
  8564   DEFSYM (QCsummary, ":summary");
  8565 
  8566   DEFSYM (Qreal, "real");
  8567   DEFSYM (Qnetwork, "network");
  8568   DEFSYM (Qserial, "serial");
  8569   DEFSYM (QCfile_handler, ":file-handler");
  8570   DEFSYM (QCbuffer, ":buffer");
  8571   DEFSYM (QChost, ":host");
  8572   DEFSYM (QCservice, ":service");
  8573   DEFSYM (QClocal, ":local");
  8574   DEFSYM (QCremote, ":remote");
  8575   DEFSYM (QCcoding, ":coding");
  8576   DEFSYM (QCserver, ":server");
  8577   DEFSYM (QCnowait, ":nowait");
  8578   DEFSYM (QCsentinel, ":sentinel");
  8579   DEFSYM (QCuse_external_socket, ":use-external-socket");
  8580   DEFSYM (QCtls_parameters, ":tls-parameters");
  8581   DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
  8582   DEFSYM (QClog, ":log");
  8583   DEFSYM (QCnoquery, ":noquery");
  8584   DEFSYM (QCstop, ":stop");
  8585   DEFSYM (QCplist, ":plist");
  8586   DEFSYM (QCcommand, ":command");
  8587   DEFSYM (QCconnection_type, ":connection-type");
  8588   DEFSYM (QCstderr, ":stderr");
  8589   DEFSYM (Qpty, "pty");
  8590   DEFSYM (Qpipe, "pipe");
  8591 
  8592   DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
  8593 
  8594   staticpro (&Vprocess_alist);
  8595   staticpro (&deleted_pid_list);
  8596 
  8597 #endif  /* subprocesses */
  8598 
  8599   DEFSYM (QCname, ":name");
  8600   DEFSYM (QCtype, ":type");
  8601 
  8602   DEFSYM (Qeuid, "euid");
  8603   DEFSYM (Qegid, "egid");
  8604   DEFSYM (Quser, "user");
  8605   DEFSYM (Qgroup, "group");
  8606   DEFSYM (Qcomm, "comm");
  8607   DEFSYM (Qstate, "state");
  8608   DEFSYM (Qppid, "ppid");
  8609   DEFSYM (Qpgrp, "pgrp");
  8610   DEFSYM (Qsess, "sess");
  8611   DEFSYM (Qttname, "ttname");
  8612   DEFSYM (Qtpgid, "tpgid");
  8613   DEFSYM (Qminflt, "minflt");
  8614   DEFSYM (Qmajflt, "majflt");
  8615   DEFSYM (Qcminflt, "cminflt");
  8616   DEFSYM (Qcmajflt, "cmajflt");
  8617   DEFSYM (Qutime, "utime");
  8618   DEFSYM (Qstime, "stime");
  8619   DEFSYM (Qtime, "time");
  8620   DEFSYM (Qcutime, "cutime");
  8621   DEFSYM (Qcstime, "cstime");
  8622   DEFSYM (Qctime, "ctime");
  8623 #ifdef subprocesses
  8624   DEFSYM (Qinternal_default_process_sentinel,
  8625           "internal-default-process-sentinel");
  8626   DEFSYM (Qinternal_default_process_filter,
  8627           "internal-default-process-filter");
  8628 #endif
  8629   DEFSYM (Qpri, "pri");
  8630   DEFSYM (Qnice, "nice");
  8631   DEFSYM (Qthcount, "thcount");
  8632   DEFSYM (Qstart, "start");
  8633   DEFSYM (Qvsize, "vsize");
  8634   DEFSYM (Qrss, "rss");
  8635   DEFSYM (Qetime, "etime");
  8636   DEFSYM (Qpcpu, "pcpu");
  8637   DEFSYM (Qpmem, "pmem");
  8638   DEFSYM (Qargs, "args");
  8639   DEFSYM (Qall, "all");
  8640   DEFSYM (Qcurrent, "current");
  8641 
  8642   DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
  8643                doc: /* Non-nil means delete processes immediately when they exit.
  8644 A value of nil means don't delete them until `list-processes' is run.  */);
  8645 
  8646   delete_exited_processes = 1;
  8647 
  8648 #ifdef subprocesses
  8649   DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
  8650                doc: /* Control type of device used to communicate with subprocesses.
  8651 Values are nil to use a pipe, or t or `pty' to use a pty.
  8652 The value has no effect if the system has no ptys or if all ptys are busy:
  8653 then a pipe is used in any case.
  8654 The value takes effect when `start-process' is called.  */);
  8655   Vprocess_connection_type = Qt;
  8656 
  8657   DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
  8658                doc: /* If non-nil, improve receive buffering by delaying after short reads.
  8659 On some systems, when Emacs reads the output from a subprocess, the output data
  8660 is read in very small blocks, potentially resulting in very poor performance.
  8661 This behavior can be remedied to some extent by setting this variable to a
  8662 non-nil value, as it will automatically delay reading from such processes, to
  8663 allow them to produce more output before Emacs tries to read it.
  8664 If the value is t, the delay is reset after each write to the process; any other
  8665 non-nil value means that the delay is not reset on write.
  8666 The variable takes effect when `start-process' is called.  */);
  8667   Vprocess_adaptive_read_buffering = Qt;
  8668 
  8669   DEFVAR_BOOL ("process-prioritize-lower-fds", process_prioritize_lower_fds,
  8670                doc: /* Whether to start checking for subprocess output from first file descriptor.
  8671 Emacs loops through file descriptors to check for output from subprocesses.
  8672 If this variable is nil, the default, then after accepting output from a
  8673 subprocess, Emacs will continue checking the rest of descriptors, starting
  8674 from the one following the descriptor it just read.  If this variable is
  8675 non-nil, Emacs will always restart the loop from the first file descriptor,
  8676 thus favoring processes with lower descriptors.  */);
  8677   process_prioritize_lower_fds = 0;
  8678 
  8679   DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
  8680                doc: /* List of functions to be called for `interrupt-process'.
  8681 The arguments of the functions are the same as for `interrupt-process'.
  8682 These functions are called in the order of the list, until one of them
  8683 returns non-nil.  */);
  8684   Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
  8685 
  8686   DEFVAR_LISP ("signal-process-functions", Vsignal_process_functions,
  8687                doc: /* List of functions to be called for `signal-process'.
  8688 The arguments of the functions are the same as for `signal-process'.
  8689 These functions are called in the order of the list, until one of them
  8690 returns non-nil.  */);
  8691   Vsignal_process_functions = list1 (Qinternal_default_signal_process);
  8692 
  8693   DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname,
  8694                doc: /* Name of external socket passed to Emacs, or nil if none.  */);
  8695   Vinternal__daemon_sockname = Qnil;
  8696 
  8697   DEFVAR_INT ("read-process-output-max", read_process_output_max,
  8698               doc: /* Maximum number of bytes to read from subprocess in a single chunk.
  8699 Enlarge the value only if the subprocess generates very large (megabytes)
  8700 amounts of data in one go.
  8701 
  8702 On GNU/Linux systems, the value should not exceed
  8703 /proc/sys/fs/pipe-max-size.  See pipe(7) manpage for details.  */);
  8704   read_process_output_max = 4096;
  8705 
  8706   DEFVAR_INT ("process-error-pause-time", process_error_pause_time,
  8707               doc: /* The number of seconds to pause after handling process errors.
  8708 This isn't used for all process-related errors, but is used when a
  8709 sentinel or a process filter function has an error.  */);
  8710   process_error_pause_time = 1;
  8711 
  8712   DEFSYM (Qinternal_default_interrupt_process,
  8713           "internal-default-interrupt-process");
  8714   DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
  8715 
  8716   DEFSYM (Qinternal_default_signal_process,
  8717           "internal-default-signal-process");
  8718   DEFSYM (Qsignal_process_functions, "signal-process-functions");
  8719 
  8720   DEFSYM (Qnull, "null");
  8721   DEFSYM (Qpipe_process_p, "pipe-process-p");
  8722   DEFSYM (Qmessage, "message");
  8723 
  8724   defsubr (&Sprocessp);
  8725   defsubr (&Sget_process);
  8726   defsubr (&Sdelete_process);
  8727   defsubr (&Sprocess_status);
  8728   defsubr (&Sprocess_exit_status);
  8729   defsubr (&Sprocess_id);
  8730   defsubr (&Sprocess_name);
  8731   defsubr (&Sprocess_tty_name);
  8732   defsubr (&Sprocess_command);
  8733   defsubr (&Sset_process_buffer);
  8734   defsubr (&Sprocess_buffer);
  8735   defsubr (&Sprocess_mark);
  8736   defsubr (&Sset_process_filter);
  8737   defsubr (&Sprocess_filter);
  8738   defsubr (&Sset_process_sentinel);
  8739   defsubr (&Sprocess_sentinel);
  8740   defsubr (&Sset_process_thread);
  8741   defsubr (&Sprocess_thread);
  8742   defsubr (&Sset_process_window_size);
  8743   defsubr (&Sset_process_inherit_coding_system_flag);
  8744   defsubr (&Sset_process_query_on_exit_flag);
  8745   defsubr (&Sprocess_query_on_exit_flag);
  8746   defsubr (&Sprocess_contact);
  8747   defsubr (&Sprocess_plist);
  8748   defsubr (&Sset_process_plist);
  8749   defsubr (&Sprocess_list);
  8750   defsubr (&Smake_process);
  8751   defsubr (&Smake_pipe_process);
  8752   defsubr (&Sserial_process_configure);
  8753   defsubr (&Smake_serial_process);
  8754   defsubr (&Sset_network_process_option);
  8755   defsubr (&Smake_network_process);
  8756   defsubr (&Sformat_network_address);
  8757   defsubr (&Snetwork_lookup_address_info);
  8758   defsubr (&Snetwork_interface_list);
  8759   defsubr (&Snetwork_interface_info);
  8760 #ifdef DATAGRAM_SOCKETS
  8761   defsubr (&Sprocess_datagram_address);
  8762   defsubr (&Sset_process_datagram_address);
  8763 #endif
  8764   defsubr (&Saccept_process_output);
  8765   defsubr (&Sprocess_send_region);
  8766   defsubr (&Sprocess_send_string);
  8767   defsubr (&Sinternal_default_interrupt_process);
  8768   defsubr (&Sinterrupt_process);
  8769   defsubr (&Skill_process);
  8770   defsubr (&Squit_process);
  8771   defsubr (&Sstop_process);
  8772   defsubr (&Scontinue_process);
  8773   defsubr (&Sprocess_running_child_p);
  8774   defsubr (&Sprocess_send_eof);
  8775   defsubr (&Sinternal_default_signal_process);
  8776   defsubr (&Ssignal_process);
  8777   defsubr (&Swaiting_for_user_input_p);
  8778   defsubr (&Sprocess_type);
  8779   defsubr (&Sinternal_default_process_sentinel);
  8780   defsubr (&Sinternal_default_process_filter);
  8781   defsubr (&Sset_process_coding_system);
  8782   defsubr (&Sprocess_coding_system);
  8783 
  8784  {
  8785    Lisp_Object subfeatures = Qnil;
  8786    const struct socket_options *sopt;
  8787 
  8788 #define ADD_SUBFEATURE(key, val) \
  8789   subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
  8790 
  8791    ADD_SUBFEATURE (QCnowait, Qt);
  8792 #ifdef DATAGRAM_SOCKETS
  8793    ADD_SUBFEATURE (QCtype, Qdatagram);
  8794 #endif
  8795 #ifdef HAVE_SEQPACKET
  8796    ADD_SUBFEATURE (QCtype, Qseqpacket);
  8797 #endif
  8798 #ifdef HAVE_LOCAL_SOCKETS
  8799    ADD_SUBFEATURE (QCfamily, Qlocal);
  8800 #endif
  8801    ADD_SUBFEATURE (QCfamily, Qipv4);
  8802 #ifdef AF_INET6
  8803    ADD_SUBFEATURE (QCfamily, Qipv6);
  8804 #endif
  8805 #ifdef HAVE_GETSOCKNAME
  8806    ADD_SUBFEATURE (QCservice, Qt);
  8807 #endif
  8808    ADD_SUBFEATURE (QCserver, Qt);
  8809 
  8810    for (sopt = socket_options; sopt->name; sopt++)
  8811      subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
  8812 
  8813    Fprovide (intern_c_string ("make-network-process"), subfeatures);
  8814  }
  8815 
  8816 #endif  /* subprocesses */
  8817 
  8818   defsubr (&Sget_buffer_process);
  8819   defsubr (&Sprocess_inherit_coding_system_flag);
  8820   defsubr (&Slist_system_processes);
  8821   defsubr (&Sprocess_attributes);
  8822   defsubr (&Snum_processors);
  8823   defsubr (&Ssignal_names);
  8824 }