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