This source file includes following definitions.
- would_block
- close_on_exec
- accept4
- process_socket
- pset_buffer
- pset_command
- pset_decode_coding_system
- pset_decoding_buf
- pset_encode_coding_system
- pset_encoding_buf
- pset_filter
- pset_log
- pset_mark
- pset_thread
- pset_name
- pset_plist
- pset_sentinel
- pset_tty_name
- pset_type
- pset_write_queue
- pset_stderrproc
- make_lisp_proc
- add_read_fd
- add_non_keyboard_read_fd
- add_process_read_fd
- delete_read_fd
- add_write_fd
- add_non_blocking_write_fd
- recompute_max_desc
- delete_write_fd
- compute_input_wait_mask
- compute_non_process_wait_mask
- compute_non_keyboard_wait_mask
- compute_write_mask
- clear_waiting_thread_info
- kbd_is_ours
- update_status
- status_convert
- connecting_status
- decode_status
- status_message
- allocate_pty
- allocate_process
- make_process
- remove_process
- update_processes_for_thread_death
- free_dns_request
- DEFUN
- DEFUN
- get_process
- record_deleted_pid
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- update_process_mark
- DEFUN
- DEFUN
- set_process_filter_masks
- is_pty_from_symbol
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- start_process_unwind
- close_process_fd
- dissociate_controlling_tty
- create_process
- create_pty
- conv_sockaddr_to_lisp
- conv_addrinfo_to_lisp
- get_lisp_to_sockaddr_size
- conv_lisp_to_sockaddr
- DEFUN
- set_socket_option
- set_network_socket_coding_system
- finish_after_tls_connection
- connect_network_socket
- network_interface_list
- network_interface_info
- DEFUN
- network_lookup_address_info_1
- deactivate_process
- server_accept_connection
- check_for_dns
- wait_for_socket_fds
- wait_while_connecting
- wait_for_tls_negotiation
- wait_reading_process_output_unwind
- wait_reading_process_output_1
- wait_reading_process_output
- read_process_output_call
- read_process_output_error_handler
- read_process_output
- read_and_dispose_of_process_output
- write_queue_push
- write_queue_pop
- send_process
- emacs_get_tty_pgrp
- DEFUN
- process_send_signal
- abbr_to_signal
- DEFUN
- child_signal_init
- child_signal_read
- child_signal_notify
- dummy_handler
- handle_child_signal
- deliver_child_signal
- exec_sentinel_error_handler
- exec_sentinel
- status_notify
- DEFUN
- add_gpm_wait_descriptor
- delete_gpm_wait_descriptor
- keyboard_bit_set
- update_processes_for_thread_death
- wait_reading_process_output
- add_timer_wait_descriptor
- remove_slash_colon
- add_keyboard_wait_descriptor
- delete_keyboard_wait_descriptor
- setup_process_coding_systems
- DEFUN
- DEFUN
- kill_buffer_processes
- DEFUN
- hold_keyboard_input
- unhold_keyboard_input
- kbd_on_hold_p
- DEFUN
- DEFUN
- DEFUN
- DEFUN
- catch_child_signal
- restore_nofile_limit
- open_channel_for_module
- init_process_emacs
- syms_of_process
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 #include <config.h>
23
24 #include <stdio.h>
25 #include <stdlib.h>
26 #include <errno.h>
27 #include <sys/types.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
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
52
53
54 static struct rlimit nofile_limit;
55 #endif
56
57 #ifdef subprocesses
58
59
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
74
75 #if defined (HAVE_IFADDRS_H)
76
77 #include <ifaddrs.h>
78
79
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
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
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
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
149
150
151 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
152 # pragma GCC diagnostic ignored "-Wstrict-overflow"
153 #endif
154
155
156
157 static bool kbd_is_on_hold;
158
159
160
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
184
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
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
233 static EMACS_INT process_tick;
234
235 static EMACS_INT update_tick;
236
237
238
239
240
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
259
260
261 static int process_output_delay_count;
262
263
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
283 static int num_pending_connects;
284
285
286 static int max_desc;
287
288
289
290
291
292 static int external_sock_fd;
293
294
295 static int child_signal_read_fd = -1;
296
297
298
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
306 static Lisp_Object chan_process[FD_SETSIZE];
307 static void wait_for_socket_fds (Lisp_Object, char const *);
308
309
310 static Lisp_Object Vprocess_alist;
311
312
313
314
315
316
317
318 static int proc_buffered_char[FD_SETSIZE];
319
320
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
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
340
341
342 #define FOR_EACH_PROCESS(list_var, proc_var) \
343 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
344
345
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
442 FOR_READ = 1,
443
444 FOR_WRITE = 2,
445
446
447 KEYBOARD_FD = 4,
448
449 PROCESS_FD = 8,
450
451 NON_BLOCKING_CONNECT_FD = 16
452 };
453
454 static struct fd_callback_data
455 {
456 fd_callback func;
457 void *data;
458
459 int flags;
460
461
462
463 struct thread_state *thread;
464
465
466 struct thread_state *waiting_thread;
467 } fd_callback_info[FD_SETSIZE];
468
469
470
471
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
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
520
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
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
693
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
710
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
723
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
740
741 static bool
742 connecting_status (Lisp_Object status)
743 {
744 return CONSP (status) && EQ (XCAR (status), Qconnect);
745 }
746
747
748
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
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
835
836
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
857
858 #ifdef PTY_OPEN
859 PTY_OPEN;
860 #else
861 fd = emacs_open (pty_name, O_RDWR | O_NONBLOCK, 0);
862 #endif
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
871
872
873
874
875
876
877
878
879
880 fcntl (fd, F_SETFD, FD_CLOEXEC);
881
882
883
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
895 return -1;
896 }
897
898
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
912
913 pset_status (p, Qrun);
914 pset_mark (p, Fmake_marker ());
915 pset_thread (p, Fcurrent_thread ());
916
917
918
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
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: )
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: )
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
1019
1020
1021
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
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
1059
1060
1061
1062
1063
1064
1065
1066
1067
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
1075 Fdelq (Qnil, deleted_pid_list));
1076
1077 }
1078
1079 DEFUN ("delete-process", Fdelete_process, Sdelete_process, 0, 1,
1080 "(list 'message)",
1081 doc:
1082
1083
1084
1085 )
1086 (register Lisp_Object process)
1087 {
1088 register struct Lisp_Process *p;
1089 bool mess = false;
1090
1091
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
1105
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
1136
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:
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169 )
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:
1204 )
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:
1217
1218
1219 )
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:
1231
1232 )
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:
1241
1242
1243
1244 )
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:
1253
1254
1255
1256
1257
1258
1259
1260 )
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:
1291 )
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:
1314 )
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: )
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
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:
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366 )
1367 (Lisp_Object process, Lisp_Object filter)
1368 {
1369 CHECK_PROCESS (process);
1370 struct Lisp_Process *p = XPROCESS (process);
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380 if (NILP (filter))
1381 filter = Qinternal_default_process_filter;
1382
1383 if (p->infd >= 0)
1384 {
1385
1386 if (EQ (filter, Qt) && !EQ (p->status, Qlisten))
1387 delete_read_fd (p->infd);
1388 else if (
1389 EQ (p->filter, Qt)
1390
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:
1406 )
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:
1416
1417 )
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:
1437 )
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:
1447 )
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:
1477 )
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:
1487
1488 )
1489 (Lisp_Object process, Lisp_Object height, Lisp_Object width)
1490 {
1491 CHECK_PROCESS (process);
1492
1493
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:
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523 )
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:
1535
1536
1537 )
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: )
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:
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569 )
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
1582
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
1605
1606
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: )
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: )
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
1634
1635 DEFUN ("process-connection", Fprocess_connection, Sprocess_connection, 1, 1, 0,
1636 doc:
1637
1638 )
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:
1647
1648
1649 )
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:
1660
1661
1662
1663
1664 )
1665 (Lisp_Object address, Lisp_Object omit_port)
1666 {
1667 if (NILP (address))
1668 return Qnil;
1669
1670 if (STRINGP (address))
1671 return address;
1672
1673 if (VECTORP (address))
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
1713 && i < 4
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: )
1734 (void)
1735 {
1736 return Fmapcar (Qcdr, Vprocess_alist);
1737 }
1738
1739
1740
1741
1742 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
1743 doc:
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801 )
1802 (ptrdiff_t nargs, Lisp_Object *args)
1803 {
1804 Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
1805 Lisp_Object xstderr, stderrproc;
1806 specpdl_ref count = SPECPDL_INDEX ();
1807
1808 if (nargs == 0)
1809 return Qnil;
1810
1811
1812 contact = Flist (nargs, args);
1813
1814 if (!NILP (plist_get (contact, QCfile_handler)))
1815 {
1816 Lisp_Object file_handler
1817 = Ffind_file_name_handler (BVAR (current_buffer, directory),
1818 Qmake_process);
1819 if (!NILP (file_handler))
1820 return CALLN (Fapply, file_handler, Qmake_process, contact);
1821 }
1822
1823 buffer = plist_get (contact, QCbuffer);
1824 if (!NILP (buffer))
1825 buffer = Fget_buffer_create (buffer, Qnil);
1826
1827
1828
1829
1830
1831 current_dir = get_current_directory (true);
1832
1833 name = plist_get (contact, QCname);
1834 CHECK_STRING (name);
1835
1836 command = plist_get (contact, QCcommand);
1837 if (CONSP (command))
1838 program = XCAR (command);
1839 else
1840 program = Qnil;
1841
1842 if (!NILP (program))
1843 CHECK_STRING (program);
1844
1845 bool query_on_exit = NILP (plist_get (contact, QCnoquery));
1846
1847 stderrproc = Qnil;
1848 xstderr = plist_get (contact, QCstderr);
1849 if (PROCESSP (xstderr))
1850 {
1851 if (!PIPECONN_P (xstderr))
1852 error ("Process is not a pipe process");
1853 stderrproc = xstderr;
1854 }
1855 else if (!NILP (xstderr))
1856 {
1857 CHECK_STRING (program);
1858 stderrproc = CALLN (Fmake_pipe_process,
1859 QCname,
1860 concat2 (name, build_string (" stderr")),
1861 QCbuffer,
1862 Fget_buffer_create (xstderr, Qnil),
1863 QCnoquery,
1864 query_on_exit ? Qnil : Qt);
1865 }
1866
1867 proc = make_process (name);
1868 record_unwind_protect (start_process_unwind, proc);
1869
1870 pset_childp (XPROCESS (proc), Qt);
1871 eassert (NILP (XPROCESS (proc)->plist));
1872 pset_type (XPROCESS (proc), Qreal);
1873 pset_buffer (XPROCESS (proc), buffer);
1874 pset_sentinel (XPROCESS (proc), plist_get (contact, QCsentinel));
1875 pset_filter (XPROCESS (proc), plist_get (contact, QCfilter));
1876 pset_command (XPROCESS (proc), Fcopy_sequence (command));
1877
1878 if (!query_on_exit)
1879 XPROCESS (proc)->kill_without_query = 1;
1880 tem = plist_get (contact, QCstop);
1881
1882
1883 CHECK_TYPE (NILP (tem), Qnull, tem);
1884
1885 tem = plist_get (contact, QCconnection_type);
1886 if (CONSP (tem))
1887 {
1888 XPROCESS (proc)->pty_in = is_pty_from_symbol (XCAR (tem));
1889 XPROCESS (proc)->pty_out = is_pty_from_symbol (XCDR (tem));
1890 }
1891 else
1892 {
1893 XPROCESS (proc)->pty_in = XPROCESS (proc)->pty_out =
1894 is_pty_from_symbol (tem);
1895 }
1896
1897 if (!NILP (stderrproc))
1898 pset_stderrproc (XPROCESS (proc), stderrproc);
1899
1900 #ifdef HAVE_GNUTLS
1901
1902 verify (GNUTLS_STAGE_EMPTY == 0);
1903 eassert (XPROCESS (proc)->gnutls_initstage == GNUTLS_STAGE_EMPTY);
1904 eassert (NILP (XPROCESS (proc)->gnutls_cred_type));
1905 #endif
1906
1907 XPROCESS (proc)->adaptive_read_buffering
1908 = (NILP (Vprocess_adaptive_read_buffering) ? 0
1909 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
1910
1911
1912 update_process_mark (XPROCESS (proc));
1913
1914 USE_SAFE_ALLOCA;
1915
1916 {
1917
1918
1919
1920
1921
1922 Lisp_Object coding_systems = Qt;
1923 Lisp_Object val, *args2;
1924
1925 tem = plist_get (contact, QCcoding);
1926 if (!NILP (tem))
1927 {
1928 val = tem;
1929 if (CONSP (val))
1930 val = XCAR (val);
1931 }
1932 else
1933 val = Vcoding_system_for_read;
1934 if (NILP (val))
1935 {
1936 ptrdiff_t nargs2 = 3 + list_length (command);
1937 Lisp_Object tem2;
1938 SAFE_ALLOCA_LISP (args2, nargs2);
1939 ptrdiff_t i = 0;
1940 args2[i++] = Qstart_process;
1941 args2[i++] = name;
1942 args2[i++] = buffer;
1943 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1944 args2[i++] = XCAR (tem2);
1945 if (!NILP (program))
1946 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1947 if (CONSP (coding_systems))
1948 val = XCAR (coding_systems);
1949 else if (CONSP (Vdefault_process_coding_system))
1950 val = XCAR (Vdefault_process_coding_system);
1951 }
1952 pset_decode_coding_system (XPROCESS (proc), val);
1953
1954 if (!NILP (tem))
1955 {
1956 val = tem;
1957 if (CONSP (val))
1958 val = XCDR (val);
1959 }
1960 else
1961 val = Vcoding_system_for_write;
1962 if (NILP (val))
1963 {
1964 if (EQ (coding_systems, Qt))
1965 {
1966 ptrdiff_t nargs2 = 3 + list_length (command);
1967 Lisp_Object tem2;
1968 SAFE_ALLOCA_LISP (args2, nargs2);
1969 ptrdiff_t i = 0;
1970 args2[i++] = Qstart_process;
1971 args2[i++] = name;
1972 args2[i++] = buffer;
1973 for (tem2 = command; CONSP (tem2); tem2 = XCDR (tem2))
1974 args2[i++] = XCAR (tem2);
1975 if (!NILP (program))
1976 coding_systems = Ffind_operation_coding_system (nargs2, args2);
1977 }
1978 if (CONSP (coding_systems))
1979 val = XCDR (coding_systems);
1980 else if (CONSP (Vdefault_process_coding_system))
1981 val = XCDR (Vdefault_process_coding_system);
1982 }
1983 pset_encode_coding_system (XPROCESS (proc), val);
1984
1985
1986
1987
1988
1989 }
1990
1991
1992 pset_decoding_buf (XPROCESS (proc), empty_unibyte_string);
1993 eassert (XPROCESS (proc)->decoding_carryover == 0);
1994 pset_encoding_buf (XPROCESS (proc), empty_unibyte_string);
1995
1996 XPROCESS (proc)->inherit_coding_system_flag
1997 = !(NILP (buffer) || !inherit_process_coding_system);
1998
1999 if (!NILP (program))
2000 {
2001 Lisp_Object program_args = XCDR (command);
2002
2003
2004
2005 if (!IS_DIRECTORY_SEP (SREF (program, 0))
2006 && !(SCHARS (program) > 1
2007 && IS_DEVICE_SEP (SREF (program, 1))))
2008 {
2009 tem = Qnil;
2010 openp (Vexec_path, program, Vexec_suffixes, &tem,
2011 make_fixnum (X_OK), false, false, NULL);
2012 if (NILP (tem))
2013 report_file_error ("Searching for program", program);
2014 tem = Fexpand_file_name (tem, Qnil);
2015 }
2016 else
2017 {
2018 if (!NILP (Ffile_directory_p (program)))
2019 error ("Specified program for new process is a directory");
2020 tem = program;
2021 }
2022
2023
2024 tem = remove_slash_colon (tem);
2025
2026 Lisp_Object arg_encoding = Qnil;
2027
2028
2029
2030 tem = list1 (ENCODE_FILE (tem));
2031 ptrdiff_t new_argc = 1;
2032
2033
2034
2035
2036
2037
2038 for (Lisp_Object tem2 = program_args; CONSP (tem2); tem2 = XCDR (tem2))
2039 {
2040 Lisp_Object arg = XCAR (tem2);
2041 CHECK_STRING (arg);
2042 if (STRING_MULTIBYTE (arg))
2043 {
2044 if (NILP (arg_encoding))
2045 arg_encoding = (complement_process_encoding_system
2046 (XPROCESS (proc)->encode_coding_system));
2047 arg = code_convert_string_norecord (arg, arg_encoding, 1);
2048 }
2049 tem = Fcons (arg, tem);
2050 new_argc++;
2051 }
2052
2053
2054
2055 char **new_argv;
2056 SAFE_NALLOCA (new_argv, 1, new_argc + 1);
2057 new_argv[new_argc] = 0;
2058
2059 for (ptrdiff_t i = new_argc - 1; i >= 0; i--)
2060 {
2061 new_argv[i] = SSDATA (XCAR (tem));
2062 tem = XCDR (tem);
2063 }
2064
2065 create_process (proc, new_argv, current_dir);
2066 }
2067 else
2068 create_pty (proc);
2069
2070 return SAFE_FREE_UNBIND_TO (count, proc);
2071 }
2072
2073
2074
2075 static void
2076 start_process_unwind (Lisp_Object proc)
2077 {
2078 if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
2079 remove_process (proc);
2080 }
2081
2082
2083
2084 static void
2085 close_process_fd (int *fd_addr)
2086 {
2087 int fd = *fd_addr;
2088 if (0 <= fd)
2089 {
2090 *fd_addr = -1;
2091 emacs_close (fd);
2092 }
2093 }
2094
2095 void
2096 dissociate_controlling_tty (void)
2097 {
2098 if (setsid () < 0)
2099 {
2100 #ifdef TIOCNOTTY
2101
2102
2103
2104
2105 int ttyfd = emacs_open (DEV_TTY, O_RDWR, 0);
2106 if (0 <= ttyfd)
2107 {
2108 ioctl (ttyfd, TIOCNOTTY, 0);
2109 emacs_close (ttyfd);
2110 }
2111 #endif
2112 }
2113 }
2114
2115
2116 enum
2117 {
2118
2119 SUBPROCESS_STDIN,
2120 WRITE_TO_SUBPROCESS,
2121
2122
2123 READ_FROM_SUBPROCESS,
2124 SUBPROCESS_STDOUT,
2125
2126
2127
2128 READ_FROM_EXEC_MONITOR,
2129 EXEC_MONITOR_OUTPUT
2130 };
2131
2132 verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1);
2133
2134 static void
2135 create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir)
2136 {
2137 struct Lisp_Process *p = XPROCESS (process);
2138 int inchannel = -1, outchannel = -1;
2139 pid_t pid = -1;
2140 int vfork_errno;
2141 int forkin, forkout, forkerr = -1;
2142 bool pty_in = false, pty_out = false;
2143 char pty_name[PTY_NAME_SIZE];
2144 Lisp_Object lisp_pty_name = Qnil;
2145 int ptychannel = -1, pty_tty = -1;
2146 sigset_t oldset;
2147
2148
2149
2150 child_signal_init ();
2151
2152 if (p->pty_in || p->pty_out)
2153 ptychannel = allocate_pty (pty_name);
2154
2155 if (ptychannel >= 0)
2156 {
2157 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2158
2159
2160
2161
2162 pty_tty = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2163 if (pty_tty < 0)
2164 report_file_error ("Opening pty", Qnil);
2165 #endif
2166 pty_in = p->pty_in;
2167 pty_out = p->pty_out;
2168 lisp_pty_name = build_string (pty_name);
2169 }
2170
2171
2172 if (ptychannel >= 0 && p->pty_in)
2173 {
2174 p->open_fd[SUBPROCESS_STDIN] = forkin = pty_tty;
2175 outchannel = ptychannel;
2176 }
2177 else
2178 {
2179 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0)
2180 report_file_error ("Creating pipe", Qnil);
2181 forkin = p->open_fd[SUBPROCESS_STDIN];
2182 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2183 }
2184
2185
2186 if (ptychannel >= 0 && p->pty_out)
2187 {
2188 forkout = pty_tty;
2189 p->open_fd[READ_FROM_SUBPROCESS] = inchannel = ptychannel;
2190 }
2191 else
2192 {
2193 if (emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2194 report_file_error ("Creating pipe", Qnil);
2195 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2196 forkout = p->open_fd[SUBPROCESS_STDOUT];
2197
2198 #if defined(GNU_LINUX) && defined(F_SETPIPE_SZ)
2199 fcntl (inchannel, F_SETPIPE_SZ, read_process_output_max);
2200 #endif
2201 }
2202
2203 if (!NILP (p->stderrproc))
2204 {
2205 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2206
2207 forkerr = pp->open_fd[SUBPROCESS_STDOUT];
2208
2209
2210 close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]);
2211 close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]);
2212 }
2213
2214 if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
2215 report_file_errno ("Creating pipe", Qnil, EMFILE);
2216
2217 #ifndef WINDOWSNT
2218 if (emacs_pipe (p->open_fd + READ_FROM_EXEC_MONITOR) != 0)
2219 report_file_error ("Creating pipe", Qnil);
2220 #endif
2221
2222 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2223 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2224
2225
2226 eassert (0 <= inchannel && inchannel < FD_SETSIZE);
2227 chan_process[inchannel] = process;
2228 p->infd = inchannel;
2229 p->outfd = outchannel;
2230
2231
2232
2233
2234
2235
2236 p->pty_in = pty_in;
2237 p->pty_out = pty_out;
2238 pset_status (p, Qrun);
2239
2240 if (!EQ (p->command, Qt)
2241 && !EQ (p->filter, Qt))
2242 add_process_read_fd (inchannel);
2243
2244 specpdl_ref count = SPECPDL_INDEX ();
2245
2246
2247 setup_process_coding_systems (process);
2248 char **env = make_environment_block (current_dir);
2249
2250 block_input ();
2251 block_child_signal (&oldset);
2252
2253 pty_in = p->pty_in;
2254 pty_out = p->pty_out;
2255 eassert ((pty_in || pty_out) == ! NILP (lisp_pty_name));
2256
2257 vfork_errno
2258 = emacs_spawn (&pid, forkin, forkout, forkerr, new_argv, env,
2259 SSDATA (current_dir),
2260 pty_in || pty_out ? SSDATA (lisp_pty_name) : NULL,
2261 pty_in, pty_out, &oldset);
2262
2263 eassert ((vfork_errno == 0) == (0 < pid));
2264
2265 p->pid = pid;
2266 if (pid >= 0)
2267 p->alive = 1;
2268
2269
2270 unblock_child_signal (&oldset);
2271 unblock_input ();
2272
2273
2274 unbind_to (count, Qnil);
2275
2276 if (pid < 0)
2277 report_file_errno (CHILD_SETUP_ERROR_DESC, Qnil, vfork_errno);
2278 else
2279 {
2280
2281
2282
2283 close_process_fd (&p->open_fd[SUBPROCESS_STDIN]);
2284 close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]);
2285
2286 #ifdef WINDOWSNT
2287 register_child (pid, inchannel);
2288 #endif
2289
2290 pset_tty_name (p, lisp_pty_name);
2291
2292 #ifndef WINDOWSNT
2293
2294
2295
2296
2297
2298 {
2299 char dummy;
2300
2301 close_process_fd (&p->open_fd[EXEC_MONITOR_OUTPUT]);
2302 emacs_read (p->open_fd[READ_FROM_EXEC_MONITOR], &dummy, 1);
2303 close_process_fd (&p->open_fd[READ_FROM_EXEC_MONITOR]);
2304 }
2305 #endif
2306 if (!NILP (p->stderrproc))
2307 {
2308 struct Lisp_Process *pp = XPROCESS (p->stderrproc);
2309 close_process_fd (&pp->open_fd[SUBPROCESS_STDOUT]);
2310 }
2311 }
2312 }
2313
2314 static void
2315 create_pty (Lisp_Object process)
2316 {
2317 struct Lisp_Process *p = XPROCESS (process);
2318 char pty_name[PTY_NAME_SIZE];
2319 int pty_fd = !(p->pty_in || p->pty_out) ? -1 : allocate_pty (pty_name);
2320
2321 if (pty_fd >= 0)
2322 {
2323 p->open_fd[SUBPROCESS_STDIN] = pty_fd;
2324 if (FD_SETSIZE <= pty_fd)
2325 report_file_errno ("Opening pty", Qnil, EMFILE);
2326 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2327
2328
2329
2330
2331 int forkout = emacs_open (pty_name, O_RDWR | O_NOCTTY, 0);
2332 if (forkout < 0)
2333 report_file_error ("Opening pty", Qnil);
2334 p->open_fd[WRITE_TO_SUBPROCESS] = forkout;
2335 #if defined (DONT_REOPEN_PTY)
2336
2337
2338
2339 child_setup_tty (forkout);
2340 #endif
2341 #endif
2342
2343 fcntl (pty_fd, F_SETFL, O_NONBLOCK);
2344
2345
2346
2347 eassert (0 <= pty_fd && pty_fd < FD_SETSIZE);
2348 chan_process[pty_fd] = process;
2349 p->infd = pty_fd;
2350 p->outfd = pty_fd;
2351
2352
2353
2354
2355
2356
2357 p->pty_in = p->pty_out = true;
2358 pset_status (p, Qrun);
2359 setup_process_coding_systems (process);
2360
2361 if (!EQ (p->filter, Qt))
2362 add_process_read_fd (pty_fd);
2363
2364 pset_tty_name (p, build_string (pty_name));
2365 }
2366
2367 p->pid = -2;
2368 }
2369
2370 DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process,
2371 0, MANY, 0,
2372 doc:
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406 )
2407 (ptrdiff_t nargs, Lisp_Object *args)
2408 {
2409 Lisp_Object proc, contact;
2410 struct Lisp_Process *p;
2411 Lisp_Object name, buffer;
2412 Lisp_Object tem;
2413 int inchannel, outchannel;
2414
2415 if (nargs == 0)
2416 return Qnil;
2417
2418 contact = Flist (nargs, args);
2419
2420 name = plist_get (contact, QCname);
2421 CHECK_STRING (name);
2422 proc = make_process (name);
2423 specpdl_ref specpdl_count = SPECPDL_INDEX ();
2424 record_unwind_protect (remove_process, proc);
2425 p = XPROCESS (proc);
2426
2427 if (emacs_pipe (p->open_fd + SUBPROCESS_STDIN) != 0
2428 || emacs_pipe (p->open_fd + READ_FROM_SUBPROCESS) != 0)
2429 report_file_error ("Creating pipe", Qnil);
2430 outchannel = p->open_fd[WRITE_TO_SUBPROCESS];
2431 inchannel = p->open_fd[READ_FROM_SUBPROCESS];
2432
2433 if (FD_SETSIZE <= inchannel || FD_SETSIZE <= outchannel)
2434 report_file_errno ("Creating pipe", Qnil, EMFILE);
2435
2436 fcntl (inchannel, F_SETFL, O_NONBLOCK);
2437 fcntl (outchannel, F_SETFL, O_NONBLOCK);
2438
2439 #ifdef WINDOWSNT
2440 register_aux_fd (inchannel);
2441 #endif
2442
2443
2444 eassert (0 <= inchannel && inchannel < FD_SETSIZE);
2445 chan_process[inchannel] = proc;
2446 p->infd = inchannel;
2447 p->outfd = outchannel;
2448
2449 if (inchannel > max_desc)
2450 max_desc = inchannel;
2451
2452 buffer = plist_get (contact, QCbuffer);
2453 if (NILP (buffer))
2454 buffer = name;
2455 buffer = Fget_buffer_create (buffer, Qnil);
2456 pset_buffer (p, buffer);
2457
2458 pset_childp (p, contact);
2459 pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
2460 pset_type (p, Qpipe);
2461 pset_sentinel (p, plist_get (contact, QCsentinel));
2462 pset_filter (p, plist_get (contact, QCfilter));
2463 eassert (NILP (p->log));
2464 if (tem = plist_get (contact, QCnoquery), !NILP (tem))
2465 p->kill_without_query = 1;
2466 if (tem = plist_get (contact, QCstop), !NILP (tem))
2467 pset_command (p, Qt);
2468 eassert (! p->pty_in && ! p->pty_out);
2469
2470 if (!EQ (p->command, Qt)
2471 && !EQ (p->filter, Qt))
2472 add_process_read_fd (inchannel);
2473 p->adaptive_read_buffering
2474 = (NILP (Vprocess_adaptive_read_buffering) ? 0
2475 : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2);
2476
2477
2478 update_process_mark (p);
2479
2480 {
2481
2482
2483
2484 Lisp_Object coding_systems = Qt;
2485 Lisp_Object val;
2486
2487 tem = plist_get (contact, QCcoding);
2488 val = Qnil;
2489 if (!NILP (tem))
2490 {
2491 val = tem;
2492 if (CONSP (val))
2493 val = XCAR (val);
2494 }
2495 else if (!NILP (Vcoding_system_for_read))
2496 val = Vcoding_system_for_read;
2497 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
2498 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
2499
2500
2501
2502
2503 val = Qnil;
2504 else
2505 {
2506 if (CONSP (coding_systems))
2507 val = XCAR (coding_systems);
2508 else if (CONSP (Vdefault_process_coding_system))
2509 val = XCAR (Vdefault_process_coding_system);
2510 else
2511 val = Qnil;
2512 }
2513 pset_decode_coding_system (p, val);
2514
2515 if (!NILP (tem))
2516 {
2517 val = tem;
2518 if (CONSP (val))
2519 val = XCDR (val);
2520 }
2521 else if (!NILP (Vcoding_system_for_write))
2522 val = Vcoding_system_for_write;
2523 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
2524 val = Qnil;
2525 else
2526 {
2527 if (CONSP (coding_systems))
2528 val = XCDR (coding_systems);
2529 else if (CONSP (Vdefault_process_coding_system))
2530 val = XCDR (Vdefault_process_coding_system);
2531 else
2532 val = Qnil;
2533 }
2534 pset_encode_coding_system (p, val);
2535 }
2536
2537 setup_process_coding_systems (proc);
2538
2539 pset_decoding_buf (p, empty_unibyte_string);
2540 eassert (p->decoding_carryover == 0);
2541 pset_encoding_buf (p, empty_unibyte_string);
2542
2543 specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
2544
2545 return proc;
2546 }
2547
2548
2549
2550
2551
2552 Lisp_Object
2553 conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
2554 {
2555 Lisp_Object address;
2556 unsigned char *cp;
2557 struct Lisp_Vector *p;
2558
2559
2560
2561
2562 if (len < offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family))
2563 return empty_unibyte_string;
2564
2565 switch (sa->sa_family)
2566 {
2567 case AF_INET:
2568 {
2569 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2570 len = sizeof (sin->sin_addr) + 1;
2571 address = make_uninit_vector (len);
2572 p = XVECTOR (address);
2573 p->contents[--len] = make_fixnum (ntohs (sin->sin_port));
2574 cp = (unsigned char *) &sin->sin_addr;
2575 break;
2576 }
2577 #ifdef AF_INET6
2578 case AF_INET6:
2579 {
2580 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2581 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2582 len = sizeof (sin6->sin6_addr) / 2 + 1;
2583 address = make_uninit_vector (len);
2584 p = XVECTOR (address);
2585 p->contents[--len] = make_fixnum (ntohs (sin6->sin6_port));
2586 for (ptrdiff_t i = 0; i < len; i++)
2587 p->contents[i] = make_fixnum (ntohs (ip6[i]));
2588 return address;
2589 }
2590 #endif
2591 #ifdef HAVE_LOCAL_SOCKETS
2592 case AF_LOCAL:
2593 {
2594 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2595 ptrdiff_t name_length = len - offsetof (struct sockaddr_un, sun_path);
2596
2597
2598
2599
2600
2601 if (name_length > 0 && sockun->sun_path[0] != '\0')
2602 {
2603 const char *terminator
2604 = memchr (sockun->sun_path, '\0', name_length);
2605
2606 if (terminator)
2607 name_length = terminator - (const char *) sockun->sun_path;
2608 }
2609
2610 return make_unibyte_string (sockun->sun_path, name_length);
2611 }
2612 #endif
2613 default:
2614 len -= offsetof (struct sockaddr, sa_family) + sizeof (sa->sa_family);
2615 address = Fcons (make_fixnum (sa->sa_family), make_nil_vector (len));
2616 p = XVECTOR (XCDR (address));
2617 cp = (unsigned char *) &sa->sa_family + sizeof (sa->sa_family);
2618 break;
2619 }
2620
2621 for (ptrdiff_t i = 0; i < len; i++)
2622 p->contents[i] = make_fixnum (*cp++);
2623
2624 return address;
2625 }
2626
2627
2628
2629 static Lisp_Object
2630 conv_addrinfo_to_lisp (struct addrinfo *res)
2631 {
2632 Lisp_Object protocol = make_fixnum (res->ai_protocol);
2633 eassert (XFIXNUM (protocol) == res->ai_protocol);
2634 return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
2635 }
2636
2637
2638
2639
2640 static ptrdiff_t
2641 get_lisp_to_sockaddr_size (Lisp_Object address, int *familyp)
2642 {
2643 struct Lisp_Vector *p;
2644
2645 if (VECTORP (address))
2646 {
2647 p = XVECTOR (address);
2648 if (p->header.size == 5)
2649 {
2650 *familyp = AF_INET;
2651 return sizeof (struct sockaddr_in);
2652 }
2653 #ifdef AF_INET6
2654 else if (p->header.size == 9)
2655 {
2656 *familyp = AF_INET6;
2657 return sizeof (struct sockaddr_in6);
2658 }
2659 #endif
2660 }
2661 #ifdef HAVE_LOCAL_SOCKETS
2662 else if (STRINGP (address))
2663 {
2664 *familyp = AF_LOCAL;
2665 return sizeof (struct sockaddr_un);
2666 }
2667 #endif
2668 else if (CONSP (address) && TYPE_RANGED_FIXNUMP (int, XCAR (address))
2669 && VECTORP (XCDR (address)))
2670 {
2671 struct sockaddr *sa;
2672 p = XVECTOR (XCDR (address));
2673 if (MAX_ALLOCA - sizeof sa->sa_family < p->header.size)
2674 return 0;
2675 *familyp = XFIXNUM (XCAR (address));
2676 return p->header.size + sizeof (sa->sa_family);
2677 }
2678 return 0;
2679 }
2680
2681
2682
2683
2684
2685
2686
2687
2688 static void
2689 conv_lisp_to_sockaddr (int family, Lisp_Object address, struct sockaddr *sa, int len)
2690 {
2691 register struct Lisp_Vector *p;
2692 register unsigned char *cp = NULL;
2693 register int i;
2694 EMACS_INT hostport;
2695
2696 memset (sa, 0, len);
2697
2698 if (VECTORP (address))
2699 {
2700 p = XVECTOR (address);
2701 if (family == AF_INET)
2702 {
2703 DECLARE_POINTER_ALIAS (sin, struct sockaddr_in, sa);
2704 len = sizeof (sin->sin_addr) + 1;
2705 hostport = XFIXNUM (p->contents[--len]);
2706 sin->sin_port = htons (hostport);
2707 cp = (unsigned char *)&sin->sin_addr;
2708 sa->sa_family = family;
2709 }
2710 #ifdef AF_INET6
2711 else if (family == AF_INET6)
2712 {
2713 DECLARE_POINTER_ALIAS (sin6, struct sockaddr_in6, sa);
2714 DECLARE_POINTER_ALIAS (ip6, uint16_t, &sin6->sin6_addr);
2715 len = sizeof (sin6->sin6_addr) / 2 + 1;
2716 hostport = XFIXNUM (p->contents[--len]);
2717 sin6->sin6_port = htons (hostport);
2718 for (i = 0; i < len; i++)
2719 if (FIXNUMP (p->contents[i]))
2720 {
2721 int j = XFIXNUM (p->contents[i]) & 0xffff;
2722 ip6[i] = ntohs (j);
2723 }
2724 sa->sa_family = family;
2725 return;
2726 }
2727 #endif
2728 else
2729 return;
2730 }
2731 else if (STRINGP (address))
2732 {
2733 #ifdef HAVE_LOCAL_SOCKETS
2734 if (family == AF_LOCAL)
2735 {
2736 DECLARE_POINTER_ALIAS (sockun, struct sockaddr_un, sa);
2737 cp = SDATA (address);
2738 for (i = 0; i < sizeof (sockun->sun_path) && *cp; i++)
2739 sockun->sun_path[i] = *cp++;
2740 sa->sa_family = family;
2741 }
2742 #endif
2743 return;
2744 }
2745 else
2746 {
2747 p = XVECTOR (XCDR (address));
2748 cp = (unsigned char *)sa + sizeof (sa->sa_family);
2749 }
2750
2751 for (i = 0; i < len; i++)
2752 if (FIXNUMP (p->contents[i]))
2753 *cp++ = XFIXNAT (p->contents[i]) & 0xff;
2754 }
2755
2756 #ifdef DATAGRAM_SOCKETS
2757 DEFUN ("process-datagram-address", Fprocess_datagram_address, Sprocess_datagram_address,
2758 1, 1, 0,
2759 doc:
2760
2761 )
2762 (Lisp_Object process)
2763 {
2764 int channel;
2765
2766 CHECK_PROCESS (process);
2767
2768 if (NETCONN_P (process))
2769 wait_for_socket_fds (process, "process-datagram-address");
2770
2771 if (!DATAGRAM_CONN_P (process))
2772 return Qnil;
2773
2774 channel = XPROCESS (process)->infd;
2775 eassert (0 <= channel && channel < FD_SETSIZE);
2776 return conv_sockaddr_to_lisp (datagram_address[channel].sa,
2777 datagram_address[channel].len);
2778 }
2779
2780 DEFUN ("set-process-datagram-address", Fset_process_datagram_address, Sset_process_datagram_address,
2781 2, 2, 0,
2782 doc:
2783
2784
2785
2786 )
2787 (Lisp_Object process, Lisp_Object address)
2788 {
2789 int channel;
2790 int family;
2791 ptrdiff_t len;
2792
2793 CHECK_PROCESS (process);
2794
2795 if (NETCONN_P (process))
2796 wait_for_socket_fds (process, "set-process-datagram-address");
2797
2798 if (!DATAGRAM_CONN_P (process))
2799 return Qnil;
2800
2801 channel = XPROCESS (process)->infd;
2802
2803 len = get_lisp_to_sockaddr_size (address, &family);
2804 eassert (0 <= channel && channel < FD_SETSIZE);
2805 if (len == 0 || datagram_address[channel].len != len)
2806 return Qnil;
2807 conv_lisp_to_sockaddr (family, address, datagram_address[channel].sa, len);
2808 return address;
2809 }
2810 #endif
2811
2812
2813 static const struct socket_options {
2814
2815
2816 const char *name;
2817
2818 int optlevel;
2819
2820 int optnum;
2821 enum { SOPT_UNKNOWN, SOPT_BOOL, SOPT_INT, SOPT_IFNAME, SOPT_LINGER } opttype;
2822 enum { OPIX_NONE = 0, OPIX_MISC = 1, OPIX_REUSEADDR = 2 } optbit;
2823 } socket_options[] =
2824 {
2825 #ifdef SO_BINDTODEVICE
2826 { ":bindtodevice", SOL_SOCKET, SO_BINDTODEVICE, SOPT_IFNAME, OPIX_MISC },
2827 #endif
2828 #ifdef SO_BROADCAST
2829 { ":broadcast", SOL_SOCKET, SO_BROADCAST, SOPT_BOOL, OPIX_MISC },
2830 #endif
2831 #ifdef SO_DONTROUTE
2832 { ":dontroute", SOL_SOCKET, SO_DONTROUTE, SOPT_BOOL, OPIX_MISC },
2833 #endif
2834 #ifdef SO_KEEPALIVE
2835 { ":keepalive", SOL_SOCKET, SO_KEEPALIVE, SOPT_BOOL, OPIX_MISC },
2836 #endif
2837 #ifdef SO_LINGER
2838 { ":linger", SOL_SOCKET, SO_LINGER, SOPT_LINGER, OPIX_MISC },
2839 #endif
2840 #ifdef SO_OOBINLINE
2841 { ":oobinline", SOL_SOCKET, SO_OOBINLINE, SOPT_BOOL, OPIX_MISC },
2842 #endif
2843 #ifdef SO_PRIORITY
2844 { ":priority", SOL_SOCKET, SO_PRIORITY, SOPT_INT, OPIX_MISC },
2845 #endif
2846 #ifdef SO_REUSEADDR
2847 { ":reuseaddr", SOL_SOCKET, SO_REUSEADDR, SOPT_BOOL, OPIX_REUSEADDR },
2848 #endif
2849 { 0, 0, 0, SOPT_UNKNOWN, OPIX_NONE }
2850 };
2851
2852
2853
2854
2855
2856
2857
2858 static int
2859 set_socket_option (int s, Lisp_Object opt, Lisp_Object val)
2860 {
2861 char *name;
2862 const struct socket_options *sopt;
2863 int ret = 0;
2864
2865 CHECK_SYMBOL (opt);
2866
2867 name = SSDATA (SYMBOL_NAME (opt));
2868 for (sopt = socket_options; sopt->name; sopt++)
2869 if (strcmp (name, sopt->name) == 0)
2870 break;
2871
2872 switch (sopt->opttype)
2873 {
2874 case SOPT_BOOL:
2875 {
2876 int optval;
2877 optval = NILP (val) ? 0 : 1;
2878 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2879 &optval, sizeof (optval));
2880 break;
2881 }
2882
2883 case SOPT_INT:
2884 {
2885 int optval;
2886 if (TYPE_RANGED_FIXNUMP (int, val))
2887 optval = XFIXNUM (val);
2888 else
2889 error ("Bad option value for %s", name);
2890 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2891 &optval, sizeof (optval));
2892 break;
2893 }
2894
2895 #ifdef SO_BINDTODEVICE
2896 case SOPT_IFNAME:
2897 {
2898 char devname[IFNAMSIZ + 1];
2899
2900
2901
2902
2903 memset (devname, 0, sizeof devname);
2904 if (STRINGP (val))
2905 memcpy (devname, SDATA (val), min (SBYTES (val), IFNAMSIZ));
2906 else if (!NILP (val))
2907 error ("Bad option value for %s", name);
2908 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2909 devname, IFNAMSIZ);
2910 break;
2911 }
2912 #endif
2913
2914 #ifdef SO_LINGER
2915 case SOPT_LINGER:
2916 {
2917 struct linger linger;
2918
2919 linger.l_onoff = 1;
2920 linger.l_linger = 0;
2921 if (TYPE_RANGED_FIXNUMP (int, val))
2922 linger.l_linger = XFIXNUM (val);
2923 else
2924 linger.l_onoff = NILP (val) ? 0 : 1;
2925 ret = setsockopt (s, sopt->optlevel, sopt->optnum,
2926 &linger, sizeof (linger));
2927 break;
2928 }
2929 #endif
2930
2931 default:
2932 return 0;
2933 }
2934
2935 if (ret < 0)
2936 {
2937 int setsockopt_errno = errno;
2938 report_file_errno ("Cannot set network option", list2 (opt, val),
2939 setsockopt_errno);
2940 }
2941
2942 return (1 << sopt->optbit);
2943 }
2944
2945
2946 DEFUN ("set-network-process-option",
2947 Fset_network_process_option, Sset_network_process_option,
2948 3, 4, 0,
2949 doc:
2950
2951
2952
2953
2954
2955 )
2956 (Lisp_Object process, Lisp_Object option, Lisp_Object value, Lisp_Object no_error)
2957 {
2958 int s;
2959 struct Lisp_Process *p;
2960
2961 CHECK_PROCESS (process);
2962 p = XPROCESS (process);
2963 if (!NETCONN1_P (p))
2964 error ("Process is not a network process");
2965
2966 wait_for_socket_fds (process, "set-network-process-option");
2967
2968 s = p->infd;
2969 if (s < 0)
2970 error ("Process is not running");
2971
2972 if (set_socket_option (s, option, value))
2973 {
2974 pset_childp (p, plist_put (p->childp, option, value));
2975 return Qt;
2976 }
2977
2978 if (NILP (no_error))
2979 error ("Unknown or unsupported option");
2980
2981 return Qnil;
2982 }
2983
2984
2985 DEFUN ("serial-process-configure",
2986 Fserial_process_configure,
2987 Sserial_process_configure,
2988 0, MANY, 0,
2989 doc:
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043 )
3044 (ptrdiff_t nargs, Lisp_Object *args)
3045 {
3046 struct Lisp_Process *p;
3047 Lisp_Object contact = Qnil;
3048 Lisp_Object proc = Qnil;
3049
3050 contact = Flist (nargs, args);
3051
3052 proc = plist_get (contact, QCprocess);
3053 if (NILP (proc))
3054 proc = plist_get (contact, QCname);
3055 if (NILP (proc))
3056 proc = plist_get (contact, QCbuffer);
3057 if (NILP (proc))
3058 proc = plist_get (contact, QCport);
3059 proc = get_process (proc);
3060 p = XPROCESS (proc);
3061 if (!EQ (p->type, Qserial))
3062 error ("Not a serial process");
3063
3064 if (NILP (plist_get (p->childp, QCspeed)))
3065 return Qnil;
3066
3067 serial_configure (p, contact);
3068 return Qnil;
3069 }
3070
3071 DEFUN ("make-serial-process", Fmake_serial_process, Smake_serial_process,
3072 0, MANY, 0,
3073 doc:
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143 )
3144 (ptrdiff_t nargs, Lisp_Object *args)
3145 {
3146 int fd = -1;
3147 Lisp_Object proc, contact, port;
3148 struct Lisp_Process *p;
3149 Lisp_Object name, buffer;
3150 Lisp_Object tem, val;
3151
3152 if (nargs == 0)
3153 return Qnil;
3154
3155 contact = Flist (nargs, args);
3156
3157 port = plist_get (contact, QCport);
3158 if (NILP (port))
3159 error ("No port specified");
3160 CHECK_STRING (port);
3161
3162 if (NILP (plist_member (contact, QCspeed)))
3163 error (":speed not specified");
3164 if (!NILP (plist_get (contact, QCspeed)))
3165 CHECK_FIXNUM (plist_get (contact, QCspeed));
3166
3167 name = plist_get (contact, QCname);
3168 if (NILP (name))
3169 name = port;
3170 CHECK_STRING (name);
3171 proc = make_process (name);
3172 specpdl_ref specpdl_count = SPECPDL_INDEX ();
3173 record_unwind_protect (remove_process, proc);
3174 p = XPROCESS (proc);
3175
3176 fd = serial_open (port);
3177 p->open_fd[SUBPROCESS_STDIN] = fd;
3178 if (FD_SETSIZE <= fd)
3179 report_file_errno ("Opening serial port", port, EMFILE);
3180 p->infd = fd;
3181 p->outfd = fd;
3182 if (fd > max_desc)
3183 max_desc = fd;
3184 eassert (0 <= fd && fd < FD_SETSIZE);
3185 chan_process[fd] = proc;
3186
3187 buffer = plist_get (contact, QCbuffer);
3188 if (NILP (buffer))
3189 buffer = name;
3190 buffer = Fget_buffer_create (buffer, Qnil);
3191 pset_buffer (p, buffer);
3192
3193 pset_childp (p, contact);
3194 pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
3195 pset_type (p, Qserial);
3196 pset_sentinel (p, plist_get (contact, QCsentinel));
3197 pset_filter (p, plist_get (contact, QCfilter));
3198 eassert (NILP (p->log));
3199 if (tem = plist_get (contact, QCnoquery), !NILP (tem))
3200 p->kill_without_query = 1;
3201 if (tem = plist_get (contact, QCstop), !NILP (tem))
3202 pset_command (p, Qt);
3203 eassert (! p->pty_in && ! p->pty_out);
3204
3205 if (!EQ (p->command, Qt)
3206 && !EQ (p->filter, Qt))
3207 add_process_read_fd (fd);
3208
3209 update_process_mark (p);
3210
3211 tem = plist_get (contact, QCcoding);
3212
3213 val = Qnil;
3214 if (!NILP (tem))
3215 {
3216 val = tem;
3217 if (CONSP (val))
3218 val = XCAR (val);
3219 }
3220 else if (!NILP (Vcoding_system_for_read))
3221 val = Vcoding_system_for_read;
3222 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3223 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3224 val = Qnil;
3225 pset_decode_coding_system (p, val);
3226
3227 val = Qnil;
3228 if (!NILP (tem))
3229 {
3230 val = tem;
3231 if (CONSP (val))
3232 val = XCDR (val);
3233 }
3234 else if (!NILP (Vcoding_system_for_write))
3235 val = Vcoding_system_for_write;
3236 else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters)))
3237 || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3238 val = Qnil;
3239 pset_encode_coding_system (p, val);
3240
3241 setup_process_coding_systems (proc);
3242 pset_decoding_buf (p, empty_unibyte_string);
3243 eassert (p->decoding_carryover == 0);
3244 pset_encoding_buf (p, empty_unibyte_string);
3245 p->inherit_coding_system_flag
3246 = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system);
3247
3248 Fserial_process_configure (nargs, args);
3249
3250 specpdl_ptr = specpdl_ref_to_ptr (specpdl_count);
3251
3252 return proc;
3253 }
3254
3255 static void
3256 set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
3257 Lisp_Object service, Lisp_Object name)
3258 {
3259 Lisp_Object tem;
3260 struct Lisp_Process *p = XPROCESS (proc);
3261 Lisp_Object contact = p->childp;
3262 Lisp_Object coding_systems = Qt;
3263 Lisp_Object val;
3264
3265 tem = plist_get (contact, QCcoding);
3266
3267
3268
3269
3270 if (!NILP (tem))
3271 {
3272 val = tem;
3273 if (CONSP (val))
3274 val = XCAR (val);
3275 }
3276 else if (!NILP (Vcoding_system_for_read))
3277 val = Vcoding_system_for_read;
3278 else if ((!NILP (p->buffer)
3279 && NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
3280 || (NILP (p->buffer)
3281 && NILP (BVAR (&buffer_defaults, enable_multibyte_characters))))
3282
3283
3284
3285
3286 val = Qnil;
3287 else
3288 {
3289 if (NILP (host) || NILP (service))
3290 coding_systems = Qnil;
3291 else
3292 coding_systems = CALLN (Ffind_operation_coding_system,
3293 Qopen_network_stream, name, p->buffer,
3294 host, service);
3295 if (CONSP (coding_systems))
3296 val = XCAR (coding_systems);
3297 else if (CONSP (Vdefault_process_coding_system))
3298 val = XCAR (Vdefault_process_coding_system);
3299 else
3300 val = Qnil;
3301 }
3302 pset_decode_coding_system (p, val);
3303
3304 if (!NILP (tem))
3305 {
3306 val = tem;
3307 if (CONSP (val))
3308 val = XCDR (val);
3309 }
3310 else if (!NILP (Vcoding_system_for_write))
3311 val = Vcoding_system_for_write;
3312 else if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
3313 val = Qnil;
3314 else
3315 {
3316 if (EQ (coding_systems, Qt))
3317 {
3318 if (NILP (host) || NILP (service))
3319 coding_systems = Qnil;
3320 else
3321 coding_systems = CALLN (Ffind_operation_coding_system,
3322 Qopen_network_stream, name, p->buffer,
3323 host, service);
3324 }
3325 if (CONSP (coding_systems))
3326 val = XCDR (coding_systems);
3327 else if (CONSP (Vdefault_process_coding_system))
3328 val = XCDR (Vdefault_process_coding_system);
3329 else
3330 val = Qnil;
3331 }
3332 pset_encode_coding_system (p, val);
3333
3334 pset_decoding_buf (p, empty_unibyte_string);
3335 p->decoding_carryover = 0;
3336 pset_encoding_buf (p, empty_unibyte_string);
3337
3338 p->inherit_coding_system_flag
3339 = !(!NILP (tem) || NILP (p->buffer) || !inherit_process_coding_system);
3340 }
3341
3342 #ifdef HAVE_GNUTLS
3343 static void
3344 finish_after_tls_connection (Lisp_Object proc)
3345 {
3346 struct Lisp_Process *p = XPROCESS (proc);
3347 Lisp_Object contact = p->childp;
3348 Lisp_Object result = Qt;
3349
3350 if (!NILP (Ffboundp (Qnsm_verify_connection)))
3351 result = call3 (Qnsm_verify_connection,
3352 proc,
3353 plist_get (contact, QChost),
3354 plist_get (contact, QCservice));
3355
3356 eassert (p->outfd < FD_SETSIZE);
3357 if (NILP (result))
3358 {
3359 pset_status (p, list2 (Qfailed,
3360 build_string ("The Network Security Manager stopped the connections")));
3361 deactivate_process (proc);
3362 }
3363 else if (p->outfd < 0)
3364 {
3365
3366
3367
3368 pset_status (p, Qfailed);
3369 deactivate_process (proc);
3370 }
3371 else if ((fd_callback_info[p->outfd].flags & NON_BLOCKING_CONNECT_FD) == 0)
3372 {
3373
3374
3375
3376 pset_status (p, Qrun);
3377
3378
3379
3380 exec_sentinel (proc, build_string ("open\n"));
3381 }
3382 }
3383 #endif
3384
3385 static void
3386 connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
3387 Lisp_Object use_external_socket_p)
3388 {
3389 int s = -1, outch, inch;
3390 int xerrno = 0;
3391 int family;
3392 int ret;
3393 ptrdiff_t addrlen UNINIT;
3394 struct Lisp_Process *p = XPROCESS (proc);
3395 Lisp_Object contact = p->childp;
3396 int optbits = 0;
3397 int socket_to_use = -1;
3398
3399 if (!NILP (use_external_socket_p))
3400 {
3401 socket_to_use = external_sock_fd;
3402 eassert (socket_to_use < FD_SETSIZE);
3403
3404
3405 external_sock_fd = -1;
3406 }
3407
3408
3409 s = -1;
3410
3411 struct sockaddr *sa = NULL;
3412 specpdl_ref count = SPECPDL_INDEX ();
3413 record_unwind_protect_nothing ();
3414 specpdl_ref count1 = SPECPDL_INDEX ();
3415
3416 while (!NILP (addrinfos))
3417 {
3418 Lisp_Object addrinfo = XCAR (addrinfos);
3419 addrinfos = XCDR (addrinfos);
3420 int protocol = XFIXNUM (XCAR (addrinfo));
3421 Lisp_Object ip_address = XCDR (addrinfo);
3422
3423 #ifdef WINDOWSNT
3424 retry_connect:
3425 #endif
3426
3427 addrlen = get_lisp_to_sockaddr_size (ip_address, &family);
3428 sa = xrealloc (sa, addrlen);
3429 set_unwind_protect_ptr (count, xfree, sa);
3430 conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
3431
3432 s = socket_to_use;
3433 if (s < 0)
3434 {
3435 int socktype = p->socktype | SOCK_CLOEXEC;
3436 if (p->is_non_blocking_client)
3437 socktype |= SOCK_NONBLOCK;
3438 s = socket (family, socktype, protocol);
3439 if (s < 0)
3440 {
3441 xerrno = errno;
3442 continue;
3443 }
3444
3445 if (FD_SETSIZE <= s)
3446 {
3447 emacs_close (s);
3448 s = -1;
3449 xerrno = EMFILE;
3450 continue;
3451 }
3452 }
3453
3454 if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
3455 {
3456 ret = fcntl (s, F_SETFL, O_NONBLOCK);
3457 if (ret < 0)
3458 {
3459 xerrno = errno;
3460 emacs_close (s);
3461 s = -1;
3462 if (0 <= socket_to_use)
3463 break;
3464 continue;
3465 }
3466 }
3467
3468 #ifdef DATAGRAM_SOCKETS
3469 if (!p->is_server && p->socktype == SOCK_DGRAM)
3470 break;
3471 #endif
3472
3473
3474 record_unwind_protect_int (close_file_unwind, s);
3475
3476
3477
3478
3479 {
3480 Lisp_Object params = contact, key, val;
3481
3482 while (!NILP (params))
3483 {
3484 key = XCAR (params);
3485 params = XCDR (params);
3486 val = XCAR (params);
3487 params = XCDR (params);
3488 optbits |= set_socket_option (s, key, val);
3489 }
3490 }
3491
3492 if (p->is_server)
3493 {
3494
3495
3496
3497
3498 #ifdef HAVE_LOCAL_SOCKETS
3499 if (family != AF_LOCAL)
3500 #endif
3501 if (!(optbits & (1 << OPIX_REUSEADDR)))
3502 {
3503 int optval = 1;
3504 if (setsockopt (s, SOL_SOCKET, SO_REUSEADDR, &optval, sizeof optval))
3505 report_file_error ("Cannot set reuse option on server socket", Qnil);
3506 }
3507
3508
3509 if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
3510 report_file_error ("Cannot bind server socket", Qnil);
3511
3512 #ifdef HAVE_GETSOCKNAME
3513 if (p->port == 0
3514 #ifdef HAVE_LOCAL_SOCKETS
3515 && family != AF_LOCAL
3516 #endif
3517 )
3518 {
3519 struct sockaddr_in sa1;
3520 socklen_t len1 = sizeof (sa1);
3521 #ifdef AF_INET6
3522
3523
3524
3525
3526 struct sockaddr_in6 sa6;
3527 verify ((offsetof (struct sockaddr_in, sin_port)
3528 == offsetof (struct sockaddr_in6, sin6_port))
3529 && sizeof (sa1.sin_port) == sizeof (sa6.sin6_port));
3530 #endif
3531 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3532 if (getsockname (s, psa1, &len1) == 0)
3533 {
3534 Lisp_Object service = make_fixnum (ntohs (sa1.sin_port));
3535 contact = plist_put (contact, QCservice, service);
3536
3537
3538 DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
3539 psa->sin_port = sa1.sin_port;
3540 }
3541 }
3542 #endif
3543
3544 if (p->socktype != SOCK_DGRAM && listen (s, p->backlog))
3545 report_file_error ("Cannot listen on server socket", Qnil);
3546
3547 break;
3548 }
3549
3550 maybe_quit ();
3551
3552 ret = connect (s, sa, addrlen);
3553 xerrno = errno;
3554
3555 if (ret == 0 || xerrno == EISCONN)
3556 {
3557
3558 break;
3559 }
3560
3561 if (p->is_non_blocking_client && xerrno == EINPROGRESS)
3562 break;
3563
3564 #ifndef WINDOWSNT
3565 if (xerrno == EINTR)
3566 {
3567
3568
3569
3570 int sc;
3571 socklen_t len;
3572 fd_set fdset;
3573 retry_select:
3574 FD_ZERO (&fdset);
3575 FD_SET (s, &fdset);
3576 maybe_quit ();
3577 sc = pselect (s + 1, NULL, &fdset, NULL, NULL, NULL);
3578 if (sc == -1)
3579 {
3580 if (errno == EINTR)
3581 goto retry_select;
3582 else
3583 report_file_error ("Failed select", Qnil);
3584 }
3585 eassert (sc > 0);
3586
3587 len = sizeof xerrno;
3588 eassert (FD_ISSET (s, &fdset));
3589 if (getsockopt (s, SOL_SOCKET, SO_ERROR, &xerrno, &len) < 0)
3590 report_file_error ("Failed getsockopt", Qnil);
3591 if (xerrno == 0)
3592 break;
3593 if (NILP (addrinfos))
3594 report_file_errno ("Failed connect", Qnil, xerrno);
3595 }
3596 #endif
3597
3598
3599 specpdl_ptr = specpdl_ref_to_ptr (count1);
3600 emacs_close (s);
3601 s = -1;
3602 if (0 <= socket_to_use)
3603 break;
3604
3605 #ifdef WINDOWSNT
3606 if (xerrno == EINTR)
3607 goto retry_connect;
3608 #endif
3609 }
3610
3611 if (s >= 0)
3612 {
3613 #ifdef DATAGRAM_SOCKETS
3614 if (p->socktype == SOCK_DGRAM)
3615 {
3616 eassert (0 <= s && s < FD_SETSIZE);
3617 if (datagram_address[s].sa)
3618 emacs_abort ();
3619
3620 datagram_address[s].sa = xmalloc (addrlen);
3621 datagram_address[s].len = addrlen;
3622 if (p->is_server)
3623 {
3624 Lisp_Object remote;
3625 memset (datagram_address[s].sa, 0, addrlen);
3626 if (remote = plist_get (contact, QCremote), !NILP (remote))
3627 {
3628 int rfamily;
3629 ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
3630 if (rlen != 0 && rfamily == family
3631 && rlen == addrlen)
3632 conv_lisp_to_sockaddr (rfamily, remote,
3633 datagram_address[s].sa, rlen);
3634 }
3635 }
3636 else
3637 memcpy (datagram_address[s].sa, sa, addrlen);
3638 }
3639 #endif
3640
3641 contact = plist_put (contact, p->is_server? QClocal: QCremote,
3642 conv_sockaddr_to_lisp (sa, addrlen));
3643 #ifdef HAVE_GETSOCKNAME
3644 if (!p->is_server)
3645 {
3646 struct sockaddr_storage sa1;
3647 socklen_t len1 = sizeof (sa1);
3648 DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
3649 if (getsockname (s, psa1, &len1) == 0)
3650 contact = plist_put (contact, QClocal,
3651 conv_sockaddr_to_lisp (psa1, len1));
3652 }
3653 #endif
3654 }
3655
3656 if (s < 0)
3657 {
3658 const char *err = (p->is_server
3659 ? "make server process failed"
3660 : "make client process failed");
3661
3662
3663
3664
3665
3666 if (p->is_non_blocking_client)
3667 {
3668 Lisp_Object data = get_file_errno_data (err, contact, xerrno);
3669
3670 pset_status (p, list2 (Qfailed, data));
3671 unbind_to (count, Qnil);
3672 return;
3673 }
3674
3675 report_file_errno (err, contact, xerrno);
3676 }
3677
3678 inch = s;
3679 outch = s;
3680
3681 eassert (0 <= inch && inch < FD_SETSIZE);
3682 chan_process[inch] = proc;
3683
3684 fcntl (inch, F_SETFL, O_NONBLOCK);
3685
3686 p = XPROCESS (proc);
3687 p->open_fd[SUBPROCESS_STDIN] = inch;
3688 p->infd = inch;
3689 p->outfd = outch;
3690
3691
3692 specpdl_ptr = specpdl_ref_to_ptr (count1);
3693
3694 if (p->is_server && p->socktype != SOCK_DGRAM)
3695 pset_status (p, Qlisten);
3696
3697
3698 update_process_mark (p);
3699
3700 if (p->is_non_blocking_client)
3701 {
3702
3703
3704
3705 if (! (connecting_status (p->status)
3706 && EQ (XCDR (p->status), addrinfos)))
3707 pset_status (p, Fcons (Qconnect, addrinfos));
3708 eassert (0 <= inch && inch < FD_SETSIZE);
3709 if ((fd_callback_info[inch].flags & NON_BLOCKING_CONNECT_FD) == 0)
3710 add_non_blocking_write_fd (inch);
3711 }
3712 else
3713
3714
3715 if ((!EQ (p->filter, Qt) && !EQ (p->command, Qt))
3716 || (EQ (p->status, Qlisten) && NILP (p->command)))
3717 add_process_read_fd (inch);
3718
3719 if (inch > max_desc)
3720 max_desc = inch;
3721
3722
3723 set_process_filter_masks (p);
3724
3725 setup_process_coding_systems (proc);
3726
3727 #ifdef HAVE_GNUTLS
3728
3729 if (!NILP (p->gnutls_boot_parameters))
3730 {
3731 Lisp_Object boot, params = p->gnutls_boot_parameters;
3732
3733 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3734
3735 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
3736 {
3737 p->gnutls_boot_parameters = Qnil;
3738
3739 finish_after_tls_connection (proc);
3740 }
3741 else if (p->gnutls_initstage != GNUTLS_STAGE_HANDSHAKE_TRIED)
3742 {
3743 deactivate_process (proc);
3744 if (NILP (boot))
3745 pset_status (p, list2 (Qfailed,
3746 build_string ("TLS negotiation failed")));
3747 else
3748 pset_status (p, list2 (Qfailed, boot));
3749 }
3750 }
3751 #endif
3752
3753 unbind_to (count, Qnil);
3754 }
3755
3756
3757
3758
3759
3760
3761
3762 DEFUN ("make-network-process", Fmake_network_process, Smake_network_process,
3763 0, MANY, 0,
3764 doc:
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
3885
3886
3887
3888
3889
3890
3891
3892
3893
3894
3895
3896
3897
3898
3899
3900
3901
3902
3903
3904
3905
3906
3907
3908
3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928 )
3929 (ptrdiff_t nargs, Lisp_Object *args)
3930 {
3931 Lisp_Object proc;
3932 Lisp_Object contact;
3933 struct Lisp_Process *p;
3934 const char *portstring UNINIT;
3935 char portbuf[INT_BUFSIZE_BOUND (EMACS_INT)];
3936 #ifdef HAVE_LOCAL_SOCKETS
3937 struct sockaddr_un address_un;
3938 #endif
3939 EMACS_INT port = 0;
3940 Lisp_Object tem;
3941 Lisp_Object name, buffer, host, service, address;
3942 Lisp_Object filter, sentinel, use_external_socket_p;
3943 Lisp_Object addrinfos = Qnil;
3944 int socktype;
3945 int family = -1;
3946 enum { any_protocol = 0 };
3947 #ifdef HAVE_GETADDRINFO_A
3948 struct gaicb *dns_request = NULL;
3949 #endif
3950 specpdl_ref count = SPECPDL_INDEX ();
3951
3952 if (nargs == 0)
3953 return Qnil;
3954
3955
3956 contact = Flist (nargs, args);
3957
3958 #ifdef WINDOWSNT
3959
3960 init_winsock (TRUE);
3961 #endif
3962
3963
3964 tem = plist_get (contact, QCtype);
3965 if (NILP (tem))
3966 socktype = SOCK_STREAM;
3967 #ifdef DATAGRAM_SOCKETS
3968 else if (EQ (tem, Qdatagram))
3969 socktype = SOCK_DGRAM;
3970 #endif
3971 #ifdef HAVE_SEQPACKET
3972 else if (EQ (tem, Qseqpacket))
3973 socktype = SOCK_SEQPACKET;
3974 #endif
3975 else
3976 error ("Unsupported connection type");
3977
3978 name = plist_get (contact, QCname);
3979 buffer = plist_get (contact, QCbuffer);
3980 filter = plist_get (contact, QCfilter);
3981 sentinel = plist_get (contact, QCsentinel);
3982 use_external_socket_p = plist_get (contact, QCuse_external_socket);
3983 Lisp_Object server = plist_get (contact, QCserver);
3984 bool nowait = !NILP (plist_get (contact, QCnowait));
3985
3986 if (!NILP (server) && nowait)
3987 error ("`:server' is incompatible with `:nowait'");
3988 CHECK_STRING (name);
3989
3990
3991 if (NILP (server))
3992 address = plist_get (contact, QCremote);
3993 else
3994 address = plist_get (contact, QClocal);
3995 if (!NILP (address))
3996 {
3997 host = service = Qnil;
3998
3999 if (!get_lisp_to_sockaddr_size (address, &family))
4000 error ("Malformed :address");
4001
4002 addrinfos = list1 (Fcons (make_fixnum (any_protocol), address));
4003 goto open_socket;
4004 }
4005
4006
4007 tem = plist_get (contact, QCfamily);
4008 if (NILP (tem))
4009 {
4010 #ifdef AF_INET6
4011 family = AF_UNSPEC;
4012 #else
4013 family = AF_INET;
4014 #endif
4015 }
4016 #ifdef HAVE_LOCAL_SOCKETS
4017 else if (EQ (tem, Qlocal))
4018 family = AF_LOCAL;
4019 #endif
4020 #ifdef AF_INET6
4021 else if (EQ (tem, Qipv6))
4022 family = AF_INET6;
4023 #endif
4024 else if (EQ (tem, Qipv4))
4025 family = AF_INET;
4026 else if (TYPE_RANGED_FIXNUMP (int, tem))
4027 family = XFIXNUM (tem);
4028 else
4029 error ("Unknown address family");
4030
4031
4032 service = plist_get (contact, QCservice);
4033
4034
4035 host = plist_get (contact, QChost);
4036 if (NILP (host))
4037 {
4038
4039
4040 #ifdef HAVE_LOCAL_SOCKETS
4041 if (family != AF_LOCAL)
4042 #endif
4043 {
4044 #ifdef AF_INET6
4045 if (family == AF_INET6)
4046 host = build_string ("::1");
4047 else
4048 #endif
4049 host = build_string ("127.0.0.1");
4050 }
4051 }
4052 else
4053 {
4054 if (EQ (host, Qlocal))
4055 {
4056
4057
4058 #ifdef AF_INET6
4059 if (family == AF_INET6)
4060 host = build_string ("::1");
4061 else
4062 #endif
4063 host = build_string ("127.0.0.1");
4064 }
4065 CHECK_STRING (host);
4066 }
4067
4068 #ifdef HAVE_LOCAL_SOCKETS
4069 if (family == AF_LOCAL)
4070 {
4071 if (!NILP (host))
4072 {
4073 message (":family local ignores the :host property");
4074 contact = plist_put (contact, QChost, Qnil);
4075 host = Qnil;
4076 }
4077 CHECK_STRING (service);
4078 if (sizeof address_un.sun_path <= SBYTES (service))
4079 error ("Service name too long");
4080 addrinfos = list1 (Fcons (make_fixnum (any_protocol), service));
4081 goto open_socket;
4082 }
4083 #endif
4084
4085
4086
4087
4088 #ifdef POLL_FOR_INPUT
4089 if (socktype != SOCK_DGRAM)
4090 {
4091 record_unwind_protect_void (run_all_atimers);
4092 bind_polling_period (10);
4093 }
4094 #endif
4095
4096 if (!NILP (host))
4097 {
4098 MAYBE_UNUSED ptrdiff_t portstringlen;
4099
4100
4101
4102 if (EQ (service, Qt))
4103 {
4104 portstring = "0";
4105 portstringlen = 1;
4106 }
4107 else if (FIXNUMP (service))
4108 {
4109 portstring = portbuf;
4110 portstringlen = sprintf (portbuf, "%"pI"d", XFIXNUM (service));
4111 }
4112 else
4113 {
4114 CHECK_STRING (service);
4115 portstring = SSDATA (service);
4116 portstringlen = SBYTES (service);
4117 }
4118
4119 #ifdef HAVE_GETADDRINFO_A
4120 if (nowait)
4121 {
4122 ptrdiff_t hostlen = SBYTES (host);
4123 struct req
4124 {
4125 struct gaicb gaicb;
4126 struct addrinfo hints;
4127 char str[FLEXIBLE_ARRAY_MEMBER];
4128 } *req = xmalloc (FLEXSIZEOF (struct req, str,
4129 hostlen + 1 + portstringlen + 1));
4130 dns_request = &req->gaicb;
4131 dns_request->ar_name = req->str;
4132 dns_request->ar_service = req->str + hostlen + 1;
4133 dns_request->ar_request = &req->hints;
4134 dns_request->ar_result = NULL;
4135 memset (&req->hints, 0, sizeof req->hints);
4136 req->hints.ai_family = family;
4137 req->hints.ai_socktype = socktype;
4138 strcpy (req->str, SSDATA (host));
4139 strcpy (req->str + hostlen + 1, portstring);
4140
4141 int ret = getaddrinfo_a (GAI_NOWAIT, &dns_request, 1, NULL);
4142 if (ret)
4143 error ("%s/%s getaddrinfo_a error %d",
4144 SSDATA (host), portstring, ret);
4145
4146 goto open_socket;
4147 }
4148 #endif
4149 }
4150
4151
4152
4153
4154 if (!NILP (host))
4155 {
4156 struct addrinfo *res, *lres;
4157 Lisp_Object msg;
4158
4159 maybe_quit ();
4160
4161 struct addrinfo hints;
4162 memset (&hints, 0, sizeof hints);
4163 hints.ai_family = family;
4164 hints.ai_socktype = socktype;
4165
4166 msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
4167 if (!EQ (msg, Qt))
4168 error ("%s", SSDATA (msg));
4169
4170 for (lres = res; lres; lres = lres->ai_next)
4171 addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
4172
4173 addrinfos = Fnreverse (addrinfos);
4174
4175 freeaddrinfo (res);
4176
4177 goto open_socket;
4178 }
4179
4180
4181
4182 if (EQ (service, Qt))
4183 port = 0;
4184 else if (FIXNUMP (service))
4185 port = XFIXNUM (service);
4186 else
4187 {
4188 CHECK_STRING (service);
4189
4190 port = -1;
4191 if (SBYTES (service) != 0)
4192 {
4193
4194
4195 char *service_end;
4196 long int lport = strtol (SSDATA (service), &service_end, 10);
4197 if (service_end == SSDATA (service) + SBYTES (service))
4198 port = lport;
4199 else
4200 {
4201 struct servent *svc_info
4202 = getservbyname (SSDATA (service),
4203 socktype == SOCK_DGRAM ? "udp" : "tcp");
4204 if (svc_info)
4205 port = ntohs (svc_info->s_port);
4206 }
4207 }
4208 }
4209
4210 if (! (0 <= port && port < 1 << 16))
4211 {
4212 AUTO_STRING (unknown_service, "Unknown service: %s");
4213 xsignal1 (Qerror, CALLN (Fformat, unknown_service, service));
4214 }
4215
4216 open_socket:
4217
4218 if (!NILP (buffer))
4219 buffer = Fget_buffer_create (buffer, Qnil);
4220
4221
4222 unbind_to (count, Qnil);
4223
4224 proc = make_process (name);
4225 record_unwind_protect (remove_process, proc);
4226 p = XPROCESS (proc);
4227 pset_childp (p, contact);
4228 pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
4229 pset_type (p, Qnetwork);
4230
4231 pset_buffer (p, buffer);
4232 pset_sentinel (p, sentinel);
4233 pset_filter (p, filter);
4234 pset_log (p, plist_get (contact, QClog));
4235 if (tem = plist_get (contact, QCnoquery), !NILP (tem))
4236 p->kill_without_query = 1;
4237 if ((tem = plist_get (contact, QCstop), !NILP (tem)))
4238 pset_command (p, Qt);
4239 eassert (p->pid == 0);
4240 p->backlog = 5;
4241 eassert (! p->is_non_blocking_client);
4242 eassert (! p->is_server);
4243 p->port = port;
4244 p->socktype = socktype;
4245 #ifdef HAVE_GETADDRINFO_A
4246 eassert (! p->dns_request);
4247 #endif
4248 #ifdef HAVE_GNUTLS
4249 tem = plist_get (contact, QCtls_parameters);
4250 CHECK_LIST (tem);
4251 p->gnutls_boot_parameters = tem;
4252 #endif
4253
4254 set_network_socket_coding_system (proc, host, service, name);
4255
4256
4257 p->is_server = !NILP (server);
4258 if (TYPE_RANGED_FIXNUMP (int, server))
4259 p->backlog = XFIXNUM (server);
4260
4261
4262 if (!p->is_server && socktype != SOCK_DGRAM && nowait)
4263 p->is_non_blocking_client = true;
4264
4265 bool postpone_connection = false;
4266 #ifdef HAVE_GETADDRINFO_A
4267
4268
4269 if (!p->is_server && NILP (addrinfos))
4270 {
4271 p->dns_request = dns_request;
4272 p->status = list1 (Qconnect);
4273 postpone_connection = true;
4274 }
4275 #endif
4276 if (! postpone_connection)
4277 connect_network_socket (proc, addrinfos, use_external_socket_p);
4278
4279 specpdl_ptr = specpdl_ref_to_ptr (count);
4280 return proc;
4281 }
4282
4283
4284
4285 #ifdef HAVE_GETIFADDRS
4286 static Lisp_Object
4287 network_interface_list (bool full, unsigned short match)
4288 {
4289 Lisp_Object res = Qnil;
4290 struct ifaddrs *ifap;
4291
4292 if (getifaddrs (&ifap) == -1)
4293 return Qnil;
4294
4295 for (struct ifaddrs *it = ifap; it != NULL; it = it->ifa_next)
4296 {
4297 int len;
4298 int addr_len;
4299 uint32_t *maskp;
4300 uint32_t *addrp;
4301 Lisp_Object elt = Qnil;
4302
4303
4304 if (it->ifa_addr == NULL)
4305 continue;
4306 if (match && it->ifa_addr->sa_family != match)
4307 continue;
4308 if (it->ifa_addr->sa_family == AF_INET)
4309 {
4310 DECLARE_POINTER_ALIAS (sin1, struct sockaddr_in, it->ifa_netmask);
4311 maskp = (uint32_t *)&sin1->sin_addr;
4312 DECLARE_POINTER_ALIAS (sin2, struct sockaddr_in, it->ifa_addr);
4313 addrp = (uint32_t *)&sin2->sin_addr;
4314 len = sizeof (struct sockaddr_in);
4315 addr_len = 1;
4316 }
4317 #ifdef AF_INET6
4318 else if (it->ifa_addr->sa_family == AF_INET6)
4319 {
4320 DECLARE_POINTER_ALIAS (sin6_1, struct sockaddr_in6, it->ifa_netmask);
4321 maskp = (uint32_t *) &sin6_1->sin6_addr;
4322 DECLARE_POINTER_ALIAS (sin6_2, struct sockaddr_in6, it->ifa_addr);
4323 addrp = (uint32_t *) &sin6_2->sin6_addr;
4324 len = sizeof (struct sockaddr_in6);
4325 addr_len = 4;
4326 }
4327 #endif
4328 else
4329 continue;
4330
4331 Lisp_Object addr = conv_sockaddr_to_lisp (it->ifa_addr, len);
4332
4333 if (full)
4334 {
4335 elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt);
4336
4337
4338
4339 int i;
4340 uint32_t mask;
4341 for (i = 0; i < addr_len; i++)
4342 {
4343 mask = maskp[i];
4344 maskp[i] = (addrp[i] & mask) | ~mask;
4345 }
4346 elt = Fcons (conv_sockaddr_to_lisp (it->ifa_netmask, len), elt);
4347 elt = Fcons (addr, elt);
4348 }
4349 else
4350 {
4351 elt = addr;
4352 }
4353 res = Fcons (Fcons (build_string (it->ifa_name), elt), res);
4354 }
4355 #ifdef HAVE_FREEIFADDRS
4356 freeifaddrs (ifap);
4357 #endif
4358
4359 return res;
4360 }
4361 #endif
4362
4363 #ifdef HAVE_NET_IF_H
4364 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4365
4366 struct ifflag_def {
4367 int flag_bit;
4368 const char *flag_sym;
4369 };
4370
4371 static const struct ifflag_def ifflag_table[] = {
4372 #ifdef IFF_UP
4373 { IFF_UP, "up" },
4374 #endif
4375 #ifdef IFF_BROADCAST
4376 { IFF_BROADCAST, "broadcast" },
4377 #endif
4378 #ifdef IFF_DEBUG
4379 { IFF_DEBUG, "debug" },
4380 #endif
4381 #ifdef IFF_LOOPBACK
4382 { IFF_LOOPBACK, "loopback" },
4383 #endif
4384 #ifdef IFF_POINTOPOINT
4385 { IFF_POINTOPOINT, "pointopoint" },
4386 #endif
4387 #ifdef IFF_RUNNING
4388 { IFF_RUNNING, "running" },
4389 #endif
4390 #ifdef IFF_NOARP
4391 { IFF_NOARP, "noarp" },
4392 #endif
4393 #ifdef IFF_PROMISC
4394 { IFF_PROMISC, "promisc" },
4395 #endif
4396 #ifdef IFF_NOTRAILERS
4397 #ifdef NS_IMPL_COCOA
4398
4399 { IFF_NOTRAILERS, "smart" },
4400 #else
4401 { IFF_NOTRAILERS, "notrailers" },
4402 #endif
4403 #endif
4404 #ifdef IFF_ALLMULTI
4405 { IFF_ALLMULTI, "allmulti" },
4406 #endif
4407 #ifdef IFF_MASTER
4408 { IFF_MASTER, "master" },
4409 #endif
4410 #ifdef IFF_SLAVE
4411 { IFF_SLAVE, "slave" },
4412 #endif
4413 #ifdef IFF_MULTICAST
4414 { IFF_MULTICAST, "multicast" },
4415 #endif
4416 #ifdef IFF_PORTSEL
4417 { IFF_PORTSEL, "portsel" },
4418 #endif
4419 #ifdef IFF_AUTOMEDIA
4420 { IFF_AUTOMEDIA, "automedia" },
4421 #endif
4422 #ifdef IFF_DYNAMIC
4423 { IFF_DYNAMIC, "dynamic" },
4424 #endif
4425 #ifdef IFF_OACTIVE
4426 { IFF_OACTIVE, "oactive" },
4427 #endif
4428 #ifdef IFF_SIMPLEX
4429 { IFF_SIMPLEX, "simplex" },
4430 #endif
4431 #ifdef IFF_LINK0
4432 { IFF_LINK0, "link0" },
4433 #endif
4434 #ifdef IFF_LINK1
4435 { IFF_LINK1, "link1" },
4436 #endif
4437 #ifdef IFF_LINK2
4438 { IFF_LINK2, "link2" },
4439 #endif
4440 { 0, 0 }
4441 };
4442
4443 static Lisp_Object
4444 network_interface_info (Lisp_Object ifname)
4445 {
4446 struct ifreq rq;
4447 Lisp_Object res = Qnil;
4448 Lisp_Object elt;
4449 int s;
4450 bool any = false;
4451 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4452 && defined HAVE_GETIFADDRS && defined LLADDR)
4453 struct ifaddrs *ifap;
4454 #endif
4455
4456 CHECK_STRING (ifname);
4457
4458 if (sizeof rq.ifr_name <= SBYTES (ifname))
4459 error ("interface name too long");
4460 lispstpcpy (rq.ifr_name, ifname);
4461
4462 s = socket (AF_INET, SOCK_STREAM | SOCK_CLOEXEC, 0);
4463 if (s < 0)
4464 return Qnil;
4465 specpdl_ref count = SPECPDL_INDEX ();
4466 record_unwind_protect_int (close_file_unwind, s);
4467
4468 elt = Qnil;
4469 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4470 if (ioctl (s, SIOCGIFFLAGS, &rq) == 0)
4471 {
4472 int flags = rq.ifr_flags;
4473 const struct ifflag_def *fp;
4474 int fnum;
4475
4476
4477
4478
4479 if (flags < 0 && sizeof (rq.ifr_flags) < sizeof (flags))
4480 flags = (unsigned short) rq.ifr_flags;
4481
4482 any = true;
4483 for (fp = ifflag_table; flags != 0 && fp->flag_sym; fp++)
4484 {
4485 if (flags & fp->flag_bit)
4486 {
4487 elt = Fcons (intern (fp->flag_sym), elt);
4488 flags -= fp->flag_bit;
4489 }
4490 }
4491 for (fnum = 0; flags && fnum < 32; flags >>= 1, fnum++)
4492 {
4493 if (flags & 1)
4494 {
4495 elt = Fcons (make_fixnum (fnum), elt);
4496 }
4497 }
4498 }
4499 #endif
4500 res = Fcons (elt, res);
4501
4502 elt = Qnil;
4503 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4504 if (ioctl (s, SIOCGIFHWADDR, &rq) == 0)
4505 {
4506 Lisp_Object hwaddr = make_uninit_vector (6);
4507 struct Lisp_Vector *p = XVECTOR (hwaddr);
4508
4509 any = true;
4510 for (int n = 0; n < 6; n++)
4511 p->contents[n] = make_fixnum (((unsigned char *)
4512 &rq.ifr_hwaddr.sa_data[0])
4513 [n]);
4514 elt = Fcons (make_fixnum (rq.ifr_hwaddr.sa_family), hwaddr);
4515 }
4516 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4517 if (getifaddrs (&ifap) != -1)
4518 {
4519 Lisp_Object hwaddr = make_nil_vector (6);
4520 struct Lisp_Vector *p = XVECTOR (hwaddr);
4521
4522 for (struct ifaddrs *it = ifap; it != NULL; it = it->ifa_next)
4523 {
4524 DECLARE_POINTER_ALIAS (sdl, struct sockaddr_dl, it->ifa_addr);
4525 unsigned char linkaddr[6];
4526 int n;
4527
4528 if (it->ifa_addr->sa_family != AF_LINK
4529 || strcmp (it->ifa_name, SSDATA (ifname)) != 0
4530 || sdl->sdl_alen != 6)
4531 continue;
4532
4533 memcpy (linkaddr, LLADDR (sdl), sdl->sdl_alen);
4534 for (n = 0; n < 6; n++)
4535 p->contents[n] = make_fixnum (linkaddr[n]);
4536
4537 elt = Fcons (make_fixnum (it->ifa_addr->sa_family), hwaddr);
4538 break;
4539 }
4540 }
4541 #ifdef HAVE_FREEIFADDRS
4542 freeifaddrs (ifap);
4543 #endif
4544
4545 #endif
4546
4547 res = Fcons (elt, res);
4548
4549 elt = Qnil;
4550 #if (defined SIOCGIFNETMASK \
4551 && (defined HAVE_STRUCT_IFREQ_IFR_NETMASK \
4552 || defined HAVE_STRUCT_IFREQ_IFR_ADDR))
4553 if (ioctl (s, SIOCGIFNETMASK, &rq) == 0)
4554 {
4555 any = true;
4556 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4557 elt = conv_sockaddr_to_lisp (&rq.ifr_netmask, sizeof (rq.ifr_netmask));
4558 #else
4559 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4560 #endif
4561 }
4562 #endif
4563 res = Fcons (elt, res);
4564
4565 elt = Qnil;
4566 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4567 if (ioctl (s, SIOCGIFBRDADDR, &rq) == 0)
4568 {
4569 any = true;
4570 elt = conv_sockaddr_to_lisp (&rq.ifr_broadaddr, sizeof rq.ifr_broadaddr);
4571 }
4572 #endif
4573 res = Fcons (elt, res);
4574
4575 elt = Qnil;
4576 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4577 if (ioctl (s, SIOCGIFADDR, &rq) == 0)
4578 {
4579 any = true;
4580 elt = conv_sockaddr_to_lisp (&rq.ifr_addr, sizeof (rq.ifr_addr));
4581 }
4582 #endif
4583 res = Fcons (elt, res);
4584
4585 return unbind_to (count, any ? res : Qnil);
4586 }
4587 #endif
4588 #endif
4589
4590 DEFUN ("network-interface-list", Fnetwork_interface_list,
4591 Snetwork_interface_list, 0, 2, 0,
4592 doc:
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611 )
4612 (Lisp_Object full, Lisp_Object family)
4613 {
4614 #if defined HAVE_GETIFADDRS || defined WINDOWSNT
4615 unsigned short match;
4616 bool full_info = false;
4617
4618 if (! NILP (full))
4619 full_info = true;
4620 if (NILP (family))
4621 match = 0;
4622 else if (EQ (family, Qipv4))
4623 match = AF_INET;
4624 #ifdef AF_INET6
4625 else if (EQ (family, Qipv6))
4626 match = AF_INET6;
4627 #endif
4628 else
4629 error ("Unsupported address family");
4630 return network_interface_list (full_info, match);
4631 #else
4632 return Qnil;
4633 #endif
4634 }
4635
4636 DEFUN ("network-interface-info", Fnetwork_interface_info,
4637 Snetwork_interface_info, 1, 1, 0,
4638 doc:
4639
4640
4641
4642
4643
4644 )
4645 (Lisp_Object ifname)
4646 {
4647 #if ((defined HAVE_NET_IF_H \
4648 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4649 || defined SIOCGIFFLAGS)) \
4650 || defined WINDOWSNT)
4651 return network_interface_info (ifname);
4652 #else
4653 return Qnil;
4654 #endif
4655 }
4656
4657 static Lisp_Object
4658 network_lookup_address_info_1 (Lisp_Object host, const char *service,
4659 struct addrinfo *hints, struct addrinfo **res)
4660 {
4661 Lisp_Object msg = Qt;
4662 int ret;
4663
4664 if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
4665 error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
4666 SSDATA (host));
4667
4668 #ifdef WINDOWSNT
4669
4670 init_winsock (TRUE);
4671 #endif
4672
4673 ret = getaddrinfo (SSDATA (host), service, hints, res);
4674 if (ret)
4675 {
4676 if (service == NULL)
4677 service = "0";
4678 #ifdef HAVE_GAI_STRERROR
4679 synchronize_system_messages_locale ();
4680 char const *str = gai_strerror (ret);
4681 if (! NILP (Vlocale_coding_system))
4682 str = SSDATA (code_convert_string_norecord
4683 (build_string (str), Vlocale_coding_system, 0));
4684 AUTO_STRING (format, "%s/%s %s");
4685 msg = CALLN (Fformat, format, host, build_string (service),
4686 build_string (str));
4687 #else
4688 AUTO_STRING (format, "%s/%s getaddrinfo error %d");
4689 msg = CALLN (Fformat, format, host, build_string (service),
4690 make_int (ret));
4691 #endif
4692 }
4693 return msg;
4694 }
4695
4696 DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
4697 Snetwork_lookup_address_info, 1, 3, 0,
4698 doc:
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709 )
4710 (Lisp_Object name, Lisp_Object family, Lisp_Object hint)
4711 {
4712 Lisp_Object addresses = Qnil;
4713 Lisp_Object msg = Qnil;
4714
4715 struct addrinfo *res, *lres;
4716 struct addrinfo hints;
4717
4718 memset (&hints, 0, sizeof hints);
4719 if (NILP (family))
4720 hints.ai_family = AF_UNSPEC;
4721 else if (EQ (family, Qipv4))
4722 hints.ai_family = AF_INET;
4723 #ifdef AF_INET6
4724 else if (EQ (family, Qipv6))
4725 hints.ai_family = AF_INET6;
4726 #endif
4727 else
4728 error ("Unsupported family");
4729 hints.ai_socktype = SOCK_DGRAM;
4730
4731 if (EQ (hint, Qnumeric))
4732 hints.ai_flags = AI_NUMERICHOST;
4733 else if (!NILP (hint))
4734 error ("Unsupported hints value");
4735
4736 msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
4737 if (!EQ (msg, Qt))
4738 message ("%s", SSDATA(msg));
4739 else
4740 {
4741 for (lres = res; lres; lres = lres->ai_next)
4742 {
4743 #ifndef AF_INET6
4744 if (lres->ai_family != AF_INET)
4745 continue;
4746 #endif
4747 addresses = Fcons (conv_sockaddr_to_lisp (lres->ai_addr,
4748 lres->ai_addrlen),
4749 addresses);
4750 }
4751 addresses = Fnreverse (addresses);
4752
4753 freeaddrinfo (res);
4754 }
4755 return addresses;
4756 }
4757
4758
4759
4760 static void
4761 deactivate_process (Lisp_Object proc)
4762 {
4763 int inchannel;
4764 struct Lisp_Process *p = XPROCESS (proc);
4765 int i;
4766
4767 #ifdef HAVE_GNUTLS
4768
4769 emacs_gnutls_deinit (proc);
4770 #endif
4771
4772 if (p->read_output_delay > 0)
4773 {
4774 if (--process_output_delay_count < 0)
4775 process_output_delay_count = 0;
4776 p->read_output_delay = 0;
4777 p->read_output_skip = 0;
4778 }
4779
4780
4781
4782 for (i = 0; i < PROCESS_OPEN_FDS; i++)
4783 close_process_fd (&p->open_fd[i]);
4784
4785 inchannel = p->infd;
4786 eassert (inchannel < FD_SETSIZE);
4787 if (inchannel >= 0)
4788 {
4789 p->infd = -1;
4790 p->outfd = -1;
4791 #ifdef DATAGRAM_SOCKETS
4792 if (DATAGRAM_CHAN_P (inchannel))
4793 {
4794 xfree (datagram_address[inchannel].sa);
4795 datagram_address[inchannel].sa = 0;
4796 datagram_address[inchannel].len = 0;
4797 }
4798 #endif
4799 chan_process[inchannel] = Qnil;
4800 delete_read_fd (inchannel);
4801 if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
4802 delete_write_fd (inchannel);
4803 if (inchannel == max_desc)
4804 recompute_max_desc ();
4805 }
4806 }
4807
4808
4809 DEFUN ("accept-process-output", Faccept_process_output, Saccept_process_output,
4810 0, 4, 0,
4811 doc:
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827 )
4828 (Lisp_Object process, Lisp_Object seconds, Lisp_Object millisec,
4829 Lisp_Object just_this_one)
4830 {
4831 intmax_t secs;
4832 int nsecs;
4833
4834 if (! NILP (process))
4835 {
4836 CHECK_PROCESS (process);
4837 struct Lisp_Process *proc = XPROCESS (process);
4838
4839
4840
4841 if (!NILP (proc->thread) && !BASE_EQ (proc->thread, Fcurrent_thread ()))
4842 {
4843 Lisp_Object proc_thread_name = XTHREAD (proc->thread)->name;
4844
4845 error ("Attempt to accept output from process %s locked to thread %s",
4846 SDATA (proc->name),
4847 STRINGP (proc_thread_name)
4848 ? SDATA (proc_thread_name)
4849 : SDATA (Fprin1_to_string (proc->thread, Qt, Qnil)));
4850 }
4851 }
4852 else
4853 just_this_one = Qnil;
4854
4855 if (!NILP (millisec))
4856 {
4857 CHECK_FIXNUM (millisec);
4858 if (NILP (seconds))
4859 seconds = make_float (XFIXNUM (millisec) / 1000.0);
4860 else
4861 {
4862 CHECK_FIXNUM (seconds);
4863 seconds = make_float (XFIXNUM (millisec) / 1000.0 + XFIXNUM (seconds));
4864 }
4865 }
4866
4867 secs = 0;
4868 nsecs = -1;
4869
4870 if (!NILP (seconds))
4871 {
4872 if (FIXNUMP (seconds))
4873 {
4874 if (XFIXNUM (seconds) > 0)
4875 {
4876 secs = XFIXNUM (seconds);
4877 nsecs = 0;
4878 }
4879 }
4880 else if (FLOATP (seconds))
4881 {
4882 if (XFLOAT_DATA (seconds) > 0)
4883 {
4884 struct timespec t = dtotimespec (XFLOAT_DATA (seconds));
4885 secs = min (t.tv_sec, WAIT_READING_MAX);
4886 nsecs = t.tv_nsec;
4887 }
4888 }
4889 else
4890 wrong_type_argument (Qnumberp, seconds);
4891 }
4892 else if (! NILP (process))
4893 nsecs = 0;
4894
4895 return
4896 ((wait_reading_process_output (secs, nsecs, 0, 0,
4897 Qnil,
4898 !NILP (process) ? XPROCESS (process) : NULL,
4899 (NILP (just_this_one) ? 0
4900 : !FIXNUMP (just_this_one) ? 1 : -1))
4901 <= 0)
4902 ? Qnil : Qt);
4903 }
4904
4905
4906
4907 static EMACS_INT connect_counter = 0;
4908
4909 static void
4910 server_accept_connection (Lisp_Object server, int channel)
4911 {
4912 Lisp_Object buffer;
4913 Lisp_Object contact, host, service;
4914 struct Lisp_Process *ps = XPROCESS (server);
4915 struct Lisp_Process *p;
4916 int s;
4917 union u_sockaddr saddr;
4918 socklen_t len = sizeof saddr;
4919
4920 s = accept4 (channel, &saddr.sa, &len, SOCK_CLOEXEC);
4921
4922 if (FD_SETSIZE <= s)
4923 {
4924 emacs_close (s);
4925 s = -1;
4926 errno = EMFILE;
4927 }
4928
4929 if (s < 0)
4930 {
4931 int code = errno;
4932 if (!would_block (code) && !NILP (ps->log))
4933 call3 (ps->log, server, Qnil,
4934 concat3 (build_string ("accept failed with code"),
4935 Fnumber_to_string (make_fixnum (code)),
4936 build_string ("\n")));
4937 return;
4938 }
4939
4940 specpdl_ref count = SPECPDL_INDEX ();
4941 record_unwind_protect_int (close_file_unwind, s);
4942
4943 connect_counter++;
4944
4945
4946
4947
4948
4949 host = Qt;
4950 service = Qnil;
4951 Lisp_Object args[11];
4952 int nargs = 0;
4953 #define HOST_FORMAT_IN "%d.%d.%d.%d"
4954 #define HOST_FORMAT_IN6 "%x:%x:%x:%x:%x:%x:%x:%x"
4955 AUTO_STRING (host_format_in, HOST_FORMAT_IN);
4956 AUTO_STRING (host_format_in6, HOST_FORMAT_IN6);
4957 AUTO_STRING (procname_format_in, "%s <"HOST_FORMAT_IN":%d>");
4958 AUTO_STRING (procname_format_in6, "%s <["HOST_FORMAT_IN6"]:%d>");
4959 AUTO_STRING (procname_format_default, "%s <%d>");
4960 switch (saddr.sa.sa_family)
4961 {
4962 case AF_INET:
4963 {
4964 args[nargs++] = procname_format_in;
4965 args[nargs++] = host_format_in;
4966 unsigned char *ip = (unsigned char *)&saddr.in.sin_addr.s_addr;
4967 service = make_fixnum (ntohs (saddr.in.sin_port));
4968 for (int i = 0; i < 4; i++)
4969 args[nargs++] = make_fixnum (ip[i]);
4970 host = Fformat (5, args + 1);
4971 args[nargs++] = service;
4972 }
4973 break;
4974
4975 #ifdef AF_INET6
4976 case AF_INET6:
4977 {
4978 args[nargs++] = procname_format_in6;
4979 args[nargs++] = host_format_in6;
4980 DECLARE_POINTER_ALIAS (ip6, uint16_t, &saddr.in6.sin6_addr);
4981 service = make_fixnum (ntohs (saddr.in.sin_port));
4982 for (int i = 0; i < 8; i++)
4983 args[nargs++] = make_fixnum (ip6[i]);
4984 host = Fformat (9, args + 1);
4985 args[nargs++] = service;
4986 }
4987 break;
4988 #endif
4989
4990 default:
4991 args[nargs++] = procname_format_default;
4992 nargs++;
4993 args[nargs++] = make_fixnum (connect_counter);
4994 break;
4995 }
4996
4997
4998
4999
5000
5001
5002 if (!(EQ (ps->filter, Qinternal_default_process_filter)
5003 || EQ (ps->filter, Qt)))
5004 buffer = Qnil;
5005 else
5006 {
5007 buffer = ps->buffer;
5008 if (!NILP (buffer))
5009 buffer = Fbuffer_name (buffer);
5010 else
5011 buffer = ps->name;
5012 if (!NILP (buffer))
5013 {
5014 args[1] = buffer;
5015 buffer = Fget_buffer_create (Fformat (nargs, args), Qnil);
5016 }
5017 }
5018
5019
5020
5021
5022 args[1] = ps->name;
5023 Lisp_Object name = Fformat (nargs, args);
5024 Lisp_Object proc = make_process (name);
5025
5026 eassert (0 <= s && s < FD_SETSIZE);
5027 chan_process[s] = proc;
5028
5029 fcntl (s, F_SETFL, O_NONBLOCK);
5030
5031 p = XPROCESS (proc);
5032
5033
5034 contact = Fcopy_sequence (ps->childp);
5035 contact = plist_put (contact, QCserver, Qnil);
5036 contact = plist_put (contact, QChost, host);
5037 if (!NILP (service))
5038 contact = plist_put (contact, QCservice, service);
5039 contact = plist_put (contact, QCremote,
5040 conv_sockaddr_to_lisp (&saddr.sa, len));
5041 #ifdef HAVE_GETSOCKNAME
5042 len = sizeof saddr;
5043 if (getsockname (s, &saddr.sa, &len) == 0)
5044 contact = plist_put (contact, QClocal,
5045 conv_sockaddr_to_lisp (&saddr.sa, len));
5046 #endif
5047
5048 pset_childp (p, contact);
5049 pset_plist (p, Fcopy_sequence (ps->plist));
5050 pset_type (p, Qnetwork);
5051
5052 pset_buffer (p, buffer);
5053 pset_sentinel (p, ps->sentinel);
5054 pset_filter (p, ps->filter);
5055 eassert (NILP (p->command));
5056 eassert (p->pid == 0);
5057
5058
5059 specpdl_ptr = specpdl_ref_to_ptr (count);
5060
5061 p->open_fd[SUBPROCESS_STDIN] = s;
5062 p->infd = s;
5063 p->outfd = s;
5064 pset_status (p, Qrun);
5065
5066
5067 if (!EQ (p->filter, Qt))
5068 add_process_read_fd (s);
5069 if (s > max_desc)
5070 max_desc = s;
5071
5072
5073
5074
5075
5076
5077 pset_decode_coding_system (p, ps->decode_coding_system);
5078 pset_encode_coding_system (p, ps->encode_coding_system);
5079 setup_process_coding_systems (proc);
5080
5081 pset_decoding_buf (p, empty_unibyte_string);
5082 eassert (p->decoding_carryover == 0);
5083 pset_encoding_buf (p, empty_unibyte_string);
5084
5085 p->inherit_coding_system_flag
5086 = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag);
5087
5088 AUTO_STRING (dash, "-");
5089 AUTO_STRING (nl, "\n");
5090 Lisp_Object host_string = STRINGP (host) ? host : dash;
5091
5092 if (!NILP (ps->log))
5093 {
5094 AUTO_STRING (accept_from, "accept from ");
5095 call3 (ps->log, server, proc, concat3 (accept_from, host_string, nl));
5096 }
5097
5098 AUTO_STRING (open_from, "open from ");
5099 exec_sentinel (proc, concat3 (open_from, host_string, nl));
5100 }
5101
5102 #ifdef HAVE_GETADDRINFO_A
5103 static Lisp_Object
5104 check_for_dns (Lisp_Object proc)
5105 {
5106 struct Lisp_Process *p = XPROCESS (proc);
5107 Lisp_Object addrinfos = Qnil;
5108
5109
5110 if (! p->dns_request)
5111 return Qnil;
5112
5113 int ret = gai_error (p->dns_request);
5114 if (ret == EAI_INPROGRESS)
5115 return Qt;
5116
5117
5118 if (ret == 0)
5119 {
5120 struct addrinfo *res;
5121
5122 for (res = p->dns_request->ar_result; res; res = res->ai_next)
5123 addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
5124
5125 addrinfos = Fnreverse (addrinfos);
5126 }
5127
5128 else if (connecting_status (p->status))
5129 {
5130 deactivate_process (proc);
5131 pset_status (p, (list2
5132 (Qfailed,
5133 concat3 (build_string ("Name lookup of "),
5134 build_string (p->dns_request->ar_name),
5135 build_string (" failed")))));
5136 }
5137
5138 free_dns_request (proc);
5139
5140
5141 if (! connecting_status (p->status))
5142 return Qnil;
5143
5144 return addrinfos;
5145 }
5146
5147 #endif
5148
5149 static void
5150 wait_for_socket_fds (Lisp_Object process, char const *name)
5151 {
5152 while (XPROCESS (process)->infd < 0
5153 && connecting_status (XPROCESS (process)->status))
5154 {
5155 add_to_log ("Waiting for socket from %s...", build_string (name));
5156 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
5157 }
5158 }
5159
5160 static void
5161 wait_while_connecting (Lisp_Object process)
5162 {
5163 while (connecting_status (XPROCESS (process)->status))
5164 {
5165 add_to_log ("Waiting for connection...");
5166 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
5167 }
5168 }
5169
5170 static void
5171 wait_for_tls_negotiation (Lisp_Object process)
5172 {
5173 #ifdef HAVE_GNUTLS
5174 while (XPROCESS (process)->gnutls_p
5175 && XPROCESS (process)->gnutls_initstage != GNUTLS_STAGE_READY)
5176 {
5177 add_to_log ("Waiting for TLS...");
5178 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil, NULL, 0);
5179 }
5180 #endif
5181 }
5182
5183 static void
5184 wait_reading_process_output_unwind (int data)
5185 {
5186 clear_waiting_thread_info ();
5187 waiting_for_user_input_p = data;
5188 }
5189
5190
5191 static void
5192 wait_reading_process_output_1 (void)
5193 {
5194 }
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
5205
5206
5207
5208
5209
5210
5211
5212
5213
5214
5215
5216
5217
5218
5219
5220
5221
5222
5223
5224
5225
5226
5227
5228
5229
5230
5231
5232
5233 int
5234 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
5235 bool do_display,
5236 Lisp_Object wait_for_cell,
5237 struct Lisp_Process *wait_proc, int just_wait_proc)
5238 {
5239 static int last_read_channel = -1;
5240 int channel, nfds;
5241 fd_set Available;
5242 fd_set Writeok;
5243 bool check_write;
5244 int check_delay;
5245 bool no_avail;
5246 int xerrno;
5247 Lisp_Object proc;
5248 struct timespec timeout, end_time, timer_delay;
5249 struct timespec got_output_end_time = invalid_timespec ();
5250 enum { MINIMUM = -1, TIMEOUT, FOREVER } wait;
5251 int got_some_output = -1;
5252 uintmax_t prev_wait_proc_nbytes_read = wait_proc ? wait_proc->nbytes_read : 0;
5253 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5254 bool retry_for_async;
5255 #endif
5256 specpdl_ref count = SPECPDL_INDEX ();
5257
5258
5259 struct timespec now = invalid_timespec ();
5260
5261 eassert (wait_proc == NULL
5262 || NILP (wait_proc->thread)
5263 || XTHREAD (wait_proc->thread) == current_thread);
5264
5265 FD_ZERO (&Available);
5266 FD_ZERO (&Writeok);
5267
5268 if (time_limit == 0 && nsecs == 0 && wait_proc && !NILP (Vinhibit_quit)
5269 && !(CONSP (wait_proc->status)
5270 && EQ (XCAR (wait_proc->status), Qexit)))
5271 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5272
5273 record_unwind_protect_int (wait_reading_process_output_unwind,
5274 waiting_for_user_input_p);
5275 waiting_for_user_input_p = read_kbd;
5276
5277 if (TYPE_MAXIMUM (time_t) < time_limit)
5278 time_limit = TYPE_MAXIMUM (time_t);
5279
5280 if (time_limit < 0 || nsecs < 0)
5281 wait = MINIMUM;
5282 else if (time_limit > 0 || nsecs > 0)
5283 {
5284 wait = TIMEOUT;
5285 now = current_timespec ();
5286 end_time = timespec_add (now, make_timespec (time_limit, nsecs));
5287 }
5288 else
5289 wait = FOREVER;
5290
5291 while (1)
5292 {
5293 bool process_skipped = false;
5294 bool wrapped;
5295 int channel_start;
5296
5297
5298
5299
5300 if (read_kbd >= 0)
5301 maybe_quit ();
5302 else if (pending_signals)
5303 process_pending_signals ();
5304
5305
5306 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5307 break;
5308
5309 eassert (max_desc < FD_SETSIZE);
5310
5311 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5312 {
5313 Lisp_Object process_list_head, aproc;
5314 struct Lisp_Process *p;
5315
5316 retry_for_async = false;
5317 FOR_EACH_PROCESS(process_list_head, aproc)
5318 {
5319 p = XPROCESS (aproc);
5320
5321 if (! wait_proc || p == wait_proc)
5322 {
5323 #ifdef HAVE_GETADDRINFO_A
5324
5325 if (p->dns_request)
5326 {
5327 Lisp_Object addrinfos = check_for_dns (aproc);
5328 if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
5329 connect_network_socket (aproc, addrinfos, Qnil);
5330 else
5331 retry_for_async = true;
5332 }
5333 #endif
5334 #ifdef HAVE_GNUTLS
5335
5336 if (p->gnutls_initstage == GNUTLS_STAGE_HANDSHAKE_TRIED
5337 && p->is_non_blocking_client
5338
5339 && !(fd_callback_info[p->outfd].flags
5340 & NON_BLOCKING_CONNECT_FD))
5341 {
5342 gnutls_try_handshake (p);
5343 p->gnutls_handshakes_tried++;
5344
5345 if (p->gnutls_initstage == GNUTLS_STAGE_READY)
5346 {
5347 gnutls_verify_boot (aproc, Qnil);
5348 finish_after_tls_connection (aproc);
5349 }
5350 else
5351 {
5352 retry_for_async = true;
5353 if (p->gnutls_handshakes_tried
5354 > GNUTLS_EMACS_HANDSHAKES_LIMIT)
5355 {
5356 deactivate_process (aproc);
5357 pset_status (p, list2 (Qfailed,
5358 build_string ("TLS negotiation failed")));
5359 }
5360 }
5361 }
5362 #endif
5363 }
5364 }
5365 }
5366 #endif
5367
5368
5369
5370 if (wait == TIMEOUT)
5371 {
5372 if (!timespec_valid_p (now))
5373 now = current_timespec ();
5374 if (timespec_cmp (end_time, now) <= 0)
5375 break;
5376 timeout = timespec_sub (end_time, now);
5377 }
5378 else
5379 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
5380
5381
5382
5383
5384
5385 if (NILP (wait_for_cell)
5386 && just_wait_proc >= 0)
5387 {
5388 do
5389 {
5390 unsigned old_timers_run = timers_run;
5391
5392 timer_delay = timer_check ();
5393
5394 if (timers_run != old_timers_run && do_display)
5395
5396
5397 redisplay_preserve_echo_area (9);
5398 else
5399 break;
5400 }
5401 while (!detect_input_pending ());
5402
5403
5404 if (read_kbd != 0
5405 && requeued_events_pending_p ())
5406 break;
5407
5408
5409 if (!timespec_valid_p (timer_delay))
5410 wait_reading_process_output_1 ();
5411 }
5412
5413
5414
5415
5416
5417
5418
5419 if (read_kbd < 0 && kbd_is_ours ())
5420 set_waiting_for_input (&timeout);
5421
5422
5423
5424
5425
5426 if (update_tick != process_tick)
5427 {
5428 fd_set Atemp;
5429 fd_set Ctemp;
5430
5431 if (kbd_on_hold_p ())
5432 FD_ZERO (&Atemp);
5433 else
5434 compute_input_wait_mask (&Atemp);
5435 compute_write_mask (&Ctemp);
5436
5437
5438
5439
5440
5441 int fd = child_signal_read_fd;
5442 eassert (fd < FD_SETSIZE);
5443 if (0 <= fd)
5444 FD_CLR (fd, &Atemp);
5445
5446 timeout = make_timespec (0, 0);
5447 if ((thread_select (pselect, max_desc + 1,
5448 &Atemp,
5449 (num_pending_connects > 0 ? &Ctemp : NULL),
5450 NULL, &timeout, NULL)
5451 <= 0))
5452 {
5453
5454
5455 clear_waiting_for_input ();
5456 got_some_output = status_notify (NULL, wait_proc);
5457 if (do_display) redisplay_preserve_echo_area (13);
5458 }
5459 }
5460
5461
5462
5463 if (wait_proc && wait_proc->raw_status_new)
5464 update_status (wait_proc);
5465 if (wait_proc
5466 && ! EQ (wait_proc->status, Qrun)
5467 && ! connecting_status (wait_proc->status))
5468 {
5469 bool read_some_bytes = false;
5470
5471 clear_waiting_for_input ();
5472
5473
5474 if (wait_proc->infd >= 0)
5475 {
5476 unsigned int count = 0;
5477 XSETPROCESS (proc, wait_proc);
5478
5479 while (true)
5480 {
5481 int nread = read_process_output (proc, wait_proc->infd);
5482 rarely_quit (++count);
5483 if (nread < 0)
5484 {
5485 if (errno != EINTR)
5486 break;
5487 }
5488 else
5489 {
5490 if (got_some_output < nread)
5491 got_some_output = nread;
5492 if (nread == 0)
5493 break;
5494 read_some_bytes = true;
5495 }
5496 }
5497 }
5498
5499 if (read_some_bytes && do_display)
5500 redisplay_preserve_echo_area (10);
5501
5502 break;
5503 }
5504
5505
5506
5507 if (wait_proc && just_wait_proc)
5508 {
5509 if (wait_proc->infd < 0)
5510 break;
5511 FD_SET (wait_proc->infd, &Available);
5512 check_delay = 0;
5513 check_write = 0;
5514 }
5515 else if (!NILP (wait_for_cell))
5516 {
5517 compute_non_process_wait_mask (&Available);
5518 check_delay = 0;
5519 check_write = 0;
5520 }
5521 else
5522 {
5523 if (! read_kbd)
5524 compute_non_keyboard_wait_mask (&Available);
5525 else
5526 compute_input_wait_mask (&Available);
5527 compute_write_mask (&Writeok);
5528 check_delay = wait_proc ? 0 : process_output_delay_count;
5529 check_write = true;
5530 }
5531
5532
5533
5534
5535 int child_fd = child_signal_read_fd;
5536 eassert (child_fd < FD_SETSIZE);
5537 if (0 <= child_fd)
5538 FD_SET (child_fd, &Available);
5539
5540
5541
5542
5543
5544
5545 if (frame_garbaged && do_display)
5546 {
5547 clear_waiting_for_input ();
5548 redisplay_preserve_echo_area (11);
5549 if (read_kbd < 0 && kbd_is_ours ())
5550 set_waiting_for_input (&timeout);
5551 }
5552
5553
5554
5555
5556
5557 no_avail = 0;
5558 if ((read_kbd
5559
5560
5561
5562
5563
5564
5565
5566
5567
5568 )
5569 && detect_input_pending ())
5570 {
5571 nfds = read_kbd ? 0 : 1;
5572 no_avail = 1;
5573 FD_ZERO (&Available);
5574 }
5575 else
5576 {
5577 #ifdef HAVE_GNUTLS
5578 int tls_nfds;
5579 fd_set tls_available;
5580 #endif
5581
5582
5583
5584
5585
5586 if (process_output_skip && check_delay > 0)
5587 {
5588 int adaptive_nsecs = timeout.tv_nsec;
5589 if (timeout.tv_sec > 0 || adaptive_nsecs > READ_OUTPUT_DELAY_MAX)
5590 adaptive_nsecs = READ_OUTPUT_DELAY_MAX;
5591 for (channel = 0; check_delay > 0 && channel <= max_desc; channel++)
5592 {
5593 proc = chan_process[channel];
5594 if (NILP (proc))
5595 continue;
5596
5597
5598 if (XPROCESS (proc)->read_output_delay > 0)
5599 {
5600 check_delay--;
5601 if (!XPROCESS (proc)->read_output_skip)
5602 continue;
5603 FD_CLR (channel, &Available);
5604 process_skipped = true;
5605 XPROCESS (proc)->read_output_skip = 0;
5606 if (XPROCESS (proc)->read_output_delay < adaptive_nsecs)
5607 adaptive_nsecs = XPROCESS (proc)->read_output_delay;
5608 }
5609 }
5610 timeout = make_timespec (0, adaptive_nsecs);
5611 process_output_skip = 0;
5612 }
5613
5614
5615
5616 if (got_some_output > 0 && !process_skipped
5617 && (timeout.tv_sec
5618 || timeout.tv_nsec > READ_OUTPUT_DELAY_INCREMENT))
5619 timeout = make_timespec (0, READ_OUTPUT_DELAY_INCREMENT);
5620
5621
5622 if (NILP (wait_for_cell) && just_wait_proc >= 0
5623 && timespec_valid_p (timer_delay)
5624 && timespec_cmp (timer_delay, timeout) < 0)
5625 {
5626 if (!timespec_valid_p (now))
5627 now = current_timespec ();
5628 struct timespec timeout_abs = timespec_add (now, timeout);
5629 if (!timespec_valid_p (got_output_end_time)
5630 || timespec_cmp (timeout_abs, got_output_end_time) < 0)
5631 got_output_end_time = timeout_abs;
5632 timeout = timer_delay;
5633 }
5634 else
5635 got_output_end_time = invalid_timespec ();
5636
5637
5638 if (timeout.tv_sec > 0 || timeout.tv_nsec > 0)
5639 now = invalid_timespec ();
5640
5641 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5642 if (retry_for_async
5643 && (timeout.tv_sec > 0 || timeout.tv_nsec > ASYNC_RETRY_NSEC))
5644 {
5645 timeout.tv_sec = 0;
5646 timeout.tv_nsec = ASYNC_RETRY_NSEC;
5647 }
5648 #endif
5649
5650 #ifdef HAVE_GNUTLS
5651
5652
5653
5654 FD_ZERO (&tls_available);
5655 tls_nfds = 0;
5656 for (channel = 0; channel < FD_SETSIZE; ++channel)
5657 if (! NILP (chan_process[channel])
5658 && FD_ISSET (channel, &Available))
5659 {
5660 struct Lisp_Process *p = XPROCESS (chan_process[channel]);
5661 if (p
5662 && p->gnutls_p && p->gnutls_state
5663 && emacs_gnutls_record_check_pending (p->gnutls_state) > 0)
5664 {
5665 tls_nfds++;
5666 eassert (p->infd == channel);
5667 FD_SET (p->infd, &tls_available);
5668 }
5669 }
5670
5671
5672 if (tls_nfds > 0
5673 && (!wait_proc ||
5674 (wait_proc->infd >= 0
5675 && FD_ISSET (wait_proc->infd, &tls_available))))
5676 timeout = make_timespec (0, 0);
5677 #endif
5678
5679 #if !defined USABLE_SIGIO && !defined WINDOWSNT
5680
5681
5682 struct timespec short_timeout = make_timespec (0, 25000000);
5683 if ((read_kbd || !NILP (wait_for_cell))
5684 && timespec_cmp (short_timeout, timeout) < 0)
5685 timeout = short_timeout;
5686 #endif
5687
5688
5689
5690
5691 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
5692 nfds = android_select (max_desc + 1,
5693 &Available, (check_write ? &Writeok : 0),
5694 NULL, &timeout);
5695 #else
5696
5697
5698
5699 #if defined HAVE_GLIB && !defined HAVE_NS
5700 nfds = xg_select (max_desc + 1,
5701 &Available, (check_write ? &Writeok : 0),
5702 NULL, &timeout, NULL);
5703 #elif defined HAVE_NS
5704
5705 nfds = ns_select (max_desc + 1,
5706 &Available, (check_write ? &Writeok : 0),
5707 NULL, &timeout, NULL);
5708 #else
5709 nfds = thread_select (pselect, max_desc + 1,
5710 &Available,
5711 (check_write ? &Writeok : 0),
5712 NULL, &timeout, NULL);
5713 #endif
5714 #endif
5715
5716 #ifdef HAVE_GNUTLS
5717
5718 if (tls_nfds > 0)
5719 {
5720 if (nfds == 0 || (nfds < 0 && errno == EINTR))
5721 {
5722
5723 nfds = tls_nfds;
5724 Available = tls_available;
5725 }
5726 else if (nfds > 0)
5727
5728
5729 for (channel = 0; channel < FD_SETSIZE; ++channel)
5730 if (FD_ISSET(channel, &tls_available))
5731 FD_SET(channel, &Available);
5732 }
5733 #endif
5734 }
5735
5736 xerrno = errno;
5737
5738
5739 clear_waiting_for_input ();
5740
5741
5742 do_pending_window_change (0);
5743
5744 if (nfds == 0)
5745 {
5746
5747
5748
5749
5750
5751
5752
5753 struct timespec huge_timespec
5754 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_HZ);
5755 struct timespec cmp_time = huge_timespec;
5756 if (wait < TIMEOUT
5757 || (wait_proc
5758 && wait_proc->nbytes_read != prev_wait_proc_nbytes_read))
5759 break;
5760 if (wait == TIMEOUT)
5761 cmp_time = end_time;
5762 if (!process_skipped && got_some_output > 0
5763 && (timeout.tv_sec > 0 || timeout.tv_nsec > 0))
5764 {
5765 if (!timespec_valid_p (got_output_end_time))
5766 break;
5767 if (timespec_cmp (got_output_end_time, cmp_time) < 0)
5768 cmp_time = got_output_end_time;
5769 }
5770 if (timespec_cmp (cmp_time, huge_timespec) < 0)
5771 {
5772 now = current_timespec ();
5773 if (timespec_cmp (cmp_time, now) <= 0)
5774 break;
5775 }
5776 }
5777
5778 if (nfds < 0)
5779 {
5780 if (xerrno == EINTR)
5781 no_avail = 1;
5782 else if (xerrno == EBADF)
5783 emacs_abort ();
5784 else
5785 report_file_errno ("Failed select", Qnil, xerrno);
5786 }
5787
5788
5789
5790
5791
5792 if (read_kbd != 0)
5793 {
5794 bool leave = false;
5795
5796 if (detect_input_pending_run_timers (do_display))
5797 {
5798 swallow_events (do_display);
5799 if (detect_input_pending_run_timers (do_display))
5800 leave = true;
5801 }
5802
5803 if (leave)
5804 break;
5805 }
5806
5807
5808 if (read_kbd != 0
5809 && requeued_events_pending_p ())
5810 break;
5811
5812
5813
5814
5815
5816
5817
5818
5819 if (read_kbd == 0 && detect_input_pending ())
5820 {
5821 swallow_events (do_display);
5822 #if 0
5823 if (detect_input_pending ())
5824 break;
5825 #endif
5826 }
5827
5828
5829 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
5830 break;
5831
5832 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
5833
5834
5835
5836
5837
5838 if (read_kbd && interrupt_input
5839 && keyboard_bit_set (&Available) && ! noninteractive)
5840 #ifdef USABLE_SIGIO
5841 handle_input_available_signal (SIGIO);
5842 #else
5843 handle_input_available_signal (SIGPOLL);
5844 #endif
5845 #endif
5846
5847
5848
5849 if (read_kbd || ! NILP (wait_for_cell))
5850 do_pending_window_change (0);
5851
5852
5853 if (no_avail || nfds == 0)
5854 continue;
5855
5856 for (channel = 0; channel <= max_desc; ++channel)
5857 {
5858 struct fd_callback_data *d = &fd_callback_info[channel];
5859 if (d->func
5860 && ((d->flags & FOR_READ
5861 && FD_ISSET (channel, &Available))
5862 || ((d->flags & FOR_WRITE)
5863 && FD_ISSET (channel, &Writeok))))
5864 d->func (channel, d->data);
5865 }
5866
5867
5868 channel_start
5869 = process_prioritize_lower_fds ? 0 : last_read_channel + 1;
5870
5871 for (channel = channel_start, wrapped = false;
5872 !wrapped || (channel < channel_start && channel <= max_desc);
5873 channel++)
5874 {
5875 if (channel > max_desc)
5876 {
5877 wrapped = true;
5878 channel = -1;
5879 continue;
5880 }
5881
5882 if (FD_ISSET (channel, &Available)
5883 && ((fd_callback_info[channel].flags & (KEYBOARD_FD | PROCESS_FD))
5884 == PROCESS_FD))
5885 {
5886 int nread;
5887
5888
5889
5890
5891 proc = chan_process[channel];
5892 if (NILP (proc))
5893 continue;
5894
5895
5896 if (EQ (XPROCESS (proc)->status, Qlisten))
5897 {
5898 server_accept_connection (proc, channel);
5899 continue;
5900 }
5901
5902
5903
5904
5905 nread = read_process_output (proc, channel);
5906 if ((!wait_proc || wait_proc == XPROCESS (proc))
5907 && got_some_output < nread)
5908 got_some_output = nread;
5909 if (nread > 0)
5910 {
5911
5912 if (wait_proc == XPROCESS (proc))
5913 wait = MINIMUM;
5914
5915
5916
5917
5918 FD_ZERO (&Available);
5919 last_read_channel = channel;
5920
5921 if (do_display)
5922 redisplay_preserve_echo_area (12);
5923 }
5924 else if (nread == -1 && would_block (errno))
5925 ;
5926 #ifdef HAVE_PTYS
5927
5928
5929
5930
5931
5932
5933
5934 else if (nread == -1 && errno == EIO)
5935 {
5936 struct Lisp_Process *p = XPROCESS (proc);
5937
5938
5939
5940 delete_read_fd (channel);
5941
5942 if (p->pid == -2)
5943 {
5944
5945
5946
5947 p->tick = ++process_tick;
5948 pset_status (p, Qfailed);
5949 }
5950 }
5951 #endif
5952
5953
5954 else if (nread == 0 && !NETCONN_P (proc) && !SERIALCONN_P (proc)
5955 && !PIPECONN_P (proc))
5956 ;
5957 else if (nread == 0 && PIPECONN_P (proc))
5958 {
5959
5960 XPROCESS (proc)->tick = ++process_tick;
5961 deactivate_process (proc);
5962 if (EQ (XPROCESS (proc)->status, Qrun))
5963 pset_status (XPROCESS (proc),
5964 list2 (Qexit, make_fixnum (0)));
5965 }
5966 else
5967 {
5968
5969 XPROCESS (proc)->tick = ++process_tick;
5970 deactivate_process (proc);
5971 if (XPROCESS (proc)->raw_status_new)
5972 update_status (XPROCESS (proc));
5973 if (EQ (XPROCESS (proc)->status, Qrun))
5974 pset_status (XPROCESS (proc),
5975 list2 (Qexit, make_fixnum (256)));
5976 }
5977 }
5978 if (FD_ISSET (channel, &Writeok)
5979 && (fd_callback_info[channel].flags
5980 & NON_BLOCKING_CONNECT_FD) != 0)
5981 {
5982 struct Lisp_Process *p;
5983
5984 delete_write_fd (channel);
5985
5986 proc = chan_process[channel];
5987 if (NILP (proc))
5988 continue;
5989
5990 p = XPROCESS (proc);
5991
5992 #ifndef WINDOWSNT
5993 {
5994 socklen_t xlen = sizeof (xerrno);
5995 if (getsockopt (channel, SOL_SOCKET, SO_ERROR, &xerrno, &xlen))
5996 xerrno = errno;
5997 }
5998 #else
5999
6000
6001
6002 {
6003 struct sockaddr pname;
6004 socklen_t pnamelen = sizeof (pname);
6005
6006
6007 xerrno = 0;
6008 if (getpeername (channel, &pname, &pnamelen) < 0)
6009 {
6010
6011 char dummy;
6012 xerrno = errno;
6013 if (errno == ENOTCONN && read (channel, &dummy, 1) < 0)
6014 xerrno = errno;
6015 }
6016 }
6017 #endif
6018 if (xerrno)
6019 {
6020 Lisp_Object addrinfos
6021 = connecting_status (p->status) ? XCDR (p->status) : Qnil;
6022 if (!NILP (addrinfos))
6023 XSETCDR (p->status, XCDR (addrinfos));
6024 else
6025 {
6026 p->tick = ++process_tick;
6027 pset_status (p, list2 (Qfailed, make_fixnum (xerrno)));
6028 }
6029 deactivate_process (proc);
6030 if (!NILP (addrinfos))
6031 connect_network_socket (proc, addrinfos, Qnil);
6032 }
6033 else
6034 {
6035 #ifdef HAVE_GNUTLS
6036
6037
6038
6039 if (NILP (p->gnutls_boot_parameters)
6040 && !p->gnutls_p)
6041 #endif
6042 {
6043 pset_status (p, Qrun);
6044
6045
6046
6047 exec_sentinel (proc, build_string ("open\n"));
6048 }
6049
6050 if (0 <= p->infd && !EQ (p->filter, Qt)
6051 && !EQ (p->command, Qt))
6052 add_process_read_fd (p->infd);
6053 }
6054 }
6055 }
6056 }
6057
6058 unbind_to (count, Qnil);
6059
6060
6061
6062
6063 if (read_kbd >= 0)
6064 {
6065
6066 clear_input_pending ();
6067 maybe_quit ();
6068 }
6069
6070
6071
6072
6073
6074
6075 if (wait_proc && wait_proc->nbytes_read != prev_wait_proc_nbytes_read)
6076 got_some_output = min (INT_MAX, (wait_proc->nbytes_read
6077 - prev_wait_proc_nbytes_read));
6078
6079 return got_some_output;
6080 }
6081
6082
6083
6084 static Lisp_Object
6085 read_process_output_call (Lisp_Object fun_and_args)
6086 {
6087 return apply1 (XCAR (fun_and_args), XCDR (fun_and_args));
6088 }
6089
6090 static Lisp_Object
6091 read_process_output_error_handler (Lisp_Object error_val)
6092 {
6093 cmd_error_internal (error_val, "error in process filter: ");
6094 Vinhibit_quit = Qt;
6095 update_echo_area ();
6096 if (process_error_pause_time > 0)
6097 Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
6098 return Qt;
6099 }
6100
6101 static void
6102 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
6103 ssize_t nbytes,
6104 struct coding_system *coding);
6105
6106
6107
6108
6109
6110
6111
6112
6113
6114
6115
6116
6117
6118 static int
6119 read_process_output (Lisp_Object proc, int channel)
6120 {
6121 ssize_t nbytes;
6122 struct Lisp_Process *p = XPROCESS (proc);
6123 eassert (0 <= channel && channel < FD_SETSIZE);
6124 struct coding_system *coding = proc_decode_coding_system[channel];
6125 int carryover = p->decoding_carryover;
6126 ptrdiff_t readmax = clip_to_bounds (1, read_process_output_max, PTRDIFF_MAX);
6127 specpdl_ref count = SPECPDL_INDEX ();
6128 Lisp_Object odeactivate;
6129 char *chars;
6130
6131 USE_SAFE_ALLOCA;
6132 chars = SAFE_ALLOCA (sizeof coding->carryover + readmax);
6133
6134 if (carryover)
6135
6136 memcpy (chars, SDATA (p->decoding_buf), carryover);
6137
6138 #ifdef DATAGRAM_SOCKETS
6139
6140 if (DATAGRAM_CHAN_P (channel))
6141 {
6142 socklen_t len = datagram_address[channel].len;
6143 do
6144 nbytes = recvfrom (channel, chars + carryover, readmax,
6145 0, datagram_address[channel].sa, &len);
6146 while (nbytes < 0 && errno == EINTR);
6147 }
6148 else
6149 #endif
6150 {
6151 bool buffered = proc_buffered_char[channel] >= 0;
6152 if (buffered)
6153 {
6154 chars[carryover] = proc_buffered_char[channel];
6155 proc_buffered_char[channel] = -1;
6156 }
6157 #ifdef HAVE_GNUTLS
6158 if (p->gnutls_p && p->gnutls_state)
6159 nbytes = emacs_gnutls_read (p, chars + carryover + buffered,
6160 readmax - buffered);
6161 else
6162 #endif
6163 nbytes = emacs_read (channel, chars + carryover + buffered,
6164 readmax - buffered);
6165 if (nbytes > 0 && p->adaptive_read_buffering)
6166 {
6167 int delay = p->read_output_delay;
6168 if (nbytes < 256)
6169 {
6170 if (delay < READ_OUTPUT_DELAY_MAX_MAX)
6171 {
6172 if (delay == 0)
6173 process_output_delay_count++;
6174 delay += READ_OUTPUT_DELAY_INCREMENT * 2;
6175 }
6176 }
6177 else if (delay > 0 && nbytes == readmax - buffered)
6178 {
6179 delay -= READ_OUTPUT_DELAY_INCREMENT;
6180 if (delay == 0)
6181 process_output_delay_count--;
6182 }
6183 p->read_output_delay = delay;
6184 if (delay)
6185 {
6186 p->read_output_skip = 1;
6187 process_output_skip = 1;
6188 }
6189 }
6190 nbytes += buffered;
6191 nbytes += buffered && nbytes <= 0;
6192 }
6193
6194 p->decoding_carryover = 0;
6195
6196 if (nbytes <= 0)
6197 {
6198 if (nbytes < 0 || coding->mode & CODING_MODE_LAST_BLOCK)
6199 {
6200 SAFE_FREE_UNBIND_TO (count, Qnil);
6201 return nbytes;
6202 }
6203 coding->mode |= CODING_MODE_LAST_BLOCK;
6204 }
6205
6206
6207
6208
6209
6210 p->nbytes_read += nbytes;
6211
6212
6213 nbytes += carryover;
6214
6215 odeactivate = Vdeactivate_mark;
6216
6217
6218
6219 record_unwind_current_buffer ();
6220
6221 read_and_dispose_of_process_output (p, chars, nbytes, coding);
6222
6223
6224 Vdeactivate_mark = odeactivate;
6225
6226 SAFE_FREE_UNBIND_TO (count, Qnil);
6227 return nbytes;
6228 }
6229
6230 static void
6231 read_and_dispose_of_process_output (struct Lisp_Process *p, char *chars,
6232 ssize_t nbytes,
6233 struct coding_system *coding)
6234 {
6235 Lisp_Object outstream = p->filter;
6236 Lisp_Object text;
6237 bool outer_running_asynch_code = running_asynch_code;
6238 int waiting = waiting_for_user_input_p;
6239
6240 #if 0
6241 Lisp_Object obuffer, okeymap;
6242 XSETBUFFER (obuffer, current_buffer);
6243 okeymap = BVAR (current_buffer, keymap);
6244 #endif
6245
6246
6247
6248
6249 specbind (Qinhibit_quit, Qt);
6250 specbind (Qlast_nonmenu_event, Qt);
6251
6252
6253
6254
6255 if (outer_running_asynch_code)
6256 {
6257 Lisp_Object tem;
6258
6259 tem = Fmatch_data (Qnil, Qnil, Qnil);
6260 restore_search_regs ();
6261 record_unwind_save_match_data ();
6262 Fset_match_data (tem, Qt);
6263 }
6264
6265
6266
6267 running_asynch_code = 1;
6268
6269 decode_coding_c_string (coding, (unsigned char *) chars, nbytes, Qt);
6270 text = coding->dst_object;
6271 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6272
6273 if (!EQ (p->decode_coding_system, Vlast_coding_system_used))
6274 {
6275 pset_decode_coding_system (p, Vlast_coding_system_used);
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288 eassert (p->outfd < FD_SETSIZE);
6289 if (NILP (p->encode_coding_system) && p->outfd >= 0
6290 && proc_encode_coding_system[p->outfd])
6291 {
6292 pset_encode_coding_system
6293 (p, coding_inherit_eol_type (Vlast_coding_system_used, Qnil));
6294 setup_coding_system (p->encode_coding_system,
6295 proc_encode_coding_system[p->outfd]);
6296 }
6297 }
6298
6299 if (coding->carryover_bytes > 0)
6300 {
6301 if (SCHARS (p->decoding_buf) < coding->carryover_bytes)
6302 pset_decoding_buf (p, make_uninit_string (coding->carryover_bytes));
6303 memcpy (SDATA (p->decoding_buf), coding->carryover,
6304 coding->carryover_bytes);
6305 p->decoding_carryover = coding->carryover_bytes;
6306 }
6307 if (SBYTES (text) > 0)
6308
6309
6310
6311 internal_condition_case_1 (read_process_output_call,
6312 list3 (outstream, make_lisp_proc (p), text),
6313 !NILP (Vdebug_on_error) ? Qnil : Qerror,
6314 read_process_output_error_handler);
6315
6316
6317 restore_search_regs ();
6318 running_asynch_code = outer_running_asynch_code;
6319
6320
6321
6322 waiting_for_user_input_p = waiting;
6323 }
6324
6325 DEFUN ("internal-default-process-filter", Finternal_default_process_filter,
6326 Sinternal_default_process_filter, 2, 2, 0,
6327 doc:
6328
6329 )
6330 (Lisp_Object proc, Lisp_Object text)
6331 {
6332 struct Lisp_Process *p;
6333 ptrdiff_t opoint;
6334
6335 CHECK_PROCESS (proc);
6336 p = XPROCESS (proc);
6337 CHECK_STRING (text);
6338
6339 if (!NILP (p->buffer) && BUFFER_LIVE_P (XBUFFER (p->buffer)))
6340 {
6341 Lisp_Object old_read_only;
6342 ptrdiff_t old_begv, old_zv;
6343 ptrdiff_t before, before_byte;
6344 ptrdiff_t opoint_byte;
6345 struct buffer *b;
6346
6347 Fset_buffer (p->buffer);
6348 opoint = PT;
6349 opoint_byte = PT_BYTE;
6350 old_read_only = BVAR (current_buffer, read_only);
6351 old_begv = BEGV;
6352 old_zv = ZV;
6353
6354 bset_read_only (current_buffer, Qnil);
6355
6356
6357
6358 if (XMARKER (p->mark)->buffer)
6359 set_point_from_marker (p->mark);
6360 else
6361 SET_PT_BOTH (ZV, ZV_BYTE);
6362 before = PT;
6363 before_byte = PT_BYTE;
6364
6365
6366
6367 if (! (BEGV <= PT && PT <= ZV))
6368 Fwiden ();
6369
6370
6371 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
6372 != ! STRING_MULTIBYTE (text))
6373 text = (STRING_MULTIBYTE (text)
6374 ? Fstring_as_unibyte (text)
6375 : Fstring_to_multibyte (text));
6376
6377
6378 insert_from_string_before_markers (text, 0, 0,
6379 SCHARS (text), SBYTES (text), 0);
6380
6381
6382
6383
6384 if (BUFFERP (p->buffer)
6385 && (b = XBUFFER (p->buffer), b != current_buffer))
6386 set_marker_both (p->mark, p->buffer, BUF_PT (b), BUF_PT_BYTE (b));
6387 else
6388 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
6389
6390 update_mode_lines = 23;
6391
6392
6393
6394 if (opoint >= before)
6395 {
6396 opoint += PT - before;
6397 opoint_byte += PT_BYTE - before_byte;
6398 }
6399 if (old_begv > before)
6400 old_begv += PT - before;
6401 if (old_zv >= before)
6402 old_zv += PT - before;
6403
6404
6405 if (old_begv != BEGV || old_zv != ZV)
6406 Fnarrow_to_region (make_fixnum (old_begv), make_fixnum (old_zv));
6407
6408 bset_read_only (current_buffer, old_read_only);
6409 SET_PT_BOTH (opoint, opoint_byte);
6410 }
6411 return Qnil;
6412 }
6413
6414
6415
6416
6417
6418
6419
6420
6421
6422
6423
6424
6425
6426
6427
6428
6429
6430
6431
6432
6433
6434
6435 static void
6436 write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
6437 const char *buf, ptrdiff_t len, bool front)
6438 {
6439 ptrdiff_t offset;
6440 Lisp_Object entry, obj;
6441
6442 if (STRINGP (input_obj))
6443 {
6444 offset = buf - SSDATA (input_obj);
6445 obj = input_obj;
6446 }
6447 else
6448 {
6449 offset = 0;
6450 obj = make_unibyte_string (buf, len);
6451 }
6452
6453 entry = Fcons (obj, Fcons (make_fixnum (offset), make_fixnum (len)));
6454
6455 if (front)
6456 pset_write_queue (p, Fcons (entry, p->write_queue));
6457 else
6458 pset_write_queue (p, nconc2 (p->write_queue, list1 (entry)));
6459 }
6460
6461
6462
6463
6464
6465 static bool
6466 write_queue_pop (struct Lisp_Process *p, Lisp_Object *obj,
6467 const char **buf, ptrdiff_t *len)
6468 {
6469 Lisp_Object entry, offset_length;
6470 ptrdiff_t offset;
6471
6472 if (NILP (p->write_queue))
6473 return 0;
6474
6475 entry = XCAR (p->write_queue);
6476 pset_write_queue (p, XCDR (p->write_queue));
6477
6478 *obj = XCAR (entry);
6479 offset_length = XCDR (entry);
6480
6481 *len = XFIXNUM (XCDR (offset_length));
6482 offset = XFIXNUM (XCAR (offset_length));
6483 *buf = SSDATA (*obj) + offset;
6484
6485 return 1;
6486 }
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498 static void
6499 send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
6500 Lisp_Object object)
6501 {
6502 struct Lisp_Process *p = XPROCESS (proc);
6503 ssize_t rv;
6504 struct coding_system *coding;
6505
6506 if (NETCONN_P (proc))
6507 {
6508 wait_while_connecting (proc);
6509 wait_for_tls_negotiation (proc);
6510 }
6511
6512 if (p->raw_status_new)
6513 update_status (p);
6514 if (! EQ (p->status, Qrun))
6515 error ("Process %s not running: %s", SDATA (p->name), SDATA (status_message (p)));
6516 if (p->outfd < 0)
6517 error ("Output file descriptor of %s is closed", SDATA (p->name));
6518
6519 eassert (p->outfd < FD_SETSIZE);
6520 coding = proc_encode_coding_system[p->outfd];
6521 Vlast_coding_system_used = CODING_ID_NAME (coding->id);
6522
6523 if ((STRINGP (object) && STRING_MULTIBYTE (object))
6524 || (BUFFERP (object)
6525 && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters)))
6526 || EQ (object, Qt))
6527 {
6528 pset_encode_coding_system
6529 (p, complement_process_encoding_system (p->encode_coding_system));
6530 if (!EQ (Vlast_coding_system_used, p->encode_coding_system))
6531 {
6532
6533
6534
6535
6536
6537
6538
6539
6540 setup_coding_system (p->encode_coding_system, coding);
6541 Vlast_coding_system_used = p->encode_coding_system;
6542 }
6543 coding->src_multibyte = 1;
6544 }
6545 else
6546 {
6547 coding->src_multibyte = 0;
6548
6549
6550
6551 if (CODING_REQUIRE_ENCODING (coding))
6552 {
6553 if (CODING_REQUIRE_FLUSHING (coding))
6554 {
6555
6556 coding->mode |= CODING_MODE_LAST_BLOCK;
6557 send_process (proc, "", 0, Qt);
6558 coding->mode &= CODING_MODE_LAST_BLOCK;
6559 }
6560 setup_coding_system (raw_text_coding_system
6561 (Vlast_coding_system_used),
6562 coding);
6563 coding->src_multibyte = 0;
6564 }
6565 }
6566 coding->dst_multibyte = 0;
6567
6568 if (CODING_REQUIRE_ENCODING (coding))
6569 {
6570 coding->dst_object = Qt;
6571 if (BUFFERP (object))
6572 {
6573 ptrdiff_t from_byte, from, to;
6574 ptrdiff_t save_pt, save_pt_byte;
6575 struct buffer *cur = current_buffer;
6576
6577 set_buffer_internal (XBUFFER (object));
6578 save_pt = PT, save_pt_byte = PT_BYTE;
6579
6580 from_byte = PTR_BYTE_POS ((unsigned char *) buf);
6581 from = BYTE_TO_CHAR (from_byte);
6582 to = BYTE_TO_CHAR (from_byte + len);
6583 TEMP_SET_PT_BOTH (from, from_byte);
6584 encode_coding_object (coding, object, from, from_byte,
6585 to, from_byte + len, Qt);
6586 TEMP_SET_PT_BOTH (save_pt, save_pt_byte);
6587 set_buffer_internal (cur);
6588 }
6589 else if (STRINGP (object))
6590 {
6591 encode_coding_object (coding, object, 0, 0, SCHARS (object),
6592 SBYTES (object), Qt);
6593 }
6594 else
6595 {
6596 coding->dst_object = make_unibyte_string (buf, len);
6597 coding->produced = len;
6598 }
6599
6600 len = coding->produced;
6601 object = coding->dst_object;
6602 buf = SSDATA (object);
6603 }
6604
6605
6606
6607 if (!NILP (p->write_queue))
6608 write_queue_push (p, object, buf, len, 0);
6609
6610 do
6611 {
6612 ptrdiff_t cur_len = -1;
6613 const char *cur_buf;
6614 Lisp_Object cur_object;
6615
6616
6617 if (!write_queue_pop (p, &cur_object, &cur_buf, &cur_len))
6618 {
6619 cur_len = len;
6620 cur_buf = buf;
6621 cur_object = object;
6622 }
6623
6624 while (cur_len > 0)
6625 {
6626
6627 ptrdiff_t written = 0;
6628 int outfd = p->outfd;
6629 if (outfd < 0)
6630 error ("Output file descriptor of %s is closed",
6631 SDATA (p->name));
6632 eassert (0 <= outfd && outfd < FD_SETSIZE);
6633 #ifdef DATAGRAM_SOCKETS
6634 if (DATAGRAM_CHAN_P (outfd))
6635 {
6636 while (true)
6637 {
6638 rv = sendto (outfd, cur_buf, cur_len, 0,
6639 datagram_address[outfd].sa,
6640 datagram_address[outfd].len);
6641 if (! (rv < 0 && errno == EINTR))
6642 break;
6643 if (pending_signals)
6644 process_pending_signals ();
6645 }
6646
6647 if (rv >= 0)
6648 written = rv;
6649 else if (errno == EMSGSIZE)
6650 report_file_error ("Sending datagram", proc);
6651 }
6652 else
6653 #endif
6654 {
6655 #ifdef HAVE_GNUTLS
6656 if (p->gnutls_p && p->gnutls_state)
6657 written = emacs_gnutls_write (p, cur_buf, cur_len);
6658 else
6659 #endif
6660 written = emacs_write_sig (outfd, cur_buf, cur_len);
6661 rv = (written ? 0 : -1);
6662 if (p->read_output_delay > 0
6663 && p->adaptive_read_buffering == 1)
6664 {
6665 p->read_output_delay = 0;
6666 process_output_delay_count--;
6667 p->read_output_skip = 0;
6668 }
6669 }
6670
6671 if (rv < 0)
6672 {
6673 if (would_block (errno))
6674
6675
6676
6677 {
6678 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690
6691
6692
6693
6694
6695
6696 if (errno == EAGAIN)
6697 {
6698 int flags = FWRITE;
6699 ioctl (p->outfd, TIOCFLUSH, &flags);
6700 }
6701 #endif
6702
6703
6704 write_queue_push (p, cur_object, cur_buf, cur_len, 1);
6705 wait_reading_process_output (0, 20 * 1000 * 1000,
6706 0, 0, Qnil, NULL, 0);
6707
6708 break;
6709 }
6710 else if (errno == EPIPE)
6711 {
6712 p->raw_status_new = 0;
6713 pset_status (p, list2 (Qexit, make_fixnum (256)));
6714 p->tick = ++process_tick;
6715 deactivate_process (proc);
6716 error ("process %s no longer connected to pipe; closed it",
6717 SDATA (p->name));
6718 }
6719 else
6720
6721 report_file_error ("Writing to process", proc);
6722 }
6723 cur_buf += written;
6724 cur_len -= written;
6725 }
6726 }
6727 while (!NILP (p->write_queue));
6728 }
6729
6730 DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
6731 3, 3, 0,
6732 doc:
6733
6734
6735
6736
6737
6738
6739
6740
6741
6742
6743 )
6744 (Lisp_Object process, Lisp_Object start, Lisp_Object end)
6745 {
6746 Lisp_Object proc = get_process (process);
6747 ptrdiff_t start_byte, end_byte;
6748
6749 validate_region (&start, &end);
6750
6751 start_byte = CHAR_TO_BYTE (XFIXNUM (start));
6752 end_byte = CHAR_TO_BYTE (XFIXNUM (end));
6753
6754 if (XFIXNUM (start) < GPT && XFIXNUM (end) > GPT)
6755 move_gap_both (XFIXNUM (start), start_byte);
6756
6757 if (NETCONN_P (proc))
6758 wait_while_connecting (proc);
6759
6760 send_process (proc, (char *) BYTE_POS_ADDR (start_byte),
6761 end_byte - start_byte, Fcurrent_buffer ());
6762
6763 return Qnil;
6764 }
6765
6766 DEFUN ("process-send-string", Fprocess_send_string, Sprocess_send_string,
6767 2, 2, 0,
6768 doc:
6769
6770
6771
6772
6773
6774
6775
6776
6777 )
6778 (Lisp_Object process, Lisp_Object string)
6779 {
6780 CHECK_STRING (string);
6781 Lisp_Object proc = get_process (process);
6782 send_process (proc, SSDATA (string),
6783 SBYTES (string), string);
6784 return Qnil;
6785 }
6786
6787
6788
6789 static pid_t
6790 emacs_get_tty_pgrp (struct Lisp_Process *p)
6791 {
6792 pid_t gid = -1;
6793
6794 #ifdef TIOCGPGRP
6795 if (ioctl (p->infd, TIOCGPGRP, &gid) == -1 && ! NILP (p->tty_name))
6796 {
6797 int fd;
6798
6799
6800 fd = emacs_open (SSDATA (p->tty_name), O_RDONLY, 0);
6801
6802 if (fd != -1)
6803 {
6804 ioctl (fd, TIOCGPGRP, &gid);
6805 emacs_close (fd);
6806 }
6807 }
6808 #endif
6809
6810 return gid;
6811 }
6812
6813 DEFUN ("process-running-child-p", Fprocess_running_child_p,
6814 Sprocess_running_child_p, 0, 1, 0,
6815 doc:
6816
6817
6818
6819
6820
6821 )
6822 (Lisp_Object process)
6823 {
6824
6825
6826 Lisp_Object proc = get_process (process);
6827 struct Lisp_Process *p = XPROCESS (proc);
6828
6829 if (!EQ (p->type, Qreal))
6830 error ("Process %s is not a subprocess",
6831 SDATA (p->name));
6832 if (p->infd < 0)
6833 error ("Process %s is not active",
6834 SDATA (p->name));
6835
6836 pid_t gid = emacs_get_tty_pgrp (p);
6837
6838 if (gid == p->pid)
6839 return Qnil;
6840 if (gid != -1)
6841 return make_fixnum (gid);
6842 return Qt;
6843 }
6844
6845
6846
6847
6848
6849
6850
6851
6852
6853
6854
6855
6856
6857
6858
6859 static void
6860 process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group,
6861 bool nomsg)
6862 {
6863 Lisp_Object proc;
6864 struct Lisp_Process *p;
6865 pid_t gid;
6866 bool no_pgrp = 0;
6867
6868 proc = get_process (process);
6869 p = XPROCESS (proc);
6870
6871 if (!EQ (p->type, Qreal))
6872 error ("Process %s is not a subprocess",
6873 SDATA (p->name));
6874 if (p->infd < 0)
6875 error ("Process %s is not active",
6876 SDATA (p->name));
6877
6878 if (! p->pty_in)
6879 current_group = Qnil;
6880
6881
6882 if (NILP (current_group))
6883
6884 gid = p->pid;
6885 else
6886 {
6887 #ifdef SIGNALS_VIA_CHARACTERS
6888
6889
6890
6891 struct termios t;
6892 cc_t *sig_char = NULL;
6893
6894 tcgetattr (p->infd, &t);
6895
6896 switch (signo)
6897 {
6898 case SIGINT:
6899 sig_char = &t.c_cc[VINTR];
6900 break;
6901
6902 case SIGQUIT:
6903 sig_char = &t.c_cc[VQUIT];
6904 break;
6905
6906 case SIGTSTP:
6907 #ifdef VSWTCH
6908 sig_char = &t.c_cc[VSWTCH];
6909 #else
6910 sig_char = &t.c_cc[VSUSP];
6911 #endif
6912 break;
6913 }
6914
6915 if (sig_char && *sig_char != CDISABLE)
6916 {
6917 send_process (proc, (char *) sig_char, 1, Qnil);
6918 return;
6919 }
6920
6921
6922
6923
6924
6925 #endif
6926
6927 #ifdef TIOCGPGRP
6928
6929
6930
6931
6932
6933
6934
6935
6936 gid = emacs_get_tty_pgrp (p);
6937
6938 if (gid == -1)
6939
6940
6941 gid = p->pid;
6942
6943
6944
6945
6946 if (gid == -1)
6947 no_pgrp = 1;
6948 #else
6949
6950
6951 gid = p->pid;
6952 #endif
6953
6954
6955
6956 if (EQ (current_group, Qlambda) && gid == p->pid)
6957 return;
6958 }
6959
6960 #ifdef SIGCONT
6961 if (signo == SIGCONT)
6962 {
6963 p->raw_status_new = 0;
6964 pset_status (p, Qrun);
6965 p->tick = ++process_tick;
6966 if (!nomsg)
6967 {
6968 status_notify (NULL, NULL);
6969 redisplay_preserve_echo_area (13);
6970 }
6971 }
6972 #endif
6973
6974 #ifdef TIOCSIGSEND
6975
6976
6977 if (! NILP (current_group) && ioctl (p->infd, TIOCSIGSEND, signo) != -1)
6978 return;
6979 #endif
6980
6981
6982
6983
6984 pid_t pid = no_pgrp ? gid : - gid;
6985
6986
6987
6988 sigset_t oldset;
6989 block_child_signal (&oldset);
6990 if (p->alive)
6991 kill (pid, signo);
6992 unblock_child_signal (&oldset);
6993 }
6994
6995 DEFUN ("internal-default-interrupt-process",
6996 Finternal_default_interrupt_process,
6997 Sinternal_default_interrupt_process, 0, 2, 0,
6998 doc:
6999
7000 )
7001 (Lisp_Object process, Lisp_Object current_group)
7002 {
7003 process_send_signal (process, SIGINT, current_group, 0);
7004 return process;
7005 }
7006
7007 DEFUN ("interrupt-process", Finterrupt_process, Sinterrupt_process, 0, 2, 0,
7008 doc:
7009
7010
7011
7012
7013
7014
7015
7016
7017
7018
7019
7020
7021 )
7022 (Lisp_Object process, Lisp_Object current_group)
7023 {
7024 return CALLN (Frun_hook_with_args_until_success, Qinterrupt_process_functions,
7025 process, current_group);
7026 }
7027
7028 DEFUN ("kill-process", Fkill_process, Skill_process, 0, 2,
7029 "(list (read-process-name \"Kill process\"))",
7030 doc:
7031 )
7032 (Lisp_Object process, Lisp_Object current_group)
7033 {
7034 process_send_signal (process, SIGKILL, current_group, 0);
7035 return process;
7036 }
7037
7038 DEFUN ("quit-process", Fquit_process, Squit_process, 0, 2, 0,
7039 doc:
7040 )
7041 (Lisp_Object process, Lisp_Object current_group)
7042 {
7043 process_send_signal (process, SIGQUIT, current_group, 0);
7044 return process;
7045 }
7046
7047 DEFUN ("stop-process", Fstop_process, Sstop_process, 0, 2, 0,
7048 doc:
7049
7050
7051 )
7052 (Lisp_Object process, Lisp_Object current_group)
7053 {
7054 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
7055 || PIPECONN_P (process)))
7056 {
7057 struct Lisp_Process *p;
7058
7059 p = XPROCESS (process);
7060 if (NILP (p->command)
7061 && p->infd >= 0)
7062 delete_read_fd (p->infd);
7063 pset_command (p, Qt);
7064 return process;
7065 }
7066 #ifndef SIGTSTP
7067 error ("No SIGTSTP support");
7068 #else
7069 process_send_signal (process, SIGTSTP, current_group, 0);
7070 #endif
7071 return process;
7072 }
7073
7074 DEFUN ("continue-process", Fcontinue_process, Scontinue_process, 0, 2, 0,
7075 doc:
7076
7077
7078 )
7079 (Lisp_Object process, Lisp_Object current_group)
7080 {
7081 if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process)
7082 || PIPECONN_P (process)))
7083 {
7084 struct Lisp_Process *p;
7085
7086 p = XPROCESS (process);
7087 eassert (p->infd < FD_SETSIZE);
7088 if (EQ (p->command, Qt)
7089 && p->infd >= 0
7090 && (!EQ (p->filter, Qt) || EQ (p->status, Qlisten)))
7091 {
7092 add_process_read_fd (p->infd);
7093 #ifdef WINDOWSNT
7094 if (fd_info[ p->infd ].flags & FILE_SERIAL)
7095 PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR);
7096 #else
7097 tcflush (p->infd, TCIFLUSH);
7098 #endif
7099 }
7100 pset_command (p, Qnil);
7101 return process;
7102 }
7103 #ifdef SIGCONT
7104 process_send_signal (process, SIGCONT, current_group, 0);
7105 #else
7106 error ("No SIGCONT support");
7107 #endif
7108 return process;
7109 }
7110
7111
7112
7113 static int
7114 abbr_to_signal (char const *name)
7115 {
7116 int i, signo;
7117 char sigbuf[20];
7118
7119 if (!strncmp (name, "SIG", 3) || !strncmp (name, "sig", 3))
7120 name += 3;
7121
7122 for (i = 0; i < sizeof sigbuf; i++)
7123 {
7124 sigbuf[i] = c_toupper (name[i]);
7125 if (! sigbuf[i])
7126 return str2sig (sigbuf, &signo) == 0 ? signo : -1;
7127 }
7128
7129 return -1;
7130 }
7131
7132 DEFUN ("internal-default-signal-process",
7133 Finternal_default_signal_process,
7134 Sinternal_default_signal_process, 2, 3, 0,
7135 doc:
7136
7137 )
7138 (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
7139 {
7140 pid_t pid;
7141 int signo;
7142
7143 if (STRINGP (process))
7144 {
7145 Lisp_Object tem = Fget_process (process);
7146 if (NILP (tem))
7147 {
7148 ptrdiff_t len;
7149 tem = string_to_number (SSDATA (process), 10, &len);
7150 if ((IEEE_FLOATING_POINT ? NILP (tem) : !NUMBERP (tem))
7151 || len != SBYTES (process))
7152 return Qnil;
7153 }
7154 process = tem;
7155 }
7156 else if (!NUMBERP (process))
7157 process = get_process (process);
7158
7159 if (NILP (process))
7160 return process;
7161
7162 if (NUMBERP (process))
7163 CONS_TO_INTEGER (process, pid_t, pid);
7164 else
7165 {
7166 CHECK_PROCESS (process);
7167 pid = XPROCESS (process)->pid;
7168 if (pid <= 0)
7169 error ("Cannot signal process %s", SDATA (XPROCESS (process)->name));
7170 }
7171
7172 if (FIXNUMP (sigcode))
7173 signo = check_integer_range (sigcode, INT_MIN, INT_MAX);
7174 else
7175 {
7176 char *name;
7177
7178 CHECK_SYMBOL (sigcode);
7179 name = SSDATA (SYMBOL_NAME (sigcode));
7180
7181 signo = abbr_to_signal (name);
7182 if (signo < 0)
7183 error ("Undefined signal name %s", name);
7184 }
7185
7186 return make_fixnum (kill (pid, signo));
7187 }
7188
7189 DEFUN ("signal-process", Fsignal_process, Ssignal_process,
7190 2, 3, "(list (read-string \"Process (name or number): \") (read-signal-name))",
7191 doc:
7192
7193
7194
7195
7196
7197
7198
7199 )
7200 (Lisp_Object process, Lisp_Object sigcode, Lisp_Object remote)
7201 {
7202 return CALLN (Frun_hook_with_args_until_success, Qsignal_process_functions,
7203 process, sigcode, remote);
7204 }
7205
7206 DEFUN ("process-send-eof", Fprocess_send_eof, Sprocess_send_eof, 0, 1, 0,
7207 doc:
7208
7209
7210
7211
7212
7213
7214
7215 )
7216 (Lisp_Object process)
7217 {
7218 Lisp_Object proc;
7219 struct coding_system *coding = NULL;
7220 int outfd;
7221
7222 proc = get_process (process);
7223
7224 if (NETCONN_P (proc))
7225 wait_while_connecting (proc);
7226
7227 if (DATAGRAM_CONN_P (proc))
7228 return process;
7229
7230
7231 outfd = XPROCESS (proc)->outfd;
7232 eassert (outfd < FD_SETSIZE);
7233 if (outfd >= 0)
7234 coding = proc_encode_coding_system[outfd];
7235
7236
7237 if (XPROCESS (proc)->raw_status_new)
7238 update_status (XPROCESS (proc));
7239 if (! EQ (XPROCESS (proc)->status, Qrun))
7240 error ("Process %s not running: %s", SDATA (XPROCESS (proc)->name), SDATA (status_message (XPROCESS (proc))));
7241
7242 if (coding && CODING_REQUIRE_FLUSHING (coding))
7243 {
7244 coding->mode |= CODING_MODE_LAST_BLOCK;
7245 send_process (proc, "", 0, Qnil);
7246 }
7247
7248 if (XPROCESS (proc)->pty_in)
7249 send_process (proc, "\004", 1, Qnil);
7250 else if (EQ (XPROCESS (proc)->type, Qserial))
7251 {
7252 #if !defined WINDOWSNT && defined HAVE_TCDRAIN
7253 if (tcdrain (XPROCESS (proc)->outfd) != 0)
7254 report_file_error ("Failed tcdrain", Qnil);
7255 #endif
7256
7257 }
7258 else
7259 {
7260 struct Lisp_Process *p = XPROCESS (proc);
7261 int old_outfd = p->outfd;
7262 int new_outfd;
7263
7264 #ifdef HAVE_SHUTDOWN
7265
7266
7267
7268
7269 if (0 <= old_outfd
7270 && (EQ (p->type, Qnetwork) || p->infd == old_outfd))
7271 shutdown (old_outfd, 1);
7272 #endif
7273 close_process_fd (&p->open_fd[WRITE_TO_SUBPROCESS]);
7274 new_outfd = emacs_open (NULL_DEVICE, O_WRONLY, 0);
7275 if (new_outfd < 0)
7276 report_file_error ("Opening null device", Qnil);
7277 p->open_fd[WRITE_TO_SUBPROCESS] = new_outfd;
7278 p->outfd = new_outfd;
7279
7280 eassert (0 <= new_outfd && new_outfd < FD_SETSIZE);
7281 if (!proc_encode_coding_system[new_outfd])
7282 proc_encode_coding_system[new_outfd]
7283 = xmalloc (sizeof (struct coding_system));
7284 if (old_outfd >= 0)
7285 {
7286 eassert (old_outfd < FD_SETSIZE);
7287 *proc_encode_coding_system[new_outfd]
7288 = *proc_encode_coding_system[old_outfd];
7289 memset (proc_encode_coding_system[old_outfd], 0,
7290 sizeof (struct coding_system));
7291 }
7292 else
7293 setup_coding_system (p->encode_coding_system,
7294 proc_encode_coding_system[new_outfd]);
7295 }
7296 return process;
7297 }
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
7309
7310
7311
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
7327
7328
7329
7330
7331
7332
7333
7334
7335
7336
7337
7338
7339
7340
7341
7342
7343
7344
7345
7346 void
7347 child_signal_init (void)
7348 {
7349
7350 eassert ((child_signal_read_fd < 0) == (child_signal_write_fd < 0));
7351
7352 #ifndef WINDOWSNT
7353 if (0 <= child_signal_read_fd)
7354 return;
7355
7356 int fds[2];
7357 if (emacs_pipe (fds) < 0)
7358 report_file_error ("Creating pipe for child signal", Qnil);
7359 if (FD_SETSIZE <= fds[0])
7360 {
7361
7362
7363 emacs_close (fds[0]);
7364 emacs_close (fds[1]);
7365 report_file_errno ("Creating pipe for child signal", Qnil,
7366 EMFILE);
7367 }
7368
7369
7370
7371 eassert (0 <= fds[0]);
7372 eassert (0 <= fds[1]);
7373 if (fcntl (fds[0], F_SETFL, O_NONBLOCK) != 0)
7374 emacs_perror ("fcntl");
7375 if (fcntl (fds[1], F_SETFL, O_NONBLOCK) != 0)
7376 emacs_perror ("fcntl");
7377 add_read_fd (fds[0], child_signal_read, NULL);
7378 fd_callback_info[fds[0]].flags &= ~KEYBOARD_FD;
7379 child_signal_read_fd = fds[0];
7380 child_signal_write_fd = fds[1];
7381 #endif
7382 }
7383
7384 #ifndef WINDOWSNT
7385
7386
7387 static void
7388 child_signal_read (int fd, void *data)
7389 {
7390 eassert (0 <= fd);
7391 eassert (fd == child_signal_read_fd);
7392 char dummy;
7393 if (emacs_read (fd, &dummy, 1) < 0 && errno != EAGAIN)
7394 emacs_perror ("reading from child signal FD");
7395 }
7396 #endif
7397
7398
7399
7400
7401 static void
7402 child_signal_notify (void)
7403 {
7404 #ifndef WINDOWSNT
7405 int fd = child_signal_write_fd;
7406 eassert (0 <= fd);
7407 char dummy = 0;
7408 if (emacs_write (fd, &dummy, 1) != 1)
7409 emacs_perror ("writing to child signal FD");
7410 #endif
7411 }
7412
7413
7414
7415
7416
7417
7418 static void dummy_handler (int sig) {}
7419 static signal_handler_t volatile lib_child_handler;
7420
7421
7422
7423
7424
7425
7426
7427
7428
7429
7430
7431
7432
7433
7434
7435
7436
7437
7438
7439
7440
7441
7442
7443
7444
7445
7446 static void
7447 handle_child_signal (int sig)
7448 {
7449 Lisp_Object tail, proc;
7450 bool changed = false;
7451
7452
7453
7454
7455
7456 for (tail = deleted_pid_list; CONSP (tail); tail = XCDR (tail))
7457 {
7458 bool all_pids_are_fixnums
7459 = (MOST_NEGATIVE_FIXNUM <= TYPE_MINIMUM (pid_t)
7460 && TYPE_MAXIMUM (pid_t) <= MOST_POSITIVE_FIXNUM);
7461 Lisp_Object head = XCAR (tail);
7462 Lisp_Object xpid;
7463 if (! CONSP (head))
7464 continue;
7465 xpid = XCAR (head);
7466 if (all_pids_are_fixnums ? FIXNUMP (xpid) : INTEGERP (xpid))
7467 {
7468 intmax_t deleted_pid;
7469 bool ok = integer_to_intmax (xpid, &deleted_pid);
7470 eassert (ok);
7471 if (child_status_changed (deleted_pid, 0, 0))
7472 {
7473 changed = true;
7474 if (STRINGP (XCDR (head)))
7475
7476
7477
7478
7479
7480
7481
7482
7483
7484
7485 unlink (SSDATA (XCDR (head)));
7486 XSETCAR (tail, Qnil);
7487 }
7488 }
7489 }
7490
7491
7492 FOR_EACH_PROCESS (tail, proc)
7493 {
7494 struct Lisp_Process *p = XPROCESS (proc);
7495 int status;
7496
7497 if (p->alive
7498 && child_status_changed (p->pid, &status, WUNTRACED | WCONTINUED))
7499 {
7500
7501 changed = true;
7502 p->tick = ++process_tick;
7503 p->raw_status = status;
7504 p->raw_status_new = 1;
7505
7506
7507 if (WIFSIGNALED (status) || WIFEXITED (status))
7508 {
7509 bool clear_desc_flag = 0;
7510 p->alive = 0;
7511 if (p->infd >= 0)
7512 clear_desc_flag = 1;
7513
7514
7515 if (clear_desc_flag)
7516 delete_read_fd (p->infd);
7517 }
7518 }
7519 }
7520
7521 if (changed)
7522
7523 child_signal_notify ();
7524
7525 lib_child_handler (sig);
7526 #ifdef NS_IMPL_GNUSTEP
7527
7528
7529 catch_child_signal ();
7530 #endif
7531 }
7532
7533 static void
7534 deliver_child_signal (int sig)
7535 {
7536 deliver_process_signal (sig, handle_child_signal);
7537 }
7538
7539
7540 static Lisp_Object
7541 exec_sentinel_error_handler (Lisp_Object error_val)
7542 {
7543
7544
7545 if (!CONSP (error_val))
7546 error_val = Fcons (Qerror, error_val);
7547 cmd_error_internal (error_val, "error in process sentinel: ");
7548 Vinhibit_quit = Qt;
7549 update_echo_area ();
7550 if (process_error_pause_time > 0)
7551 Fsleep_for (make_fixnum (process_error_pause_time), Qnil);
7552 return Qt;
7553 }
7554
7555 static void
7556 exec_sentinel (Lisp_Object proc, Lisp_Object reason)
7557 {
7558 Lisp_Object sentinel, odeactivate;
7559 struct Lisp_Process *p = XPROCESS (proc);
7560 specpdl_ref count = SPECPDL_INDEX ();
7561 bool outer_running_asynch_code = running_asynch_code;
7562 int waiting = waiting_for_user_input_p;
7563
7564 if (inhibit_sentinels)
7565 return;
7566
7567 odeactivate = Vdeactivate_mark;
7568 #if 0
7569 Lisp_Object obuffer, okeymap;
7570 XSETBUFFER (obuffer, current_buffer);
7571 okeymap = BVAR (current_buffer, keymap);
7572 #endif
7573
7574
7575
7576
7577 record_unwind_current_buffer ();
7578
7579 sentinel = p->sentinel;
7580
7581
7582 specbind (Qinhibit_quit, Qt);
7583 specbind (Qlast_nonmenu_event, Qt);
7584
7585
7586
7587
7588 if (outer_running_asynch_code)
7589 {
7590 Lisp_Object tem;
7591 tem = Fmatch_data (Qnil, Qnil, Qnil);
7592 restore_search_regs ();
7593 record_unwind_save_match_data ();
7594 Fset_match_data (tem, Qt);
7595 }
7596
7597
7598
7599 running_asynch_code = 1;
7600
7601 internal_condition_case_1 (read_process_output_call,
7602 list3 (sentinel, proc, reason),
7603 !NILP (Vdebug_on_error) ? Qnil : Qerror,
7604 exec_sentinel_error_handler);
7605
7606
7607 restore_search_regs ();
7608 running_asynch_code = outer_running_asynch_code;
7609
7610 Vdeactivate_mark = odeactivate;
7611
7612
7613
7614 waiting_for_user_input_p = waiting;
7615
7616 unbind_to (count, Qnil);
7617 }
7618
7619
7620
7621
7622
7623
7624
7625
7626
7627
7628 static int
7629 status_notify (struct Lisp_Process *deleting_process,
7630 struct Lisp_Process *wait_proc)
7631 {
7632 Lisp_Object proc;
7633 Lisp_Object tail, msg;
7634 int got_some_output = -1;
7635
7636 tail = Qnil;
7637 msg = Qnil;
7638
7639
7640
7641 update_tick = process_tick;
7642
7643 FOR_EACH_PROCESS (tail, proc)
7644 {
7645 Lisp_Object symbol;
7646 register struct Lisp_Process *p = XPROCESS (proc);
7647
7648 if (p->tick != p->update_tick)
7649 {
7650 p->update_tick = p->tick;
7651
7652
7653 while (! EQ (p->filter, Qt)
7654 && ! connecting_status (p->status)
7655 && ! EQ (p->status, Qlisten)
7656
7657 && ! EQ (p->command, Qt)
7658 && p->infd >= 0
7659 && p != deleting_process)
7660 {
7661 int nread = read_process_output (proc, p->infd);
7662 if ((!wait_proc || wait_proc == XPROCESS (proc))
7663 && got_some_output < nread)
7664 got_some_output = nread;
7665 if (nread <= 0)
7666 break;
7667 }
7668
7669
7670 if (p->raw_status_new)
7671 update_status (p);
7672 msg = status_message (p);
7673
7674
7675 symbol = p->status;
7676 if (CONSP (p->status))
7677 symbol = XCAR (p->status);
7678
7679 if (EQ (symbol, Qsignal) || EQ (symbol, Qexit)
7680 || EQ (symbol, Qclosed))
7681 {
7682 if (delete_exited_processes)
7683 remove_process (proc);
7684 else
7685 deactivate_process (proc);
7686 }
7687
7688
7689
7690
7691 p->update_tick = p->tick;
7692
7693 exec_sentinel (proc, msg);
7694 if (BUFFERP (p->buffer))
7695
7696 bset_update_mode_line (XBUFFER (p->buffer));
7697 }
7698 }
7699
7700 return got_some_output;
7701 }
7702
7703 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel,
7704 Sinternal_default_process_sentinel, 2, 2, 0,
7705 doc:
7706 )
7707 (Lisp_Object proc, Lisp_Object msg)
7708 {
7709 Lisp_Object buffer, symbol;
7710 struct Lisp_Process *p;
7711 CHECK_PROCESS (proc);
7712 p = XPROCESS (proc);
7713 buffer = p->buffer;
7714 symbol = p->status;
7715 if (CONSP (symbol))
7716 symbol = XCAR (symbol);
7717
7718 if (!EQ (symbol, Qrun) && !NILP (buffer))
7719 {
7720 Lisp_Object tem;
7721 struct buffer *old = current_buffer;
7722 ptrdiff_t opoint, opoint_byte;
7723 ptrdiff_t before, before_byte;
7724
7725
7726
7727 if (!BUFFER_LIVE_P (XBUFFER (buffer)))
7728 return Qnil;
7729 Fset_buffer (buffer);
7730
7731 if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
7732 msg = (code_convert_string_norecord
7733 (msg, Vlocale_coding_system, 1));
7734
7735 opoint = PT;
7736 opoint_byte = PT_BYTE;
7737
7738
7739
7740 if (XMARKER (p->mark)->buffer)
7741 Fgoto_char (p->mark);
7742 else
7743 SET_PT_BOTH (ZV, ZV_BYTE);
7744
7745 before = PT;
7746 before_byte = PT_BYTE;
7747
7748 tem = BVAR (current_buffer, read_only);
7749 bset_read_only (current_buffer, Qnil);
7750 insert_string ("\nProcess ");
7751 {
7752 Lisp_Object tem2 = p->name; Finsert (1, &tem2); }
7753 insert_string (" ");
7754 Finsert (1, &msg);
7755 bset_read_only (current_buffer, tem);
7756 set_marker_both (p->mark, p->buffer, PT, PT_BYTE);
7757
7758 if (opoint >= before)
7759 SET_PT_BOTH (opoint + (PT - before),
7760 opoint_byte + (PT_BYTE - before_byte));
7761 else
7762 SET_PT_BOTH (opoint, opoint_byte);
7763
7764 set_buffer_internal (old);
7765 }
7766 return Qnil;
7767 }
7768
7769
7770 DEFUN ("set-process-coding-system", Fset_process_coding_system,
7771 Sset_process_coding_system, 1, 3, 0,
7772 doc:
7773
7774 )
7775 (Lisp_Object process, Lisp_Object decoding, Lisp_Object encoding)
7776 {
7777 CHECK_PROCESS (process);
7778
7779 struct Lisp_Process *p = XPROCESS (process);
7780
7781 Fcheck_coding_system (decoding);
7782 Fcheck_coding_system (encoding);
7783 encoding = coding_inherit_eol_type (encoding, Qnil);
7784 pset_decode_coding_system (p, decoding);
7785 pset_encode_coding_system (p, encoding);
7786
7787
7788
7789 if (p->infd < 0 || p->outfd < 0)
7790 return Qnil;
7791
7792 setup_process_coding_systems (process);
7793
7794 return Qnil;
7795 }
7796
7797 DEFUN ("process-coding-system",
7798 Fprocess_coding_system, Sprocess_coding_system, 1, 1, 0,
7799 doc: )
7800 (register Lisp_Object process)
7801 {
7802 CHECK_PROCESS (process);
7803 return Fcons (XPROCESS (process)->decode_coding_system,
7804 XPROCESS (process)->encode_coding_system);
7805 }
7806
7807
7808
7809
7810 # ifdef HAVE_GPM
7811
7812 void
7813 add_gpm_wait_descriptor (int desc)
7814 {
7815 add_keyboard_wait_descriptor (desc);
7816 }
7817
7818 void
7819 delete_gpm_wait_descriptor (int desc)
7820 {
7821 delete_keyboard_wait_descriptor (desc);
7822 }
7823
7824 # endif
7825
7826 #if defined (USABLE_SIGIO) || defined (USABLE_SIGPOLL)
7827
7828
7829
7830
7831 static bool
7832 keyboard_bit_set (fd_set *mask)
7833 {
7834 int fd;
7835
7836 eassert (max_desc < FD_SETSIZE);
7837 for (fd = 0; fd <= max_desc; fd++)
7838 if (FD_ISSET (fd, mask)
7839 && ((fd_callback_info[fd].flags & (FOR_READ | KEYBOARD_FD))
7840 == (FOR_READ | KEYBOARD_FD)))
7841 return 1;
7842
7843 return 0;
7844 }
7845 # endif
7846
7847 #else
7848
7849
7850
7851 void
7852 update_processes_for_thread_death (Lisp_Object dying_thread)
7853 {
7854 }
7855
7856
7857 extern int sys_select (int, fd_set *, fd_set *, fd_set *,
7858 struct timespec *, void *);
7859
7860
7861
7862
7863
7864
7865
7866
7867
7868
7869
7870
7871
7872
7873
7874
7875
7876
7877
7878
7879
7880
7881
7882
7883
7884
7885
7886
7887
7888
7889
7890 int
7891 wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
7892 bool do_display,
7893 Lisp_Object wait_for_cell,
7894 struct Lisp_Process *wait_proc, int just_wait_proc)
7895 {
7896 register int nfds;
7897 struct timespec end_time, timeout;
7898 enum { MINIMUM = -1, TIMEOUT, FOREVER } wait;
7899
7900 if (TYPE_MAXIMUM (time_t) < time_limit)
7901 time_limit = TYPE_MAXIMUM (time_t);
7902
7903 if (time_limit < 0 || nsecs < 0)
7904 wait = MINIMUM;
7905 else if (time_limit > 0 || nsecs > 0)
7906 {
7907 wait = TIMEOUT;
7908 end_time = timespec_add (current_timespec (),
7909 make_timespec (time_limit, nsecs));
7910 }
7911 else
7912 wait = FOREVER;
7913
7914
7915
7916
7917 stop_polling ();
7918 turn_on_atimers (0);
7919
7920 while (1)
7921 {
7922 bool timeout_reduced_for_timers = false;
7923 fd_set waitchannels;
7924 int xerrno;
7925
7926
7927
7928
7929 if (read_kbd >= 0)
7930 maybe_quit ();
7931
7932
7933 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
7934 break;
7935
7936
7937
7938 if (wait == TIMEOUT)
7939 {
7940 struct timespec now = current_timespec ();
7941 if (timespec_cmp (end_time, now) <= 0)
7942 break;
7943 timeout = timespec_sub (end_time, now);
7944 }
7945 else
7946 timeout = make_timespec (wait < TIMEOUT ? 0 : 100000, 0);
7947
7948
7949
7950
7951
7952 if (NILP (wait_for_cell))
7953 {
7954 struct timespec timer_delay;
7955
7956 do
7957 {
7958 unsigned old_timers_run = timers_run;
7959 timer_delay = timer_check ();
7960 if (timers_run != old_timers_run && do_display)
7961
7962
7963 redisplay_preserve_echo_area (14);
7964 else
7965 break;
7966 }
7967 while (!detect_input_pending ());
7968
7969
7970 if (read_kbd != 0
7971 && requeued_events_pending_p ())
7972 break;
7973
7974 if (timespec_valid_p (timer_delay))
7975 {
7976 if (timespec_cmp (timer_delay, timeout) < 0)
7977 {
7978 timeout = timer_delay;
7979 timeout_reduced_for_timers = true;
7980 }
7981 }
7982 }
7983
7984
7985
7986 if (read_kbd < 0)
7987 set_waiting_for_input (&timeout);
7988
7989
7990
7991 if (frame_garbaged && do_display)
7992 {
7993 clear_waiting_for_input ();
7994 redisplay_preserve_echo_area (15);
7995 if (read_kbd < 0)
7996 set_waiting_for_input (&timeout);
7997 }
7998
7999
8000 FD_ZERO (&waitchannels);
8001 if (read_kbd && detect_input_pending ())
8002 nfds = 0;
8003 else
8004 {
8005 if (read_kbd || !NILP (wait_for_cell))
8006 FD_SET (0, &waitchannels);
8007 nfds = pselect (1, &waitchannels, NULL, NULL, &timeout, NULL);
8008 }
8009
8010 xerrno = errno;
8011
8012
8013 clear_waiting_for_input ();
8014
8015
8016 do_pending_window_change (0);
8017
8018 if (wait < FOREVER && nfds == 0 && ! timeout_reduced_for_timers)
8019
8020 break;
8021
8022 if (nfds == -1)
8023 {
8024
8025
8026 if (xerrno == EINTR)
8027 FD_ZERO (&waitchannels);
8028 else
8029 report_file_errno ("Failed select", Qnil, xerrno);
8030 }
8031
8032
8033
8034 if (read_kbd
8035 && detect_input_pending_run_timers (do_display))
8036 {
8037 swallow_events (do_display);
8038 if (detect_input_pending_run_timers (do_display))
8039 break;
8040 }
8041
8042
8043 if (read_kbd
8044 && requeued_events_pending_p ())
8045 break;
8046
8047
8048
8049
8050
8051
8052
8053 if (! NILP (wait_for_cell)
8054 && detect_input_pending ())
8055 {
8056 swallow_events (do_display);
8057 if (detect_input_pending ())
8058 break;
8059 }
8060
8061
8062 if (! NILP (wait_for_cell) && ! NILP (XCAR (wait_for_cell)))
8063 break;
8064 }
8065
8066 start_polling ();
8067
8068 return -1;
8069 }
8070
8071 #endif
8072
8073
8074
8075
8076 #ifdef HAVE_TIMERFD
8077
8078
8079
8080
8081 void
8082 add_timer_wait_descriptor (int fd)
8083 {
8084 eassert (0 <= fd && fd < FD_SETSIZE);
8085 add_read_fd (fd, timerfd_callback, NULL);
8086 fd_callback_info[fd].flags &= ~KEYBOARD_FD;
8087 }
8088
8089 #endif
8090
8091
8092
8093
8094 Lisp_Object
8095 remove_slash_colon (Lisp_Object name)
8096 {
8097 return
8098 (SREF (name, 0) == '/' && SREF (name, 1) == ':'
8099 ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
8100 SBYTES (name) - 2, STRING_MULTIBYTE (name))
8101 : name);
8102 }
8103
8104
8105
8106 void
8107 add_keyboard_wait_descriptor (int desc)
8108 {
8109 #ifdef subprocesses
8110 eassert (desc >= 0 && desc < FD_SETSIZE);
8111 fd_callback_info[desc].flags &= ~PROCESS_FD;
8112 fd_callback_info[desc].flags |= (FOR_READ | KEYBOARD_FD);
8113 if (desc > max_desc)
8114 max_desc = desc;
8115 #endif
8116 }
8117
8118
8119
8120 void
8121 delete_keyboard_wait_descriptor (int desc)
8122 {
8123 #ifdef subprocesses
8124 eassert (desc >= 0 && desc < FD_SETSIZE);
8125
8126 fd_callback_info[desc].flags &= ~(FOR_READ | KEYBOARD_FD | PROCESS_FD);
8127
8128 if (desc == max_desc)
8129 recompute_max_desc ();
8130 #endif
8131 }
8132
8133
8134
8135 void
8136 setup_process_coding_systems (Lisp_Object process)
8137 {
8138 #ifdef subprocesses
8139 struct Lisp_Process *p = XPROCESS (process);
8140 int inch = p->infd;
8141 int outch = p->outfd;
8142 Lisp_Object coding_system;
8143
8144 if (inch < 0 || outch < 0)
8145 return;
8146
8147 eassert (0 <= inch && inch < FD_SETSIZE);
8148 if (!proc_decode_coding_system[inch])
8149 proc_decode_coding_system[inch] = xmalloc (sizeof (struct coding_system));
8150 coding_system = p->decode_coding_system;
8151 if (EQ (p->filter, Qinternal_default_process_filter)
8152 && BUFFERP (p->buffer))
8153 {
8154 if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters)))
8155 coding_system = raw_text_coding_system (coding_system);
8156 }
8157 setup_coding_system (coding_system, proc_decode_coding_system[inch]);
8158
8159 eassert (0 <= outch && outch < FD_SETSIZE);
8160 if (!proc_encode_coding_system[outch])
8161 proc_encode_coding_system[outch] = xmalloc (sizeof (struct coding_system));
8162 setup_coding_system (p->encode_coding_system,
8163 proc_encode_coding_system[outch]);
8164 #endif
8165 }
8166
8167 DEFUN ("get-buffer-process", Fget_buffer_process, Sget_buffer_process, 1, 1, 0,
8168 doc:
8169
8170
8171 )
8172 (register Lisp_Object buffer)
8173 {
8174 #ifdef subprocesses
8175 register Lisp_Object buf, tail, proc;
8176
8177 if (NILP (buffer)) return Qnil;
8178 buf = Fget_buffer (buffer);
8179 if (NILP (buf)) return Qnil;
8180
8181 FOR_EACH_PROCESS (tail, proc)
8182 if (EQ (XPROCESS (proc)->buffer, buf))
8183 return proc;
8184 #endif
8185 return Qnil;
8186 }
8187
8188 DEFUN ("process-inherit-coding-system-flag",
8189 Fprocess_inherit_coding_system_flag, Sprocess_inherit_coding_system_flag,
8190 1, 1, 0,
8191 doc:
8192
8193
8194 )
8195 (register Lisp_Object process)
8196 {
8197 #ifdef subprocesses
8198 CHECK_PROCESS (process);
8199 return XPROCESS (process)->inherit_coding_system_flag ? Qt : Qnil;
8200 #else
8201
8202
8203 return inherit_process_coding_system ? Qt : Qnil;
8204 #endif
8205 }
8206
8207
8208
8209
8210 void
8211 kill_buffer_processes (Lisp_Object buffer)
8212 {
8213 #ifdef subprocesses
8214 Lisp_Object tail, proc;
8215
8216 FOR_EACH_PROCESS (tail, proc)
8217 if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer))
8218 {
8219 if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc))
8220 Fdelete_process (proc);
8221 else if (XPROCESS (proc)->infd >= 0)
8222 process_send_signal (proc, SIGHUP, Qnil, 1);
8223 }
8224 #else
8225
8226 #endif
8227 }
8228
8229 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p,
8230 Swaiting_for_user_input_p, 0, 0, 0,
8231 doc:
8232 )
8233 (void)
8234 {
8235 #ifdef subprocesses
8236 return (waiting_for_user_input_p ? Qt : Qnil);
8237 #else
8238 return Qnil;
8239 #endif
8240 }
8241
8242
8243
8244 void
8245 hold_keyboard_input (void)
8246 {
8247 kbd_is_on_hold = 1;
8248 }
8249
8250
8251
8252 void
8253 unhold_keyboard_input (void)
8254 {
8255 kbd_is_on_hold = 0;
8256 }
8257
8258
8259
8260 bool
8261 kbd_on_hold_p (void)
8262 {
8263 return kbd_is_on_hold;
8264 }
8265
8266
8267
8268
8269 DEFUN ("list-system-processes", Flist_system_processes, Slist_system_processes,
8270 0, 0, 0,
8271 doc:
8272
8273
8274
8275 )
8276 (void)
8277 {
8278 Lisp_Object handler
8279 = Ffind_file_name_handler (BVAR (current_buffer, directory),
8280 Qlist_system_processes);
8281 if (!NILP (handler))
8282 return call1 (handler, Qlist_system_processes);
8283
8284 return list_system_processes ();
8285 }
8286
8287 DEFUN ("process-attributes", Fprocess_attributes,
8288 Sprocess_attributes, 1, 1, 0,
8289 doc:
8290
8291
8292
8293
8294
8295
8296
8297
8298
8299
8300
8301
8302
8303
8304
8305
8306
8307
8308
8309
8310
8311
8312
8313
8314
8315
8316
8317
8318
8319
8320
8321
8322
8323
8324
8325
8326
8327
8328
8329
8330
8331
8332
8333
8334
8335
8336
8337
8338
8339 )
8340 ( Lisp_Object pid)
8341 {
8342 Lisp_Object handler
8343 = Ffind_file_name_handler (BVAR (current_buffer, directory),
8344 Qprocess_attributes);
8345 if (!NILP (handler))
8346 return call2 (handler, Qprocess_attributes, pid);
8347
8348 return system_process_attributes (pid);
8349 }
8350
8351 DEFUN ("num-processors", Fnum_processors, Snum_processors, 0, 1, 0,
8352 doc:
8353
8354
8355
8356
8357 )
8358 (Lisp_Object query)
8359 {
8360 #ifndef MSDOS
8361 return make_uint (num_processors (EQ (query, Qall) ? NPROC_ALL
8362 : EQ (query, Qcurrent) ? NPROC_CURRENT
8363 : NPROC_CURRENT_OVERRIDABLE));
8364 #else
8365 return make_fixnum (1);
8366 #endif
8367 }
8368
8369 DEFUN ("signal-names", Fsignal_names, Ssignal_names, 0, 0, 0,
8370 doc: )
8371 (void)
8372 {
8373 #ifndef MSDOS
8374 int i;
8375 char name[SIG2STR_MAX];
8376 Lisp_Object names = Qnil;
8377
8378 for (i = 0; i <= SIGNUM_BOUND; ++i)
8379 {
8380 if (!sig2str (i, name))
8381 names = Fcons (build_string (name), names);
8382 }
8383
8384 return names;
8385 #else
8386 return Qnil;
8387 #endif
8388 }
8389
8390 #ifdef subprocesses
8391
8392
8393
8394
8395
8396 void
8397 catch_child_signal (void)
8398 {
8399 struct sigaction action, old_action;
8400 sigset_t oldset;
8401 emacs_sigaction_init (&action, deliver_child_signal);
8402 block_child_signal (&oldset);
8403 sigaction (SIGCHLD, &action, &old_action);
8404 eassert (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
8405 || ! (old_action.sa_flags & SA_SIGINFO));
8406
8407 if (old_action.sa_handler != deliver_child_signal)
8408 lib_child_handler
8409 = (old_action.sa_handler == SIG_DFL || old_action.sa_handler == SIG_IGN
8410 ? dummy_handler
8411 : old_action.sa_handler);
8412 unblock_child_signal (&oldset);
8413 }
8414 #endif
8415
8416
8417
8418 void
8419 restore_nofile_limit (void)
8420 {
8421 #ifdef HAVE_SETRLIMIT
8422 if (FD_SETSIZE < nofile_limit.rlim_cur)
8423 setrlimit (RLIMIT_NOFILE, &nofile_limit);
8424 #endif
8425 }
8426
8427 int
8428 open_channel_for_module (Lisp_Object process)
8429 {
8430 CHECK_PROCESS (process);
8431 CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
8432 #ifndef MSDOS
8433 int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
8434 if (fd == -1)
8435 report_file_error ("Cannot duplicate file descriptor", Qnil);
8436 return fd;
8437 #else
8438
8439 emacs_abort ();
8440 #endif
8441 }
8442
8443
8444
8445
8446 void
8447 init_process_emacs (int sockfd)
8448 {
8449 #ifdef subprocesses
8450 int i;
8451
8452 inhibit_sentinels = 0;
8453
8454 if (!will_dump_with_unexec_p ())
8455 {
8456 #if defined HAVE_GLIB && !defined WINDOWSNT
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474 GSource *source = g_child_watch_source_new (getpid ());
8475 catch_child_signal ();
8476 g_source_unref (source);
8477
8478 if (lib_child_handler != dummy_handler)
8479 {
8480
8481 signal_handler_t lib_child_handler_glib = lib_child_handler;
8482 catch_child_signal ();
8483 eassert (lib_child_handler == dummy_handler);
8484 lib_child_handler = lib_child_handler_glib;
8485 }
8486 #else
8487 catch_child_signal ();
8488 #endif
8489 }
8490
8491 #ifdef HAVE_SETRLIMIT
8492
8493 if (getrlimit (RLIMIT_NOFILE, &nofile_limit) != 0)
8494 nofile_limit.rlim_cur = 0;
8495 else if (FD_SETSIZE < nofile_limit.rlim_cur)
8496 {
8497 struct rlimit rlim = nofile_limit;
8498 rlim.rlim_cur = FD_SETSIZE;
8499 if (setrlimit (RLIMIT_NOFILE, &rlim) != 0)
8500 nofile_limit.rlim_cur = 0;
8501 }
8502 #endif
8503
8504 external_sock_fd = sockfd;
8505 Lisp_Object sockname = Qnil;
8506 # if HAVE_GETSOCKNAME
8507 if (0 <= sockfd)
8508 {
8509 union u_sockaddr sa;
8510 socklen_t salen = sizeof sa;
8511 if (getsockname (sockfd, &sa.sa, &salen) == 0)
8512 sockname = conv_sockaddr_to_lisp (&sa.sa, salen);
8513 }
8514 # endif
8515 Vinternal__daemon_sockname = sockname;
8516
8517 max_desc = -1;
8518 memset (fd_callback_info, 0, sizeof (fd_callback_info));
8519
8520 num_pending_connects = 0;
8521
8522 process_output_delay_count = 0;
8523 process_output_skip = 0;
8524
8525
8526
8527
8528 #if 0
8529 FD_SET (0, &input_wait_mask);
8530 #endif
8531
8532 Vprocess_alist = Qnil;
8533 deleted_pid_list = Qnil;
8534 for (i = 0; i < FD_SETSIZE; i++)
8535 {
8536 chan_process[i] = Qnil;
8537 proc_buffered_char[i] = -1;
8538 }
8539 memset (proc_decode_coding_system, 0, sizeof proc_decode_coding_system);
8540 memset (proc_encode_coding_system, 0, sizeof proc_encode_coding_system);
8541 #ifdef DATAGRAM_SOCKETS
8542 memset (datagram_address, 0, sizeof datagram_address);
8543 #endif
8544
8545 #endif
8546 kbd_is_on_hold = 0;
8547 }
8548
8549 void
8550 syms_of_process (void)
8551 {
8552 DEFSYM (Qmake_process, "make-process");
8553 DEFSYM (Qlist_system_processes, "list-system-processes");
8554 DEFSYM (Qprocess_attributes, "process-attributes");
8555
8556 #ifdef subprocesses
8557
8558 DEFSYM (Qprocessp, "processp");
8559 DEFSYM (Qrun, "run");
8560 DEFSYM (Qstop, "stop");
8561 DEFSYM (Qsignal, "signal");
8562
8563
8564
8565
8566 DEFSYM (Qopen, "open");
8567 DEFSYM (Qclosed, "closed");
8568 DEFSYM (Qconnect, "connect");
8569 DEFSYM (Qfailed, "failed");
8570 DEFSYM (Qlisten, "listen");
8571 DEFSYM (Qlocal, "local");
8572 DEFSYM (Qipv4, "ipv4");
8573 #ifdef AF_INET6
8574 DEFSYM (Qipv6, "ipv6");
8575 #endif
8576 DEFSYM (Qnumeric, "numeric");
8577 DEFSYM (Qdatagram, "datagram");
8578 DEFSYM (Qseqpacket, "seqpacket");
8579
8580 DEFSYM (QCport, ":port");
8581 DEFSYM (QCspeed, ":speed");
8582 DEFSYM (QCprocess, ":process");
8583
8584 DEFSYM (QCbytesize, ":bytesize");
8585 DEFSYM (QCstopbits, ":stopbits");
8586 DEFSYM (QCparity, ":parity");
8587 DEFSYM (Qodd, "odd");
8588 DEFSYM (Qeven, "even");
8589 DEFSYM (QCflowcontrol, ":flowcontrol");
8590 DEFSYM (Qhw, "hw");
8591 DEFSYM (Qsw, "sw");
8592 DEFSYM (QCsummary, ":summary");
8593
8594 DEFSYM (Qreal, "real");
8595 DEFSYM (Qnetwork, "network");
8596 DEFSYM (Qserial, "serial");
8597 DEFSYM (QCfile_handler, ":file-handler");
8598 DEFSYM (QCbuffer, ":buffer");
8599 DEFSYM (QChost, ":host");
8600 DEFSYM (QCservice, ":service");
8601 DEFSYM (QClocal, ":local");
8602 DEFSYM (QCremote, ":remote");
8603 DEFSYM (QCcoding, ":coding");
8604 DEFSYM (QCserver, ":server");
8605 DEFSYM (QCnowait, ":nowait");
8606 DEFSYM (QCsentinel, ":sentinel");
8607 DEFSYM (QCuse_external_socket, ":use-external-socket");
8608 DEFSYM (QCtls_parameters, ":tls-parameters");
8609 DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
8610 DEFSYM (QClog, ":log");
8611 DEFSYM (QCnoquery, ":noquery");
8612 DEFSYM (QCstop, ":stop");
8613 DEFSYM (QCplist, ":plist");
8614 DEFSYM (QCcommand, ":command");
8615 DEFSYM (QCconnection_type, ":connection-type");
8616 DEFSYM (QCstderr, ":stderr");
8617 DEFSYM (Qpty, "pty");
8618 DEFSYM (Qpipe, "pipe");
8619
8620 DEFSYM (Qlast_nonmenu_event, "last-nonmenu-event");
8621
8622 staticpro (&Vprocess_alist);
8623 staticpro (&deleted_pid_list);
8624
8625 #endif
8626
8627 DEFSYM (QCname, ":name");
8628 DEFSYM (QCtype, ":type");
8629
8630 DEFSYM (Qeuid, "euid");
8631 DEFSYM (Qegid, "egid");
8632 DEFSYM (Quser, "user");
8633 DEFSYM (Qgroup, "group");
8634 DEFSYM (Qcomm, "comm");
8635 DEFSYM (Qstate, "state");
8636 DEFSYM (Qppid, "ppid");
8637 DEFSYM (Qpgrp, "pgrp");
8638 DEFSYM (Qsess, "sess");
8639 DEFSYM (Qttname, "ttname");
8640 DEFSYM (Qtpgid, "tpgid");
8641 DEFSYM (Qminflt, "minflt");
8642 DEFSYM (Qmajflt, "majflt");
8643 DEFSYM (Qcminflt, "cminflt");
8644 DEFSYM (Qcmajflt, "cmajflt");
8645 DEFSYM (Qutime, "utime");
8646 DEFSYM (Qstime, "stime");
8647 DEFSYM (Qtime, "time");
8648 DEFSYM (Qcutime, "cutime");
8649 DEFSYM (Qcstime, "cstime");
8650 DEFSYM (Qctime, "ctime");
8651 #ifdef subprocesses
8652 DEFSYM (Qinternal_default_process_sentinel,
8653 "internal-default-process-sentinel");
8654 DEFSYM (Qinternal_default_process_filter,
8655 "internal-default-process-filter");
8656 #endif
8657 DEFSYM (Qpri, "pri");
8658 DEFSYM (Qnice, "nice");
8659 DEFSYM (Qthcount, "thcount");
8660 DEFSYM (Qstart, "start");
8661 DEFSYM (Qvsize, "vsize");
8662 DEFSYM (Qrss, "rss");
8663 DEFSYM (Qetime, "etime");
8664 DEFSYM (Qpcpu, "pcpu");
8665 DEFSYM (Qpmem, "pmem");
8666 DEFSYM (Qargs, "args");
8667 DEFSYM (Qall, "all");
8668 DEFSYM (Qcurrent, "current");
8669
8670 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes,
8671 doc:
8672 );
8673
8674 delete_exited_processes = 1;
8675
8676 #ifdef subprocesses
8677 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type,
8678 doc:
8679
8680
8681
8682 );
8683 Vprocess_connection_type = Qt;
8684
8685 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering,
8686 doc:
8687
8688
8689
8690
8691
8692
8693
8694 );
8695 Vprocess_adaptive_read_buffering = Qt;
8696
8697 DEFVAR_BOOL ("process-prioritize-lower-fds", process_prioritize_lower_fds,
8698 doc:
8699
8700
8701
8702
8703
8704 );
8705 process_prioritize_lower_fds = 0;
8706
8707 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions,
8708 doc:
8709
8710
8711 );
8712 Vinterrupt_process_functions = list1 (Qinternal_default_interrupt_process);
8713
8714 DEFVAR_LISP ("signal-process-functions", Vsignal_process_functions,
8715 doc:
8716
8717
8718 );
8719 Vsignal_process_functions = list1 (Qinternal_default_signal_process);
8720
8721 DEFVAR_LISP ("internal--daemon-sockname", Vinternal__daemon_sockname,
8722 doc: );
8723 Vinternal__daemon_sockname = Qnil;
8724
8725 DEFVAR_INT ("read-process-output-max", read_process_output_max,
8726 doc:
8727
8728
8729
8730
8731 );
8732 read_process_output_max = 4096;
8733
8734 DEFVAR_INT ("process-error-pause-time", process_error_pause_time,
8735 doc:
8736
8737 );
8738 process_error_pause_time = 1;
8739
8740 DEFSYM (Qinternal_default_interrupt_process,
8741 "internal-default-interrupt-process");
8742 DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
8743
8744 DEFSYM (Qinternal_default_signal_process,
8745 "internal-default-signal-process");
8746 DEFSYM (Qsignal_process_functions, "signal-process-functions");
8747
8748 DEFSYM (Qnull, "null");
8749 DEFSYM (Qpipe_process_p, "pipe-process-p");
8750 DEFSYM (Qmessage, "message");
8751
8752 defsubr (&Sprocessp);
8753 defsubr (&Sget_process);
8754 defsubr (&Sdelete_process);
8755 defsubr (&Sprocess_status);
8756 defsubr (&Sprocess_exit_status);
8757 defsubr (&Sprocess_id);
8758 defsubr (&Sprocess_name);
8759 defsubr (&Sprocess_tty_name);
8760 defsubr (&Sprocess_command);
8761 defsubr (&Sset_process_buffer);
8762 defsubr (&Sprocess_buffer);
8763 defsubr (&Sprocess_mark);
8764 defsubr (&Sset_process_filter);
8765 defsubr (&Sprocess_filter);
8766 defsubr (&Sset_process_sentinel);
8767 defsubr (&Sprocess_sentinel);
8768 defsubr (&Sset_process_thread);
8769 defsubr (&Sprocess_thread);
8770 defsubr (&Sset_process_window_size);
8771 defsubr (&Sset_process_inherit_coding_system_flag);
8772 defsubr (&Sset_process_query_on_exit_flag);
8773 defsubr (&Sprocess_query_on_exit_flag);
8774 defsubr (&Sprocess_contact);
8775 defsubr (&Sprocess_plist);
8776 defsubr (&Sset_process_plist);
8777 defsubr (&Sprocess_list);
8778 defsubr (&Smake_process);
8779 defsubr (&Smake_pipe_process);
8780 defsubr (&Sserial_process_configure);
8781 defsubr (&Smake_serial_process);
8782 defsubr (&Sset_network_process_option);
8783 defsubr (&Smake_network_process);
8784 defsubr (&Sformat_network_address);
8785 defsubr (&Snetwork_lookup_address_info);
8786 defsubr (&Snetwork_interface_list);
8787 defsubr (&Snetwork_interface_info);
8788 #ifdef DATAGRAM_SOCKETS
8789 defsubr (&Sprocess_datagram_address);
8790 defsubr (&Sset_process_datagram_address);
8791 #endif
8792 defsubr (&Saccept_process_output);
8793 defsubr (&Sprocess_send_region);
8794 defsubr (&Sprocess_send_string);
8795 defsubr (&Sinternal_default_interrupt_process);
8796 defsubr (&Sinterrupt_process);
8797 defsubr (&Skill_process);
8798 defsubr (&Squit_process);
8799 defsubr (&Sstop_process);
8800 defsubr (&Scontinue_process);
8801 defsubr (&Sprocess_running_child_p);
8802 defsubr (&Sprocess_send_eof);
8803 defsubr (&Sinternal_default_signal_process);
8804 defsubr (&Ssignal_process);
8805 defsubr (&Swaiting_for_user_input_p);
8806 defsubr (&Sprocess_type);
8807 defsubr (&Sinternal_default_process_sentinel);
8808 defsubr (&Sinternal_default_process_filter);
8809 defsubr (&Sset_process_coding_system);
8810 defsubr (&Sprocess_coding_system);
8811
8812 {
8813 Lisp_Object subfeatures = Qnil;
8814 const struct socket_options *sopt;
8815
8816 #define ADD_SUBFEATURE(key, val) \
8817 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8818
8819 ADD_SUBFEATURE (QCnowait, Qt);
8820 #ifdef DATAGRAM_SOCKETS
8821 ADD_SUBFEATURE (QCtype, Qdatagram);
8822 #endif
8823 #ifdef HAVE_SEQPACKET
8824 ADD_SUBFEATURE (QCtype, Qseqpacket);
8825 #endif
8826 #ifdef HAVE_LOCAL_SOCKETS
8827 ADD_SUBFEATURE (QCfamily, Qlocal);
8828 #endif
8829 ADD_SUBFEATURE (QCfamily, Qipv4);
8830 #ifdef AF_INET6
8831 ADD_SUBFEATURE (QCfamily, Qipv6);
8832 #endif
8833 #ifdef HAVE_GETSOCKNAME
8834 ADD_SUBFEATURE (QCservice, Qt);
8835 #endif
8836 ADD_SUBFEATURE (QCserver, Qt);
8837
8838 for (sopt = socket_options; sopt->name; sopt++)
8839 subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
8840
8841 Fprovide (intern_c_string ("make-network-process"), subfeatures);
8842 }
8843
8844 #endif
8845
8846 defsubr (&Sget_buffer_process);
8847 defsubr (&Sprocess_inherit_coding_system_flag);
8848 defsubr (&Slist_system_processes);
8849 defsubr (&Sprocess_attributes);
8850 defsubr (&Snum_processors);
8851 defsubr (&Ssignal_names);
8852 }