1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2018 Free Software
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or (at
11 your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
27 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
35 /* Only MS-DOS does not define `subprocesses'. */
38 #include <sys/socket.h>
40 #include <netinet/in.h>
41 #include <arpa/inet.h>
43 #endif /* subprocesses */
46 # include <sys/resource.h>
48 /* If NOFILE_LIMIT.rlim_cur is greater than FD_SETSIZE, then
49 NOFILE_LIMIT is the initial limit on the number of open files,
50 which should be restored in child processes. */
51 static struct rlimit nofile_limit
;
56 /* Are local (unix) sockets supported? */
57 #if defined (HAVE_SYS_UN_H)
58 #if !defined (AF_LOCAL) && defined (AF_UNIX)
59 #define AF_LOCAL AF_UNIX
62 #define HAVE_LOCAL_SOCKETS
67 #include <sys/ioctl.h>
68 #if defined (HAVE_NET_IF_H)
70 #endif /* HAVE_NET_IF_H */
72 #if defined (HAVE_IFADDRS_H)
73 /* Must be after net/if.h */
76 /* We only use structs from this header when we use getifaddrs. */
77 #if defined (HAVE_NET_IF_DL_H)
78 #include <net/if_dl.h>
88 # include <sys/stream.h>
89 # include <sys/stropts.h>
101 #include <flexmember.h>
105 #endif /* subprocesses */
111 #include "character.h"
116 #include "termopts.h"
117 #include "keyboard.h"
118 #include "blockinput.h"
120 #include "sysselect.h"
121 #include "syssignal.h"
127 #ifdef HAVE_WINDOW_SYSTEM
129 #endif /* HAVE_WINDOW_SYSTEM */
132 #include "xgselect.h"
138 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
139 /* This is 0.1s in nanoseconds. */
140 #define ASYNC_RETRY_NSEC 100000000
144 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
145 const struct timespec
*, const sigset_t
*);
148 /* Work around GCC 4.3.0 bug with strict overflow checking; see
149 <https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
150 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
151 #if GNUC_PREREQ (4, 3, 0) && ! GNUC_PREREQ (5, 1, 0)
152 # pragma GCC diagnostic ignored "-Wstrict-overflow"
155 /* True if keyboard input is on hold, zero otherwise. */
157 static bool kbd_is_on_hold
;
159 /* Nonzero means don't run process sentinels. This is used
161 bool inhibit_sentinels
;
166 # define SOCK_CLOEXEC 0
168 #ifndef SOCK_NONBLOCK
169 # define SOCK_NONBLOCK 0
172 /* True if ERRNUM represents an error where the system call would
173 block if a blocking variant were used. */
175 would_block (int errnum
)
178 if (EWOULDBLOCK
!= EAGAIN
&& errnum
== EWOULDBLOCK
)
181 return errnum
== EAGAIN
;
186 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
189 close_on_exec (int fd
)
192 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
197 # define accept4(sockfd, addr, addrlen, flags) \
198 process_accept4 (sockfd, addr, addrlen, flags)
200 accept4 (int sockfd
, struct sockaddr
*addr
, socklen_t
*addrlen
, int flags
)
202 return close_on_exec (accept (sockfd
, addr
, addrlen
));
206 process_socket (int domain
, int type
, int protocol
)
208 return close_on_exec (socket (domain
, type
, protocol
));
211 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
214 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
215 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
216 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
217 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
218 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
219 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
221 /* Number of events of change of status of a process. */
222 static EMACS_INT process_tick
;
223 /* Number of events for which the user or sentinel has been notified. */
224 static EMACS_INT update_tick
;
226 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
227 this system. We need to read full packets, so we need a
228 "non-destructive" select. So we require either native select,
229 or emulation of select using FIONREAD. */
231 #ifndef BROKEN_DATAGRAM_SOCKETS
232 # if defined HAVE_SELECT || defined USABLE_FIONREAD
233 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
234 # define DATAGRAM_SOCKETS
239 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
240 # define HAVE_SEQPACKET
243 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
244 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
245 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
247 /* Number of processes which have a non-zero read_output_delay,
248 and therefore might be delayed for adaptive read buffering. */
250 static int process_output_delay_count
;
252 /* True if any process has non-nil read_output_skip. */
254 static bool process_output_skip
;
256 static void start_process_unwind (Lisp_Object
);
257 static void create_process (Lisp_Object
, char **, Lisp_Object
);
259 static bool keyboard_bit_set (fd_set
*);
261 static void deactivate_process (Lisp_Object
);
262 static int status_notify (struct Lisp_Process
*, struct Lisp_Process
*);
263 static int read_process_output (Lisp_Object
, int);
264 static void create_pty (Lisp_Object
);
265 static void exec_sentinel (Lisp_Object
, Lisp_Object
);
267 /* Number of bits set in connect_wait_mask. */
268 static int num_pending_connects
;
270 /* The largest descriptor currently in use; -1 if none. */
273 /* Set the external socket descriptor for Emacs to use when
274 `make-network-process' is called with a non-nil
275 `:use-external-socket' option. The value should be either -1, or
276 the file descriptor of a socket that is already bound. */
277 static int external_sock_fd
;
279 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
280 static Lisp_Object chan_process
[FD_SETSIZE
];
281 static void wait_for_socket_fds (Lisp_Object
, char const *);
283 /* Alist of elements (NAME . PROCESS). */
284 static Lisp_Object Vprocess_alist
;
286 /* Buffered-ahead input char from process, indexed by channel.
287 -1 means empty (no char is buffered).
288 Used on sys V where the only way to tell if there is any
289 output from the process is to read at least one char.
290 Always -1 on systems that support FIONREAD. */
292 static int proc_buffered_char
[FD_SETSIZE
];
294 /* Table of `struct coding-system' for each process. */
295 static struct coding_system
*proc_decode_coding_system
[FD_SETSIZE
];
296 static struct coding_system
*proc_encode_coding_system
[FD_SETSIZE
];
298 #ifdef DATAGRAM_SOCKETS
299 /* Table of `partner address' for datagram sockets. */
300 static struct sockaddr_and_len
{
303 } datagram_address
[FD_SETSIZE
];
304 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
305 #define DATAGRAM_CONN_P(proc) \
306 (PROCESSP (proc) && \
307 XPROCESS (proc)->infd >= 0 && \
308 datagram_address[XPROCESS (proc)->infd].sa != 0)
310 #define DATAGRAM_CONN_P(proc) (0)
313 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
314 a `for' loop which iterates over processes from Vprocess_alist. */
316 #define FOR_EACH_PROCESS(list_var, proc_var) \
317 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
319 /* These setters are used only in this file, so they can be private. */
321 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
326 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
331 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
333 p
->decode_coding_system
= val
;
336 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
338 p
->decoding_buf
= val
;
341 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
343 p
->encode_coding_system
= val
;
346 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
348 p
->encoding_buf
= val
;
351 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
353 p
->filter
= NILP (val
) ? Qinternal_default_process_filter
: val
;
356 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
361 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
366 pset_thread (struct Lisp_Process
*p
, Lisp_Object val
)
371 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
376 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
381 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
383 p
->sentinel
= NILP (val
) ? Qinternal_default_process_sentinel
: val
;
386 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
391 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
396 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
398 p
->write_queue
= val
;
401 pset_stderrproc (struct Lisp_Process
*p
, Lisp_Object val
)
408 make_lisp_proc (struct Lisp_Process
*p
)
410 return make_lisp_ptr (p
, Lisp_Vectorlike
);
415 /* Read from file descriptor. */
417 /* Write to file descriptor. */
419 /* This descriptor refers to a keyboard. Only valid if FOR_READ is
422 /* This descriptor refers to a process. */
424 /* A non-blocking connect. Only valid if FOR_WRITE is set. */
425 NON_BLOCKING_CONNECT_FD
= 16
428 static struct fd_callback_data
432 /* Flags from enum fd_bits. */
434 /* If this fd is locked to a certain thread, this points to it.
435 Otherwise, this is NULL. If an fd is locked to a thread, then
436 only that thread is permitted to wait on it. */
437 struct thread_state
*thread
;
438 /* If this fd is currently being selected on by a thread, this
439 points to the thread. Otherwise it is NULL. */
440 struct thread_state
*waiting_thread
;
441 } fd_callback_info
[FD_SETSIZE
];
444 /* Add a file descriptor FD to be monitored for when read is possible.
445 When read is possible, call FUNC with argument DATA. */
448 add_read_fd (int fd
, fd_callback func
, void *data
)
450 add_keyboard_wait_descriptor (fd
);
452 fd_callback_info
[fd
].func
= func
;
453 fd_callback_info
[fd
].data
= data
;
457 add_non_keyboard_read_fd (int fd
)
459 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
460 eassert (fd_callback_info
[fd
].func
== NULL
);
462 fd_callback_info
[fd
].flags
&= ~KEYBOARD_FD
;
463 fd_callback_info
[fd
].flags
|= FOR_READ
;
469 add_process_read_fd (int fd
)
471 add_non_keyboard_read_fd (fd
);
472 fd_callback_info
[fd
].flags
|= PROCESS_FD
;
475 /* Stop monitoring file descriptor FD for when read is possible. */
478 delete_read_fd (int fd
)
480 delete_keyboard_wait_descriptor (fd
);
482 if (fd_callback_info
[fd
].flags
== 0)
484 fd_callback_info
[fd
].func
= 0;
485 fd_callback_info
[fd
].data
= 0;
489 /* Add a file descriptor FD to be monitored for when write is possible.
490 When write is possible, call FUNC with argument DATA. */
493 add_write_fd (int fd
, fd_callback func
, void *data
)
495 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
497 fd_callback_info
[fd
].func
= func
;
498 fd_callback_info
[fd
].data
= data
;
499 fd_callback_info
[fd
].flags
|= FOR_WRITE
;
505 add_non_blocking_write_fd (int fd
)
507 eassert (fd
>= 0 && fd
< FD_SETSIZE
);
508 eassert (fd_callback_info
[fd
].func
== NULL
);
510 fd_callback_info
[fd
].flags
|= FOR_WRITE
| NON_BLOCKING_CONNECT_FD
;
513 ++num_pending_connects
;
517 recompute_max_desc (void)
521 for (fd
= max_desc
; fd
>= 0; --fd
)
523 if (fd_callback_info
[fd
].flags
!= 0)
531 /* Stop monitoring file descriptor FD for when write is possible. */
534 delete_write_fd (int fd
)
536 if ((fd_callback_info
[fd
].flags
& NON_BLOCKING_CONNECT_FD
) != 0)
538 if (--num_pending_connects
< 0)
541 fd_callback_info
[fd
].flags
&= ~(FOR_WRITE
| NON_BLOCKING_CONNECT_FD
);
542 if (fd_callback_info
[fd
].flags
== 0)
544 fd_callback_info
[fd
].func
= 0;
545 fd_callback_info
[fd
].data
= 0;
548 recompute_max_desc ();
553 compute_input_wait_mask (fd_set
*mask
)
558 for (fd
= 0; fd
<= max_desc
; ++fd
)
560 if (fd_callback_info
[fd
].thread
!= NULL
561 && fd_callback_info
[fd
].thread
!= current_thread
)
563 if (fd_callback_info
[fd
].waiting_thread
!= NULL
564 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
566 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0)
569 fd_callback_info
[fd
].waiting_thread
= current_thread
;
575 compute_non_process_wait_mask (fd_set
*mask
)
580 for (fd
= 0; fd
<= max_desc
; ++fd
)
582 if (fd_callback_info
[fd
].thread
!= NULL
583 && fd_callback_info
[fd
].thread
!= current_thread
)
585 if (fd_callback_info
[fd
].waiting_thread
!= NULL
586 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
588 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0
589 && (fd_callback_info
[fd
].flags
& PROCESS_FD
) == 0)
592 fd_callback_info
[fd
].waiting_thread
= current_thread
;
598 compute_non_keyboard_wait_mask (fd_set
*mask
)
603 for (fd
= 0; fd
<= max_desc
; ++fd
)
605 if (fd_callback_info
[fd
].thread
!= NULL
606 && fd_callback_info
[fd
].thread
!= current_thread
)
608 if (fd_callback_info
[fd
].waiting_thread
!= NULL
609 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
611 if ((fd_callback_info
[fd
].flags
& FOR_READ
) != 0
612 && (fd_callback_info
[fd
].flags
& KEYBOARD_FD
) == 0)
615 fd_callback_info
[fd
].waiting_thread
= current_thread
;
621 compute_write_mask (fd_set
*mask
)
626 for (fd
= 0; fd
<= max_desc
; ++fd
)
628 if (fd_callback_info
[fd
].thread
!= NULL
629 && fd_callback_info
[fd
].thread
!= current_thread
)
631 if (fd_callback_info
[fd
].waiting_thread
!= NULL
632 && fd_callback_info
[fd
].waiting_thread
!= current_thread
)
634 if ((fd_callback_info
[fd
].flags
& FOR_WRITE
) != 0)
637 fd_callback_info
[fd
].waiting_thread
= current_thread
;
643 clear_waiting_thread_info (void)
647 for (fd
= 0; fd
<= max_desc
; ++fd
)
649 if (fd_callback_info
[fd
].waiting_thread
== current_thread
)
650 fd_callback_info
[fd
].waiting_thread
= NULL
;
655 /* Compute the Lisp form of the process status, p->status, from
656 the numeric status that was returned by `wait'. */
658 static Lisp_Object
status_convert (int);
661 update_status (struct Lisp_Process
*p
)
663 eassert (p
->raw_status_new
);
664 pset_status (p
, status_convert (p
->raw_status
));
665 p
->raw_status_new
= 0;
668 /* Convert a process status word in Unix format to
669 the list that we use internally. */
672 status_convert (int w
)
675 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
676 else if (WIFEXITED (w
))
677 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
678 WCOREDUMP (w
) ? Qt
: Qnil
));
679 else if (WIFSIGNALED (w
))
680 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
681 WCOREDUMP (w
) ? Qt
: Qnil
));
686 /* True if STATUS is that of a process attempting connection. */
689 connecting_status (Lisp_Object status
)
691 return CONSP (status
) && EQ (XCAR (status
), Qconnect
);
694 /* Given a status-list, extract the three pieces of information
695 and store them individually through the three pointers. */
698 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, Lisp_Object
*code
,
703 if (connecting_status (l
))
709 *code
= make_number (0);
718 *coredump
= !NILP (tem
);
722 /* Return a string describing a process status list. */
725 status_message (struct Lisp_Process
*p
)
727 Lisp_Object status
= p
->status
;
728 Lisp_Object symbol
, code
;
732 decode_status (status
, &symbol
, &code
, &coredump
);
734 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
737 synchronize_system_messages_locale ();
738 signame
= strsignal (XFASTINT (code
));
740 string
= build_string ("unknown");
745 string
= build_unibyte_string (signame
);
746 if (! NILP (Vlocale_coding_system
))
747 string
= (code_convert_string_norecord
748 (string
, Vlocale_coding_system
, 0));
749 c1
= STRING_CHAR (SDATA (string
));
752 Faset (string
, make_number (0), make_number (c2
));
754 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
755 return concat2 (string
, suffix
);
757 else if (EQ (symbol
, Qexit
))
760 return build_string (XFASTINT (code
) == 0
762 : "connection broken by remote peer\n");
763 if (XFASTINT (code
) == 0)
764 return build_string ("finished\n");
765 AUTO_STRING (prefix
, "exited abnormally with code ");
766 string
= Fnumber_to_string (code
);
767 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
768 return concat3 (prefix
, string
, suffix
);
770 else if (EQ (symbol
, Qfailed
))
772 AUTO_STRING (format
, "failed with code %s\n");
773 return CALLN (Fformat
, format
, code
);
776 return Fcopy_sequence (Fsymbol_name (symbol
));
779 enum { PTY_NAME_SIZE
= 24 };
781 /* Open an available pty, returning a file descriptor.
782 Store into PTY_NAME the file name of the terminal corresponding to the pty.
783 Return -1 on failure. */
786 allocate_pty (char pty_name
[PTY_NAME_SIZE
])
795 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
796 for (i
= 0; i
< 16; i
++)
799 #ifdef PTY_NAME_SPRINTF
802 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
803 #endif /* no PTY_NAME_SPRINTF */
807 #else /* no PTY_OPEN */
808 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
809 #endif /* no PTY_OPEN */
813 #ifdef PTY_TTY_NAME_SPRINTF
816 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
817 #endif /* no PTY_TTY_NAME_SPRINTF */
819 /* Set FD's close-on-exec flag. This is needed even if
820 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
821 doesn't require support for that combination.
822 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
823 doesn't work if the close-on-exec flag is set (Bug#20555).
824 Multithreaded platforms where posix_openpt ignores
825 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
826 have a race condition between the PTY_OPEN and here. */
827 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
829 /* Check to make certain that both sides are available.
830 This avoids a nasty yet stupid bug in rlogins. */
831 if (faccessat (AT_FDCWD
, pty_name
, R_OK
| W_OK
, AT_EACCESS
) != 0)
840 #endif /* HAVE_PTYS */
844 /* Allocate basically initialized process. */
846 static struct Lisp_Process
*
847 allocate_process (void)
849 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
853 make_process (Lisp_Object name
)
855 struct Lisp_Process
*p
= allocate_process ();
856 /* Initialize Lisp data. Note that allocate_process initializes all
857 Lisp data to nil, so do it only for slots which should not be nil. */
858 pset_status (p
, Qrun
);
859 pset_mark (p
, Fmake_marker ());
860 pset_thread (p
, Fcurrent_thread ());
862 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
863 non-Lisp data, so do it only for slots which should not be zero. */
866 for (int i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
870 verify (GNUTLS_STAGE_EMPTY
== 0);
871 eassert (p
->gnutls_initstage
== GNUTLS_STAGE_EMPTY
);
872 eassert (NILP (p
->gnutls_boot_parameters
));
875 /* If name is already in use, modify it until it is unused. */
877 Lisp_Object name1
= name
;
878 for (printmax_t i
= 1; ; i
++)
880 Lisp_Object tem
= Fget_process (name1
);
883 char const suffix_fmt
[] = "<%"pMd
">";
884 char suffix
[sizeof suffix_fmt
+ INT_STRLEN_BOUND (printmax_t
)];
885 AUTO_STRING_WITH_LEN (lsuffix
, suffix
, sprintf (suffix
, suffix_fmt
, i
));
886 name1
= concat2 (name
, lsuffix
);
890 pset_sentinel (p
, Qinternal_default_process_sentinel
);
891 pset_filter (p
, Qinternal_default_process_filter
);
893 XSETPROCESS (val
, p
);
894 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
899 remove_process (register Lisp_Object proc
)
901 register Lisp_Object pair
;
903 pair
= Frassq (proc
, Vprocess_alist
);
904 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
906 deactivate_process (proc
);
910 update_processes_for_thread_death (Lisp_Object dying_thread
)
914 for (pair
= Vprocess_alist
; !NILP (pair
); pair
= XCDR (pair
))
916 Lisp_Object process
= XCDR (XCAR (pair
));
917 if (EQ (XPROCESS (process
)->thread
, dying_thread
))
919 struct Lisp_Process
*proc
= XPROCESS (process
);
921 pset_thread (proc
, Qnil
);
923 fd_callback_info
[proc
->infd
].thread
= NULL
;
924 if (proc
->outfd
>= 0)
925 fd_callback_info
[proc
->outfd
].thread
= NULL
;
930 #ifdef HAVE_GETADDRINFO_A
932 free_dns_request (Lisp_Object proc
)
934 struct Lisp_Process
*p
= XPROCESS (proc
);
936 if (p
->dns_request
->ar_result
)
937 freeaddrinfo (p
->dns_request
->ar_result
);
938 xfree (p
->dns_request
);
939 p
->dns_request
= NULL
;
944 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
945 doc
: /* Return t if OBJECT is a process. */)
948 return PROCESSP (object
) ? Qt
: Qnil
;
951 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
952 doc
: /* Return the process named NAME, or nil if there is none. */)
953 (register Lisp_Object name
)
958 return Fcdr (Fassoc (name
, Vprocess_alist
, Qnil
));
961 /* This is how commands for the user decode process arguments. It
962 accepts a process, a process name, a buffer, a buffer name, or nil.
963 Buffers denote the first process in the buffer, and nil denotes the
967 get_process (register Lisp_Object name
)
969 register Lisp_Object proc
, obj
;
972 obj
= Fget_process (name
);
974 obj
= Fget_buffer (name
);
976 error ("Process %s does not exist", SDATA (name
));
978 else if (NILP (name
))
979 obj
= Fcurrent_buffer ();
983 /* Now obj should be either a buffer object or a process object. */
986 if (NILP (BVAR (XBUFFER (obj
), name
)))
987 error ("Attempt to get process for a dead buffer");
988 proc
= Fget_buffer_process (obj
);
990 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
1001 /* Fdelete_process promises to immediately forget about the process, but in
1002 reality, Emacs needs to remember those processes until they have been
1003 treated by the SIGCHLD handler and waitpid has been invoked on them;
1004 otherwise they might fill up the kernel's process table.
1006 Some processes created by call-process are also put onto this list.
1008 Members of this list are (process-ID . filename) pairs. The
1009 process-ID is a number; the filename, if a string, is a file that
1010 needs to be removed after the process exits. */
1011 static Lisp_Object deleted_pid_list
;
1014 record_deleted_pid (pid_t pid
, Lisp_Object filename
)
1016 deleted_pid_list
= Fcons (Fcons (make_fixnum_or_float (pid
), filename
),
1017 /* GC treated elements set to nil. */
1018 Fdelq (Qnil
, deleted_pid_list
));
1022 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
1023 doc
: /* Delete PROCESS: kill it and forget about it immediately.
1024 PROCESS may be a process, a buffer, the name of a process or buffer, or
1025 nil, indicating the current buffer's process. */)
1026 (register Lisp_Object process
)
1028 register struct Lisp_Process
*p
;
1030 process
= get_process (process
);
1031 p
= XPROCESS (process
);
1033 #ifdef HAVE_GETADDRINFO_A
1036 /* Cancel the request. Unless shutting down, wait until
1037 completion. Free the request if completely canceled. */
1039 bool canceled
= gai_cancel (p
->dns_request
) != EAI_NOTCANCELED
;
1040 if (!canceled
&& !inhibit_sentinels
)
1042 struct gaicb
const *req
= p
->dns_request
;
1043 while (gai_suspend (&req
, 1, NULL
) != 0)
1048 free_dns_request (process
);
1052 p
->raw_status_new
= 0;
1053 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1055 pset_status (p
, list2 (Qexit
, make_number (0)));
1056 p
->tick
= ++process_tick
;
1057 status_notify (p
, NULL
);
1058 redisplay_preserve_echo_area (13);
1063 record_kill_process (p
, Qnil
);
1067 /* Update P's status, since record_kill_process will make the
1068 SIGCHLD handler update deleted_pid_list, not *P. */
1070 if (p
->raw_status_new
)
1072 symbol
= CONSP (p
->status
) ? XCAR (p
->status
) : p
->status
;
1073 if (! (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)))
1074 pset_status (p
, list2 (Qsignal
, make_number (SIGKILL
)));
1076 p
->tick
= ++process_tick
;
1077 status_notify (p
, NULL
);
1078 redisplay_preserve_echo_area (13);
1081 remove_process (process
);
1085 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
1086 doc
: /* Return the status of PROCESS.
1087 The returned value is one of the following symbols:
1088 run -- for a process that is running.
1089 stop -- for a process stopped but continuable.
1090 exit -- for a process that has exited.
1091 signal -- for a process that has got a fatal signal.
1092 open -- for a network stream connection that is open.
1093 listen -- for a network stream server that is listening.
1094 closed -- for a network stream connection that is closed.
1095 connect -- when waiting for a non-blocking connection to complete.
1096 failed -- when a non-blocking connection has failed.
1097 nil -- if arg is a process name and no such process exists.
1098 PROCESS may be a process, a buffer, the name of a process, or
1099 nil, indicating the current buffer's process. */)
1100 (register Lisp_Object process
)
1102 register struct Lisp_Process
*p
;
1103 register Lisp_Object status
;
1105 if (STRINGP (process
))
1106 process
= Fget_process (process
);
1108 process
= get_process (process
);
1113 p
= XPROCESS (process
);
1114 if (p
->raw_status_new
)
1118 status
= XCAR (status
);
1119 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1121 if (EQ (status
, Qexit
))
1123 else if (EQ (p
->command
, Qt
))
1125 else if (EQ (status
, Qrun
))
1131 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
1133 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
1134 If PROCESS has not yet exited or died, return 0. */)
1135 (register Lisp_Object process
)
1137 CHECK_PROCESS (process
);
1138 if (XPROCESS (process
)->raw_status_new
)
1139 update_status (XPROCESS (process
));
1140 if (CONSP (XPROCESS (process
)->status
))
1141 return XCAR (XCDR (XPROCESS (process
)->status
));
1142 return make_number (0);
1145 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
1146 doc
: /* Return the process id of PROCESS.
1147 This is the pid of the external process which PROCESS uses or talks to.
1148 For a network, serial, and pipe connections, this value is nil. */)
1149 (register Lisp_Object process
)
1153 CHECK_PROCESS (process
);
1154 pid
= XPROCESS (process
)->pid
;
1155 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
1158 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
1159 doc
: /* Return the name of PROCESS, as a string.
1160 This is the name of the program invoked in PROCESS,
1161 possibly modified to make it unique among process names. */)
1162 (register Lisp_Object process
)
1164 CHECK_PROCESS (process
);
1165 return XPROCESS (process
)->name
;
1168 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
1169 doc
: /* Return the command that was executed to start PROCESS.
1170 This is a list of strings, the first string being the program executed
1171 and the rest of the strings being the arguments given to it.
1172 For a network or serial or pipe connection, this is nil (process is running)
1173 or t (process is stopped). */)
1174 (register Lisp_Object process
)
1176 CHECK_PROCESS (process
);
1177 return XPROCESS (process
)->command
;
1180 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
1181 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
1182 This is the terminal that the process itself reads and writes on,
1183 not the name of the pty that Emacs uses to talk with that terminal. */)
1184 (register Lisp_Object process
)
1186 CHECK_PROCESS (process
);
1187 return XPROCESS (process
)->tty_name
;
1190 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
1192 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
1194 (register Lisp_Object process
, Lisp_Object buffer
)
1196 struct Lisp_Process
*p
;
1198 CHECK_PROCESS (process
);
1200 CHECK_BUFFER (buffer
);
1201 p
= XPROCESS (process
);
1202 pset_buffer (p
, buffer
);
1203 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1204 pset_childp (p
, Fplist_put (p
->childp
, QCbuffer
, buffer
));
1205 setup_process_coding_systems (process
);
1209 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
1211 doc
: /* Return the buffer PROCESS is associated with.
1212 The default process filter inserts output from PROCESS into this buffer. */)
1213 (register Lisp_Object process
)
1215 CHECK_PROCESS (process
);
1216 return XPROCESS (process
)->buffer
;
1219 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
1221 doc
: /* Return the marker for the end of the last output from PROCESS. */)
1222 (register Lisp_Object process
)
1224 CHECK_PROCESS (process
);
1225 return XPROCESS (process
)->mark
;
1229 set_process_filter_masks (struct Lisp_Process
*p
)
1231 if (EQ (p
->filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1232 delete_read_fd (p
->infd
);
1233 else if (EQ (p
->filter
, Qt
)
1234 /* Network or serial process not stopped: */
1235 && !EQ (p
->command
, Qt
))
1236 add_process_read_fd (p
->infd
);
1239 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1241 doc
: /* Give PROCESS the filter function FILTER; nil means default.
1242 A value of t means stop accepting output from the process.
1244 When a process has a non-default filter, its buffer is not used for output.
1245 Instead, each time it does output, the entire string of output is
1246 passed to the filter.
1248 The filter gets two arguments: the process and the string of output.
1249 The string argument is normally a multibyte string, except:
1250 - if the process's input coding system is no-conversion or raw-text,
1251 it is a unibyte string (the non-converted input), or else
1252 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1253 string (the result of converting the decoded input multibyte
1254 string to unibyte with `string-make-unibyte'). */)
1255 (Lisp_Object process
, Lisp_Object filter
)
1257 CHECK_PROCESS (process
);
1258 struct Lisp_Process
*p
= XPROCESS (process
);
1260 /* Don't signal an error if the process's input file descriptor
1261 is closed. This could make debugging Lisp more difficult,
1262 for example when doing something like
1264 (setq process (start-process ...))
1266 (set-process-filter process ...) */
1269 filter
= Qinternal_default_process_filter
;
1271 pset_filter (p
, filter
);
1274 set_process_filter_masks (p
);
1276 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1277 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1278 setup_process_coding_systems (process
);
1282 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1284 doc
: /* Return the filter function of PROCESS.
1285 See `set-process-filter' for more info on filter functions. */)
1286 (register Lisp_Object process
)
1288 CHECK_PROCESS (process
);
1289 return XPROCESS (process
)->filter
;
1292 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1294 doc
: /* Give PROCESS the sentinel SENTINEL; nil for default.
1295 The sentinel is called as a function when the process changes state.
1296 It gets two arguments: the process, and a string describing the change. */)
1297 (register Lisp_Object process
, Lisp_Object sentinel
)
1299 struct Lisp_Process
*p
;
1301 CHECK_PROCESS (process
);
1302 p
= XPROCESS (process
);
1304 if (NILP (sentinel
))
1305 sentinel
= Qinternal_default_process_sentinel
;
1307 pset_sentinel (p
, sentinel
);
1308 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1309 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1313 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1315 doc
: /* Return the sentinel of PROCESS.
1316 See `set-process-sentinel' for more info on sentinels. */)
1317 (register Lisp_Object process
)
1319 CHECK_PROCESS (process
);
1320 return XPROCESS (process
)->sentinel
;
1323 DEFUN ("set-process-thread", Fset_process_thread
, Sset_process_thread
,
1325 doc
: /* Set the locking thread of PROCESS to be THREAD.
1326 If THREAD is nil, the process is unlocked. */)
1327 (Lisp_Object process
, Lisp_Object thread
)
1329 struct Lisp_Process
*proc
;
1330 struct thread_state
*tstate
;
1332 CHECK_PROCESS (process
);
1337 CHECK_THREAD (thread
);
1338 tstate
= XTHREAD (thread
);
1341 proc
= XPROCESS (process
);
1342 pset_thread (proc
, thread
);
1343 if (proc
->infd
>= 0)
1344 fd_callback_info
[proc
->infd
].thread
= tstate
;
1345 if (proc
->outfd
>= 0)
1346 fd_callback_info
[proc
->outfd
].thread
= tstate
;
1351 DEFUN ("process-thread", Fprocess_thread
, Sprocess_thread
,
1353 doc
: /* Ret the locking thread of PROCESS.
1354 If PROCESS is unlocked, this function returns nil. */)
1355 (Lisp_Object process
)
1357 CHECK_PROCESS (process
);
1358 return XPROCESS (process
)->thread
;
1361 DEFUN ("set-process-window-size", Fset_process_window_size
,
1362 Sset_process_window_size
, 3, 3, 0,
1363 doc
: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
1364 Value is t if PROCESS was successfully told about the window size,
1366 (Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1368 CHECK_PROCESS (process
);
1370 /* All known platforms store window sizes as 'unsigned short'. */
1371 CHECK_RANGED_INTEGER (height
, 0, USHRT_MAX
);
1372 CHECK_RANGED_INTEGER (width
, 0, USHRT_MAX
);
1374 if (NETCONN_P (process
)
1375 || XPROCESS (process
)->infd
< 0
1376 || (set_window_size (XPROCESS (process
)->infd
,
1377 XINT (height
), XINT (width
))
1384 DEFUN ("set-process-inherit-coding-system-flag",
1385 Fset_process_inherit_coding_system_flag
,
1386 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1387 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1388 If the second argument FLAG is non-nil, then the variable
1389 `buffer-file-coding-system' of the buffer associated with PROCESS
1390 will be bound to the value of the coding system used to decode
1393 This is useful when the coding system specified for the process buffer
1394 leaves either the character code conversion or the end-of-line conversion
1395 unspecified, or if the coding system used to decode the process output
1396 is more appropriate for saving the process buffer.
1398 Binding the variable `inherit-process-coding-system' to non-nil before
1399 starting the process is an alternative way of setting the inherit flag
1400 for the process which will run.
1402 This function returns FLAG. */)
1403 (register Lisp_Object process
, Lisp_Object flag
)
1405 CHECK_PROCESS (process
);
1406 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1410 DEFUN ("set-process-query-on-exit-flag",
1411 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1413 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1414 If the second argument FLAG is non-nil, Emacs will query the user before
1415 exiting or killing a buffer if PROCESS is running. This function
1417 (register Lisp_Object process
, Lisp_Object flag
)
1419 CHECK_PROCESS (process
);
1420 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1424 DEFUN ("process-query-on-exit-flag",
1425 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1427 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1428 (register Lisp_Object process
)
1430 CHECK_PROCESS (process
);
1431 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1434 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1436 doc
: /* Return the contact info of PROCESS; t for a real child.
1437 For a network or serial or pipe connection, the value depends on the
1438 optional KEY arg. If KEY is nil, value is a cons cell of the form
1439 \(HOST SERVICE) for a network connection or (PORT SPEED) for a serial
1440 connection; it is t for a pipe connection. If KEY is t, the complete
1441 contact information for the connection is returned, else the specific
1442 value for the keyword KEY is returned. See `make-network-process',
1443 `make-serial-process', or `make pipe-process' for the list of keywords.
1444 If PROCESS is a non-blocking network process that hasn't been fully
1445 set up yet, this function will block until socket setup has completed. */)
1446 (Lisp_Object process
, Lisp_Object key
)
1448 Lisp_Object contact
;
1450 CHECK_PROCESS (process
);
1451 contact
= XPROCESS (process
)->childp
;
1453 #ifdef DATAGRAM_SOCKETS
1455 if (NETCONN_P (process
))
1456 wait_for_socket_fds (process
, "process-contact");
1458 if (DATAGRAM_CONN_P (process
)
1459 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1460 contact
= Fplist_put (contact
, QCremote
,
1461 Fprocess_datagram_address (process
));
1464 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
) && !PIPECONN_P (process
))
1467 if (NILP (key
) && NETCONN_P (process
))
1468 return list2 (Fplist_get (contact
, QChost
),
1469 Fplist_get (contact
, QCservice
));
1470 if (NILP (key
) && SERIALCONN_P (process
))
1471 return list2 (Fplist_get (contact
, QCport
),
1472 Fplist_get (contact
, QCspeed
));
1473 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1474 if the pipe process is useful for purposes other than receiving
1476 if (NILP (key
) && PIPECONN_P (process
))
1478 return Fplist_get (contact
, key
);
1481 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1483 doc
: /* Return the plist of PROCESS. */)
1484 (register Lisp_Object process
)
1486 CHECK_PROCESS (process
);
1487 return XPROCESS (process
)->plist
;
1490 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1492 doc
: /* Replace the plist of PROCESS with PLIST. Return PLIST. */)
1493 (Lisp_Object process
, Lisp_Object plist
)
1495 CHECK_PROCESS (process
);
1498 pset_plist (XPROCESS (process
), plist
);
1502 #if 0 /* Turned off because we don't currently record this info
1503 in the process. Perhaps add it. */
1504 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1505 doc
: /* Return the connection type of PROCESS.
1506 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1507 a socket connection. */)
1508 (Lisp_Object process
)
1510 return XPROCESS (process
)->type
;
1514 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1515 doc
: /* Return the connection type of PROCESS.
1516 The value is either the symbol `real', `network', `serial', or `pipe'.
1517 PROCESS may be a process, a buffer, the name of a process or buffer, or
1518 nil, indicating the current buffer's process. */)
1519 (Lisp_Object process
)
1522 proc
= get_process (process
);
1523 return XPROCESS (proc
)->type
;
1526 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1528 doc
: /* Convert network ADDRESS from internal format to a string.
1529 A 4 or 5 element vector represents an IPv4 address (with port number).
1530 An 8 or 9 element vector represents an IPv6 address (with port number).
1531 If optional second argument OMIT-PORT is non-nil, don't include a port
1532 number in the string, even when present in ADDRESS.
1533 Return nil if format of ADDRESS is invalid. */)
1534 (Lisp_Object address
, Lisp_Object omit_port
)
1539 if (STRINGP (address
)) /* AF_LOCAL */
1542 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1544 register struct Lisp_Vector
*p
= XVECTOR (address
);
1545 ptrdiff_t size
= p
->header
.size
;
1546 Lisp_Object args
[10];
1550 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1552 format
= "%d.%d.%d.%d";
1557 format
= "%d.%d.%d.%d:%d";
1560 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1562 format
= "%x:%x:%x:%x:%x:%x:%x:%x";
1567 format
= "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1573 AUTO_STRING (format_obj
, format
);
1574 args
[0] = format_obj
;
1576 for (i
= 0; i
< nargs
; i
++)
1578 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1581 if (nargs
<= 5 /* IPv4 */
1582 && i
< 4 /* host, not port */
1583 && XINT (p
->contents
[i
]) > 255)
1586 args
[i
+ 1] = p
->contents
[i
];
1589 return Fformat (nargs
+ 1, args
);
1592 if (CONSP (address
))
1594 AUTO_STRING (format
, "<Family %d>");
1595 return CALLN (Fformat
, format
, Fcar (address
));
1601 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1602 doc
: /* Return a list of all processes that are Emacs sub-processes. */)
1605 return Fmapcar (Qcdr
, Vprocess_alist
);
1608 /* Starting asynchronous inferior processes. */
1610 DEFUN ("make-process", Fmake_process
, Smake_process
, 0, MANY
, 0,
1611 doc
: /* Start a program in a subprocess. Return the process object for it.
1613 This is similar to `start-process', but arguments are specified as
1614 keyword/argument pairs. The following arguments are defined:
1616 :name NAME -- NAME is name for process. It is modified if necessary
1619 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1620 with the process. Process output goes at end of that buffer, unless
1621 you specify an output stream or filter function to handle the output.
1622 BUFFER may be also nil, meaning that this process is not associated
1625 :command COMMAND -- COMMAND is a list starting with the program file
1626 name, followed by strings to give to the program as arguments.
1628 :coding CODING -- If CODING is a symbol, it specifies the coding
1629 system used for both reading and writing for this process. If CODING
1630 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1631 ENCODING is used for writing.
1633 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1634 the process is running. If BOOL is not given, query before exiting.
1636 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1637 In the stopped state, a process does not accept incoming data, but you
1638 can send outgoing data. The stopped state is cleared by
1639 `continue-process' and set by `stop-process'.
1641 :connection-type TYPE -- TYPE is control type of device used to
1642 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1643 to use a pty, or nil to use the default specified through
1644 `process-connection-type'.
1646 :filter FILTER -- Install FILTER as the process filter.
1648 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1650 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1651 to the standard error of subprocess. Specifying this implies
1652 `:connection-type' is set to `pipe'.
1654 usage: (make-process &rest ARGS) */)
1655 (ptrdiff_t nargs
, Lisp_Object
*args
)
1657 Lisp_Object buffer
, name
, command
, program
, proc
, contact
, current_dir
, tem
;
1658 Lisp_Object xstderr
, stderrproc
;
1659 ptrdiff_t count
= SPECPDL_INDEX ();
1664 /* Save arguments for process-contact and clone-process. */
1665 contact
= Flist (nargs
, args
);
1667 buffer
= Fplist_get (contact
, QCbuffer
);
1669 buffer
= Fget_buffer_create (buffer
);
1671 /* Make sure that the child will be able to chdir to the current
1672 buffer's current directory, or its unhandled equivalent. We
1673 can't just have the child check for an error when it does the
1674 chdir, since it's in a vfork. */
1675 current_dir
= encode_current_directory ();
1677 name
= Fplist_get (contact
, QCname
);
1678 CHECK_STRING (name
);
1680 command
= Fplist_get (contact
, QCcommand
);
1681 if (CONSP (command
))
1682 program
= XCAR (command
);
1686 if (!NILP (program
))
1687 CHECK_STRING (program
);
1690 xstderr
= Fplist_get (contact
, QCstderr
);
1691 if (PROCESSP (xstderr
))
1693 if (!PIPECONN_P (xstderr
))
1694 error ("Process is not a pipe process");
1695 stderrproc
= xstderr
;
1697 else if (!NILP (xstderr
))
1699 CHECK_STRING (program
);
1700 stderrproc
= CALLN (Fmake_pipe_process
,
1702 concat2 (name
, build_string (" stderr")),
1704 Fget_buffer_create (xstderr
));
1707 proc
= make_process (name
);
1708 record_unwind_protect (start_process_unwind
, proc
);
1710 pset_childp (XPROCESS (proc
), Qt
);
1711 eassert (NILP (XPROCESS (proc
)->plist
));
1712 pset_type (XPROCESS (proc
), Qreal
);
1713 pset_buffer (XPROCESS (proc
), buffer
);
1714 pset_sentinel (XPROCESS (proc
), Fplist_get (contact
, QCsentinel
));
1715 pset_filter (XPROCESS (proc
), Fplist_get (contact
, QCfilter
));
1716 pset_command (XPROCESS (proc
), Fcopy_sequence (command
));
1718 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
1719 XPROCESS (proc
)->kill_without_query
= 1;
1720 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
1721 pset_command (XPROCESS (proc
), Qt
);
1723 tem
= Fplist_get (contact
, QCconnection_type
);
1725 XPROCESS (proc
)->pty_flag
= true;
1726 else if (EQ (tem
, Qpipe
))
1727 XPROCESS (proc
)->pty_flag
= false;
1728 else if (NILP (tem
))
1729 XPROCESS (proc
)->pty_flag
= !NILP (Vprocess_connection_type
);
1731 report_file_error ("Unknown connection type", tem
);
1733 if (!NILP (stderrproc
))
1735 pset_stderrproc (XPROCESS (proc
), stderrproc
);
1737 XPROCESS (proc
)->pty_flag
= false;
1741 /* AKA GNUTLS_INITSTAGE(proc). */
1742 verify (GNUTLS_STAGE_EMPTY
== 0);
1743 eassert (XPROCESS (proc
)->gnutls_initstage
== GNUTLS_STAGE_EMPTY
);
1744 eassert (NILP (XPROCESS (proc
)->gnutls_cred_type
));
1747 XPROCESS (proc
)->adaptive_read_buffering
1748 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1749 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1751 /* Make the process marker point into the process buffer (if any). */
1752 if (BUFFERP (buffer
))
1753 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1754 BUF_ZV (XBUFFER (buffer
)),
1755 BUF_ZV_BYTE (XBUFFER (buffer
)));
1760 /* Decide coding systems for communicating with the process. Here
1761 we don't setup the structure coding_system nor pay attention to
1762 unibyte mode. They are done in create_process. */
1764 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1765 Lisp_Object coding_systems
= Qt
;
1766 Lisp_Object val
, *args2
;
1768 tem
= Fplist_get (contact
, QCcoding
);
1776 val
= Vcoding_system_for_read
;
1779 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1781 SAFE_ALLOCA_LISP (args2
, nargs2
);
1783 args2
[i
++] = Qstart_process
;
1785 args2
[i
++] = buffer
;
1786 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1787 args2
[i
++] = XCAR (tem2
);
1788 if (!NILP (program
))
1789 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1790 if (CONSP (coding_systems
))
1791 val
= XCAR (coding_systems
);
1792 else if (CONSP (Vdefault_process_coding_system
))
1793 val
= XCAR (Vdefault_process_coding_system
);
1795 pset_decode_coding_system (XPROCESS (proc
), val
);
1804 val
= Vcoding_system_for_write
;
1807 if (EQ (coding_systems
, Qt
))
1809 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1811 SAFE_ALLOCA_LISP (args2
, nargs2
);
1813 args2
[i
++] = Qstart_process
;
1815 args2
[i
++] = buffer
;
1816 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1817 args2
[i
++] = XCAR (tem2
);
1818 if (!NILP (program
))
1819 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1821 if (CONSP (coding_systems
))
1822 val
= XCDR (coding_systems
);
1823 else if (CONSP (Vdefault_process_coding_system
))
1824 val
= XCDR (Vdefault_process_coding_system
);
1826 pset_encode_coding_system (XPROCESS (proc
), val
);
1827 /* Note: At this moment, the above coding system may leave
1828 text-conversion or eol-conversion unspecified. They will be
1829 decided after we read output from the process and decode it by
1830 some coding system, or just before we actually send a text to
1835 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1836 eassert (XPROCESS (proc
)->decoding_carryover
== 0);
1837 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1839 XPROCESS (proc
)->inherit_coding_system_flag
1840 = !(NILP (buffer
) || !inherit_process_coding_system
);
1842 if (!NILP (program
))
1844 Lisp_Object program_args
= XCDR (command
);
1846 /* If program file name is not absolute, search our path for it.
1847 Put the name we will really use in TEM. */
1848 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1849 && !(SCHARS (program
) > 1
1850 && IS_DEVICE_SEP (SREF (program
, 1))))
1853 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
,
1854 make_number (X_OK
), false);
1856 report_file_error ("Searching for program", program
);
1857 tem
= Fexpand_file_name (tem
, Qnil
);
1861 if (!NILP (Ffile_directory_p (program
)))
1862 error ("Specified program for new process is a directory");
1866 /* Remove "/:" from TEM. */
1867 tem
= remove_slash_colon (tem
);
1869 Lisp_Object arg_encoding
= Qnil
;
1871 /* Encode the file name and put it in NEW_ARGV.
1872 That's where the child will use it to execute the program. */
1873 tem
= list1 (ENCODE_FILE (tem
));
1874 ptrdiff_t new_argc
= 1;
1876 /* Here we encode arguments by the coding system used for sending
1877 data to the process. We don't support using different coding
1878 systems for encoding arguments and for encoding data sent to the
1881 for (Lisp_Object tem2
= program_args
; CONSP (tem2
); tem2
= XCDR (tem2
))
1883 Lisp_Object arg
= XCAR (tem2
);
1885 if (STRING_MULTIBYTE (arg
))
1887 if (NILP (arg_encoding
))
1888 arg_encoding
= (complement_process_encoding_system
1889 (XPROCESS (proc
)->encode_coding_system
));
1890 arg
= code_convert_string_norecord (arg
, arg_encoding
, 1);
1892 tem
= Fcons (arg
, tem
);
1896 /* Now that everything is encoded we can collect the strings into
1899 SAFE_NALLOCA (new_argv
, 1, new_argc
+ 1);
1900 new_argv
[new_argc
] = 0;
1902 for (ptrdiff_t i
= new_argc
- 1; i
>= 0; i
--)
1904 new_argv
[i
] = SSDATA (XCAR (tem
));
1908 create_process (proc
, new_argv
, current_dir
);
1914 return unbind_to (count
, proc
);
1917 /* If PROC doesn't have its pid set, then an error was signaled and
1918 the process wasn't started successfully, so remove it. */
1920 start_process_unwind (Lisp_Object proc
)
1922 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1923 remove_process (proc
);
1926 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1929 close_process_fd (int *fd_addr
)
1939 /* Indexes of file descriptors in open_fds. */
1942 /* The pipe from Emacs to its subprocess. */
1944 WRITE_TO_SUBPROCESS
,
1946 /* The main pipe from the subprocess to Emacs. */
1947 READ_FROM_SUBPROCESS
,
1950 /* The pipe from the subprocess to Emacs that is closed when the
1951 subprocess execs. */
1952 READ_FROM_EXEC_MONITOR
,
1956 verify (PROCESS_OPEN_FDS
== EXEC_MONITOR_OUTPUT
+ 1);
1959 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1961 struct Lisp_Process
*p
= XPROCESS (process
);
1962 int inchannel
, outchannel
;
1965 int forkin
, forkout
, forkerr
= -1;
1967 char pty_name
[PTY_NAME_SIZE
];
1968 Lisp_Object lisp_pty_name
= Qnil
;
1971 inchannel
= outchannel
= -1;
1974 outchannel
= inchannel
= allocate_pty (pty_name
);
1978 p
->open_fd
[READ_FROM_SUBPROCESS
] = inchannel
;
1979 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1980 /* On most USG systems it does not work to open the pty's tty here,
1981 then close it and reopen it in the child. */
1982 /* Don't let this terminal become our controlling terminal
1983 (in case we don't have one). */
1984 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1986 report_file_error ("Opening pty", Qnil
);
1987 p
->open_fd
[SUBPROCESS_STDIN
] = forkin
;
1989 forkin
= forkout
= -1;
1990 #endif /* not USG, or USG_SUBTTY_WORKS */
1992 lisp_pty_name
= build_string (pty_name
);
1996 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
1997 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
1998 report_file_error ("Creating pipe", Qnil
);
1999 forkin
= p
->open_fd
[SUBPROCESS_STDIN
];
2000 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
2001 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
2002 forkout
= p
->open_fd
[SUBPROCESS_STDOUT
];
2004 if (!NILP (p
->stderrproc
))
2006 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
2008 forkerr
= pp
->open_fd
[SUBPROCESS_STDOUT
];
2010 /* Close unnecessary file descriptors. */
2011 close_process_fd (&pp
->open_fd
[WRITE_TO_SUBPROCESS
]);
2012 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDIN
]);
2017 if (emacs_pipe (p
->open_fd
+ READ_FROM_EXEC_MONITOR
) != 0)
2018 report_file_error ("Creating pipe", Qnil
);
2021 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2022 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2024 /* Record this as an active process, with its channels. */
2025 chan_process
[inchannel
] = process
;
2026 p
->infd
= inchannel
;
2027 p
->outfd
= outchannel
;
2029 /* Previously we recorded the tty descriptor used in the subprocess.
2030 It was only used for getting the foreground tty process, so now
2031 we just reopen the device (see emacs_get_tty_pgrp) as this is
2032 more portable (see USG_SUBTTY_WORKS above). */
2034 p
->pty_flag
= pty_flag
;
2035 pset_status (p
, Qrun
);
2037 if (!EQ (p
->command
, Qt
))
2038 add_process_read_fd (inchannel
);
2040 /* This may signal an error. */
2041 setup_process_coding_systems (process
);
2044 block_child_signal (&oldset
);
2047 /* vfork, and prevent local vars from being clobbered by the vfork. */
2048 Lisp_Object
volatile current_dir_volatile
= current_dir
;
2049 Lisp_Object
volatile lisp_pty_name_volatile
= lisp_pty_name
;
2050 char **volatile new_argv_volatile
= new_argv
;
2051 int volatile forkin_volatile
= forkin
;
2052 int volatile forkout_volatile
= forkout
;
2053 int volatile forkerr_volatile
= forkerr
;
2054 struct Lisp_Process
*p_volatile
= p
;
2057 /* Darwin doesn't let us run setsid after a vfork, so use fork when
2058 necessary. Also, reset SIGCHLD handling after a vfork, as
2059 apparently macOS can mistakenly deliver SIGCHLD to the child. */
2066 signal (SIGCHLD
, SIG_DFL
);
2072 current_dir
= current_dir_volatile
;
2073 lisp_pty_name
= lisp_pty_name_volatile
;
2074 new_argv
= new_argv_volatile
;
2075 forkin
= forkin_volatile
;
2076 forkout
= forkout_volatile
;
2077 forkerr
= forkerr_volatile
;
2080 pty_flag
= p
->pty_flag
;
2083 #endif /* not WINDOWSNT */
2085 /* Make the pty be the controlling terminal of the process. */
2087 /* First, disconnect its current controlling terminal. */
2090 /* Make the pty's terminal the controlling terminal. */
2091 if (pty_flag
&& forkin
>= 0)
2094 /* We ignore the return value
2095 because faith@cs.unc.edu says that is necessary on Linux. */
2096 ioctl (forkin
, TIOCSCTTY
, 0);
2099 #if defined (LDISC1)
2100 if (pty_flag
&& forkin
>= 0)
2103 tcgetattr (forkin
, &t
);
2105 if (tcsetattr (forkin
, TCSANOW
, &t
) < 0)
2106 emacs_perror ("create_process/tcsetattr LDISC1");
2109 #if defined (NTTYDISC) && defined (TIOCSETD)
2110 if (pty_flag
&& forkin
>= 0)
2112 /* Use new line discipline. */
2113 int ldisc
= NTTYDISC
;
2114 ioctl (forkin
, TIOCSETD
, &ldisc
);
2119 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
2120 can do TIOCSPGRP only to the process's controlling tty. */
2123 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
2124 I can't test it since I don't have 4.3. */
2125 int j
= emacs_open (DEV_TTY
, O_RDWR
, 0);
2128 ioctl (j
, TIOCNOTTY
, 0);
2132 #endif /* TIOCNOTTY */
2134 #if !defined (DONT_REOPEN_PTY)
2135 /*** There is a suggestion that this ought to be a
2136 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
2137 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
2138 that system does seem to need this code, even though
2139 both TIOCSCTTY is defined. */
2140 /* Now close the pty (if we had it open) and reopen it.
2141 This makes the pty the controlling terminal of the subprocess. */
2145 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
2148 emacs_close (forkin
);
2149 forkout
= forkin
= emacs_open (SSDATA (lisp_pty_name
), O_RDWR
, 0);
2153 emacs_perror (SSDATA (lisp_pty_name
));
2154 _exit (EXIT_CANCELED
);
2158 #endif /* not DONT_REOPEN_PTY */
2160 #ifdef SETUP_SLAVE_PTY
2165 #endif /* SETUP_SLAVE_PTY */
2166 #endif /* HAVE_PTYS */
2168 signal (SIGINT
, SIG_DFL
);
2169 signal (SIGQUIT
, SIG_DFL
);
2171 signal (SIGPROF
, SIG_DFL
);
2174 /* Emacs ignores SIGPIPE, but the child should not. */
2175 signal (SIGPIPE
, SIG_DFL
);
2177 /* Stop blocking SIGCHLD in the child. */
2178 unblock_child_signal (&oldset
);
2181 child_setup_tty (forkout
);
2186 pid
= child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
2187 #else /* not WINDOWSNT */
2188 child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
2189 #endif /* not WINDOWSNT */
2192 /* Back in the parent process. */
2194 vfork_errno
= errno
;
2199 /* Stop blocking in the parent. */
2200 unblock_child_signal (&oldset
);
2204 report_file_errno ("Doing vfork", Qnil
, vfork_errno
);
2207 /* vfork succeeded. */
2209 /* Close the pipe ends that the child uses, or the child's pty. */
2210 close_process_fd (&p
->open_fd
[SUBPROCESS_STDIN
]);
2211 close_process_fd (&p
->open_fd
[SUBPROCESS_STDOUT
]);
2214 register_child (pid
, inchannel
);
2215 #endif /* WINDOWSNT */
2217 pset_tty_name (p
, lisp_pty_name
);
2220 /* Wait for child_setup to complete in case that vfork is
2221 actually defined as fork. The descriptor
2222 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
2223 of a pipe is closed at the child side either by close-on-exec
2224 on successful execve or the _exit call in child_setup. */
2228 close_process_fd (&p
->open_fd
[EXEC_MONITOR_OUTPUT
]);
2229 emacs_read (p
->open_fd
[READ_FROM_EXEC_MONITOR
], &dummy
, 1);
2230 close_process_fd (&p
->open_fd
[READ_FROM_EXEC_MONITOR
]);
2233 if (!NILP (p
->stderrproc
))
2235 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
2236 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDOUT
]);
2242 create_pty (Lisp_Object process
)
2244 struct Lisp_Process
*p
= XPROCESS (process
);
2245 char pty_name
[PTY_NAME_SIZE
];
2246 int pty_fd
= !p
->pty_flag
? -1 : allocate_pty (pty_name
);
2250 p
->open_fd
[SUBPROCESS_STDIN
] = pty_fd
;
2251 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2252 /* On most USG systems it does not work to open the pty's tty here,
2253 then close it and reopen it in the child. */
2254 /* Don't let this terminal become our controlling terminal
2255 (in case we don't have one). */
2256 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2258 report_file_error ("Opening pty", Qnil
);
2259 p
->open_fd
[WRITE_TO_SUBPROCESS
] = forkout
;
2260 #if defined (DONT_REOPEN_PTY)
2261 /* In the case that vfork is defined as fork, the parent process
2262 (Emacs) may send some data before the child process completes
2263 tty options setup. So we setup tty before forking. */
2264 child_setup_tty (forkout
);
2265 #endif /* DONT_REOPEN_PTY */
2266 #endif /* not USG, or USG_SUBTTY_WORKS */
2268 fcntl (pty_fd
, F_SETFL
, O_NONBLOCK
);
2270 /* Record this as an active process, with its channels.
2271 As a result, child_setup will close Emacs's side of the pipes. */
2272 chan_process
[pty_fd
] = process
;
2276 /* Previously we recorded the tty descriptor used in the subprocess.
2277 It was only used for getting the foreground tty process, so now
2278 we just reopen the device (see emacs_get_tty_pgrp) as this is
2279 more portable (see USG_SUBTTY_WORKS above). */
2282 pset_status (p
, Qrun
);
2283 setup_process_coding_systems (process
);
2285 add_process_read_fd (pty_fd
);
2287 pset_tty_name (p
, build_string (pty_name
));
2293 DEFUN ("make-pipe-process", Fmake_pipe_process
, Smake_pipe_process
,
2295 doc
: /* Create and return a bidirectional pipe process.
2297 In Emacs, pipes are represented by process objects, so input and
2298 output work as for subprocesses, and `delete-process' closes a pipe.
2299 However, a pipe process has no process id, it cannot be signaled,
2300 and the status codes are different from normal processes.
2302 Arguments are specified as keyword/argument pairs. The following
2303 arguments are defined:
2305 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2307 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2308 with the process. Process output goes at the end of that buffer,
2309 unless you specify an output stream or filter function to handle the
2310 output. If BUFFER is not given, the value of NAME is used.
2312 :coding CODING -- If CODING is a symbol, it specifies the coding
2313 system used for both reading and writing for this process. If CODING
2314 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2315 ENCODING is used for writing.
2317 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2318 the process is running. If BOOL is not given, query before exiting.
2320 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2321 In the stopped state, a pipe process does not accept incoming data,
2322 but you can send outgoing data. The stopped state is cleared by
2323 `continue-process' and set by `stop-process'.
2325 :filter FILTER -- Install FILTER as the process filter.
2327 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2329 usage: (make-pipe-process &rest ARGS) */)
2330 (ptrdiff_t nargs
, Lisp_Object
*args
)
2332 Lisp_Object proc
, contact
;
2333 struct Lisp_Process
*p
;
2334 Lisp_Object name
, buffer
;
2336 ptrdiff_t specpdl_count
;
2337 int inchannel
, outchannel
;
2342 contact
= Flist (nargs
, args
);
2344 name
= Fplist_get (contact
, QCname
);
2345 CHECK_STRING (name
);
2346 proc
= make_process (name
);
2347 specpdl_count
= SPECPDL_INDEX ();
2348 record_unwind_protect (remove_process
, proc
);
2349 p
= XPROCESS (proc
);
2351 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
2352 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
2353 report_file_error ("Creating pipe", Qnil
);
2354 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
2355 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
2357 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2358 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2361 register_aux_fd (inchannel
);
2364 /* Record this as an active process, with its channels. */
2365 chan_process
[inchannel
] = proc
;
2366 p
->infd
= inchannel
;
2367 p
->outfd
= outchannel
;
2369 if (inchannel
> max_desc
)
2370 max_desc
= inchannel
;
2372 buffer
= Fplist_get (contact
, QCbuffer
);
2375 buffer
= Fget_buffer_create (buffer
);
2376 pset_buffer (p
, buffer
);
2378 pset_childp (p
, contact
);
2379 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2380 pset_type (p
, Qpipe
);
2381 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2382 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2383 eassert (NILP (p
->log
));
2384 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2385 p
->kill_without_query
= 1;
2386 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2387 pset_command (p
, Qt
);
2388 eassert (! p
->pty_flag
);
2390 if (!EQ (p
->command
, Qt
))
2391 add_process_read_fd (inchannel
);
2392 p
->adaptive_read_buffering
2393 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
2394 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
2396 /* Make the process marker point into the process buffer (if any). */
2397 if (BUFFERP (buffer
))
2398 set_marker_both (p
->mark
, buffer
,
2399 BUF_ZV (XBUFFER (buffer
)),
2400 BUF_ZV_BYTE (XBUFFER (buffer
)));
2403 /* Setup coding systems for communicating with the network stream. */
2405 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2406 Lisp_Object coding_systems
= Qt
;
2409 tem
= Fplist_get (contact
, QCcoding
);
2417 else if (!NILP (Vcoding_system_for_read
))
2418 val
= Vcoding_system_for_read
;
2419 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2420 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2421 /* We dare not decode end-of-line format by setting VAL to
2422 Qraw_text, because the existing Emacs Lisp libraries
2423 assume that they receive bare code including a sequence of
2428 if (CONSP (coding_systems
))
2429 val
= XCAR (coding_systems
);
2430 else if (CONSP (Vdefault_process_coding_system
))
2431 val
= XCAR (Vdefault_process_coding_system
);
2435 pset_decode_coding_system (p
, val
);
2443 else if (!NILP (Vcoding_system_for_write
))
2444 val
= Vcoding_system_for_write
;
2445 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2449 if (CONSP (coding_systems
))
2450 val
= XCDR (coding_systems
);
2451 else if (CONSP (Vdefault_process_coding_system
))
2452 val
= XCDR (Vdefault_process_coding_system
);
2456 pset_encode_coding_system (p
, val
);
2458 /* This may signal an error. */
2459 setup_process_coding_systems (proc
);
2461 specpdl_ptr
= specpdl
+ specpdl_count
;
2467 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2468 The address family of sa is not included in the result. */
2471 conv_sockaddr_to_lisp (struct sockaddr
*sa
, ptrdiff_t len
)
2473 Lisp_Object address
;
2476 struct Lisp_Vector
*p
;
2478 /* Workaround for a bug in getsockname on BSD: Names bound to
2479 sockets in the UNIX domain are inaccessible; getsockname returns
2480 a zero length name. */
2481 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2482 return empty_unibyte_string
;
2484 switch (sa
->sa_family
)
2488 DECLARE_POINTER_ALIAS (sin
, struct sockaddr_in
, sa
);
2489 len
= sizeof (sin
->sin_addr
) + 1;
2490 address
= Fmake_vector (make_number (len
), Qnil
);
2491 p
= XVECTOR (address
);
2492 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2493 cp
= (unsigned char *) &sin
->sin_addr
;
2499 DECLARE_POINTER_ALIAS (sin6
, struct sockaddr_in6
, sa
);
2500 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &sin6
->sin6_addr
);
2501 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2502 address
= Fmake_vector (make_number (len
), Qnil
);
2503 p
= XVECTOR (address
);
2504 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2505 for (i
= 0; i
< len
; i
++)
2506 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2510 #ifdef HAVE_LOCAL_SOCKETS
2513 DECLARE_POINTER_ALIAS (sockun
, struct sockaddr_un
, sa
);
2514 ptrdiff_t name_length
= len
- offsetof (struct sockaddr_un
, sun_path
);
2515 /* If the first byte is NUL, the name is a Linux abstract
2516 socket name, and the name can contain embedded NULs. If
2517 it's not, we have a NUL-terminated string. Be careful not
2518 to walk past the end of the object looking for the name
2519 terminator, however. */
2520 if (name_length
> 0 && sockun
->sun_path
[0] != '\0')
2522 const char *terminator
2523 = memchr (sockun
->sun_path
, '\0', name_length
);
2526 name_length
= terminator
- (const char *) sockun
->sun_path
;
2529 return make_unibyte_string (sockun
->sun_path
, name_length
);
2533 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2534 address
= Fcons (make_number (sa
->sa_family
),
2535 Fmake_vector (make_number (len
), Qnil
));
2536 p
= XVECTOR (XCDR (address
));
2537 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2543 p
->contents
[i
++] = make_number (*cp
++);
2548 /* Convert an internal struct addrinfo to a Lisp object. */
2551 conv_addrinfo_to_lisp (struct addrinfo
*res
)
2553 Lisp_Object protocol
= make_number (res
->ai_protocol
);
2554 eassert (XINT (protocol
) == res
->ai_protocol
);
2555 return Fcons (protocol
, conv_sockaddr_to_lisp (res
->ai_addr
, res
->ai_addrlen
));
2559 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2562 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2564 struct Lisp_Vector
*p
;
2566 if (VECTORP (address
))
2568 p
= XVECTOR (address
);
2569 if (p
->header
.size
== 5)
2572 return sizeof (struct sockaddr_in
);
2575 else if (p
->header
.size
== 9)
2577 *familyp
= AF_INET6
;
2578 return sizeof (struct sockaddr_in6
);
2582 #ifdef HAVE_LOCAL_SOCKETS
2583 else if (STRINGP (address
))
2585 *familyp
= AF_LOCAL
;
2586 return sizeof (struct sockaddr_un
);
2589 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2590 && VECTORP (XCDR (address
)))
2592 struct sockaddr
*sa
;
2593 p
= XVECTOR (XCDR (address
));
2594 if (MAX_ALLOCA
- sizeof sa
->sa_family
< p
->header
.size
)
2596 *familyp
= XINT (XCAR (address
));
2597 return p
->header
.size
+ sizeof (sa
->sa_family
);
2602 /* Convert an address object (vector or string) to an internal sockaddr.
2604 The address format has been basically validated by
2605 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2606 it could have come from user data. So if FAMILY is not valid,
2607 we return after zeroing *SA. */
2610 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2612 register struct Lisp_Vector
*p
;
2613 register unsigned char *cp
= NULL
;
2617 memset (sa
, 0, len
);
2619 if (VECTORP (address
))
2621 p
= XVECTOR (address
);
2622 if (family
== AF_INET
)
2624 DECLARE_POINTER_ALIAS (sin
, struct sockaddr_in
, sa
);
2625 len
= sizeof (sin
->sin_addr
) + 1;
2626 hostport
= XINT (p
->contents
[--len
]);
2627 sin
->sin_port
= htons (hostport
);
2628 cp
= (unsigned char *)&sin
->sin_addr
;
2629 sa
->sa_family
= family
;
2632 else if (family
== AF_INET6
)
2634 DECLARE_POINTER_ALIAS (sin6
, struct sockaddr_in6
, sa
);
2635 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &sin6
->sin6_addr
);
2636 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2637 hostport
= XINT (p
->contents
[--len
]);
2638 sin6
->sin6_port
= htons (hostport
);
2639 for (i
= 0; i
< len
; i
++)
2640 if (INTEGERP (p
->contents
[i
]))
2642 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2645 sa
->sa_family
= family
;
2652 else if (STRINGP (address
))
2654 #ifdef HAVE_LOCAL_SOCKETS
2655 if (family
== AF_LOCAL
)
2657 DECLARE_POINTER_ALIAS (sockun
, struct sockaddr_un
, sa
);
2658 cp
= SDATA (address
);
2659 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2660 sockun
->sun_path
[i
] = *cp
++;
2661 sa
->sa_family
= family
;
2668 p
= XVECTOR (XCDR (address
));
2669 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2672 for (i
= 0; i
< len
; i
++)
2673 if (INTEGERP (p
->contents
[i
]))
2674 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2677 #ifdef DATAGRAM_SOCKETS
2678 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2680 doc
: /* Get the current datagram address associated with PROCESS.
2681 If PROCESS is a non-blocking network process that hasn't been fully
2682 set up yet, this function will block until socket setup has completed. */)
2683 (Lisp_Object process
)
2687 CHECK_PROCESS (process
);
2689 if (NETCONN_P (process
))
2690 wait_for_socket_fds (process
, "process-datagram-address");
2692 if (!DATAGRAM_CONN_P (process
))
2695 channel
= XPROCESS (process
)->infd
;
2696 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2697 datagram_address
[channel
].len
);
2700 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2702 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2703 Return nil upon error setting address, ADDRESS otherwise.
2705 If PROCESS is a non-blocking network process that hasn't been fully
2706 set up yet, this function will block until socket setup has completed. */)
2707 (Lisp_Object process
, Lisp_Object address
)
2713 CHECK_PROCESS (process
);
2715 if (NETCONN_P (process
))
2716 wait_for_socket_fds (process
, "set-process-datagram-address");
2718 if (!DATAGRAM_CONN_P (process
))
2721 channel
= XPROCESS (process
)->infd
;
2723 len
= get_lisp_to_sockaddr_size (address
, &family
);
2724 if (len
== 0 || datagram_address
[channel
].len
!= len
)
2726 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2732 static const struct socket_options
{
2733 /* The name of this option. Should be lowercase version of option
2734 name without SO_ prefix. */
2736 /* Option level SOL_... */
2738 /* Option number SO_... */
2740 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2741 enum { OPIX_NONE
= 0, OPIX_MISC
= 1, OPIX_REUSEADDR
= 2 } optbit
;
2742 } socket_options
[] =
2744 #ifdef SO_BINDTODEVICE
2745 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2748 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2751 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2754 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2757 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2760 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2763 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2766 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2768 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2771 /* Set option OPT to value VAL on socket S.
2773 Return (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2774 Signals an error if setting a known option fails.
2778 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2781 const struct socket_options
*sopt
;
2786 name
= SSDATA (SYMBOL_NAME (opt
));
2787 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2788 if (strcmp (name
, sopt
->name
) == 0)
2791 switch (sopt
->opttype
)
2796 optval
= NILP (val
) ? 0 : 1;
2797 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2798 &optval
, sizeof (optval
));
2805 if (TYPE_RANGED_INTEGERP (int, val
))
2806 optval
= XINT (val
);
2808 error ("Bad option value for %s", name
);
2809 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2810 &optval
, sizeof (optval
));
2814 #ifdef SO_BINDTODEVICE
2817 char devname
[IFNAMSIZ
+ 1];
2819 /* This is broken, at least in the Linux 2.4 kernel.
2820 To unbind, the arg must be a zero integer, not the empty string.
2821 This should work on all systems. KFS. 2003-09-23. */
2822 memset (devname
, 0, sizeof devname
);
2825 char *arg
= SSDATA (val
);
2826 int len
= min (strlen (arg
), IFNAMSIZ
);
2827 memcpy (devname
, arg
, len
);
2829 else if (!NILP (val
))
2830 error ("Bad option value for %s", name
);
2831 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2840 struct linger linger
;
2843 linger
.l_linger
= 0;
2844 if (TYPE_RANGED_INTEGERP (int, val
))
2845 linger
.l_linger
= XINT (val
);
2847 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2848 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2849 &linger
, sizeof (linger
));
2860 int setsockopt_errno
= errno
;
2861 report_file_errno ("Cannot set network option", list2 (opt
, val
),
2865 return (1 << sopt
->optbit
);
2869 DEFUN ("set-network-process-option",
2870 Fset_network_process_option
, Sset_network_process_option
,
2872 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2873 See `make-network-process' for a list of options and values.
2874 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2875 OPTION is not a supported option, return nil instead; otherwise return t.
2877 If PROCESS is a non-blocking network process that hasn't been fully
2878 set up yet, this function will block until socket setup has completed. */)
2879 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2882 struct Lisp_Process
*p
;
2884 CHECK_PROCESS (process
);
2885 p
= XPROCESS (process
);
2886 if (!NETCONN1_P (p
))
2887 error ("Process is not a network process");
2889 wait_for_socket_fds (process
, "set-network-process-option");
2893 error ("Process is not running");
2895 if (set_socket_option (s
, option
, value
))
2897 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2901 if (NILP (no_error
))
2902 error ("Unknown or unsupported option");
2908 DEFUN ("serial-process-configure",
2909 Fserial_process_configure
,
2910 Sserial_process_configure
,
2912 doc
: /* Configure speed, bytesize, etc. of a serial process.
2914 Arguments are specified as keyword/argument pairs. Attributes that
2915 are not given are re-initialized from the process's current
2916 configuration (available via the function `process-contact') or set to
2917 reasonable default values. The following arguments are defined:
2923 -- Any of these arguments can be given to identify the process that is
2924 to be configured. If none of these arguments is given, the current
2925 buffer's process is used.
2927 :speed SPEED -- SPEED is the speed of the serial port in bits per
2928 second, also called baud rate. Any value can be given for SPEED, but
2929 most serial ports work only at a few defined values between 1200 and
2930 115200, with 9600 being the most common value. If SPEED is nil, the
2931 serial port is not configured any further, i.e., all other arguments
2932 are ignored. This may be useful for special serial ports such as
2933 Bluetooth-to-serial converters which can only be configured through AT
2934 commands. A value of nil for SPEED can be used only when passed
2935 through `make-serial-process' or `serial-term'.
2937 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2938 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2940 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2941 `odd' (use odd parity), or the symbol `even' (use even parity). If
2942 PARITY is not given, no parity is used.
2944 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2945 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2946 is not given or nil, 1 stopbit is used.
2948 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2949 flowcontrol to be used, which is either nil (don't use flowcontrol),
2950 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2951 \(use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2952 flowcontrol is used.
2954 `serial-process-configure' is called by `make-serial-process' for the
2955 initial configuration of the serial port.
2959 \(serial-process-configure :process "/dev/ttyS0" :speed 1200)
2961 \(serial-process-configure
2962 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2964 \(serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2966 usage: (serial-process-configure &rest ARGS) */)
2967 (ptrdiff_t nargs
, Lisp_Object
*args
)
2969 struct Lisp_Process
*p
;
2970 Lisp_Object contact
= Qnil
;
2971 Lisp_Object proc
= Qnil
;
2973 contact
= Flist (nargs
, args
);
2975 proc
= Fplist_get (contact
, QCprocess
);
2977 proc
= Fplist_get (contact
, QCname
);
2979 proc
= Fplist_get (contact
, QCbuffer
);
2981 proc
= Fplist_get (contact
, QCport
);
2982 proc
= get_process (proc
);
2983 p
= XPROCESS (proc
);
2984 if (!EQ (p
->type
, Qserial
))
2985 error ("Not a serial process");
2987 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2990 serial_configure (p
, contact
);
2994 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2996 doc
: /* Create and return a serial port process.
2998 In Emacs, serial port connections are represented by process objects,
2999 so input and output work as for subprocesses, and `delete-process'
3000 closes a serial port connection. However, a serial process has no
3001 process id, it cannot be signaled, and the status codes are different
3002 from normal processes.
3004 `make-serial-process' creates a process and a buffer, on which you
3005 probably want to use `process-send-string'. Try \\[serial-term] for
3006 an interactive terminal. See below for examples.
3008 Arguments are specified as keyword/argument pairs. The following
3009 arguments are defined:
3011 :port PORT -- (mandatory) PORT is the path or name of the serial port.
3012 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
3013 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
3014 the backslashes in strings).
3016 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
3017 which this function calls.
3019 :name NAME -- NAME is the name of the process. If NAME is not given,
3020 the value of PORT is used.
3022 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3023 with the process. Process output goes at the end of that buffer,
3024 unless you specify an output stream or filter function to handle the
3025 output. If BUFFER is not given, the value of NAME is used.
3027 :coding CODING -- If CODING is a symbol, it specifies the coding
3028 system used for both reading and writing for this process. If CODING
3029 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3030 ENCODING is used for writing.
3032 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
3033 the process is running. If BOOL is not given, query before exiting.
3035 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
3036 In the stopped state, a serial process does not accept incoming data,
3037 but you can send outgoing data. The stopped state is cleared by
3038 `continue-process' and set by `stop-process'.
3040 :filter FILTER -- Install FILTER as the process filter.
3042 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3044 :plist PLIST -- Install PLIST as the initial plist of the process.
3050 -- This function calls `serial-process-configure' to handle these
3053 The original argument list, possibly modified by later configuration,
3054 is available via the function `process-contact'.
3058 \(make-serial-process :port "/dev/ttyS0" :speed 9600)
3060 \(make-serial-process :port "COM1" :speed 115200 :stopbits 2)
3062 \(make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
3064 \(make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
3066 usage: (make-serial-process &rest ARGS) */)
3067 (ptrdiff_t nargs
, Lisp_Object
*args
)
3070 Lisp_Object proc
, contact
, port
;
3071 struct Lisp_Process
*p
;
3072 Lisp_Object name
, buffer
;
3073 Lisp_Object tem
, val
;
3074 ptrdiff_t specpdl_count
;
3079 contact
= Flist (nargs
, args
);
3081 port
= Fplist_get (contact
, QCport
);
3083 error ("No port specified");
3084 CHECK_STRING (port
);
3086 if (NILP (Fplist_member (contact
, QCspeed
)))
3087 error (":speed not specified");
3088 if (!NILP (Fplist_get (contact
, QCspeed
)))
3089 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
3091 name
= Fplist_get (contact
, QCname
);
3094 CHECK_STRING (name
);
3095 proc
= make_process (name
);
3096 specpdl_count
= SPECPDL_INDEX ();
3097 record_unwind_protect (remove_process
, proc
);
3098 p
= XPROCESS (proc
);
3100 fd
= serial_open (port
);
3101 p
->open_fd
[SUBPROCESS_STDIN
] = fd
;
3106 chan_process
[fd
] = proc
;
3108 buffer
= Fplist_get (contact
, QCbuffer
);
3111 buffer
= Fget_buffer_create (buffer
);
3112 pset_buffer (p
, buffer
);
3114 pset_childp (p
, contact
);
3115 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3116 pset_type (p
, Qserial
);
3117 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
3118 pset_filter (p
, Fplist_get (contact
, QCfilter
));
3119 eassert (NILP (p
->log
));
3120 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3121 p
->kill_without_query
= 1;
3122 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
3123 pset_command (p
, Qt
);
3124 eassert (! p
->pty_flag
);
3126 if (!EQ (p
->command
, Qt
))
3127 add_process_read_fd (fd
);
3129 if (BUFFERP (buffer
))
3131 set_marker_both (p
->mark
, buffer
,
3132 BUF_ZV (XBUFFER (buffer
)),
3133 BUF_ZV_BYTE (XBUFFER (buffer
)));
3136 tem
= Fplist_member (contact
, QCcoding
);
3137 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3143 val
= XCAR (XCDR (tem
));
3147 else if (!NILP (Vcoding_system_for_read
))
3148 val
= Vcoding_system_for_read
;
3149 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3150 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3152 pset_decode_coding_system (p
, val
);
3157 val
= XCAR (XCDR (tem
));
3161 else if (!NILP (Vcoding_system_for_write
))
3162 val
= Vcoding_system_for_write
;
3163 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
3164 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3166 pset_encode_coding_system (p
, val
);
3168 setup_process_coding_systems (proc
);
3169 pset_decoding_buf (p
, empty_unibyte_string
);
3170 eassert (p
->decoding_carryover
== 0);
3171 pset_encoding_buf (p
, empty_unibyte_string
);
3172 p
->inherit_coding_system_flag
3173 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
3175 Fserial_process_configure (nargs
, args
);
3177 specpdl_ptr
= specpdl
+ specpdl_count
;
3183 set_network_socket_coding_system (Lisp_Object proc
, Lisp_Object host
,
3184 Lisp_Object service
, Lisp_Object name
)
3187 struct Lisp_Process
*p
= XPROCESS (proc
);
3188 Lisp_Object contact
= p
->childp
;
3189 Lisp_Object coding_systems
= Qt
;
3192 tem
= Fplist_member (contact
, QCcoding
);
3193 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
3194 tem
= Qnil
; /* No error message (too late!). */
3196 /* Setup coding systems for communicating with the network stream. */
3197 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
3201 val
= XCAR (XCDR (tem
));
3205 else if (!NILP (Vcoding_system_for_read
))
3206 val
= Vcoding_system_for_read
;
3207 else if ((!NILP (p
->buffer
)
3208 && NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
3209 || (NILP (p
->buffer
)
3210 && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
3211 /* We dare not decode end-of-line format by setting VAL to
3212 Qraw_text, because the existing Emacs Lisp libraries
3213 assume that they receive bare code including a sequence of
3218 if (NILP (host
) || NILP (service
))
3219 coding_systems
= Qnil
;
3221 coding_systems
= CALLN (Ffind_operation_coding_system
,
3222 Qopen_network_stream
, name
, p
->buffer
,
3224 if (CONSP (coding_systems
))
3225 val
= XCAR (coding_systems
);
3226 else if (CONSP (Vdefault_process_coding_system
))
3227 val
= XCAR (Vdefault_process_coding_system
);
3231 pset_decode_coding_system (p
, val
);
3235 val
= XCAR (XCDR (tem
));
3239 else if (!NILP (Vcoding_system_for_write
))
3240 val
= Vcoding_system_for_write
;
3241 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
3245 if (EQ (coding_systems
, Qt
))
3247 if (NILP (host
) || NILP (service
))
3248 coding_systems
= Qnil
;
3250 coding_systems
= CALLN (Ffind_operation_coding_system
,
3251 Qopen_network_stream
, name
, p
->buffer
,
3254 if (CONSP (coding_systems
))
3255 val
= XCDR (coding_systems
);
3256 else if (CONSP (Vdefault_process_coding_system
))
3257 val
= XCDR (Vdefault_process_coding_system
);
3261 pset_encode_coding_system (p
, val
);
3263 pset_decoding_buf (p
, empty_unibyte_string
);
3264 p
->decoding_carryover
= 0;
3265 pset_encoding_buf (p
, empty_unibyte_string
);
3267 p
->inherit_coding_system_flag
3268 = !(!NILP (tem
) || NILP (p
->buffer
) || !inherit_process_coding_system
);
3273 finish_after_tls_connection (Lisp_Object proc
)
3275 struct Lisp_Process
*p
= XPROCESS (proc
);
3276 Lisp_Object contact
= p
->childp
;
3277 Lisp_Object result
= Qt
;
3279 if (!NILP (Ffboundp (Qnsm_verify_connection
)))
3280 result
= call3 (Qnsm_verify_connection
,
3282 Fplist_get (contact
, QChost
),
3283 Fplist_get (contact
, QCservice
));
3287 pset_status (p
, list2 (Qfailed
,
3288 build_string ("The Network Security Manager stopped the connections")));
3289 deactivate_process (proc
);
3291 else if (p
->outfd
< 0)
3293 /* The counterparty may have closed the connection (especially
3294 if the NSM prompt above take a long time), so recheck the file
3296 pset_status (p
, Qfailed
);
3297 deactivate_process (proc
);
3299 else if ((fd_callback_info
[p
->outfd
].flags
& NON_BLOCKING_CONNECT_FD
) == 0)
3301 /* If we cleared the connection wait mask before we did the TLS
3302 setup, then we have to say that the process is finally "open"
3304 pset_status (p
, Qrun
);
3305 /* Execute the sentinel here. If we had relied on status_notify
3306 to do it later, it will read input from the process before
3307 calling the sentinel. */
3308 exec_sentinel (proc
, build_string ("open\n"));
3314 connect_network_socket (Lisp_Object proc
, Lisp_Object addrinfos
,
3315 Lisp_Object use_external_socket_p
)
3317 ptrdiff_t count
= SPECPDL_INDEX ();
3318 int s
= -1, outch
, inch
;
3321 struct sockaddr
*sa
= NULL
;
3324 struct Lisp_Process
*p
= XPROCESS (proc
);
3325 Lisp_Object contact
= p
->childp
;
3327 int socket_to_use
= -1;
3329 if (!NILP (use_external_socket_p
))
3331 socket_to_use
= external_sock_fd
;
3333 /* Ensure we don't consume the external socket twice. */
3334 external_sock_fd
= -1;
3337 /* Do this in case we never enter the while-loop below. */
3340 while (!NILP (addrinfos
))
3342 Lisp_Object addrinfo
= XCAR (addrinfos
);
3343 addrinfos
= XCDR (addrinfos
);
3344 int protocol
= XINT (XCAR (addrinfo
));
3345 Lisp_Object ip_address
= XCDR (addrinfo
);
3351 addrlen
= get_lisp_to_sockaddr_size (ip_address
, &family
);
3354 sa
= xmalloc (addrlen
);
3355 conv_lisp_to_sockaddr (family
, ip_address
, sa
, addrlen
);
3360 int socktype
= p
->socktype
| SOCK_CLOEXEC
;
3361 if (p
->is_non_blocking_client
)
3362 socktype
|= SOCK_NONBLOCK
;
3363 s
= socket (family
, socktype
, protocol
);
3371 if (p
->is_non_blocking_client
&& ! (SOCK_NONBLOCK
&& socket_to_use
< 0))
3373 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3379 if (0 <= socket_to_use
)
3385 #ifdef DATAGRAM_SOCKETS
3386 if (!p
->is_server
&& p
->socktype
== SOCK_DGRAM
)
3388 #endif /* DATAGRAM_SOCKETS */
3390 /* Make us close S if quit. */
3391 record_unwind_protect_int (close_file_unwind
, s
);
3393 /* Parse network options in the arg list. We simply ignore anything
3394 which isn't a known option (including other keywords). An error
3395 is signaled if setting a known option fails. */
3397 Lisp_Object params
= contact
, key
, val
;
3399 while (!NILP (params
))
3401 key
= XCAR (params
);
3402 params
= XCDR (params
);
3403 val
= XCAR (params
);
3404 params
= XCDR (params
);
3405 optbits
|= set_socket_option (s
, key
, val
);
3411 /* Configure as a server socket. */
3413 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3414 explicit :reuseaddr key to override this. */
3415 #ifdef HAVE_LOCAL_SOCKETS
3416 if (family
!= AF_LOCAL
)
3418 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3421 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3422 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3425 /* If passed a socket descriptor, it should be already bound. */
3426 if (socket_to_use
< 0 && bind (s
, sa
, addrlen
) != 0)
3427 report_file_error ("Cannot bind server socket", Qnil
);
3429 #ifdef HAVE_GETSOCKNAME
3431 #ifdef HAVE_LOCAL_SOCKETS
3432 && family
!= AF_LOCAL
3436 struct sockaddr_in sa1
;
3437 socklen_t len1
= sizeof (sa1
);
3439 /* The code below assumes the port is at the same offset
3440 and of the same width in both IPv4 and IPv6
3441 structures, but the standards don't guarantee that,
3442 so verify it here. */
3443 struct sockaddr_in6 sa6
;
3444 verify ((offsetof (struct sockaddr_in
, sin_port
)
3445 == offsetof (struct sockaddr_in6
, sin6_port
))
3446 && sizeof (sa1
.sin_port
) == sizeof (sa6
.sin6_port
));
3448 DECLARE_POINTER_ALIAS (psa1
, struct sockaddr
, &sa1
);
3449 if (getsockname (s
, psa1
, &len1
) == 0)
3451 Lisp_Object service
= make_number (ntohs (sa1
.sin_port
));
3452 contact
= Fplist_put (contact
, QCservice
, service
);
3453 /* Save the port number so that we can stash it in
3454 the process object later. */
3455 DECLARE_POINTER_ALIAS (psa
, struct sockaddr_in
, sa
);
3456 psa
->sin_port
= sa1
.sin_port
;
3461 if (p
->socktype
!= SOCK_DGRAM
&& listen (s
, p
->backlog
))
3462 report_file_error ("Cannot listen on server socket", Qnil
);
3469 ret
= connect (s
, sa
, addrlen
);
3472 if (ret
== 0 || xerrno
== EISCONN
)
3474 /* The unwind-protect will be discarded afterwards. */
3478 if (p
->is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3482 if (xerrno
== EINTR
)
3484 /* Unlike most other syscalls connect() cannot be called
3485 again. (That would return EALREADY.) The proper way to
3486 wait for completion is pselect(). */
3494 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3500 report_file_error ("Failed select", Qnil
);
3504 len
= sizeof xerrno
;
3505 eassert (FD_ISSET (s
, &fdset
));
3506 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) < 0)
3507 report_file_error ("Failed getsockopt", Qnil
);
3510 if (NILP (addrinfos
))
3511 report_file_errno ("Failed connect", Qnil
, xerrno
);
3513 #endif /* !WINDOWSNT */
3515 /* Discard the unwind protect closing S. */
3516 specpdl_ptr
= specpdl
+ count
;
3519 if (0 <= socket_to_use
)
3523 if (xerrno
== EINTR
)
3530 #ifdef DATAGRAM_SOCKETS
3531 if (p
->socktype
== SOCK_DGRAM
)
3533 if (datagram_address
[s
].sa
)
3536 datagram_address
[s
].sa
= xmalloc (addrlen
);
3537 datagram_address
[s
].len
= addrlen
;
3541 memset (datagram_address
[s
].sa
, 0, addrlen
);
3542 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3545 ptrdiff_t rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3546 if (rlen
!= 0 && rfamily
== family
3548 conv_lisp_to_sockaddr (rfamily
, remote
,
3549 datagram_address
[s
].sa
, rlen
);
3553 memcpy (datagram_address
[s
].sa
, sa
, addrlen
);
3557 contact
= Fplist_put (contact
, p
->is_server
? QClocal
: QCremote
,
3558 conv_sockaddr_to_lisp (sa
, addrlen
));
3559 #ifdef HAVE_GETSOCKNAME
3562 struct sockaddr_storage sa1
;
3563 socklen_t len1
= sizeof (sa1
);
3564 DECLARE_POINTER_ALIAS (psa1
, struct sockaddr
, &sa1
);
3565 if (getsockname (s
, psa1
, &len1
) == 0)
3566 contact
= Fplist_put (contact
, QClocal
,
3567 conv_sockaddr_to_lisp (psa1
, len1
));
3574 /* If non-blocking got this far - and failed - assume non-blocking is
3575 not supported after all. This is probably a wrong assumption, but
3576 the normal blocking calls to open-network-stream handles this error
3578 if (p
->is_non_blocking_client
)
3581 report_file_errno ((p
->is_server
3582 ? "make server process failed"
3583 : "make client process failed"),
3590 chan_process
[inch
] = proc
;
3592 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3594 p
= XPROCESS (proc
);
3595 p
->open_fd
[SUBPROCESS_STDIN
] = inch
;
3599 /* Discard the unwind protect for closing S, if any. */
3600 specpdl_ptr
= specpdl
+ count
;
3602 if (p
->is_server
&& p
->socktype
!= SOCK_DGRAM
)
3603 pset_status (p
, Qlisten
);
3605 /* Make the process marker point into the process buffer (if any). */
3606 if (BUFFERP (p
->buffer
))
3607 set_marker_both (p
->mark
, p
->buffer
,
3608 BUF_ZV (XBUFFER (p
->buffer
)),
3609 BUF_ZV_BYTE (XBUFFER (p
->buffer
)));
3611 if (p
->is_non_blocking_client
)
3613 /* We may get here if connect did succeed immediately. However,
3614 in that case, we still need to signal this like a non-blocking
3616 if (! (connecting_status (p
->status
)
3617 && EQ (XCDR (p
->status
), addrinfos
)))
3618 pset_status (p
, Fcons (Qconnect
, addrinfos
));
3619 if ((fd_callback_info
[inch
].flags
& NON_BLOCKING_CONNECT_FD
) == 0)
3620 add_non_blocking_write_fd (inch
);
3623 /* A server may have a client filter setting of Qt, but it must
3624 still listen for incoming connects unless it is stopped. */
3625 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3626 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3627 add_process_read_fd (inch
);
3629 if (inch
> max_desc
)
3632 /* Set up the masks based on the process filter. */
3633 set_process_filter_masks (p
);
3635 setup_process_coding_systems (proc
);
3638 /* Continue the asynchronous connection. */
3639 if (!NILP (p
->gnutls_boot_parameters
))
3641 Lisp_Object boot
, params
= p
->gnutls_boot_parameters
;
3643 boot
= Fgnutls_boot (proc
, XCAR (params
), XCDR (params
));
3644 p
->gnutls_boot_parameters
= Qnil
;
3646 if (p
->gnutls_initstage
== GNUTLS_STAGE_READY
)
3647 /* Run sentinels, etc. */
3648 finish_after_tls_connection (proc
);
3649 else if (p
->gnutls_initstage
!= GNUTLS_STAGE_HANDSHAKE_TRIED
)
3651 deactivate_process (proc
);
3653 pset_status (p
, list2 (Qfailed
,
3654 build_string ("TLS negotiation failed")));
3656 pset_status (p
, list2 (Qfailed
, boot
));
3663 /* Create a network stream/datagram client/server process. Treated
3664 exactly like a normal process when reading and writing. Primary
3665 differences are in status display and process deletion. A network
3666 connection has no PID; you cannot signal it. All you can do is
3667 stop/continue it and deactivate/close it via delete-process. */
3669 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
3671 doc
: /* Create and return a network server or client process.
3673 In Emacs, network connections are represented by process objects, so
3674 input and output work as for subprocesses and `delete-process' closes
3675 a network connection. However, a network process has no process id,
3676 it cannot be signaled, and the status codes are different from normal
3679 Arguments are specified as keyword/argument pairs. The following
3680 arguments are defined:
3682 :name NAME -- NAME is name for process. It is modified if necessary
3685 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3686 with the process. Process output goes at end of that buffer, unless
3687 you specify an output stream or filter function to handle the output.
3688 BUFFER may be also nil, meaning that this process is not associated
3691 :host HOST -- HOST is name of the host to connect to, or its IP
3692 address. The symbol `local' specifies the local host. If specified
3693 for a server process, it must be a valid name or address for the local
3694 host, and only clients connecting to that address will be accepted.
3696 :service SERVICE -- SERVICE is name of the service desired, or an
3697 integer specifying a port number to connect to. If SERVICE is t,
3698 a random port number is selected for the server. A port number can
3699 be specified as an integer string, e.g., "80", as well as an integer.
3701 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3702 stream type connection, `datagram' creates a datagram type connection,
3703 `seqpacket' creates a reliable datagram connection.
3705 :family FAMILY -- FAMILY is the address (and protocol) family for the
3706 service specified by HOST and SERVICE. The default (nil) is to use
3707 whatever address family (IPv4 or IPv6) that is defined for the host
3708 and port number specified by HOST and SERVICE. Other address families
3710 local -- for a local (i.e. UNIX) address specified by SERVICE.
3711 ipv4 -- use IPv4 address family only.
3712 ipv6 -- use IPv6 address family only.
3714 :local ADDRESS -- ADDRESS is the local address used for the connection.
3715 This parameter is ignored when opening a client process. When specified
3716 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3718 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3719 connection. This parameter is ignored when opening a stream server
3720 process. For a datagram server process, it specifies the initial
3721 setting of the remote datagram address. When specified for a client
3722 process, the FAMILY, HOST, and SERVICE args are ignored.
3724 The format of ADDRESS depends on the address family:
3725 - An IPv4 address is represented as an vector of integers [A B C D P]
3726 corresponding to numeric IP address A.B.C.D and port number P.
3727 - A local address is represented as a string with the address in the
3728 local address space.
3729 - An "unsupported family" address is represented by a cons (F . AV)
3730 where F is the family number and AV is a vector containing the socket
3731 address data with one element per address data byte. Do not rely on
3732 this format in portable code, as it may depend on implementation
3733 defined constants, data sizes, and data structure alignment.
3735 :coding CODING -- If CODING is a symbol, it specifies the coding
3736 system used for both reading and writing for this process. If CODING
3737 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3738 ENCODING is used for writing.
3740 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3741 process, return without waiting for the connection to complete;
3742 instead, the sentinel function will be called with second arg matching
3743 "open" (if successful) or "failed" when the connect completes.
3744 Default is to use a blocking connect (i.e. wait) for stream type
3747 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3748 running when Emacs is exited.
3750 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3751 In the stopped state, a server process does not accept new
3752 connections, and a client process does not handle incoming traffic.
3753 The stopped state is cleared by `continue-process' and set by
3756 :filter FILTER -- Install FILTER as the process filter.
3758 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3759 process filter are multibyte, otherwise they are unibyte.
3760 If this keyword is not specified, the strings are multibyte if
3761 the default value of `enable-multibyte-characters' is non-nil.
3763 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3765 :log LOG -- Install LOG as the server process log function. This
3766 function is called when the server accepts a network connection from a
3767 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3768 is the server process, CLIENT is the new process for the connection,
3769 and MESSAGE is a string.
3771 :plist PLIST -- Install PLIST as the new process's initial plist.
3773 :tls-parameters LIST -- is a list that should be supplied if you're
3774 opening a TLS connection. The first element is the TLS type (either
3775 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3776 be a keyword list accepted by gnutls-boot (as returned by
3777 `gnutls-boot-parameters').
3779 :server QLEN -- if QLEN is non-nil, create a server process for the
3780 specified FAMILY, SERVICE, and connection type (stream or datagram).
3781 If QLEN is an integer, it is used as the max. length of the server's
3782 pending connection queue (also known as the backlog); the default
3783 queue length is 5. Default is to create a client process.
3785 The following network options can be specified for this connection:
3787 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3788 :dontroute BOOL -- Only send to directly connected hosts.
3789 :keepalive BOOL -- Send keep-alive messages on network stream.
3790 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3791 :oobinline BOOL -- Place out-of-band data in receive data stream.
3792 :priority INT -- Set protocol defined priority for sent packets.
3793 :reuseaddr BOOL -- Allow reusing a recently used local address
3794 (this is allowed by default for a server process).
3795 :bindtodevice NAME -- bind to interface NAME. Using this may require
3796 special privileges on some systems.
3797 :use-external-socket BOOL -- Use any pre-allocated sockets that have
3798 been passed to Emacs. If Emacs wasn't
3799 passed a socket, this option is silently
3803 Consult the relevant system programmer's manual pages for more
3804 information on using these options.
3807 A server process will listen for and accept connections from clients.
3808 When a client connection is accepted, a new network process is created
3809 for the connection with the following parameters:
3811 - The client's process name is constructed by concatenating the server
3812 process's NAME and a client identification string.
3813 - If the FILTER argument is non-nil, the client process will not get a
3814 separate process buffer; otherwise, the client's process buffer is a newly
3815 created buffer named after the server process's BUFFER name or process
3816 NAME concatenated with the client identification string.
3817 - The connection type and the process filter and sentinel parameters are
3818 inherited from the server process's TYPE, FILTER and SENTINEL.
3819 - The client process's contact info is set according to the client's
3820 addressing information (typically an IP address and a port number).
3821 - The client process's plist is initialized from the server's plist.
3823 Notice that the FILTER and SENTINEL args are never used directly by
3824 the server process. Also, the BUFFER argument is not used directly by
3825 the server process, but via the optional :log function, accepted (and
3826 failed) connections may be logged in the server process's buffer.
3828 The original argument list, modified with the actual connection
3829 information, is available via the `process-contact' function.
3831 usage: (make-network-process &rest ARGS) */)
3832 (ptrdiff_t nargs
, Lisp_Object
*args
)
3835 Lisp_Object contact
;
3836 struct Lisp_Process
*p
;
3837 const char *portstring UNINIT
;
3838 char portbuf
[INT_BUFSIZE_BOUND (EMACS_INT
)];
3839 #ifdef HAVE_LOCAL_SOCKETS
3840 struct sockaddr_un address_un
;
3844 Lisp_Object name
, buffer
, host
, service
, address
;
3845 Lisp_Object filter
, sentinel
, use_external_socket_p
;
3846 Lisp_Object addrinfos
= Qnil
;
3849 enum { any_protocol
= 0 };
3850 #ifdef HAVE_GETADDRINFO_A
3851 struct gaicb
*dns_request
= NULL
;
3853 ptrdiff_t count
= SPECPDL_INDEX ();
3858 /* Save arguments for process-contact and clone-process. */
3859 contact
= Flist (nargs
, args
);
3862 /* Ensure socket support is loaded if available. */
3863 init_winsock (TRUE
);
3866 /* :type TYPE (nil: stream, datagram */
3867 tem
= Fplist_get (contact
, QCtype
);
3869 socktype
= SOCK_STREAM
;
3870 #ifdef DATAGRAM_SOCKETS
3871 else if (EQ (tem
, Qdatagram
))
3872 socktype
= SOCK_DGRAM
;
3874 #ifdef HAVE_SEQPACKET
3875 else if (EQ (tem
, Qseqpacket
))
3876 socktype
= SOCK_SEQPACKET
;
3879 error ("Unsupported connection type");
3881 name
= Fplist_get (contact
, QCname
);
3882 buffer
= Fplist_get (contact
, QCbuffer
);
3883 filter
= Fplist_get (contact
, QCfilter
);
3884 sentinel
= Fplist_get (contact
, QCsentinel
);
3885 use_external_socket_p
= Fplist_get (contact
, QCuse_external_socket
);
3887 CHECK_STRING (name
);
3889 /* :local ADDRESS or :remote ADDRESS */
3890 tem
= Fplist_get (contact
, QCserver
);
3892 address
= Fplist_get (contact
, QCremote
);
3894 address
= Fplist_get (contact
, QClocal
);
3895 if (!NILP (address
))
3897 host
= service
= Qnil
;
3899 if (!get_lisp_to_sockaddr_size (address
, &family
))
3900 error ("Malformed :address");
3902 addrinfos
= list1 (Fcons (make_number (any_protocol
), address
));
3906 /* :family FAMILY -- nil (for Inet), local, or integer. */
3907 tem
= Fplist_get (contact
, QCfamily
);
3916 #ifdef HAVE_LOCAL_SOCKETS
3917 else if (EQ (tem
, Qlocal
))
3921 else if (EQ (tem
, Qipv6
))
3924 else if (EQ (tem
, Qipv4
))
3926 else if (TYPE_RANGED_INTEGERP (int, tem
))
3927 family
= XINT (tem
);
3929 error ("Unknown address family");
3931 /* :service SERVICE -- string, integer (port number), or t (random port). */
3932 service
= Fplist_get (contact
, QCservice
);
3934 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3935 host
= Fplist_get (contact
, QChost
);
3938 /* The "connection" function gets it bind info from the address we're
3939 given, so use this dummy address if nothing is specified. */
3940 #ifdef HAVE_LOCAL_SOCKETS
3941 if (family
!= AF_LOCAL
)
3943 host
= build_string ("127.0.0.1");
3947 if (EQ (host
, Qlocal
))
3948 /* Depending on setup, "localhost" may map to different IPv4 and/or
3949 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3950 host
= build_string ("127.0.0.1");
3951 CHECK_STRING (host
);
3954 #ifdef HAVE_LOCAL_SOCKETS
3955 if (family
== AF_LOCAL
)
3959 message (":family local ignores the :host property");
3960 contact
= Fplist_put (contact
, QChost
, Qnil
);
3963 CHECK_STRING (service
);
3964 if (sizeof address_un
.sun_path
<= SBYTES (service
))
3965 error ("Service name too long");
3966 addrinfos
= list1 (Fcons (make_number (any_protocol
), service
));
3971 /* Slow down polling to every ten seconds.
3972 Some kernels have a bug which causes retrying connect to fail
3973 after a connect. Polling can interfere with gethostbyname too. */
3974 #ifdef POLL_FOR_INPUT
3975 if (socktype
!= SOCK_DGRAM
)
3977 record_unwind_protect_void (run_all_atimers
);
3978 bind_polling_period (10);
3984 ptrdiff_t portstringlen ATTRIBUTE_UNUSED
;
3986 /* SERVICE can either be a string or int.
3987 Convert to a C string for later use by getaddrinfo. */
3988 if (EQ (service
, Qt
))
3993 else if (INTEGERP (service
))
3995 portstring
= portbuf
;
3996 portstringlen
= sprintf (portbuf
, "%"pI
"d", XINT (service
));
4000 CHECK_STRING (service
);
4001 portstring
= SSDATA (service
);
4002 portstringlen
= SBYTES (service
);
4005 #ifdef HAVE_GETADDRINFO_A
4006 if (!NILP (Fplist_get (contact
, QCnowait
)))
4008 ptrdiff_t hostlen
= SBYTES (host
);
4012 struct addrinfo hints
;
4013 char str
[FLEXIBLE_ARRAY_MEMBER
];
4014 } *req
= xmalloc (FLEXSIZEOF (struct req
, str
,
4015 hostlen
+ 1 + portstringlen
+ 1));
4016 dns_request
= &req
->gaicb
;
4017 dns_request
->ar_name
= req
->str
;
4018 dns_request
->ar_service
= req
->str
+ hostlen
+ 1;
4019 dns_request
->ar_request
= &req
->hints
;
4020 dns_request
->ar_result
= NULL
;
4021 memset (&req
->hints
, 0, sizeof req
->hints
);
4022 req
->hints
.ai_family
= family
;
4023 req
->hints
.ai_socktype
= socktype
;
4024 strcpy (req
->str
, SSDATA (host
));
4025 strcpy (req
->str
+ hostlen
+ 1, portstring
);
4027 int ret
= getaddrinfo_a (GAI_NOWAIT
, &dns_request
, 1, NULL
);
4029 error ("%s/%s getaddrinfo_a error %d",
4030 SSDATA (host
), portstring
, ret
);
4034 #endif /* HAVE_GETADDRINFO_A */
4037 /* If we have a host, use getaddrinfo to resolve both host and service.
4038 Otherwise, use getservbyname to lookup the service. */
4042 struct addrinfo
*res
, *lres
;
4047 struct addrinfo hints
;
4048 memset (&hints
, 0, sizeof hints
);
4049 hints
.ai_family
= family
;
4050 hints
.ai_socktype
= socktype
;
4052 ret
= getaddrinfo (SSDATA (host
), portstring
, &hints
, &res
);
4054 #ifdef HAVE_GAI_STRERROR
4056 synchronize_system_messages_locale ();
4057 char const *str
= gai_strerror (ret
);
4058 if (! NILP (Vlocale_coding_system
))
4059 str
= SSDATA (code_convert_string_norecord
4060 (build_string (str
), Vlocale_coding_system
, 0));
4061 error ("%s/%s %s", SSDATA (host
), portstring
, str
);
4064 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
4067 for (lres
= res
; lres
; lres
= lres
->ai_next
)
4068 addrinfos
= Fcons (conv_addrinfo_to_lisp (lres
), addrinfos
);
4070 addrinfos
= Fnreverse (addrinfos
);
4077 /* No hostname has been specified (e.g., a local server process). */
4079 if (EQ (service
, Qt
))
4081 else if (INTEGERP (service
))
4082 port
= XINT (service
);
4085 CHECK_STRING (service
);
4088 if (SBYTES (service
) != 0)
4090 /* Allow the service to be a string containing the port number,
4091 because that's allowed if you have getaddrbyname. */
4093 long int lport
= strtol (SSDATA (service
), &service_end
, 10);
4094 if (service_end
== SSDATA (service
) + SBYTES (service
))
4098 struct servent
*svc_info
4099 = getservbyname (SSDATA (service
),
4100 socktype
== SOCK_DGRAM
? "udp" : "tcp");
4102 port
= ntohs (svc_info
->s_port
);
4107 if (! (0 <= port
&& port
< 1 << 16))
4109 AUTO_STRING (unknown_service
, "Unknown service: %s");
4110 xsignal1 (Qerror
, CALLN (Fformat
, unknown_service
, service
));
4116 buffer
= Fget_buffer_create (buffer
);
4118 /* Unwind bind_polling_period. */
4119 unbind_to (count
, Qnil
);
4121 proc
= make_process (name
);
4122 record_unwind_protect (remove_process
, proc
);
4123 p
= XPROCESS (proc
);
4124 pset_childp (p
, contact
);
4125 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
4126 pset_type (p
, Qnetwork
);
4128 pset_buffer (p
, buffer
);
4129 pset_sentinel (p
, sentinel
);
4130 pset_filter (p
, filter
);
4131 pset_log (p
, Fplist_get (contact
, QClog
));
4132 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
4133 p
->kill_without_query
= 1;
4134 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
4135 pset_command (p
, Qt
);
4136 eassert (p
->pid
== 0);
4138 eassert (! p
->is_non_blocking_client
);
4139 eassert (! p
->is_server
);
4141 p
->socktype
= socktype
;
4142 #ifdef HAVE_GETADDRINFO_A
4143 eassert (! p
->dns_request
);
4146 tem
= Fplist_get (contact
, QCtls_parameters
);
4148 p
->gnutls_boot_parameters
= tem
;
4151 set_network_socket_coding_system (proc
, host
, service
, name
);
4154 tem
= Fplist_get (contact
, QCserver
);
4157 /* Don't support network sockets when non-blocking mode is
4158 not available, since a blocked Emacs is not useful. */
4159 p
->is_server
= true;
4160 if (TYPE_RANGED_INTEGERP (int, tem
))
4161 p
->backlog
= XINT (tem
);
4165 if (!p
->is_server
&& socktype
!= SOCK_DGRAM
4166 && !NILP (Fplist_get (contact
, QCnowait
)))
4167 p
->is_non_blocking_client
= true;
4169 bool postpone_connection
= false;
4170 #ifdef HAVE_GETADDRINFO_A
4171 /* With async address resolution, the list of addresses is empty, so
4172 postpone connecting to the server. */
4173 if (!p
->is_server
&& NILP (addrinfos
))
4175 p
->dns_request
= dns_request
;
4176 p
->status
= list1 (Qconnect
);
4177 postpone_connection
= true;
4180 if (! postpone_connection
)
4181 connect_network_socket (proc
, addrinfos
, use_external_socket_p
);
4183 specpdl_ptr
= specpdl
+ count
;
4188 #ifdef HAVE_NET_IF_H
4192 network_interface_list (void)
4194 struct ifconf ifconf
;
4195 struct ifreq
*ifreq
;
4197 ptrdiff_t buf_size
= 512;
4202 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
4205 count
= SPECPDL_INDEX ();
4206 record_unwind_protect_int (close_file_unwind
, s
);
4210 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
4211 ifconf
.ifc_buf
= buf
;
4212 ifconf
.ifc_len
= buf_size
;
4213 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
4220 while (ifconf
.ifc_len
== buf_size
);
4222 res
= unbind_to (count
, Qnil
);
4223 ifreq
= ifconf
.ifc_req
;
4224 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
4226 struct ifreq
*ifq
= ifreq
;
4227 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
4228 #define SIZEOF_IFREQ(sif) \
4229 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
4230 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
4232 int len
= SIZEOF_IFREQ (ifq
);
4234 int len
= sizeof (*ifreq
);
4236 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
4237 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
4239 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
4242 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
4243 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
4244 res
= Fcons (Fcons (build_string (namebuf
),
4245 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
4246 sizeof (struct sockaddr
))),
4253 #endif /* SIOCGIFCONF */
4255 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4259 const char *flag_sym
;
4262 static const struct ifflag_def ifflag_table
[] = {
4266 #ifdef IFF_BROADCAST
4267 { IFF_BROADCAST
, "broadcast" },
4270 { IFF_DEBUG
, "debug" },
4273 { IFF_LOOPBACK
, "loopback" },
4275 #ifdef IFF_POINTOPOINT
4276 { IFF_POINTOPOINT
, "pointopoint" },
4279 { IFF_RUNNING
, "running" },
4282 { IFF_NOARP
, "noarp" },
4285 { IFF_PROMISC
, "promisc" },
4287 #ifdef IFF_NOTRAILERS
4288 #ifdef NS_IMPL_COCOA
4289 /* Really means smart, notrailers is obsolete. */
4290 { IFF_NOTRAILERS
, "smart" },
4292 { IFF_NOTRAILERS
, "notrailers" },
4296 { IFF_ALLMULTI
, "allmulti" },
4299 { IFF_MASTER
, "master" },
4302 { IFF_SLAVE
, "slave" },
4304 #ifdef IFF_MULTICAST
4305 { IFF_MULTICAST
, "multicast" },
4308 { IFF_PORTSEL
, "portsel" },
4310 #ifdef IFF_AUTOMEDIA
4311 { IFF_AUTOMEDIA
, "automedia" },
4314 { IFF_DYNAMIC
, "dynamic" },
4317 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress. */
4320 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4323 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit. */
4326 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit. */
4329 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit. */
4335 network_interface_info (Lisp_Object ifname
)
4338 Lisp_Object res
= Qnil
;
4343 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4344 && defined HAVE_GETIFADDRS && defined LLADDR)
4345 struct ifaddrs
*ifap
;
4348 CHECK_STRING (ifname
);
4350 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
4351 error ("interface name too long");
4352 lispstpcpy (rq
.ifr_name
, ifname
);
4354 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
4357 count
= SPECPDL_INDEX ();
4358 record_unwind_protect_int (close_file_unwind
, s
);
4361 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4362 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
4364 int flags
= rq
.ifr_flags
;
4365 const struct ifflag_def
*fp
;
4368 /* If flags is smaller than int (i.e. short) it may have the high bit set
4369 due to IFF_MULTICAST. In that case, sign extending it into
4371 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
4372 flags
= (unsigned short) rq
.ifr_flags
;
4375 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
4377 if (flags
& fp
->flag_bit
)
4379 elt
= Fcons (intern (fp
->flag_sym
), elt
);
4380 flags
-= fp
->flag_bit
;
4383 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
4387 elt
= Fcons (make_number (fnum
), elt
);
4392 res
= Fcons (elt
, res
);
4395 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4396 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4398 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4399 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4403 for (n
= 0; n
< 6; n
++)
4404 p
->contents
[n
] = make_number (((unsigned char *)
4405 &rq
.ifr_hwaddr
.sa_data
[0])
4407 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4409 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4410 if (getifaddrs (&ifap
) != -1)
4412 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4413 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4416 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
4418 DECLARE_POINTER_ALIAS (sdl
, struct sockaddr_dl
, it
->ifa_addr
);
4419 unsigned char linkaddr
[6];
4422 if (it
->ifa_addr
->sa_family
!= AF_LINK
4423 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
4424 || sdl
->sdl_alen
!= 6)
4427 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
4428 for (n
= 0; n
< 6; n
++)
4429 p
->contents
[n
] = make_number (linkaddr
[n
]);
4431 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
4435 #ifdef HAVE_FREEIFADDRS
4439 #endif /* HAVE_GETIFADDRS && LLADDR */
4441 res
= Fcons (elt
, res
);
4444 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4445 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4448 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4449 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4451 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4455 res
= Fcons (elt
, res
);
4458 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4459 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4462 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4465 res
= Fcons (elt
, res
);
4468 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4469 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4472 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4475 res
= Fcons (elt
, res
);
4477 return unbind_to (count
, any
? res
: Qnil
);
4479 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4480 #endif /* defined (HAVE_NET_IF_H) */
4482 DEFUN ("network-interface-list", Fnetwork_interface_list
,
4483 Snetwork_interface_list
, 0, 0, 0,
4484 doc
: /* Return an alist of all network interfaces and their network address.
4485 Each element is a cons, the car of which is a string containing the
4486 interface name, and the cdr is the network address in internal
4487 format; see the description of ADDRESS in `make-network-process'.
4489 If the information is not available, return nil. */)
4492 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4493 return network_interface_list ();
4499 DEFUN ("network-interface-info", Fnetwork_interface_info
,
4500 Snetwork_interface_info
, 1, 1, 0,
4501 doc
: /* Return information about network interface named IFNAME.
4502 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4503 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4504 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4505 FLAGS is the current flags of the interface.
4507 Data that is unavailable is returned as nil. */)
4508 (Lisp_Object ifname
)
4510 #if ((defined HAVE_NET_IF_H \
4511 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4512 || defined SIOCGIFFLAGS)) \
4513 || defined WINDOWSNT)
4514 return network_interface_info (ifname
);
4520 /* Turn off input and output for process PROC. */
4523 deactivate_process (Lisp_Object proc
)
4526 struct Lisp_Process
*p
= XPROCESS (proc
);
4530 /* Delete GnuTLS structures in PROC, if any. */
4531 emacs_gnutls_deinit (proc
);
4532 #endif /* HAVE_GNUTLS */
4534 if (p
->read_output_delay
> 0)
4536 if (--process_output_delay_count
< 0)
4537 process_output_delay_count
= 0;
4538 p
->read_output_delay
= 0;
4539 p
->read_output_skip
= 0;
4542 /* Beware SIGCHLD hereabouts. */
4544 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
4545 close_process_fd (&p
->open_fd
[i
]);
4547 inchannel
= p
->infd
;
4552 #ifdef DATAGRAM_SOCKETS
4553 if (DATAGRAM_CHAN_P (inchannel
))
4555 xfree (datagram_address
[inchannel
].sa
);
4556 datagram_address
[inchannel
].sa
= 0;
4557 datagram_address
[inchannel
].len
= 0;
4560 chan_process
[inchannel
] = Qnil
;
4561 delete_read_fd (inchannel
);
4562 if ((fd_callback_info
[inchannel
].flags
& NON_BLOCKING_CONNECT_FD
) != 0)
4563 delete_write_fd (inchannel
);
4564 if (inchannel
== max_desc
)
4565 recompute_max_desc ();
4570 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4572 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4573 It is given to their filter functions.
4574 Optional argument PROCESS means do not return until output has been
4575 received from PROCESS.
4577 Optional second argument SECONDS and third argument MILLISEC
4578 specify a timeout; return after that much time even if there is
4579 no subprocess output. If SECONDS is a floating point number,
4580 it specifies a fractional number of seconds to wait.
4581 The MILLISEC argument is obsolete and should be avoided.
4583 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4584 from PROCESS only, suspending reading output from other processes.
4585 If JUST-THIS-ONE is an integer, don't run any timers either.
4586 Return non-nil if we received any output from PROCESS (or, if PROCESS
4587 is nil, from any process) before the timeout expired. */)
4588 (Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
,
4589 Lisp_Object just_this_one
)
4594 if (! NILP (process
))
4596 CHECK_PROCESS (process
);
4597 struct Lisp_Process
*proc
= XPROCESS (process
);
4599 /* Can't wait for a process that is dedicated to a different
4601 if (!EQ (proc
->thread
, Qnil
) && !EQ (proc
->thread
, Fcurrent_thread ()))
4603 Lisp_Object proc_thread_name
= XTHREAD (proc
->thread
)->name
;
4605 if (STRINGP (proc_thread_name
))
4606 error ("Attempt to accept output from process %s locked to thread %s",
4607 SDATA (proc
->name
), SDATA (proc_thread_name
));
4609 error ("Attempt to accept output from process %s locked to thread %p",
4610 SDATA (proc
->name
), XTHREAD (proc
->thread
));
4614 just_this_one
= Qnil
;
4616 if (!NILP (millisec
))
4617 { /* Obsolete calling convention using integers rather than floats. */
4618 CHECK_NUMBER (millisec
);
4620 seconds
= make_float (XINT (millisec
) / 1000.0);
4623 CHECK_NUMBER (seconds
);
4624 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4631 if (!NILP (seconds
))
4633 if (INTEGERP (seconds
))
4635 if (XINT (seconds
) > 0)
4637 secs
= XINT (seconds
);
4641 else if (FLOATP (seconds
))
4643 if (XFLOAT_DATA (seconds
) > 0)
4645 struct timespec t
= dtotimespec (XFLOAT_DATA (seconds
));
4646 secs
= min (t
.tv_sec
, WAIT_READING_MAX
);
4651 wrong_type_argument (Qnumberp
, seconds
);
4653 else if (! NILP (process
))
4657 ((wait_reading_process_output (secs
, nsecs
, 0, 0,
4659 !NILP (process
) ? XPROCESS (process
) : NULL
,
4660 (NILP (just_this_one
) ? 0
4661 : !INTEGERP (just_this_one
) ? 1 : -1))
4666 /* Accept a connection for server process SERVER on CHANNEL. */
4668 static EMACS_INT connect_counter
= 0;
4671 server_accept_connection (Lisp_Object server
, int channel
)
4674 Lisp_Object contact
, host
, service
;
4675 struct Lisp_Process
*ps
= XPROCESS (server
);
4676 struct Lisp_Process
*p
;
4680 struct sockaddr_in in
;
4682 struct sockaddr_in6 in6
;
4684 #ifdef HAVE_LOCAL_SOCKETS
4685 struct sockaddr_un un
;
4688 socklen_t len
= sizeof saddr
;
4691 s
= accept4 (channel
, &saddr
.sa
, &len
, SOCK_CLOEXEC
);
4696 if (!would_block (code
) && !NILP (ps
->log
))
4697 call3 (ps
->log
, server
, Qnil
,
4698 concat3 (build_string ("accept failed with code"),
4699 Fnumber_to_string (make_number (code
)),
4700 build_string ("\n")));
4704 count
= SPECPDL_INDEX ();
4705 record_unwind_protect_int (close_file_unwind
, s
);
4709 /* Setup a new process to handle the connection. */
4711 /* Generate a unique identification of the caller, and build contact
4712 information for this process. */
4715 Lisp_Object args
[11];
4717 AUTO_STRING (procname_format_in
, "%s <%d.%d.%d.%d:%d>");
4718 AUTO_STRING (procname_format_in6
, "%s <[%x:%x:%x:%x:%x:%x:%x:%x]:%d>");
4719 AUTO_STRING (procname_format_default
, "%s <%d>");
4720 switch (saddr
.sa
.sa_family
)
4724 args
[nargs
++] = procname_format_in
;
4726 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4727 service
= make_number (ntohs (saddr
.in
.sin_port
));
4728 for (int i
= 0; i
< 4; i
++)
4729 args
[nargs
++] = make_number (ip
[i
]);
4730 args
[nargs
++] = service
;
4737 args
[nargs
++] = procname_format_in6
;
4739 DECLARE_POINTER_ALIAS (ip6
, uint16_t, &saddr
.in6
.sin6_addr
);
4740 service
= make_number (ntohs (saddr
.in
.sin_port
));
4741 for (int i
= 0; i
< 8; i
++)
4742 args
[nargs
++] = make_number (ip6
[i
]);
4743 args
[nargs
++] = service
;
4749 args
[nargs
++] = procname_format_default
;
4751 args
[nargs
++] = make_number (connect_counter
);
4755 /* Create a new buffer name for this process if it doesn't have a
4756 filter. The new buffer name is based on the buffer name or
4757 process name of the server process concatenated with the caller
4760 if (!(EQ (ps
->filter
, Qinternal_default_process_filter
)
4761 || EQ (ps
->filter
, Qt
)))
4765 buffer
= ps
->buffer
;
4767 buffer
= Fbuffer_name (buffer
);
4773 buffer
= Fget_buffer_create (Fformat (nargs
, args
));
4777 /* Generate a unique name for the new server process. Combine the
4778 server process name with the caller identification. */
4781 Lisp_Object name
= Fformat (nargs
, args
);
4782 Lisp_Object proc
= make_process (name
);
4784 chan_process
[s
] = proc
;
4786 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4788 p
= XPROCESS (proc
);
4790 /* Build new contact information for this setup. */
4791 contact
= Fcopy_sequence (ps
->childp
);
4792 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4793 contact
= Fplist_put (contact
, QChost
, host
);
4794 if (!NILP (service
))
4795 contact
= Fplist_put (contact
, QCservice
, service
);
4796 contact
= Fplist_put (contact
, QCremote
,
4797 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4798 #ifdef HAVE_GETSOCKNAME
4800 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4801 contact
= Fplist_put (contact
, QClocal
,
4802 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4805 pset_childp (p
, contact
);
4806 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4807 pset_type (p
, Qnetwork
);
4809 pset_buffer (p
, buffer
);
4810 pset_sentinel (p
, ps
->sentinel
);
4811 pset_filter (p
, ps
->filter
);
4812 eassert (NILP (p
->command
));
4813 eassert (p
->pid
== 0);
4815 /* Discard the unwind protect for closing S. */
4816 specpdl_ptr
= specpdl
+ count
;
4818 p
->open_fd
[SUBPROCESS_STDIN
] = s
;
4821 pset_status (p
, Qrun
);
4823 /* Client processes for accepted connections are not stopped initially. */
4824 if (!EQ (p
->filter
, Qt
))
4825 add_process_read_fd (s
);
4829 /* Setup coding system for new process based on server process.
4830 This seems to be the proper thing to do, as the coding system
4831 of the new process should reflect the settings at the time the
4832 server socket was opened; not the current settings. */
4834 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4835 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4836 setup_process_coding_systems (proc
);
4838 pset_decoding_buf (p
, empty_unibyte_string
);
4839 eassert (p
->decoding_carryover
== 0);
4840 pset_encoding_buf (p
, empty_unibyte_string
);
4842 p
->inherit_coding_system_flag
4843 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4845 AUTO_STRING (dash
, "-");
4846 AUTO_STRING (nl
, "\n");
4847 Lisp_Object host_string
= STRINGP (host
) ? host
: dash
;
4849 if (!NILP (ps
->log
))
4851 AUTO_STRING (accept_from
, "accept from ");
4852 call3 (ps
->log
, server
, proc
, concat3 (accept_from
, host_string
, nl
));
4855 AUTO_STRING (open_from
, "open from ");
4856 exec_sentinel (proc
, concat3 (open_from
, host_string
, nl
));
4859 #ifdef HAVE_GETADDRINFO_A
4861 check_for_dns (Lisp_Object proc
)
4863 struct Lisp_Process
*p
= XPROCESS (proc
);
4864 Lisp_Object addrinfos
= Qnil
;
4867 if (! p
->dns_request
)
4870 int ret
= gai_error (p
->dns_request
);
4871 if (ret
== EAI_INPROGRESS
)
4874 /* We got a response. */
4877 struct addrinfo
*res
;
4879 for (res
= p
->dns_request
->ar_result
; res
; res
= res
->ai_next
)
4880 addrinfos
= Fcons (conv_addrinfo_to_lisp (res
), addrinfos
);
4882 addrinfos
= Fnreverse (addrinfos
);
4884 /* The DNS lookup failed. */
4885 else if (connecting_status (p
->status
))
4887 deactivate_process (proc
);
4888 pset_status (p
, (list2
4890 concat3 (build_string ("Name lookup of "),
4891 build_string (p
->dns_request
->ar_name
),
4892 build_string (" failed")))));
4895 free_dns_request (proc
);
4897 /* This process should not already be connected (or killed). */
4898 if (! connecting_status (p
->status
))
4904 #endif /* HAVE_GETADDRINFO_A */
4907 wait_for_socket_fds (Lisp_Object process
, char const *name
)
4909 while (XPROCESS (process
)->infd
< 0
4910 && connecting_status (XPROCESS (process
)->status
))
4912 add_to_log ("Waiting for socket from %s...", build_string (name
));
4913 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4918 wait_while_connecting (Lisp_Object process
)
4920 while (connecting_status (XPROCESS (process
)->status
))
4922 add_to_log ("Waiting for connection...");
4923 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4928 wait_for_tls_negotiation (Lisp_Object process
)
4931 while (XPROCESS (process
)->gnutls_p
4932 && XPROCESS (process
)->gnutls_initstage
!= GNUTLS_STAGE_READY
)
4934 add_to_log ("Waiting for TLS...");
4935 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4941 wait_reading_process_output_unwind (int data
)
4943 clear_waiting_thread_info ();
4944 waiting_for_user_input_p
= data
;
4947 /* This is here so breakpoints can be put on it. */
4949 wait_reading_process_output_1 (void)
4953 /* Read and dispose of subprocess output while waiting for timeout to
4954 elapse and/or keyboard input to be available.
4958 If negative, gobble data immediately available but don't wait for any.
4961 an additional duration to wait, measured in nanoseconds
4962 If TIME_LIMIT is zero, then:
4963 If NSECS == 0, there is no limit.
4964 If NSECS > 0, the timeout consists of NSECS only.
4965 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4968 0 to ignore keyboard input, or
4969 1 to return when input is available, or
4970 -1 meaning caller will actually read the input, so don't throw to
4973 DO_DISPLAY means redisplay should be done to show subprocess
4974 output that arrives.
4976 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4977 (and gobble terminal input into the buffer if any arrives).
4979 If WAIT_PROC is specified, wait until something arrives from that
4982 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4983 (suspending output from other processes). A negative value
4984 means don't run any timers either.
4986 Return positive if we received input from WAIT_PROC (or from any
4987 process if WAIT_PROC is null), zero if we attempted to receive
4988 input but got none, and negative if we didn't even try. */
4991 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4993 Lisp_Object wait_for_cell
,
4994 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
5004 struct timespec timeout
, end_time
, timer_delay
;
5005 struct timespec got_output_end_time
= invalid_timespec ();
5006 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
5007 int got_some_output
= -1;
5008 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5009 bool retry_for_async
;
5011 ptrdiff_t count
= SPECPDL_INDEX ();
5013 /* Close to the current time if known, an invalid timespec otherwise. */
5014 struct timespec now
= invalid_timespec ();
5016 eassert (wait_proc
== NULL
5017 || EQ (wait_proc
->thread
, Qnil
)
5018 || XTHREAD (wait_proc
->thread
) == current_thread
);
5020 FD_ZERO (&Available
);
5023 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
5024 && !(CONSP (wait_proc
->status
)
5025 && EQ (XCAR (wait_proc
->status
), Qexit
)))
5026 message1 ("Blocking call to accept-process-output with quit inhibited!!");
5028 record_unwind_protect_int (wait_reading_process_output_unwind
,
5029 waiting_for_user_input_p
);
5030 waiting_for_user_input_p
= read_kbd
;
5032 if (TYPE_MAXIMUM (time_t) < time_limit
)
5033 time_limit
= TYPE_MAXIMUM (time_t);
5035 if (time_limit
< 0 || nsecs
< 0)
5037 else if (time_limit
> 0 || nsecs
> 0)
5040 now
= current_timespec ();
5041 end_time
= timespec_add (now
, make_timespec (time_limit
, nsecs
));
5048 bool process_skipped
= false;
5050 /* If calling from keyboard input, do not quit
5051 since we want to return C-g as an input character.
5052 Otherwise, do pending quit if requested. */
5055 else if (pending_signals
)
5056 process_pending_signals ();
5058 /* Exit now if the cell we're waiting for became non-nil. */
5059 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5062 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5064 Lisp_Object process_list_head
, aproc
;
5065 struct Lisp_Process
*p
;
5067 retry_for_async
= false;
5068 FOR_EACH_PROCESS(process_list_head
, aproc
)
5070 p
= XPROCESS (aproc
);
5072 if (! wait_proc
|| p
== wait_proc
)
5074 #ifdef HAVE_GETADDRINFO_A
5075 /* Check for pending DNS requests. */
5078 Lisp_Object addrinfos
= check_for_dns (aproc
);
5079 if (!NILP (addrinfos
) && !EQ (addrinfos
, Qt
))
5080 connect_network_socket (aproc
, addrinfos
, Qnil
);
5082 retry_for_async
= true;
5086 /* Continue TLS negotiation. */
5087 if (p
->gnutls_initstage
== GNUTLS_STAGE_HANDSHAKE_TRIED
5088 && p
->is_non_blocking_client
)
5090 gnutls_try_handshake (p
);
5091 p
->gnutls_handshakes_tried
++;
5093 if (p
->gnutls_initstage
== GNUTLS_STAGE_READY
)
5095 gnutls_verify_boot (aproc
, Qnil
);
5096 finish_after_tls_connection (aproc
);
5100 retry_for_async
= true;
5101 if (p
->gnutls_handshakes_tried
5102 > GNUTLS_EMACS_HANDSHAKES_LIMIT
)
5104 deactivate_process (aproc
);
5105 pset_status (p
, list2 (Qfailed
,
5106 build_string ("TLS negotiation failed")));
5114 #endif /* GETADDRINFO_A or GNUTLS */
5116 /* Compute time from now till when time limit is up. */
5117 /* Exit if already run out. */
5118 if (wait
== TIMEOUT
)
5120 if (!timespec_valid_p (now
))
5121 now
= current_timespec ();
5122 if (timespec_cmp (end_time
, now
) <= 0)
5124 timeout
= timespec_sub (end_time
, now
);
5127 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
5129 /* Normally we run timers here.
5130 But not if wait_for_cell; in those cases,
5131 the wait is supposed to be short,
5132 and those callers cannot handle running arbitrary Lisp code here. */
5133 if (NILP (wait_for_cell
)
5134 && just_wait_proc
>= 0)
5138 unsigned old_timers_run
= timers_run
;
5139 struct buffer
*old_buffer
= current_buffer
;
5140 Lisp_Object old_window
= selected_window
;
5142 timer_delay
= timer_check ();
5144 /* If a timer has run, this might have changed buffers
5145 an alike. Make read_key_sequence aware of that. */
5146 if (timers_run
!= old_timers_run
5147 && (old_buffer
!= current_buffer
5148 || !EQ (old_window
, selected_window
))
5149 && waiting_for_user_input_p
== -1)
5150 record_asynch_buffer_change ();
5152 if (timers_run
!= old_timers_run
&& do_display
)
5153 /* We must retry, since a timer may have requeued itself
5154 and that could alter the time_delay. */
5155 redisplay_preserve_echo_area (9);
5159 while (!detect_input_pending ());
5161 /* If there is unread keyboard input, also return. */
5163 && requeued_events_pending_p ())
5166 /* This is so a breakpoint can be put here. */
5167 if (!timespec_valid_p (timer_delay
))
5168 wait_reading_process_output_1 ();
5171 /* Cause C-g and alarm signals to take immediate action,
5172 and cause input available signals to zero out timeout.
5174 It is important that we do this before checking for process
5175 activity. If we get a SIGCHLD after the explicit checks for
5176 process activity, timeout is the only way we will know. */
5178 set_waiting_for_input (&timeout
);
5180 /* If status of something has changed, and no input is
5181 available, notify the user of the change right away. After
5182 this explicit check, we'll let the SIGCHLD handler zap
5183 timeout to get our attention. */
5184 if (update_tick
!= process_tick
)
5189 if (kbd_on_hold_p ())
5192 compute_input_wait_mask (&Atemp
);
5193 compute_write_mask (&Ctemp
);
5195 timeout
= make_timespec (0, 0);
5196 if ((thread_select (pselect
, max_desc
+ 1,
5198 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
5199 NULL
, &timeout
, NULL
)
5202 /* It's okay for us to do this and then continue with
5203 the loop, since timeout has already been zeroed out. */
5204 clear_waiting_for_input ();
5205 got_some_output
= status_notify (NULL
, wait_proc
);
5206 if (do_display
) redisplay_preserve_echo_area (13);
5210 /* Don't wait for output from a non-running process. Just
5211 read whatever data has already been received. */
5212 if (wait_proc
&& wait_proc
->raw_status_new
)
5213 update_status (wait_proc
);
5215 && ! EQ (wait_proc
->status
, Qrun
)
5216 && ! connecting_status (wait_proc
->status
))
5218 bool read_some_bytes
= false;
5220 clear_waiting_for_input ();
5222 /* If data can be read from the process, do so until exhausted. */
5223 if (wait_proc
->infd
>= 0)
5225 XSETPROCESS (proc
, wait_proc
);
5229 int nread
= read_process_output (proc
, wait_proc
->infd
);
5232 if (errno
== EIO
|| would_block (errno
))
5237 if (got_some_output
< nread
)
5238 got_some_output
= nread
;
5241 read_some_bytes
= true;
5246 if (read_some_bytes
&& do_display
)
5247 redisplay_preserve_echo_area (10);
5252 /* Wait till there is something to do. */
5254 if (wait_proc
&& just_wait_proc
)
5256 if (wait_proc
->infd
< 0) /* Terminated. */
5258 FD_SET (wait_proc
->infd
, &Available
);
5262 else if (!NILP (wait_for_cell
))
5264 compute_non_process_wait_mask (&Available
);
5271 compute_non_keyboard_wait_mask (&Available
);
5273 compute_input_wait_mask (&Available
);
5274 compute_write_mask (&Writeok
);
5275 check_delay
= wait_proc
? 0 : process_output_delay_count
;
5279 /* If frame size has changed or the window is newly mapped,
5280 redisplay now, before we start to wait. There is a race
5281 condition here; if a SIGIO arrives between now and the select
5282 and indicates that a frame is trashed, the select may block
5283 displaying a trashed screen. */
5284 if (frame_garbaged
&& do_display
)
5286 clear_waiting_for_input ();
5287 redisplay_preserve_echo_area (11);
5289 set_waiting_for_input (&timeout
);
5292 /* Skip the `select' call if input is available and we're
5293 waiting for keyboard input or a cell change (which can be
5294 triggered by processing X events). In the latter case, set
5295 nfds to 1 to avoid breaking the loop. */
5297 if ((read_kbd
|| !NILP (wait_for_cell
))
5298 && detect_input_pending ())
5300 nfds
= read_kbd
? 0 : 1;
5302 FD_ZERO (&Available
);
5306 /* Set the timeout for adaptive read buffering if any
5307 process has non-zero read_output_skip and non-zero
5308 read_output_delay, and we are not reading output for a
5309 specific process. It is not executed if
5310 Vprocess_adaptive_read_buffering is nil. */
5311 if (process_output_skip
&& check_delay
> 0)
5313 int adaptive_nsecs
= timeout
.tv_nsec
;
5314 if (timeout
.tv_sec
> 0 || adaptive_nsecs
> READ_OUTPUT_DELAY_MAX
)
5315 adaptive_nsecs
= READ_OUTPUT_DELAY_MAX
;
5316 for (channel
= 0; check_delay
> 0 && channel
<= max_desc
; channel
++)
5318 proc
= chan_process
[channel
];
5321 /* Find minimum non-zero read_output_delay among the
5322 processes with non-zero read_output_skip. */
5323 if (XPROCESS (proc
)->read_output_delay
> 0)
5326 if (!XPROCESS (proc
)->read_output_skip
)
5328 FD_CLR (channel
, &Available
);
5329 process_skipped
= true;
5330 XPROCESS (proc
)->read_output_skip
= 0;
5331 if (XPROCESS (proc
)->read_output_delay
< adaptive_nsecs
)
5332 adaptive_nsecs
= XPROCESS (proc
)->read_output_delay
;
5335 timeout
= make_timespec (0, adaptive_nsecs
);
5336 process_output_skip
= 0;
5339 /* If we've got some output and haven't limited our timeout
5340 with adaptive read buffering, limit it. */
5341 if (got_some_output
> 0 && !process_skipped
5343 || timeout
.tv_nsec
> READ_OUTPUT_DELAY_INCREMENT
))
5344 timeout
= make_timespec (0, READ_OUTPUT_DELAY_INCREMENT
);
5347 if (NILP (wait_for_cell
) && just_wait_proc
>= 0
5348 && timespec_valid_p (timer_delay
)
5349 && timespec_cmp (timer_delay
, timeout
) < 0)
5351 if (!timespec_valid_p (now
))
5352 now
= current_timespec ();
5353 struct timespec timeout_abs
= timespec_add (now
, timeout
);
5354 if (!timespec_valid_p (got_output_end_time
)
5355 || timespec_cmp (timeout_abs
, got_output_end_time
) < 0)
5356 got_output_end_time
= timeout_abs
;
5357 timeout
= timer_delay
;
5360 got_output_end_time
= invalid_timespec ();
5362 /* NOW can become inaccurate if time can pass during pselect. */
5363 if (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0)
5364 now
= invalid_timespec ();
5366 #if defined HAVE_GETADDRINFO_A || defined HAVE_GNUTLS
5368 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> ASYNC_RETRY_NSEC
))
5371 timeout
.tv_nsec
= ASYNC_RETRY_NSEC
;
5375 /* Non-macOS HAVE_GLIB builds call thread_select in xgselect.c. */
5376 #if defined HAVE_GLIB && !defined HAVE_NS
5377 nfds
= xg_select (max_desc
+ 1,
5378 &Available
, (check_write
? &Writeok
: 0),
5379 NULL
, &timeout
, NULL
);
5380 #elif defined HAVE_NS
5381 /* And NS builds call thread_select in ns_select. */
5382 nfds
= ns_select (max_desc
+ 1,
5383 &Available
, (check_write
? &Writeok
: 0),
5384 NULL
, &timeout
, NULL
);
5385 #else /* !HAVE_GLIB */
5386 nfds
= thread_select (pselect
, max_desc
+ 1,
5388 (check_write
? &Writeok
: 0),
5389 NULL
, &timeout
, NULL
);
5390 #endif /* !HAVE_GLIB */
5393 /* GnuTLS buffers data internally. In lowat mode it leaves
5394 some data in the TCP buffers so that select works, but
5395 with custom pull/push functions we need to check if some
5396 data is available in the buffers manually. */
5399 fd_set tls_available
;
5402 FD_ZERO (&tls_available
);
5405 /* We're not waiting on a specific process, so loop
5406 through all the channels and check for data.
5407 This is a workaround needed for some versions of
5408 the gnutls library -- 2.12.14 has been confirmed
5410 http://comments.gmane.org/gmane.emacs.devel/145074 */
5411 for (channel
= 0; channel
< FD_SETSIZE
; ++channel
)
5412 if (! NILP (chan_process
[channel
]))
5414 struct Lisp_Process
*p
=
5415 XPROCESS (chan_process
[channel
]);
5416 if (p
&& p
->gnutls_p
&& p
->gnutls_state
5417 && ((emacs_gnutls_record_check_pending
5422 eassert (p
->infd
== channel
);
5423 FD_SET (p
->infd
, &tls_available
);
5430 /* Check this specific channel. */
5431 if (wait_proc
->gnutls_p
/* Check for valid process. */
5432 && wait_proc
->gnutls_state
5433 /* Do we have pending data? */
5434 && ((emacs_gnutls_record_check_pending
5435 (wait_proc
->gnutls_state
))
5439 eassert (0 <= wait_proc
->infd
);
5440 /* Set to Available. */
5441 FD_SET (wait_proc
->infd
, &tls_available
);
5446 Available
= tls_available
;
5453 /* Make C-g and alarm signals set flags again. */
5454 clear_waiting_for_input ();
5456 /* If we woke up due to SIGWINCH, actually change size now. */
5457 do_pending_window_change (0);
5461 /* Exit the main loop if we've passed the requested timeout,
5462 or aren't skipping processes and got some output and
5463 haven't lowered our timeout due to timers or SIGIO and
5464 have waited a long amount of time due to repeated
5466 struct timespec huge_timespec
5467 = make_timespec (TYPE_MAXIMUM (time_t), 2 * TIMESPEC_RESOLUTION
);
5468 struct timespec cmp_time
= huge_timespec
;
5471 if (wait
== TIMEOUT
)
5472 cmp_time
= end_time
;
5473 if (!process_skipped
&& got_some_output
> 0
5474 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0))
5476 if (!timespec_valid_p (got_output_end_time
))
5478 if (timespec_cmp (got_output_end_time
, cmp_time
) < 0)
5479 cmp_time
= got_output_end_time
;
5481 if (timespec_cmp (cmp_time
, huge_timespec
) < 0)
5483 now
= current_timespec ();
5484 if (timespec_cmp (cmp_time
, now
) <= 0)
5491 if (xerrno
== EINTR
)
5493 else if (xerrno
== EBADF
)
5496 report_file_errno ("Failed select", Qnil
, xerrno
);
5499 /* Check for keyboard input. */
5500 /* If there is any, return immediately
5501 to give it higher priority than subprocesses. */
5505 unsigned old_timers_run
= timers_run
;
5506 struct buffer
*old_buffer
= current_buffer
;
5507 Lisp_Object old_window
= selected_window
;
5510 if (detect_input_pending_run_timers (do_display
))
5512 swallow_events (do_display
);
5513 if (detect_input_pending_run_timers (do_display
))
5517 /* If a timer has run, this might have changed buffers
5518 an alike. Make read_key_sequence aware of that. */
5519 if (timers_run
!= old_timers_run
5520 && waiting_for_user_input_p
== -1
5521 && (old_buffer
!= current_buffer
5522 || !EQ (old_window
, selected_window
)))
5523 record_asynch_buffer_change ();
5529 /* If there is unread keyboard input, also return. */
5531 && requeued_events_pending_p ())
5534 /* If we are not checking for keyboard input now,
5535 do process events (but don't run any timers).
5536 This is so that X events will be processed.
5537 Otherwise they may have to wait until polling takes place.
5538 That would causes delays in pasting selections, for example.
5540 (We used to do this only if wait_for_cell.) */
5541 if (read_kbd
== 0 && detect_input_pending ())
5543 swallow_events (do_display
);
5544 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5545 if (detect_input_pending ())
5550 /* Exit now if the cell we're waiting for became non-nil. */
5551 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5555 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5556 go read it. This can happen with X on BSD after logging out.
5557 In that case, there really is no input and no SIGIO,
5558 but select says there is input. */
5560 if (read_kbd
&& interrupt_input
5561 && keyboard_bit_set (&Available
) && ! noninteractive
)
5562 handle_input_available_signal (SIGIO
);
5565 /* If checking input just got us a size-change event from X,
5566 obey it now if we should. */
5567 if (read_kbd
|| ! NILP (wait_for_cell
))
5568 do_pending_window_change (0);
5570 /* Check for data from a process. */
5571 if (no_avail
|| nfds
== 0)
5574 for (channel
= 0; channel
<= max_desc
; ++channel
)
5576 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
5578 && ((d
->flags
& FOR_READ
5579 && FD_ISSET (channel
, &Available
))
5580 || ((d
->flags
& FOR_WRITE
)
5581 && FD_ISSET (channel
, &Writeok
))))
5582 d
->func (channel
, d
->data
);
5585 for (channel
= 0; channel
<= max_desc
; channel
++)
5587 if (FD_ISSET (channel
, &Available
)
5588 && ((fd_callback_info
[channel
].flags
& (KEYBOARD_FD
| PROCESS_FD
))
5593 /* If waiting for this channel, arrange to return as
5594 soon as no more input to be processed. No more
5596 proc
= chan_process
[channel
];
5600 /* If this is a server stream socket, accept connection. */
5601 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
5603 server_accept_connection (proc
, channel
);
5607 /* Read data from the process, starting with our
5608 buffered-ahead character if we have one. */
5610 nread
= read_process_output (proc
, channel
);
5611 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
5612 && got_some_output
< nread
)
5613 got_some_output
= nread
;
5616 /* Vacuum up any leftovers without waiting. */
5617 if (wait_proc
== XPROCESS (proc
))
5619 /* Since read_process_output can run a filter,
5620 which can call accept-process-output,
5621 don't try to read from any other processes
5622 before doing the select again. */
5623 FD_ZERO (&Available
);
5626 redisplay_preserve_echo_area (12);
5628 else if (nread
== -1 && would_block (errno
))
5631 /* On some OSs with ptys, when the process on one end of
5632 a pty exits, the other end gets an error reading with
5633 errno = EIO instead of getting an EOF (0 bytes read).
5634 Therefore, if we get an error reading and errno =
5635 EIO, just continue, because the child process has
5636 exited and should clean itself up soon (e.g. when we
5638 else if (nread
== -1 && errno
== EIO
)
5640 struct Lisp_Process
*p
= XPROCESS (proc
);
5642 /* Clear the descriptor now, so we only raise the
5644 delete_read_fd (channel
);
5648 /* If the EIO occurs on a pty, the SIGCHLD handler's
5649 waitpid call will not find the process object to
5650 delete. Do it here. */
5651 p
->tick
= ++process_tick
;
5652 pset_status (p
, Qfailed
);
5655 #endif /* HAVE_PTYS */
5656 /* If we can detect process termination, don't consider the
5657 process gone just because its pipe is closed. */
5658 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5659 && !PIPECONN_P (proc
))
5661 else if (nread
== 0 && PIPECONN_P (proc
))
5663 /* Preserve status of processes already terminated. */
5664 XPROCESS (proc
)->tick
= ++process_tick
;
5665 deactivate_process (proc
);
5666 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5667 pset_status (XPROCESS (proc
),
5668 list2 (Qexit
, make_number (0)));
5672 /* Preserve status of processes already terminated. */
5673 XPROCESS (proc
)->tick
= ++process_tick
;
5674 deactivate_process (proc
);
5675 if (XPROCESS (proc
)->raw_status_new
)
5676 update_status (XPROCESS (proc
));
5677 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5678 pset_status (XPROCESS (proc
),
5679 list2 (Qexit
, make_number (256)));
5682 if (FD_ISSET (channel
, &Writeok
)
5683 && (fd_callback_info
[channel
].flags
5684 & NON_BLOCKING_CONNECT_FD
) != 0)
5686 struct Lisp_Process
*p
;
5688 delete_write_fd (channel
);
5690 proc
= chan_process
[channel
];
5694 p
= XPROCESS (proc
);
5698 socklen_t xlen
= sizeof (xerrno
);
5699 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5703 /* On MS-Windows, getsockopt clears the error for the
5704 entire process, which may not be the right thing; see
5705 w32.c. Use getpeername instead. */
5707 struct sockaddr pname
;
5708 socklen_t pnamelen
= sizeof (pname
);
5710 /* If connection failed, getpeername will fail. */
5712 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5714 /* Obtain connect failure code through error slippage. */
5717 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5724 Lisp_Object addrinfos
5725 = connecting_status (p
->status
) ? XCDR (p
->status
) : Qnil
;
5726 if (!NILP (addrinfos
))
5727 XSETCDR (p
->status
, XCDR (addrinfos
));
5730 p
->tick
= ++process_tick
;
5731 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
5733 deactivate_process (proc
);
5734 if (!NILP (addrinfos
))
5735 connect_network_socket (proc
, addrinfos
, Qnil
);
5740 /* If we have an incompletely set up TLS connection,
5741 then defer the sentinel signaling until
5743 if (NILP (p
->gnutls_boot_parameters
)
5747 pset_status (p
, Qrun
);
5748 /* Execute the sentinel here. If we had relied on
5749 status_notify to do it later, it will read input
5750 from the process before calling the sentinel. */
5751 exec_sentinel (proc
, build_string ("open\n"));
5754 if (0 <= p
->infd
&& !EQ (p
->filter
, Qt
)
5755 && !EQ (p
->command
, Qt
))
5756 add_process_read_fd (p
->infd
);
5759 } /* End for each file descriptor. */
5760 } /* End while exit conditions not met. */
5762 unbind_to (count
, Qnil
);
5764 /* If calling from keyboard input, do not quit
5765 since we want to return C-g as an input character.
5766 Otherwise, do pending quit if requested. */
5769 /* Prevent input_pending from remaining set if we quit. */
5770 clear_input_pending ();
5774 return got_some_output
;
5777 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5780 read_process_output_call (Lisp_Object fun_and_args
)
5782 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5786 read_process_output_error_handler (Lisp_Object error_val
)
5788 cmd_error_internal (error_val
, "error in process filter: ");
5790 update_echo_area ();
5791 Fsleep_for (make_number (2), Qnil
);
5796 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5798 struct coding_system
*coding
);
5800 /* Read pending output from the process channel,
5801 starting with our buffered-ahead character if we have one.
5802 Yield number of decoded characters read.
5804 This function reads at most 4096 characters.
5805 If you want to read all available subprocess output,
5806 you must call it repeatedly until it returns zero.
5808 The characters read are decoded according to PROC's coding-system
5812 read_process_output (Lisp_Object proc
, int channel
)
5815 struct Lisp_Process
*p
= XPROCESS (proc
);
5816 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5817 int carryover
= p
->decoding_carryover
;
5818 enum { readmax
= 4096 };
5819 ptrdiff_t count
= SPECPDL_INDEX ();
5820 Lisp_Object odeactivate
;
5821 char chars
[sizeof coding
->carryover
+ readmax
];
5824 /* See the comment above. */
5825 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5827 #ifdef DATAGRAM_SOCKETS
5828 /* We have a working select, so proc_buffered_char is always -1. */
5829 if (DATAGRAM_CHAN_P (channel
))
5831 socklen_t len
= datagram_address
[channel
].len
;
5832 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5833 0, datagram_address
[channel
].sa
, &len
);
5838 bool buffered
= proc_buffered_char
[channel
] >= 0;
5841 chars
[carryover
] = proc_buffered_char
[channel
];
5842 proc_buffered_char
[channel
] = -1;
5845 if (p
->gnutls_p
&& p
->gnutls_state
)
5846 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5847 readmax
- buffered
);
5850 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5851 readmax
- buffered
);
5852 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5854 int delay
= p
->read_output_delay
;
5857 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5860 process_output_delay_count
++;
5861 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5864 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5866 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5868 process_output_delay_count
--;
5870 p
->read_output_delay
= delay
;
5873 p
->read_output_skip
= 1;
5874 process_output_skip
= 1;
5878 nbytes
+= buffered
&& nbytes
<= 0;
5881 p
->decoding_carryover
= 0;
5883 /* At this point, NBYTES holds number of bytes just received
5884 (including the one in proc_buffered_char[channel]). */
5887 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5889 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5892 /* Now set NBYTES how many bytes we must decode. */
5893 nbytes
+= carryover
;
5895 odeactivate
= Vdeactivate_mark
;
5896 /* There's no good reason to let process filters change the current
5897 buffer, and many callers of accept-process-output, sit-for, and
5898 friends don't expect current-buffer to be changed from under them. */
5899 record_unwind_current_buffer ();
5901 read_and_dispose_of_process_output (p
, chars
, nbytes
, coding
);
5903 /* Handling the process output should not deactivate the mark. */
5904 Vdeactivate_mark
= odeactivate
;
5906 unbind_to (count
, Qnil
);
5911 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5913 struct coding_system
*coding
)
5915 Lisp_Object outstream
= p
->filter
;
5917 bool outer_running_asynch_code
= running_asynch_code
;
5918 int waiting
= waiting_for_user_input_p
;
5921 Lisp_Object obuffer
, okeymap
;
5922 XSETBUFFER (obuffer
, current_buffer
);
5923 okeymap
= BVAR (current_buffer
, keymap
);
5926 /* We inhibit quit here instead of just catching it so that
5927 hitting ^G when a filter happens to be running won't screw
5929 specbind (Qinhibit_quit
, Qt
);
5930 specbind (Qlast_nonmenu_event
, Qt
);
5932 /* In case we get recursively called,
5933 and we already saved the match data nonrecursively,
5934 save the same match data in safely recursive fashion. */
5935 if (outer_running_asynch_code
)
5938 /* Don't clobber the CURRENT match data, either! */
5939 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5940 restore_search_regs ();
5941 record_unwind_save_match_data ();
5942 Fset_match_data (tem
, Qt
);
5945 /* For speed, if a search happens within this code,
5946 save the match data in a special nonrecursive fashion. */
5947 running_asynch_code
= 1;
5949 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5950 text
= coding
->dst_object
;
5951 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5952 /* A new coding system might be found. */
5953 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5955 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5957 /* Don't call setup_coding_system for
5958 proc_decode_coding_system[channel] here. It is done in
5959 detect_coding called via decode_coding above. */
5961 /* If a coding system for encoding is not yet decided, we set
5962 it as the same as coding-system for decoding.
5964 But, before doing that we must check if
5965 proc_encode_coding_system[p->outfd] surely points to a
5966 valid memory because p->outfd will be changed once EOF is
5967 sent to the process. */
5968 if (NILP (p
->encode_coding_system
) && p
->outfd
>= 0
5969 && proc_encode_coding_system
[p
->outfd
])
5971 pset_encode_coding_system
5972 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5973 setup_coding_system (p
->encode_coding_system
,
5974 proc_encode_coding_system
[p
->outfd
]);
5978 if (coding
->carryover_bytes
> 0)
5980 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5981 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5982 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5983 coding
->carryover_bytes
);
5984 p
->decoding_carryover
= coding
->carryover_bytes
;
5986 if (SBYTES (text
) > 0)
5987 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5988 sometimes it's simply wrong to wrap (e.g. when called from
5989 accept-process-output). */
5990 internal_condition_case_1 (read_process_output_call
,
5991 list3 (outstream
, make_lisp_proc (p
), text
),
5992 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5993 read_process_output_error_handler
);
5995 /* If we saved the match data nonrecursively, restore it now. */
5996 restore_search_regs ();
5997 running_asynch_code
= outer_running_asynch_code
;
5999 /* Restore waiting_for_user_input_p as it was
6000 when we were called, in case the filter clobbered it. */
6001 waiting_for_user_input_p
= waiting
;
6003 #if 0 /* Call record_asynch_buffer_change unconditionally,
6004 because we might have changed minor modes or other things
6005 that affect key bindings. */
6006 if (! EQ (Fcurrent_buffer (), obuffer
)
6007 || ! EQ (current_buffer
->keymap
, okeymap
))
6009 /* But do it only if the caller is actually going to read events.
6010 Otherwise there's no need to make him wake up, and it could
6011 cause trouble (for example it would make sit_for return). */
6012 if (waiting_for_user_input_p
== -1)
6013 record_asynch_buffer_change ();
6016 DEFUN ("internal-default-process-filter", Finternal_default_process_filter
,
6017 Sinternal_default_process_filter
, 2, 2, 0,
6018 doc
: /* Function used as default process filter.
6019 This inserts the process's output into its buffer, if there is one.
6020 Otherwise it discards the output. */)
6021 (Lisp_Object proc
, Lisp_Object text
)
6023 struct Lisp_Process
*p
;
6026 CHECK_PROCESS (proc
);
6027 p
= XPROCESS (proc
);
6028 CHECK_STRING (text
);
6030 if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
6032 Lisp_Object old_read_only
;
6033 ptrdiff_t old_begv
, old_zv
;
6034 ptrdiff_t old_begv_byte
, old_zv_byte
;
6035 ptrdiff_t before
, before_byte
;
6036 ptrdiff_t opoint_byte
;
6039 Fset_buffer (p
->buffer
);
6041 opoint_byte
= PT_BYTE
;
6042 old_read_only
= BVAR (current_buffer
, read_only
);
6045 old_begv_byte
= BEGV_BYTE
;
6046 old_zv_byte
= ZV_BYTE
;
6048 bset_read_only (current_buffer
, Qnil
);
6050 /* Insert new output into buffer at the current end-of-output
6051 marker, thus preserving logical ordering of input and output. */
6052 if (XMARKER (p
->mark
)->buffer
)
6053 set_point_from_marker (p
->mark
);
6055 SET_PT_BOTH (ZV
, ZV_BYTE
);
6057 before_byte
= PT_BYTE
;
6059 /* If the output marker is outside of the visible region, save
6060 the restriction and widen. */
6061 if (! (BEGV
<= PT
&& PT
<= ZV
))
6064 /* Adjust the multibyteness of TEXT to that of the buffer. */
6065 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
6066 != ! STRING_MULTIBYTE (text
))
6067 text
= (STRING_MULTIBYTE (text
)
6068 ? Fstring_as_unibyte (text
)
6069 : Fstring_to_multibyte (text
));
6070 /* Insert before markers in case we are inserting where
6071 the buffer's mark is, and the user's next command is Meta-y. */
6072 insert_from_string_before_markers (text
, 0, 0,
6073 SCHARS (text
), SBYTES (text
), 0);
6075 /* Make sure the process marker's position is valid when the
6076 process buffer is changed in the signal_after_change above.
6077 W3 is known to do that. */
6078 if (BUFFERP (p
->buffer
)
6079 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
6080 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
6082 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
6084 update_mode_lines
= 23;
6086 /* Make sure opoint and the old restrictions
6087 float ahead of any new text just as point would. */
6088 if (opoint
>= before
)
6090 opoint
+= PT
- before
;
6091 opoint_byte
+= PT_BYTE
- before_byte
;
6093 if (old_begv
> before
)
6095 old_begv
+= PT
- before
;
6096 old_begv_byte
+= PT_BYTE
- before_byte
;
6098 if (old_zv
>= before
)
6100 old_zv
+= PT
- before
;
6101 old_zv_byte
+= PT_BYTE
- before_byte
;
6104 /* If the restriction isn't what it should be, set it. */
6105 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
6106 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
6108 bset_read_only (current_buffer
, old_read_only
);
6109 SET_PT_BOTH (opoint
, opoint_byte
);
6114 /* Sending data to subprocess. */
6116 /* In send_process, when a write fails temporarily,
6117 wait_reading_process_output is called. It may execute user code,
6118 e.g. timers, that attempts to write new data to the same process.
6119 We must ensure that data is sent in the right order, and not
6120 interspersed half-completed with other writes (Bug#10815). This is
6121 handled by the write_queue element of struct process. It is a list
6122 with each entry having the form
6124 (string . (offset . length))
6126 where STRING is a lisp string, OFFSET is the offset into the
6127 string's byte sequence from which we should begin to send, and
6128 LENGTH is the number of bytes left to send. */
6130 /* Create a new entry in write_queue.
6131 INPUT_OBJ should be a buffer, string Qt, or Qnil.
6132 BUF is a pointer to the string sequence of the input_obj or a C
6133 string in case of Qt or Qnil. */
6136 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
6137 const char *buf
, ptrdiff_t len
, bool front
)
6140 Lisp_Object entry
, obj
;
6142 if (STRINGP (input_obj
))
6144 offset
= buf
- SSDATA (input_obj
);
6150 obj
= make_unibyte_string (buf
, len
);
6153 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
6156 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
6158 pset_write_queue (p
, nconc2 (p
->write_queue
, list1 (entry
)));
6161 /* Remove the first element in the write_queue of process P, put its
6162 contents in OBJ, BUF and LEN, and return true. If the
6163 write_queue is empty, return false. */
6166 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
6167 const char **buf
, ptrdiff_t *len
)
6169 Lisp_Object entry
, offset_length
;
6172 if (NILP (p
->write_queue
))
6175 entry
= XCAR (p
->write_queue
);
6176 pset_write_queue (p
, XCDR (p
->write_queue
));
6178 *obj
= XCAR (entry
);
6179 offset_length
= XCDR (entry
);
6181 *len
= XINT (XCDR (offset_length
));
6182 offset
= XINT (XCAR (offset_length
));
6183 *buf
= SSDATA (*obj
) + offset
;
6188 /* Send some data to process PROC.
6189 BUF is the beginning of the data; LEN is the number of characters.
6190 OBJECT is the Lisp object that the data comes from. If OBJECT is
6191 nil or t, it means that the data comes from C string.
6193 If OBJECT is not nil, the data is encoded by PROC's coding-system
6194 for encoding before it is sent.
6196 This function can evaluate Lisp code and can garbage collect. */
6199 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
6202 struct Lisp_Process
*p
= XPROCESS (proc
);
6204 struct coding_system
*coding
;
6206 if (NETCONN_P (proc
))
6208 wait_while_connecting (proc
);
6209 wait_for_tls_negotiation (proc
);
6212 if (p
->raw_status_new
)
6214 if (! EQ (p
->status
, Qrun
))
6215 error ("Process %s not running", SDATA (p
->name
));
6217 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
6219 coding
= proc_encode_coding_system
[p
->outfd
];
6220 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
6222 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
6223 || (BUFFERP (object
)
6224 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
6227 pset_encode_coding_system
6228 (p
, complement_process_encoding_system (p
->encode_coding_system
));
6229 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
6231 /* The coding system for encoding was changed to raw-text
6232 because we sent a unibyte text previously. Now we are
6233 sending a multibyte text, thus we must encode it by the
6234 original coding system specified for the current process.
6236 Another reason we come here is that the coding system
6237 was just complemented and a new one was returned by
6238 complement_process_encoding_system. */
6239 setup_coding_system (p
->encode_coding_system
, coding
);
6240 Vlast_coding_system_used
= p
->encode_coding_system
;
6242 coding
->src_multibyte
= 1;
6246 coding
->src_multibyte
= 0;
6247 /* For sending a unibyte text, character code conversion should
6248 not take place but EOL conversion should. So, setup raw-text
6249 or one of the subsidiary if we have not yet done it. */
6250 if (CODING_REQUIRE_ENCODING (coding
))
6252 if (CODING_REQUIRE_FLUSHING (coding
))
6254 /* But, before changing the coding, we must flush out data. */
6255 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6256 send_process (proc
, "", 0, Qt
);
6257 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
6259 setup_coding_system (raw_text_coding_system
6260 (Vlast_coding_system_used
),
6262 coding
->src_multibyte
= 0;
6265 coding
->dst_multibyte
= 0;
6267 if (CODING_REQUIRE_ENCODING (coding
))
6269 coding
->dst_object
= Qt
;
6270 if (BUFFERP (object
))
6272 ptrdiff_t from_byte
, from
, to
;
6273 ptrdiff_t save_pt
, save_pt_byte
;
6274 struct buffer
*cur
= current_buffer
;
6276 set_buffer_internal (XBUFFER (object
));
6277 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
6279 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
6280 from
= BYTE_TO_CHAR (from_byte
);
6281 to
= BYTE_TO_CHAR (from_byte
+ len
);
6282 TEMP_SET_PT_BOTH (from
, from_byte
);
6283 encode_coding_object (coding
, object
, from
, from_byte
,
6284 to
, from_byte
+ len
, Qt
);
6285 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
6286 set_buffer_internal (cur
);
6288 else if (STRINGP (object
))
6290 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
6291 SBYTES (object
), Qt
);
6295 coding
->dst_object
= make_unibyte_string (buf
, len
);
6296 coding
->produced
= len
;
6299 len
= coding
->produced
;
6300 object
= coding
->dst_object
;
6301 buf
= SSDATA (object
);
6304 /* If there is already data in the write_queue, put the new data
6305 in the back of queue. Otherwise, ignore it. */
6306 if (!NILP (p
->write_queue
))
6307 write_queue_push (p
, object
, buf
, len
, 0);
6309 do /* while !NILP (p->write_queue) */
6311 ptrdiff_t cur_len
= -1;
6312 const char *cur_buf
;
6313 Lisp_Object cur_object
;
6315 /* If write_queue is empty, ignore it. */
6316 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
6320 cur_object
= object
;
6325 /* Send this batch, using one or more write calls. */
6326 ptrdiff_t written
= 0;
6327 int outfd
= p
->outfd
;
6328 #ifdef DATAGRAM_SOCKETS
6329 if (DATAGRAM_CHAN_P (outfd
))
6331 rv
= sendto (outfd
, cur_buf
, cur_len
,
6332 0, datagram_address
[outfd
].sa
,
6333 datagram_address
[outfd
].len
);
6336 else if (errno
== EMSGSIZE
)
6337 report_file_error ("Sending datagram", proc
);
6343 if (p
->gnutls_p
&& p
->gnutls_state
)
6344 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
6347 written
= emacs_write_sig (outfd
, cur_buf
, cur_len
);
6348 rv
= (written
? 0 : -1);
6349 if (p
->read_output_delay
> 0
6350 && p
->adaptive_read_buffering
== 1)
6352 p
->read_output_delay
= 0;
6353 process_output_delay_count
--;
6354 p
->read_output_skip
= 0;
6360 if (would_block (errno
))
6361 /* Buffer is full. Wait, accepting input;
6362 that may allow the program
6363 to finish doing output and read more. */
6365 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6366 /* A gross hack to work around a bug in FreeBSD.
6367 In the following sequence, read(2) returns
6371 write(2) 954 bytes, get EAGAIN
6372 read(2) 1024 bytes in process_read_output
6373 read(2) 11 bytes in process_read_output
6375 That is, read(2) returns more bytes than have
6376 ever been written successfully. The 1033 bytes
6377 read are the 1022 bytes written successfully
6378 after processing (for example with CRs added if
6379 the terminal is set up that way which it is
6380 here). The same bytes will be seen again in a
6381 later read(2), without the CRs. */
6383 if (errno
== EAGAIN
)
6386 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
6388 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6390 /* Put what we should have written in wait_queue. */
6391 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
6392 wait_reading_process_output (0, 20 * 1000 * 1000,
6393 0, 0, Qnil
, NULL
, 0);
6394 /* Reread queue, to see what is left. */
6397 else if (errno
== EPIPE
)
6399 p
->raw_status_new
= 0;
6400 pset_status (p
, list2 (Qexit
, make_number (256)));
6401 p
->tick
= ++process_tick
;
6402 deactivate_process (proc
);
6403 error ("process %s no longer connected to pipe; closed it",
6407 /* This is a real error. */
6408 report_file_error ("Writing to process", proc
);
6414 while (!NILP (p
->write_queue
));
6417 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
6419 doc
: /* Send current contents of region as input to PROCESS.
6420 PROCESS may be a process, a buffer, the name of a process or buffer, or
6421 nil, indicating the current buffer's process.
6422 Called from program, takes three arguments, PROCESS, START and END.
6423 If the region is more than 500 characters long,
6424 it is sent in several bunches. This may happen even for shorter regions.
6425 Output from processes can arrive in between bunches.
6427 If PROCESS is a non-blocking network process that hasn't been fully
6428 set up yet, this function will block until socket setup has completed. */)
6429 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
6431 Lisp_Object proc
= get_process (process
);
6432 ptrdiff_t start_byte
, end_byte
;
6434 validate_region (&start
, &end
);
6436 start_byte
= CHAR_TO_BYTE (XINT (start
));
6437 end_byte
= CHAR_TO_BYTE (XINT (end
));
6439 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
6440 move_gap_both (XINT (start
), start_byte
);
6442 if (NETCONN_P (proc
))
6443 wait_while_connecting (proc
);
6445 send_process (proc
, (char *) BYTE_POS_ADDR (start_byte
),
6446 end_byte
- start_byte
, Fcurrent_buffer ());
6451 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
6453 doc
: /* Send PROCESS the contents of STRING as input.
6454 PROCESS may be a process, a buffer, the name of a process or buffer, or
6455 nil, indicating the current buffer's process.
6456 If STRING is more than 500 characters long,
6457 it is sent in several bunches. This may happen even for shorter strings.
6458 Output from processes can arrive in between bunches.
6460 If PROCESS is a non-blocking network process that hasn't been fully
6461 set up yet, this function will block until socket setup has completed. */)
6462 (Lisp_Object process
, Lisp_Object string
)
6464 CHECK_STRING (string
);
6465 Lisp_Object proc
= get_process (process
);
6466 send_process (proc
, SSDATA (string
),
6467 SBYTES (string
), string
);
6471 /* Return the foreground process group for the tty/pty that
6472 the process P uses. */
6474 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
6479 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
6482 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6483 master side. Try the slave side. */
6484 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
6488 ioctl (fd
, TIOCGPGRP
, &gid
);
6492 #endif /* defined (TIOCGPGRP ) */
6497 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
6498 Sprocess_running_child_p
, 0, 1, 0,
6499 doc
: /* Return non-nil if PROCESS has given the terminal to a
6500 child. If the operating system does not make it possible to find out,
6501 return t. If we can find out, return the numeric ID of the foreground
6503 (Lisp_Object process
)
6505 /* Initialize in case ioctl doesn't exist or gives an error,
6506 in a way that will cause returning t. */
6507 Lisp_Object proc
= get_process (process
);
6508 struct Lisp_Process
*p
= XPROCESS (proc
);
6510 if (!EQ (p
->type
, Qreal
))
6511 error ("Process %s is not a subprocess",
6514 error ("Process %s is not active",
6517 pid_t gid
= emacs_get_tty_pgrp (p
);
6522 return make_number (gid
);
6526 /* Send a signal number SIGNO to PROCESS.
6527 If CURRENT_GROUP is t, that means send to the process group
6528 that currently owns the terminal being used to communicate with PROCESS.
6529 This is used for various commands in shell mode.
6530 If CURRENT_GROUP is lambda, that means send to the process group
6531 that currently owns the terminal, but only if it is NOT the shell itself.
6533 If NOMSG is false, insert signal-announcements into process's buffers
6536 If we can, we try to signal PROCESS by sending control characters
6537 down the pty. This allows us to signal inferiors who have changed
6538 their uid, for which kill would return an EPERM error. */
6541 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
6545 struct Lisp_Process
*p
;
6549 proc
= get_process (process
);
6550 p
= XPROCESS (proc
);
6552 if (!EQ (p
->type
, Qreal
))
6553 error ("Process %s is not a subprocess",
6556 error ("Process %s is not active",
6560 current_group
= Qnil
;
6562 /* If we are using pgrps, get a pgrp number and make it negative. */
6563 if (NILP (current_group
))
6564 /* Send the signal to the shell's process group. */
6568 #ifdef SIGNALS_VIA_CHARACTERS
6569 /* If possible, send signals to the entire pgrp
6570 by sending an input character to it. */
6573 cc_t
*sig_char
= NULL
;
6575 tcgetattr (p
->infd
, &t
);
6580 sig_char
= &t
.c_cc
[VINTR
];
6584 sig_char
= &t
.c_cc
[VQUIT
];
6589 sig_char
= &t
.c_cc
[VSWTCH
];
6591 sig_char
= &t
.c_cc
[VSUSP
];
6596 if (sig_char
&& *sig_char
!= CDISABLE
)
6598 send_process (proc
, (char *) sig_char
, 1, Qnil
);
6601 /* If we can't send the signal with a character,
6602 fall through and send it another way. */
6604 /* The code above may fall through if it can't
6605 handle the signal. */
6606 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6609 /* Get the current pgrp using the tty itself, if we have that.
6610 Otherwise, use the pty to get the pgrp.
6611 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6612 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6613 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6614 His patch indicates that if TIOCGPGRP returns an error, then
6615 we should just assume that p->pid is also the process group id. */
6617 gid
= emacs_get_tty_pgrp (p
);
6620 /* If we can't get the information, assume
6621 the shell owns the tty. */
6624 /* It is not clear whether anything really can set GID to -1.
6625 Perhaps on some system one of those ioctls can or could do so.
6626 Or perhaps this is vestigial. */
6629 #else /* ! defined (TIOCGPGRP) */
6630 /* Can't select pgrps on this system, so we know that
6631 the child itself heads the pgrp. */
6633 #endif /* ! defined (TIOCGPGRP) */
6635 /* If current_group is lambda, and the shell owns the terminal,
6636 don't send any signal. */
6637 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6642 if (signo
== SIGCONT
)
6644 p
->raw_status_new
= 0;
6645 pset_status (p
, Qrun
);
6646 p
->tick
= ++process_tick
;
6649 status_notify (NULL
, NULL
);
6650 redisplay_preserve_echo_area (13);
6656 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6657 We don't know whether the bug is fixed in later HP-UX versions. */
6658 if (! NILP (current_group
) && ioctl (p
->infd
, TIOCSIGSEND
, signo
) != -1)
6662 /* If we don't have process groups, send the signal to the immediate
6663 subprocess. That isn't really right, but it's better than any
6664 obvious alternative. */
6665 pid_t pid
= no_pgrp
? gid
: - gid
;
6667 /* Do not kill an already-reaped process, as that could kill an
6668 innocent bystander that happens to have the same process ID. */
6670 block_child_signal (&oldset
);
6673 unblock_child_signal (&oldset
);
6676 DEFUN ("internal-default-interrupt-process",
6677 Finternal_default_interrupt_process
,
6678 Sinternal_default_interrupt_process
, 0, 2, 0,
6679 doc
: /* Default function to interrupt process PROCESS.
6680 It shall be the last element in list `interrupt-process-functions'.
6681 See function `interrupt-process' for more details on usage. */)
6682 (Lisp_Object process
, Lisp_Object current_group
)
6684 process_send_signal (process
, SIGINT
, current_group
, 0);
6688 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6689 doc
: /* Interrupt process PROCESS.
6690 PROCESS may be a process, a buffer, or the name of a process or buffer.
6691 No arg or nil means current buffer's process.
6692 Second arg CURRENT-GROUP non-nil means send signal to
6693 the current process-group of the process's controlling terminal
6694 rather than to the process's own process group.
6695 If the process is a shell, this means interrupt current subjob
6696 rather than the shell.
6698 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6699 don't send the signal.
6701 This function calls the functions of `interrupt-process-functions' in
6702 the order of the list, until one of them returns non-`nil'. */)
6703 (Lisp_Object process
, Lisp_Object current_group
)
6705 return CALLN (Frun_hook_with_args_until_success
, Qinterrupt_process_functions
,
6706 process
, current_group
);
6709 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6710 doc
: /* Kill process PROCESS. May be process or name of one.
6711 See function `interrupt-process' for more details on usage. */)
6712 (Lisp_Object process
, Lisp_Object current_group
)
6714 process_send_signal (process
, SIGKILL
, current_group
, 0);
6718 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6719 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6720 See function `interrupt-process' for more details on usage. */)
6721 (Lisp_Object process
, Lisp_Object current_group
)
6723 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6727 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6728 doc
: /* Stop process PROCESS. May be process or name of one.
6729 See function `interrupt-process' for more details on usage.
6730 If PROCESS is a network or serial or pipe connection, inhibit handling
6731 of incoming traffic. */)
6732 (Lisp_Object process
, Lisp_Object current_group
)
6734 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6735 || PIPECONN_P (process
)))
6737 struct Lisp_Process
*p
;
6739 p
= XPROCESS (process
);
6740 if (NILP (p
->command
)
6742 delete_read_fd (p
->infd
);
6743 pset_command (p
, Qt
);
6747 error ("No SIGTSTP support");
6749 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6754 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6755 doc
: /* Continue process PROCESS. May be process or name of one.
6756 See function `interrupt-process' for more details on usage.
6757 If PROCESS is a network or serial process, resume handling of incoming
6759 (Lisp_Object process
, Lisp_Object current_group
)
6761 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6762 || PIPECONN_P (process
)))
6764 struct Lisp_Process
*p
;
6766 p
= XPROCESS (process
);
6767 if (EQ (p
->command
, Qt
)
6769 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6771 add_process_read_fd (p
->infd
);
6773 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6774 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6775 #else /* not WINDOWSNT */
6776 tcflush (p
->infd
, TCIFLUSH
);
6777 #endif /* not WINDOWSNT */
6779 pset_command (p
, Qnil
);
6783 process_send_signal (process
, SIGCONT
, current_group
, 0);
6785 error ("No SIGCONT support");
6790 /* Return the integer value of the signal whose abbreviation is ABBR,
6791 or a negative number if there is no such signal. */
6793 abbr_to_signal (char const *name
)
6796 char sigbuf
[20]; /* Large enough for all valid signal abbreviations. */
6798 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6801 for (i
= 0; i
< sizeof sigbuf
; i
++)
6803 sigbuf
[i
] = c_toupper (name
[i
]);
6805 return str2sig (sigbuf
, &signo
) == 0 ? signo
: -1;
6811 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6812 2, 2, "sProcess (name or number): \nnSignal code: ",
6813 doc
: /* Send PROCESS the signal with code SIGCODE.
6814 PROCESS may also be a number specifying the process id of the
6815 process to signal; in this case, the process need not be a child of
6817 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6818 (Lisp_Object process
, Lisp_Object sigcode
)
6823 if (STRINGP (process
))
6825 Lisp_Object tem
= Fget_process (process
);
6828 Lisp_Object process_number
6829 = string_to_number (SSDATA (process
), 10, 1);
6830 if (NUMBERP (process_number
))
6831 tem
= process_number
;
6835 else if (!NUMBERP (process
))
6836 process
= get_process (process
);
6841 if (NUMBERP (process
))
6842 CONS_TO_INTEGER (process
, pid_t
, pid
);
6845 CHECK_PROCESS (process
);
6846 pid
= XPROCESS (process
)->pid
;
6848 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6851 if (INTEGERP (sigcode
))
6853 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6854 signo
= XINT (sigcode
);
6860 CHECK_SYMBOL (sigcode
);
6861 name
= SSDATA (SYMBOL_NAME (sigcode
));
6863 signo
= abbr_to_signal (name
);
6865 error ("Undefined signal name %s", name
);
6868 return make_number (kill (pid
, signo
));
6871 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6872 doc
: /* Make PROCESS see end-of-file in its input.
6873 EOF comes after any text already sent to it.
6874 PROCESS may be a process, a buffer, the name of a process or buffer, or
6875 nil, indicating the current buffer's process.
6876 If PROCESS is a network connection, or is a process communicating
6877 through a pipe (as opposed to a pty), then you cannot send any more
6878 text to PROCESS after you call this function.
6879 If PROCESS is a serial process, wait until all output written to the
6880 process has been transmitted to the serial port. */)
6881 (Lisp_Object process
)
6884 struct coding_system
*coding
= NULL
;
6887 proc
= get_process (process
);
6889 if (NETCONN_P (proc
))
6890 wait_while_connecting (proc
);
6892 if (DATAGRAM_CONN_P (proc
))
6896 outfd
= XPROCESS (proc
)->outfd
;
6898 coding
= proc_encode_coding_system
[outfd
];
6900 /* Make sure the process is really alive. */
6901 if (XPROCESS (proc
)->raw_status_new
)
6902 update_status (XPROCESS (proc
));
6903 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6904 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6906 if (coding
&& CODING_REQUIRE_FLUSHING (coding
))
6908 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6909 send_process (proc
, "", 0, Qnil
);
6912 if (XPROCESS (proc
)->pty_flag
)
6913 send_process (proc
, "\004", 1, Qnil
);
6914 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6917 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6918 report_file_error ("Failed tcdrain", Qnil
);
6919 #endif /* not WINDOWSNT */
6920 /* Do nothing on Windows because writes are blocking. */
6924 struct Lisp_Process
*p
= XPROCESS (proc
);
6925 int old_outfd
= p
->outfd
;
6928 #ifdef HAVE_SHUTDOWN
6929 /* If this is a network connection, or socketpair is used
6930 for communication with the subprocess, call shutdown to cause EOF.
6931 (In some old system, shutdown to socketpair doesn't work.
6932 Then we just can't win.) */
6934 && (EQ (p
->type
, Qnetwork
) || p
->infd
== old_outfd
))
6935 shutdown (old_outfd
, 1);
6937 close_process_fd (&p
->open_fd
[WRITE_TO_SUBPROCESS
]);
6938 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6940 report_file_error ("Opening null device", Qnil
);
6941 p
->open_fd
[WRITE_TO_SUBPROCESS
] = new_outfd
;
6942 p
->outfd
= new_outfd
;
6944 if (!proc_encode_coding_system
[new_outfd
])
6945 proc_encode_coding_system
[new_outfd
]
6946 = xmalloc (sizeof (struct coding_system
));
6949 *proc_encode_coding_system
[new_outfd
]
6950 = *proc_encode_coding_system
[old_outfd
];
6951 memset (proc_encode_coding_system
[old_outfd
], 0,
6952 sizeof (struct coding_system
));
6955 setup_coding_system (p
->encode_coding_system
,
6956 proc_encode_coding_system
[new_outfd
]);
6961 /* The main Emacs thread records child processes in three places:
6963 - Vprocess_alist, for asynchronous subprocesses, which are child
6964 processes visible to Lisp.
6966 - deleted_pid_list, for child processes invisible to Lisp,
6967 typically because of delete-process. These are recorded so that
6968 the processes can be reaped when they exit, so that the operating
6969 system's process table is not cluttered by zombies.
6971 - the local variable PID in Fcall_process, call_process_cleanup and
6972 call_process_kill, for synchronous subprocesses.
6973 record_unwind_protect is used to make sure this process is not
6974 forgotten: if the user interrupts call-process and the child
6975 process refuses to exit immediately even with two C-g's,
6976 call_process_kill adds PID's contents to deleted_pid_list before
6979 The main Emacs thread invokes waitpid only on child processes that
6980 it creates and that have not been reaped. This avoid races on
6981 platforms such as GTK, where other threads create their own
6982 subprocesses which the main thread should not reap. For example,
6983 if the main thread attempted to reap an already-reaped child, it
6984 might inadvertently reap a GTK-created process that happened to
6985 have the same process ID. */
6987 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6988 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6989 keep track of its own children. GNUstep is similar. */
6991 static void dummy_handler (int sig
) {}
6992 static signal_handler_t
volatile lib_child_handler
;
6994 /* Handle a SIGCHLD signal by looking for known child processes of
6995 Emacs whose status have changed. For each one found, record its
6998 All we do is change the status; we do not run sentinels or print
6999 notifications. That is saved for the next time keyboard input is
7000 done, in order to avoid timing errors.
7002 ** WARNING: this can be called during garbage collection.
7003 Therefore, it must not be fooled by the presence of mark bits in
7006 ** USG WARNING: Although it is not obvious from the documentation
7007 in signal(2), on a USG system the SIGCLD handler MUST NOT call
7008 signal() before executing at least one wait(), otherwise the
7009 handler will be called again, resulting in an infinite loop. The
7010 relevant portion of the documentation reads "SIGCLD signals will be
7011 queued and the signal-catching function will be continually
7012 reentered until the queue is empty". Invoking signal() causes the
7013 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
7016 ** Malloc WARNING: This should never call malloc either directly or
7017 indirectly; if it does, that is a bug. */
7020 handle_child_signal (int sig
)
7022 Lisp_Object tail
, proc
;
7024 /* Find the process that signaled us, and record its status. */
7026 /* The process can have been deleted by Fdelete_process, or have
7027 been started asynchronously by Fcall_process. */
7028 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
7030 bool all_pids_are_fixnums
7031 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
7032 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
7033 Lisp_Object head
= XCAR (tail
);
7038 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
7041 if (INTEGERP (xpid
))
7042 deleted_pid
= XINT (xpid
);
7044 deleted_pid
= XFLOAT_DATA (xpid
);
7045 if (child_status_changed (deleted_pid
, 0, 0))
7047 if (STRINGP (XCDR (head
)))
7048 unlink (SSDATA (XCDR (head
)));
7049 XSETCAR (tail
, Qnil
);
7054 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
7055 FOR_EACH_PROCESS (tail
, proc
)
7057 struct Lisp_Process
*p
= XPROCESS (proc
);
7061 && child_status_changed (p
->pid
, &status
, WUNTRACED
| WCONTINUED
))
7063 /* Change the status of the process that was found. */
7064 p
->tick
= ++process_tick
;
7065 p
->raw_status
= status
;
7066 p
->raw_status_new
= 1;
7068 /* If process has terminated, stop waiting for its output. */
7069 if (WIFSIGNALED (status
) || WIFEXITED (status
))
7071 bool clear_desc_flag
= 0;
7074 clear_desc_flag
= 1;
7076 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
7077 if (clear_desc_flag
)
7078 delete_read_fd (p
->infd
);
7083 lib_child_handler (sig
);
7084 #ifdef NS_IMPL_GNUSTEP
7085 /* NSTask in GNUstep sets its child handler each time it is called.
7086 So we must re-set ours. */
7087 catch_child_signal ();
7092 deliver_child_signal (int sig
)
7094 deliver_process_signal (sig
, handle_child_signal
);
7099 exec_sentinel_error_handler (Lisp_Object error_val
)
7101 /* Make sure error_val is a cons cell, as all the rest of error
7102 handling expects that, and will barf otherwise. */
7103 if (!CONSP (error_val
))
7104 error_val
= Fcons (Qerror
, error_val
);
7105 cmd_error_internal (error_val
, "error in process sentinel: ");
7107 update_echo_area ();
7108 Fsleep_for (make_number (2), Qnil
);
7113 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
7115 Lisp_Object sentinel
, odeactivate
;
7116 struct Lisp_Process
*p
= XPROCESS (proc
);
7117 ptrdiff_t count
= SPECPDL_INDEX ();
7118 bool outer_running_asynch_code
= running_asynch_code
;
7119 int waiting
= waiting_for_user_input_p
;
7121 if (inhibit_sentinels
)
7124 odeactivate
= Vdeactivate_mark
;
7126 Lisp_Object obuffer
, okeymap
;
7127 XSETBUFFER (obuffer
, current_buffer
);
7128 okeymap
= BVAR (current_buffer
, keymap
);
7131 /* There's no good reason to let sentinels change the current
7132 buffer, and many callers of accept-process-output, sit-for, and
7133 friends don't expect current-buffer to be changed from under them. */
7134 record_unwind_current_buffer ();
7136 sentinel
= p
->sentinel
;
7138 /* Inhibit quit so that random quits don't screw up a running filter. */
7139 specbind (Qinhibit_quit
, Qt
);
7140 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
7142 /* In case we get recursively called,
7143 and we already saved the match data nonrecursively,
7144 save the same match data in safely recursive fashion. */
7145 if (outer_running_asynch_code
)
7148 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
7149 restore_search_regs ();
7150 record_unwind_save_match_data ();
7151 Fset_match_data (tem
, Qt
);
7154 /* For speed, if a search happens within this code,
7155 save the match data in a special nonrecursive fashion. */
7156 running_asynch_code
= 1;
7158 internal_condition_case_1 (read_process_output_call
,
7159 list3 (sentinel
, proc
, reason
),
7160 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
7161 exec_sentinel_error_handler
);
7163 /* If we saved the match data nonrecursively, restore it now. */
7164 restore_search_regs ();
7165 running_asynch_code
= outer_running_asynch_code
;
7167 Vdeactivate_mark
= odeactivate
;
7169 /* Restore waiting_for_user_input_p as it was
7170 when we were called, in case the filter clobbered it. */
7171 waiting_for_user_input_p
= waiting
;
7174 if (! EQ (Fcurrent_buffer (), obuffer
)
7175 || ! EQ (current_buffer
->keymap
, okeymap
))
7177 /* But do it only if the caller is actually going to read events.
7178 Otherwise there's no need to make him wake up, and it could
7179 cause trouble (for example it would make sit_for return). */
7180 if (waiting_for_user_input_p
== -1)
7181 record_asynch_buffer_change ();
7183 unbind_to (count
, Qnil
);
7186 /* Report all recent events of a change in process status
7187 (either run the sentinel or output a message).
7188 This is usually done while Emacs is waiting for keyboard input
7189 but can be done at other times.
7191 Return positive if any input was received from WAIT_PROC (or from
7192 any process if WAIT_PROC is null), zero if input was attempted but
7193 none received, and negative if we didn't even try. */
7196 status_notify (struct Lisp_Process
*deleting_process
,
7197 struct Lisp_Process
*wait_proc
)
7200 Lisp_Object tail
, msg
;
7201 int got_some_output
= -1;
7206 /* Set this now, so that if new processes are created by sentinels
7207 that we run, we get called again to handle their status changes. */
7208 update_tick
= process_tick
;
7210 FOR_EACH_PROCESS (tail
, proc
)
7213 register struct Lisp_Process
*p
= XPROCESS (proc
);
7215 if (p
->tick
!= p
->update_tick
)
7217 p
->update_tick
= p
->tick
;
7219 /* If process is still active, read any output that remains. */
7220 while (! EQ (p
->filter
, Qt
)
7221 && ! connecting_status (p
->status
)
7222 && ! EQ (p
->status
, Qlisten
)
7223 /* Network or serial process not stopped: */
7224 && ! EQ (p
->command
, Qt
)
7226 && p
!= deleting_process
)
7228 int nread
= read_process_output (proc
, p
->infd
);
7229 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
7230 && got_some_output
< nread
)
7231 got_some_output
= nread
;
7236 /* Get the text to use for the message. */
7237 if (p
->raw_status_new
)
7239 msg
= status_message (p
);
7241 /* If process is terminated, deactivate it or delete it. */
7243 if (CONSP (p
->status
))
7244 symbol
= XCAR (p
->status
);
7246 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
7247 || EQ (symbol
, Qclosed
))
7249 if (delete_exited_processes
)
7250 remove_process (proc
);
7252 deactivate_process (proc
);
7255 /* The actions above may have further incremented p->tick.
7256 So set p->update_tick again so that an error in the sentinel will
7257 not cause this code to be run again. */
7258 p
->update_tick
= p
->tick
;
7259 /* Now output the message suitably. */
7260 exec_sentinel (proc
, msg
);
7261 if (BUFFERP (p
->buffer
))
7262 /* In case it uses %s in mode-line-format. */
7263 bset_update_mode_line (XBUFFER (p
->buffer
));
7267 return got_some_output
;
7270 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel
,
7271 Sinternal_default_process_sentinel
, 2, 2, 0,
7272 doc
: /* Function used as default sentinel for processes.
7273 This inserts a status message into the process's buffer, if there is one. */)
7274 (Lisp_Object proc
, Lisp_Object msg
)
7276 Lisp_Object buffer
, symbol
;
7277 struct Lisp_Process
*p
;
7278 CHECK_PROCESS (proc
);
7279 p
= XPROCESS (proc
);
7283 symbol
= XCAR (symbol
);
7285 if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
7288 struct buffer
*old
= current_buffer
;
7289 ptrdiff_t opoint
, opoint_byte
;
7290 ptrdiff_t before
, before_byte
;
7292 /* Avoid error if buffer is deleted
7293 (probably that's why the process is dead, too). */
7294 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
7296 Fset_buffer (buffer
);
7298 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
7299 msg
= (code_convert_string_norecord
7300 (msg
, Vlocale_coding_system
, 1));
7303 opoint_byte
= PT_BYTE
;
7304 /* Insert new output into buffer
7305 at the current end-of-output marker,
7306 thus preserving logical ordering of input and output. */
7307 if (XMARKER (p
->mark
)->buffer
)
7308 Fgoto_char (p
->mark
);
7310 SET_PT_BOTH (ZV
, ZV_BYTE
);
7313 before_byte
= PT_BYTE
;
7315 tem
= BVAR (current_buffer
, read_only
);
7316 bset_read_only (current_buffer
, Qnil
);
7317 insert_string ("\nProcess ");
7318 { /* FIXME: temporary kludge. */
7319 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
7320 insert_string (" ");
7322 bset_read_only (current_buffer
, tem
);
7323 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
7325 if (opoint
>= before
)
7326 SET_PT_BOTH (opoint
+ (PT
- before
),
7327 opoint_byte
+ (PT_BYTE
- before_byte
));
7329 SET_PT_BOTH (opoint
, opoint_byte
);
7331 set_buffer_internal (old
);
7337 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
7338 Sset_process_coding_system
, 1, 3, 0,
7339 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
7340 DECODING will be used to decode subprocess output and ENCODING to
7341 encode subprocess input. */)
7342 (Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
7344 CHECK_PROCESS (process
);
7346 struct Lisp_Process
*p
= XPROCESS (process
);
7348 Fcheck_coding_system (decoding
);
7349 Fcheck_coding_system (encoding
);
7350 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
7351 pset_decode_coding_system (p
, decoding
);
7352 pset_encode_coding_system (p
, encoding
);
7354 /* If the sockets haven't been set up yet, the final setup part of
7355 this will be called asynchronously. */
7356 if (p
->infd
< 0 || p
->outfd
< 0)
7359 setup_process_coding_systems (process
);
7364 DEFUN ("process-coding-system",
7365 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
7366 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7367 (register Lisp_Object process
)
7369 CHECK_PROCESS (process
);
7370 return Fcons (XPROCESS (process
)->decode_coding_system
,
7371 XPROCESS (process
)->encode_coding_system
);
7374 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
7375 Sset_process_filter_multibyte
, 2, 2, 0,
7376 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
7377 If FLAG is non-nil, the filter is given multibyte strings.
7378 If FLAG is nil, the filter is given unibyte strings. In this case,
7379 all character code conversion except for end-of-line conversion is
7381 (Lisp_Object process
, Lisp_Object flag
)
7383 CHECK_PROCESS (process
);
7385 struct Lisp_Process
*p
= XPROCESS (process
);
7387 pset_decode_coding_system
7388 (p
, raw_text_coding_system (p
->decode_coding_system
));
7390 /* If the sockets haven't been set up yet, the final setup part of
7391 this will be called asynchronously. */
7392 if (p
->infd
< 0 || p
->outfd
< 0)
7395 setup_process_coding_systems (process
);
7400 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
7401 Sprocess_filter_multibyte_p
, 1, 1, 0,
7402 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7403 (Lisp_Object process
)
7405 CHECK_PROCESS (process
);
7406 struct Lisp_Process
*p
= XPROCESS (process
);
7409 struct coding_system
*coding
= proc_decode_coding_system
[p
->infd
];
7410 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
7419 add_gpm_wait_descriptor (int desc
)
7421 add_keyboard_wait_descriptor (desc
);
7425 delete_gpm_wait_descriptor (int desc
)
7427 delete_keyboard_wait_descriptor (desc
);
7432 # ifdef USABLE_SIGIO
7434 /* Return true if *MASK has a bit set
7435 that corresponds to one of the keyboard input descriptors. */
7438 keyboard_bit_set (fd_set
*mask
)
7442 for (fd
= 0; fd
<= max_desc
; fd
++)
7443 if (FD_ISSET (fd
, mask
)
7444 && ((fd_callback_info
[fd
].flags
& (FOR_READ
| KEYBOARD_FD
))
7445 == (FOR_READ
| KEYBOARD_FD
)))
7452 #else /* not subprocesses */
7454 /* This is referenced in thread.c:run_thread (which is never actually
7455 called, since threads are not enabled for this configuration. */
7457 update_processes_for_thread_death (Lisp_Object dying_thread
)
7461 /* Defined in msdos.c. */
7462 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
7463 struct timespec
*, void *);
7465 /* Implementation of wait_reading_process_output, assuming that there
7466 are no subprocesses. Used only by the MS-DOS build.
7468 Wait for timeout to elapse and/or keyboard input to be available.
7472 If negative, gobble data immediately available but don't wait for any.
7475 an additional duration to wait, measured in nanoseconds
7476 If TIME_LIMIT is zero, then:
7477 If NSECS == 0, there is no limit.
7478 If NSECS > 0, the timeout consists of NSECS only.
7479 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7482 0 to ignore keyboard input, or
7483 1 to return when input is available, or
7484 -1 means caller will actually read the input, so don't throw to
7487 see full version for other parameters. We know that wait_proc will
7488 always be NULL, since `subprocesses' isn't defined.
7490 DO_DISPLAY means redisplay should be done to show subprocess
7491 output that arrives.
7493 Return -1 signifying we got no output and did not try. */
7496 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
7498 Lisp_Object wait_for_cell
,
7499 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
7502 struct timespec end_time
, timeout
;
7503 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
7505 if (TYPE_MAXIMUM (time_t) < time_limit
)
7506 time_limit
= TYPE_MAXIMUM (time_t);
7508 if (time_limit
< 0 || nsecs
< 0)
7510 else if (time_limit
> 0 || nsecs
> 0)
7513 end_time
= timespec_add (current_timespec (),
7514 make_timespec (time_limit
, nsecs
));
7519 /* Turn off periodic alarms (in case they are in use)
7520 and then turn off any other atimers,
7521 because the select emulator uses alarms. */
7523 turn_on_atimers (0);
7527 bool timeout_reduced_for_timers
= false;
7528 fd_set waitchannels
;
7531 /* If calling from keyboard input, do not quit
7532 since we want to return C-g as an input character.
7533 Otherwise, do pending quit if requested. */
7537 /* Exit now if the cell we're waiting for became non-nil. */
7538 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7541 /* Compute time from now till when time limit is up. */
7542 /* Exit if already run out. */
7543 if (wait
== TIMEOUT
)
7545 struct timespec now
= current_timespec ();
7546 if (timespec_cmp (end_time
, now
) <= 0)
7548 timeout
= timespec_sub (end_time
, now
);
7551 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
7553 /* If our caller will not immediately handle keyboard events,
7554 run timer events directly.
7555 (Callers that will immediately read keyboard events
7556 call timer_delay on their own.) */
7557 if (NILP (wait_for_cell
))
7559 struct timespec timer_delay
;
7563 unsigned old_timers_run
= timers_run
;
7564 timer_delay
= timer_check ();
7565 if (timers_run
!= old_timers_run
&& do_display
)
7566 /* We must retry, since a timer may have requeued itself
7567 and that could alter the time delay. */
7568 redisplay_preserve_echo_area (14);
7572 while (!detect_input_pending ());
7574 /* If there is unread keyboard input, also return. */
7576 && requeued_events_pending_p ())
7579 if (timespec_valid_p (timer_delay
))
7581 if (timespec_cmp (timer_delay
, timeout
) < 0)
7583 timeout
= timer_delay
;
7584 timeout_reduced_for_timers
= true;
7589 /* Cause C-g and alarm signals to take immediate action,
7590 and cause input available signals to zero out timeout. */
7592 set_waiting_for_input (&timeout
);
7594 /* If a frame has been newly mapped and needs updating,
7595 reprocess its display stuff. */
7596 if (frame_garbaged
&& do_display
)
7598 clear_waiting_for_input ();
7599 redisplay_preserve_echo_area (15);
7601 set_waiting_for_input (&timeout
);
7604 /* Wait till there is something to do. */
7605 FD_ZERO (&waitchannels
);
7606 if (read_kbd
&& detect_input_pending ())
7610 if (read_kbd
|| !NILP (wait_for_cell
))
7611 FD_SET (0, &waitchannels
);
7612 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
7617 /* Make C-g and alarm signals set flags again. */
7618 clear_waiting_for_input ();
7620 /* If we woke up due to SIGWINCH, actually change size now. */
7621 do_pending_window_change (0);
7623 if (wait
< INFINITY
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7624 /* We waited the full specified time, so return now. */
7629 /* If the system call was interrupted, then go around the
7631 if (xerrno
== EINTR
)
7632 FD_ZERO (&waitchannels
);
7634 report_file_errno ("Failed select", Qnil
, xerrno
);
7637 /* Check for keyboard input. */
7640 && detect_input_pending_run_timers (do_display
))
7642 swallow_events (do_display
);
7643 if (detect_input_pending_run_timers (do_display
))
7647 /* If there is unread keyboard input, also return. */
7649 && requeued_events_pending_p ())
7652 /* If wait_for_cell. check for keyboard input
7653 but don't run any timers.
7654 ??? (It seems wrong to me to check for keyboard
7655 input at all when wait_for_cell, but the code
7656 has been this way since July 1994.
7657 Try changing this after version 19.31.) */
7658 if (! NILP (wait_for_cell
)
7659 && detect_input_pending ())
7661 swallow_events (do_display
);
7662 if (detect_input_pending ())
7666 /* Exit now if the cell we're waiting for became non-nil. */
7667 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7676 #endif /* not subprocesses */
7678 /* The following functions are needed even if async subprocesses are
7679 not supported. Some of them are no-op stubs in that case. */
7683 /* Add FD, which is a descriptor returned by timerfd_create,
7684 to the set of non-keyboard input descriptors. */
7687 add_timer_wait_descriptor (int fd
)
7689 add_read_fd (fd
, timerfd_callback
, NULL
);
7690 fd_callback_info
[fd
].flags
&= ~KEYBOARD_FD
;
7693 #endif /* HAVE_TIMERFD */
7695 /* If program file NAME starts with /: for quoting a magic
7696 name, remove that, preserving the multibyteness of NAME. */
7699 remove_slash_colon (Lisp_Object name
)
7702 (SREF (name
, 0) == '/' && SREF (name
, 1) == ':'
7703 ? make_specified_string (SSDATA (name
) + 2, SCHARS (name
) - 2,
7704 SBYTES (name
) - 2, STRING_MULTIBYTE (name
))
7708 /* Add DESC to the set of keyboard input descriptors. */
7711 add_keyboard_wait_descriptor (int desc
)
7713 #ifdef subprocesses /* Actually means "not MSDOS". */
7714 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7715 fd_callback_info
[desc
].flags
&= ~PROCESS_FD
;
7716 fd_callback_info
[desc
].flags
|= (FOR_READ
| KEYBOARD_FD
);
7717 if (desc
> max_desc
)
7722 /* From now on, do not expect DESC to give keyboard input. */
7725 delete_keyboard_wait_descriptor (int desc
)
7728 eassert (desc
>= 0 && desc
< FD_SETSIZE
);
7730 fd_callback_info
[desc
].flags
&= ~(FOR_READ
| KEYBOARD_FD
| PROCESS_FD
);
7732 if (desc
== max_desc
)
7733 recompute_max_desc ();
7737 /* Setup coding systems of PROCESS. */
7740 setup_process_coding_systems (Lisp_Object process
)
7743 struct Lisp_Process
*p
= XPROCESS (process
);
7745 int outch
= p
->outfd
;
7746 Lisp_Object coding_system
;
7748 if (inch
< 0 || outch
< 0)
7751 if (!proc_decode_coding_system
[inch
])
7752 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7753 coding_system
= p
->decode_coding_system
;
7754 if (EQ (p
->filter
, Qinternal_default_process_filter
)
7755 && BUFFERP (p
->buffer
))
7757 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7758 coding_system
= raw_text_coding_system (coding_system
);
7760 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7762 if (!proc_encode_coding_system
[outch
])
7763 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7764 setup_coding_system (p
->encode_coding_system
,
7765 proc_encode_coding_system
[outch
]);
7769 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7770 doc
: /* Return the (or a) live process associated with BUFFER.
7771 BUFFER may be a buffer or the name of one.
7772 Return nil if all processes associated with BUFFER have been
7773 deleted or killed. */)
7774 (register Lisp_Object buffer
)
7777 register Lisp_Object buf
, tail
, proc
;
7779 if (NILP (buffer
)) return Qnil
;
7780 buf
= Fget_buffer (buffer
);
7781 if (NILP (buf
)) return Qnil
;
7783 FOR_EACH_PROCESS (tail
, proc
)
7784 if (EQ (XPROCESS (proc
)->buffer
, buf
))
7786 #endif /* subprocesses */
7790 DEFUN ("process-inherit-coding-system-flag",
7791 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7793 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7794 If this flag is t, `buffer-file-coding-system' of the buffer
7795 associated with PROCESS will inherit the coding system used to decode
7796 the process output. */)
7797 (register Lisp_Object process
)
7800 CHECK_PROCESS (process
);
7801 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7803 /* Ignore the argument and return the value of
7804 inherit-process-coding-system. */
7805 return inherit_process_coding_system
? Qt
: Qnil
;
7809 /* Kill all processes associated with `buffer'.
7810 If `buffer' is nil, kill all processes. */
7813 kill_buffer_processes (Lisp_Object buffer
)
7816 Lisp_Object tail
, proc
;
7818 FOR_EACH_PROCESS (tail
, proc
)
7819 if (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
))
7821 if (NETCONN_P (proc
) || SERIALCONN_P (proc
) || PIPECONN_P (proc
))
7822 Fdelete_process (proc
);
7823 else if (XPROCESS (proc
)->infd
>= 0)
7824 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7826 #else /* subprocesses */
7827 /* Since we have no subprocesses, this does nothing. */
7828 #endif /* subprocesses */
7831 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7832 Swaiting_for_user_input_p
, 0, 0, 0,
7833 doc
: /* Return non-nil if Emacs is waiting for input from the user.
7834 This is intended for use by asynchronous process output filters and sentinels. */)
7838 return (waiting_for_user_input_p
? Qt
: Qnil
);
7844 /* Stop reading input from keyboard sources. */
7847 hold_keyboard_input (void)
7852 /* Resume reading input from keyboard sources. */
7855 unhold_keyboard_input (void)
7860 /* Return true if keyboard input is on hold, zero otherwise. */
7863 kbd_on_hold_p (void)
7865 return kbd_is_on_hold
;
7869 /* Enumeration of and access to system processes a-la ps(1). */
7871 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7873 doc
: /* Return a list of numerical process IDs of all running processes.
7874 If this functionality is unsupported, return nil.
7876 See `process-attributes' for getting attributes of a process given its ID. */)
7879 return list_system_processes ();
7882 DEFUN ("process-attributes", Fprocess_attributes
,
7883 Sprocess_attributes
, 1, 1, 0,
7884 doc
: /* Return attributes of the process given by its PID, a number.
7886 Value is an alist where each element is a cons cell of the form
7890 If this functionality is unsupported, the value is nil.
7892 See `list-system-processes' for getting a list of all process IDs.
7894 The KEYs of the attributes that this function may return are listed
7895 below, together with the type of the associated VALUE (in parentheses).
7896 Not all platforms support all of these attributes; unsupported
7897 attributes will not appear in the returned alist.
7898 Unless explicitly indicated otherwise, numbers can have either
7899 integer or floating point values.
7901 euid -- Effective user User ID of the process (number)
7902 user -- User name corresponding to euid (string)
7903 egid -- Effective user Group ID of the process (number)
7904 group -- Group name corresponding to egid (string)
7905 comm -- Command name (executable name only) (string)
7906 state -- Process state code, such as "S", "R", or "T" (string)
7907 ppid -- Parent process ID (number)
7908 pgrp -- Process group ID (number)
7909 sess -- Session ID, i.e. process ID of session leader (number)
7910 ttname -- Controlling tty name (string)
7911 tpgid -- ID of foreground process group on the process's tty (number)
7912 minflt -- number of minor page faults (number)
7913 majflt -- number of major page faults (number)
7914 cminflt -- cumulative number of minor page faults (number)
7915 cmajflt -- cumulative number of major page faults (number)
7916 utime -- user time used by the process, in (current-time) format,
7917 which is a list of integers (HIGH LOW USEC PSEC)
7918 stime -- system time used by the process (current-time)
7919 time -- sum of utime and stime (current-time)
7920 cutime -- user time used by the process and its children (current-time)
7921 cstime -- system time used by the process and its children (current-time)
7922 ctime -- sum of cutime and cstime (current-time)
7923 pri -- priority of the process (number)
7924 nice -- nice value of the process (number)
7925 thcount -- process thread count (number)
7926 start -- time the process started (current-time)
7927 vsize -- virtual memory size of the process in KB's (number)
7928 rss -- resident set size of the process in KB's (number)
7929 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7930 pcpu -- percents of CPU time used by the process (floating-point number)
7931 pmem -- percents of total physical memory used by process's resident set
7932 (floating-point number)
7933 args -- command line which invoked the process (string). */)
7936 return system_process_attributes (pid
);
7940 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7941 Invoke this after init_process_emacs, and after glib and/or GNUstep
7942 futz with the SIGCHLD handler, but before Emacs forks any children.
7943 This function's caller should block SIGCHLD. */
7946 catch_child_signal (void)
7948 struct sigaction action
, old_action
;
7950 emacs_sigaction_init (&action
, deliver_child_signal
);
7951 block_child_signal (&oldset
);
7952 sigaction (SIGCHLD
, &action
, &old_action
);
7953 eassert (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7954 || ! (old_action
.sa_flags
& SA_SIGINFO
));
7956 if (old_action
.sa_handler
!= deliver_child_signal
)
7958 = (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7960 : old_action
.sa_handler
);
7961 unblock_child_signal (&oldset
);
7963 #endif /* subprocesses */
7965 /* Limit the number of open files to the value it had at startup. */
7968 restore_nofile_limit (void)
7970 #ifdef HAVE_SETRLIMIT
7971 if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
7972 setrlimit (RLIMIT_NOFILE
, &nofile_limit
);
7977 /* This is not called "init_process" because that is the name of a
7978 Mach system call, so it would cause problems on Darwin systems. */
7980 init_process_emacs (int sockfd
)
7985 inhibit_sentinels
= 0;
7988 if (! noninteractive
|| initialized
)
7991 #if defined HAVE_GLIB && !defined WINDOWSNT
7992 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7993 this should always fail, but is enough to initialize glib's
7994 private SIGCHLD handler, allowing catch_child_signal to copy
7995 it into lib_child_handler. */
7996 g_source_unref (g_child_watch_source_new (getpid ()));
7998 catch_child_signal ();
8001 #ifdef HAVE_SETRLIMIT
8002 /* Don't allocate more than FD_SETSIZE file descriptors for Emacs itself. */
8003 if (getrlimit (RLIMIT_NOFILE
, &nofile_limit
) != 0)
8004 nofile_limit
.rlim_cur
= 0;
8005 else if (FD_SETSIZE
< nofile_limit
.rlim_cur
)
8007 struct rlimit rlim
= nofile_limit
;
8008 rlim
.rlim_cur
= FD_SETSIZE
;
8009 if (setrlimit (RLIMIT_NOFILE
, &rlim
) != 0)
8010 nofile_limit
.rlim_cur
= 0;
8014 external_sock_fd
= sockfd
;
8016 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
8018 num_pending_connects
= 0;
8020 process_output_delay_count
= 0;
8021 process_output_skip
= 0;
8023 /* Don't do this, it caused infinite select loops. The display
8024 method should call add_keyboard_wait_descriptor on stdin if it
8027 FD_SET (0, &input_wait_mask
);
8030 Vprocess_alist
= Qnil
;
8031 deleted_pid_list
= Qnil
;
8032 for (i
= 0; i
< FD_SETSIZE
; i
++)
8034 chan_process
[i
] = Qnil
;
8035 proc_buffered_char
[i
] = -1;
8037 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
8038 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
8039 #ifdef DATAGRAM_SOCKETS
8040 memset (datagram_address
, 0, sizeof datagram_address
);
8043 #if defined (DARWIN_OS)
8044 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
8045 processes. As such, we only change the default value. */
8048 char const *release
= (STRINGP (Voperating_system_release
)
8049 ? SSDATA (Voperating_system_release
)
8051 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
8052 Vprocess_connection_type
= Qnil
;
8056 #endif /* subprocesses */
8061 syms_of_process (void)
8065 DEFSYM (Qprocessp
, "processp");
8066 DEFSYM (Qrun
, "run");
8067 DEFSYM (Qstop
, "stop");
8068 DEFSYM (Qsignal
, "signal");
8070 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
8073 DEFSYM (Qopen
, "open");
8074 DEFSYM (Qclosed
, "closed");
8075 DEFSYM (Qconnect
, "connect");
8076 DEFSYM (Qfailed
, "failed");
8077 DEFSYM (Qlisten
, "listen");
8078 DEFSYM (Qlocal
, "local");
8079 DEFSYM (Qipv4
, "ipv4");
8081 DEFSYM (Qipv6
, "ipv6");
8083 DEFSYM (Qdatagram
, "datagram");
8084 DEFSYM (Qseqpacket
, "seqpacket");
8086 DEFSYM (QCport
, ":port");
8087 DEFSYM (QCspeed
, ":speed");
8088 DEFSYM (QCprocess
, ":process");
8090 DEFSYM (QCbytesize
, ":bytesize");
8091 DEFSYM (QCstopbits
, ":stopbits");
8092 DEFSYM (QCparity
, ":parity");
8093 DEFSYM (Qodd
, "odd");
8094 DEFSYM (Qeven
, "even");
8095 DEFSYM (QCflowcontrol
, ":flowcontrol");
8098 DEFSYM (QCsummary
, ":summary");
8100 DEFSYM (Qreal
, "real");
8101 DEFSYM (Qnetwork
, "network");
8102 DEFSYM (Qserial
, "serial");
8103 DEFSYM (QCbuffer
, ":buffer");
8104 DEFSYM (QChost
, ":host");
8105 DEFSYM (QCservice
, ":service");
8106 DEFSYM (QClocal
, ":local");
8107 DEFSYM (QCremote
, ":remote");
8108 DEFSYM (QCcoding
, ":coding");
8109 DEFSYM (QCserver
, ":server");
8110 DEFSYM (QCnowait
, ":nowait");
8111 DEFSYM (QCsentinel
, ":sentinel");
8112 DEFSYM (QCuse_external_socket
, ":use-external-socket");
8113 DEFSYM (QCtls_parameters
, ":tls-parameters");
8114 DEFSYM (Qnsm_verify_connection
, "nsm-verify-connection");
8115 DEFSYM (QClog
, ":log");
8116 DEFSYM (QCnoquery
, ":noquery");
8117 DEFSYM (QCstop
, ":stop");
8118 DEFSYM (QCplist
, ":plist");
8119 DEFSYM (QCcommand
, ":command");
8120 DEFSYM (QCconnection_type
, ":connection-type");
8121 DEFSYM (QCstderr
, ":stderr");
8122 DEFSYM (Qpty
, "pty");
8123 DEFSYM (Qpipe
, "pipe");
8125 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
8127 staticpro (&Vprocess_alist
);
8128 staticpro (&deleted_pid_list
);
8130 #endif /* subprocesses */
8132 DEFSYM (QCname
, ":name");
8133 DEFSYM (QCtype
, ":type");
8135 DEFSYM (Qeuid
, "euid");
8136 DEFSYM (Qegid
, "egid");
8137 DEFSYM (Quser
, "user");
8138 DEFSYM (Qgroup
, "group");
8139 DEFSYM (Qcomm
, "comm");
8140 DEFSYM (Qstate
, "state");
8141 DEFSYM (Qppid
, "ppid");
8142 DEFSYM (Qpgrp
, "pgrp");
8143 DEFSYM (Qsess
, "sess");
8144 DEFSYM (Qttname
, "ttname");
8145 DEFSYM (Qtpgid
, "tpgid");
8146 DEFSYM (Qminflt
, "minflt");
8147 DEFSYM (Qmajflt
, "majflt");
8148 DEFSYM (Qcminflt
, "cminflt");
8149 DEFSYM (Qcmajflt
, "cmajflt");
8150 DEFSYM (Qutime
, "utime");
8151 DEFSYM (Qstime
, "stime");
8152 DEFSYM (Qtime
, "time");
8153 DEFSYM (Qcutime
, "cutime");
8154 DEFSYM (Qcstime
, "cstime");
8155 DEFSYM (Qctime
, "ctime");
8157 DEFSYM (Qinternal_default_process_sentinel
,
8158 "internal-default-process-sentinel");
8159 DEFSYM (Qinternal_default_process_filter
,
8160 "internal-default-process-filter");
8162 DEFSYM (Qpri
, "pri");
8163 DEFSYM (Qnice
, "nice");
8164 DEFSYM (Qthcount
, "thcount");
8165 DEFSYM (Qstart
, "start");
8166 DEFSYM (Qvsize
, "vsize");
8167 DEFSYM (Qrss
, "rss");
8168 DEFSYM (Qetime
, "etime");
8169 DEFSYM (Qpcpu
, "pcpu");
8170 DEFSYM (Qpmem
, "pmem");
8171 DEFSYM (Qargs
, "args");
8173 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
8174 doc
: /* Non-nil means delete processes immediately when they exit.
8175 A value of nil means don't delete them until `list-processes' is run. */);
8177 delete_exited_processes
= 1;
8180 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
8181 doc
: /* Control type of device used to communicate with subprocesses.
8182 Values are nil to use a pipe, or t or `pty' to use a pty.
8183 The value has no effect if the system has no ptys or if all ptys are busy:
8184 then a pipe is used in any case.
8185 The value takes effect when `start-process' is called. */);
8186 Vprocess_connection_type
= Qt
;
8188 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
8189 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
8190 On some systems, when Emacs reads the output from a subprocess, the output data
8191 is read in very small blocks, potentially resulting in very poor performance.
8192 This behavior can be remedied to some extent by setting this variable to a
8193 non-nil value, as it will automatically delay reading from such processes, to
8194 allow them to produce more output before Emacs tries to read it.
8195 If the value is t, the delay is reset after each write to the process; any other
8196 non-nil value means that the delay is not reset on write.
8197 The variable takes effect when `start-process' is called. */);
8198 Vprocess_adaptive_read_buffering
= Qt
;
8200 DEFVAR_LISP ("interrupt-process-functions", Vinterrupt_process_functions
,
8201 doc
: /* List of functions to be called for `interrupt-process'.
8202 The arguments of the functions are the same as for `interrupt-process'.
8203 These functions are called in the order of the list, until one of them
8204 returns non-`nil'. */);
8205 Vinterrupt_process_functions
= list1 (Qinternal_default_interrupt_process
);
8207 DEFSYM (Qinternal_default_interrupt_process
,
8208 "internal-default-interrupt-process");
8209 DEFSYM (Qinterrupt_process_functions
, "interrupt-process-functions");
8211 defsubr (&Sprocessp
);
8212 defsubr (&Sget_process
);
8213 defsubr (&Sdelete_process
);
8214 defsubr (&Sprocess_status
);
8215 defsubr (&Sprocess_exit_status
);
8216 defsubr (&Sprocess_id
);
8217 defsubr (&Sprocess_name
);
8218 defsubr (&Sprocess_tty_name
);
8219 defsubr (&Sprocess_command
);
8220 defsubr (&Sset_process_buffer
);
8221 defsubr (&Sprocess_buffer
);
8222 defsubr (&Sprocess_mark
);
8223 defsubr (&Sset_process_filter
);
8224 defsubr (&Sprocess_filter
);
8225 defsubr (&Sset_process_sentinel
);
8226 defsubr (&Sprocess_sentinel
);
8227 defsubr (&Sset_process_thread
);
8228 defsubr (&Sprocess_thread
);
8229 defsubr (&Sset_process_window_size
);
8230 defsubr (&Sset_process_inherit_coding_system_flag
);
8231 defsubr (&Sset_process_query_on_exit_flag
);
8232 defsubr (&Sprocess_query_on_exit_flag
);
8233 defsubr (&Sprocess_contact
);
8234 defsubr (&Sprocess_plist
);
8235 defsubr (&Sset_process_plist
);
8236 defsubr (&Sprocess_list
);
8237 defsubr (&Smake_process
);
8238 defsubr (&Smake_pipe_process
);
8239 defsubr (&Sserial_process_configure
);
8240 defsubr (&Smake_serial_process
);
8241 defsubr (&Sset_network_process_option
);
8242 defsubr (&Smake_network_process
);
8243 defsubr (&Sformat_network_address
);
8244 defsubr (&Snetwork_interface_list
);
8245 defsubr (&Snetwork_interface_info
);
8246 #ifdef DATAGRAM_SOCKETS
8247 defsubr (&Sprocess_datagram_address
);
8248 defsubr (&Sset_process_datagram_address
);
8250 defsubr (&Saccept_process_output
);
8251 defsubr (&Sprocess_send_region
);
8252 defsubr (&Sprocess_send_string
);
8253 defsubr (&Sinternal_default_interrupt_process
);
8254 defsubr (&Sinterrupt_process
);
8255 defsubr (&Skill_process
);
8256 defsubr (&Squit_process
);
8257 defsubr (&Sstop_process
);
8258 defsubr (&Scontinue_process
);
8259 defsubr (&Sprocess_running_child_p
);
8260 defsubr (&Sprocess_send_eof
);
8261 defsubr (&Ssignal_process
);
8262 defsubr (&Swaiting_for_user_input_p
);
8263 defsubr (&Sprocess_type
);
8264 defsubr (&Sinternal_default_process_sentinel
);
8265 defsubr (&Sinternal_default_process_filter
);
8266 defsubr (&Sset_process_coding_system
);
8267 defsubr (&Sprocess_coding_system
);
8268 defsubr (&Sset_process_filter_multibyte
);
8269 defsubr (&Sprocess_filter_multibyte_p
);
8272 Lisp_Object subfeatures
= Qnil
;
8273 const struct socket_options
*sopt
;
8275 #define ADD_SUBFEATURE(key, val) \
8276 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8278 ADD_SUBFEATURE (QCnowait
, Qt
);
8279 #ifdef DATAGRAM_SOCKETS
8280 ADD_SUBFEATURE (QCtype
, Qdatagram
);
8282 #ifdef HAVE_SEQPACKET
8283 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
8285 #ifdef HAVE_LOCAL_SOCKETS
8286 ADD_SUBFEATURE (QCfamily
, Qlocal
);
8288 ADD_SUBFEATURE (QCfamily
, Qipv4
);
8290 ADD_SUBFEATURE (QCfamily
, Qipv6
);
8292 #ifdef HAVE_GETSOCKNAME
8293 ADD_SUBFEATURE (QCservice
, Qt
);
8295 ADD_SUBFEATURE (QCserver
, Qt
);
8297 for (sopt
= socket_options
; sopt
->name
; sopt
++)
8298 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
8300 Fprovide (intern_c_string ("make-network-process"), subfeatures
);
8303 #endif /* subprocesses */
8305 defsubr (&Sget_buffer_process
);
8306 defsubr (&Sprocess_inherit_coding_system_flag
);
8307 defsubr (&Slist_system_processes
);
8308 defsubr (&Sprocess_attributes
);