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 <http://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 <http://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
));
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 #else /* !HAVE_GLIB */
5375 nfds
= thread_select (
5383 (check_write
? &Writeok
: 0),
5384 NULL
, &timeout
, NULL
);
5385 #endif /* !HAVE_GLIB */
5388 /* GnuTLS buffers data internally. In lowat mode it leaves
5389 some data in the TCP buffers so that select works, but
5390 with custom pull/push functions we need to check if some
5391 data is available in the buffers manually. */
5394 fd_set tls_available
;
5397 FD_ZERO (&tls_available
);
5400 /* We're not waiting on a specific process, so loop
5401 through all the channels and check for data.
5402 This is a workaround needed for some versions of
5403 the gnutls library -- 2.12.14 has been confirmed
5405 http://comments.gmane.org/gmane.emacs.devel/145074 */
5406 for (channel
= 0; channel
< FD_SETSIZE
; ++channel
)
5407 if (! NILP (chan_process
[channel
]))
5409 struct Lisp_Process
*p
=
5410 XPROCESS (chan_process
[channel
]);
5411 if (p
&& p
->gnutls_p
&& p
->gnutls_state
5412 && ((emacs_gnutls_record_check_pending
5417 eassert (p
->infd
== channel
);
5418 FD_SET (p
->infd
, &tls_available
);
5425 /* Check this specific channel. */
5426 if (wait_proc
->gnutls_p
/* Check for valid process. */
5427 && wait_proc
->gnutls_state
5428 /* Do we have pending data? */
5429 && ((emacs_gnutls_record_check_pending
5430 (wait_proc
->gnutls_state
))
5434 eassert (0 <= wait_proc
->infd
);
5435 /* Set to Available. */
5436 FD_SET (wait_proc
->infd
, &tls_available
);
5441 Available
= tls_available
;
5448 /* Make C-g and alarm signals set flags again. */
5449 clear_waiting_for_input ();
5451 /* If we woke up due to SIGWINCH, actually change size now. */
5452 do_pending_window_change (0);
5456 /* Exit the main loop if we've passed the requested timeout,
5457 or aren't skipping processes and got some output and
5458 haven't lowered our timeout due to timers or SIGIO and
5459 have waited a long amount of time due to repeated
5461 struct timespec huge_timespec
5462 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION
);
5463 struct timespec cmp_time
= huge_timespec
;
5466 if (wait
== TIMEOUT
)
5467 cmp_time
= end_time
;
5468 if (!process_skipped
&& got_some_output
> 0
5469 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0))
5471 if (!timespec_valid_p (got_output_end_time
))
5473 if (timespec_cmp (got_output_end_time
, cmp_time
) < 0)
5474 cmp_time
= got_output_end_time
;
5476 if (timespec_cmp (cmp_time
, huge_timespec
) < 0)
5478 now
= current_timespec ();
5479 if (timespec_cmp (cmp_time
, now
) <= 0)
5486 if (xerrno
== EINTR
)
5488 else if (xerrno
== EBADF
)
5491 report_file_errno ("Failed select", Qnil
, xerrno
);
5494 /* Check for keyboard input. */
5495 /* If there is any, return immediately
5496 to give it higher priority than subprocesses. */
5500 unsigned old_timers_run
= timers_run
;
5501 struct buffer
*old_buffer
= current_buffer
;
5502 Lisp_Object old_window
= selected_window
;
5505 if (detect_input_pending_run_timers (do_display
))
5507 swallow_events (do_display
);
5508 if (detect_input_pending_run_timers (do_display
))
5512 /* If a timer has run, this might have changed buffers
5513 an alike. Make read_key_sequence aware of that. */
5514 if (timers_run
!= old_timers_run
5515 && waiting_for_user_input_p
== -1
5516 && (old_buffer
!= current_buffer
5517 || !EQ (old_window
, selected_window
)))
5518 record_asynch_buffer_change ();
5524 /* If there is unread keyboard input, also return. */
5526 && requeued_events_pending_p ())
5529 /* If we are not checking for keyboard input now,
5530 do process events (but don't run any timers).
5531 This is so that X events will be processed.
5532 Otherwise they may have to wait until polling takes place.
5533 That would causes delays in pasting selections, for example.
5535 (We used to do this only if wait_for_cell.) */
5536 if (read_kbd
== 0 && detect_input_pending ())
5538 swallow_events (do_display
);
5539 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5540 if (detect_input_pending ())
5545 /* Exit now if the cell we're waiting for became non-nil. */
5546 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5550 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5551 go read it. This can happen with X on BSD after logging out.
5552 In that case, there really is no input and no SIGIO,
5553 but select says there is input. */
5555 if (read_kbd
&& interrupt_input
5556 && keyboard_bit_set (&Available
) && ! noninteractive
)
5557 handle_input_available_signal (SIGIO
);
5560 /* If checking input just got us a size-change event from X,
5561 obey it now if we should. */
5562 if (read_kbd
|| ! NILP (wait_for_cell
))
5563 do_pending_window_change (0);
5565 /* Check for data from a process. */
5566 if (no_avail
|| nfds
== 0)
5569 for (channel
= 0; channel
<= max_desc
; ++channel
)
5571 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
5573 && ((d
->flags
& FOR_READ
5574 && FD_ISSET (channel
, &Available
))
5575 || ((d
->flags
& FOR_WRITE
)
5576 && FD_ISSET (channel
, &Writeok
))))
5577 d
->func (channel
, d
->data
);
5580 for (channel
= 0; channel
<= max_desc
; channel
++)
5582 if (FD_ISSET (channel
, &Available
)
5583 && ((fd_callback_info
[channel
].flags
& (KEYBOARD_FD
| PROCESS_FD
))
5588 /* If waiting for this channel, arrange to return as
5589 soon as no more input to be processed. No more
5591 proc
= chan_process
[channel
];
5595 /* If this is a server stream socket, accept connection. */
5596 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
5598 server_accept_connection (proc
, channel
);
5602 /* Read data from the process, starting with our
5603 buffered-ahead character if we have one. */
5605 nread
= read_process_output (proc
, channel
);
5606 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
5607 && got_some_output
< nread
)
5608 got_some_output
= nread
;
5611 /* Vacuum up any leftovers without waiting. */
5612 if (wait_proc
== XPROCESS (proc
))
5614 /* Since read_process_output can run a filter,
5615 which can call accept-process-output,
5616 don't try to read from any other processes
5617 before doing the select again. */
5618 FD_ZERO (&Available
);
5621 redisplay_preserve_echo_area (12);
5623 else if (nread
== -1 && would_block (errno
))
5626 /* FIXME: Is this special case still needed? */
5627 /* Note that we cannot distinguish between no input
5628 available now and a closed pipe.
5629 With luck, a closed pipe will be accompanied by
5630 subprocess termination and SIGCHLD. */
5631 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5632 && !PIPECONN_P (proc
))
5636 /* On some OSs with ptys, when the process on one end of
5637 a pty exits, the other end gets an error reading with
5638 errno = EIO instead of getting an EOF (0 bytes read).
5639 Therefore, if we get an error reading and errno =
5640 EIO, just continue, because the child process has
5641 exited and should clean itself up soon (e.g. when we
5643 else if (nread
== -1 && errno
== EIO
)
5645 struct Lisp_Process
*p
= XPROCESS (proc
);
5647 /* Clear the descriptor now, so we only raise the
5649 delete_read_fd (channel
);
5653 /* If the EIO occurs on a pty, the SIGCHLD handler's
5654 waitpid call will not find the process object to
5655 delete. Do it here. */
5656 p
->tick
= ++process_tick
;
5657 pset_status (p
, Qfailed
);
5660 #endif /* HAVE_PTYS */
5661 /* If we can detect process termination, don't consider the
5662 process gone just because its pipe is closed. */
5663 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5664 && !PIPECONN_P (proc
))
5666 else if (nread
== 0 && PIPECONN_P (proc
))
5668 /* Preserve status of processes already terminated. */
5669 XPROCESS (proc
)->tick
= ++process_tick
;
5670 deactivate_process (proc
);
5671 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5672 pset_status (XPROCESS (proc
),
5673 list2 (Qexit
, make_number (0)));
5677 /* Preserve status of processes already terminated. */
5678 XPROCESS (proc
)->tick
= ++process_tick
;
5679 deactivate_process (proc
);
5680 if (XPROCESS (proc
)->raw_status_new
)
5681 update_status (XPROCESS (proc
));
5682 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5683 pset_status (XPROCESS (proc
),
5684 list2 (Qexit
, make_number (256)));
5687 if (FD_ISSET (channel
, &Writeok
)
5688 && (fd_callback_info
[channel
].flags
5689 & NON_BLOCKING_CONNECT_FD
) != 0)
5691 struct Lisp_Process
*p
;
5693 delete_write_fd (channel
);
5695 proc
= chan_process
[channel
];
5699 p
= XPROCESS (proc
);
5703 socklen_t xlen
= sizeof (xerrno
);
5704 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5708 /* On MS-Windows, getsockopt clears the error for the
5709 entire process, which may not be the right thing; see
5710 w32.c. Use getpeername instead. */
5712 struct sockaddr pname
;
5713 socklen_t pnamelen
= sizeof (pname
);
5715 /* If connection failed, getpeername will fail. */
5717 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5719 /* Obtain connect failure code through error slippage. */
5722 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5729 Lisp_Object addrinfos
5730 = connecting_status (p
->status
) ? XCDR (p
->status
) : Qnil
;
5731 if (!NILP (addrinfos
))
5732 XSETCDR (p
->status
, XCDR (addrinfos
));
5735 p
->tick
= ++process_tick
;
5736 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
5738 deactivate_process (proc
);
5739 if (!NILP (addrinfos
))
5740 connect_network_socket (proc
, addrinfos
, Qnil
);
5745 /* If we have an incompletely set up TLS connection,
5746 then defer the sentinel signaling until
5748 if (NILP (p
->gnutls_boot_parameters
)
5752 pset_status (p
, Qrun
);
5753 /* Execute the sentinel here. If we had relied on
5754 status_notify to do it later, it will read input
5755 from the process before calling the sentinel. */
5756 exec_sentinel (proc
, build_string ("open\n"));
5759 if (0 <= p
->infd
&& !EQ (p
->filter
, Qt
)
5760 && !EQ (p
->command
, Qt
))
5761 add_process_read_fd (p
->infd
);
5764 } /* End for each file descriptor. */
5765 } /* End while exit conditions not met. */
5767 unbind_to (count
, Qnil
);
5769 /* If calling from keyboard input, do not quit
5770 since we want to return C-g as an input character.
5771 Otherwise, do pending quit if requested. */
5774 /* Prevent input_pending from remaining set if we quit. */
5775 clear_input_pending ();
5779 return got_some_output
;
5782 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5785 read_process_output_call (Lisp_Object fun_and_args
)
5787 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5791 read_process_output_error_handler (Lisp_Object error_val
)
5793 cmd_error_internal (error_val
, "error in process filter: ");
5795 update_echo_area ();
5796 Fsleep_for (make_number (2), Qnil
);
5801 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5803 struct coding_system
*coding
);
5805 /* Read pending output from the process channel,
5806 starting with our buffered-ahead character if we have one.
5807 Yield number of decoded characters read.
5809 This function reads at most 4096 characters.
5810 If you want to read all available subprocess output,
5811 you must call it repeatedly until it returns zero.
5813 The characters read are decoded according to PROC's coding-system
5817 read_process_output (Lisp_Object proc
, int channel
)
5820 struct Lisp_Process
*p
= XPROCESS (proc
);
5821 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5822 int carryover
= p
->decoding_carryover
;
5823 enum { readmax
= 4096 };
5824 ptrdiff_t count
= SPECPDL_INDEX ();
5825 Lisp_Object odeactivate
;
5826 char chars
[sizeof coding
->carryover
+ readmax
];
5829 /* See the comment above. */
5830 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5832 #ifdef DATAGRAM_SOCKETS
5833 /* We have a working select, so proc_buffered_char is always -1. */
5834 if (DATAGRAM_CHAN_P (channel
))
5836 socklen_t len
= datagram_address
[channel
].len
;
5837 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5838 0, datagram_address
[channel
].sa
, &len
);
5843 bool buffered
= proc_buffered_char
[channel
] >= 0;
5846 chars
[carryover
] = proc_buffered_char
[channel
];
5847 proc_buffered_char
[channel
] = -1;
5850 if (p
->gnutls_p
&& p
->gnutls_state
)
5851 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5852 readmax
- buffered
);
5855 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5856 readmax
- buffered
);
5857 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5859 int delay
= p
->read_output_delay
;
5862 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5865 process_output_delay_count
++;
5866 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5869 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5871 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5873 process_output_delay_count
--;
5875 p
->read_output_delay
= delay
;
5878 p
->read_output_skip
= 1;
5879 process_output_skip
= 1;
5883 nbytes
+= buffered
&& nbytes
<= 0;
5886 p
->decoding_carryover
= 0;
5888 /* At this point, NBYTES holds number of bytes just received
5889 (including the one in proc_buffered_char[channel]). */
5892 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5894 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5897 /* Now set NBYTES how many bytes we must decode. */
5898 nbytes
+= carryover
;
5900 odeactivate
= Vdeactivate_mark
;
5901 /* There's no good reason to let process filters change the current
5902 buffer, and many callers of accept-process-output, sit-for, and
5903 friends don't expect current-buffer to be changed from under them. */
5904 record_unwind_current_buffer ();
5906 read_and_dispose_of_process_output (p
, chars
, nbytes
, coding
);
5908 /* Handling the process output should not deactivate the mark. */
5909 Vdeactivate_mark
= odeactivate
;
5911 unbind_to (count
, Qnil
);
5916 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5918 struct coding_system
*coding
)
5920 Lisp_Object outstream
= p
->filter
;
5922 bool outer_running_asynch_code
= running_asynch_code
;
5923 int waiting
= waiting_for_user_input_p
;
5926 Lisp_Object obuffer
, okeymap
;
5927 XSETBUFFER (obuffer
, current_buffer
);
5928 okeymap
= BVAR (current_buffer
, keymap
);
5931 /* We inhibit quit here instead of just catching it so that
5932 hitting ^G when a filter happens to be running won't screw
5934 specbind (Qinhibit_quit
, Qt
);
5935 specbind (Qlast_nonmenu_event
, Qt
);
5937 /* In case we get recursively called,
5938 and we already saved the match data nonrecursively,
5939 save the same match data in safely recursive fashion. */
5940 if (outer_running_asynch_code
)
5943 /* Don't clobber the CURRENT match data, either! */
5944 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5945 restore_search_regs ();
5946 record_unwind_save_match_data ();
5947 Fset_match_data (tem
, Qt
);
5950 /* For speed, if a search happens within this code,
5951 save the match data in a special nonrecursive fashion. */
5952 running_asynch_code
= 1;
5954 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5955 text
= coding
->dst_object
;
5956 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5957 /* A new coding system might be found. */
5958 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5960 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5962 /* Don't call setup_coding_system for
5963 proc_decode_coding_system[channel] here. It is done in
5964 detect_coding called via decode_coding above. */
5966 /* If a coding system for encoding is not yet decided, we set
5967 it as the same as coding-system for decoding.
5969 But, before doing that we must check if
5970 proc_encode_coding_system[p->outfd] surely points to a
5971 valid memory because p->outfd will be changed once EOF is
5972 sent to the process. */
5973 if (NILP (p
->encode_coding_system
) && p
->outfd
>= 0
5974 && proc_encode_coding_system
[p
->outfd
])
5976 pset_encode_coding_system
5977 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5978 setup_coding_system (p
->encode_coding_system
,
5979 proc_encode_coding_system
[p
->outfd
]);
5983 if (coding
->carryover_bytes
> 0)
5985 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5986 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5987 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5988 coding
->carryover_bytes
);
5989 p
->decoding_carryover
= coding
->carryover_bytes
;
5991 if (SBYTES (text
) > 0)
5992 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5993 sometimes it's simply wrong to wrap (e.g. when called from
5994 accept-process-output). */
5995 internal_condition_case_1 (read_process_output_call
,
5996 list3 (outstream
, make_lisp_proc (p
), text
),
5997 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5998 read_process_output_error_handler
);
6000 /* If we saved the match data nonrecursively, restore it now. */
6001 restore_search_regs ();
6002 running_asynch_code
= outer_running_asynch_code
;
6004 /* Restore waiting_for_user_input_p as it was
6005 when we were called, in case the filter clobbered it. */
6006 waiting_for_user_input_p
= waiting
;
6008 #if 0 /* Call record_asynch_buffer_change unconditionally,
6009 because we might have changed minor modes or other things
6010 that affect key bindings. */
6011 if (! EQ (Fcurrent_buffer (), obuffer
)
6012 || ! EQ (current_buffer
->keymap
, okeymap
))
6014 /* But do it only if the caller is actually going to read events.
6015 Otherwise there's no need to make him wake up, and it could
6016 cause trouble (for example it would make sit_for return). */
6017 if (waiting_for_user_input_p
== -1)
6018 record_asynch_buffer_change ();
6021 DEFUN ("internal-default-process-filter", Finternal_default_process_filter
,
6022 Sinternal_default_process_filter
, 2, 2, 0,
6023 doc
: /* Function used as default process filter.
6024 This inserts the process's output into its buffer, if there is one.
6025 Otherwise it discards the output. */)
6026 (Lisp_Object proc
, Lisp_Object text
)
6028 struct Lisp_Process
*p
;
6031 CHECK_PROCESS (proc
);
6032 p
= XPROCESS (proc
);
6033 CHECK_STRING (text
);
6035 if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
6037 Lisp_Object old_read_only
;
6038 ptrdiff_t old_begv
, old_zv
;
6039 ptrdiff_t old_begv_byte
, old_zv_byte
;
6040 ptrdiff_t before
, before_byte
;
6041 ptrdiff_t opoint_byte
;
6044 Fset_buffer (p
->buffer
);
6046 opoint_byte
= PT_BYTE
;
6047 old_read_only
= BVAR (current_buffer
, read_only
);
6050 old_begv_byte
= BEGV_BYTE
;
6051 old_zv_byte
= ZV_BYTE
;
6053 bset_read_only (current_buffer
, Qnil
);
6055 /* Insert new output into buffer at the current end-of-output
6056 marker, thus preserving logical ordering of input and output. */
6057 if (XMARKER (p
->mark
)->buffer
)
6058 set_point_from_marker (p
->mark
);
6060 SET_PT_BOTH (ZV
, ZV_BYTE
);
6062 before_byte
= PT_BYTE
;
6064 /* If the output marker is outside of the visible region, save
6065 the restriction and widen. */
6066 if (! (BEGV
<= PT
&& PT
<= ZV
))
6069 /* Adjust the multibyteness of TEXT to that of the buffer. */
6070 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
6071 != ! STRING_MULTIBYTE (text
))
6072 text
= (STRING_MULTIBYTE (text
)
6073 ? Fstring_as_unibyte (text
)
6074 : Fstring_to_multibyte (text
));
6075 /* Insert before markers in case we are inserting where
6076 the buffer's mark is, and the user's next command is Meta-y. */
6077 insert_from_string_before_markers (text
, 0, 0,
6078 SCHARS (text
), SBYTES (text
), 0);
6080 /* Make sure the process marker's position is valid when the
6081 process buffer is changed in the signal_after_change above.
6082 W3 is known to do that. */
6083 if (BUFFERP (p
->buffer
)
6084 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
6085 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
6087 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6089 update_mode_lines
= 23;
6091 /* Make sure opoint and the old restrictions
6092 float ahead of any new text just as point would. */
6093 if (opoint
>= before
)
6095 opoint
+= PT
- before
;
6096 opoint_byte
+= PT_BYTE
- before_byte
;
6098 if (old_begv
> before
)
6100 old_begv
+= PT
- before
;
6101 old_begv_byte
+= PT_BYTE
- before_byte
;
6103 if (old_zv
>= before
)
6105 old_zv
+= PT
- before
;
6106 old_zv_byte
+= PT_BYTE
- before_byte
;
6109 /* If the restriction isn't what it should be, set it. */
6110 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
6111 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
6113 bset_read_only (current_buffer
, old_read_only
);
6114 SET_PT_BOTH (opoint
, opoint_byte
);
6119 /* Sending data to subprocess. */
6121 /* In send_process, when a write fails temporarily,
6122 wait_reading_process_output is called. It may execute user code,
6123 e.g. timers, that attempts to write new data to the same process.
6124 We must ensure that data is sent in the right order, and not
6125 interspersed half-completed with other writes (Bug#10815). This is
6126 handled by the write_queue element of struct process. It is a list
6127 with each entry having the form
6129 (string . (offset . length))
6131 where STRING is a lisp string, OFFSET is the offset into the
6132 string's byte sequence from which we should begin to send, and
6133 LENGTH is the number of bytes left to send. */
6135 /* Create a new entry in write_queue.
6136 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6137 BUF is a pointer to the string sequence of the input_obj or a C
6138 string in case of Qt or Qnil. */
6141 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
6142 const char *buf
, ptrdiff_t len
, bool front
)
6145 Lisp_Object entry
, obj
;
6147 if (STRINGP (input_obj
))
6149 offset
= buf
- SSDATA (input_obj
);
6155 obj
= make_unibyte_string (buf
, len
);
6158 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
6161 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
6163 pset_write_queue (p
, nconc2 (p
->write_queue
, list1 (entry
)));
6166 /* Remove the first element in the write_queue of process P, put its
6167 contents in OBJ, BUF and LEN, and return true. If the
6168 write_queue is empty, return false. */
6171 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
6172 const char **buf
, ptrdiff_t *len
)
6174 Lisp_Object entry
, offset_length
;
6177 if (NILP (p
->write_queue
))
6180 entry
= XCAR (p
->write_queue
);
6181 pset_write_queue (p
, XCDR (p
->write_queue
));
6183 *obj
= XCAR (entry
);
6184 offset_length
= XCDR (entry
);
6186 *len
= XINT (XCDR (offset_length
));
6187 offset
= XINT (XCAR (offset_length
));
6188 *buf
= SSDATA (*obj
) + offset
;
6193 /* Send some data to process PROC.
6194 BUF is the beginning of the data; LEN is the number of characters.
6195 OBJECT is the Lisp object that the data comes from. If OBJECT is
6196 nil or t, it means that the data comes from C string.
6198 If OBJECT is not nil, the data is encoded by PROC's coding-system
6199 for encoding before it is sent.
6201 This function can evaluate Lisp code and can garbage collect. */
6204 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
6207 struct Lisp_Process
*p
= XPROCESS (proc
);
6209 struct coding_system
*coding
;
6211 if (NETCONN_P (proc
))
6213 wait_while_connecting (proc
);
6214 wait_for_tls_negotiation (proc
);
6217 if (p
->raw_status_new
)
6219 if (! EQ (p
->status
, Qrun
))
6220 error ("Process %s not running", SDATA (p
->name
));
6222 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
6224 coding
= proc_encode_coding_system
[p
->outfd
];
6225 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
6227 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
6228 || (BUFFERP (object
)
6229 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
6232 pset_encode_coding_system
6233 (p
, complement_process_encoding_system (p
->encode_coding_system
));
6234 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
6236 /* The coding system for encoding was changed to raw-text
6237 because we sent a unibyte text previously. Now we are
6238 sending a multibyte text, thus we must encode it by the
6239 original coding system specified for the current process.
6241 Another reason we come here is that the coding system
6242 was just complemented and a new one was returned by
6243 complement_process_encoding_system. */
6244 setup_coding_system (p
->encode_coding_system
, coding
);
6245 Vlast_coding_system_used
= p
->encode_coding_system
;
6247 coding
->src_multibyte
= 1;
6251 coding
->src_multibyte
= 0;
6252 /* For sending a unibyte text, character code conversion should
6253 not take place but EOL conversion should. So, setup raw-text
6254 or one of the subsidiary if we have not yet done it. */
6255 if (CODING_REQUIRE_ENCODING (coding
))
6257 if (CODING_REQUIRE_FLUSHING (coding
))
6259 /* But, before changing the coding, we must flush out data. */
6260 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6261 send_process (proc
, "", 0, Qt
);
6262 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
6264 setup_coding_system (raw_text_coding_system
6265 (Vlast_coding_system_used
),
6267 coding
->src_multibyte
= 0;
6270 coding
->dst_multibyte
= 0;
6272 if (CODING_REQUIRE_ENCODING (coding
))
6274 coding
->dst_object
= Qt
;
6275 if (BUFFERP (object
))
6277 ptrdiff_t from_byte
, from
, to
;
6278 ptrdiff_t save_pt
, save_pt_byte
;
6279 struct buffer
*cur
= current_buffer
;
6281 set_buffer_internal (XBUFFER (object
));
6282 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
6284 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
6285 from
= BYTE_TO_CHAR (from_byte
);
6286 to
= BYTE_TO_CHAR (from_byte
+ len
);
6287 TEMP_SET_PT_BOTH (from
, from_byte
);
6288 encode_coding_object (coding
, object
, from
, from_byte
,
6289 to
, from_byte
+ len
, Qt
);
6290 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
6291 set_buffer_internal (cur
);
6293 else if (STRINGP (object
))
6295 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
6296 SBYTES (object
), Qt
);
6300 coding
->dst_object
= make_unibyte_string (buf
, len
);
6301 coding
->produced
= len
;
6304 len
= coding
->produced
;
6305 object
= coding
->dst_object
;
6306 buf
= SSDATA (object
);
6309 /* If there is already data in the write_queue, put the new data
6310 in the back of queue. Otherwise, ignore it. */
6311 if (!NILP (p
->write_queue
))
6312 write_queue_push (p
, object
, buf
, len
, 0);
6314 do /* while !NILP (p->write_queue) */
6316 ptrdiff_t cur_len
= -1;
6317 const char *cur_buf
;
6318 Lisp_Object cur_object
;
6320 /* If write_queue is empty, ignore it. */
6321 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
6325 cur_object
= object
;
6330 /* Send this batch, using one or more write calls. */
6331 ptrdiff_t written
= 0;
6332 int outfd
= p
->outfd
;
6333 #ifdef DATAGRAM_SOCKETS
6334 if (DATAGRAM_CHAN_P (outfd
))
6336 rv
= sendto (outfd
, cur_buf
, cur_len
,
6337 0, datagram_address
[outfd
].sa
,
6338 datagram_address
[outfd
].len
);
6341 else if (errno
== EMSGSIZE
)
6342 report_file_error ("Sending datagram", proc
);
6348 if (p
->gnutls_p
&& p
->gnutls_state
)
6349 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
6352 written
= emacs_write_sig (outfd
, cur_buf
, cur_len
);
6353 rv
= (written
? 0 : -1);
6354 if (p
->read_output_delay
> 0
6355 && p
->adaptive_read_buffering
== 1)
6357 p
->read_output_delay
= 0;
6358 process_output_delay_count
--;
6359 p
->read_output_skip
= 0;
6365 if (would_block (errno
))
6366 /* Buffer is full. Wait, accepting input;
6367 that may allow the program
6368 to finish doing output and read more. */
6370 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6371 /* A gross hack to work around a bug in FreeBSD.
6372 In the following sequence, read(2) returns
6376 write(2) 954 bytes, get EAGAIN
6377 read(2) 1024 bytes in process_read_output
6378 read(2) 11 bytes in process_read_output
6380 That is, read(2) returns more bytes than have
6381 ever been written successfully. The 1033 bytes
6382 read are the 1022 bytes written successfully
6383 after processing (for example with CRs added if
6384 the terminal is set up that way which it is
6385 here). The same bytes will be seen again in a
6386 later read(2), without the CRs. */
6388 if (errno
== EAGAIN
)
6391 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
6393 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6395 /* Put what we should have written in wait_queue. */
6396 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
6397 wait_reading_process_output (0, 20 * 1000 * 1000,
6398 0, 0, Qnil
, NULL
, 0);
6399 /* Reread queue, to see what is left. */
6402 else if (errno
== EPIPE
)
6404 p
->raw_status_new
= 0;
6405 pset_status (p
, list2 (Qexit
, make_number (256)));
6406 p
->tick
= ++process_tick
;
6407 deactivate_process (proc
);
6408 error ("process %s no longer connected to pipe; closed it",
6412 /* This is a real error. */
6413 report_file_error ("Writing to process", proc
);
6419 while (!NILP (p
->write_queue
));
6422 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
6424 doc
: /* Send current contents of region as input to PROCESS.
6425 PROCESS may be a process, a buffer, the name of a process or buffer, or
6426 nil, indicating the current buffer's process.
6427 Called from program, takes three arguments, PROCESS, START and END.
6428 If the region is more than 500 characters long,
6429 it is sent in several bunches. This may happen even for shorter regions.
6430 Output from processes can arrive in between bunches.
6432 If PROCESS is a non-blocking network process that hasn't been fully
6433 set up yet, this function will block until socket setup has completed. */)
6434 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
6436 Lisp_Object proc
= get_process (process
);
6437 ptrdiff_t start_byte
, end_byte
;
6439 validate_region (&start
, &end
);
6441 start_byte
= CHAR_TO_BYTE (XINT (start
));
6442 end_byte
= CHAR_TO_BYTE (XINT (end
));
6444 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
6445 move_gap_both (XINT (start
), start_byte
);
6447 if (NETCONN_P (proc
))
6448 wait_while_connecting (proc
);
6450 send_process (proc
, (char *) BYTE_POS_ADDR (start_byte
),
6451 end_byte
- start_byte
, Fcurrent_buffer ());
6456 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
6458 doc
: /* Send PROCESS the contents of STRING as input.
6459 PROCESS may be a process, a buffer, the name of a process or buffer, or
6460 nil, indicating the current buffer's process.
6461 If STRING is more than 500 characters long,
6462 it is sent in several bunches. This may happen even for shorter strings.
6463 Output from processes can arrive in between bunches.
6465 If PROCESS is a non-blocking network process that hasn't been fully
6466 set up yet, this function will block until socket setup has completed. */)
6467 (Lisp_Object process
, Lisp_Object string
)
6469 CHECK_STRING (string
);
6470 Lisp_Object proc
= get_process (process
);
6471 send_process (proc
, SSDATA (string
),
6472 SBYTES (string
), string
);
6476 /* Return the foreground process group for the tty/pty that
6477 the process P uses. */
6479 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
6484 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
6487 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6488 master side. Try the slave side. */
6489 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
6493 ioctl (fd
, TIOCGPGRP
, &gid
);
6497 #endif /* defined (TIOCGPGRP ) */
6502 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
6503 Sprocess_running_child_p
, 0, 1, 0,
6504 doc
: /* Return non-nil if PROCESS has given the terminal to a
6505 child. If the operating system does not make it possible to find out,
6506 return t. If we can find out, return the numeric ID of the foreground
6508 (Lisp_Object process
)
6510 /* Initialize in case ioctl doesn't exist or gives an error,
6511 in a way that will cause returning t. */
6512 Lisp_Object proc
= get_process (process
);
6513 struct Lisp_Process
*p
= XPROCESS (proc
);
6515 if (!EQ (p
->type
, Qreal
))
6516 error ("Process %s is not a subprocess",
6519 error ("Process %s is not active",
6522 pid_t gid
= emacs_get_tty_pgrp (p
);
6527 return make_number (gid
);
6531 /* Send a signal number SIGNO to PROCESS.
6532 If CURRENT_GROUP is t, that means send to the process group
6533 that currently owns the terminal being used to communicate with PROCESS.
6534 This is used for various commands in shell mode.
6535 If CURRENT_GROUP is lambda, that means send to the process group
6536 that currently owns the terminal, but only if it is NOT the shell itself.
6538 If NOMSG is false, insert signal-announcements into process's buffers
6541 If we can, we try to signal PROCESS by sending control characters
6542 down the pty. This allows us to signal inferiors who have changed
6543 their uid, for which kill would return an EPERM error. */
6546 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
6550 struct Lisp_Process
*p
;
6554 proc
= get_process (process
);
6555 p
= XPROCESS (proc
);
6557 if (!EQ (p
->type
, Qreal
))
6558 error ("Process %s is not a subprocess",
6561 error ("Process %s is not active",
6565 current_group
= Qnil
;
6567 /* If we are using pgrps, get a pgrp number and make it negative. */
6568 if (NILP (current_group
))
6569 /* Send the signal to the shell's process group. */
6573 #ifdef SIGNALS_VIA_CHARACTERS
6574 /* If possible, send signals to the entire pgrp
6575 by sending an input character to it. */
6578 cc_t
*sig_char
= NULL
;
6580 tcgetattr (p
->infd
, &t
);
6585 sig_char
= &t
.c_cc
[VINTR
];
6589 sig_char
= &t
.c_cc
[VQUIT
];
6594 sig_char
= &t
.c_cc
[VSWTCH
];
6596 sig_char
= &t
.c_cc
[VSUSP
];
6601 if (sig_char
&& *sig_char
!= CDISABLE
)
6603 send_process (proc
, (char *) sig_char
, 1, Qnil
);
6606 /* If we can't send the signal with a character,
6607 fall through and send it another way. */
6609 /* The code above may fall through if it can't
6610 handle the signal. */
6611 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6614 /* Get the current pgrp using the tty itself, if we have that.
6615 Otherwise, use the pty to get the pgrp.
6616 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6617 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6618 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6619 His patch indicates that if TIOCGPGRP returns an error, then
6620 we should just assume that p->pid is also the process group id. */
6622 gid
= emacs_get_tty_pgrp (p
);
6625 /* If we can't get the information, assume
6626 the shell owns the tty. */
6629 /* It is not clear whether anything really can set GID to -1.
6630 Perhaps on some system one of those ioctls can or could do so.
6631 Or perhaps this is vestigial. */
6634 #else /* ! defined (TIOCGPGRP) */
6635 /* Can't select pgrps on this system, so we know that
6636 the child itself heads the pgrp. */
6638 #endif /* ! defined (TIOCGPGRP) */
6640 /* If current_group is lambda, and the shell owns the terminal,
6641 don't send any signal. */
6642 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6647 if (signo
== SIGCONT
)
6649 p
->raw_status_new
= 0;
6650 pset_status (p
, Qrun
);
6651 p
->tick
= ++process_tick
;
6654 status_notify (NULL
, NULL
);
6655 redisplay_preserve_echo_area (13);
6661 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6662 We don't know whether the bug is fixed in later HP-UX versions. */
6663 if (! NILP (current_group
) && ioctl (p
->infd
, TIOCSIGSEND
, signo
) != -1)
6667 /* If we don't have process groups, send the signal to the immediate
6668 subprocess. That isn't really right, but it's better than any
6669 obvious alternative. */
6670 pid_t pid
= no_pgrp
? gid
: - gid
;
6672 /* Do not kill an already-reaped process, as that could kill an
6673 innocent bystander that happens to have the same process ID. */
6675 block_child_signal (&oldset
);
6678 unblock_child_signal (&oldset
);
6681 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6682 doc
: /* Interrupt process PROCESS.
6683 PROCESS may be a process, a buffer, or the name of a process or buffer.
6684 No arg or nil means current buffer's process.
6685 Second arg CURRENT-GROUP non-nil means send signal to
6686 the current process-group of the process's controlling terminal
6687 rather than to the process's own process group.
6688 If the process is a shell, this means interrupt current subjob
6689 rather than the shell.
6691 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6692 don't send the signal. */)
6693 (Lisp_Object process
, Lisp_Object current_group
)
6695 process_send_signal (process
, SIGINT
, current_group
, 0);
6699 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6700 doc
: /* Kill process PROCESS. May be process or name of one.
6701 See function `interrupt-process' for more details on usage. */)
6702 (Lisp_Object process
, Lisp_Object current_group
)
6704 process_send_signal (process
, SIGKILL
, current_group
, 0);
6708 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6709 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6710 See function `interrupt-process' for more details on usage. */)
6711 (Lisp_Object process
, Lisp_Object current_group
)
6713 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6717 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6718 doc
: /* Stop process PROCESS. May be process or name of one.
6719 See function `interrupt-process' for more details on usage.
6720 If PROCESS is a network or serial or pipe connection, inhibit handling
6721 of incoming traffic. */)
6722 (Lisp_Object process
, Lisp_Object current_group
)
6724 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6725 || PIPECONN_P (process
)))
6727 struct Lisp_Process
*p
;
6729 p
= XPROCESS (process
);
6730 if (NILP (p
->command
)
6732 delete_read_fd (p
->infd
);
6733 pset_command (p
, Qt
);
6737 error ("No SIGTSTP support");
6739 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6744 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6745 doc
: /* Continue process PROCESS. May be process or name of one.
6746 See function `interrupt-process' for more details on usage.
6747 If PROCESS is a network or serial process, resume handling of incoming
6749 (Lisp_Object process
, Lisp_Object current_group
)
6751 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6752 || PIPECONN_P (process
)))
6754 struct Lisp_Process
*p
;
6756 p
= XPROCESS (process
);
6757 if (EQ (p
->command
, Qt
)
6759 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6761 add_process_read_fd (p
->infd
);
6763 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6764 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6765 #else /* not WINDOWSNT */
6766 tcflush (p
->infd
, TCIFLUSH
);
6767 #endif /* not WINDOWSNT */
6769 pset_command (p
, Qnil
);
6773 process_send_signal (process
, SIGCONT
, current_group
, 0);
6775 error ("No SIGCONT support");
6780 /* Return the integer value of the signal whose abbreviation is ABBR,
6781 or a negative number if there is no such signal. */
6783 abbr_to_signal (char const *name
)
6786 char sigbuf
[20]; /* Large enough for all valid signal abbreviations. */
6788 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6791 for (i
= 0; i
< sizeof sigbuf
; i
++)
6793 sigbuf
[i
] = c_toupper (name
[i
]);
6795 return str2sig (sigbuf
, &signo
) == 0 ? signo
: -1;
6801 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6802 2, 2, "sProcess (name or number): \nnSignal code: ",
6803 doc
: /* Send PROCESS the signal with code SIGCODE.
6804 PROCESS may also be a number specifying the process id of the
6805 process to signal; in this case, the process need not be a child of
6807 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6808 (Lisp_Object process
, Lisp_Object sigcode
)
6813 if (STRINGP (process
))
6815 Lisp_Object tem
= Fget_process (process
);
6818 Lisp_Object process_number
6819 = string_to_number (SSDATA (process
), 10, 1);
6820 if (NUMBERP (process_number
))
6821 tem
= process_number
;
6825 else if (!NUMBERP (process
))
6826 process
= get_process (process
);
6831 if (NUMBERP (process
))
6832 CONS_TO_INTEGER (process
, pid_t
, pid
);
6835 CHECK_PROCESS (process
);
6836 pid
= XPROCESS (process
)->pid
;
6838 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6841 if (INTEGERP (sigcode
))
6843 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6844 signo
= XINT (sigcode
);
6850 CHECK_SYMBOL (sigcode
);
6851 name
= SSDATA (SYMBOL_NAME (sigcode
));
6853 signo
= abbr_to_signal (name
);
6855 error ("Undefined signal name %s", name
);
6858 return make_number (kill (pid
, signo
));
6861 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6862 doc
: /* Make PROCESS see end-of-file in its input.
6863 EOF comes after any text already sent to it.
6864 PROCESS may be a process, a buffer, the name of a process or buffer, or
6865 nil, indicating the current buffer's process.
6866 If PROCESS is a network connection, or is a process communicating
6867 through a pipe (as opposed to a pty), then you cannot send any more
6868 text to PROCESS after you call this function.
6869 If PROCESS is a serial process, wait until all output written to the
6870 process has been transmitted to the serial port. */)
6871 (Lisp_Object process
)
6874 struct coding_system
*coding
= NULL
;
6877 proc
= get_process (process
);
6879 if (NETCONN_P (proc
))
6880 wait_while_connecting (proc
);
6882 if (DATAGRAM_CONN_P (proc
))
6886 outfd
= XPROCESS (proc
)->outfd
;
6888 coding
= proc_encode_coding_system
[outfd
];
6890 /* Make sure the process is really alive. */
6891 if (XPROCESS (proc
)->raw_status_new
)
6892 update_status (XPROCESS (proc
));
6893 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6894 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6896 if (coding
&& CODING_REQUIRE_FLUSHING (coding
))
6898 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6899 send_process (proc
, "", 0, Qnil
);
6902 if (XPROCESS (proc
)->pty_flag
)
6903 send_process (proc
, "\004", 1, Qnil
);
6904 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6907 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6908 report_file_error ("Failed tcdrain", Qnil
);
6909 #endif /* not WINDOWSNT */
6910 /* Do nothing on Windows because writes are blocking. */
6914 struct Lisp_Process
*p
= XPROCESS (proc
);
6915 int old_outfd
= p
->outfd
;
6918 #ifdef HAVE_SHUTDOWN
6919 /* If this is a network connection, or socketpair is used
6920 for communication with the subprocess, call shutdown to cause EOF.
6921 (In some old system, shutdown to socketpair doesn't work.
6922 Then we just can't win.) */
6924 && (EQ (p
->type
, Qnetwork
) || p
->infd
== old_outfd
))
6925 shutdown (old_outfd
, 1);
6927 close_process_fd (&p
->open_fd
[WRITE_TO_SUBPROCESS
]);
6928 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6930 report_file_error ("Opening null device", Qnil
);
6931 p
->open_fd
[WRITE_TO_SUBPROCESS
] = new_outfd
;
6932 p
->outfd
= new_outfd
;
6934 if (!proc_encode_coding_system
[new_outfd
])
6935 proc_encode_coding_system
[new_outfd
]
6936 = xmalloc (sizeof (struct coding_system
));
6939 *proc_encode_coding_system
[new_outfd
]
6940 = *proc_encode_coding_system
[old_outfd
];
6941 memset (proc_encode_coding_system
[old_outfd
], 0,
6942 sizeof (struct coding_system
));
6945 setup_coding_system (p
->encode_coding_system
,
6946 proc_encode_coding_system
[new_outfd
]);
6951 /* The main Emacs thread records child processes in three places:
6953 - Vprocess_alist, for asynchronous subprocesses, which are child
6954 processes visible to Lisp.
6956 - deleted_pid_list, for child processes invisible to Lisp,
6957 typically because of delete-process. These are recorded so that
6958 the processes can be reaped when they exit, so that the operating
6959 system's process table is not cluttered by zombies.
6961 - the local variable PID in Fcall_process, call_process_cleanup and
6962 call_process_kill, for synchronous subprocesses.
6963 record_unwind_protect is used to make sure this process is not
6964 forgotten: if the user interrupts call-process and the child
6965 process refuses to exit immediately even with two C-g's,
6966 call_process_kill adds PID's contents to deleted_pid_list before
6969 The main Emacs thread invokes waitpid only on child processes that
6970 it creates and that have not been reaped. This avoid races on
6971 platforms such as GTK, where other threads create their own
6972 subprocesses which the main thread should not reap. For example,
6973 if the main thread attempted to reap an already-reaped child, it
6974 might inadvertently reap a GTK-created process that happened to
6975 have the same process ID. */
6977 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6978 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6979 keep track of its own children. GNUstep is similar. */
6981 static void dummy_handler (int sig
) {}
6982 static signal_handler_t
volatile lib_child_handler
;
6984 /* Handle a SIGCHLD signal by looking for known child processes of
6985 Emacs whose status have changed. For each one found, record its
6988 All we do is change the status; we do not run sentinels or print
6989 notifications. That is saved for the next time keyboard input is
6990 done, in order to avoid timing errors.
6992 ** WARNING: this can be called during garbage collection.
6993 Therefore, it must not be fooled by the presence of mark bits in
6996 ** USG WARNING: Although it is not obvious from the documentation
6997 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6998 signal() before executing at least one wait(), otherwise the
6999 handler will be called again, resulting in an infinite loop. The
7000 relevant portion of the documentation reads "SIGCLD signals will be
7001 queued and the signal-catching function will be continually
7002 reentered until the queue is empty". Invoking signal() causes the
7003 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7006 ** Malloc WARNING: This should never call malloc either directly or
7007 indirectly; if it does, that is a bug. */
7010 handle_child_signal (int sig
)
7012 Lisp_Object tail
, proc
;
7014 /* Find the process that signaled us, and record its status. */
7016 /* The process can have been deleted by Fdelete_process, or have
7017 been started asynchronously by Fcall_process. */
7018 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
7020 bool all_pids_are_fixnums
7021 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
7022 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
7023 Lisp_Object head
= XCAR (tail
);
7028 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
7031 if (INTEGERP (xpid
))
7032 deleted_pid
= XINT (xpid
);
7034 deleted_pid
= XFLOAT_DATA (xpid
);
7035 if (child_status_changed (deleted_pid
, 0, 0))
7037 if (STRINGP (XCDR (head
)))
7038 unlink (SSDATA (XCDR (head
)));
7039 XSETCAR (tail
, Qnil
);
7044 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7045 FOR_EACH_PROCESS (tail
, proc
)
7047 struct Lisp_Process
*p
= XPROCESS (proc
);
7051 && child_status_changed (p
->pid
, &status
, WUNTRACED
| WCONTINUED
))
7053 /* Change the status of the process that was found. */
7054 p
->tick
= ++process_tick
;
7055 p
->raw_status
= status
;
7056 p
->raw_status_new
= 1;
7058 /* If process has terminated, stop waiting for its output. */
7059 if (WIFSIGNALED (status
) || WIFEXITED (status
))
7061 bool clear_desc_flag
= 0;
7064 clear_desc_flag
= 1;
7066 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7067 if (clear_desc_flag
)
7068 delete_read_fd (p
->infd
);
7073 lib_child_handler (sig
);
7074 #ifdef NS_IMPL_GNUSTEP
7075 /* NSTask in GNUstep sets its child handler each time it is called.
7076 So we must re-set ours. */
7077 catch_child_signal ();
7082 deliver_child_signal (int sig
)
7084 deliver_process_signal (sig
, handle_child_signal
);
7089 exec_sentinel_error_handler (Lisp_Object error_val
)
7091 cmd_error_internal (error_val
, "error in process sentinel: ");
7093 update_echo_area ();
7094 Fsleep_for (make_number (2), Qnil
);
7099 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
7101 Lisp_Object sentinel
, odeactivate
;
7102 struct Lisp_Process
*p
= XPROCESS (proc
);
7103 ptrdiff_t count
= SPECPDL_INDEX ();
7104 bool outer_running_asynch_code
= running_asynch_code
;
7105 int waiting
= waiting_for_user_input_p
;
7107 if (inhibit_sentinels
)
7110 odeactivate
= Vdeactivate_mark
;
7112 Lisp_Object obuffer
, okeymap
;
7113 XSETBUFFER (obuffer
, current_buffer
);
7114 okeymap
= BVAR (current_buffer
, keymap
);
7117 /* There's no good reason to let sentinels change the current
7118 buffer, and many callers of accept-process-output, sit-for, and
7119 friends don't expect current-buffer to be changed from under them. */
7120 record_unwind_current_buffer ();
7122 sentinel
= p
->sentinel
;
7124 /* Inhibit quit so that random quits don't screw up a running filter. */
7125 specbind (Qinhibit_quit
, Qt
);
7126 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
7128 /* In case we get recursively called,
7129 and we already saved the match data nonrecursively,
7130 save the same match data in safely recursive fashion. */
7131 if (outer_running_asynch_code
)
7134 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
7135 restore_search_regs ();
7136 record_unwind_save_match_data ();
7137 Fset_match_data (tem
, Qt
);
7140 /* For speed, if a search happens within this code,
7141 save the match data in a special nonrecursive fashion. */
7142 running_asynch_code
= 1;
7144 internal_condition_case_1 (read_process_output_call
,
7145 list3 (sentinel
, proc
, reason
),
7146 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
7147 exec_sentinel_error_handler
);
7149 /* If we saved the match data nonrecursively, restore it now. */
7150 restore_search_regs ();
7151 running_asynch_code
= outer_running_asynch_code
;
7153 Vdeactivate_mark
= odeactivate
;
7155 /* Restore waiting_for_user_input_p as it was
7156 when we were called, in case the filter clobbered it. */
7157 waiting_for_user_input_p
= waiting
;
7160 if (! EQ (Fcurrent_buffer (), obuffer
)
7161 || ! EQ (current_buffer
->keymap
, okeymap
))
7163 /* But do it only if the caller is actually going to read events.
7164 Otherwise there's no need to make him wake up, and it could
7165 cause trouble (for example it would make sit_for return). */
7166 if (waiting_for_user_input_p
== -1)
7167 record_asynch_buffer_change ();
7169 unbind_to (count
, Qnil
);
7172 /* Report all recent events of a change in process status
7173 (either run the sentinel or output a message).
7174 This is usually done while Emacs is waiting for keyboard input
7175 but can be done at other times.
7177 Return positive if any input was received from WAIT_PROC (or from
7178 any process if WAIT_PROC is null), zero if input was attempted but
7179 none received, and negative if we didn't even try. */
7182 status_notify (struct Lisp_Process
*deleting_process
,
7183 struct Lisp_Process
*wait_proc
)
7186 Lisp_Object tail
, msg
;
7187 int got_some_output
= -1;
7192 /* Set this now, so that if new processes are created by sentinels
7193 that we run, we get called again to handle their status changes. */
7194 update_tick
= process_tick
;
7196 FOR_EACH_PROCESS (tail
, proc
)
7199 register struct Lisp_Process
*p
= XPROCESS (proc
);
7201 if (p
->tick
!= p
->update_tick
)
7203 p
->update_tick
= p
->tick
;
7205 /* If process is still active, read any output that remains. */
7206 while (! EQ (p
->filter
, Qt
)
7207 && ! connecting_status (p
->status
)
7208 && ! EQ (p
->status
, Qlisten
)
7209 /* Network or serial process not stopped: */
7210 && ! EQ (p
->command
, Qt
)
7212 && p
!= deleting_process
)
7214 int nread
= read_process_output (proc
, p
->infd
);
7215 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
7216 && got_some_output
< nread
)
7217 got_some_output
= nread
;
7222 /* Get the text to use for the message. */
7223 if (p
->raw_status_new
)
7225 msg
= status_message (p
);
7227 /* If process is terminated, deactivate it or delete it. */
7229 if (CONSP (p
->status
))
7230 symbol
= XCAR (p
->status
);
7232 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
7233 || EQ (symbol
, Qclosed
))
7235 if (delete_exited_processes
)
7236 remove_process (proc
);
7238 deactivate_process (proc
);
7241 /* The actions above may have further incremented p->tick.
7242 So set p->update_tick again so that an error in the sentinel will
7243 not cause this code to be run again. */
7244 p
->update_tick
= p
->tick
;
7245 /* Now output the message suitably. */
7246 exec_sentinel (proc
, msg
);
7247 if (BUFFERP (p
->buffer
))
7248 /* In case it uses %s in mode-line-format. */
7249 bset_update_mode_line (XBUFFER (p
->buffer
));
7253 return got_some_output
;
7256 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel
,
7257 Sinternal_default_process_sentinel
, 2, 2, 0,
7258 doc
: /* Function used as default sentinel for processes.
7259 This inserts a status message into the process's buffer, if there is one. */)
7260 (Lisp_Object proc
, Lisp_Object msg
)
7262 Lisp_Object buffer
, symbol
;
7263 struct Lisp_Process
*p
;
7264 CHECK_PROCESS (proc
);
7265 p
= XPROCESS (proc
);
7269 symbol
= XCAR (symbol
);
7271 if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
7274 struct buffer
*old
= current_buffer
;
7275 ptrdiff_t opoint
, opoint_byte
;
7276 ptrdiff_t before
, before_byte
;
7278 /* Avoid error if buffer is deleted
7279 (probably that's why the process is dead, too). */
7280 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
7282 Fset_buffer (buffer
);
7284 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
7285 msg
= (code_convert_string_norecord
7286 (msg
, Vlocale_coding_system
, 1));
7289 opoint_byte
= PT_BYTE
;
7290 /* Insert new output into buffer
7291 at the current end-of-output marker,
7292 thus preserving logical ordering of input and output. */
7293 if (XMARKER (p
->mark
)->buffer
)
7294 Fgoto_char (p
->mark
);
7296 SET_PT_BOTH (ZV
, ZV_BYTE
);
7299 before_byte
= PT_BYTE
;
7301 tem
= BVAR (current_buffer
, read_only
);
7302 bset_read_only (current_buffer
, Qnil
);
7303 insert_string ("\nProcess ");
7304 { /* FIXME: temporary kludge. */
7305 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
7306 insert_string (" ");
7308 bset_read_only (current_buffer
, tem
);
7309 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
7311 if (opoint
>= before
)
7312 SET_PT_BOTH (opoint
+ (PT
- before
),
7313 opoint_byte
+ (PT_BYTE
- before_byte
));
7315 SET_PT_BOTH (opoint
, opoint_byte
);
7317 set_buffer_internal (old
);
7323 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
7324 Sset_process_coding_system
, 1, 3, 0,
7325 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
7326 DECODING will be used to decode subprocess output and ENCODING to
7327 encode subprocess input. */)
7328 (Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
7330 CHECK_PROCESS (process
);
7332 struct Lisp_Process
*p
= XPROCESS (process
);
7334 Fcheck_coding_system (decoding
);
7335 Fcheck_coding_system (encoding
);
7336 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
7337 pset_decode_coding_system (p
, decoding
);
7338 pset_encode_coding_system (p
, encoding
);
7340 /* If the sockets haven't been set up yet, the final setup part of
7341 this will be called asynchronously. */
7342 if (p
->infd
< 0 || p
->outfd
< 0)
7345 setup_process_coding_systems (process
);
7350 DEFUN ("process-coding-system",
7351 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
7352 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7353 (register Lisp_Object process
)
7355 CHECK_PROCESS (process
);
7356 return Fcons (XPROCESS (process
)->decode_coding_system
,
7357 XPROCESS (process
)->encode_coding_system
);
7360 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
7361 Sset_process_filter_multibyte
, 2, 2, 0,
7362 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
7363 If FLAG is non-nil, the filter is given multibyte strings.
7364 If FLAG is nil, the filter is given unibyte strings. In this case,
7365 all character code conversion except for end-of-line conversion is
7367 (Lisp_Object process
, Lisp_Object flag
)
7369 CHECK_PROCESS (process
);
7371 struct Lisp_Process
*p
= XPROCESS (process
);
7373 pset_decode_coding_system
7374 (p
, raw_text_coding_system (p
->decode_coding_system
));
7376 /* If the sockets haven't been set up yet, the final setup part of
7377 this will be called asynchronously. */
7378 if (p
->infd
< 0 || p
->outfd
< 0)
7381 setup_process_coding_systems (process
);
7386 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
7387 Sprocess_filter_multibyte_p
, 1, 1, 0,
7388 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7389 (Lisp_Object process
)
7391 CHECK_PROCESS (process
);
7392 struct Lisp_Process
*p
= XPROCESS (process
);
7395 struct coding_system
*coding
= proc_decode_coding_system
[p
->infd
];
7396 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
7405 add_gpm_wait_descriptor (int desc
)
7407 add_keyboard_wait_descriptor (desc
);
7411 delete_gpm_wait_descriptor (int desc
)
7413 delete_keyboard_wait_descriptor (desc
);
7418 # ifdef USABLE_SIGIO
7420 /* Return true if *MASK has a bit set
7421 that corresponds to one of the keyboard input descriptors. */
7424 keyboard_bit_set (fd_set
*mask
)
7428 for (fd
= 0; fd
<= max_desc
; fd
++)
7429 if (FD_ISSET (fd
, mask
)
7430 && ((fd_callback_info
[fd
].flags
& (FOR_READ
| KEYBOARD_FD
))
7431 == (FOR_READ
| KEYBOARD_FD
)))
7438 #else /* not subprocesses */
7440 /* Defined in msdos.c. */
7441 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
7442 struct timespec
*, void *);
7444 /* Implementation of wait_reading_process_output, assuming that there
7445 are no subprocesses. Used only by the MS-DOS build.
7447 Wait for timeout to elapse and/or keyboard input to be available.
7451 If negative, gobble data immediately available but don't wait for any.
7454 an additional duration to wait, measured in nanoseconds
7455 If TIME_LIMIT is zero, then:
7456 If NSECS == 0, there is no limit.
7457 If NSECS > 0, the timeout consists of NSECS only.
7458 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7461 0 to ignore keyboard input, or
7462 1 to return when input is available, or
7463 -1 means caller will actually read the input, so don't throw to
7466 see full version for other parameters. We know that wait_proc will
7467 always be NULL, since `subprocesses' isn't defined.
7469 DO_DISPLAY means redisplay should be done to show subprocess
7470 output that arrives.
7472 Return -1 signifying we got no output and did not try. */
7475 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
7477 Lisp_Object wait_for_cell
,
7478 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
7481 struct timespec end_time
, timeout
;
7482 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
7484 if (TYPE_MAXIMUM (time_t) < time_limit
)
7485 time_limit
= TYPE_MAXIMUM (time_t);
7487 if (time_limit
< 0 || nsecs
< 0)
7489 else if (time_limit
> 0 || nsecs
> 0)
7492 end_time
= timespec_add (current_timespec (),
7493 make_timespec (time_limit
, nsecs
));
7498 /* Turn off periodic alarms (in case they are in use)
7499 and then turn off any other atimers,
7500 because the select emulator uses alarms. */
7502 turn_on_atimers (0);
7506 bool timeout_reduced_for_timers
= false;
7507 fd_set waitchannels
;
7510 /* If calling from keyboard input, do not quit
7511 since we want to return C-g as an input character.
7512 Otherwise, do pending quit if requested. */
7516 /* Exit now if the cell we're waiting for became non-nil. */
7517 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7520 /* Compute time from now till when time limit is up. */
7521 /* Exit if already run out. */
7522 if (wait
== TIMEOUT
)
7524 struct timespec now
= current_timespec ();
7525 if (timespec_cmp (end_time
, now
) <= 0)
7527 timeout
= timespec_sub (end_time
, now
);
7530 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
7532 /* If our caller will not immediately handle keyboard events,
7533 run timer events directly.
7534 (Callers that will immediately read keyboard events
7535 call timer_delay on their own.) */
7536 if (NILP (wait_for_cell
))
7538 struct timespec timer_delay
;
7542 unsigned old_timers_run
= timers_run
;
7543 timer_delay
= timer_check ();
7544 if (timers_run
!= old_timers_run
&& do_display
)
7545 /* We must retry, since a timer may have requeued itself
7546 and that could alter the time delay. */
7547 redisplay_preserve_echo_area (14);
7551 while (!detect_input_pending ());
7553 /* If there is unread keyboard input, also return. */
7555 && requeued_events_pending_p ())
7558 if (timespec_valid_p (timer_delay
))
7560 if (timespec_cmp (timer_delay
, timeout
) < 0)
7562 timeout
= timer_delay
;
7563 timeout_reduced_for_timers
= true;
7568 /* Cause C-g and alarm signals to take immediate action,
7569 and cause input available signals to zero out timeout. */
7571 set_waiting_for_input (&timeout
);
7573 /* If a frame has been newly mapped and needs updating,
7574 reprocess its display stuff. */
7575 if (frame_garbaged
&& do_display
)
7577 clear_waiting_for_input ();
7578 redisplay_preserve_echo_area (15);
7580 set_waiting_for_input (&timeout
);
7583 /* Wait till there is something to do. */
7584 FD_ZERO (&waitchannels
);
7585 if (read_kbd
&& detect_input_pending ())
7589 if (read_kbd
|| !NILP (wait_for_cell
))
7590 FD_SET (0, &waitchannels
);
7591 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
7596 /* Make C-g and alarm signals set flags again. */
7597 clear_waiting_for_input ();
7599 /* If we woke up due to SIGWINCH, actually change size now. */
7600 do_pending_window_change (0);
7602 if (wait
< INFINITY
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7603 /* We waited the full specified time, so return now. */
7608 /* If the system call was interrupted, then go around the
7610 if (xerrno
== EINTR
)
7611 FD_ZERO (&waitchannels
);
7613 report_file_errno ("Failed select", Qnil
, xerrno
);
7616 /* Check for keyboard input. */
7619 && detect_input_pending_run_timers (do_display
))
7621 swallow_events (do_display
);
7622 if (detect_input_pending_run_timers (do_display
))
7626 /* If there is unread keyboard input, also return. */
7628 && requeued_events_pending_p ())
7631 /* If wait_for_cell. check for keyboard input
7632 but don't run any timers.
7633 ??? (It seems wrong to me to check for keyboard
7634 input at all when wait_for_cell, but the code
7635 has been this way since July 1994.
7636 Try changing this after version 19.31.) */
7637 if (! NILP (wait_for_cell
)
7638 && detect_input_pending ())
7640 swallow_events (do_display
);
7641 if (detect_input_pending ())
7645 /* Exit now if the cell we're waiting for became non-nil. */
7646 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7655 #endif /* not subprocesses */
7657 /* The following functions are needed even if async subprocesses are
7658 not supported. Some of them are no-op stubs in that case. */
7662 /* Add FD, which is a descriptor returned by timerfd_create,
7663 to the set of non-keyboard input descriptors. */
7666 add_timer_wait_descriptor (int fd
)
7668 add_read_fd (fd
, timerfd_callback
, NULL
);
7669 fd_callback_info
[fd
].flags
&= ~KEYBOARD_FD
;
7672 #endif /* HAVE_TIMERFD */
7674 /* If program file NAME starts with /: for quoting a magic
7675 name, remove that, preserving the multibyteness of NAME. */
7678 remove_slash_colon (Lisp_Object name
)
7681 ((SBYTES (name
) > 2 && SREF (name
, 0) == '/' && SREF (name
, 1) == ':')
7682 ? make_specified_string (SSDATA (name
) + 2, SCHARS (name
) - 2,
7683 SBYTES (name
) - 2, STRING_MULTIBYTE (name
))
7687 /* Add DESC to the set of keyboard input descriptors. */
7690 add_keyboard_wait_descriptor (int desc
)
7692 #ifdef subprocesses /* Actually means "not MSDOS". */
7693 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7694 fd_callback_info
[desc
].flags
&= ~PROCESS_FD
;
7695 fd_callback_info
[desc
].flags
|= (FOR_READ
| KEYBOARD_FD
);
7696 if (desc
> max_desc
)
7701 /* From now on, do not expect DESC to give keyboard input. */
7704 delete_keyboard_wait_descriptor (int desc
)
7707 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7709 fd_callback_info
[desc
].flags
&= ~(FOR_READ
| KEYBOARD_FD
| PROCESS_FD
);
7711 if (desc
== max_desc
)
7712 recompute_max_desc ();
7716 /* Setup coding systems of PROCESS. */
7719 setup_process_coding_systems (Lisp_Object process
)
7722 struct Lisp_Process
*p
= XPROCESS (process
);
7724 int outch
= p
->outfd
;
7725 Lisp_Object coding_system
;
7727 if (inch
< 0 || outch
< 0)
7730 if (!proc_decode_coding_system
[inch
])
7731 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7732 coding_system
= p
->decode_coding_system
;
7733 if (EQ (p
->filter
, Qinternal_default_process_filter
)
7734 && BUFFERP (p
->buffer
))
7736 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7737 coding_system
= raw_text_coding_system (coding_system
);
7739 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7741 if (!proc_encode_coding_system
[outch
])
7742 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7743 setup_coding_system (p
->encode_coding_system
,
7744 proc_encode_coding_system
[outch
]);
7748 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7749 doc
: /* Return the (or a) live process associated with BUFFER.
7750 BUFFER may be a buffer or the name of one.
7751 Return nil if all processes associated with BUFFER have been
7752 deleted or killed. */)
7753 (register Lisp_Object buffer
)
7756 register Lisp_Object buf
, tail
, proc
;
7758 if (NILP (buffer
)) return Qnil
;
7759 buf
= Fget_buffer (buffer
);
7760 if (NILP (buf
)) return Qnil
;
7762 FOR_EACH_PROCESS (tail
, proc
)
7763 if (EQ (XPROCESS (proc
)->buffer
, buf
))
7765 #endif /* subprocesses */
7769 DEFUN ("process-inherit-coding-system-flag",
7770 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7772 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7773 If this flag is t, `buffer-file-coding-system' of the buffer
7774 associated with PROCESS will inherit the coding system used to decode
7775 the process output. */)
7776 (register Lisp_Object process
)
7779 CHECK_PROCESS (process
);
7780 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7782 /* Ignore the argument and return the value of
7783 inherit-process-coding-system. */
7784 return inherit_process_coding_system
? Qt
: Qnil
;
7788 /* Kill all processes associated with `buffer'.
7789 If `buffer' is nil, kill all processes. */
7792 kill_buffer_processes (Lisp_Object buffer
)
7795 Lisp_Object tail
, proc
;
7797 FOR_EACH_PROCESS (tail
, proc
)
7798 if (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
))
7800 if (NETCONN_P (proc
) || SERIALCONN_P (proc
) || PIPECONN_P (proc
))
7801 Fdelete_process (proc
);
7802 else if (XPROCESS (proc
)->infd
>= 0)
7803 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7805 #else /* subprocesses */
7806 /* Since we have no subprocesses, this does nothing. */
7807 #endif /* subprocesses */
7810 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7811 Swaiting_for_user_input_p
, 0, 0, 0,
7812 doc
: /* Return non-nil if Emacs is waiting for input from the user.
7813 This is intended for use by asynchronous process output filters and sentinels. */)
7817 return (waiting_for_user_input_p
? Qt
: Qnil
);
7823 /* Stop reading input from keyboard sources. */
7826 hold_keyboard_input (void)
7831 /* Resume reading input from keyboard sources. */
7834 unhold_keyboard_input (void)
7839 /* Return true if keyboard input is on hold, zero otherwise. */
7842 kbd_on_hold_p (void)
7844 return kbd_is_on_hold
;
7848 /* Enumeration of and access to system processes a-la ps(1). */
7850 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7852 doc
: /* Return a list of numerical process IDs of all running processes.
7853 If this functionality is unsupported, return nil.
7855 See `process-attributes' for getting attributes of a process given its ID. */)
7858 return list_system_processes ();
7861 DEFUN ("process-attributes", Fprocess_attributes
,
7862 Sprocess_attributes
, 1, 1, 0,
7863 doc
: /* Return attributes of the process given by its PID, a number.
7865 Value is an alist where each element is a cons cell of the form
7869 If this functionality is unsupported, the value is nil.
7871 See `list-system-processes' for getting a list of all process IDs.
7873 The KEYs of the attributes that this function may return are listed
7874 below, together with the type of the associated VALUE (in parentheses).
7875 Not all platforms support all of these attributes; unsupported
7876 attributes will not appear in the returned alist.
7877 Unless explicitly indicated otherwise, numbers can have either
7878 integer or floating point values.
7880 euid -- Effective user User ID of the process (number)
7881 user -- User name corresponding to euid (string)
7882 egid -- Effective user Group ID of the process (number)
7883 group -- Group name corresponding to egid (string)
7884 comm -- Command name (executable name only) (string)
7885 state -- Process state code, such as "S", "R", or "T" (string)
7886 ppid -- Parent process ID (number)
7887 pgrp -- Process group ID (number)
7888 sess -- Session ID, i.e. process ID of session leader (number)
7889 ttname -- Controlling tty name (string)
7890 tpgid -- ID of foreground process group on the process's tty (number)
7891 minflt -- number of minor page faults (number)
7892 majflt -- number of major page faults (number)
7893 cminflt -- cumulative number of minor page faults (number)
7894 cmajflt -- cumulative number of major page faults (number)
7895 utime -- user time used by the process, in (current-time) format,
7896 which is a list of integers (HIGH LOW USEC PSEC)
7897 stime -- system time used by the process (current-time)
7898 time -- sum of utime and stime (current-time)
7899 cutime -- user time used by the process and its children (current-time)
7900 cstime -- system time used by the process and its children (current-time)
7901 ctime -- sum of cutime and cstime (current-time)
7902 pri -- priority of the process (number)
7903 nice -- nice value of the process (number)
7904 thcount -- process thread count (number)
7905 start -- time the process started (current-time)
7906 vsize -- virtual memory size of the process in KB's (number)
7907 rss -- resident set size of the process in KB's (number)
7908 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7909 pcpu -- percents of CPU time used by the process (floating-point number)
7910 pmem -- percents of total physical memory used by process's resident set
7911 (floating-point number)
7912 args -- command line which invoked the process (string). */)
7915 return system_process_attributes (pid
);
7919 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7920 Invoke this after init_process_emacs, and after glib and/or GNUstep
7921 futz with the SIGCHLD handler, but before Emacs forks any children.
7922 This function's caller should block SIGCHLD. */
7925 catch_child_signal (void)
7927 struct sigaction action
, old_action
;
7929 emacs_sigaction_init (&action
, deliver_child_signal
);
7930 block_child_signal (&oldset
);
7931 sigaction (SIGCHLD
, &action
, &old_action
);
7932 eassert (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7933 || ! (old_action
.sa_flags
& SA_SIGINFO
));
7935 if (old_action
.sa_handler
!= deliver_child_signal
)
7937 = (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7939 : old_action
.sa_handler
);
7940 unblock_child_signal (&oldset
);
7942 #endif /* subprocesses */
7944 /* Limit the number of open files to the value it had at startup. */
7947 restore_nofile_limit (void)
7949 #ifdef HAVE_SETRLIMIT
7950 if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
7951 setrlimit (RLIMIT_NOFILE
, &nofile_limit
);
7956 /* This is not called "init_process" because that is the name of a
7957 Mach system call, so it would cause problems on Darwin systems. */
7959 init_process_emacs (int sockfd
)
7964 inhibit_sentinels
= 0;
7967 if (! noninteractive
|| initialized
)
7970 #if defined HAVE_GLIB && !defined WINDOWSNT
7971 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7972 this should always fail, but is enough to initialize glib's
7973 private SIGCHLD handler, allowing catch_child_signal to copy
7974 it into lib_child_handler. */
7975 g_source_unref (g_child_watch_source_new (getpid ()));
7977 catch_child_signal ();
7980 #ifdef HAVE_SETRLIMIT
7981 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
7982 if (getrlimit (RLIMIT_NOFILE
, &nofile_limit
) != 0)
7983 nofile_limit
.rlim_cur
= 0;
7984 else if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
7986 struct rlimit rlim
= nofile_limit
;
7987 rlim
.rlim_cur
= FD_SETSIZE
;
7988 if (setrlimit (RLIMIT_NOFILE
, &rlim
) != 0)
7989 nofile_limit
.rlim_cur
= 0;
7993 external_sock_fd
= sockfd
;
7995 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7997 num_pending_connects
= 0;
7999 process_output_delay_count
= 0;
8000 process_output_skip
= 0;
8002 /* Don't do this, it caused infinite select loops. The display
8003 method should call add_keyboard_wait_descriptor on stdin if it
8006 FD_SET (0, &input_wait_mask
);
8009 Vprocess_alist
= Qnil
;
8010 deleted_pid_list
= Qnil
;
8011 for (i
= 0; i
< FD_SETSIZE
; i
++)
8013 chan_process
[i
] = Qnil
;
8014 proc_buffered_char
[i
] = -1;
8016 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
8017 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
8018 #ifdef DATAGRAM_SOCKETS
8019 memset (datagram_address
, 0, sizeof datagram_address
);
8022 #if defined (DARWIN_OS)
8023 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8024 processes. As such, we only change the default value. */
8027 char const *release
= (STRINGP (Voperating_system_release
)
8028 ? SSDATA (Voperating_system_release
)
8030 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
8031 Vprocess_connection_type
= Qnil
;
8035 #endif /* subprocesses */
8040 syms_of_process (void)
8044 DEFSYM (Qprocessp
, "processp");
8045 DEFSYM (Qrun
, "run");
8046 DEFSYM (Qstop
, "stop");
8047 DEFSYM (Qsignal
, "signal");
8049 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8052 DEFSYM (Qopen
, "open");
8053 DEFSYM (Qclosed
, "closed");
8054 DEFSYM (Qconnect
, "connect");
8055 DEFSYM (Qfailed
, "failed");
8056 DEFSYM (Qlisten
, "listen");
8057 DEFSYM (Qlocal
, "local");
8058 DEFSYM (Qipv4
, "ipv4");
8060 DEFSYM (Qipv6
, "ipv6");
8062 DEFSYM (Qdatagram
, "datagram");
8063 DEFSYM (Qseqpacket
, "seqpacket");
8065 DEFSYM (QCport
, ":port");
8066 DEFSYM (QCspeed
, ":speed");
8067 DEFSYM (QCprocess
, ":process");
8069 DEFSYM (QCbytesize
, ":bytesize");
8070 DEFSYM (QCstopbits
, ":stopbits");
8071 DEFSYM (QCparity
, ":parity");
8072 DEFSYM (Qodd
, "odd");
8073 DEFSYM (Qeven
, "even");
8074 DEFSYM (QCflowcontrol
, ":flowcontrol");
8077 DEFSYM (QCsummary
, ":summary");
8079 DEFSYM (Qreal
, "real");
8080 DEFSYM (Qnetwork
, "network");
8081 DEFSYM (Qserial
, "serial");
8082 DEFSYM (Qpipe
, "pipe");
8083 DEFSYM (QCbuffer
, ":buffer");
8084 DEFSYM (QChost
, ":host");
8085 DEFSYM (QCservice
, ":service");
8086 DEFSYM (QClocal
, ":local");
8087 DEFSYM (QCremote
, ":remote");
8088 DEFSYM (QCcoding
, ":coding");
8089 DEFSYM (QCserver
, ":server");
8090 DEFSYM (QCnowait
, ":nowait");
8091 DEFSYM (QCsentinel
, ":sentinel");
8092 DEFSYM (QCuse_external_socket
, ":use-external-socket");
8093 DEFSYM (QCtls_parameters
, ":tls-parameters");
8094 DEFSYM (Qnsm_verify_connection
, "nsm-verify-connection");
8095 DEFSYM (QClog
, ":log");
8096 DEFSYM (QCnoquery
, ":noquery");
8097 DEFSYM (QCstop
, ":stop");
8098 DEFSYM (QCplist
, ":plist");
8099 DEFSYM (QCcommand
, ":command");
8100 DEFSYM (QCconnection_type
, ":connection-type");
8101 DEFSYM (QCstderr
, ":stderr");
8102 DEFSYM (Qpty
, "pty");
8103 DEFSYM (Qpipe
, "pipe");
8105 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
8107 staticpro (&Vprocess_alist
);
8108 staticpro (&deleted_pid_list
);
8110 #endif /* subprocesses */
8112 DEFSYM (QCname
, ":name");
8113 DEFSYM (QCtype
, ":type");
8115 DEFSYM (Qeuid
, "euid");
8116 DEFSYM (Qegid
, "egid");
8117 DEFSYM (Quser
, "user");
8118 DEFSYM (Qgroup
, "group");
8119 DEFSYM (Qcomm
, "comm");
8120 DEFSYM (Qstate
, "state");
8121 DEFSYM (Qppid
, "ppid");
8122 DEFSYM (Qpgrp
, "pgrp");
8123 DEFSYM (Qsess
, "sess");
8124 DEFSYM (Qttname
, "ttname");
8125 DEFSYM (Qtpgid
, "tpgid");
8126 DEFSYM (Qminflt
, "minflt");
8127 DEFSYM (Qmajflt
, "majflt");
8128 DEFSYM (Qcminflt
, "cminflt");
8129 DEFSYM (Qcmajflt
, "cmajflt");
8130 DEFSYM (Qutime
, "utime");
8131 DEFSYM (Qstime
, "stime");
8132 DEFSYM (Qtime
, "time");
8133 DEFSYM (Qcutime
, "cutime");
8134 DEFSYM (Qcstime
, "cstime");
8135 DEFSYM (Qctime
, "ctime");
8137 DEFSYM (Qinternal_default_process_sentinel
,
8138 "internal-default-process-sentinel");
8139 DEFSYM (Qinternal_default_process_filter
,
8140 "internal-default-process-filter");
8142 DEFSYM (Qpri
, "pri");
8143 DEFSYM (Qnice
, "nice");
8144 DEFSYM (Qthcount
, "thcount");
8145 DEFSYM (Qstart
, "start");
8146 DEFSYM (Qvsize
, "vsize");
8147 DEFSYM (Qrss
, "rss");
8148 DEFSYM (Qetime
, "etime");
8149 DEFSYM (Qpcpu
, "pcpu");
8150 DEFSYM (Qpmem
, "pmem");
8151 DEFSYM (Qargs
, "args");
8153 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
8154 doc
: /* Non-nil means delete processes immediately when they exit.
8155 A value of nil means don't delete them until `list-processes' is run. */);
8157 delete_exited_processes
= 1;
8160 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
8161 doc
: /* Control type of device used to communicate with subprocesses.
8162 Values are nil to use a pipe, or t or `pty' to use a pty.
8163 The value has no effect if the system has no ptys or if all ptys are busy:
8164 then a pipe is used in any case.
8165 The value takes effect when `start-process' is called. */);
8166 Vprocess_connection_type
= Qt
;
8168 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
8169 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
8170 On some systems, when Emacs reads the output from a subprocess, the output data
8171 is read in very small blocks, potentially resulting in very poor performance.
8172 This behavior can be remedied to some extent by setting this variable to a
8173 non-nil value, as it will automatically delay reading from such processes, to
8174 allow them to produce more output before Emacs tries to read it.
8175 If the value is t, the delay is reset after each write to the process; any other
8176 non-nil value means that the delay is not reset on write.
8177 The variable takes effect when `start-process' is called. */);
8178 Vprocess_adaptive_read_buffering
= Qt
;
8180 defsubr (&Sprocessp
);
8181 defsubr (&Sget_process
);
8182 defsubr (&Sdelete_process
);
8183 defsubr (&Sprocess_status
);
8184 defsubr (&Sprocess_exit_status
);
8185 defsubr (&Sprocess_id
);
8186 defsubr (&Sprocess_name
);
8187 defsubr (&Sprocess_tty_name
);
8188 defsubr (&Sprocess_command
);
8189 defsubr (&Sset_process_buffer
);
8190 defsubr (&Sprocess_buffer
);
8191 defsubr (&Sprocess_mark
);
8192 defsubr (&Sset_process_filter
);
8193 defsubr (&Sprocess_filter
);
8194 defsubr (&Sset_process_sentinel
);
8195 defsubr (&Sprocess_sentinel
);
8196 defsubr (&Sset_process_thread
);
8197 defsubr (&Sprocess_thread
);
8198 defsubr (&Sset_process_window_size
);
8199 defsubr (&Sset_process_inherit_coding_system_flag
);
8200 defsubr (&Sset_process_query_on_exit_flag
);
8201 defsubr (&Sprocess_query_on_exit_flag
);
8202 defsubr (&Sprocess_contact
);
8203 defsubr (&Sprocess_plist
);
8204 defsubr (&Sset_process_plist
);
8205 defsubr (&Sprocess_list
);
8206 defsubr (&Smake_process
);
8207 defsubr (&Smake_pipe_process
);
8208 defsubr (&Sserial_process_configure
);
8209 defsubr (&Smake_serial_process
);
8210 defsubr (&Sset_network_process_option
);
8211 defsubr (&Smake_network_process
);
8212 defsubr (&Sformat_network_address
);
8213 defsubr (&Snetwork_interface_list
);
8214 defsubr (&Snetwork_interface_info
);
8215 #ifdef DATAGRAM_SOCKETS
8216 defsubr (&Sprocess_datagram_address
);
8217 defsubr (&Sset_process_datagram_address
);
8219 defsubr (&Saccept_process_output
);
8220 defsubr (&Sprocess_send_region
);
8221 defsubr (&Sprocess_send_string
);
8222 defsubr (&Sinterrupt_process
);
8223 defsubr (&Skill_process
);
8224 defsubr (&Squit_process
);
8225 defsubr (&Sstop_process
);
8226 defsubr (&Scontinue_process
);
8227 defsubr (&Sprocess_running_child_p
);
8228 defsubr (&Sprocess_send_eof
);
8229 defsubr (&Ssignal_process
);
8230 defsubr (&Swaiting_for_user_input_p
);
8231 defsubr (&Sprocess_type
);
8232 defsubr (&Sinternal_default_process_sentinel
);
8233 defsubr (&Sinternal_default_process_filter
);
8234 defsubr (&Sset_process_coding_system
);
8235 defsubr (&Sprocess_coding_system
);
8236 defsubr (&Sset_process_filter_multibyte
);
8237 defsubr (&Sprocess_filter_multibyte_p
);
8240 Lisp_Object subfeatures
= Qnil
;
8241 const struct socket_options
*sopt
;
8243 #define ADD_SUBFEATURE(key, val) \
8244 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8246 ADD_SUBFEATURE (QCnowait
, Qt
);
8247 #ifdef DATAGRAM_SOCKETS
8248 ADD_SUBFEATURE (QCtype
, Qdatagram
);
8250 #ifdef HAVE_SEQPACKET
8251 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
8253 #ifdef HAVE_LOCAL_SOCKETS
8254 ADD_SUBFEATURE (QCfamily
, Qlocal
);
8256 ADD_SUBFEATURE (QCfamily
, Qipv4
);
8258 ADD_SUBFEATURE (QCfamily
, Qipv6
);
8260 #ifdef HAVE_GETSOCKNAME
8261 ADD_SUBFEATURE (QCservice
, Qt
);
8263 ADD_SUBFEATURE (QCserver
, Qt
);
8265 for (sopt
= socket_options
; sopt
->name
; sopt
++)
8266 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
8268 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
8271 #endif /* subprocesses */
8273 defsubr (&Sget_buffer_process
);
8274 defsubr (&Sprocess_inherit_coding_system_flag
);
8275 defsubr (&Slist_system_processes
);
8276 defsubr (&Sprocess_attributes
);