1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2017 Free Software
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
27 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
35 /* Only MS-DOS does not define `subprocesses'. */
38 #include <sys/socket.h>
40 #include <netinet/in.h>
41 #include <arpa/inet.h>
44 # include <sys/resource.h>
46 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
47 NOFILE_LIMIT is the initial limit on the number of open files,
48 which should be restored in child processes. */
49 static struct rlimit nofile_limit
;
52 /* Are local (unix) sockets supported? */
53 #if defined (HAVE_SYS_UN_H)
54 #if !defined (AF_LOCAL) && defined (AF_UNIX)
55 #define AF_LOCAL AF_UNIX
58 #define HAVE_LOCAL_SOCKETS
63 #include <sys/ioctl.h>
64 #if defined (HAVE_NET_IF_H)
66 #endif /* HAVE_NET_IF_H */
68 #if defined (HAVE_IFADDRS_H)
69 /* Must be after net/if.h */
72 /* We only use structs from this header when we use getifaddrs. */
73 #if defined (HAVE_NET_IF_DL_H)
74 #include <net/if_dl.h>
84 # include <sys/stream.h>
85 # include <sys/stropts.h>
97 #include <flexmember.h>
101 #endif /* subprocesses */
107 #include "character.h"
112 #include "termopts.h"
113 #include "keyboard.h"
114 #include "blockinput.h"
116 #include "sysselect.h"
117 #include "syssignal.h"
123 #ifdef HAVE_WINDOW_SYSTEM
125 #endif /* HAVE_WINDOW_SYSTEM */
128 #include "xgselect.h"
134 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
135 /* This is 0.1s in nanoseconds. */
136 #define ASYNC_RETRY_NSEC 100000000
140 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
141 const struct timespec
*, const sigset_t
*);
144 /* Work around GCC 4.3.0 bug with strict overflow checking; see
145 <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
146 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
147 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
148 # pragma GCC diagnostic ignored "-Wstrict-overflow"
151 /* True if keyboard input is on hold, zero otherwise. */
153 static bool kbd_is_on_hold
;
155 /* Nonzero means don't run process sentinels. This is used
157 bool inhibit_sentinels
;
162 # define SOCK_CLOEXEC 0
164 #ifndef SOCK_NONBLOCK
165 # define SOCK_NONBLOCK 0
168 /* True if ERRNUM represents an error where the system call would
169 block if a blocking variant were used. */
171 would_block (int errnum
)
174 if (EWOULDBLOCK
!= EAGAIN
&& errnum
== EWOULDBLOCK
)
177 return errnum
== EAGAIN
;
182 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
185 close_on_exec (int fd
)
188 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
193 # define accept4(sockfd, addr, addrlen, flags) \
194 process_accept4 (sockfd, addr, addrlen, flags)
196 accept4 (int sockfd
, struct sockaddr
*addr
, socklen_t
*addrlen
, int flags
)
198 return close_on_exec (accept (sockfd
, addr
, addrlen
));
202 process_socket (int domain
, int type
, int protocol
)
204 return close_on_exec (socket (domain
, type
, protocol
));
207 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
210 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
211 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
212 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
213 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
214 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
215 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
217 /* Number of events of change of status of a process. */
218 static EMACS_INT process_tick
;
219 /* Number of events for which the user or sentinel has been notified. */
220 static EMACS_INT update_tick
;
222 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
223 this system. We need to read full packets, so we need a
224 "non-destructive" select. So we require either native select,
225 or emulation of select using FIONREAD. */
227 #ifndef BROKEN_DATAGRAM_SOCKETS
228 # if defined HAVE_SELECT || defined USABLE_FIONREAD
229 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
230 # define DATAGRAM_SOCKETS
235 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
236 # define HAVE_SEQPACKET
239 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
240 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
241 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
243 /* Number of processes which have a non-zero read_output_delay,
244 and therefore might be delayed for adaptive read buffering. */
246 static int process_output_delay_count
;
248 /* True if any process has non-nil read_output_skip. */
250 static bool process_output_skip
;
252 static void start_process_unwind (Lisp_Object
);
253 static void create_process (Lisp_Object
, char **, Lisp_Object
);
255 static bool keyboard_bit_set (fd_set
*);
257 static void deactivate_process (Lisp_Object
);
258 static int status_notify (struct Lisp_Process
*, struct Lisp_Process
*);
259 static int read_process_output (Lisp_Object
, int);
260 static void create_pty (Lisp_Object
);
261 static void exec_sentinel (Lisp_Object
, Lisp_Object
);
263 /* Number of bits set in connect_wait_mask. */
264 static int num_pending_connects
;
266 /* The largest descriptor currently in use; -1 if none. */
269 /* Set the external socket descriptor for Emacs to use when
270 `make-network-process' is called with a non-nil
271 `:use-external-socket' option. The value should be either -1, or
272 the file descriptor of a socket that is already bound. */
273 static int external_sock_fd
;
275 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
276 static Lisp_Object chan_process
[FD_SETSIZE
];
277 static void wait_for_socket_fds (Lisp_Object
, char const *);
279 /* Alist of elements (NAME . PROCESS). */
280 static Lisp_Object Vprocess_alist
;
282 /* Buffered-ahead input char from process, indexed by channel.
283 -1 means empty (no char is buffered).
284 Used on sys V where the only way to tell if there is any
285 output from the process is to read at least one char.
286 Always -1 on systems that support FIONREAD. */
288 static int proc_buffered_char
[FD_SETSIZE
];
290 /* Table of `struct coding-system' for each process. */
291 static struct coding_system
*proc_decode_coding_system
[FD_SETSIZE
];
292 static struct coding_system
*proc_encode_coding_system
[FD_SETSIZE
];
294 #ifdef DATAGRAM_SOCKETS
295 /* Table of `partner address' for datagram sockets. */
296 static struct sockaddr_and_len
{
299 } datagram_address
[FD_SETSIZE
];
300 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
301 #define DATAGRAM_CONN_P(proc) \
302 (PROCESSP (proc) && \
303 XPROCESS (proc)->infd >= 0 && \
304 datagram_address[XPROCESS (proc)->infd].sa != 0)
306 #define DATAGRAM_CONN_P(proc) (0)
309 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
310 a `for' loop which iterates over processes from Vprocess_alist. */
312 #define FOR_EACH_PROCESS(list_var, proc_var) \
313 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
315 /* These setters are used only in this file, so they can be private. */
317 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
322 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
327 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
329 p
->decode_coding_system
= val
;
332 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
334 p
->decoding_buf
= val
;
337 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
339 p
->encode_coding_system
= val
;
342 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
344 p
->encoding_buf
= val
;
347 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
349 p
->filter
= NILP (val
) ? Qinternal_default_process_filter
: val
;
352 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
357 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
362 pset_thread (struct Lisp_Process
*p
, Lisp_Object val
)
367 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
372 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
377 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
379 p
->sentinel
= NILP (val
) ? Qinternal_default_process_sentinel
: val
;
382 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
387 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
392 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
394 p
->write_queue
= val
;
397 pset_stderrproc (struct Lisp_Process
*p
, Lisp_Object val
)
404 make_lisp_proc (struct Lisp_Process
*p
)
406 return make_lisp_ptr (p
, Lisp_Vectorlike
);
411 /* Read from file descriptor. */
413 /* Write to file descriptor. */
415 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
418 /* This descriptor refers to a process. */
420 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
421 NON_BLOCKING_CONNECT_FD
= 16
424 static struct fd_callback_data
428 /* Flags from enum fd_bits. */
430 /* If this fd is locked to a certain thread, this points to it.
431 Otherwise, this is NULL. If an fd is locked to a thread, then
432 only that thread is permitted to wait on it. */
433 struct thread_state
*thread
;
434 /* If this fd is currently being selected on by a thread, this
435 points to the thread. Otherwise it is NULL. */
436 struct thread_state
*waiting_thread
;
437 } fd_callback_info
[FD_SETSIZE
];
440 /* Add a file descriptor FD to be monitored for when read is possible.
441 When read is possible, call FUNC with argument DATA. */
444 add_read_fd (int fd
, fd_callback func
, void *data
)
446 add_keyboard_wait_descriptor (fd
);
448 fd_callback_info
[fd
].func
= func
;
449 fd_callback_info
[fd
].data
= data
;
453 add_non_keyboard_read_fd (int fd
)
455 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
456 eassert (fd_callback_info
[fd
].func
== NULL
);
458 fd_callback_info
[fd
].flags
&= ~KEYBOARD_FD
;
459 fd_callback_info
[fd
].flags
|= FOR_READ
;
465 add_process_read_fd (int fd
)
467 add_non_keyboard_read_fd (fd
);
468 fd_callback_info
[fd
].flags
|= PROCESS_FD
;
471 /* Stop monitoring file descriptor FD for when read is possible. */
474 delete_read_fd (int fd
)
476 delete_keyboard_wait_descriptor (fd
);
478 if (fd_callback_info
[fd
].flags
== 0)
480 fd_callback_info
[fd
].func
= 0;
481 fd_callback_info
[fd
].data
= 0;
485 /* Add a file descriptor FD to be monitored for when write is possible.
486 When write is possible, call FUNC with argument DATA. */
489 add_write_fd (int fd
, fd_callback func
, void *data
)
491 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
493 fd_callback_info
[fd
].func
= func
;
494 fd_callback_info
[fd
].data
= data
;
495 fd_callback_info
[fd
].flags
|= FOR_WRITE
;
501 add_non_blocking_write_fd (int fd
)
503 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
504 eassert (fd_callback_info
[fd
].func
== NULL
);
506 fd_callback_info
[fd
].flags
|= FOR_WRITE
| NON_BLOCKING_CONNECT_FD
;
509 ++num_pending_connects
;
513 recompute_max_desc (void)
517 for (fd
= max_desc
; fd
>= 0; --fd
)
519 if (fd_callback_info
[fd
].flags
!= 0)
527 /* Stop monitoring file descriptor FD for when write is possible. */
530 delete_write_fd (int fd
)
532 if ((fd_callback_info
[fd
].flags
& NON_BLOCKING_CONNECT_FD
) != 0)
534 if (--num_pending_connects
< 0)
537 fd_callback_info
[fd
].flags
&= ~(FOR_WRITE
| NON_BLOCKING_CONNECT_FD
);
538 if (fd_callback_info
[fd
].flags
== 0)
540 fd_callback_info
[fd
].func
= 0;
541 fd_callback_info
[fd
].data
= 0;
544 recompute_max_desc ();
549 compute_input_wait_mask (fd_set
*mask
)
554 for (fd
= 0; fd
<= max_desc
; ++fd
)
556 if (fd_callback_info
[fd
].thread
!= NULL
557 && fd_callback_info
[fd
].thread
!= current_thread
)
559 if (fd_callback_info
[fd
].waiting_thread
!= NULL
560 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
562 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0)
565 fd_callback_info
[fd
].waiting_thread
= current_thread
;
571 compute_non_process_wait_mask (fd_set
*mask
)
576 for (fd
= 0; fd
<= max_desc
; ++fd
)
578 if (fd_callback_info
[fd
].thread
!= NULL
579 && fd_callback_info
[fd
].thread
!= current_thread
)
581 if (fd_callback_info
[fd
].waiting_thread
!= NULL
582 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
584 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0
585 && (fd_callback_info
[fd
].flags
& PROCESS_FD
) == 0)
588 fd_callback_info
[fd
].waiting_thread
= current_thread
;
594 compute_non_keyboard_wait_mask (fd_set
*mask
)
599 for (fd
= 0; fd
<= max_desc
; ++fd
)
601 if (fd_callback_info
[fd
].thread
!= NULL
602 && fd_callback_info
[fd
].thread
!= current_thread
)
604 if (fd_callback_info
[fd
].waiting_thread
!= NULL
605 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
607 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0
608 && (fd_callback_info
[fd
].flags
& KEYBOARD_FD
) == 0)
611 fd_callback_info
[fd
].waiting_thread
= current_thread
;
617 compute_write_mask (fd_set
*mask
)
622 for (fd
= 0; fd
<= max_desc
; ++fd
)
624 if (fd_callback_info
[fd
].thread
!= NULL
625 && fd_callback_info
[fd
].thread
!= current_thread
)
627 if (fd_callback_info
[fd
].waiting_thread
!= NULL
628 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
630 if ((fd_callback_info
[fd
].flags
& FOR_WRITE
) != 0)
633 fd_callback_info
[fd
].waiting_thread
= current_thread
;
639 clear_waiting_thread_info (void)
643 for (fd
= 0; fd
<= max_desc
; ++fd
)
645 if (fd_callback_info
[fd
].waiting_thread
== current_thread
)
646 fd_callback_info
[fd
].waiting_thread
= NULL
;
651 /* Compute the Lisp form of the process status, p->status, from
652 the numeric status that was returned by `wait'. */
654 static Lisp_Object
status_convert (int);
657 update_status (struct Lisp_Process
*p
)
659 eassert (p
->raw_status_new
);
660 pset_status (p
, status_convert (p
->raw_status
));
661 p
->raw_status_new
= 0;
664 /* Convert a process status word in Unix format to
665 the list that we use internally. */
668 status_convert (int w
)
671 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
672 else if (WIFEXITED (w
))
673 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
674 WCOREDUMP (w
) ? Qt
: Qnil
));
675 else if (WIFSIGNALED (w
))
676 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
677 WCOREDUMP (w
) ? Qt
: Qnil
));
682 /* True if STATUS is that of a process attempting connection. */
685 connecting_status (Lisp_Object status
)
687 return CONSP (status
) && EQ (XCAR (status
), Qconnect
);
690 /* Given a status-list, extract the three pieces of information
691 and store them individually through the three pointers. */
694 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, Lisp_Object
*code
,
699 if (connecting_status (l
))
705 *code
= make_number (0);
714 *coredump
= !NILP (tem
);
718 /* Return a string describing a process status list. */
721 status_message (struct Lisp_Process
*p
)
723 Lisp_Object status
= p
->status
;
724 Lisp_Object symbol
, code
;
728 decode_status (status
, &symbol
, &code
, &coredump
);
730 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
733 synchronize_system_messages_locale ();
734 signame
= strsignal (XFASTINT (code
));
736 string
= build_string ("unknown");
741 string
= build_unibyte_string (signame
);
742 if (! NILP (Vlocale_coding_system
))
743 string
= (code_convert_string_norecord
744 (string
, Vlocale_coding_system
, 0));
745 c1
= STRING_CHAR (SDATA (string
));
748 Faset (string
, make_number (0), make_number (c2
));
750 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
751 return concat2 (string
, suffix
);
753 else if (EQ (symbol
, Qexit
))
756 return build_string (XFASTINT (code
) == 0
758 : "connection broken by remote peer\n");
759 if (XFASTINT (code
) == 0)
760 return build_string ("finished\n");
761 AUTO_STRING (prefix
, "exited abnormally with code ");
762 string
= Fnumber_to_string (code
);
763 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
764 return concat3 (prefix
, string
, suffix
);
766 else if (EQ (symbol
, Qfailed
))
768 AUTO_STRING (format
, "failed with code %s\n");
769 return CALLN (Fformat
, format
, code
);
772 return Fcopy_sequence (Fsymbol_name (symbol
));
775 enum { PTY_NAME_SIZE
= 24 };
777 /* Open an available pty, returning a file descriptor.
778 Store into PTY_NAME the file name of the terminal corresponding to the pty.
779 Return -1 on failure. */
782 allocate_pty (char pty_name
[PTY_NAME_SIZE
])
791 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
792 for (i
= 0; i
< 16; i
++)
795 #ifdef PTY_NAME_SPRINTF
798 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
799 #endif /* no PTY_NAME_SPRINTF */
803 #else /* no PTY_OPEN */
804 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
805 #endif /* no PTY_OPEN */
809 #ifdef PTY_TTY_NAME_SPRINTF
812 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
813 #endif /* no PTY_TTY_NAME_SPRINTF */
815 /* Set FD's close-on-exec flag. This is needed even if
816 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
817 doesn't require support for that combination.
818 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
819 doesn't work if the close-on-exec flag is set (Bug#20555).
820 Multithreaded platforms where posix_openpt ignores
821 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
822 have a race condition between the PTY_OPEN and here. */
823 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
825 /* Check to make certain that both sides are available.
826 This avoids a nasty yet stupid bug in rlogins. */
827 if (faccessat (AT_FDCWD
, pty_name
, R_OK
| W_OK
, AT_EACCESS
) != 0)
836 #endif /* HAVE_PTYS */
840 /* Allocate basically initialized process. */
842 static struct Lisp_Process
*
843 allocate_process (void)
845 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
849 make_process (Lisp_Object name
)
851 struct Lisp_Process
*p
= allocate_process ();
852 /* Initialize Lisp data. Note that allocate_process initializes all
853 Lisp data to nil, so do it only for slots which should not be nil. */
854 pset_status (p
, Qrun
);
855 pset_mark (p
, Fmake_marker ());
856 pset_thread (p
, Fcurrent_thread ());
858 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
859 non-Lisp data, so do it only for slots which should not be zero. */
862 for (int i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
866 verify (GNUTLS_STAGE_EMPTY
== 0);
867 eassert (p
->gnutls_initstage
== GNUTLS_STAGE_EMPTY
);
868 eassert (NILP (p
->gnutls_boot_parameters
));
871 /* If name is already in use, modify it until it is unused. */
873 Lisp_Object name1
= name
;
874 for (printmax_t i
= 1; ; i
++)
876 Lisp_Object tem
= Fget_process (name1
);
879 char const suffix_fmt
[] = "<%"pMd
">";
880 char suffix
[sizeof suffix_fmt
+ INT_STRLEN_BOUND (printmax_t
)];
881 AUTO_STRING_WITH_LEN (lsuffix
, suffix
, sprintf (suffix
, suffix_fmt
, i
));
882 name1
= concat2 (name
, lsuffix
);
886 pset_sentinel (p
, Qinternal_default_process_sentinel
);
887 pset_filter (p
, Qinternal_default_process_filter
);
889 XSETPROCESS (val
, p
);
890 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
895 remove_process (register Lisp_Object proc
)
897 register Lisp_Object pair
;
899 pair
= Frassq (proc
, Vprocess_alist
);
900 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
902 deactivate_process (proc
);
906 update_processes_for_thread_death (Lisp_Object dying_thread
)
910 for (pair
= Vprocess_alist
; !NILP (pair
); pair
= XCDR (pair
))
912 Lisp_Object process
= XCDR (XCAR (pair
));
913 if (EQ (XPROCESS (process
)->thread
, dying_thread
))
915 struct Lisp_Process
*proc
= XPROCESS (process
);
917 pset_thread (proc
, Qnil
);
919 fd_callback_info
[proc
->infd
].thread
= NULL
;
920 if (proc
->outfd
>= 0)
921 fd_callback_info
[proc
->outfd
].thread
= NULL
;
926 #ifdef HAVE_GETADDRINFO_A
928 free_dns_request (Lisp_Object proc
)
930 struct Lisp_Process
*p
= XPROCESS (proc
);
932 if (p
->dns_request
->ar_result
)
933 freeaddrinfo (p
->dns_request
->ar_result
);
934 xfree (p
->dns_request
);
935 p
->dns_request
= NULL
;
940 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
941 doc
: /* Return t if OBJECT is a process. */)
944 return PROCESSP (object
) ? Qt
: Qnil
;
947 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
948 doc
: /* Return the process named NAME, or nil if there is none. */)
949 (register Lisp_Object name
)
954 return Fcdr (Fassoc (name
, Vprocess_alist
, Qnil
));
957 /* This is how commands for the user decode process arguments. It
958 accepts a process, a process name, a buffer, a buffer name, or nil.
959 Buffers denote the first process in the buffer, and nil denotes the
963 get_process (register Lisp_Object name
)
965 register Lisp_Object proc
, obj
;
968 obj
= Fget_process (name
);
970 obj
= Fget_buffer (name
);
972 error ("Process %s does not exist", SDATA (name
));
974 else if (NILP (name
))
975 obj
= Fcurrent_buffer ();
979 /* Now obj should be either a buffer object or a process object. */
982 if (NILP (BVAR (XBUFFER (obj
), name
)))
983 error ("Attempt to get process for a dead buffer");
984 proc
= Fget_buffer_process (obj
);
986 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
997 /* Fdelete_process promises to immediately forget about the process, but in
998 reality, Emacs needs to remember those processes until they have been
999 treated by the SIGCHLD handler and waitpid has been invoked on them;
1000 otherwise they might fill up the kernel's process table.
1002 Some processes created by call-process are also put onto this list.
1004 Members of this list are (process-ID . filename) pairs. The
1005 process-ID is a number; the filename, if a string, is a file that
1006 needs to be removed after the process exits. */
1007 static Lisp_Object deleted_pid_list
;
1010 record_deleted_pid (pid_t pid
, Lisp_Object filename
)
1012 deleted_pid_list
= Fcons (Fcons (make_fixnum_or_float (pid
), filename
),
1013 /* GC treated elements set to nil. */
1014 Fdelq (Qnil
, deleted_pid_list
));
1018 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
1019 doc
: /* Delete PROCESS: kill it and forget about it immediately.
1020 PROCESS may be a process, a buffer, the name of a process or buffer, or
1021 nil, indicating the current buffer's process. */)
1022 (register Lisp_Object process
)
1024 register struct Lisp_Process
*p
;
1026 process
= get_process (process
);
1027 p
= XPROCESS (process
);
1029 #ifdef HAVE_GETADDRINFO_A
1032 /* Cancel the request. Unless shutting down, wait until
1033 completion. Free the request if completely canceled. */
1035 bool canceled
= gai_cancel (p
->dns_request
) != EAI_NOTCANCELED
;
1036 if (!canceled
&& !inhibit_sentinels
)
1038 struct gaicb
const *req
= p
->dns_request
;
1039 while (gai_suspend (&req
, 1, NULL
) != 0)
1044 free_dns_request (process
);
1048 p
->raw_status_new
= 0;
1049 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1051 pset_status (p
, list2 (Qexit
, make_number (0)));
1052 p
->tick
= ++process_tick
;
1053 status_notify (p
, NULL
);
1054 redisplay_preserve_echo_area (13);
1059 record_kill_process (p
, Qnil
);
1063 /* Update P's status, since record_kill_process will make the
1064 SIGCHLD handler update deleted_pid_list, not *P. */
1066 if (p
->raw_status_new
)
1068 symbol
= CONSP (p
->status
) ? XCAR (p
->status
) : p
->status
;
1069 if (! (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)))
1070 pset_status (p
, list2 (Qsignal
, make_number (SIGKILL
)));
1072 p
->tick
= ++process_tick
;
1073 status_notify (p
, NULL
);
1074 redisplay_preserve_echo_area (13);
1077 remove_process (process
);
1081 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
1082 doc
: /* Return the status of PROCESS.
1083 The returned value is one of the following symbols:
1084 run -- for a process that is running.
1085 stop -- for a process stopped but continuable.
1086 exit -- for a process that has exited.
1087 signal -- for a process that has got a fatal signal.
1088 open -- for a network stream connection that is open.
1089 listen -- for a network stream server that is listening.
1090 closed -- for a network stream connection that is closed.
1091 connect -- when waiting for a non-blocking connection to complete.
1092 failed -- when a non-blocking connection has failed.
1093 nil -- if arg is a process name and no such process exists.
1094 PROCESS may be a process, a buffer, the name of a process, or
1095 nil, indicating the current buffer's process. */)
1096 (register Lisp_Object process
)
1098 register struct Lisp_Process
*p
;
1099 register Lisp_Object status
;
1101 if (STRINGP (process
))
1102 process
= Fget_process (process
);
1104 process
= get_process (process
);
1109 p
= XPROCESS (process
);
1110 if (p
->raw_status_new
)
1114 status
= XCAR (status
);
1115 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1117 if (EQ (status
, Qexit
))
1119 else if (EQ (p
->command
, Qt
))
1121 else if (EQ (status
, Qrun
))
1127 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
1129 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
1130 If PROCESS has not yet exited or died, return 0. */)
1131 (register Lisp_Object process
)
1133 CHECK_PROCESS (process
);
1134 if (XPROCESS (process
)->raw_status_new
)
1135 update_status (XPROCESS (process
));
1136 if (CONSP (XPROCESS (process
)->status
))
1137 return XCAR (XCDR (XPROCESS (process
)->status
));
1138 return make_number (0);
1141 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
1142 doc
: /* Return the process id of PROCESS.
1143 This is the pid of the external process which PROCESS uses or talks to.
1144 For a network, serial, and pipe connections, this value is nil. */)
1145 (register Lisp_Object process
)
1149 CHECK_PROCESS (process
);
1150 pid
= XPROCESS (process
)->pid
;
1151 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
1154 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
1155 doc
: /* Return the name of PROCESS, as a string.
1156 This is the name of the program invoked in PROCESS,
1157 possibly modified to make it unique among process names. */)
1158 (register Lisp_Object process
)
1160 CHECK_PROCESS (process
);
1161 return XPROCESS (process
)->name
;
1164 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
1165 doc
: /* Return the command that was executed to start PROCESS.
1166 This is a list of strings, the first string being the program executed
1167 and the rest of the strings being the arguments given to it.
1168 For a network or serial or pipe connection, this is nil (process is running)
1169 or t (process is stopped). */)
1170 (register Lisp_Object process
)
1172 CHECK_PROCESS (process
);
1173 return XPROCESS (process
)->command
;
1176 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
1177 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
1178 This is the terminal that the process itself reads and writes on,
1179 not the name of the pty that Emacs uses to talk with that terminal. */)
1180 (register Lisp_Object process
)
1182 CHECK_PROCESS (process
);
1183 return XPROCESS (process
)->tty_name
;
1186 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
1188 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1190 (register Lisp_Object process
, Lisp_Object buffer
)
1192 struct Lisp_Process
*p
;
1194 CHECK_PROCESS (process
);
1196 CHECK_BUFFER (buffer
);
1197 p
= XPROCESS (process
);
1198 pset_buffer (p
, buffer
);
1199 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1200 pset_childp (p
, Fplist_put (p
->childp
, QCbuffer
, buffer
));
1201 setup_process_coding_systems (process
);
1205 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
1207 doc
: /* Return the buffer PROCESS is associated with.
1208 The default process filter inserts output from PROCESS into this buffer. */)
1209 (register Lisp_Object process
)
1211 CHECK_PROCESS (process
);
1212 return XPROCESS (process
)->buffer
;
1215 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
1217 doc
: /* Return the marker for the end of the last output from PROCESS. */)
1218 (register Lisp_Object process
)
1220 CHECK_PROCESS (process
);
1221 return XPROCESS (process
)->mark
;
1225 set_process_filter_masks (struct Lisp_Process
*p
)
1227 if (EQ (p
->filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1228 delete_read_fd (p
->infd
);
1229 else if (EQ (p
->filter
, Qt
)
1230 /* Network or serial process not stopped: */
1231 && !EQ (p
->command
, Qt
))
1232 add_process_read_fd (p
->infd
);
1235 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1237 doc
: /* Give PROCESS the filter function FILTER; nil means default.
1238 A value of t means stop accepting output from the process.
1240 When a process has a non-default filter, its buffer is not used for output.
1241 Instead, each time it does output, the entire string of output is
1242 passed to the filter.
1244 The filter gets two arguments: the process and the string of output.
1245 The string argument is normally a multibyte string, except:
1246 - if the process's input coding system is no-conversion or raw-text,
1247 it is a unibyte string (the non-converted input), or else
1248 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1249 string (the result of converting the decoded input multibyte
1250 string to unibyte with `string-make-unibyte'). */)
1251 (Lisp_Object process
, Lisp_Object filter
)
1253 CHECK_PROCESS (process
);
1254 struct Lisp_Process
*p
= XPROCESS (process
);
1256 /* Don't signal an error if the process's input file descriptor
1257 is closed. This could make debugging Lisp more difficult,
1258 for example when doing something like
1260 (setq process (start-process ...))
1262 (set-process-filter process ...) */
1265 filter
= Qinternal_default_process_filter
;
1267 pset_filter (p
, filter
);
1270 set_process_filter_masks (p
);
1272 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1273 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1274 setup_process_coding_systems (process
);
1278 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1280 doc
: /* Return the filter function of PROCESS.
1281 See `set-process-filter' for more info on filter functions. */)
1282 (register Lisp_Object process
)
1284 CHECK_PROCESS (process
);
1285 return XPROCESS (process
)->filter
;
1288 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1290 doc
: /* Give PROCESS the sentinel SENTINEL; nil for default.
1291 The sentinel is called as a function when the process changes state.
1292 It gets two arguments: the process, and a string describing the change. */)
1293 (register Lisp_Object process
, Lisp_Object sentinel
)
1295 struct Lisp_Process
*p
;
1297 CHECK_PROCESS (process
);
1298 p
= XPROCESS (process
);
1300 if (NILP (sentinel
))
1301 sentinel
= Qinternal_default_process_sentinel
;
1303 pset_sentinel (p
, sentinel
);
1304 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1305 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1309 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1311 doc
: /* Return the sentinel of PROCESS.
1312 See `set-process-sentinel' for more info on sentinels. */)
1313 (register Lisp_Object process
)
1315 CHECK_PROCESS (process
);
1316 return XPROCESS (process
)->sentinel
;
1319 DEFUN ("set-process-thread", Fset_process_thread
, Sset_process_thread
,
1321 doc
: /* Set the locking thread of PROCESS to be THREAD.
1322 If THREAD is nil, the process is unlocked. */)
1323 (Lisp_Object process
, Lisp_Object thread
)
1325 struct Lisp_Process
*proc
;
1326 struct thread_state
*tstate
;
1328 CHECK_PROCESS (process
);
1333 CHECK_THREAD (thread
);
1334 tstate
= XTHREAD (thread
);
1337 proc
= XPROCESS (process
);
1338 pset_thread (proc
, thread
);
1339 if (proc
->infd
>= 0)
1340 fd_callback_info
[proc
->infd
].thread
= tstate
;
1341 if (proc
->outfd
>= 0)
1342 fd_callback_info
[proc
->outfd
].thread
= tstate
;
1347 DEFUN ("process-thread", Fprocess_thread
, Sprocess_thread
,
1349 doc
: /* Ret the locking thread of PROCESS.
1350 If PROCESS is unlocked, this function returns nil. */)
1351 (Lisp_Object process
)
1353 CHECK_PROCESS (process
);
1354 return XPROCESS (process
)->thread
;
1357 DEFUN ("set-process-window-size", Fset_process_window_size
,
1358 Sset_process_window_size
, 3, 3, 0,
1359 doc
: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1360 Value is t if PROCESS was successfully told about the window size,
1362 (Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1364 CHECK_PROCESS (process
);
1366 /* All known platforms store window sizes as 'unsigned short'. */
1367 CHECK_RANGED_INTEGER (height
, 0, USHRT_MAX
);
1368 CHECK_RANGED_INTEGER (width
, 0, USHRT_MAX
);
1370 if (NETCONN_P (process
)
1371 || XPROCESS (process
)->infd
< 0
1372 || (set_window_size (XPROCESS (process
)->infd
,
1373 XINT (height
), XINT (width
))
1380 DEFUN ("set-process-inherit-coding-system-flag",
1381 Fset_process_inherit_coding_system_flag
,
1382 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1383 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1384 If the second argument FLAG is non-nil, then the variable
1385 `buffer-file-coding-system' of the buffer associated with PROCESS
1386 will be bound to the value of the coding system used to decode
1389 This is useful when the coding system specified for the process buffer
1390 leaves either the character code conversion or the end-of-line conversion
1391 unspecified, or if the coding system used to decode the process output
1392 is more appropriate for saving the process buffer.
1394 Binding the variable `inherit-process-coding-system' to non-nil before
1395 starting the process is an alternative way of setting the inherit flag
1396 for the process which will run.
1398 This function returns FLAG. */)
1399 (register Lisp_Object process
, Lisp_Object flag
)
1401 CHECK_PROCESS (process
);
1402 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1406 DEFUN ("set-process-query-on-exit-flag",
1407 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1409 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1410 If the second argument FLAG is non-nil, Emacs will query the user before
1411 exiting or killing a buffer if PROCESS is running. This function
1413 (register Lisp_Object process
, Lisp_Object flag
)
1415 CHECK_PROCESS (process
);
1416 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1420 DEFUN ("process-query-on-exit-flag",
1421 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1423 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1424 (register Lisp_Object process
)
1426 CHECK_PROCESS (process
);
1427 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1430 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1432 doc
: /* Return the contact info of PROCESS; t for a real child.
1433 For a network or serial or pipe connection, the value depends on the
1434 optional KEY arg. If KEY is nil, value is a cons cell of the form
1435 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1436 connection; it is t for a pipe connection. If KEY is t, the complete
1437 contact information for the connection is returned, else the specific
1438 value for the keyword KEY is returned. See `make-network-process',
1439 `make-serial-process', or `make pipe-process' for the list of keywords.
1440 If PROCESS is a non-blocking network process that hasn't been fully
1441 set up yet, this function will block until socket setup has completed. */)
1442 (Lisp_Object process
, Lisp_Object key
)
1444 Lisp_Object contact
;
1446 CHECK_PROCESS (process
);
1447 contact
= XPROCESS (process
)->childp
;
1449 #ifdef DATAGRAM_SOCKETS
1451 if (NETCONN_P (process
))
1452 wait_for_socket_fds (process
, "process-contact");
1454 if (DATAGRAM_CONN_P (process
)
1455 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1456 contact
= Fplist_put (contact
, QCremote
,
1457 Fprocess_datagram_address (process
));
1460 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
) && !PIPECONN_P (process
))
1463 if (NILP (key
) && NETCONN_P (process
))
1464 return list2 (Fplist_get (contact
, QChost
),
1465 Fplist_get (contact
, QCservice
));
1466 if (NILP (key
) && SERIALCONN_P (process
))
1467 return list2 (Fplist_get (contact
, QCport
),
1468 Fplist_get (contact
, QCspeed
));
1469 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1470 if the pipe process is useful for purposes other than receiving
1472 if (NILP (key
) && PIPECONN_P (process
))
1474 return Fplist_get (contact
, key
);
1477 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1479 doc
: /* Return the plist of PROCESS. */)
1480 (register Lisp_Object process
)
1482 CHECK_PROCESS (process
);
1483 return XPROCESS (process
)->plist
;
1486 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1488 doc
: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1489 (Lisp_Object process
, Lisp_Object plist
)
1491 CHECK_PROCESS (process
);
1494 pset_plist (XPROCESS (process
), plist
);
1498 #if 0 /* Turned off because we don't currently record this info
1499 in the process. Perhaps add it. */
1500 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1501 doc
: /* Return the connection type of PROCESS.
1502 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1503 a socket connection. */)
1504 (Lisp_Object process
)
1506 return XPROCESS (process
)->type
;
1510 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1511 doc
: /* Return the connection type of PROCESS.
1512 The value is either the symbol `real', `network', `serial', or `pipe'.
1513 PROCESS may be a process, a buffer, the name of a process or buffer, or
1514 nil, indicating the current buffer's process. */)
1515 (Lisp_Object process
)
1518 proc
= get_process (process
);
1519 return XPROCESS (proc
)->type
;
1522 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1524 doc
: /* Convert network ADDRESS from internal format to a string.
1525 A 4 or 5 element vector represents an IPv4 address (with port number).
1526 An 8 or 9 element vector represents an IPv6 address (with port number).
1527 If optional second argument OMIT-PORT is non-nil, don't include a port
1528 number in the string, even when present in ADDRESS.
1529 Return nil if format of ADDRESS is invalid. */)
1530 (Lisp_Object address
, Lisp_Object omit_port
)
1535 if (STRINGP (address
)) /* AF_LOCAL */
1538 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1540 register struct Lisp_Vector
*p
= XVECTOR (address
);
1541 ptrdiff_t size
= p
->header
.size
;
1542 Lisp_Object args
[10];
1546 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1548 format
= "%d.%d.%d.%d";
1553 format
= "%d.%d.%d.%d:%d";
1556 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1558 format
= "%x:%x:%x:%x:%x:%x:%x:%x";
1563 format
= "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1569 AUTO_STRING (format_obj
, format
);
1570 args
[0] = format_obj
;
1572 for (i
= 0; i
< nargs
; i
++)
1574 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1577 if (nargs
<= 5 /* IPv4 */
1578 && i
< 4 /* host, not port */
1579 && XINT (p
->contents
[i
]) > 255)
1582 args
[i
+ 1] = p
->contents
[i
];
1585 return Fformat (nargs
+ 1, args
);
1588 if (CONSP (address
))
1590 AUTO_STRING (format
, "<Family %d>");
1591 return CALLN (Fformat
, format
, Fcar (address
));
1597 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1598 doc
: /* Return a list of all processes that are Emacs sub-processes. */)
1601 return Fmapcar (Qcdr
, Vprocess_alist
);
1604 /* Starting asynchronous inferior processes. */
1606 DEFUN ("make-process", Fmake_process
, Smake_process
, 0, MANY
, 0,
1607 doc
: /* Start a program in a subprocess. Return the process object for it.
1609 This is similar to `start-process', but arguments are specified as
1610 keyword/argument pairs. The following arguments are defined:
1612 :name NAME -- NAME is name for process. It is modified if necessary
1615 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1616 with the process. Process output goes at end of that buffer, unless
1617 you specify an output stream or filter function to handle the output.
1618 BUFFER may be also nil, meaning that this process is not associated
1621 :command COMMAND -- COMMAND is a list starting with the program file
1622 name, followed by strings to give to the program as arguments.
1624 :coding CODING -- If CODING is a symbol, it specifies the coding
1625 system used for both reading and writing for this process. If CODING
1626 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1627 ENCODING is used for writing.
1629 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1630 the process is running. If BOOL is not given, query before exiting.
1632 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1633 In the stopped state, a process does not accept incoming data, but you
1634 can send outgoing data. The stopped state is cleared by
1635 `continue-process' and set by `stop-process'.
1637 :connection-type TYPE -- TYPE is control type of device used to
1638 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1639 to use a pty, or nil to use the default specified through
1640 `process-connection-type'.
1642 :filter FILTER -- Install FILTER as the process filter.
1644 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1646 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1647 to the standard error of subprocess. Specifying this implies
1648 `:connection-type' is set to `pipe'.
1650 usage: (make-process &rest ARGS) */)
1651 (ptrdiff_t nargs
, Lisp_Object
*args
)
1653 Lisp_Object buffer
, name
, command
, program
, proc
, contact
, current_dir
, tem
;
1654 Lisp_Object xstderr
, stderrproc
;
1655 ptrdiff_t count
= SPECPDL_INDEX ();
1660 /* Save arguments for process-contact and clone-process. */
1661 contact
= Flist (nargs
, args
);
1663 buffer
= Fplist_get (contact
, QCbuffer
);
1665 buffer
= Fget_buffer_create (buffer
);
1667 /* Make sure that the child will be able to chdir to the current
1668 buffer's current directory, or its unhandled equivalent. We
1669 can't just have the child check for an error when it does the
1670 chdir, since it's in a vfork. */
1671 current_dir
= encode_current_directory ();
1673 name
= Fplist_get (contact
, QCname
);
1674 CHECK_STRING (name
);
1676 command
= Fplist_get (contact
, QCcommand
);
1677 if (CONSP (command
))
1678 program
= XCAR (command
);
1682 if (!NILP (program
))
1683 CHECK_STRING (program
);
1686 xstderr
= Fplist_get (contact
, QCstderr
);
1687 if (PROCESSP (xstderr
))
1689 if (!PIPECONN_P (xstderr
))
1690 error ("Process is not a pipe process");
1691 stderrproc
= xstderr
;
1693 else if (!NILP (xstderr
))
1695 CHECK_STRING (program
);
1696 stderrproc
= CALLN (Fmake_pipe_process
,
1698 concat2 (name
, build_string (" stderr")),
1700 Fget_buffer_create (xstderr
));
1703 proc
= make_process (name
);
1704 record_unwind_protect (start_process_unwind
, proc
);
1706 pset_childp (XPROCESS (proc
), Qt
);
1707 eassert (NILP (XPROCESS (proc
)->plist
));
1708 pset_type (XPROCESS (proc
), Qreal
);
1709 pset_buffer (XPROCESS (proc
), buffer
);
1710 pset_sentinel (XPROCESS (proc
), Fplist_get (contact
, QCsentinel
));
1711 pset_filter (XPROCESS (proc
), Fplist_get (contact
, QCfilter
));
1712 pset_command (XPROCESS (proc
), Fcopy_sequence (command
));
1714 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
1715 XPROCESS (proc
)->kill_without_query
= 1;
1716 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
1717 pset_command (XPROCESS (proc
), Qt
);
1719 tem
= Fplist_get (contact
, QCconnection_type
);
1721 XPROCESS (proc
)->pty_flag
= true;
1722 else if (EQ (tem
, Qpipe
))
1723 XPROCESS (proc
)->pty_flag
= false;
1724 else if (NILP (tem
))
1725 XPROCESS (proc
)->pty_flag
= !NILP (Vprocess_connection_type
);
1727 report_file_error ("Unknown connection type", tem
);
1729 if (!NILP (stderrproc
))
1731 pset_stderrproc (XPROCESS (proc
), stderrproc
);
1733 XPROCESS (proc
)->pty_flag
= false;
1737 /* AKA GNUTLS_INITSTAGE(proc). */
1738 verify (GNUTLS_STAGE_EMPTY
== 0);
1739 eassert (XPROCESS (proc
)->gnutls_initstage
== GNUTLS_STAGE_EMPTY
);
1740 eassert (NILP (XPROCESS (proc
)->gnutls_cred_type
));
1743 XPROCESS (proc
)->adaptive_read_buffering
1744 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1745 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1747 /* Make the process marker point into the process buffer (if any). */
1748 if (BUFFERP (buffer
))
1749 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1750 BUF_ZV (XBUFFER (buffer
)),
1751 BUF_ZV_BYTE (XBUFFER (buffer
)));
1756 /* Decide coding systems for communicating with the process. Here
1757 we don't setup the structure coding_system nor pay attention to
1758 unibyte mode. They are done in create_process. */
1760 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1761 Lisp_Object coding_systems
= Qt
;
1762 Lisp_Object val
, *args2
;
1764 tem
= Fplist_get (contact
, QCcoding
);
1772 val
= Vcoding_system_for_read
;
1775 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1777 SAFE_ALLOCA_LISP (args2
, nargs2
);
1779 args2
[i
++] = Qstart_process
;
1781 args2
[i
++] = buffer
;
1782 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1783 args2
[i
++] = XCAR (tem2
);
1784 if (!NILP (program
))
1785 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1786 if (CONSP (coding_systems
))
1787 val
= XCAR (coding_systems
);
1788 else if (CONSP (Vdefault_process_coding_system
))
1789 val
= XCAR (Vdefault_process_coding_system
);
1791 pset_decode_coding_system (XPROCESS (proc
), val
);
1800 val
= Vcoding_system_for_write
;
1803 if (EQ (coding_systems
, Qt
))
1805 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1807 SAFE_ALLOCA_LISP (args2
, nargs2
);
1809 args2
[i
++] = Qstart_process
;
1811 args2
[i
++] = buffer
;
1812 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1813 args2
[i
++] = XCAR (tem2
);
1814 if (!NILP (program
))
1815 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1817 if (CONSP (coding_systems
))
1818 val
= XCDR (coding_systems
);
1819 else if (CONSP (Vdefault_process_coding_system
))
1820 val
= XCDR (Vdefault_process_coding_system
);
1822 pset_encode_coding_system (XPROCESS (proc
), val
);
1823 /* Note: At this moment, the above coding system may leave
1824 text-conversion or eol-conversion unspecified. They will be
1825 decided after we read output from the process and decode it by
1826 some coding system, or just before we actually send a text to
1831 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1832 eassert (XPROCESS (proc
)->decoding_carryover
== 0);
1833 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1835 XPROCESS (proc
)->inherit_coding_system_flag
1836 = !(NILP (buffer
) || !inherit_process_coding_system
);
1838 if (!NILP (program
))
1840 Lisp_Object program_args
= XCDR (command
);
1842 /* If program file name is not absolute, search our path for it.
1843 Put the name we will really use in TEM. */
1844 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1845 && !(SCHARS (program
) > 1
1846 && IS_DEVICE_SEP (SREF (program
, 1))))
1849 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
,
1850 make_number (X_OK
), false);
1852 report_file_error ("Searching for program", program
);
1853 tem
= Fexpand_file_name (tem
, Qnil
);
1857 if (!NILP (Ffile_directory_p (program
)))
1858 error ("Specified program for new process is a directory");
1862 /* Remove "/:" from TEM. */
1863 tem
= remove_slash_colon (tem
);
1865 Lisp_Object arg_encoding
= Qnil
;
1867 /* Encode the file name and put it in NEW_ARGV.
1868 That's where the child will use it to execute the program. */
1869 tem
= list1 (ENCODE_FILE (tem
));
1870 ptrdiff_t new_argc
= 1;
1872 /* Here we encode arguments by the coding system used for sending
1873 data to the process. We don't support using different coding
1874 systems for encoding arguments and for encoding data sent to the
1877 for (Lisp_Object tem2
= program_args
; CONSP (tem2
); tem2
= XCDR (tem2
))
1879 Lisp_Object arg
= XCAR (tem2
);
1881 if (STRING_MULTIBYTE (arg
))
1883 if (NILP (arg_encoding
))
1884 arg_encoding
= (complement_process_encoding_system
1885 (XPROCESS (proc
)->encode_coding_system
));
1886 arg
= code_convert_string_norecord (arg
, arg_encoding
, 1);
1888 tem
= Fcons (arg
, tem
);
1892 /* Now that everything is encoded we can collect the strings into
1895 SAFE_NALLOCA (new_argv
, 1, new_argc
+ 1);
1896 new_argv
[new_argc
] = 0;
1898 for (ptrdiff_t i
= new_argc
- 1; i
>= 0; i
--)
1900 new_argv
[i
] = SSDATA (XCAR (tem
));
1904 create_process (proc
, new_argv
, current_dir
);
1910 return unbind_to (count
, proc
);
1913 /* If PROC doesn't have its pid set, then an error was signaled and
1914 the process wasn't started successfully, so remove it. */
1916 start_process_unwind (Lisp_Object proc
)
1918 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1919 remove_process (proc
);
1922 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1925 close_process_fd (int *fd_addr
)
1935 /* Indexes of file descriptors in open_fds. */
1938 /* The pipe from Emacs to its subprocess. */
1940 WRITE_TO_SUBPROCESS
,
1942 /* The main pipe from the subprocess to Emacs. */
1943 READ_FROM_SUBPROCESS
,
1946 /* The pipe from the subprocess to Emacs that is closed when the
1947 subprocess execs. */
1948 READ_FROM_EXEC_MONITOR
,
1952 verify (PROCESS_OPEN_FDS
== EXEC_MONITOR_OUTPUT
+ 1);
1955 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1957 struct Lisp_Process
*p
= XPROCESS (process
);
1958 int inchannel
, outchannel
;
1961 int forkin
, forkout
, forkerr
= -1;
1963 char pty_name
[PTY_NAME_SIZE
];
1964 Lisp_Object lisp_pty_name
= Qnil
;
1967 inchannel
= outchannel
= -1;
1970 outchannel
= inchannel
= allocate_pty (pty_name
);
1974 p
->open_fd
[READ_FROM_SUBPROCESS
] = inchannel
;
1975 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1976 /* On most USG systems it does not work to open the pty's tty here,
1977 then close it and reopen it in the child. */
1978 /* Don't let this terminal become our controlling terminal
1979 (in case we don't have one). */
1980 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1982 report_file_error ("Opening pty", Qnil
);
1983 p
->open_fd
[SUBPROCESS_STDIN
] = forkin
;
1985 forkin
= forkout
= -1;
1986 #endif /* not USG, or USG_SUBTTY_WORKS */
1988 lisp_pty_name
= build_string (pty_name
);
1992 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
1993 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
1994 report_file_error ("Creating pipe", Qnil
);
1995 forkin
= p
->open_fd
[SUBPROCESS_STDIN
];
1996 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
1997 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
1998 forkout
= p
->open_fd
[SUBPROCESS_STDOUT
];
2000 if (!NILP (p
->stderrproc
))
2002 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
2004 forkerr
= pp
->open_fd
[SUBPROCESS_STDOUT
];
2006 /* Close unnecessary file descriptors. */
2007 close_process_fd (&pp
->open_fd
[WRITE_TO_SUBPROCESS
]);
2008 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDIN
]);
2013 if (emacs_pipe (p
->open_fd
+ READ_FROM_EXEC_MONITOR
) != 0)
2014 report_file_error ("Creating pipe", Qnil
);
2017 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2018 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2020 /* Record this as an active process, with its channels. */
2021 chan_process
[inchannel
] = process
;
2022 p
->infd
= inchannel
;
2023 p
->outfd
= outchannel
;
2025 /* Previously we recorded the tty descriptor used in the subprocess.
2026 It was only used for getting the foreground tty process, so now
2027 we just reopen the device (see emacs_get_tty_pgrp) as this is
2028 more portable (see USG_SUBTTY_WORKS above). */
2030 p
->pty_flag
= pty_flag
;
2031 pset_status (p
, Qrun
);
2033 if (!EQ (p
->command
, Qt
))
2034 add_process_read_fd (inchannel
);
2036 /* This may signal an error. */
2037 setup_process_coding_systems (process
);
2040 block_child_signal (&oldset
);
2043 /* vfork, and prevent local vars from being clobbered by the vfork. */
2044 Lisp_Object
volatile current_dir_volatile
= current_dir
;
2045 Lisp_Object
volatile lisp_pty_name_volatile
= lisp_pty_name
;
2046 char **volatile new_argv_volatile
= new_argv
;
2047 int volatile forkin_volatile
= forkin
;
2048 int volatile forkout_volatile
= forkout
;
2049 int volatile forkerr_volatile
= forkerr
;
2050 struct Lisp_Process
*p_volatile
= p
;
2053 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2054 necessary. Also, reset SIGCHLD handling after a vfork, as
2055 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2062 signal (SIGCHLD
, SIG_DFL
);
2068 current_dir
= current_dir_volatile
;
2069 lisp_pty_name
= lisp_pty_name_volatile
;
2070 new_argv
= new_argv_volatile
;
2071 forkin
= forkin_volatile
;
2072 forkout
= forkout_volatile
;
2073 forkerr
= forkerr_volatile
;
2076 pty_flag
= p
->pty_flag
;
2079 #endif /* not WINDOWSNT */
2081 /* Make the pty be the controlling terminal of the process. */
2083 /* First, disconnect its current controlling terminal. */
2086 /* Make the pty's terminal the controlling terminal. */
2087 if (pty_flag
&& forkin
>= 0)
2090 /* We ignore the return value
2091 because faith@cs.unc.edu says that is necessary on Linux. */
2092 ioctl (forkin
, TIOCSCTTY
, 0);
2095 #if defined (LDISC1)
2096 if (pty_flag
&& forkin
>= 0)
2099 tcgetattr (forkin
, &t
);
2101 if (tcsetattr (forkin
, TCSANOW
, &t
) < 0)
2102 emacs_perror ("create_process/tcsetattr LDISC1");
2105 #if defined (NTTYDISC) && defined (TIOCSETD)
2106 if (pty_flag
&& forkin
>= 0)
2108 /* Use new line discipline. */
2109 int ldisc
= NTTYDISC
;
2110 ioctl (forkin
, TIOCSETD
, &ldisc
);
2115 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2116 can do TIOCSPGRP only to the process's controlling tty. */
2119 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2120 I can't test it since I don't have 4.3. */
2121 int j
= emacs_open (DEV_TTY
, O_RDWR
, 0);
2124 ioctl (j
, TIOCNOTTY
, 0);
2128 #endif /* TIOCNOTTY */
2130 #if !defined (DONT_REOPEN_PTY)
2131 /*** There is a suggestion that this ought to be a
2132 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2133 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2134 that system does seem to need this code, even though
2135 both TIOCSCTTY is defined. */
2136 /* Now close the pty (if we had it open) and reopen it.
2137 This makes the pty the controlling terminal of the subprocess. */
2141 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2144 emacs_close (forkin
);
2145 forkout
= forkin
= emacs_open (SSDATA (lisp_pty_name
), O_RDWR
, 0);
2149 emacs_perror (SSDATA (lisp_pty_name
));
2150 _exit (EXIT_CANCELED
);
2154 #endif /* not DONT_REOPEN_PTY */
2156 #ifdef SETUP_SLAVE_PTY
2161 #endif /* SETUP_SLAVE_PTY */
2162 #endif /* HAVE_PTYS */
2164 signal (SIGINT
, SIG_DFL
);
2165 signal (SIGQUIT
, SIG_DFL
);
2167 signal (SIGPROF
, SIG_DFL
);
2170 /* Emacs ignores SIGPIPE, but the child should not. */
2171 signal (SIGPIPE
, SIG_DFL
);
2173 /* Stop blocking SIGCHLD in the child. */
2174 unblock_child_signal (&oldset
);
2177 child_setup_tty (forkout
);
2182 pid
= child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
2183 #else /* not WINDOWSNT */
2184 child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
2185 #endif /* not WINDOWSNT */
2188 /* Back in the parent process. */
2190 vfork_errno
= errno
;
2195 /* Stop blocking in the parent. */
2196 unblock_child_signal (&oldset
);
2200 report_file_errno ("Doing vfork", Qnil
, vfork_errno
);
2203 /* vfork succeeded. */
2205 /* Close the pipe ends that the child uses, or the child's pty. */
2206 close_process_fd (&p
->open_fd
[SUBPROCESS_STDIN
]);
2207 close_process_fd (&p
->open_fd
[SUBPROCESS_STDOUT
]);
2210 register_child (pid
, inchannel
);
2211 #endif /* WINDOWSNT */
2213 pset_tty_name (p
, lisp_pty_name
);
2216 /* Wait for child_setup to complete in case that vfork is
2217 actually defined as fork. The descriptor
2218 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2219 of a pipe is closed at the child side either by close-on-exec
2220 on successful execve or the _exit call in child_setup. */
2224 close_process_fd (&p
->open_fd
[EXEC_MONITOR_OUTPUT
]);
2225 emacs_read (p
->open_fd
[READ_FROM_EXEC_MONITOR
], &dummy
, 1);
2226 close_process_fd (&p
->open_fd
[READ_FROM_EXEC_MONITOR
]);
2229 if (!NILP (p
->stderrproc
))
2231 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
2232 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDOUT
]);
2238 create_pty (Lisp_Object process
)
2240 struct Lisp_Process
*p
= XPROCESS (process
);
2241 char pty_name
[PTY_NAME_SIZE
];
2242 int pty_fd
= !p
->pty_flag
? -1 : allocate_pty (pty_name
);
2246 p
->open_fd
[SUBPROCESS_STDIN
] = pty_fd
;
2247 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2248 /* On most USG systems it does not work to open the pty's tty here,
2249 then close it and reopen it in the child. */
2250 /* Don't let this terminal become our controlling terminal
2251 (in case we don't have one). */
2252 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2254 report_file_error ("Opening pty", Qnil
);
2255 p
->open_fd
[WRITE_TO_SUBPROCESS
] = forkout
;
2256 #if defined (DONT_REOPEN_PTY)
2257 /* In the case that vfork is defined as fork, the parent process
2258 (Emacs) may send some data before the child process completes
2259 tty options setup. So we setup tty before forking. */
2260 child_setup_tty (forkout
);
2261 #endif /* DONT_REOPEN_PTY */
2262 #endif /* not USG, or USG_SUBTTY_WORKS */
2264 fcntl (pty_fd
, F_SETFL
, O_NONBLOCK
);
2266 /* Record this as an active process, with its channels.
2267 As a result, child_setup will close Emacs's side of the pipes. */
2268 chan_process
[pty_fd
] = process
;
2272 /* Previously we recorded the tty descriptor used in the subprocess.
2273 It was only used for getting the foreground tty process, so now
2274 we just reopen the device (see emacs_get_tty_pgrp) as this is
2275 more portable (see USG_SUBTTY_WORKS above). */
2278 pset_status (p
, Qrun
);
2279 setup_process_coding_systems (process
);
2281 add_process_read_fd (pty_fd
);
2283 pset_tty_name (p
, build_string (pty_name
));
2289 DEFUN ("make-pipe-process", Fmake_pipe_process
, Smake_pipe_process
,
2291 doc
: /* Create and return a bidirectional pipe process.
2293 In Emacs, pipes are represented by process objects, so input and
2294 output work as for subprocesses, and `delete-process' closes a pipe.
2295 However, a pipe process has no process id, it cannot be signaled,
2296 and the status codes are different from normal processes.
2298 Arguments are specified as keyword/argument pairs. The following
2299 arguments are defined:
2301 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2303 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2304 with the process. Process output goes at the end of that buffer,
2305 unless you specify an output stream or filter function to handle the
2306 output. If BUFFER is not given, the value of NAME is used.
2308 :coding CODING -- If CODING is a symbol, it specifies the coding
2309 system used for both reading and writing for this process. If CODING
2310 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2311 ENCODING is used for writing.
2313 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2314 the process is running. If BOOL is not given, query before exiting.
2316 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2317 In the stopped state, a pipe process does not accept incoming data,
2318 but you can send outgoing data. The stopped state is cleared by
2319 `continue-process' and set by `stop-process'.
2321 :filter FILTER -- Install FILTER as the process filter.
2323 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2325 usage: (make-pipe-process &rest ARGS) */)
2326 (ptrdiff_t nargs
, Lisp_Object
*args
)
2328 Lisp_Object proc
, contact
;
2329 struct Lisp_Process
*p
;
2330 Lisp_Object name
, buffer
;
2332 ptrdiff_t specpdl_count
;
2333 int inchannel
, outchannel
;
2338 contact
= Flist (nargs
, args
);
2340 name
= Fplist_get (contact
, QCname
);
2341 CHECK_STRING (name
);
2342 proc
= make_process (name
);
2343 specpdl_count
= SPECPDL_INDEX ();
2344 record_unwind_protect (remove_process
, proc
);
2345 p
= XPROCESS (proc
);
2347 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
2348 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
2349 report_file_error ("Creating pipe", Qnil
);
2350 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
2351 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
2353 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2354 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2357 register_aux_fd (inchannel
);
2360 /* Record this as an active process, with its channels. */
2361 chan_process
[inchannel
] = proc
;
2362 p
->infd
= inchannel
;
2363 p
->outfd
= outchannel
;
2365 if (inchannel
> max_desc
)
2366 max_desc
= inchannel
;
2368 buffer
= Fplist_get (contact
, QCbuffer
);
2371 buffer
= Fget_buffer_create (buffer
);
2372 pset_buffer (p
, buffer
);
2374 pset_childp (p
, contact
);
2375 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2376 pset_type (p
, Qpipe
);
2377 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2378 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2379 eassert (NILP (p
->log
));
2380 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2381 p
->kill_without_query
= 1;
2382 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2383 pset_command (p
, Qt
);
2384 eassert (! p
->pty_flag
);
2386 if (!EQ (p
->command
, Qt
))
2387 add_process_read_fd (inchannel
);
2388 p
->adaptive_read_buffering
2389 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
2390 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
2392 /* Make the process marker point into the process buffer (if any). */
2393 if (BUFFERP (buffer
))
2394 set_marker_both (p
->mark
, buffer
,
2395 BUF_ZV (XBUFFER (buffer
)),
2396 BUF_ZV_BYTE (XBUFFER (buffer
)));
2399 /* Setup coding systems for communicating with the network stream. */
2401 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2402 Lisp_Object coding_systems
= Qt
;
2405 tem
= Fplist_get (contact
, QCcoding
);
2413 else if (!NILP (Vcoding_system_for_read
))
2414 val
= Vcoding_system_for_read
;
2415 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2416 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2417 /* We dare not decode end-of-line format by setting VAL to
2418 Qraw_text, because the existing Emacs Lisp libraries
2419 assume that they receive bare code including a sequence of
2424 if (CONSP (coding_systems
))
2425 val
= XCAR (coding_systems
);
2426 else if (CONSP (Vdefault_process_coding_system
))
2427 val
= XCAR (Vdefault_process_coding_system
);
2431 pset_decode_coding_system (p
, val
);
2439 else if (!NILP (Vcoding_system_for_write
))
2440 val
= Vcoding_system_for_write
;
2441 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2445 if (CONSP (coding_systems
))
2446 val
= XCDR (coding_systems
);
2447 else if (CONSP (Vdefault_process_coding_system
))
2448 val
= XCDR (Vdefault_process_coding_system
);
2452 pset_encode_coding_system (p
, val
);
2454 /* This may signal an error. */
2455 setup_process_coding_systems (proc
);
2457 specpdl_ptr
= specpdl
+ specpdl_count
;
2463 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2464 The address family of sa is not included in the result. */
2467 conv_sockaddr_to_lisp (struct sockaddr
*sa
, ptrdiff_t len
)
2469 Lisp_Object address
;
2472 struct Lisp_Vector
*p
;
2474 /* Workaround for a bug in getsockname on BSD: Names bound to
2475 sockets in the UNIX domain are inaccessible; getsockname returns
2476 a zero length name. */
2477 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2478 return empty_unibyte_string
;
2480 switch (sa
->sa_family
)
2484 DECLARE_POINTER_ALIAS (sin
, struct sockaddr_in
, sa
);
2485 len
= sizeof (sin
->sin_addr
) + 1;
2486 address
= Fmake_vector (make_number (len
), Qnil
);
2487 p
= XVECTOR (address
);
2488 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2489 cp
= (unsigned char *) &sin
->sin_addr
;
2495 DECLARE_POINTER_ALIAS (sin6
, struct sockaddr_in6
, sa
);
2496 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &sin6
->sin6_addr
);
2497 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2498 address
= Fmake_vector (make_number (len
), Qnil
);
2499 p
= XVECTOR (address
);
2500 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2501 for (i
= 0; i
< len
; i
++)
2502 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2506 #ifdef HAVE_LOCAL_SOCKETS
2509 DECLARE_POINTER_ALIAS (sockun
, struct sockaddr_un
, sa
);
2510 ptrdiff_t name_length
= len
- offsetof (struct sockaddr_un
, sun_path
);
2511 /* If the first byte is NUL, the name is a Linux abstract
2512 socket name, and the name can contain embedded NULs. If
2513 it's not, we have a NUL-terminated string. Be careful not
2514 to walk past the end of the object looking for the name
2515 terminator, however. */
2516 if (name_length
> 0 && sockun
->sun_path
[0] != '\0')
2518 const char *terminator
2519 = memchr (sockun
->sun_path
, '\0', name_length
);
2522 name_length
= terminator
- (const char *) sockun
->sun_path
;
2525 return make_unibyte_string (sockun
->sun_path
, name_length
);
2529 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2530 address
= Fcons (make_number (sa
->sa_family
),
2531 Fmake_vector (make_number (len
), Qnil
));
2532 p
= XVECTOR (XCDR (address
));
2533 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2539 p
->contents
[i
++] = make_number (*cp
++);
2544 /* Convert an internal struct addrinfo to a Lisp object. */
2547 conv_addrinfo_to_lisp (struct addrinfo
*res
)
2549 Lisp_Object protocol
= make_number (res
->ai_protocol
);
2550 eassert (XINT (protocol
) == res
->ai_protocol
);
2551 return Fcons (protocol
, conv_sockaddr_to_lisp (res
->ai_addr
, res
->ai_addrlen
));
2555 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2558 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2560 struct Lisp_Vector
*p
;
2562 if (VECTORP (address
))
2564 p
= XVECTOR (address
);
2565 if (p
->header
.size
== 5)
2568 return sizeof (struct sockaddr_in
);
2571 else if (p
->header
.size
== 9)
2573 *familyp
= AF_INET6
;
2574 return sizeof (struct sockaddr_in6
);
2578 #ifdef HAVE_LOCAL_SOCKETS
2579 else if (STRINGP (address
))
2581 *familyp
= AF_LOCAL
;
2582 return sizeof (struct sockaddr_un
);
2585 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2586 && VECTORP (XCDR (address
)))
2588 struct sockaddr
*sa
;
2589 p
= XVECTOR (XCDR (address
));
2590 if (MAX_ALLOCA
- sizeof sa
->sa_family
< p
->header
.size
)
2592 *familyp
= XINT (XCAR (address
));
2593 return p
->header
.size
+ sizeof (sa
->sa_family
);
2598 /* Convert an address object (vector or string) to an internal sockaddr.
2600 The address format has been basically validated by
2601 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2602 it could have come from user data. So if FAMILY is not valid,
2603 we return after zeroing *SA. */
2606 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2608 register struct Lisp_Vector
*p
;
2609 register unsigned char *cp
= NULL
;
2613 memset (sa
, 0, len
);
2615 if (VECTORP (address
))
2617 p
= XVECTOR (address
);
2618 if (family
== AF_INET
)
2620 DECLARE_POINTER_ALIAS (sin
, struct sockaddr_in
, sa
);
2621 len
= sizeof (sin
->sin_addr
) + 1;
2622 hostport
= XINT (p
->contents
[--len
]);
2623 sin
->sin_port
= htons (hostport
);
2624 cp
= (unsigned char *)&sin
->sin_addr
;
2625 sa
->sa_family
= family
;
2628 else if (family
== AF_INET6
)
2630 DECLARE_POINTER_ALIAS (sin6
, struct sockaddr_in6
, sa
);
2631 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &sin6
->sin6_addr
);
2632 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2633 hostport
= XINT (p
->contents
[--len
]);
2634 sin6
->sin6_port
= htons (hostport
);
2635 for (i
= 0; i
< len
; i
++)
2636 if (INTEGERP (p
->contents
[i
]))
2638 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2641 sa
->sa_family
= family
;
2648 else if (STRINGP (address
))
2650 #ifdef HAVE_LOCAL_SOCKETS
2651 if (family
== AF_LOCAL
)
2653 DECLARE_POINTER_ALIAS (sockun
, struct sockaddr_un
, sa
);
2654 cp
= SDATA (address
);
2655 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2656 sockun
->sun_path
[i
] = *cp
++;
2657 sa
->sa_family
= family
;
2664 p
= XVECTOR (XCDR (address
));
2665 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2668 for (i
= 0; i
< len
; i
++)
2669 if (INTEGERP (p
->contents
[i
]))
2670 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2673 #ifdef DATAGRAM_SOCKETS
2674 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2676 doc
: /* Get the current datagram address associated with PROCESS.
2677 If PROCESS is a non-blocking network process that hasn't been fully
2678 set up yet, this function will block until socket setup has completed. */)
2679 (Lisp_Object process
)
2683 CHECK_PROCESS (process
);
2685 if (NETCONN_P (process
))
2686 wait_for_socket_fds (process
, "process-datagram-address");
2688 if (!DATAGRAM_CONN_P (process
))
2691 channel
= XPROCESS (process
)->infd
;
2692 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2693 datagram_address
[channel
].len
);
2696 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2698 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2699 Return nil upon error setting address, ADDRESS otherwise.
2701 If PROCESS is a non-blocking network process that hasn't been fully
2702 set up yet, this function will block until socket setup has completed. */)
2703 (Lisp_Object process
, Lisp_Object address
)
2709 CHECK_PROCESS (process
);
2711 if (NETCONN_P (process
))
2712 wait_for_socket_fds (process
, "set-process-datagram-address");
2714 if (!DATAGRAM_CONN_P (process
))
2717 channel
= XPROCESS (process
)->infd
;
2719 len
= get_lisp_to_sockaddr_size (address
, &family
);
2720 if (len
== 0 || datagram_address
[channel
].len
!= len
)
2722 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2728 static const struct socket_options
{
2729 /* The name of this option. Should be lowercase version of option
2730 name without SO_ prefix. */
2732 /* Option level SOL_... */
2734 /* Option number SO_... */
2736 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2737 enum { OPIX_NONE
= 0, OPIX_MISC
= 1, OPIX_REUSEADDR
= 2 } optbit
;
2738 } socket_options
[] =
2740 #ifdef SO_BINDTODEVICE
2741 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2744 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2747 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2750 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2753 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2756 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2759 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2762 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2764 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2767 /* Set option OPT to value VAL on socket S.
2769 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2770 Signals an error if setting a known option fails.
2774 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2777 const struct socket_options
*sopt
;
2782 name
= SSDATA (SYMBOL_NAME (opt
));
2783 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2784 if (strcmp (name
, sopt
->name
) == 0)
2787 switch (sopt
->opttype
)
2792 optval
= NILP (val
) ? 0 : 1;
2793 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2794 &optval
, sizeof (optval
));
2801 if (TYPE_RANGED_INTEGERP (int, val
))
2802 optval
= XINT (val
);
2804 error ("Bad option value for %s", name
);
2805 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2806 &optval
, sizeof (optval
));
2810 #ifdef SO_BINDTODEVICE
2813 char devname
[IFNAMSIZ
+ 1];
2815 /* This is broken, at least in the Linux 2.4 kernel.
2816 To unbind, the arg must be a zero integer, not the empty string.
2817 This should work on all systems. KFS. 2003-09-23. */
2818 memset (devname
, 0, sizeof devname
);
2821 char *arg
= SSDATA (val
);
2822 int len
= min (strlen (arg
), IFNAMSIZ
);
2823 memcpy (devname
, arg
, len
);
2825 else if (!NILP (val
))
2826 error ("Bad option value for %s", name
);
2827 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2836 struct linger linger
;
2839 linger
.l_linger
= 0;
2840 if (TYPE_RANGED_INTEGERP (int, val
))
2841 linger
.l_linger
= XINT (val
);
2843 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2844 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2845 &linger
, sizeof (linger
));
2856 int setsockopt_errno
= errno
;
2857 report_file_errno ("Cannot set network option", list2 (opt
, val
),
2861 return (1 << sopt
->optbit
);
2865 DEFUN ("set-network-process-option",
2866 Fset_network_process_option
, Sset_network_process_option
,
2868 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2869 See `make-network-process' for a list of options and values.
2870 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2871 OPTION is not a supported option, return nil instead; otherwise return t.
2873 If PROCESS is a non-blocking network process that hasn't been fully
2874 set up yet, this function will block until socket setup has completed. */)
2875 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2878 struct Lisp_Process
*p
;
2880 CHECK_PROCESS (process
);
2881 p
= XPROCESS (process
);
2882 if (!NETCONN1_P (p
))
2883 error ("Process is not a network process");
2885 wait_for_socket_fds (process
, "set-network-process-option");
2889 error ("Process is not running");
2891 if (set_socket_option (s
, option
, value
))
2893 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2897 if (NILP (no_error
))
2898 error ("Unknown or unsupported option");
2904 DEFUN ("serial-process-configure",
2905 Fserial_process_configure
,
2906 Sserial_process_configure
,
2908 doc
: /* Configure speed, bytesize, etc. of a serial process.
2910 Arguments are specified as keyword/argument pairs. Attributes that
2911 are not given are re-initialized from the process's current
2912 configuration (available via the function `process-contact') or set to
2913 reasonable default values. The following arguments are defined:
2919 -- Any of these arguments can be given to identify the process that is
2920 to be configured. If none of these arguments is given, the current
2921 buffer's process is used.
2923 :speed SPEED -- SPEED is the speed of the serial port in bits per
2924 second, also called baud rate. Any value can be given for SPEED, but
2925 most serial ports work only at a few defined values between 1200 and
2926 115200, with 9600 being the most common value. If SPEED is nil, the
2927 serial port is not configured any further, i.e., all other arguments
2928 are ignored. This may be useful for special serial ports such as
2929 Bluetooth-to-serial converters which can only be configured through AT
2930 commands. A value of nil for SPEED can be used only when passed
2931 through `make-serial-process' or `serial-term'.
2933 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2934 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2936 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2937 `odd' (use odd parity), or the symbol `even' (use even parity). If
2938 PARITY is not given, no parity is used.
2940 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2941 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2942 is not given or nil, 1 stopbit is used.
2944 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2945 flowcontrol to be used, which is either nil (don't use flowcontrol),
2946 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2947 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2948 flowcontrol is used.
2950 `serial-process-configure' is called by `make-serial-process' for the
2951 initial configuration of the serial port.
2955 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2957 \(serial-process-configure
2958 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2960 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2962 usage: (serial-process-configure &rest ARGS) */)
2963 (ptrdiff_t nargs
, Lisp_Object
*args
)
2965 struct Lisp_Process
*p
;
2966 Lisp_Object contact
= Qnil
;
2967 Lisp_Object proc
= Qnil
;
2969 contact
= Flist (nargs
, args
);
2971 proc
= Fplist_get (contact
, QCprocess
);
2973 proc
= Fplist_get (contact
, QCname
);
2975 proc
= Fplist_get (contact
, QCbuffer
);
2977 proc
= Fplist_get (contact
, QCport
);
2978 proc
= get_process (proc
);
2979 p
= XPROCESS (proc
);
2980 if (!EQ (p
->type
, Qserial
))
2981 error ("Not a serial process");
2983 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2986 serial_configure (p
, contact
);
2990 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2992 doc
: /* Create and return a serial port process.
2994 In Emacs, serial port connections are represented by process objects,
2995 so input and output work as for subprocesses, and `delete-process'
2996 closes a serial port connection. However, a serial process has no
2997 process id, it cannot be signaled, and the status codes are different
2998 from normal processes.
3000 `make-serial-process' creates a process and a buffer, on which you
3001 probably want to use `process-send-string'. Try \\[serial-term] for
3002 an interactive terminal. See below for examples.
3004 Arguments are specified as keyword/argument pairs. The following
3005 arguments are defined:
3007 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3008 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3009 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3010 the backslashes in strings).
3012 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3013 which this function calls.
3015 :name NAME -- NAME is the name of the process. If NAME is not given,
3016 the value of PORT is used.
3018 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3019 with the process. Process output goes at the end of that buffer,
3020 unless you specify an output stream or filter function to handle the
3021 output. If BUFFER is not given, the value of NAME is used.
3023 :coding CODING -- If CODING is a symbol, it specifies the coding
3024 system used for both reading and writing for this process. If CODING
3025 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3026 ENCODING is used for writing.
3028 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3029 the process is running. If BOOL is not given, query before exiting.
3031 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3032 In the stopped state, a serial process does not accept incoming data,
3033 but you can send outgoing data. The stopped state is cleared by
3034 `continue-process' and set by `stop-process'.
3036 :filter FILTER -- Install FILTER as the process filter.
3038 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3040 :plist PLIST -- Install PLIST as the initial plist of the process.
3046 -- This function calls `serial-process-configure' to handle these
3049 The original argument list, possibly modified by later configuration,
3050 is available via the function `process-contact'.
3054 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3056 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3058 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3060 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3062 usage: (make-serial-process &rest ARGS) */)
3063 (ptrdiff_t nargs
, Lisp_Object
*args
)
3066 Lisp_Object proc
, contact
, port
;
3067 struct Lisp_Process
*p
;
3068 Lisp_Object name
, buffer
;
3069 Lisp_Object tem
, val
;
3070 ptrdiff_t specpdl_count
;
3075 contact
= Flist (nargs
, args
);
3077 port
= Fplist_get (contact
, QCport
);
3079 error ("No port specified");
3080 CHECK_STRING (port
);
3082 if (NILP (Fplist_member (contact
, QCspeed
)))
3083 error (":speed not specified");
3084 if (!NILP (Fplist_get (contact
, QCspeed
)))
3085 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
3087 name
= Fplist_get (contact
, QCname
);
3090 CHECK_STRING (name
);
3091 proc
= make_process (name
);
3092 specpdl_count
= SPECPDL_INDEX ();
3093 record_unwind_protect (remove_process
, proc
);
3094 p
= XPROCESS (proc
);
3096 fd
= serial_open (port
);
3097 p
->open_fd
[SUBPROCESS_STDIN
] = fd
;
3102 chan_process
[fd
] = proc
;
3104 buffer
= Fplist_get (contact
, QCbuffer
);
3107 buffer
= Fget_buffer_create (buffer
);
3108 pset_buffer (p
, buffer
);
3110 pset_childp (p
, contact
);
3111 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3112 pset_type (p
, Qserial
);
3113 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
3114 pset_filter (p
, Fplist_get (contact
, QCfilter
));
3115 eassert (NILP (p
->log
));
3116 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3117 p
->kill_without_query
= 1;
3118 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
3119 pset_command (p
, Qt
);
3120 eassert (! p
->pty_flag
);
3122 if (!EQ (p
->command
, Qt
))
3123 add_process_read_fd (fd
);
3125 if (BUFFERP (buffer
))
3127 set_marker_both (p
->mark
, buffer
,
3128 BUF_ZV (XBUFFER (buffer
)),
3129 BUF_ZV_BYTE (XBUFFER (buffer
)));
3132 tem
= Fplist_member (contact
, QCcoding
);
3133 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3139 val
= XCAR (XCDR (tem
));
3143 else if (!NILP (Vcoding_system_for_read
))
3144 val
= Vcoding_system_for_read
;
3145 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3146 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3148 pset_decode_coding_system (p
, val
);
3153 val
= XCAR (XCDR (tem
));
3157 else if (!NILP (Vcoding_system_for_write
))
3158 val
= Vcoding_system_for_write
;
3159 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3160 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3162 pset_encode_coding_system (p
, val
);
3164 setup_process_coding_systems (proc
);
3165 pset_decoding_buf (p
, empty_unibyte_string
);
3166 eassert (p
->decoding_carryover
== 0);
3167 pset_encoding_buf (p
, empty_unibyte_string
);
3168 p
->inherit_coding_system_flag
3169 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3171 Fserial_process_configure (nargs
, args
);
3173 specpdl_ptr
= specpdl
+ specpdl_count
;
3179 set_network_socket_coding_system (Lisp_Object proc
, Lisp_Object host
,
3180 Lisp_Object service
, Lisp_Object name
)
3183 struct Lisp_Process
*p
= XPROCESS (proc
);
3184 Lisp_Object contact
= p
->childp
;
3185 Lisp_Object coding_systems
= Qt
;
3188 tem
= Fplist_member (contact
, QCcoding
);
3189 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3190 tem
= Qnil
; /* No error message (too late!). */
3192 /* Setup coding systems for communicating with the network stream. */
3193 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3197 val
= XCAR (XCDR (tem
));
3201 else if (!NILP (Vcoding_system_for_read
))
3202 val
= Vcoding_system_for_read
;
3203 else if ((!NILP (p
->buffer
)
3204 && NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
3205 || (NILP (p
->buffer
)
3206 && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3207 /* We dare not decode end-of-line format by setting VAL to
3208 Qraw_text, because the existing Emacs Lisp libraries
3209 assume that they receive bare code including a sequence of
3214 if (NILP (host
) || NILP (service
))
3215 coding_systems
= Qnil
;
3217 coding_systems
= CALLN (Ffind_operation_coding_system
,
3218 Qopen_network_stream
, name
, p
->buffer
,
3220 if (CONSP (coding_systems
))
3221 val
= XCAR (coding_systems
);
3222 else if (CONSP (Vdefault_process_coding_system
))
3223 val
= XCAR (Vdefault_process_coding_system
);
3227 pset_decode_coding_system (p
, val
);
3231 val
= XCAR (XCDR (tem
));
3235 else if (!NILP (Vcoding_system_for_write
))
3236 val
= Vcoding_system_for_write
;
3237 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3241 if (EQ (coding_systems
, Qt
))
3243 if (NILP (host
) || NILP (service
))
3244 coding_systems
= Qnil
;
3246 coding_systems
= CALLN (Ffind_operation_coding_system
,
3247 Qopen_network_stream
, name
, p
->buffer
,
3250 if (CONSP (coding_systems
))
3251 val
= XCDR (coding_systems
);
3252 else if (CONSP (Vdefault_process_coding_system
))
3253 val
= XCDR (Vdefault_process_coding_system
);
3257 pset_encode_coding_system (p
, val
);
3259 pset_decoding_buf (p
, empty_unibyte_string
);
3260 p
->decoding_carryover
= 0;
3261 pset_encoding_buf (p
, empty_unibyte_string
);
3263 p
->inherit_coding_system_flag
3264 = !(!NILP (tem
) || NILP (p
->buffer
) || !inherit_process_coding_system
);
3269 finish_after_tls_connection (Lisp_Object proc
)
3271 struct Lisp_Process
*p
= XPROCESS (proc
);
3272 Lisp_Object contact
= p
->childp
;
3273 Lisp_Object result
= Qt
;
3275 if (!NILP (Ffboundp (Qnsm_verify_connection
)))
3276 result
= call3 (Qnsm_verify_connection
,
3278 Fplist_get (contact
, QChost
),
3279 Fplist_get (contact
, QCservice
));
3283 pset_status (p
, list2 (Qfailed
,
3284 build_string ("The Network Security Manager stopped the connections")));
3285 deactivate_process (proc
);
3287 else if (p
->outfd
< 0)
3289 /* The counterparty may have closed the connection (especially
3290 if the NSM prompt above take a long time), so recheck the file
3292 pset_status (p
, Qfailed
);
3293 deactivate_process (proc
);
3295 else if ((fd_callback_info
[p
->outfd
].flags
& NON_BLOCKING_CONNECT_FD
) == 0)
3297 /* If we cleared the connection wait mask before we did the TLS
3298 setup, then we have to say that the process is finally "open"
3300 pset_status (p
, Qrun
);
3301 /* Execute the sentinel here. If we had relied on status_notify
3302 to do it later, it will read input from the process before
3303 calling the sentinel. */
3304 exec_sentinel (proc
, build_string ("open\n"));
3310 connect_network_socket (Lisp_Object proc
, Lisp_Object addrinfos
,
3311 Lisp_Object use_external_socket_p
)
3313 ptrdiff_t count
= SPECPDL_INDEX ();
3314 int s
= -1, outch
, inch
;
3317 struct sockaddr
*sa
= NULL
;
3320 struct Lisp_Process
*p
= XPROCESS (proc
);
3321 Lisp_Object contact
= p
->childp
;
3323 int socket_to_use
= -1;
3325 if (!NILP (use_external_socket_p
))
3327 socket_to_use
= external_sock_fd
;
3329 /* Ensure we don't consume the external socket twice. */
3330 external_sock_fd
= -1;
3333 /* Do this in case we never enter the while-loop below. */
3336 while (!NILP (addrinfos
))
3338 Lisp_Object addrinfo
= XCAR (addrinfos
);
3339 addrinfos
= XCDR (addrinfos
);
3340 int protocol
= XINT (XCAR (addrinfo
));
3341 Lisp_Object ip_address
= XCDR (addrinfo
);
3347 addrlen
= get_lisp_to_sockaddr_size (ip_address
, &family
);
3350 sa
= xmalloc (addrlen
);
3351 conv_lisp_to_sockaddr (family
, ip_address
, sa
, addrlen
);
3356 int socktype
= p
->socktype
| SOCK_CLOEXEC
;
3357 if (p
->is_non_blocking_client
)
3358 socktype
|= SOCK_NONBLOCK
;
3359 s
= socket (family
, socktype
, protocol
);
3367 if (p
->is_non_blocking_client
&& ! (SOCK_NONBLOCK
&& socket_to_use
< 0))
3369 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3375 if (0 <= socket_to_use
)
3381 #ifdef DATAGRAM_SOCKETS
3382 if (!p
->is_server
&& p
->socktype
== SOCK_DGRAM
)
3384 #endif /* DATAGRAM_SOCKETS */
3386 /* Make us close S if quit. */
3387 record_unwind_protect_int (close_file_unwind
, s
);
3389 /* Parse network options in the arg list. We simply ignore anything
3390 which isn't a known option (including other keywords). An error
3391 is signaled if setting a known option fails. */
3393 Lisp_Object params
= contact
, key
, val
;
3395 while (!NILP (params
))
3397 key
= XCAR (params
);
3398 params
= XCDR (params
);
3399 val
= XCAR (params
);
3400 params
= XCDR (params
);
3401 optbits
|= set_socket_option (s
, key
, val
);
3407 /* Configure as a server socket. */
3409 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3410 explicit :reuseaddr key to override this. */
3411 #ifdef HAVE_LOCAL_SOCKETS
3412 if (family
!= AF_LOCAL
)
3414 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3417 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3418 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3421 /* If passed a socket descriptor, it should be already bound. */
3422 if (socket_to_use
< 0 && bind (s
, sa
, addrlen
) != 0)
3423 report_file_error ("Cannot bind server socket", Qnil
);
3425 #ifdef HAVE_GETSOCKNAME
3427 #ifdef HAVE_LOCAL_SOCKETS
3428 && family
!= AF_LOCAL
3432 struct sockaddr_in sa1
;
3433 socklen_t len1
= sizeof (sa1
);
3435 /* The code below assumes the port is at the same offset
3436 and of the same width in both IPv4 and IPv6
3437 structures, but the standards don't guarantee that,
3438 so verify it here. */
3439 struct sockaddr_in6 sa6
;
3440 verify ((offsetof (struct sockaddr_in
, sin_port
)
3441 == offsetof (struct sockaddr_in6
, sin6_port
))
3442 && sizeof (sa1
.sin_port
) == sizeof (sa6
.sin6_port
));
3444 DECLARE_POINTER_ALIAS (psa1
, struct sockaddr
, &sa1
);
3445 if (getsockname (s
, psa1
, &len1
) == 0)
3447 Lisp_Object service
= make_number (ntohs (sa1
.sin_port
));
3448 contact
= Fplist_put (contact
, QCservice
, service
);
3449 /* Save the port number so that we can stash it in
3450 the process object later. */
3451 DECLARE_POINTER_ALIAS (psa
, struct sockaddr_in
, sa
);
3452 psa
->sin_port
= sa1
.sin_port
;
3457 if (p
->socktype
!= SOCK_DGRAM
&& listen (s
, p
->backlog
))
3458 report_file_error ("Cannot listen on server socket", Qnil
);
3465 ret
= connect (s
, sa
, addrlen
);
3468 if (ret
== 0 || xerrno
== EISCONN
)
3470 /* The unwind-protect will be discarded afterwards. */
3474 if (p
->is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3478 if (xerrno
== EINTR
)
3480 /* Unlike most other syscalls connect() cannot be called
3481 again. (That would return EALREADY.) The proper way to
3482 wait for completion is pselect(). */
3490 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3496 report_file_error ("Failed select", Qnil
);
3500 len
= sizeof xerrno
;
3501 eassert (FD_ISSET (s
, &fdset
));
3502 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) < 0)
3503 report_file_error ("Failed getsockopt", Qnil
);
3506 if (NILP (addrinfos
))
3507 report_file_errno ("Failed connect", Qnil
, xerrno
);
3509 #endif /* !WINDOWSNT */
3511 /* Discard the unwind protect closing S. */
3512 specpdl_ptr
= specpdl
+ count
;
3515 if (0 <= socket_to_use
)
3519 if (xerrno
== EINTR
)
3526 #ifdef DATAGRAM_SOCKETS
3527 if (p
->socktype
== SOCK_DGRAM
)
3529 if (datagram_address
[s
].sa
)
3532 datagram_address
[s
].sa
= xmalloc (addrlen
);
3533 datagram_address
[s
].len
= addrlen
;
3537 memset (datagram_address
[s
].sa
, 0, addrlen
);
3538 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3541 ptrdiff_t rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3542 if (rlen
!= 0 && rfamily
== family
3544 conv_lisp_to_sockaddr (rfamily
, remote
,
3545 datagram_address
[s
].sa
, rlen
);
3549 memcpy (datagram_address
[s
].sa
, sa
, addrlen
);
3553 contact
= Fplist_put (contact
, p
->is_server
? QClocal
: QCremote
,
3554 conv_sockaddr_to_lisp (sa
, addrlen
));
3555 #ifdef HAVE_GETSOCKNAME
3558 struct sockaddr_storage sa1
;
3559 socklen_t len1
= sizeof (sa1
);
3560 DECLARE_POINTER_ALIAS (psa1
, struct sockaddr
, &sa1
);
3561 if (getsockname (s
, psa1
, &len1
) == 0)
3562 contact
= Fplist_put (contact
, QClocal
,
3563 conv_sockaddr_to_lisp (psa1
, len1
));
3570 /* If non-blocking got this far - and failed - assume non-blocking is
3571 not supported after all. This is probably a wrong assumption, but
3572 the normal blocking calls to open-network-stream handles this error
3574 if (p
->is_non_blocking_client
)
3577 report_file_errno ((p
->is_server
3578 ? "make server process failed"
3579 : "make client process failed"),
3586 chan_process
[inch
] = proc
;
3588 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3590 p
= XPROCESS (proc
);
3591 p
->open_fd
[SUBPROCESS_STDIN
] = inch
;
3595 /* Discard the unwind protect for closing S, if any. */
3596 specpdl_ptr
= specpdl
+ count
;
3598 if (p
->is_server
&& p
->socktype
!= SOCK_DGRAM
)
3599 pset_status (p
, Qlisten
);
3601 /* Make the process marker point into the process buffer (if any). */
3602 if (BUFFERP (p
->buffer
))
3603 set_marker_both (p
->mark
, p
->buffer
,
3604 BUF_ZV (XBUFFER (p
->buffer
)),
3605 BUF_ZV_BYTE (XBUFFER (p
->buffer
)));
3607 if (p
->is_non_blocking_client
)
3609 /* We may get here if connect did succeed immediately. However,
3610 in that case, we still need to signal this like a non-blocking
3612 if (! (connecting_status (p
->status
)
3613 && EQ (XCDR (p
->status
), addrinfos
)))
3614 pset_status (p
, Fcons (Qconnect
, addrinfos
));
3615 if ((fd_callback_info
[inch
].flags
& NON_BLOCKING_CONNECT_FD
) == 0)
3616 add_non_blocking_write_fd (inch
);
3619 /* A server may have a client filter setting of Qt, but it must
3620 still listen for incoming connects unless it is stopped. */
3621 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3622 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3623 add_process_read_fd (inch
);
3625 if (inch
> max_desc
)
3628 /* Set up the masks based on the process filter. */
3629 set_process_filter_masks (p
);
3631 setup_process_coding_systems (proc
);
3634 /* Continue the asynchronous connection. */
3635 if (!NILP (p
->gnutls_boot_parameters
))
3637 Lisp_Object boot
, params
= p
->gnutls_boot_parameters
;
3639 boot
= Fgnutls_boot (proc
, XCAR (params
), XCDR (params
));
3640 p
->gnutls_boot_parameters
= Qnil
;
3642 if (p
->gnutls_initstage
== GNUTLS_STAGE_READY
)
3643 /* Run sentinels, etc. */
3644 finish_after_tls_connection (proc
);
3645 else if (p
->gnutls_initstage
!= GNUTLS_STAGE_HANDSHAKE_TRIED
)
3647 deactivate_process (proc
);
3649 pset_status (p
, list2 (Qfailed
,
3650 build_string ("TLS negotiation failed")));
3652 pset_status (p
, list2 (Qfailed
, boot
));
3659 /* Create a network stream/datagram client/server process. Treated
3660 exactly like a normal process when reading and writing. Primary
3661 differences are in status display and process deletion. A network
3662 connection has no PID; you cannot signal it. All you can do is
3663 stop/continue it and deactivate/close it via delete-process. */
3665 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
3667 doc
: /* Create and return a network server or client process.
3669 In Emacs, network connections are represented by process objects, so
3670 input and output work as for subprocesses and `delete-process' closes
3671 a network connection. However, a network process has no process id,
3672 it cannot be signaled, and the status codes are different from normal
3675 Arguments are specified as keyword/argument pairs. The following
3676 arguments are defined:
3678 :name NAME -- NAME is name for process. It is modified if necessary
3681 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3682 with the process. Process output goes at end of that buffer, unless
3683 you specify an output stream or filter function to handle the output.
3684 BUFFER may be also nil, meaning that this process is not associated
3687 :host HOST -- HOST is name of the host to connect to, or its IP
3688 address. The symbol `local' specifies the local host. If specified
3689 for a server process, it must be a valid name or address for the local
3690 host, and only clients connecting to that address will be accepted.
3692 :service SERVICE -- SERVICE is name of the service desired, or an
3693 integer specifying a port number to connect to. If SERVICE is t,
3694 a random port number is selected for the server. A port number can
3695 be specified as an integer string, e.g., "80", as well as an integer.
3697 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3698 stream type connection, `datagram' creates a datagram type connection,
3699 `seqpacket' creates a reliable datagram connection.
3701 :family FAMILY -- FAMILY is the address (and protocol) family for the
3702 service specified by HOST and SERVICE. The default (nil) is to use
3703 whatever address family (IPv4 or IPv6) that is defined for the host
3704 and port number specified by HOST and SERVICE. Other address families
3706 local -- for a local (i.e. UNIX) address specified by SERVICE.
3707 ipv4 -- use IPv4 address family only.
3708 ipv6 -- use IPv6 address family only.
3710 :local ADDRESS -- ADDRESS is the local address used for the connection.
3711 This parameter is ignored when opening a client process. When specified
3712 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3714 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3715 connection. This parameter is ignored when opening a stream server
3716 process. For a datagram server process, it specifies the initial
3717 setting of the remote datagram address. When specified for a client
3718 process, the FAMILY, HOST, and SERVICE args are ignored.
3720 The format of ADDRESS depends on the address family:
3721 - An IPv4 address is represented as an vector of integers [A B C D P]
3722 corresponding to numeric IP address A.B.C.D and port number P.
3723 - A local address is represented as a string with the address in the
3724 local address space.
3725 - An "unsupported family" address is represented by a cons (F . AV)
3726 where F is the family number and AV is a vector containing the socket
3727 address data with one element per address data byte. Do not rely on
3728 this format in portable code, as it may depend on implementation
3729 defined constants, data sizes, and data structure alignment.
3731 :coding CODING -- If CODING is a symbol, it specifies the coding
3732 system used for both reading and writing for this process. If CODING
3733 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3734 ENCODING is used for writing.
3736 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3737 process, return without waiting for the connection to complete;
3738 instead, the sentinel function will be called with second arg matching
3739 "open" (if successful) or "failed" when the connect completes.
3740 Default is to use a blocking connect (i.e. wait) for stream type
3743 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3744 running when Emacs is exited.
3746 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3747 In the stopped state, a server process does not accept new
3748 connections, and a client process does not handle incoming traffic.
3749 The stopped state is cleared by `continue-process' and set by
3752 :filter FILTER -- Install FILTER as the process filter.
3754 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3755 process filter are multibyte, otherwise they are unibyte.
3756 If this keyword is not specified, the strings are multibyte if
3757 the default value of `enable-multibyte-characters' is non-nil.
3759 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3761 :log LOG -- Install LOG as the server process log function. This
3762 function is called when the server accepts a network connection from a
3763 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3764 is the server process, CLIENT is the new process for the connection,
3765 and MESSAGE is a string.
3767 :plist PLIST -- Install PLIST as the new process's initial plist.
3769 :tls-parameters LIST -- is a list that should be supplied if you're
3770 opening a TLS connection. The first element is the TLS type (either
3771 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3772 be a keyword list accepted by gnutls-boot (as returned by
3773 `gnutls-boot-parameters').
3775 :server QLEN -- if QLEN is non-nil, create a server process for the
3776 specified FAMILY, SERVICE, and connection type (stream or datagram).
3777 If QLEN is an integer, it is used as the max. length of the server's
3778 pending connection queue (also known as the backlog); the default
3779 queue length is 5. Default is to create a client process.
3781 The following network options can be specified for this connection:
3783 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3784 :dontroute BOOL -- Only send to directly connected hosts.
3785 :keepalive BOOL -- Send keep-alive messages on network stream.
3786 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3787 :oobinline BOOL -- Place out-of-band data in receive data stream.
3788 :priority INT -- Set protocol defined priority for sent packets.
3789 :reuseaddr BOOL -- Allow reusing a recently used local address
3790 (this is allowed by default for a server process).
3791 :bindtodevice NAME -- bind to interface NAME. Using this may require
3792 special privileges on some systems.
3793 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3794 been passed to Emacs. If Emacs wasn't
3795 passed a socket, this option is silently
3799 Consult the relevant system programmer's manual pages for more
3800 information on using these options.
3803 A server process will listen for and accept connections from clients.
3804 When a client connection is accepted, a new network process is created
3805 for the connection with the following parameters:
3807 - The client's process name is constructed by concatenating the server
3808 process's NAME and a client identification string.
3809 - If the FILTER argument is non-nil, the client process will not get a
3810 separate process buffer; otherwise, the client's process buffer is a newly
3811 created buffer named after the server process's BUFFER name or process
3812 NAME concatenated with the client identification string.
3813 - The connection type and the process filter and sentinel parameters are
3814 inherited from the server process's TYPE, FILTER and SENTINEL.
3815 - The client process's contact info is set according to the client's
3816 addressing information (typically an IP address and a port number).
3817 - The client process's plist is initialized from the server's plist.
3819 Notice that the FILTER and SENTINEL args are never used directly by
3820 the server process. Also, the BUFFER argument is not used directly by
3821 the server process, but via the optional :log function, accepted (and
3822 failed) connections may be logged in the server process's buffer.
3824 The original argument list, modified with the actual connection
3825 information, is available via the `process-contact' function.
3827 usage: (make-network-process &rest ARGS) */)
3828 (ptrdiff_t nargs
, Lisp_Object
*args
)
3831 Lisp_Object contact
;
3832 struct Lisp_Process
*p
;
3833 const char *portstring
;
3834 ptrdiff_t portstringlen ATTRIBUTE_UNUSED
;
3835 char portbuf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
3836 #ifdef HAVE_LOCAL_SOCKETS
3837 struct sockaddr_un address_un
;
3841 Lisp_Object name
, buffer
, host
, service
, address
;
3842 Lisp_Object filter
, sentinel
, use_external_socket_p
;
3843 Lisp_Object addrinfos
= Qnil
;
3846 enum { any_protocol
= 0 };
3847 #ifdef HAVE_GETADDRINFO_A
3848 struct gaicb
*dns_request
= NULL
;
3850 ptrdiff_t count
= SPECPDL_INDEX ();
3855 /* Save arguments for process-contact and clone-process. */
3856 contact
= Flist (nargs
, args
);
3859 /* Ensure socket support is loaded if available. */
3860 init_winsock (TRUE
);
3863 /* :type TYPE (nil: stream, datagram */
3864 tem
= Fplist_get (contact
, QCtype
);
3866 socktype
= SOCK_STREAM
;
3867 #ifdef DATAGRAM_SOCKETS
3868 else if (EQ (tem
, Qdatagram
))
3869 socktype
= SOCK_DGRAM
;
3871 #ifdef HAVE_SEQPACKET
3872 else if (EQ (tem
, Qseqpacket
))
3873 socktype
= SOCK_SEQPACKET
;
3876 error ("Unsupported connection type");
3878 name
= Fplist_get (contact
, QCname
);
3879 buffer
= Fplist_get (contact
, QCbuffer
);
3880 filter
= Fplist_get (contact
, QCfilter
);
3881 sentinel
= Fplist_get (contact
, QCsentinel
);
3882 use_external_socket_p
= Fplist_get (contact
, QCuse_external_socket
);
3884 CHECK_STRING (name
);
3886 /* :local ADDRESS or :remote ADDRESS */
3887 tem
= Fplist_get (contact
, QCserver
);
3889 address
= Fplist_get (contact
, QCremote
);
3891 address
= Fplist_get (contact
, QClocal
);
3892 if (!NILP (address
))
3894 host
= service
= Qnil
;
3896 if (!get_lisp_to_sockaddr_size (address
, &family
))
3897 error ("Malformed :address");
3899 addrinfos
= list1 (Fcons (make_number (any_protocol
), address
));
3903 /* :family FAMILY -- nil (for Inet), local, or integer. */
3904 tem
= Fplist_get (contact
, QCfamily
);
3913 #ifdef HAVE_LOCAL_SOCKETS
3914 else if (EQ (tem
, Qlocal
))
3918 else if (EQ (tem
, Qipv6
))
3921 else if (EQ (tem
, Qipv4
))
3923 else if (TYPE_RANGED_INTEGERP (int, tem
))
3924 family
= XINT (tem
);
3926 error ("Unknown address family");
3928 /* :service SERVICE -- string, integer (port number), or t (random port). */
3929 service
= Fplist_get (contact
, QCservice
);
3931 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3932 host
= Fplist_get (contact
, QChost
);
3935 /* The "connection" function gets it bind info from the address we're
3936 given, so use this dummy address if nothing is specified. */
3937 #ifdef HAVE_LOCAL_SOCKETS
3938 if (family
!= AF_LOCAL
)
3940 host
= build_string ("127.0.0.1");
3944 if (EQ (host
, Qlocal
))
3945 /* Depending on setup, "localhost" may map to different IPv4 and/or
3946 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3947 host
= build_string ("127.0.0.1");
3948 CHECK_STRING (host
);
3951 #ifdef HAVE_LOCAL_SOCKETS
3952 if (family
== AF_LOCAL
)
3956 message (":family local ignores the :host property");
3957 contact
= Fplist_put (contact
, QChost
, Qnil
);
3960 CHECK_STRING (service
);
3961 if (sizeof address_un
.sun_path
<= SBYTES (service
))
3962 error ("Service name too long");
3963 addrinfos
= list1 (Fcons (make_number (any_protocol
), service
));
3968 /* Slow down polling to every ten seconds.
3969 Some kernels have a bug which causes retrying connect to fail
3970 after a connect. Polling can interfere with gethostbyname too. */
3971 #ifdef POLL_FOR_INPUT
3972 if (socktype
!= SOCK_DGRAM
)
3974 record_unwind_protect_void (run_all_atimers
);
3975 bind_polling_period (10);
3981 /* SERVICE can either be a string or int.
3982 Convert to a C string for later use by getaddrinfo. */
3983 if (EQ (service
, Qt
))
3988 else if (INTEGERP (service
))
3990 portstring
= portbuf
;
3991 portstringlen
= sprintf (portbuf
, "%"pI
"d", XINT (service
));
3995 CHECK_STRING (service
);
3996 portstring
= SSDATA (service
);
3997 portstringlen
= SBYTES (service
);
4001 #ifdef HAVE_GETADDRINFO_A
4002 if (!NILP (host
) && !NILP (Fplist_get (contact
, QCnowait
)))
4004 ptrdiff_t hostlen
= SBYTES (host
);
4008 struct addrinfo hints
;
4009 char str
[FLEXIBLE_ARRAY_MEMBER
];
4010 } *req
= xmalloc (FLEXSIZEOF (struct req
, str
,
4011 hostlen
+ 1 + portstringlen
+ 1));
4012 dns_request
= &req
->gaicb
;
4013 dns_request
->ar_name
= req
->str
;
4014 dns_request
->ar_service
= req
->str
+ hostlen
+ 1;
4015 dns_request
->ar_request
= &req
->hints
;
4016 dns_request
->ar_result
= NULL
;
4017 memset (&req
->hints
, 0, sizeof req
->hints
);
4018 req
->hints
.ai_family
= family
;
4019 req
->hints
.ai_socktype
= socktype
;
4020 strcpy (req
->str
, SSDATA (host
));
4021 strcpy (req
->str
+ hostlen
+ 1, portstring
);
4023 int ret
= getaddrinfo_a (GAI_NOWAIT
, &dns_request
, 1, NULL
);
4025 error ("%s/%s getaddrinfo_a error %d", SSDATA (host
), portstring
, ret
);
4029 #endif /* HAVE_GETADDRINFO_A */
4031 /* If we have a host, use getaddrinfo to resolve both host and service.
4032 Otherwise, use getservbyname to lookup the service. */
4036 struct addrinfo
*res
, *lres
;
4041 struct addrinfo hints
;
4042 memset (&hints
, 0, sizeof hints
);
4043 hints
.ai_family
= family
;
4044 hints
.ai_socktype
= socktype
;
4046 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
4048 #ifdef HAVE_GAI_STRERROR
4050 synchronize_system_messages_locale ();
4051 char const *str
= gai_strerror (ret
);
4052 if (! NILP (Vlocale_coding_system
))
4053 str
= SSDATA (code_convert_string_norecord
4054 (build_string (str
), Vlocale_coding_system
, 0));
4055 error ("%s/%s %s", SSDATA (host
), portstring
, str
);
4058 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
4061 for (lres
= res
; lres
; lres
= lres
->ai_next
)
4062 addrinfos
= Fcons (conv_addrinfo_to_lisp (lres
), addrinfos
);
4064 addrinfos
= Fnreverse (addrinfos
);
4071 /* No hostname has been specified (e.g., a local server process). */
4073 if (EQ (service
, Qt
))
4075 else if (INTEGERP (service
))
4076 port
= XINT (service
);
4079 CHECK_STRING (service
);
4082 if (SBYTES (service
) != 0)
4084 /* Allow the service to be a string containing the port number,
4085 because that's allowed if you have getaddrbyname. */
4087 long int lport
= strtol (SSDATA (service
), &service_end
, 10);
4088 if (service_end
== SSDATA (service
) + SBYTES (service
))
4092 struct servent
*svc_info
4093 = getservbyname (SSDATA (service
),
4094 socktype
== SOCK_DGRAM
? "udp" : "tcp");
4096 port
= ntohs (svc_info
->s_port
);
4101 if (! (0 <= port
&& port
< 1 << 16))
4103 AUTO_STRING (unknown_service
, "Unknown service: %s");
4104 xsignal1 (Qerror
, CALLN (Fformat
, unknown_service
, service
));
4110 buffer
= Fget_buffer_create (buffer
);
4112 /* Unwind bind_polling_period. */
4113 unbind_to (count
, Qnil
);
4115 proc
= make_process (name
);
4116 record_unwind_protect (remove_process
, proc
);
4117 p
= XPROCESS (proc
);
4118 pset_childp (p
, contact
);
4119 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
4120 pset_type (p
, Qnetwork
);
4122 pset_buffer (p
, buffer
);
4123 pset_sentinel (p
, sentinel
);
4124 pset_filter (p
, filter
);
4125 pset_log (p
, Fplist_get (contact
, QClog
));
4126 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
4127 p
->kill_without_query
= 1;
4128 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
4129 pset_command (p
, Qt
);
4130 eassert (p
->pid
== 0);
4132 eassert (! p
->is_non_blocking_client
);
4133 eassert (! p
->is_server
);
4135 p
->socktype
= socktype
;
4136 #ifdef HAVE_GETADDRINFO_A
4137 eassert (! p
->dns_request
);
4140 tem
= Fplist_get (contact
, QCtls_parameters
);
4142 p
->gnutls_boot_parameters
= tem
;
4145 set_network_socket_coding_system (proc
, host
, service
, name
);
4148 tem
= Fplist_get (contact
, QCserver
);
4151 /* Don't support network sockets when non-blocking mode is
4152 not available, since a blocked Emacs is not useful. */
4153 p
->is_server
= true;
4154 if (TYPE_RANGED_INTEGERP (int, tem
))
4155 p
->backlog
= XINT (tem
);
4159 if (!p
->is_server
&& socktype
!= SOCK_DGRAM
4160 && !NILP (Fplist_get (contact
, QCnowait
)))
4161 p
->is_non_blocking_client
= true;
4163 bool postpone_connection
= false;
4164 #ifdef HAVE_GETADDRINFO_A
4165 /* With async address resolution, the list of addresses is empty, so
4166 postpone connecting to the server. */
4167 if (!p
->is_server
&& NILP (addrinfos
))
4169 p
->dns_request
= dns_request
;
4170 p
->status
= list1 (Qconnect
);
4171 postpone_connection
= true;
4174 if (! postpone_connection
)
4175 connect_network_socket (proc
, addrinfos
, use_external_socket_p
);
4177 specpdl_ptr
= specpdl
+ count
;
4182 #ifdef HAVE_NET_IF_H
4186 network_interface_list (void)
4188 struct ifconf ifconf
;
4189 struct ifreq
*ifreq
;
4191 ptrdiff_t buf_size
= 512;
4196 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
4199 count
= SPECPDL_INDEX ();
4200 record_unwind_protect_int (close_file_unwind
, s
);
4204 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
4205 ifconf
.ifc_buf
= buf
;
4206 ifconf
.ifc_len
= buf_size
;
4207 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
4214 while (ifconf
.ifc_len
== buf_size
);
4216 res
= unbind_to (count
, Qnil
);
4217 ifreq
= ifconf
.ifc_req
;
4218 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
4220 struct ifreq
*ifq
= ifreq
;
4221 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4222 #define SIZEOF_IFREQ(sif) \
4223 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4224 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4226 int len
= SIZEOF_IFREQ (ifq
);
4228 int len
= sizeof (*ifreq
);
4230 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
4231 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
4233 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
4236 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
4237 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
4238 res
= Fcons (Fcons (build_string (namebuf
),
4239 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
4240 sizeof (struct sockaddr
))),
4247 #endif /* SIOCGIFCONF */
4249 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4253 const char *flag_sym
;
4256 static const struct ifflag_def ifflag_table
[] = {
4260 #ifdef IFF_BROADCAST
4261 { IFF_BROADCAST
, "broadcast" },
4264 { IFF_DEBUG
, "debug" },
4267 { IFF_LOOPBACK
, "loopback" },
4269 #ifdef IFF_POINTOPOINT
4270 { IFF_POINTOPOINT
, "pointopoint" },
4273 { IFF_RUNNING
, "running" },
4276 { IFF_NOARP
, "noarp" },
4279 { IFF_PROMISC
, "promisc" },
4281 #ifdef IFF_NOTRAILERS
4282 #ifdef NS_IMPL_COCOA
4283 /* Really means smart, notrailers is obsolete. */
4284 { IFF_NOTRAILERS
, "smart" },
4286 { IFF_NOTRAILERS
, "notrailers" },
4290 { IFF_ALLMULTI
, "allmulti" },
4293 { IFF_MASTER
, "master" },
4296 { IFF_SLAVE
, "slave" },
4298 #ifdef IFF_MULTICAST
4299 { IFF_MULTICAST
, "multicast" },
4302 { IFF_PORTSEL
, "portsel" },
4304 #ifdef IFF_AUTOMEDIA
4305 { IFF_AUTOMEDIA
, "automedia" },
4308 { IFF_DYNAMIC
, "dynamic" },
4311 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress. */
4314 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4317 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit. */
4320 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit. */
4323 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit. */
4329 network_interface_info (Lisp_Object ifname
)
4332 Lisp_Object res
= Qnil
;
4337 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4338 && defined HAVE_GETIFADDRS && defined LLADDR)
4339 struct ifaddrs
*ifap
;
4342 CHECK_STRING (ifname
);
4344 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
4345 error ("interface name too long");
4346 lispstpcpy (rq
.ifr_name
, ifname
);
4348 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
4351 count
= SPECPDL_INDEX ();
4352 record_unwind_protect_int (close_file_unwind
, s
);
4355 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4356 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
4358 int flags
= rq
.ifr_flags
;
4359 const struct ifflag_def
*fp
;
4362 /* If flags is smaller than int (i.e. short) it may have the high bit set
4363 due to IFF_MULTICAST. In that case, sign extending it into
4365 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
4366 flags
= (unsigned short) rq
.ifr_flags
;
4369 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
4371 if (flags
& fp
->flag_bit
)
4373 elt
= Fcons (intern (fp
->flag_sym
), elt
);
4374 flags
-= fp
->flag_bit
;
4377 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
4381 elt
= Fcons (make_number (fnum
), elt
);
4386 res
= Fcons (elt
, res
);
4389 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4390 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4392 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4393 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4397 for (n
= 0; n
< 6; n
++)
4398 p
->contents
[n
] = make_number (((unsigned char *)
4399 &rq
.ifr_hwaddr
.sa_data
[0])
4401 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4403 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4404 if (getifaddrs (&ifap
) != -1)
4406 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4407 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4410 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
4412 DECLARE_POINTER_ALIAS (sdl
, struct sockaddr_dl
, it
->ifa_addr
);
4413 unsigned char linkaddr
[6];
4416 if (it
->ifa_addr
->sa_family
!= AF_LINK
4417 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
4418 || sdl
->sdl_alen
!= 6)
4421 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
4422 for (n
= 0; n
< 6; n
++)
4423 p
->contents
[n
] = make_number (linkaddr
[n
]);
4425 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
4429 #ifdef HAVE_FREEIFADDRS
4433 #endif /* HAVE_GETIFADDRS && LLADDR */
4435 res
= Fcons (elt
, res
);
4438 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4439 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4442 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4443 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4445 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4449 res
= Fcons (elt
, res
);
4452 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4453 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4456 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4459 res
= Fcons (elt
, res
);
4462 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4463 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4466 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4469 res
= Fcons (elt
, res
);
4471 return unbind_to (count
, any
? res
: Qnil
);
4473 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4474 #endif /* defined (HAVE_NET_IF_H) */
4476 DEFUN ("network-interface-list", Fnetwork_interface_list
,
4477 Snetwork_interface_list
, 0, 0, 0,
4478 doc
: /* Return an alist of all network interfaces and their network address.
4479 Each element is a cons, the car of which is a string containing the
4480 interface name, and the cdr is the network address in internal
4481 format; see the description of ADDRESS in `make-network-process'.
4483 If the information is not available, return nil. */)
4486 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4487 return network_interface_list ();
4493 DEFUN ("network-interface-info", Fnetwork_interface_info
,
4494 Snetwork_interface_info
, 1, 1, 0,
4495 doc
: /* Return information about network interface named IFNAME.
4496 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4497 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4498 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4499 FLAGS is the current flags of the interface.
4501 Data that is unavailable is returned as nil. */)
4502 (Lisp_Object ifname
)
4504 #if ((defined HAVE_NET_IF_H \
4505 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4506 || defined SIOCGIFFLAGS)) \
4507 || defined WINDOWSNT)
4508 return network_interface_info (ifname
);
4514 /* Turn off input and output for process PROC. */
4517 deactivate_process (Lisp_Object proc
)
4520 struct Lisp_Process
*p
= XPROCESS (proc
);
4524 /* Delete GnuTLS structures in PROC, if any. */
4525 emacs_gnutls_deinit (proc
);
4526 #endif /* HAVE_GNUTLS */
4528 if (p
->read_output_delay
> 0)
4530 if (--process_output_delay_count
< 0)
4531 process_output_delay_count
= 0;
4532 p
->read_output_delay
= 0;
4533 p
->read_output_skip
= 0;
4536 /* Beware SIGCHLD hereabouts. */
4538 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
4539 close_process_fd (&p
->open_fd
[i
]);
4541 inchannel
= p
->infd
;
4546 #ifdef DATAGRAM_SOCKETS
4547 if (DATAGRAM_CHAN_P (inchannel
))
4549 xfree (datagram_address
[inchannel
].sa
);
4550 datagram_address
[inchannel
].sa
= 0;
4551 datagram_address
[inchannel
].len
= 0;
4554 chan_process
[inchannel
] = Qnil
;
4555 delete_read_fd (inchannel
);
4556 if ((fd_callback_info
[inchannel
].flags
& NON_BLOCKING_CONNECT_FD
) != 0)
4557 delete_write_fd (inchannel
);
4558 if (inchannel
== max_desc
)
4559 recompute_max_desc ();
4564 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4566 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4567 It is given to their filter functions.
4568 Optional argument PROCESS means do not return until output has been
4569 received from PROCESS.
4571 Optional second argument SECONDS and third argument MILLISEC
4572 specify a timeout; return after that much time even if there is
4573 no subprocess output. If SECONDS is a floating point number,
4574 it specifies a fractional number of seconds to wait.
4575 The MILLISEC argument is obsolete and should be avoided.
4577 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4578 from PROCESS only, suspending reading output from other processes.
4579 If JUST-THIS-ONE is an integer, don't run any timers either.
4580 Return non-nil if we received any output from PROCESS (or, if PROCESS
4581 is nil, from any process) before the timeout expired. */)
4582 (Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
,
4583 Lisp_Object just_this_one
)
4588 if (! NILP (process
))
4590 CHECK_PROCESS (process
);
4591 struct Lisp_Process
*proc
= XPROCESS (process
);
4593 /* Can't wait for a process that is dedicated to a different
4595 if (!EQ (proc
->thread
, Qnil
) && !EQ (proc
->thread
, Fcurrent_thread ()))
4597 Lisp_Object proc_thread_name
= XTHREAD (proc
->thread
)->name
;
4599 if (STRINGP (proc_thread_name
))
4600 error ("Attempt to accept output from process %s locked to thread %s",
4601 SDATA (proc
->name
), SDATA (proc_thread_name
));
4603 error ("Attempt to accept output from process %s locked to thread %p",
4604 SDATA (proc
->name
), XTHREAD (proc
->thread
));
4608 just_this_one
= Qnil
;
4610 if (!NILP (millisec
))
4611 { /* Obsolete calling convention using integers rather than floats. */
4612 CHECK_NUMBER (millisec
);
4614 seconds
= make_float (XINT (millisec
) / 1000.0);
4617 CHECK_NUMBER (seconds
);
4618 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4625 if (!NILP (seconds
))
4627 if (INTEGERP (seconds
))
4629 if (XINT (seconds
) > 0)
4631 secs
= XINT (seconds
);
4635 else if (FLOATP (seconds
))
4637 if (XFLOAT_DATA (seconds
) > 0)
4639 struct timespec t
= dtotimespec (XFLOAT_DATA (seconds
));
4640 secs
= min (t
.tv_sec
, WAIT_READING_MAX
);
4645 wrong_type_argument (Qnumberp
, seconds
);
4647 else if (! NILP (process
))
4651 ((wait_reading_process_output (secs
, nsecs
, 0, 0,
4653 !NILP (process
) ? XPROCESS (process
) : NULL
,
4654 (NILP (just_this_one
) ? 0
4655 : !INTEGERP (just_this_one
) ? 1 : -1))
4660 /* Accept a connection for server process SERVER on CHANNEL. */
4662 static EMACS_INT connect_counter
= 0;
4665 server_accept_connection (Lisp_Object server
, int channel
)
4668 Lisp_Object contact
, host
, service
;
4669 struct Lisp_Process
*ps
= XPROCESS (server
);
4670 struct Lisp_Process
*p
;
4674 struct sockaddr_in in
;
4676 struct sockaddr_in6 in6
;
4678 #ifdef HAVE_LOCAL_SOCKETS
4679 struct sockaddr_un un
;
4682 socklen_t len
= sizeof saddr
;
4685 s
= accept4 (channel
, &saddr
.sa
, &len
, SOCK_CLOEXEC
);
4690 if (!would_block (code
) && !NILP (ps
->log
))
4691 call3 (ps
->log
, server
, Qnil
,
4692 concat3 (build_string ("accept failed with code"),
4693 Fnumber_to_string (make_number (code
)),
4694 build_string ("\n")));
4698 count
= SPECPDL_INDEX ();
4699 record_unwind_protect_int (close_file_unwind
, s
);
4703 /* Setup a new process to handle the connection. */
4705 /* Generate a unique identification of the caller, and build contact
4706 information for this process. */
4709 Lisp_Object args
[11];
4711 AUTO_STRING (procname_format_in
, "%s <%d.%d.%d.%d:%d>");
4712 AUTO_STRING (procname_format_in6
, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4713 AUTO_STRING (procname_format_default
, "%s <%d>");
4714 switch (saddr
.sa
.sa_family
)
4718 args
[nargs
++] = procname_format_in
;
4720 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4721 service
= make_number (ntohs (saddr
.in
.sin_port
));
4722 for (int i
= 0; i
< 4; i
++)
4723 args
[nargs
++] = make_number (ip
[i
]);
4724 args
[nargs
++] = service
;
4731 args
[nargs
++] = procname_format_in6
;
4733 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &saddr
.in6
.sin6_addr
);
4734 service
= make_number (ntohs (saddr
.in
.sin_port
));
4735 for (int i
= 0; i
< 8; i
++)
4736 args
[nargs
++] = make_number (ip6
[i
]);
4737 args
[nargs
++] = service
;
4743 args
[nargs
++] = procname_format_default
;
4745 args
[nargs
++] = make_number (connect_counter
);
4749 /* Create a new buffer name for this process if it doesn't have a
4750 filter. The new buffer name is based on the buffer name or
4751 process name of the server process concatenated with the caller
4754 if (!(EQ (ps
->filter
, Qinternal_default_process_filter
)
4755 || EQ (ps
->filter
, Qt
)))
4759 buffer
= ps
->buffer
;
4761 buffer
= Fbuffer_name (buffer
);
4767 buffer
= Fget_buffer_create (Fformat (nargs
, args
));
4771 /* Generate a unique name for the new server process. Combine the
4772 server process name with the caller identification. */
4775 Lisp_Object name
= Fformat (nargs
, args
);
4776 Lisp_Object proc
= make_process (name
);
4778 chan_process
[s
] = proc
;
4780 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4782 p
= XPROCESS (proc
);
4784 /* Build new contact information for this setup. */
4785 contact
= Fcopy_sequence (ps
->childp
);
4786 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4787 contact
= Fplist_put (contact
, QChost
, host
);
4788 if (!NILP (service
))
4789 contact
= Fplist_put (contact
, QCservice
, service
);
4790 contact
= Fplist_put (contact
, QCremote
,
4791 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4792 #ifdef HAVE_GETSOCKNAME
4794 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4795 contact
= Fplist_put (contact
, QClocal
,
4796 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4799 pset_childp (p
, contact
);
4800 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4801 pset_type (p
, Qnetwork
);
4803 pset_buffer (p
, buffer
);
4804 pset_sentinel (p
, ps
->sentinel
);
4805 pset_filter (p
, ps
->filter
);
4806 eassert (NILP (p
->command
));
4807 eassert (p
->pid
== 0);
4809 /* Discard the unwind protect for closing S. */
4810 specpdl_ptr
= specpdl
+ count
;
4812 p
->open_fd
[SUBPROCESS_STDIN
] = s
;
4815 pset_status (p
, Qrun
);
4817 /* Client processes for accepted connections are not stopped initially. */
4818 if (!EQ (p
->filter
, Qt
))
4819 add_process_read_fd (s
);
4823 /* Setup coding system for new process based on server process.
4824 This seems to be the proper thing to do, as the coding system
4825 of the new process should reflect the settings at the time the
4826 server socket was opened; not the current settings. */
4828 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4829 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4830 setup_process_coding_systems (proc
);
4832 pset_decoding_buf (p
, empty_unibyte_string
);
4833 eassert (p
->decoding_carryover
== 0);
4834 pset_encoding_buf (p
, empty_unibyte_string
);
4836 p
->inherit_coding_system_flag
4837 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4839 AUTO_STRING (dash
, "-");
4840 AUTO_STRING (nl
, "\n");
4841 Lisp_Object host_string
= STRINGP (host
) ? host
: dash
;
4843 if (!NILP (ps
->log
))
4845 AUTO_STRING (accept_from
, "accept from ");
4846 call3 (ps
->log
, server
, proc
, concat3 (accept_from
, host_string
, nl
));
4849 AUTO_STRING (open_from
, "open from ");
4850 exec_sentinel (proc
, concat3 (open_from
, host_string
, nl
));
4853 #ifdef HAVE_GETADDRINFO_A
4855 check_for_dns (Lisp_Object proc
)
4857 struct Lisp_Process
*p
= XPROCESS (proc
);
4858 Lisp_Object addrinfos
= Qnil
;
4861 if (! p
->dns_request
)
4864 int ret
= gai_error (p
->dns_request
);
4865 if (ret
== EAI_INPROGRESS
)
4868 /* We got a response. */
4871 struct addrinfo
*res
;
4873 for (res
= p
->dns_request
->ar_result
; res
; res
= res
->ai_next
)
4874 addrinfos
= Fcons (conv_addrinfo_to_lisp (res
), addrinfos
);
4876 addrinfos
= Fnreverse (addrinfos
);
4878 /* The DNS lookup failed. */
4879 else if (connecting_status (p
->status
))
4881 deactivate_process (proc
);
4882 pset_status (p
, (list2
4884 concat3 (build_string ("Name lookup of "),
4885 build_string (p
->dns_request
->ar_name
),
4886 build_string (" failed")))));
4889 free_dns_request (proc
);
4891 /* This process should not already be connected (or killed). */
4892 if (! connecting_status (p
->status
))
4898 #endif /* HAVE_GETADDRINFO_A */
4901 wait_for_socket_fds (Lisp_Object process
, char const *name
)
4903 while (XPROCESS (process
)->infd
< 0
4904 && connecting_status (XPROCESS (process
)->status
))
4906 add_to_log ("Waiting for socket from %s...", build_string (name
));
4907 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4912 wait_while_connecting (Lisp_Object process
)
4914 while (connecting_status (XPROCESS (process
)->status
))
4916 add_to_log ("Waiting for connection...");
4917 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4922 wait_for_tls_negotiation (Lisp_Object process
)
4925 while (XPROCESS (process
)->gnutls_p
4926 && XPROCESS (process
)->gnutls_initstage
!= GNUTLS_STAGE_READY
)
4928 add_to_log ("Waiting for TLS...");
4929 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4935 wait_reading_process_output_unwind (int data
)
4937 clear_waiting_thread_info ();
4938 waiting_for_user_input_p
= data
;
4941 /* This is here so breakpoints can be put on it. */
4943 wait_reading_process_output_1 (void)
4947 /* Read and dispose of subprocess output while waiting for timeout to
4948 elapse and/or keyboard input to be available.
4952 If negative, gobble data immediately available but don't wait for any.
4955 an additional duration to wait, measured in nanoseconds
4956 If TIME_LIMIT is zero, then:
4957 If NSECS == 0, there is no limit.
4958 If NSECS > 0, the timeout consists of NSECS only.
4959 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4962 0 to ignore keyboard input, or
4963 1 to return when input is available, or
4964 -1 meaning caller will actually read the input, so don't throw to
4967 DO_DISPLAY means redisplay should be done to show subprocess
4968 output that arrives.
4970 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4971 (and gobble terminal input into the buffer if any arrives).
4973 If WAIT_PROC is specified, wait until something arrives from that
4976 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4977 (suspending output from other processes). A negative value
4978 means don't run any timers either.
4980 Return positive if we received input from WAIT_PROC (or from any
4981 process if WAIT_PROC is null), zero if we attempted to receive
4982 input but got none, and negative if we didn't even try. */
4985 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4987 Lisp_Object wait_for_cell
,
4988 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4998 struct timespec timeout
, end_time
, timer_delay
;
4999 struct timespec got_output_end_time
= invalid_timespec ();
5000 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
5001 int got_some_output
= -1;
5002 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5003 bool retry_for_async
;
5005 ptrdiff_t count
= SPECPDL_INDEX ();
5007 /* Close to the current time if known, an invalid timespec otherwise. */
5008 struct timespec now
= invalid_timespec ();
5010 eassert (wait_proc
== NULL
5011 || EQ (wait_proc
->thread
, Qnil
)
5012 || XTHREAD (wait_proc
->thread
) == current_thread
);
5014 FD_ZERO (&Available
);
5017 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
5018 && !(CONSP (wait_proc
->status
)
5019 && EQ (XCAR (wait_proc
->status
), Qexit
)))
5020 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5022 record_unwind_protect_int (wait_reading_process_output_unwind
,
5023 waiting_for_user_input_p
);
5024 waiting_for_user_input_p
= read_kbd
;
5026 if (TYPE_MAXIMUM (time_t) < time_limit
)
5027 time_limit
= TYPE_MAXIMUM (time_t);
5029 if (time_limit
< 0 || nsecs
< 0)
5031 else if (time_limit
> 0 || nsecs
> 0)
5034 now
= current_timespec ();
5035 end_time
= timespec_add (now
, make_timespec (time_limit
, nsecs
));
5042 bool process_skipped
= false;
5044 /* If calling from keyboard input, do not quit
5045 since we want to return C-g as an input character.
5046 Otherwise, do pending quit if requested. */
5049 else if (pending_signals
)
5050 process_pending_signals ();
5052 /* Exit now if the cell we're waiting for became non-nil. */
5053 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5056 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5058 Lisp_Object process_list_head
, aproc
;
5059 struct Lisp_Process
*p
;
5061 retry_for_async
= false;
5062 FOR_EACH_PROCESS(process_list_head
, aproc
)
5064 p
= XPROCESS (aproc
);
5066 if (! wait_proc
|| p
== wait_proc
)
5068 #ifdef HAVE_GETADDRINFO_A
5069 /* Check for pending DNS requests. */
5072 Lisp_Object addrinfos
= check_for_dns (aproc
);
5073 if (!NILP (addrinfos
) && !EQ (addrinfos
, Qt
))
5074 connect_network_socket (aproc
, addrinfos
, Qnil
);
5076 retry_for_async
= true;
5080 /* Continue TLS negotiation. */
5081 if (p
->gnutls_initstage
== GNUTLS_STAGE_HANDSHAKE_TRIED
5082 && p
->is_non_blocking_client
)
5084 gnutls_try_handshake (p
);
5085 p
->gnutls_handshakes_tried
++;
5087 if (p
->gnutls_initstage
== GNUTLS_STAGE_READY
)
5089 gnutls_verify_boot (aproc
, Qnil
);
5090 finish_after_tls_connection (aproc
);
5094 retry_for_async
= true;
5095 if (p
->gnutls_handshakes_tried
5096 > GNUTLS_EMACS_HANDSHAKES_LIMIT
)
5098 deactivate_process (aproc
);
5099 pset_status (p
, list2 (Qfailed
,
5100 build_string ("TLS negotiation failed")));
5108 #endif /* GETADDRINFO_A or GNUTLS */
5110 /* Compute time from now till when time limit is up. */
5111 /* Exit if already run out. */
5112 if (wait
== TIMEOUT
)
5114 if (!timespec_valid_p (now
))
5115 now
= current_timespec ();
5116 if (timespec_cmp (end_time
, now
) <= 0)
5118 timeout
= timespec_sub (end_time
, now
);
5121 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
5123 /* Normally we run timers here.
5124 But not if wait_for_cell; in those cases,
5125 the wait is supposed to be short,
5126 and those callers cannot handle running arbitrary Lisp code here. */
5127 if (NILP (wait_for_cell
)
5128 && just_wait_proc
>= 0)
5132 unsigned old_timers_run
= timers_run
;
5133 struct buffer
*old_buffer
= current_buffer
;
5134 Lisp_Object old_window
= selected_window
;
5136 timer_delay
= timer_check ();
5138 /* If a timer has run, this might have changed buffers
5139 an alike. Make read_key_sequence aware of that. */
5140 if (timers_run
!= old_timers_run
5141 && (old_buffer
!= current_buffer
5142 || !EQ (old_window
, selected_window
))
5143 && waiting_for_user_input_p
== -1)
5144 record_asynch_buffer_change ();
5146 if (timers_run
!= old_timers_run
&& do_display
)
5147 /* We must retry, since a timer may have requeued itself
5148 and that could alter the time_delay. */
5149 redisplay_preserve_echo_area (9);
5153 while (!detect_input_pending ());
5155 /* If there is unread keyboard input, also return. */
5157 && requeued_events_pending_p ())
5160 /* This is so a breakpoint can be put here. */
5161 if (!timespec_valid_p (timer_delay
))
5162 wait_reading_process_output_1 ();
5165 /* Cause C-g and alarm signals to take immediate action,
5166 and cause input available signals to zero out timeout.
5168 It is important that we do this before checking for process
5169 activity. If we get a SIGCHLD after the explicit checks for
5170 process activity, timeout is the only way we will know. */
5172 set_waiting_for_input (&timeout
);
5174 /* If status of something has changed, and no input is
5175 available, notify the user of the change right away. After
5176 this explicit check, we'll let the SIGCHLD handler zap
5177 timeout to get our attention. */
5178 if (update_tick
!= process_tick
)
5183 if (kbd_on_hold_p ())
5186 compute_input_wait_mask (&Atemp
);
5187 compute_write_mask (&Ctemp
);
5189 timeout
= make_timespec (0, 0);
5190 if ((thread_select (pselect
, max_desc
+ 1,
5192 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
5193 NULL
, &timeout
, NULL
)
5196 /* It's okay for us to do this and then continue with
5197 the loop, since timeout has already been zeroed out. */
5198 clear_waiting_for_input ();
5199 got_some_output
= status_notify (NULL
, wait_proc
);
5200 if (do_display
) redisplay_preserve_echo_area (13);
5204 /* Don't wait for output from a non-running process. Just
5205 read whatever data has already been received. */
5206 if (wait_proc
&& wait_proc
->raw_status_new
)
5207 update_status (wait_proc
);
5209 && ! EQ (wait_proc
->status
, Qrun
)
5210 && ! connecting_status (wait_proc
->status
))
5212 bool read_some_bytes
= false;
5214 clear_waiting_for_input ();
5216 /* If data can be read from the process, do so until exhausted. */
5217 if (wait_proc
->infd
>= 0)
5219 XSETPROCESS (proc
, wait_proc
);
5223 int nread
= read_process_output (proc
, wait_proc
->infd
);
5226 if (errno
== EIO
|| would_block (errno
))
5231 if (got_some_output
< nread
)
5232 got_some_output
= nread
;
5235 read_some_bytes
= true;
5240 if (read_some_bytes
&& do_display
)
5241 redisplay_preserve_echo_area (10);
5246 /* Wait till there is something to do. */
5248 if (wait_proc
&& just_wait_proc
)
5250 if (wait_proc
->infd
< 0) /* Terminated. */
5252 FD_SET (wait_proc
->infd
, &Available
);
5256 else if (!NILP (wait_for_cell
))
5258 compute_non_process_wait_mask (&Available
);
5265 compute_non_keyboard_wait_mask (&Available
);
5267 compute_input_wait_mask (&Available
);
5268 compute_write_mask (&Writeok
);
5269 check_delay
= wait_proc
? 0 : process_output_delay_count
;
5273 /* If frame size has changed or the window is newly mapped,
5274 redisplay now, before we start to wait. There is a race
5275 condition here; if a SIGIO arrives between now and the select
5276 and indicates that a frame is trashed, the select may block
5277 displaying a trashed screen. */
5278 if (frame_garbaged
&& do_display
)
5280 clear_waiting_for_input ();
5281 redisplay_preserve_echo_area (11);
5283 set_waiting_for_input (&timeout
);
5286 /* Skip the `select' call if input is available and we're
5287 waiting for keyboard input or a cell change (which can be
5288 triggered by processing X events). In the latter case, set
5289 nfds to 1 to avoid breaking the loop. */
5291 if ((read_kbd
|| !NILP (wait_for_cell
))
5292 && detect_input_pending ())
5294 nfds
= read_kbd
? 0 : 1;
5296 FD_ZERO (&Available
);
5300 /* Set the timeout for adaptive read buffering if any
5301 process has non-zero read_output_skip and non-zero
5302 read_output_delay, and we are not reading output for a
5303 specific process. It is not executed if
5304 Vprocess_adaptive_read_buffering is nil. */
5305 if (process_output_skip
&& check_delay
> 0)
5307 int adaptive_nsecs
= timeout
.tv_nsec
;
5308 if (timeout
.tv_sec
> 0 || adaptive_nsecs
> READ_OUTPUT_DELAY_MAX
)
5309 adaptive_nsecs
= READ_OUTPUT_DELAY_MAX
;
5310 for (channel
= 0; check_delay
> 0 && channel
<= max_desc
; channel
++)
5312 proc
= chan_process
[channel
];
5315 /* Find minimum non-zero read_output_delay among the
5316 processes with non-zero read_output_skip. */
5317 if (XPROCESS (proc
)->read_output_delay
> 0)
5320 if (!XPROCESS (proc
)->read_output_skip
)
5322 FD_CLR (channel
, &Available
);
5323 process_skipped
= true;
5324 XPROCESS (proc
)->read_output_skip
= 0;
5325 if (XPROCESS (proc
)->read_output_delay
< adaptive_nsecs
)
5326 adaptive_nsecs
= XPROCESS (proc
)->read_output_delay
;
5329 timeout
= make_timespec (0, adaptive_nsecs
);
5330 process_output_skip
= 0;
5333 /* If we've got some output and haven't limited our timeout
5334 with adaptive read buffering, limit it. */
5335 if (got_some_output
> 0 && !process_skipped
5337 || timeout
.tv_nsec
> READ_OUTPUT_DELAY_INCREMENT
))
5338 timeout
= make_timespec (0, READ_OUTPUT_DELAY_INCREMENT
);
5341 if (NILP (wait_for_cell
) && just_wait_proc
>= 0
5342 && timespec_valid_p (timer_delay
)
5343 && timespec_cmp (timer_delay
, timeout
) < 0)
5345 if (!timespec_valid_p (now
))
5346 now
= current_timespec ();
5347 struct timespec timeout_abs
= timespec_add (now
, timeout
);
5348 if (!timespec_valid_p (got_output_end_time
)
5349 || timespec_cmp (timeout_abs
, got_output_end_time
) < 0)
5350 got_output_end_time
= timeout_abs
;
5351 timeout
= timer_delay
;
5354 got_output_end_time
= invalid_timespec ();
5356 /* NOW can become inaccurate if time can pass during pselect. */
5357 if (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0)
5358 now
= invalid_timespec ();
5360 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5362 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> ASYNC_RETRY_NSEC
))
5365 timeout
.tv_nsec
= ASYNC_RETRY_NSEC
;
5369 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5370 #if defined HAVE_GLIB && !defined HAVE_NS
5371 nfds
= xg_select (max_desc
+ 1,
5372 &Available
, (check_write
? &Writeok
: 0),
5373 NULL
, &timeout
, NULL
);
5374 #elif defined HAVE_NS
5375 /* And NS builds call thread_select in ns_select. */
5376 nfds
= ns_select (max_desc
+ 1,
5377 &Available
, (check_write
? &Writeok
: 0),
5378 NULL
, &timeout
, NULL
);
5379 #else /* !HAVE_GLIB */
5380 nfds
= thread_select (pselect
, max_desc
+ 1,
5382 (check_write
? &Writeok
: 0),
5383 NULL
, &timeout
, NULL
);
5384 #endif /* !HAVE_GLIB */
5387 /* GnuTLS buffers data internally. In lowat mode it leaves
5388 some data in the TCP buffers so that select works, but
5389 with custom pull/push functions we need to check if some
5390 data is available in the buffers manually. */
5393 fd_set tls_available
;
5396 FD_ZERO (&tls_available
);
5399 /* We're not waiting on a specific process, so loop
5400 through all the channels and check for data.
5401 This is a workaround needed for some versions of
5402 the gnutls library -- 2.12.14 has been confirmed
5404 http://comments.gmane.org/gmane.emacs.devel/145074 */
5405 for (channel
= 0; channel
< FD_SETSIZE
; ++channel
)
5406 if (! NILP (chan_process
[channel
]))
5408 struct Lisp_Process
*p
=
5409 XPROCESS (chan_process
[channel
]);
5410 if (p
&& p
->gnutls_p
&& p
->gnutls_state
5411 && ((emacs_gnutls_record_check_pending
5416 eassert (p
->infd
== channel
);
5417 FD_SET (p
->infd
, &tls_available
);
5424 /* Check this specific channel. */
5425 if (wait_proc
->gnutls_p
/* Check for valid process. */
5426 && wait_proc
->gnutls_state
5427 /* Do we have pending data? */
5428 && ((emacs_gnutls_record_check_pending
5429 (wait_proc
->gnutls_state
))
5433 eassert (0 <= wait_proc
->infd
);
5434 /* Set to Available. */
5435 FD_SET (wait_proc
->infd
, &tls_available
);
5440 Available
= tls_available
;
5447 /* Make C-g and alarm signals set flags again. */
5448 clear_waiting_for_input ();
5450 /* If we woke up due to SIGWINCH, actually change size now. */
5451 do_pending_window_change (0);
5455 /* Exit the main loop if we've passed the requested timeout,
5456 or aren't skipping processes and got some output and
5457 haven't lowered our timeout due to timers or SIGIO and
5458 have waited a long amount of time due to repeated
5460 struct timespec huge_timespec
5461 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION
);
5462 struct timespec cmp_time
= huge_timespec
;
5465 if (wait
== TIMEOUT
)
5466 cmp_time
= end_time
;
5467 if (!process_skipped
&& got_some_output
> 0
5468 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0))
5470 if (!timespec_valid_p (got_output_end_time
))
5472 if (timespec_cmp (got_output_end_time
, cmp_time
) < 0)
5473 cmp_time
= got_output_end_time
;
5475 if (timespec_cmp (cmp_time
, huge_timespec
) < 0)
5477 now
= current_timespec ();
5478 if (timespec_cmp (cmp_time
, now
) <= 0)
5485 if (xerrno
== EINTR
)
5487 else if (xerrno
== EBADF
)
5490 report_file_errno ("Failed select", Qnil
, xerrno
);
5493 /* Check for keyboard input. */
5494 /* If there is any, return immediately
5495 to give it higher priority than subprocesses. */
5499 unsigned old_timers_run
= timers_run
;
5500 struct buffer
*old_buffer
= current_buffer
;
5501 Lisp_Object old_window
= selected_window
;
5504 if (detect_input_pending_run_timers (do_display
))
5506 swallow_events (do_display
);
5507 if (detect_input_pending_run_timers (do_display
))
5511 /* If a timer has run, this might have changed buffers
5512 an alike. Make read_key_sequence aware of that. */
5513 if (timers_run
!= old_timers_run
5514 && waiting_for_user_input_p
== -1
5515 && (old_buffer
!= current_buffer
5516 || !EQ (old_window
, selected_window
)))
5517 record_asynch_buffer_change ();
5523 /* If there is unread keyboard input, also return. */
5525 && requeued_events_pending_p ())
5528 /* If we are not checking for keyboard input now,
5529 do process events (but don't run any timers).
5530 This is so that X events will be processed.
5531 Otherwise they may have to wait until polling takes place.
5532 That would causes delays in pasting selections, for example.
5534 (We used to do this only if wait_for_cell.) */
5535 if (read_kbd
== 0 && detect_input_pending ())
5537 swallow_events (do_display
);
5538 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5539 if (detect_input_pending ())
5544 /* Exit now if the cell we're waiting for became non-nil. */
5545 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5549 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5550 go read it. This can happen with X on BSD after logging out.
5551 In that case, there really is no input and no SIGIO,
5552 but select says there is input. */
5554 if (read_kbd
&& interrupt_input
5555 && keyboard_bit_set (&Available
) && ! noninteractive
)
5556 handle_input_available_signal (SIGIO
);
5559 /* If checking input just got us a size-change event from X,
5560 obey it now if we should. */
5561 if (read_kbd
|| ! NILP (wait_for_cell
))
5562 do_pending_window_change (0);
5564 /* Check for data from a process. */
5565 if (no_avail
|| nfds
== 0)
5568 for (channel
= 0; channel
<= max_desc
; ++channel
)
5570 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
5572 && ((d
->flags
& FOR_READ
5573 && FD_ISSET (channel
, &Available
))
5574 || ((d
->flags
& FOR_WRITE
)
5575 && FD_ISSET (channel
, &Writeok
))))
5576 d
->func (channel
, d
->data
);
5579 for (channel
= 0; channel
<= max_desc
; channel
++)
5581 if (FD_ISSET (channel
, &Available
)
5582 && ((fd_callback_info
[channel
].flags
& (KEYBOARD_FD
| PROCESS_FD
))
5587 /* If waiting for this channel, arrange to return as
5588 soon as no more input to be processed. No more
5590 proc
= chan_process
[channel
];
5594 /* If this is a server stream socket, accept connection. */
5595 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
5597 server_accept_connection (proc
, channel
);
5601 /* Read data from the process, starting with our
5602 buffered-ahead character if we have one. */
5604 nread
= read_process_output (proc
, channel
);
5605 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
5606 && got_some_output
< nread
)
5607 got_some_output
= nread
;
5610 /* Vacuum up any leftovers without waiting. */
5611 if (wait_proc
== XPROCESS (proc
))
5613 /* Since read_process_output can run a filter,
5614 which can call accept-process-output,
5615 don't try to read from any other processes
5616 before doing the select again. */
5617 FD_ZERO (&Available
);
5620 redisplay_preserve_echo_area (12);
5622 else if (nread
== -1 && would_block (errno
))
5625 /* FIXME: Is this special case still needed? */
5626 /* Note that we cannot distinguish between no input
5627 available now and a closed pipe.
5628 With luck, a closed pipe will be accompanied by
5629 subprocess termination and SIGCHLD. */
5630 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5631 && !PIPECONN_P (proc
))
5635 /* On some OSs with ptys, when the process on one end of
5636 a pty exits, the other end gets an error reading with
5637 errno = EIO instead of getting an EOF (0 bytes read).
5638 Therefore, if we get an error reading and errno =
5639 EIO, just continue, because the child process has
5640 exited and should clean itself up soon (e.g. when we
5642 else if (nread
== -1 && errno
== EIO
)
5644 struct Lisp_Process
*p
= XPROCESS (proc
);
5646 /* Clear the descriptor now, so we only raise the
5648 delete_read_fd (channel
);
5652 /* If the EIO occurs on a pty, the SIGCHLD handler's
5653 waitpid call will not find the process object to
5654 delete. Do it here. */
5655 p
->tick
= ++process_tick
;
5656 pset_status (p
, Qfailed
);
5659 #endif /* HAVE_PTYS */
5660 /* If we can detect process termination, don't consider the
5661 process gone just because its pipe is closed. */
5662 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5663 && !PIPECONN_P (proc
))
5665 else if (nread
== 0 && PIPECONN_P (proc
))
5667 /* Preserve status of processes already terminated. */
5668 XPROCESS (proc
)->tick
= ++process_tick
;
5669 deactivate_process (proc
);
5670 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5671 pset_status (XPROCESS (proc
),
5672 list2 (Qexit
, make_number (0)));
5676 /* Preserve status of processes already terminated. */
5677 XPROCESS (proc
)->tick
= ++process_tick
;
5678 deactivate_process (proc
);
5679 if (XPROCESS (proc
)->raw_status_new
)
5680 update_status (XPROCESS (proc
));
5681 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5682 pset_status (XPROCESS (proc
),
5683 list2 (Qexit
, make_number (256)));
5686 if (FD_ISSET (channel
, &Writeok
)
5687 && (fd_callback_info
[channel
].flags
5688 & NON_BLOCKING_CONNECT_FD
) != 0)
5690 struct Lisp_Process
*p
;
5692 delete_write_fd (channel
);
5694 proc
= chan_process
[channel
];
5698 p
= XPROCESS (proc
);
5702 socklen_t xlen
= sizeof (xerrno
);
5703 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5707 /* On MS-Windows, getsockopt clears the error for the
5708 entire process, which may not be the right thing; see
5709 w32.c. Use getpeername instead. */
5711 struct sockaddr pname
;
5712 socklen_t pnamelen
= sizeof (pname
);
5714 /* If connection failed, getpeername will fail. */
5716 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5718 /* Obtain connect failure code through error slippage. */
5721 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5728 Lisp_Object addrinfos
5729 = connecting_status (p
->status
) ? XCDR (p
->status
) : Qnil
;
5730 if (!NILP (addrinfos
))
5731 XSETCDR (p
->status
, XCDR (addrinfos
));
5734 p
->tick
= ++process_tick
;
5735 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
5737 deactivate_process (proc
);
5738 if (!NILP (addrinfos
))
5739 connect_network_socket (proc
, addrinfos
, Qnil
);
5744 /* If we have an incompletely set up TLS connection,
5745 then defer the sentinel signaling until
5747 if (NILP (p
->gnutls_boot_parameters
)
5751 pset_status (p
, Qrun
);
5752 /* Execute the sentinel here. If we had relied on
5753 status_notify to do it later, it will read input
5754 from the process before calling the sentinel. */
5755 exec_sentinel (proc
, build_string ("open\n"));
5758 if (0 <= p
->infd
&& !EQ (p
->filter
, Qt
)
5759 && !EQ (p
->command
, Qt
))
5760 add_process_read_fd (p
->infd
);
5763 } /* End for each file descriptor. */
5764 } /* End while exit conditions not met. */
5766 unbind_to (count
, Qnil
);
5768 /* If calling from keyboard input, do not quit
5769 since we want to return C-g as an input character.
5770 Otherwise, do pending quit if requested. */
5773 /* Prevent input_pending from remaining set if we quit. */
5774 clear_input_pending ();
5778 return got_some_output
;
5781 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5784 read_process_output_call (Lisp_Object fun_and_args
)
5786 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5790 read_process_output_error_handler (Lisp_Object error_val
)
5792 cmd_error_internal (error_val
, "error in process filter: ");
5794 update_echo_area ();
5795 Fsleep_for (make_number (2), Qnil
);
5800 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5802 struct coding_system
*coding
);
5804 /* Read pending output from the process channel,
5805 starting with our buffered-ahead character if we have one.
5806 Yield number of decoded characters read.
5808 This function reads at most 4096 characters.
5809 If you want to read all available subprocess output,
5810 you must call it repeatedly until it returns zero.
5812 The characters read are decoded according to PROC's coding-system
5816 read_process_output (Lisp_Object proc
, int channel
)
5819 struct Lisp_Process
*p
= XPROCESS (proc
);
5820 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5821 int carryover
= p
->decoding_carryover
;
5822 enum { readmax
= 4096 };
5823 ptrdiff_t count
= SPECPDL_INDEX ();
5824 Lisp_Object odeactivate
;
5825 char chars
[sizeof coding
->carryover
+ readmax
];
5828 /* See the comment above. */
5829 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5831 #ifdef DATAGRAM_SOCKETS
5832 /* We have a working select, so proc_buffered_char is always -1. */
5833 if (DATAGRAM_CHAN_P (channel
))
5835 socklen_t len
= datagram_address
[channel
].len
;
5836 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5837 0, datagram_address
[channel
].sa
, &len
);
5842 bool buffered
= proc_buffered_char
[channel
] >= 0;
5845 chars
[carryover
] = proc_buffered_char
[channel
];
5846 proc_buffered_char
[channel
] = -1;
5849 if (p
->gnutls_p
&& p
->gnutls_state
)
5850 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5851 readmax
- buffered
);
5854 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5855 readmax
- buffered
);
5856 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5858 int delay
= p
->read_output_delay
;
5861 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5864 process_output_delay_count
++;
5865 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5868 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5870 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5872 process_output_delay_count
--;
5874 p
->read_output_delay
= delay
;
5877 p
->read_output_skip
= 1;
5878 process_output_skip
= 1;
5882 nbytes
+= buffered
&& nbytes
<= 0;
5885 p
->decoding_carryover
= 0;
5887 /* At this point, NBYTES holds number of bytes just received
5888 (including the one in proc_buffered_char[channel]). */
5891 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5893 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5896 /* Now set NBYTES how many bytes we must decode. */
5897 nbytes
+= carryover
;
5899 odeactivate
= Vdeactivate_mark
;
5900 /* There's no good reason to let process filters change the current
5901 buffer, and many callers of accept-process-output, sit-for, and
5902 friends don't expect current-buffer to be changed from under them. */
5903 record_unwind_current_buffer ();
5905 read_and_dispose_of_process_output (p
, chars
, nbytes
, coding
);
5907 /* Handling the process output should not deactivate the mark. */
5908 Vdeactivate_mark
= odeactivate
;
5910 unbind_to (count
, Qnil
);
5915 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5917 struct coding_system
*coding
)
5919 Lisp_Object outstream
= p
->filter
;
5921 bool outer_running_asynch_code
= running_asynch_code
;
5922 int waiting
= waiting_for_user_input_p
;
5925 Lisp_Object obuffer
, okeymap
;
5926 XSETBUFFER (obuffer
, current_buffer
);
5927 okeymap
= BVAR (current_buffer
, keymap
);
5930 /* We inhibit quit here instead of just catching it so that
5931 hitting ^G when a filter happens to be running won't screw
5933 specbind (Qinhibit_quit
, Qt
);
5934 specbind (Qlast_nonmenu_event
, Qt
);
5936 /* In case we get recursively called,
5937 and we already saved the match data nonrecursively,
5938 save the same match data in safely recursive fashion. */
5939 if (outer_running_asynch_code
)
5942 /* Don't clobber the CURRENT match data, either! */
5943 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5944 restore_search_regs ();
5945 record_unwind_save_match_data ();
5946 Fset_match_data (tem
, Qt
);
5949 /* For speed, if a search happens within this code,
5950 save the match data in a special nonrecursive fashion. */
5951 running_asynch_code
= 1;
5953 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5954 text
= coding
->dst_object
;
5955 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5956 /* A new coding system might be found. */
5957 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5959 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5961 /* Don't call setup_coding_system for
5962 proc_decode_coding_system[channel] here. It is done in
5963 detect_coding called via decode_coding above. */
5965 /* If a coding system for encoding is not yet decided, we set
5966 it as the same as coding-system for decoding.
5968 But, before doing that we must check if
5969 proc_encode_coding_system[p->outfd] surely points to a
5970 valid memory because p->outfd will be changed once EOF is
5971 sent to the process. */
5972 if (NILP (p
->encode_coding_system
) && p
->outfd
>= 0
5973 && proc_encode_coding_system
[p
->outfd
])
5975 pset_encode_coding_system
5976 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5977 setup_coding_system (p
->encode_coding_system
,
5978 proc_encode_coding_system
[p
->outfd
]);
5982 if (coding
->carryover_bytes
> 0)
5984 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5985 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5986 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5987 coding
->carryover_bytes
);
5988 p
->decoding_carryover
= coding
->carryover_bytes
;
5990 if (SBYTES (text
) > 0)
5991 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5992 sometimes it's simply wrong to wrap (e.g. when called from
5993 accept-process-output). */
5994 internal_condition_case_1 (read_process_output_call
,
5995 list3 (outstream
, make_lisp_proc (p
), text
),
5996 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5997 read_process_output_error_handler
);
5999 /* If we saved the match data nonrecursively, restore it now. */
6000 restore_search_regs ();
6001 running_asynch_code
= outer_running_asynch_code
;
6003 /* Restore waiting_for_user_input_p as it was
6004 when we were called, in case the filter clobbered it. */
6005 waiting_for_user_input_p
= waiting
;
6007 #if 0 /* Call record_asynch_buffer_change unconditionally,
6008 because we might have changed minor modes or other things
6009 that affect key bindings. */
6010 if (! EQ (Fcurrent_buffer (), obuffer
)
6011 || ! EQ (current_buffer
->keymap
, okeymap
))
6013 /* But do it only if the caller is actually going to read events.
6014 Otherwise there's no need to make him wake up, and it could
6015 cause trouble (for example it would make sit_for return). */
6016 if (waiting_for_user_input_p
== -1)
6017 record_asynch_buffer_change ();
6020 DEFUN ("internal-default-process-filter", Finternal_default_process_filter
,
6021 Sinternal_default_process_filter
, 2, 2, 0,
6022 doc
: /* Function used as default process filter.
6023 This inserts the process's output into its buffer, if there is one.
6024 Otherwise it discards the output. */)
6025 (Lisp_Object proc
, Lisp_Object text
)
6027 struct Lisp_Process
*p
;
6030 CHECK_PROCESS (proc
);
6031 p
= XPROCESS (proc
);
6032 CHECK_STRING (text
);
6034 if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
6036 Lisp_Object old_read_only
;
6037 ptrdiff_t old_begv
, old_zv
;
6038 ptrdiff_t old_begv_byte
, old_zv_byte
;
6039 ptrdiff_t before
, before_byte
;
6040 ptrdiff_t opoint_byte
;
6043 Fset_buffer (p
->buffer
);
6045 opoint_byte
= PT_BYTE
;
6046 old_read_only
= BVAR (current_buffer
, read_only
);
6049 old_begv_byte
= BEGV_BYTE
;
6050 old_zv_byte
= ZV_BYTE
;
6052 bset_read_only (current_buffer
, Qnil
);
6054 /* Insert new output into buffer at the current end-of-output
6055 marker, thus preserving logical ordering of input and output. */
6056 if (XMARKER (p
->mark
)->buffer
)
6057 set_point_from_marker (p
->mark
);
6059 SET_PT_BOTH (ZV
, ZV_BYTE
);
6061 before_byte
= PT_BYTE
;
6063 /* If the output marker is outside of the visible region, save
6064 the restriction and widen. */
6065 if (! (BEGV
<= PT
&& PT
<= ZV
))
6068 /* Adjust the multibyteness of TEXT to that of the buffer. */
6069 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
6070 != ! STRING_MULTIBYTE (text
))
6071 text
= (STRING_MULTIBYTE (text
)
6072 ? Fstring_as_unibyte (text
)
6073 : Fstring_to_multibyte (text
));
6074 /* Insert before markers in case we are inserting where
6075 the buffer's mark is, and the user's next command is Meta-y. */
6076 insert_from_string_before_markers (text
, 0, 0,
6077 SCHARS (text
), SBYTES (text
), 0);
6079 /* Make sure the process marker's position is valid when the
6080 process buffer is changed in the signal_after_change above.
6081 W3 is known to do that. */
6082 if (BUFFERP (p
->buffer
)
6083 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
6084 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
6086 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6088 update_mode_lines
= 23;
6090 /* Make sure opoint and the old restrictions
6091 float ahead of any new text just as point would. */
6092 if (opoint
>= before
)
6094 opoint
+= PT
- before
;
6095 opoint_byte
+= PT_BYTE
- before_byte
;
6097 if (old_begv
> before
)
6099 old_begv
+= PT
- before
;
6100 old_begv_byte
+= PT_BYTE
- before_byte
;
6102 if (old_zv
>= before
)
6104 old_zv
+= PT
- before
;
6105 old_zv_byte
+= PT_BYTE
- before_byte
;
6108 /* If the restriction isn't what it should be, set it. */
6109 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
6110 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
6112 bset_read_only (current_buffer
, old_read_only
);
6113 SET_PT_BOTH (opoint
, opoint_byte
);
6118 /* Sending data to subprocess. */
6120 /* In send_process, when a write fails temporarily,
6121 wait_reading_process_output is called. It may execute user code,
6122 e.g. timers, that attempts to write new data to the same process.
6123 We must ensure that data is sent in the right order, and not
6124 interspersed half-completed with other writes (Bug#10815). This is
6125 handled by the write_queue element of struct process. It is a list
6126 with each entry having the form
6128 (string . (offset . length))
6130 where STRING is a lisp string, OFFSET is the offset into the
6131 string's byte sequence from which we should begin to send, and
6132 LENGTH is the number of bytes left to send. */
6134 /* Create a new entry in write_queue.
6135 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6136 BUF is a pointer to the string sequence of the input_obj or a C
6137 string in case of Qt or Qnil. */
6140 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
6141 const char *buf
, ptrdiff_t len
, bool front
)
6144 Lisp_Object entry
, obj
;
6146 if (STRINGP (input_obj
))
6148 offset
= buf
- SSDATA (input_obj
);
6154 obj
= make_unibyte_string (buf
, len
);
6157 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
6160 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
6162 pset_write_queue (p
, nconc2 (p
->write_queue
, list1 (entry
)));
6165 /* Remove the first element in the write_queue of process P, put its
6166 contents in OBJ, BUF and LEN, and return true. If the
6167 write_queue is empty, return false. */
6170 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
6171 const char **buf
, ptrdiff_t *len
)
6173 Lisp_Object entry
, offset_length
;
6176 if (NILP (p
->write_queue
))
6179 entry
= XCAR (p
->write_queue
);
6180 pset_write_queue (p
, XCDR (p
->write_queue
));
6182 *obj
= XCAR (entry
);
6183 offset_length
= XCDR (entry
);
6185 *len
= XINT (XCDR (offset_length
));
6186 offset
= XINT (XCAR (offset_length
));
6187 *buf
= SSDATA (*obj
) + offset
;
6192 /* Send some data to process PROC.
6193 BUF is the beginning of the data; LEN is the number of characters.
6194 OBJECT is the Lisp object that the data comes from. If OBJECT is
6195 nil or t, it means that the data comes from C string.
6197 If OBJECT is not nil, the data is encoded by PROC's coding-system
6198 for encoding before it is sent.
6200 This function can evaluate Lisp code and can garbage collect. */
6203 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
6206 struct Lisp_Process
*p
= XPROCESS (proc
);
6208 struct coding_system
*coding
;
6210 if (NETCONN_P (proc
))
6212 wait_while_connecting (proc
);
6213 wait_for_tls_negotiation (proc
);
6216 if (p
->raw_status_new
)
6218 if (! EQ (p
->status
, Qrun
))
6219 error ("Process %s not running", SDATA (p
->name
));
6221 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
6223 coding
= proc_encode_coding_system
[p
->outfd
];
6224 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
6226 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
6227 || (BUFFERP (object
)
6228 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
6231 pset_encode_coding_system
6232 (p
, complement_process_encoding_system (p
->encode_coding_system
));
6233 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
6235 /* The coding system for encoding was changed to raw-text
6236 because we sent a unibyte text previously. Now we are
6237 sending a multibyte text, thus we must encode it by the
6238 original coding system specified for the current process.
6240 Another reason we come here is that the coding system
6241 was just complemented and a new one was returned by
6242 complement_process_encoding_system. */
6243 setup_coding_system (p
->encode_coding_system
, coding
);
6244 Vlast_coding_system_used
= p
->encode_coding_system
;
6246 coding
->src_multibyte
= 1;
6250 coding
->src_multibyte
= 0;
6251 /* For sending a unibyte text, character code conversion should
6252 not take place but EOL conversion should. So, setup raw-text
6253 or one of the subsidiary if we have not yet done it. */
6254 if (CODING_REQUIRE_ENCODING (coding
))
6256 if (CODING_REQUIRE_FLUSHING (coding
))
6258 /* But, before changing the coding, we must flush out data. */
6259 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6260 send_process (proc
, "", 0, Qt
);
6261 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
6263 setup_coding_system (raw_text_coding_system
6264 (Vlast_coding_system_used
),
6266 coding
->src_multibyte
= 0;
6269 coding
->dst_multibyte
= 0;
6271 if (CODING_REQUIRE_ENCODING (coding
))
6273 coding
->dst_object
= Qt
;
6274 if (BUFFERP (object
))
6276 ptrdiff_t from_byte
, from
, to
;
6277 ptrdiff_t save_pt
, save_pt_byte
;
6278 struct buffer
*cur
= current_buffer
;
6280 set_buffer_internal (XBUFFER (object
));
6281 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
6283 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
6284 from
= BYTE_TO_CHAR (from_byte
);
6285 to
= BYTE_TO_CHAR (from_byte
+ len
);
6286 TEMP_SET_PT_BOTH (from
, from_byte
);
6287 encode_coding_object (coding
, object
, from
, from_byte
,
6288 to
, from_byte
+ len
, Qt
);
6289 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
6290 set_buffer_internal (cur
);
6292 else if (STRINGP (object
))
6294 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
6295 SBYTES (object
), Qt
);
6299 coding
->dst_object
= make_unibyte_string (buf
, len
);
6300 coding
->produced
= len
;
6303 len
= coding
->produced
;
6304 object
= coding
->dst_object
;
6305 buf
= SSDATA (object
);
6308 /* If there is already data in the write_queue, put the new data
6309 in the back of queue. Otherwise, ignore it. */
6310 if (!NILP (p
->write_queue
))
6311 write_queue_push (p
, object
, buf
, len
, 0);
6313 do /* while !NILP (p->write_queue) */
6315 ptrdiff_t cur_len
= -1;
6316 const char *cur_buf
;
6317 Lisp_Object cur_object
;
6319 /* If write_queue is empty, ignore it. */
6320 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
6324 cur_object
= object
;
6329 /* Send this batch, using one or more write calls. */
6330 ptrdiff_t written
= 0;
6331 int outfd
= p
->outfd
;
6332 #ifdef DATAGRAM_SOCKETS
6333 if (DATAGRAM_CHAN_P (outfd
))
6335 rv
= sendto (outfd
, cur_buf
, cur_len
,
6336 0, datagram_address
[outfd
].sa
,
6337 datagram_address
[outfd
].len
);
6340 else if (errno
== EMSGSIZE
)
6341 report_file_error ("Sending datagram", proc
);
6347 if (p
->gnutls_p
&& p
->gnutls_state
)
6348 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
6351 written
= emacs_write_sig (outfd
, cur_buf
, cur_len
);
6352 rv
= (written
? 0 : -1);
6353 if (p
->read_output_delay
> 0
6354 && p
->adaptive_read_buffering
== 1)
6356 p
->read_output_delay
= 0;
6357 process_output_delay_count
--;
6358 p
->read_output_skip
= 0;
6364 if (would_block (errno
))
6365 /* Buffer is full. Wait, accepting input;
6366 that may allow the program
6367 to finish doing output and read more. */
6369 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6370 /* A gross hack to work around a bug in FreeBSD.
6371 In the following sequence, read(2) returns
6375 write(2) 954 bytes, get EAGAIN
6376 read(2) 1024 bytes in process_read_output
6377 read(2) 11 bytes in process_read_output
6379 That is, read(2) returns more bytes than have
6380 ever been written successfully. The 1033 bytes
6381 read are the 1022 bytes written successfully
6382 after processing (for example with CRs added if
6383 the terminal is set up that way which it is
6384 here). The same bytes will be seen again in a
6385 later read(2), without the CRs. */
6387 if (errno
== EAGAIN
)
6390 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
6392 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6394 /* Put what we should have written in wait_queue. */
6395 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
6396 wait_reading_process_output (0, 20 * 1000 * 1000,
6397 0, 0, Qnil
, NULL
, 0);
6398 /* Reread queue, to see what is left. */
6401 else if (errno
== EPIPE
)
6403 p
->raw_status_new
= 0;
6404 pset_status (p
, list2 (Qexit
, make_number (256)));
6405 p
->tick
= ++process_tick
;
6406 deactivate_process (proc
);
6407 error ("process %s no longer connected to pipe; closed it",
6411 /* This is a real error. */
6412 report_file_error ("Writing to process", proc
);
6418 while (!NILP (p
->write_queue
));
6421 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
6423 doc
: /* Send current contents of region as input to PROCESS.
6424 PROCESS may be a process, a buffer, the name of a process or buffer, or
6425 nil, indicating the current buffer's process.
6426 Called from program, takes three arguments, PROCESS, START and END.
6427 If the region is more than 500 characters long,
6428 it is sent in several bunches. This may happen even for shorter regions.
6429 Output from processes can arrive in between bunches.
6431 If PROCESS is a non-blocking network process that hasn't been fully
6432 set up yet, this function will block until socket setup has completed. */)
6433 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
6435 Lisp_Object proc
= get_process (process
);
6436 ptrdiff_t start_byte
, end_byte
;
6438 validate_region (&start
, &end
);
6440 start_byte
= CHAR_TO_BYTE (XINT (start
));
6441 end_byte
= CHAR_TO_BYTE (XINT (end
));
6443 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
6444 move_gap_both (XINT (start
), start_byte
);
6446 if (NETCONN_P (proc
))
6447 wait_while_connecting (proc
);
6449 send_process (proc
, (char *) BYTE_POS_ADDR (start_byte
),
6450 end_byte
- start_byte
, Fcurrent_buffer ());
6455 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
6457 doc
: /* Send PROCESS the contents of STRING as input.
6458 PROCESS may be a process, a buffer, the name of a process or buffer, or
6459 nil, indicating the current buffer's process.
6460 If STRING is more than 500 characters long,
6461 it is sent in several bunches. This may happen even for shorter strings.
6462 Output from processes can arrive in between bunches.
6464 If PROCESS is a non-blocking network process that hasn't been fully
6465 set up yet, this function will block until socket setup has completed. */)
6466 (Lisp_Object process
, Lisp_Object string
)
6468 CHECK_STRING (string
);
6469 Lisp_Object proc
= get_process (process
);
6470 send_process (proc
, SSDATA (string
),
6471 SBYTES (string
), string
);
6475 /* Return the foreground process group for the tty/pty that
6476 the process P uses. */
6478 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
6483 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
6486 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6487 master side. Try the slave side. */
6488 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
6492 ioctl (fd
, TIOCGPGRP
, &gid
);
6496 #endif /* defined (TIOCGPGRP ) */
6501 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
6502 Sprocess_running_child_p
, 0, 1, 0,
6503 doc
: /* Return non-nil if PROCESS has given the terminal to a
6504 child. If the operating system does not make it possible to find out,
6505 return t. If we can find out, return the numeric ID of the foreground
6507 (Lisp_Object process
)
6509 /* Initialize in case ioctl doesn't exist or gives an error,
6510 in a way that will cause returning t. */
6511 Lisp_Object proc
= get_process (process
);
6512 struct Lisp_Process
*p
= XPROCESS (proc
);
6514 if (!EQ (p
->type
, Qreal
))
6515 error ("Process %s is not a subprocess",
6518 error ("Process %s is not active",
6521 pid_t gid
= emacs_get_tty_pgrp (p
);
6526 return make_number (gid
);
6530 /* Send a signal number SIGNO to PROCESS.
6531 If CURRENT_GROUP is t, that means send to the process group
6532 that currently owns the terminal being used to communicate with PROCESS.
6533 This is used for various commands in shell mode.
6534 If CURRENT_GROUP is lambda, that means send to the process group
6535 that currently owns the terminal, but only if it is NOT the shell itself.
6537 If NOMSG is false, insert signal-announcements into process's buffers
6540 If we can, we try to signal PROCESS by sending control characters
6541 down the pty. This allows us to signal inferiors who have changed
6542 their uid, for which kill would return an EPERM error. */
6545 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
6549 struct Lisp_Process
*p
;
6553 proc
= get_process (process
);
6554 p
= XPROCESS (proc
);
6556 if (!EQ (p
->type
, Qreal
))
6557 error ("Process %s is not a subprocess",
6560 error ("Process %s is not active",
6564 current_group
= Qnil
;
6566 /* If we are using pgrps, get a pgrp number and make it negative. */
6567 if (NILP (current_group
))
6568 /* Send the signal to the shell's process group. */
6572 #ifdef SIGNALS_VIA_CHARACTERS
6573 /* If possible, send signals to the entire pgrp
6574 by sending an input character to it. */
6577 cc_t
*sig_char
= NULL
;
6579 tcgetattr (p
->infd
, &t
);
6584 sig_char
= &t
.c_cc
[VINTR
];
6588 sig_char
= &t
.c_cc
[VQUIT
];
6593 sig_char
= &t
.c_cc
[VSWTCH
];
6595 sig_char
= &t
.c_cc
[VSUSP
];
6600 if (sig_char
&& *sig_char
!= CDISABLE
)
6602 send_process (proc
, (char *) sig_char
, 1, Qnil
);
6605 /* If we can't send the signal with a character,
6606 fall through and send it another way. */
6608 /* The code above may fall through if it can't
6609 handle the signal. */
6610 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6613 /* Get the current pgrp using the tty itself, if we have that.
6614 Otherwise, use the pty to get the pgrp.
6615 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6616 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6617 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6618 His patch indicates that if TIOCGPGRP returns an error, then
6619 we should just assume that p->pid is also the process group id. */
6621 gid
= emacs_get_tty_pgrp (p
);
6624 /* If we can't get the information, assume
6625 the shell owns the tty. */
6628 /* It is not clear whether anything really can set GID to -1.
6629 Perhaps on some system one of those ioctls can or could do so.
6630 Or perhaps this is vestigial. */
6633 #else /* ! defined (TIOCGPGRP) */
6634 /* Can't select pgrps on this system, so we know that
6635 the child itself heads the pgrp. */
6637 #endif /* ! defined (TIOCGPGRP) */
6639 /* If current_group is lambda, and the shell owns the terminal,
6640 don't send any signal. */
6641 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6646 if (signo
== SIGCONT
)
6648 p
->raw_status_new
= 0;
6649 pset_status (p
, Qrun
);
6650 p
->tick
= ++process_tick
;
6653 status_notify (NULL
, NULL
);
6654 redisplay_preserve_echo_area (13);
6660 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6661 We don't know whether the bug is fixed in later HP-UX versions. */
6662 if (! NILP (current_group
) && ioctl (p
->infd
, TIOCSIGSEND
, signo
) != -1)
6666 /* If we don't have process groups, send the signal to the immediate
6667 subprocess. That isn't really right, but it's better than any
6668 obvious alternative. */
6669 pid_t pid
= no_pgrp
? gid
: - gid
;
6671 /* Do not kill an already-reaped process, as that could kill an
6672 innocent bystander that happens to have the same process ID. */
6674 block_child_signal (&oldset
);
6677 unblock_child_signal (&oldset
);
6680 DEFUN ("internal-default-interrupt-process",
6681 Finternal_default_interrupt_process
,
6682 Sinternal_default_interrupt_process
, 0, 2, 0,
6683 doc
: /* Default function to interrupt process PROCESS.
6684 It shall be the last element in list `interrupt-process-functions'.
6685 See function `interrupt-process' for more details on usage. */)
6686 (Lisp_Object process
, Lisp_Object current_group
)
6688 process_send_signal (process
, SIGINT
, current_group
, 0);
6692 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6693 doc
: /* Interrupt process PROCESS.
6694 PROCESS may be a process, a buffer, or the name of a process or buffer.
6695 No arg or nil means current buffer's process.
6696 Second arg CURRENT-GROUP non-nil means send signal to
6697 the current process-group of the process's controlling terminal
6698 rather than to the process's own process group.
6699 If the process is a shell, this means interrupt current subjob
6700 rather than the shell.
6702 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6703 don't send the signal.
6705 This function calls the functions of `interrupt-process-functions' in
6706 the order of the list, until one of them returns non-`nil'. */)
6707 (Lisp_Object process
, Lisp_Object current_group
)
6709 return CALLN (Frun_hook_with_args_until_success
, Qinterrupt_process_functions
,
6710 process
, current_group
);
6713 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6714 doc
: /* Kill process PROCESS. May be process or name of one.
6715 See function `interrupt-process' for more details on usage. */)
6716 (Lisp_Object process
, Lisp_Object current_group
)
6718 process_send_signal (process
, SIGKILL
, current_group
, 0);
6722 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6723 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6724 See function `interrupt-process' for more details on usage. */)
6725 (Lisp_Object process
, Lisp_Object current_group
)
6727 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6731 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6732 doc
: /* Stop process PROCESS. May be process or name of one.
6733 See function `interrupt-process' for more details on usage.
6734 If PROCESS is a network or serial or pipe connection, inhibit handling
6735 of incoming traffic. */)
6736 (Lisp_Object process
, Lisp_Object current_group
)
6738 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6739 || PIPECONN_P (process
)))
6741 struct Lisp_Process
*p
;
6743 p
= XPROCESS (process
);
6744 if (NILP (p
->command
)
6746 delete_read_fd (p
->infd
);
6747 pset_command (p
, Qt
);
6751 error ("No SIGTSTP support");
6753 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6758 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6759 doc
: /* Continue process PROCESS. May be process or name of one.
6760 See function `interrupt-process' for more details on usage.
6761 If PROCESS is a network or serial process, resume handling of incoming
6763 (Lisp_Object process
, Lisp_Object current_group
)
6765 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6766 || PIPECONN_P (process
)))
6768 struct Lisp_Process
*p
;
6770 p
= XPROCESS (process
);
6771 if (EQ (p
->command
, Qt
)
6773 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6775 add_process_read_fd (p
->infd
);
6777 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6778 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6779 #else /* not WINDOWSNT */
6780 tcflush (p
->infd
, TCIFLUSH
);
6781 #endif /* not WINDOWSNT */
6783 pset_command (p
, Qnil
);
6787 process_send_signal (process
, SIGCONT
, current_group
, 0);
6789 error ("No SIGCONT support");
6794 /* Return the integer value of the signal whose abbreviation is ABBR,
6795 or a negative number if there is no such signal. */
6797 abbr_to_signal (char const *name
)
6800 char sigbuf
[20]; /* Large enough for all valid signal abbreviations. */
6802 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6805 for (i
= 0; i
< sizeof sigbuf
; i
++)
6807 sigbuf
[i
] = c_toupper (name
[i
]);
6809 return str2sig (sigbuf
, &signo
) == 0 ? signo
: -1;
6815 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6816 2, 2, "sProcess (name or number): \nnSignal code: ",
6817 doc
: /* Send PROCESS the signal with code SIGCODE.
6818 PROCESS may also be a number specifying the process id of the
6819 process to signal; in this case, the process need not be a child of
6821 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6822 (Lisp_Object process
, Lisp_Object sigcode
)
6827 if (STRINGP (process
))
6829 Lisp_Object tem
= Fget_process (process
);
6832 Lisp_Object process_number
6833 = string_to_number (SSDATA (process
), 10, 1);
6834 if (NUMBERP (process_number
))
6835 tem
= process_number
;
6839 else if (!NUMBERP (process
))
6840 process
= get_process (process
);
6845 if (NUMBERP (process
))
6846 CONS_TO_INTEGER (process
, pid_t
, pid
);
6849 CHECK_PROCESS (process
);
6850 pid
= XPROCESS (process
)->pid
;
6852 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6855 if (INTEGERP (sigcode
))
6857 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6858 signo
= XINT (sigcode
);
6864 CHECK_SYMBOL (sigcode
);
6865 name
= SSDATA (SYMBOL_NAME (sigcode
));
6867 signo
= abbr_to_signal (name
);
6869 error ("Undefined signal name %s", name
);
6872 return make_number (kill (pid
, signo
));
6875 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6876 doc
: /* Make PROCESS see end-of-file in its input.
6877 EOF comes after any text already sent to it.
6878 PROCESS may be a process, a buffer, the name of a process or buffer, or
6879 nil, indicating the current buffer's process.
6880 If PROCESS is a network connection, or is a process communicating
6881 through a pipe (as opposed to a pty), then you cannot send any more
6882 text to PROCESS after you call this function.
6883 If PROCESS is a serial process, wait until all output written to the
6884 process has been transmitted to the serial port. */)
6885 (Lisp_Object process
)
6888 struct coding_system
*coding
= NULL
;
6891 proc
= get_process (process
);
6893 if (NETCONN_P (proc
))
6894 wait_while_connecting (proc
);
6896 if (DATAGRAM_CONN_P (proc
))
6900 outfd
= XPROCESS (proc
)->outfd
;
6902 coding
= proc_encode_coding_system
[outfd
];
6904 /* Make sure the process is really alive. */
6905 if (XPROCESS (proc
)->raw_status_new
)
6906 update_status (XPROCESS (proc
));
6907 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6908 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6910 if (coding
&& CODING_REQUIRE_FLUSHING (coding
))
6912 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6913 send_process (proc
, "", 0, Qnil
);
6916 if (XPROCESS (proc
)->pty_flag
)
6917 send_process (proc
, "\004", 1, Qnil
);
6918 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6921 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6922 report_file_error ("Failed tcdrain", Qnil
);
6923 #endif /* not WINDOWSNT */
6924 /* Do nothing on Windows because writes are blocking. */
6928 struct Lisp_Process
*p
= XPROCESS (proc
);
6929 int old_outfd
= p
->outfd
;
6932 #ifdef HAVE_SHUTDOWN
6933 /* If this is a network connection, or socketpair is used
6934 for communication with the subprocess, call shutdown to cause EOF.
6935 (In some old system, shutdown to socketpair doesn't work.
6936 Then we just can't win.) */
6938 && (EQ (p
->type
, Qnetwork
) || p
->infd
== old_outfd
))
6939 shutdown (old_outfd
, 1);
6941 close_process_fd (&p
->open_fd
[WRITE_TO_SUBPROCESS
]);
6942 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6944 report_file_error ("Opening null device", Qnil
);
6945 p
->open_fd
[WRITE_TO_SUBPROCESS
] = new_outfd
;
6946 p
->outfd
= new_outfd
;
6948 if (!proc_encode_coding_system
[new_outfd
])
6949 proc_encode_coding_system
[new_outfd
]
6950 = xmalloc (sizeof (struct coding_system
));
6953 *proc_encode_coding_system
[new_outfd
]
6954 = *proc_encode_coding_system
[old_outfd
];
6955 memset (proc_encode_coding_system
[old_outfd
], 0,
6956 sizeof (struct coding_system
));
6959 setup_coding_system (p
->encode_coding_system
,
6960 proc_encode_coding_system
[new_outfd
]);
6965 /* The main Emacs thread records child processes in three places:
6967 - Vprocess_alist, for asynchronous subprocesses, which are child
6968 processes visible to Lisp.
6970 - deleted_pid_list, for child processes invisible to Lisp,
6971 typically because of delete-process. These are recorded so that
6972 the processes can be reaped when they exit, so that the operating
6973 system's process table is not cluttered by zombies.
6975 - the local variable PID in Fcall_process, call_process_cleanup and
6976 call_process_kill, for synchronous subprocesses.
6977 record_unwind_protect is used to make sure this process is not
6978 forgotten: if the user interrupts call-process and the child
6979 process refuses to exit immediately even with two C-g's,
6980 call_process_kill adds PID's contents to deleted_pid_list before
6983 The main Emacs thread invokes waitpid only on child processes that
6984 it creates and that have not been reaped. This avoid races on
6985 platforms such as GTK, where other threads create their own
6986 subprocesses which the main thread should not reap. For example,
6987 if the main thread attempted to reap an already-reaped child, it
6988 might inadvertently reap a GTK-created process that happened to
6989 have the same process ID. */
6991 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6992 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6993 keep track of its own children. GNUstep is similar. */
6995 static void dummy_handler (int sig
) {}
6996 static signal_handler_t
volatile lib_child_handler
;
6998 /* Handle a SIGCHLD signal by looking for known child processes of
6999 Emacs whose status have changed. For each one found, record its
7002 All we do is change the status; we do not run sentinels or print
7003 notifications. That is saved for the next time keyboard input is
7004 done, in order to avoid timing errors.
7006 ** WARNING: this can be called during garbage collection.
7007 Therefore, it must not be fooled by the presence of mark bits in
7010 ** USG WARNING: Although it is not obvious from the documentation
7011 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7012 signal() before executing at least one wait(), otherwise the
7013 handler will be called again, resulting in an infinite loop. The
7014 relevant portion of the documentation reads "SIGCLD signals will be
7015 queued and the signal-catching function will be continually
7016 reentered until the queue is empty". Invoking signal() causes the
7017 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7020 ** Malloc WARNING: This should never call malloc either directly or
7021 indirectly; if it does, that is a bug. */
7024 handle_child_signal (int sig
)
7026 Lisp_Object tail
, proc
;
7028 /* Find the process that signaled us, and record its status. */
7030 /* The process can have been deleted by Fdelete_process, or have
7031 been started asynchronously by Fcall_process. */
7032 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
7034 bool all_pids_are_fixnums
7035 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
7036 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
7037 Lisp_Object head
= XCAR (tail
);
7042 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
7045 if (INTEGERP (xpid
))
7046 deleted_pid
= XINT (xpid
);
7048 deleted_pid
= XFLOAT_DATA (xpid
);
7049 if (child_status_changed (deleted_pid
, 0, 0))
7051 if (STRINGP (XCDR (head
)))
7052 unlink (SSDATA (XCDR (head
)));
7053 XSETCAR (tail
, Qnil
);
7058 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7059 FOR_EACH_PROCESS (tail
, proc
)
7061 struct Lisp_Process
*p
= XPROCESS (proc
);
7065 && child_status_changed (p
->pid
, &status
, WUNTRACED
| WCONTINUED
))
7067 /* Change the status of the process that was found. */
7068 p
->tick
= ++process_tick
;
7069 p
->raw_status
= status
;
7070 p
->raw_status_new
= 1;
7072 /* If process has terminated, stop waiting for its output. */
7073 if (WIFSIGNALED (status
) || WIFEXITED (status
))
7075 bool clear_desc_flag
= 0;
7078 clear_desc_flag
= 1;
7080 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7081 if (clear_desc_flag
)
7082 delete_read_fd (p
->infd
);
7087 lib_child_handler (sig
);
7088 #ifdef NS_IMPL_GNUSTEP
7089 /* NSTask in GNUstep sets its child handler each time it is called.
7090 So we must re-set ours. */
7091 catch_child_signal ();
7096 deliver_child_signal (int sig
)
7098 deliver_process_signal (sig
, handle_child_signal
);
7103 exec_sentinel_error_handler (Lisp_Object error_val
)
7105 /* Make sure error_val is a cons cell, as all the rest of error
7106 handling expects that, and will barf otherwise. */
7107 if (!CONSP (error_val
))
7108 error_val
= Fcons (Qerror
, error_val
);
7109 cmd_error_internal (error_val
, "error in process sentinel: ");
7111 update_echo_area ();
7112 Fsleep_for (make_number (2), Qnil
);
7117 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
7119 Lisp_Object sentinel
, odeactivate
;
7120 struct Lisp_Process
*p
= XPROCESS (proc
);
7121 ptrdiff_t count
= SPECPDL_INDEX ();
7122 bool outer_running_asynch_code
= running_asynch_code
;
7123 int waiting
= waiting_for_user_input_p
;
7125 if (inhibit_sentinels
)
7128 odeactivate
= Vdeactivate_mark
;
7130 Lisp_Object obuffer
, okeymap
;
7131 XSETBUFFER (obuffer
, current_buffer
);
7132 okeymap
= BVAR (current_buffer
, keymap
);
7135 /* There's no good reason to let sentinels change the current
7136 buffer, and many callers of accept-process-output, sit-for, and
7137 friends don't expect current-buffer to be changed from under them. */
7138 record_unwind_current_buffer ();
7140 sentinel
= p
->sentinel
;
7142 /* Inhibit quit so that random quits don't screw up a running filter. */
7143 specbind (Qinhibit_quit
, Qt
);
7144 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
7146 /* In case we get recursively called,
7147 and we already saved the match data nonrecursively,
7148 save the same match data in safely recursive fashion. */
7149 if (outer_running_asynch_code
)
7152 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
7153 restore_search_regs ();
7154 record_unwind_save_match_data ();
7155 Fset_match_data (tem
, Qt
);
7158 /* For speed, if a search happens within this code,
7159 save the match data in a special nonrecursive fashion. */
7160 running_asynch_code
= 1;
7162 internal_condition_case_1 (read_process_output_call
,
7163 list3 (sentinel
, proc
, reason
),
7164 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
7165 exec_sentinel_error_handler
);
7167 /* If we saved the match data nonrecursively, restore it now. */
7168 restore_search_regs ();
7169 running_asynch_code
= outer_running_asynch_code
;
7171 Vdeactivate_mark
= odeactivate
;
7173 /* Restore waiting_for_user_input_p as it was
7174 when we were called, in case the filter clobbered it. */
7175 waiting_for_user_input_p
= waiting
;
7178 if (! EQ (Fcurrent_buffer (), obuffer
)
7179 || ! EQ (current_buffer
->keymap
, okeymap
))
7181 /* But do it only if the caller is actually going to read events.
7182 Otherwise there's no need to make him wake up, and it could
7183 cause trouble (for example it would make sit_for return). */
7184 if (waiting_for_user_input_p
== -1)
7185 record_asynch_buffer_change ();
7187 unbind_to (count
, Qnil
);
7190 /* Report all recent events of a change in process status
7191 (either run the sentinel or output a message).
7192 This is usually done while Emacs is waiting for keyboard input
7193 but can be done at other times.
7195 Return positive if any input was received from WAIT_PROC (or from
7196 any process if WAIT_PROC is null), zero if input was attempted but
7197 none received, and negative if we didn't even try. */
7200 status_notify (struct Lisp_Process
*deleting_process
,
7201 struct Lisp_Process
*wait_proc
)
7204 Lisp_Object tail
, msg
;
7205 int got_some_output
= -1;
7210 /* Set this now, so that if new processes are created by sentinels
7211 that we run, we get called again to handle their status changes. */
7212 update_tick
= process_tick
;
7214 FOR_EACH_PROCESS (tail
, proc
)
7217 register struct Lisp_Process
*p
= XPROCESS (proc
);
7219 if (p
->tick
!= p
->update_tick
)
7221 p
->update_tick
= p
->tick
;
7223 /* If process is still active, read any output that remains. */
7224 while (! EQ (p
->filter
, Qt
)
7225 && ! connecting_status (p
->status
)
7226 && ! EQ (p
->status
, Qlisten
)
7227 /* Network or serial process not stopped: */
7228 && ! EQ (p
->command
, Qt
)
7230 && p
!= deleting_process
)
7232 int nread
= read_process_output (proc
, p
->infd
);
7233 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
7234 && got_some_output
< nread
)
7235 got_some_output
= nread
;
7240 /* Get the text to use for the message. */
7241 if (p
->raw_status_new
)
7243 msg
= status_message (p
);
7245 /* If process is terminated, deactivate it or delete it. */
7247 if (CONSP (p
->status
))
7248 symbol
= XCAR (p
->status
);
7250 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
7251 || EQ (symbol
, Qclosed
))
7253 if (delete_exited_processes
)
7254 remove_process (proc
);
7256 deactivate_process (proc
);
7259 /* The actions above may have further incremented p->tick.
7260 So set p->update_tick again so that an error in the sentinel will
7261 not cause this code to be run again. */
7262 p
->update_tick
= p
->tick
;
7263 /* Now output the message suitably. */
7264 exec_sentinel (proc
, msg
);
7265 if (BUFFERP (p
->buffer
))
7266 /* In case it uses %s in mode-line-format. */
7267 bset_update_mode_line (XBUFFER (p
->buffer
));
7271 return got_some_output
;
7274 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel
,
7275 Sinternal_default_process_sentinel
, 2, 2, 0,
7276 doc
: /* Function used as default sentinel for processes.
7277 This inserts a status message into the process's buffer, if there is one. */)
7278 (Lisp_Object proc
, Lisp_Object msg
)
7280 Lisp_Object buffer
, symbol
;
7281 struct Lisp_Process
*p
;
7282 CHECK_PROCESS (proc
);
7283 p
= XPROCESS (proc
);
7287 symbol
= XCAR (symbol
);
7289 if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
7292 struct buffer
*old
= current_buffer
;
7293 ptrdiff_t opoint
, opoint_byte
;
7294 ptrdiff_t before
, before_byte
;
7296 /* Avoid error if buffer is deleted
7297 (probably that's why the process is dead, too). */
7298 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
7300 Fset_buffer (buffer
);
7302 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
7303 msg
= (code_convert_string_norecord
7304 (msg
, Vlocale_coding_system
, 1));
7307 opoint_byte
= PT_BYTE
;
7308 /* Insert new output into buffer
7309 at the current end-of-output marker,
7310 thus preserving logical ordering of input and output. */
7311 if (XMARKER (p
->mark
)->buffer
)
7312 Fgoto_char (p
->mark
);
7314 SET_PT_BOTH (ZV
, ZV_BYTE
);
7317 before_byte
= PT_BYTE
;
7319 tem
= BVAR (current_buffer
, read_only
);
7320 bset_read_only (current_buffer
, Qnil
);
7321 insert_string ("\nProcess ");
7322 { /* FIXME: temporary kludge. */
7323 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
7324 insert_string (" ");
7326 bset_read_only (current_buffer
, tem
);
7327 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
7329 if (opoint
>= before
)
7330 SET_PT_BOTH (opoint
+ (PT
- before
),
7331 opoint_byte
+ (PT_BYTE
- before_byte
));
7333 SET_PT_BOTH (opoint
, opoint_byte
);
7335 set_buffer_internal (old
);
7341 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
7342 Sset_process_coding_system
, 1, 3, 0,
7343 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
7344 DECODING will be used to decode subprocess output and ENCODING to
7345 encode subprocess input. */)
7346 (Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
7348 CHECK_PROCESS (process
);
7350 struct Lisp_Process
*p
= XPROCESS (process
);
7352 Fcheck_coding_system (decoding
);
7353 Fcheck_coding_system (encoding
);
7354 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
7355 pset_decode_coding_system (p
, decoding
);
7356 pset_encode_coding_system (p
, encoding
);
7358 /* If the sockets haven't been set up yet, the final setup part of
7359 this will be called asynchronously. */
7360 if (p
->infd
< 0 || p
->outfd
< 0)
7363 setup_process_coding_systems (process
);
7368 DEFUN ("process-coding-system",
7369 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
7370 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7371 (register Lisp_Object process
)
7373 CHECK_PROCESS (process
);
7374 return Fcons (XPROCESS (process
)->decode_coding_system
,
7375 XPROCESS (process
)->encode_coding_system
);
7378 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
7379 Sset_process_filter_multibyte
, 2, 2, 0,
7380 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
7381 If FLAG is non-nil, the filter is given multibyte strings.
7382 If FLAG is nil, the filter is given unibyte strings. In this case,
7383 all character code conversion except for end-of-line conversion is
7385 (Lisp_Object process
, Lisp_Object flag
)
7387 CHECK_PROCESS (process
);
7389 struct Lisp_Process
*p
= XPROCESS (process
);
7391 pset_decode_coding_system
7392 (p
, raw_text_coding_system (p
->decode_coding_system
));
7394 /* If the sockets haven't been set up yet, the final setup part of
7395 this will be called asynchronously. */
7396 if (p
->infd
< 0 || p
->outfd
< 0)
7399 setup_process_coding_systems (process
);
7404 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
7405 Sprocess_filter_multibyte_p
, 1, 1, 0,
7406 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7407 (Lisp_Object process
)
7409 CHECK_PROCESS (process
);
7410 struct Lisp_Process
*p
= XPROCESS (process
);
7413 struct coding_system
*coding
= proc_decode_coding_system
[p
->infd
];
7414 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
7423 add_gpm_wait_descriptor (int desc
)
7425 add_keyboard_wait_descriptor (desc
);
7429 delete_gpm_wait_descriptor (int desc
)
7431 delete_keyboard_wait_descriptor (desc
);
7436 # ifdef USABLE_SIGIO
7438 /* Return true if *MASK has a bit set
7439 that corresponds to one of the keyboard input descriptors. */
7442 keyboard_bit_set (fd_set
*mask
)
7446 for (fd
= 0; fd
<= max_desc
; fd
++)
7447 if (FD_ISSET (fd
, mask
)
7448 && ((fd_callback_info
[fd
].flags
& (FOR_READ
| KEYBOARD_FD
))
7449 == (FOR_READ
| KEYBOARD_FD
)))
7456 #else /* not subprocesses */
7458 /* Defined in msdos.c. */
7459 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
7460 struct timespec
*, void *);
7462 /* Implementation of wait_reading_process_output, assuming that there
7463 are no subprocesses. Used only by the MS-DOS build.
7465 Wait for timeout to elapse and/or keyboard input to be available.
7469 If negative, gobble data immediately available but don't wait for any.
7472 an additional duration to wait, measured in nanoseconds
7473 If TIME_LIMIT is zero, then:
7474 If NSECS == 0, there is no limit.
7475 If NSECS > 0, the timeout consists of NSECS only.
7476 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7479 0 to ignore keyboard input, or
7480 1 to return when input is available, or
7481 -1 means caller will actually read the input, so don't throw to
7484 see full version for other parameters. We know that wait_proc will
7485 always be NULL, since `subprocesses' isn't defined.
7487 DO_DISPLAY means redisplay should be done to show subprocess
7488 output that arrives.
7490 Return -1 signifying we got no output and did not try. */
7493 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
7495 Lisp_Object wait_for_cell
,
7496 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
7499 struct timespec end_time
, timeout
;
7500 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
7502 if (TYPE_MAXIMUM (time_t) < time_limit
)
7503 time_limit
= TYPE_MAXIMUM (time_t);
7505 if (time_limit
< 0 || nsecs
< 0)
7507 else if (time_limit
> 0 || nsecs
> 0)
7510 end_time
= timespec_add (current_timespec (),
7511 make_timespec (time_limit
, nsecs
));
7516 /* Turn off periodic alarms (in case they are in use)
7517 and then turn off any other atimers,
7518 because the select emulator uses alarms. */
7520 turn_on_atimers (0);
7524 bool timeout_reduced_for_timers
= false;
7525 fd_set waitchannels
;
7528 /* If calling from keyboard input, do not quit
7529 since we want to return C-g as an input character.
7530 Otherwise, do pending quit if requested. */
7534 /* Exit now if the cell we're waiting for became non-nil. */
7535 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7538 /* Compute time from now till when time limit is up. */
7539 /* Exit if already run out. */
7540 if (wait
== TIMEOUT
)
7542 struct timespec now
= current_timespec ();
7543 if (timespec_cmp (end_time
, now
) <= 0)
7545 timeout
= timespec_sub (end_time
, now
);
7548 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
7550 /* If our caller will not immediately handle keyboard events,
7551 run timer events directly.
7552 (Callers that will immediately read keyboard events
7553 call timer_delay on their own.) */
7554 if (NILP (wait_for_cell
))
7556 struct timespec timer_delay
;
7560 unsigned old_timers_run
= timers_run
;
7561 timer_delay
= timer_check ();
7562 if (timers_run
!= old_timers_run
&& do_display
)
7563 /* We must retry, since a timer may have requeued itself
7564 and that could alter the time delay. */
7565 redisplay_preserve_echo_area (14);
7569 while (!detect_input_pending ());
7571 /* If there is unread keyboard input, also return. */
7573 && requeued_events_pending_p ())
7576 if (timespec_valid_p (timer_delay
))
7578 if (timespec_cmp (timer_delay
, timeout
) < 0)
7580 timeout
= timer_delay
;
7581 timeout_reduced_for_timers
= true;
7586 /* Cause C-g and alarm signals to take immediate action,
7587 and cause input available signals to zero out timeout. */
7589 set_waiting_for_input (&timeout
);
7591 /* If a frame has been newly mapped and needs updating,
7592 reprocess its display stuff. */
7593 if (frame_garbaged
&& do_display
)
7595 clear_waiting_for_input ();
7596 redisplay_preserve_echo_area (15);
7598 set_waiting_for_input (&timeout
);
7601 /* Wait till there is something to do. */
7602 FD_ZERO (&waitchannels
);
7603 if (read_kbd
&& detect_input_pending ())
7607 if (read_kbd
|| !NILP (wait_for_cell
))
7608 FD_SET (0, &waitchannels
);
7609 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
7614 /* Make C-g and alarm signals set flags again. */
7615 clear_waiting_for_input ();
7617 /* If we woke up due to SIGWINCH, actually change size now. */
7618 do_pending_window_change (0);
7620 if (wait
< INFINITY
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7621 /* We waited the full specified time, so return now. */
7626 /* If the system call was interrupted, then go around the
7628 if (xerrno
== EINTR
)
7629 FD_ZERO (&waitchannels
);
7631 report_file_errno ("Failed select", Qnil
, xerrno
);
7634 /* Check for keyboard input. */
7637 && detect_input_pending_run_timers (do_display
))
7639 swallow_events (do_display
);
7640 if (detect_input_pending_run_timers (do_display
))
7644 /* If there is unread keyboard input, also return. */
7646 && requeued_events_pending_p ())
7649 /* If wait_for_cell. check for keyboard input
7650 but don't run any timers.
7651 ??? (It seems wrong to me to check for keyboard
7652 input at all when wait_for_cell, but the code
7653 has been this way since July 1994.
7654 Try changing this after version 19.31.) */
7655 if (! NILP (wait_for_cell
)
7656 && detect_input_pending ())
7658 swallow_events (do_display
);
7659 if (detect_input_pending ())
7663 /* Exit now if the cell we're waiting for became non-nil. */
7664 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7673 #endif /* not subprocesses */
7675 /* The following functions are needed even if async subprocesses are
7676 not supported. Some of them are no-op stubs in that case. */
7680 /* Add FD, which is a descriptor returned by timerfd_create,
7681 to the set of non-keyboard input descriptors. */
7684 add_timer_wait_descriptor (int fd
)
7686 add_read_fd (fd
, timerfd_callback
, NULL
);
7687 fd_callback_info
[fd
].flags
&= ~KEYBOARD_FD
;
7690 #endif /* HAVE_TIMERFD */
7692 /* If program file NAME starts with /: for quoting a magic
7693 name, remove that, preserving the multibyteness of NAME. */
7696 remove_slash_colon (Lisp_Object name
)
7699 (SREF (name
, 0) == '/' && SREF (name
, 1) == ':'
7700 ? make_specified_string (SSDATA (name
) + 2, SCHARS (name
) - 2,
7701 SBYTES (name
) - 2, STRING_MULTIBYTE (name
))
7705 /* Add DESC to the set of keyboard input descriptors. */
7708 add_keyboard_wait_descriptor (int desc
)
7710 #ifdef subprocesses /* Actually means "not MSDOS". */
7711 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7712 fd_callback_info
[desc
].flags
&= ~PROCESS_FD
;
7713 fd_callback_info
[desc
].flags
|= (FOR_READ
| KEYBOARD_FD
);
7714 if (desc
> max_desc
)
7719 /* From now on, do not expect DESC to give keyboard input. */
7722 delete_keyboard_wait_descriptor (int desc
)
7725 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7727 fd_callback_info
[desc
].flags
&= ~(FOR_READ
| KEYBOARD_FD
| PROCESS_FD
);
7729 if (desc
== max_desc
)
7730 recompute_max_desc ();
7734 /* Setup coding systems of PROCESS. */
7737 setup_process_coding_systems (Lisp_Object process
)
7740 struct Lisp_Process
*p
= XPROCESS (process
);
7742 int outch
= p
->outfd
;
7743 Lisp_Object coding_system
;
7745 if (inch
< 0 || outch
< 0)
7748 if (!proc_decode_coding_system
[inch
])
7749 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7750 coding_system
= p
->decode_coding_system
;
7751 if (EQ (p
->filter
, Qinternal_default_process_filter
)
7752 && BUFFERP (p
->buffer
))
7754 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7755 coding_system
= raw_text_coding_system (coding_system
);
7757 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7759 if (!proc_encode_coding_system
[outch
])
7760 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7761 setup_coding_system (p
->encode_coding_system
,
7762 proc_encode_coding_system
[outch
]);
7766 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7767 doc
: /* Return the (or a) live process associated with BUFFER.
7768 BUFFER may be a buffer or the name of one.
7769 Return nil if all processes associated with BUFFER have been
7770 deleted or killed. */)
7771 (register Lisp_Object buffer
)
7774 register Lisp_Object buf
, tail
, proc
;
7776 if (NILP (buffer
)) return Qnil
;
7777 buf
= Fget_buffer (buffer
);
7778 if (NILP (buf
)) return Qnil
;
7780 FOR_EACH_PROCESS (tail
, proc
)
7781 if (EQ (XPROCESS (proc
)->buffer
, buf
))
7783 #endif /* subprocesses */
7787 DEFUN ("process-inherit-coding-system-flag",
7788 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7790 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7791 If this flag is t, `buffer-file-coding-system' of the buffer
7792 associated with PROCESS will inherit the coding system used to decode
7793 the process output. */)
7794 (register Lisp_Object process
)
7797 CHECK_PROCESS (process
);
7798 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7800 /* Ignore the argument and return the value of
7801 inherit-process-coding-system. */
7802 return inherit_process_coding_system
? Qt
: Qnil
;
7806 /* Kill all processes associated with `buffer'.
7807 If `buffer' is nil, kill all processes. */
7810 kill_buffer_processes (Lisp_Object buffer
)
7813 Lisp_Object tail
, proc
;
7815 FOR_EACH_PROCESS (tail
, proc
)
7816 if (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
))
7818 if (NETCONN_P (proc
) || SERIALCONN_P (proc
) || PIPECONN_P (proc
))
7819 Fdelete_process (proc
);
7820 else if (XPROCESS (proc
)->infd
>= 0)
7821 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7823 #else /* subprocesses */
7824 /* Since we have no subprocesses, this does nothing. */
7825 #endif /* subprocesses */
7828 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7829 Swaiting_for_user_input_p
, 0, 0, 0,
7830 doc
: /* Return non-nil if Emacs is waiting for input from the user.
7831 This is intended for use by asynchronous process output filters and sentinels. */)
7835 return (waiting_for_user_input_p
? Qt
: Qnil
);
7841 /* Stop reading input from keyboard sources. */
7844 hold_keyboard_input (void)
7849 /* Resume reading input from keyboard sources. */
7852 unhold_keyboard_input (void)
7857 /* Return true if keyboard input is on hold, zero otherwise. */
7860 kbd_on_hold_p (void)
7862 return kbd_is_on_hold
;
7866 /* Enumeration of and access to system processes a-la ps(1). */
7868 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7870 doc
: /* Return a list of numerical process IDs of all running processes.
7871 If this functionality is unsupported, return nil.
7873 See `process-attributes' for getting attributes of a process given its ID. */)
7876 return list_system_processes ();
7879 DEFUN ("process-attributes", Fprocess_attributes
,
7880 Sprocess_attributes
, 1, 1, 0,
7881 doc
: /* Return attributes of the process given by its PID, a number.
7883 Value is an alist where each element is a cons cell of the form
7887 If this functionality is unsupported, the value is nil.
7889 See `list-system-processes' for getting a list of all process IDs.
7891 The KEYs of the attributes that this function may return are listed
7892 below, together with the type of the associated VALUE (in parentheses).
7893 Not all platforms support all of these attributes; unsupported
7894 attributes will not appear in the returned alist.
7895 Unless explicitly indicated otherwise, numbers can have either
7896 integer or floating point values.
7898 euid -- Effective user User ID of the process (number)
7899 user -- User name corresponding to euid (string)
7900 egid -- Effective user Group ID of the process (number)
7901 group -- Group name corresponding to egid (string)
7902 comm -- Command name (executable name only) (string)
7903 state -- Process state code, such as "S", "R", or "T" (string)
7904 ppid -- Parent process ID (number)
7905 pgrp -- Process group ID (number)
7906 sess -- Session ID, i.e. process ID of session leader (number)
7907 ttname -- Controlling tty name (string)
7908 tpgid -- ID of foreground process group on the process's tty (number)
7909 minflt -- number of minor page faults (number)
7910 majflt -- number of major page faults (number)
7911 cminflt -- cumulative number of minor page faults (number)
7912 cmajflt -- cumulative number of major page faults (number)
7913 utime -- user time used by the process, in (current-time) format,
7914 which is a list of integers (HIGH LOW USEC PSEC)
7915 stime -- system time used by the process (current-time)
7916 time -- sum of utime and stime (current-time)
7917 cutime -- user time used by the process and its children (current-time)
7918 cstime -- system time used by the process and its children (current-time)
7919 ctime -- sum of cutime and cstime (current-time)
7920 pri -- priority of the process (number)
7921 nice -- nice value of the process (number)
7922 thcount -- process thread count (number)
7923 start -- time the process started (current-time)
7924 vsize -- virtual memory size of the process in KB's (number)
7925 rss -- resident set size of the process in KB's (number)
7926 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7927 pcpu -- percents of CPU time used by the process (floating-point number)
7928 pmem -- percents of total physical memory used by process's resident set
7929 (floating-point number)
7930 args -- command line which invoked the process (string). */)
7933 return system_process_attributes (pid
);
7937 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7938 Invoke this after init_process_emacs, and after glib and/or GNUstep
7939 futz with the SIGCHLD handler, but before Emacs forks any children.
7940 This function's caller should block SIGCHLD. */
7943 catch_child_signal (void)
7945 struct sigaction action
, old_action
;
7947 emacs_sigaction_init (&action
, deliver_child_signal
);
7948 block_child_signal (&oldset
);
7949 sigaction (SIGCHLD
, &action
, &old_action
);
7950 eassert (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7951 || ! (old_action
.sa_flags
& SA_SIGINFO
));
7953 if (old_action
.sa_handler
!= deliver_child_signal
)
7955 = (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7957 : old_action
.sa_handler
);
7958 unblock_child_signal (&oldset
);
7960 #endif /* subprocesses */
7962 /* Limit the number of open files to the value it had at startup. */
7965 restore_nofile_limit (void)
7967 #ifdef HAVE_SETRLIMIT
7968 if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
7969 setrlimit (RLIMIT_NOFILE
, &nofile_limit
);
7974 /* This is not called "init_process" because that is the name of a
7975 Mach system call, so it would cause problems on Darwin systems. */
7977 init_process_emacs (int sockfd
)
7982 inhibit_sentinels
= 0;
7985 if (! noninteractive
|| initialized
)
7988 #if defined HAVE_GLIB && !defined WINDOWSNT
7989 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7990 this should always fail, but is enough to initialize glib's
7991 private SIGCHLD handler, allowing catch_child_signal to copy
7992 it into lib_child_handler. */
7993 g_source_unref (g_child_watch_source_new (getpid ()));
7995 catch_child_signal ();
7998 #ifdef HAVE_SETRLIMIT
7999 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8000 if (getrlimit (RLIMIT_NOFILE
, &nofile_limit
) != 0)
8001 nofile_limit
.rlim_cur
= 0;
8002 else if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
8004 struct rlimit rlim
= nofile_limit
;
8005 rlim
.rlim_cur
= FD_SETSIZE
;
8006 if (setrlimit (RLIMIT_NOFILE
, &rlim
) != 0)
8007 nofile_limit
.rlim_cur
= 0;
8011 external_sock_fd
= sockfd
;
8013 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
8015 num_pending_connects
= 0;
8017 process_output_delay_count
= 0;
8018 process_output_skip
= 0;
8020 /* Don't do this, it caused infinite select loops. The display
8021 method should call add_keyboard_wait_descriptor on stdin if it
8024 FD_SET (0, &input_wait_mask
);
8027 Vprocess_alist
= Qnil
;
8028 deleted_pid_list
= Qnil
;
8029 for (i
= 0; i
< FD_SETSIZE
; i
++)
8031 chan_process
[i
] = Qnil
;
8032 proc_buffered_char
[i
] = -1;
8034 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
8035 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
8036 #ifdef DATAGRAM_SOCKETS
8037 memset (datagram_address
, 0, sizeof datagram_address
);
8040 #if defined (DARWIN_OS)
8041 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8042 processes. As such, we only change the default value. */
8045 char const *release
= (STRINGP (Voperating_system_release
)
8046 ? SSDATA (Voperating_system_release
)
8048 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
8049 Vprocess_connection_type
= Qnil
;
8053 #endif /* subprocesses */
8058 syms_of_process (void)
8062 DEFSYM (Qprocessp
, "processp");
8063 DEFSYM (Qrun
, "run");
8064 DEFSYM (Qstop
, "stop");
8065 DEFSYM (Qsignal
, "signal");
8067 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8070 DEFSYM (Qopen
, "open");
8071 DEFSYM (Qclosed
, "closed");
8072 DEFSYM (Qconnect
, "connect");
8073 DEFSYM (Qfailed
, "failed");
8074 DEFSYM (Qlisten
, "listen");
8075 DEFSYM (Qlocal
, "local");
8076 DEFSYM (Qipv4
, "ipv4");
8078 DEFSYM (Qipv6
, "ipv6");
8080 DEFSYM (Qdatagram
, "datagram");
8081 DEFSYM (Qseqpacket
, "seqpacket");
8083 DEFSYM (QCport
, ":port");
8084 DEFSYM (QCspeed
, ":speed");
8085 DEFSYM (QCprocess
, ":process");
8087 DEFSYM (QCbytesize
, ":bytesize");
8088 DEFSYM (QCstopbits
, ":stopbits");
8089 DEFSYM (QCparity
, ":parity");
8090 DEFSYM (Qodd
, "odd");
8091 DEFSYM (Qeven
, "even");
8092 DEFSYM (QCflowcontrol
, ":flowcontrol");
8095 DEFSYM (QCsummary
, ":summary");
8097 DEFSYM (Qreal
, "real");
8098 DEFSYM (Qnetwork
, "network");
8099 DEFSYM (Qserial
, "serial");
8100 DEFSYM (Qpipe
, "pipe");
8101 DEFSYM (QCbuffer
, ":buffer");
8102 DEFSYM (QChost
, ":host");
8103 DEFSYM (QCservice
, ":service");
8104 DEFSYM (QClocal
, ":local");
8105 DEFSYM (QCremote
, ":remote");
8106 DEFSYM (QCcoding
, ":coding");
8107 DEFSYM (QCserver
, ":server");
8108 DEFSYM (QCnowait
, ":nowait");
8109 DEFSYM (QCsentinel
, ":sentinel");
8110 DEFSYM (QCuse_external_socket
, ":use-external-socket");
8111 DEFSYM (QCtls_parameters
, ":tls-parameters");
8112 DEFSYM (Qnsm_verify_connection
, "nsm-verify-connection");
8113 DEFSYM (QClog
, ":log");
8114 DEFSYM (QCnoquery
, ":noquery");
8115 DEFSYM (QCstop
, ":stop");
8116 DEFSYM (QCplist
, ":plist");
8117 DEFSYM (QCcommand
, ":command");
8118 DEFSYM (QCconnection_type
, ":connection-type");
8119 DEFSYM (QCstderr
, ":stderr");
8120 DEFSYM (Qpty
, "pty");
8121 DEFSYM (Qpipe
, "pipe");
8123 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
8125 staticpro (&Vprocess_alist
);
8126 staticpro (&deleted_pid_list
);
8128 #endif /* subprocesses */
8130 DEFSYM (QCname
, ":name");
8131 DEFSYM (QCtype
, ":type");
8133 DEFSYM (Qeuid
, "euid");
8134 DEFSYM (Qegid
, "egid");
8135 DEFSYM (Quser
, "user");
8136 DEFSYM (Qgroup
, "group");
8137 DEFSYM (Qcomm
, "comm");
8138 DEFSYM (Qstate
, "state");
8139 DEFSYM (Qppid
, "ppid");
8140 DEFSYM (Qpgrp
, "pgrp");
8141 DEFSYM (Qsess
, "sess");
8142 DEFSYM (Qttname
, "ttname");
8143 DEFSYM (Qtpgid
, "tpgid");
8144 DEFSYM (Qminflt
, "minflt");
8145 DEFSYM (Qmajflt
, "majflt");
8146 DEFSYM (Qcminflt
, "cminflt");
8147 DEFSYM (Qcmajflt
, "cmajflt");
8148 DEFSYM (Qutime
, "utime");
8149 DEFSYM (Qstime
, "stime");
8150 DEFSYM (Qtime
, "time");
8151 DEFSYM (Qcutime
, "cutime");
8152 DEFSYM (Qcstime
, "cstime");
8153 DEFSYM (Qctime
, "ctime");
8155 DEFSYM (Qinternal_default_process_sentinel
,
8156 "internal-default-process-sentinel");
8157 DEFSYM (Qinternal_default_process_filter
,
8158 "internal-default-process-filter");
8160 DEFSYM (Qpri
, "pri");
8161 DEFSYM (Qnice
, "nice");
8162 DEFSYM (Qthcount
, "thcount");
8163 DEFSYM (Qstart
, "start");
8164 DEFSYM (Qvsize
, "vsize");
8165 DEFSYM (Qrss
, "rss");
8166 DEFSYM (Qetime
, "etime");
8167 DEFSYM (Qpcpu
, "pcpu");
8168 DEFSYM (Qpmem
, "pmem");
8169 DEFSYM (Qargs
, "args");
8171 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
8172 doc
: /* Non-nil means delete processes immediately when they exit.
8173 A value of nil means don't delete them until `list-processes' is run. */);
8175 delete_exited_processes
= 1;
8178 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
8179 doc
: /* Control type of device used to communicate with subprocesses.
8180 Values are nil to use a pipe, or t or `pty' to use a pty.
8181 The value has no effect if the system has no ptys or if all ptys are busy:
8182 then a pipe is used in any case.
8183 The value takes effect when `start-process' is called. */);
8184 Vprocess_connection_type
= Qt
;
8186 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
8187 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
8188 On some systems, when Emacs reads the output from a subprocess, the output data
8189 is read in very small blocks, potentially resulting in very poor performance.
8190 This behavior can be remedied to some extent by setting this variable to a
8191 non-nil value, as it will automatically delay reading from such processes, to
8192 allow them to produce more output before Emacs tries to read it.
8193 If the value is t, the delay is reset after each write to the process; any other
8194 non-nil value means that the delay is not reset on write.
8195 The variable takes effect when `start-process' is called. */);
8196 Vprocess_adaptive_read_buffering
= Qt
;
8198 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions
,
8199 doc
: /* List of functions to be called for `interrupt-process'.
8200 The arguments of the functions are the same as for `interrupt-process'.
8201 These functions are called in the order of the list, until one of them
8202 returns non-`nil'. */);
8203 Vinterrupt_process_functions
= list1 (Qinternal_default_interrupt_process
);
8205 DEFSYM (Qinternal_default_interrupt_process
,
8206 "internal-default-interrupt-process");
8207 DEFSYM (Qinterrupt_process_functions
, "interrupt-process-functions");
8209 defsubr (&Sprocessp
);
8210 defsubr (&Sget_process
);
8211 defsubr (&Sdelete_process
);
8212 defsubr (&Sprocess_status
);
8213 defsubr (&Sprocess_exit_status
);
8214 defsubr (&Sprocess_id
);
8215 defsubr (&Sprocess_name
);
8216 defsubr (&Sprocess_tty_name
);
8217 defsubr (&Sprocess_command
);
8218 defsubr (&Sset_process_buffer
);
8219 defsubr (&Sprocess_buffer
);
8220 defsubr (&Sprocess_mark
);
8221 defsubr (&Sset_process_filter
);
8222 defsubr (&Sprocess_filter
);
8223 defsubr (&Sset_process_sentinel
);
8224 defsubr (&Sprocess_sentinel
);
8225 defsubr (&Sset_process_thread
);
8226 defsubr (&Sprocess_thread
);
8227 defsubr (&Sset_process_window_size
);
8228 defsubr (&Sset_process_inherit_coding_system_flag
);
8229 defsubr (&Sset_process_query_on_exit_flag
);
8230 defsubr (&Sprocess_query_on_exit_flag
);
8231 defsubr (&Sprocess_contact
);
8232 defsubr (&Sprocess_plist
);
8233 defsubr (&Sset_process_plist
);
8234 defsubr (&Sprocess_list
);
8235 defsubr (&Smake_process
);
8236 defsubr (&Smake_pipe_process
);
8237 defsubr (&Sserial_process_configure
);
8238 defsubr (&Smake_serial_process
);
8239 defsubr (&Sset_network_process_option
);
8240 defsubr (&Smake_network_process
);
8241 defsubr (&Sformat_network_address
);
8242 defsubr (&Snetwork_interface_list
);
8243 defsubr (&Snetwork_interface_info
);
8244 #ifdef DATAGRAM_SOCKETS
8245 defsubr (&Sprocess_datagram_address
);
8246 defsubr (&Sset_process_datagram_address
);
8248 defsubr (&Saccept_process_output
);
8249 defsubr (&Sprocess_send_region
);
8250 defsubr (&Sprocess_send_string
);
8251 defsubr (&Sinternal_default_interrupt_process
);
8252 defsubr (&Sinterrupt_process
);
8253 defsubr (&Skill_process
);
8254 defsubr (&Squit_process
);
8255 defsubr (&Sstop_process
);
8256 defsubr (&Scontinue_process
);
8257 defsubr (&Sprocess_running_child_p
);
8258 defsubr (&Sprocess_send_eof
);
8259 defsubr (&Ssignal_process
);
8260 defsubr (&Swaiting_for_user_input_p
);
8261 defsubr (&Sprocess_type
);
8262 defsubr (&Sinternal_default_process_sentinel
);
8263 defsubr (&Sinternal_default_process_filter
);
8264 defsubr (&Sset_process_coding_system
);
8265 defsubr (&Sprocess_coding_system
);
8266 defsubr (&Sset_process_filter_multibyte
);
8267 defsubr (&Sprocess_filter_multibyte_p
);
8270 Lisp_Object subfeatures
= Qnil
;
8271 const struct socket_options
*sopt
;
8273 #define ADD_SUBFEATURE(key, val) \
8274 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8276 ADD_SUBFEATURE (QCnowait
, Qt
);
8277 #ifdef DATAGRAM_SOCKETS
8278 ADD_SUBFEATURE (QCtype
, Qdatagram
);
8280 #ifdef HAVE_SEQPACKET
8281 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
8283 #ifdef HAVE_LOCAL_SOCKETS
8284 ADD_SUBFEATURE (QCfamily
, Qlocal
);
8286 ADD_SUBFEATURE (QCfamily
, Qipv4
);
8288 ADD_SUBFEATURE (QCfamily
, Qipv6
);
8290 #ifdef HAVE_GETSOCKNAME
8291 ADD_SUBFEATURE (QCservice
, Qt
);
8293 ADD_SUBFEATURE (QCserver
, Qt
);
8295 for (sopt
= socket_options
; sopt
->name
; sopt
++)
8296 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
8298 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
8301 #endif /* subprocesses */
8303 defsubr (&Sget_buffer_process
);
8304 defsubr (&Sprocess_inherit_coding_system_flag
);
8305 defsubr (&Slist_system_processes
);
8306 defsubr (&Sprocess_attributes
);