1 /* Asynchronous subprocess control for GNU Emacs.
3 Copyright (C) 1985-1988, 1993-1996, 1998-1999, 2001-2016 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
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
26 #include <sys/types.h> /* Some typedefs are used in sys/file.h. */
34 /* Only MS-DOS does not define `subprocesses'. */
37 #include <sys/socket.h>
39 #include <netinet/in.h>
40 #include <arpa/inet.h>
42 /* Are local (unix) sockets supported? */
43 #if defined (HAVE_SYS_UN_H)
44 #if !defined (AF_LOCAL) && defined (AF_UNIX)
45 #define AF_LOCAL AF_UNIX
48 #define HAVE_LOCAL_SOCKETS
53 #include <sys/ioctl.h>
54 #if defined (HAVE_NET_IF_H)
56 #endif /* HAVE_NET_IF_H */
58 #if defined (HAVE_IFADDRS_H)
59 /* Must be after net/if.h */
62 /* We only use structs from this header when we use getifaddrs. */
63 #if defined (HAVE_NET_IF_DL_H)
64 #include <net/if_dl.h>
74 # include <sys/stream.h>
75 # include <sys/stropts.h>
79 #include <arpa/nameser.h>
95 #endif /* subprocesses */
101 #include "character.h"
106 #include "termopts.h"
107 #include "keyboard.h"
108 #include "blockinput.h"
110 #include "sysselect.h"
111 #include "syssignal.h"
117 #ifdef HAVE_WINDOW_SYSTEM
119 #endif /* HAVE_WINDOW_SYSTEM */
122 #include "xgselect.h"
129 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
130 struct timespec
*, void *);
133 /* Work around GCC 4.7.0 bug with strict overflow checking; see
134 <http://gcc.gnu.org/bugzilla/show_bug.cgi?id=52904>.
135 This bug appears to be fixed in GCC 5.1, so don't work around it there. */
136 #if __GNUC__ == 4 && __GNUC_MINOR__ >= 3
137 # pragma GCC diagnostic ignored "-Wstrict-overflow"
140 /* True if keyboard input is on hold, zero otherwise. */
142 static bool kbd_is_on_hold
;
144 /* Nonzero means don't run process sentinels. This is used
146 bool inhibit_sentinels
;
151 # define SOCK_CLOEXEC 0
156 /* Emulate GNU/Linux accept4 and socket well enough for this module. */
159 close_on_exec (int fd
)
162 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
167 # define accept4(sockfd, addr, addrlen, flags) \
168 process_accept4 (sockfd, addr, addrlen, flags)
170 accept4 (int sockfd
, struct sockaddr
*addr
, socklen_t
*addrlen
, int flags
)
172 return close_on_exec (accept (sockfd
, addr
, addrlen
));
176 process_socket (int domain
, int type
, int protocol
)
178 return close_on_exec (socket (domain
, type
, protocol
));
181 # define socket(domain, type, protocol) process_socket (domain, type, protocol)
184 #define NETCONN_P(p) (EQ (XPROCESS (p)->type, Qnetwork))
185 #define NETCONN1_P(p) (EQ (p->type, Qnetwork))
186 #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial))
187 #define SERIALCONN1_P(p) (EQ (p->type, Qserial))
188 #define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe))
189 #define PIPECONN1_P(p) (EQ (p->type, Qpipe))
191 /* Number of events of change of status of a process. */
192 static EMACS_INT process_tick
;
193 /* Number of events for which the user or sentinel has been notified. */
194 static EMACS_INT update_tick
;
196 /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects.
197 The code can be simplified by assuming NON_BLOCKING_CONNECT once
198 Emacs starts assuming POSIX 1003.1-2001 or later. */
200 #if (defined HAVE_SELECT \
201 && (defined GNU_LINUX || defined HAVE_GETPEERNAME) \
202 && (defined EWOULDBLOCK || defined EINPROGRESS))
203 # define NON_BLOCKING_CONNECT
206 /* Define DATAGRAM_SOCKETS if datagrams can be used safely on
207 this system. We need to read full packets, so we need a
208 "non-destructive" select. So we require either native select,
209 or emulation of select using FIONREAD. */
211 #ifndef BROKEN_DATAGRAM_SOCKETS
212 # if defined HAVE_SELECT || defined USABLE_FIONREAD
213 # if defined HAVE_SENDTO && defined HAVE_RECVFROM && defined EMSGSIZE
214 # define DATAGRAM_SOCKETS
219 #if defined HAVE_LOCAL_SOCKETS && defined DATAGRAM_SOCKETS
220 # define HAVE_SEQPACKET
223 #define READ_OUTPUT_DELAY_INCREMENT (TIMESPEC_RESOLUTION / 100)
224 #define READ_OUTPUT_DELAY_MAX (READ_OUTPUT_DELAY_INCREMENT * 5)
225 #define READ_OUTPUT_DELAY_MAX_MAX (READ_OUTPUT_DELAY_INCREMENT * 7)
227 /* Number of processes which have a non-zero read_output_delay,
228 and therefore might be delayed for adaptive read buffering. */
230 static int process_output_delay_count
;
232 /* True if any process has non-nil read_output_skip. */
234 static bool process_output_skip
;
236 static void create_process (Lisp_Object
, char **, Lisp_Object
);
238 static bool keyboard_bit_set (fd_set
*);
240 static void deactivate_process (Lisp_Object
);
241 static int status_notify (struct Lisp_Process
*, struct Lisp_Process
*);
242 static int read_process_output (Lisp_Object
, int);
243 static void handle_child_signal (int);
244 static void create_pty (Lisp_Object
);
246 static Lisp_Object
get_process (register Lisp_Object name
);
247 static void exec_sentinel (Lisp_Object proc
, Lisp_Object reason
);
249 /* Mask of bits indicating the descriptors that we wait for input on. */
251 static fd_set input_wait_mask
;
253 /* Mask that excludes keyboard input descriptor(s). */
255 static fd_set non_keyboard_wait_mask
;
257 /* Mask that excludes process input descriptor(s). */
259 static fd_set non_process_wait_mask
;
261 /* Mask for selecting for write. */
263 static fd_set write_mask
;
265 #ifdef NON_BLOCKING_CONNECT
266 /* Mask of bits indicating the descriptors that we wait for connect to
267 complete on. Once they complete, they are removed from this mask
268 and added to the input_wait_mask and non_keyboard_wait_mask. */
270 static fd_set connect_wait_mask
;
272 /* Number of bits set in connect_wait_mask. */
273 static int num_pending_connects
;
274 #endif /* NON_BLOCKING_CONNECT */
276 /* The largest descriptor currently in use for a process object; -1 if none. */
277 static int max_process_desc
;
279 /* The largest descriptor currently in use for input; -1 if none. */
280 static int max_input_desc
;
282 /* Indexed by descriptor, gives the process (if any) for that descriptor. */
283 static Lisp_Object chan_process
[FD_SETSIZE
];
284 #ifdef HAVE_GETADDRINFO_A
285 /* Pending DNS requests. */
286 static Lisp_Object dns_processes
;
287 static void wait_for_socket_fds (Lisp_Object process
, char *name
);
290 /* Alist of elements (NAME . PROCESS). */
291 static Lisp_Object Vprocess_alist
;
293 /* Buffered-ahead input char from process, indexed by channel.
294 -1 means empty (no char is buffered).
295 Used on sys V where the only way to tell if there is any
296 output from the process is to read at least one char.
297 Always -1 on systems that support FIONREAD. */
299 static int proc_buffered_char
[FD_SETSIZE
];
301 /* Table of `struct coding-system' for each process. */
302 static struct coding_system
*proc_decode_coding_system
[FD_SETSIZE
];
303 static struct coding_system
*proc_encode_coding_system
[FD_SETSIZE
];
305 #ifdef DATAGRAM_SOCKETS
306 /* Table of `partner address' for datagram sockets. */
307 static struct sockaddr_and_len
{
310 } datagram_address
[FD_SETSIZE
];
311 #define DATAGRAM_CHAN_P(chan) (datagram_address[chan].sa != 0)
312 #define DATAGRAM_CONN_P(proc) \
313 (PROCESSP (proc) && \
314 XPROCESS (proc)->infd >= 0 && \
315 datagram_address[XPROCESS (proc)->infd].sa != 0)
317 #define DATAGRAM_CHAN_P(chan) (0)
318 #define DATAGRAM_CONN_P(proc) (0)
321 /* FOR_EACH_PROCESS (LIST_VAR, PROC_VAR) followed by a statement is
322 a `for' loop which iterates over processes from Vprocess_alist. */
324 #define FOR_EACH_PROCESS(list_var, proc_var) \
325 FOR_EACH_ALIST_VALUE (Vprocess_alist, list_var, proc_var)
327 /* These setters are used only in this file, so they can be private. */
329 pset_buffer (struct Lisp_Process
*p
, Lisp_Object val
)
334 pset_command (struct Lisp_Process
*p
, Lisp_Object val
)
339 pset_decode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
341 p
->decode_coding_system
= val
;
344 pset_decoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
346 p
->decoding_buf
= val
;
349 pset_encode_coding_system (struct Lisp_Process
*p
, Lisp_Object val
)
351 p
->encode_coding_system
= val
;
354 pset_encoding_buf (struct Lisp_Process
*p
, Lisp_Object val
)
356 p
->encoding_buf
= val
;
359 pset_filter (struct Lisp_Process
*p
, Lisp_Object val
)
361 p
->filter
= NILP (val
) ? Qinternal_default_process_filter
: val
;
364 pset_log (struct Lisp_Process
*p
, Lisp_Object val
)
369 pset_mark (struct Lisp_Process
*p
, Lisp_Object val
)
374 pset_name (struct Lisp_Process
*p
, Lisp_Object val
)
379 pset_plist (struct Lisp_Process
*p
, Lisp_Object val
)
384 pset_sentinel (struct Lisp_Process
*p
, Lisp_Object val
)
386 p
->sentinel
= NILP (val
) ? Qinternal_default_process_sentinel
: val
;
389 pset_tty_name (struct Lisp_Process
*p
, Lisp_Object val
)
394 pset_type (struct Lisp_Process
*p
, Lisp_Object val
)
399 pset_write_queue (struct Lisp_Process
*p
, Lisp_Object val
)
401 p
->write_queue
= val
;
404 pset_stderrproc (struct Lisp_Process
*p
, Lisp_Object val
)
411 make_lisp_proc (struct Lisp_Process
*p
)
413 return make_lisp_ptr (p
, Lisp_Vectorlike
);
416 static struct fd_callback_data
422 int condition
; /* Mask of the defines above. */
423 } fd_callback_info
[FD_SETSIZE
];
426 /* Add a file descriptor FD to be monitored for when read is possible.
427 When read is possible, call FUNC with argument DATA. */
430 add_read_fd (int fd
, fd_callback func
, void *data
)
432 add_keyboard_wait_descriptor (fd
);
434 fd_callback_info
[fd
].func
= func
;
435 fd_callback_info
[fd
].data
= data
;
436 fd_callback_info
[fd
].condition
|= FOR_READ
;
439 /* Stop monitoring file descriptor FD for when read is possible. */
442 delete_read_fd (int fd
)
444 delete_keyboard_wait_descriptor (fd
);
446 fd_callback_info
[fd
].condition
&= ~FOR_READ
;
447 if (fd_callback_info
[fd
].condition
== 0)
449 fd_callback_info
[fd
].func
= 0;
450 fd_callback_info
[fd
].data
= 0;
454 /* Add a file descriptor FD to be monitored for when write is possible.
455 When write is possible, call FUNC with argument DATA. */
458 add_write_fd (int fd
, fd_callback func
, void *data
)
460 FD_SET (fd
, &write_mask
);
461 if (fd
> max_input_desc
)
464 fd_callback_info
[fd
].func
= func
;
465 fd_callback_info
[fd
].data
= data
;
466 fd_callback_info
[fd
].condition
|= FOR_WRITE
;
469 /* FD is no longer an input descriptor; update max_input_desc accordingly. */
472 delete_input_desc (int fd
)
474 if (fd
== max_input_desc
)
478 while (0 <= fd
&& ! (FD_ISSET (fd
, &input_wait_mask
)
479 || FD_ISSET (fd
, &write_mask
)));
485 /* Stop monitoring file descriptor FD for when write is possible. */
488 delete_write_fd (int fd
)
490 FD_CLR (fd
, &write_mask
);
491 fd_callback_info
[fd
].condition
&= ~FOR_WRITE
;
492 if (fd_callback_info
[fd
].condition
== 0)
494 fd_callback_info
[fd
].func
= 0;
495 fd_callback_info
[fd
].data
= 0;
496 delete_input_desc (fd
);
501 /* Compute the Lisp form of the process status, p->status, from
502 the numeric status that was returned by `wait'. */
504 static Lisp_Object
status_convert (int);
507 update_status (struct Lisp_Process
*p
)
509 eassert (p
->raw_status_new
);
510 pset_status (p
, status_convert (p
->raw_status
));
511 p
->raw_status_new
= 0;
514 /* Convert a process status word in Unix format to
515 the list that we use internally. */
518 status_convert (int w
)
521 return Fcons (Qstop
, Fcons (make_number (WSTOPSIG (w
)), Qnil
));
522 else if (WIFEXITED (w
))
523 return Fcons (Qexit
, Fcons (make_number (WEXITSTATUS (w
)),
524 WCOREDUMP (w
) ? Qt
: Qnil
));
525 else if (WIFSIGNALED (w
))
526 return Fcons (Qsignal
, Fcons (make_number (WTERMSIG (w
)),
527 WCOREDUMP (w
) ? Qt
: Qnil
));
532 /* Given a status-list, extract the three pieces of information
533 and store them individually through the three pointers. */
536 decode_status (Lisp_Object l
, Lisp_Object
*symbol
, int *code
, bool *coredump
)
550 *code
= XFASTINT (XCAR (tem
));
552 *coredump
= !NILP (tem
);
556 /* Return a string describing a process status list. */
559 status_message (struct Lisp_Process
*p
)
561 Lisp_Object status
= p
->status
;
567 decode_status (status
, &symbol
, &code
, &coredump
);
569 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qstop
))
572 synchronize_system_messages_locale ();
573 signame
= strsignal (code
);
575 string
= build_string ("unknown");
580 string
= build_unibyte_string (signame
);
581 if (! NILP (Vlocale_coding_system
))
582 string
= (code_convert_string_norecord
583 (string
, Vlocale_coding_system
, 0));
584 c1
= STRING_CHAR (SDATA (string
));
587 Faset (string
, make_number (0), make_number (c2
));
589 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
590 return concat2 (string
, suffix
);
592 else if (EQ (symbol
, Qexit
))
595 return build_string (code
== 0 ? "deleted\n" : "connection broken by remote peer\n");
597 return build_string ("finished\n");
598 AUTO_STRING (prefix
, "exited abnormally with code ");
599 string
= Fnumber_to_string (make_number (code
));
600 AUTO_STRING (suffix
, coredump
? " (core dumped)\n" : "\n");
601 return concat3 (prefix
, string
, suffix
);
603 else if (EQ (symbol
, Qfailed
))
605 AUTO_STRING (prefix
, "failed with code ");
606 string
= Fnumber_to_string (make_number (code
));
607 AUTO_STRING (suffix
, "\n");
608 return concat3 (prefix
, string
, suffix
);
611 return Fcopy_sequence (Fsymbol_name (symbol
));
614 enum { PTY_NAME_SIZE
= 24 };
616 /* Open an available pty, returning a file descriptor.
617 Store into PTY_NAME the file name of the terminal corresponding to the pty.
618 Return -1 on failure. */
621 allocate_pty (char pty_name
[PTY_NAME_SIZE
])
630 for (c
= FIRST_PTY_LETTER
; c
<= 'z'; c
++)
631 for (i
= 0; i
< 16; i
++)
634 #ifdef PTY_NAME_SPRINTF
637 sprintf (pty_name
, "/dev/pty%c%x", c
, i
);
638 #endif /* no PTY_NAME_SPRINTF */
642 #else /* no PTY_OPEN */
643 fd
= emacs_open (pty_name
, O_RDWR
| O_NONBLOCK
, 0);
644 #endif /* no PTY_OPEN */
648 #ifdef PTY_TTY_NAME_SPRINTF
651 sprintf (pty_name
, "/dev/tty%c%x", c
, i
);
652 #endif /* no PTY_TTY_NAME_SPRINTF */
654 /* Set FD's close-on-exec flag. This is needed even if
655 PT_OPEN calls posix_openpt with O_CLOEXEC, since POSIX
656 doesn't require support for that combination.
657 Do this after PTY_TTY_NAME_SPRINTF, which on some platforms
658 doesn't work if the close-on-exec flag is set (Bug#20555).
659 Multithreaded platforms where posix_openpt ignores
660 O_CLOEXEC (or where PTY_OPEN doesn't call posix_openpt)
661 have a race condition between the PTY_OPEN and here. */
662 fcntl (fd
, F_SETFD
, FD_CLOEXEC
);
664 /* Check to make certain that both sides are available.
665 This avoids a nasty yet stupid bug in rlogins. */
666 if (faccessat (AT_FDCWD
, pty_name
, R_OK
| W_OK
, AT_EACCESS
) != 0)
679 #endif /* HAVE_PTYS */
683 /* Allocate basically initialized process. */
685 static struct Lisp_Process
*
686 allocate_process (void)
688 return ALLOCATE_ZEROED_PSEUDOVECTOR (struct Lisp_Process
, pid
, PVEC_PROCESS
);
692 make_process (Lisp_Object name
)
694 register Lisp_Object val
, tem
, name1
;
695 register struct Lisp_Process
*p
;
696 char suffix
[sizeof "<>" + INT_STRLEN_BOUND (printmax_t
)];
699 p
= allocate_process ();
700 /* Initialize Lisp data. Note that allocate_process initializes all
701 Lisp data to nil, so do it only for slots which should not be nil. */
702 pset_status (p
, Qrun
);
703 pset_mark (p
, Fmake_marker ());
705 /* Initialize non-Lisp data. Note that allocate_process zeroes out all
706 non-Lisp data, so do it only for slots which should not be zero. */
709 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
713 p
->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
714 p
->gnutls_boot_parameters
= Qnil
;
717 /* If name is already in use, modify it until it is unused. */
722 tem
= Fget_process (name1
);
723 if (NILP (tem
)) break;
724 name1
= concat2 (name
, make_formatted_string (suffix
, "<%"pMd
">", i
));
728 pset_sentinel (p
, Qinternal_default_process_sentinel
);
729 pset_filter (p
, Qinternal_default_process_filter
);
730 XSETPROCESS (val
, p
);
731 Vprocess_alist
= Fcons (Fcons (name
, val
), Vprocess_alist
);
736 remove_process (register Lisp_Object proc
)
738 register Lisp_Object pair
;
740 pair
= Frassq (proc
, Vprocess_alist
);
741 Vprocess_alist
= Fdelq (pair
, Vprocess_alist
);
743 deactivate_process (proc
);
747 DEFUN ("processp", Fprocessp
, Sprocessp
, 1, 1, 0,
748 doc
: /* Return t if OBJECT is a process. */)
751 return PROCESSP (object
) ? Qt
: Qnil
;
754 DEFUN ("get-process", Fget_process
, Sget_process
, 1, 1, 0,
755 doc
: /* Return the process named NAME, or nil if there is none. */)
756 (register Lisp_Object name
)
761 return Fcdr (Fassoc (name
, Vprocess_alist
));
764 /* This is how commands for the user decode process arguments. It
765 accepts a process, a process name, a buffer, a buffer name, or nil.
766 Buffers denote the first process in the buffer, and nil denotes the
770 get_process (register Lisp_Object name
)
772 register Lisp_Object proc
, obj
;
775 obj
= Fget_process (name
);
777 obj
= Fget_buffer (name
);
779 error ("Process %s does not exist", SDATA (name
));
781 else if (NILP (name
))
782 obj
= Fcurrent_buffer ();
786 /* Now obj should be either a buffer object or a process object. */
789 if (NILP (BVAR (XBUFFER (obj
), name
)))
790 error ("Attempt to get process for a dead buffer");
791 proc
= Fget_buffer_process (obj
);
793 error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj
), name
)));
804 /* Fdelete_process promises to immediately forget about the process, but in
805 reality, Emacs needs to remember those processes until they have been
806 treated by the SIGCHLD handler and waitpid has been invoked on them;
807 otherwise they might fill up the kernel's process table.
809 Some processes created by call-process are also put onto this list.
811 Members of this list are (process-ID . filename) pairs. The
812 process-ID is a number; the filename, if a string, is a file that
813 needs to be removed after the process exits. */
814 static Lisp_Object deleted_pid_list
;
817 record_deleted_pid (pid_t pid
, Lisp_Object filename
)
819 deleted_pid_list
= Fcons (Fcons (make_fixnum_or_float (pid
), filename
),
820 /* GC treated elements set to nil. */
821 Fdelq (Qnil
, deleted_pid_list
));
825 DEFUN ("delete-process", Fdelete_process
, Sdelete_process
, 1, 1, 0,
826 doc
: /* Delete PROCESS: kill it and forget about it immediately.
827 PROCESS may be a process, a buffer, the name of a process or buffer, or
828 nil, indicating the current buffer's process. */)
829 (register Lisp_Object process
)
831 register struct Lisp_Process
*p
;
833 process
= get_process (process
);
834 p
= XPROCESS (process
);
836 p
->raw_status_new
= 0;
837 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
839 pset_status (p
, list2 (Qexit
, make_number (0)));
840 p
->tick
= ++process_tick
;
841 status_notify (p
, NULL
);
842 redisplay_preserve_echo_area (13);
847 record_kill_process (p
, Qnil
);
851 /* Update P's status, since record_kill_process will make the
852 SIGCHLD handler update deleted_pid_list, not *P. */
854 if (p
->raw_status_new
)
856 symbol
= CONSP (p
->status
) ? XCAR (p
->status
) : p
->status
;
857 if (! (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)))
858 pset_status (p
, list2 (Qsignal
, make_number (SIGKILL
)));
860 p
->tick
= ++process_tick
;
861 status_notify (p
, NULL
);
862 redisplay_preserve_echo_area (13);
865 remove_process (process
);
869 DEFUN ("process-status", Fprocess_status
, Sprocess_status
, 1, 1, 0,
870 doc
: /* Return the status of PROCESS.
871 The returned value is one of the following symbols:
872 run -- for a process that is running.
873 stop -- for a process stopped but continuable.
874 exit -- for a process that has exited.
875 signal -- for a process that has got a fatal signal.
876 open -- for a network stream connection that is open.
877 listen -- for a network stream server that is listening.
878 closed -- for a network stream connection that is closed.
879 connect -- when waiting for a non-blocking connection to complete.
880 failed -- when a non-blocking connection has failed.
881 nil -- if arg is a process name and no such process exists.
882 PROCESS may be a process, a buffer, the name of a process, or
883 nil, indicating the current buffer's process. */)
884 (register Lisp_Object process
)
886 register struct Lisp_Process
*p
;
887 register Lisp_Object status
;
889 if (STRINGP (process
))
890 process
= Fget_process (process
);
892 process
= get_process (process
);
897 p
= XPROCESS (process
);
898 if (p
->raw_status_new
)
902 status
= XCAR (status
);
903 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
905 if (EQ (status
, Qexit
))
907 else if (EQ (p
->command
, Qt
))
909 else if (EQ (status
, Qrun
))
915 DEFUN ("process-exit-status", Fprocess_exit_status
, Sprocess_exit_status
,
917 doc
: /* Return the exit status of PROCESS or the signal number that killed it.
918 If PROCESS has not yet exited or died, return 0. */)
919 (register Lisp_Object process
)
921 CHECK_PROCESS (process
);
922 if (XPROCESS (process
)->raw_status_new
)
923 update_status (XPROCESS (process
));
924 if (CONSP (XPROCESS (process
)->status
))
925 return XCAR (XCDR (XPROCESS (process
)->status
));
926 return make_number (0);
929 DEFUN ("process-id", Fprocess_id
, Sprocess_id
, 1, 1, 0,
930 doc
: /* Return the process id of PROCESS.
931 This is the pid of the external process which PROCESS uses or talks to.
932 For a network connection, this value is nil. */)
933 (register Lisp_Object process
)
937 CHECK_PROCESS (process
);
938 pid
= XPROCESS (process
)->pid
;
939 return (pid
? make_fixnum_or_float (pid
) : Qnil
);
942 DEFUN ("process-name", Fprocess_name
, Sprocess_name
, 1, 1, 0,
943 doc
: /* Return the name of PROCESS, as a string.
944 This is the name of the program invoked in PROCESS,
945 possibly modified to make it unique among process names. */)
946 (register Lisp_Object process
)
948 CHECK_PROCESS (process
);
949 return XPROCESS (process
)->name
;
952 DEFUN ("process-command", Fprocess_command
, Sprocess_command
, 1, 1, 0,
953 doc
: /* Return the command that was executed to start PROCESS.
954 This is a list of strings, the first string being the program executed
955 and the rest of the strings being the arguments given to it.
956 For a network or serial process, this is nil (process is running) or t
957 (process is stopped). */)
958 (register Lisp_Object process
)
960 CHECK_PROCESS (process
);
961 return XPROCESS (process
)->command
;
964 DEFUN ("process-tty-name", Fprocess_tty_name
, Sprocess_tty_name
, 1, 1, 0,
965 doc
: /* Return the name of the terminal PROCESS uses, or nil if none.
966 This is the terminal that the process itself reads and writes on,
967 not the name of the pty that Emacs uses to talk with that terminal. */)
968 (register Lisp_Object process
)
970 CHECK_PROCESS (process
);
971 return XPROCESS (process
)->tty_name
;
974 DEFUN ("set-process-buffer", Fset_process_buffer
, Sset_process_buffer
,
976 doc
: /* Set buffer associated with PROCESS to BUFFER (a buffer, or nil).
978 (register Lisp_Object process
, Lisp_Object buffer
)
980 struct Lisp_Process
*p
;
982 CHECK_PROCESS (process
);
984 CHECK_BUFFER (buffer
);
985 p
= XPROCESS (process
);
986 pset_buffer (p
, buffer
);
987 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
988 pset_childp (p
, Fplist_put (p
->childp
, QCbuffer
, buffer
));
989 setup_process_coding_systems (process
);
993 DEFUN ("process-buffer", Fprocess_buffer
, Sprocess_buffer
,
995 doc
: /* Return the buffer PROCESS is associated with.
996 The default process filter inserts output from PROCESS into this buffer. */)
997 (register Lisp_Object process
)
999 CHECK_PROCESS (process
);
1000 return XPROCESS (process
)->buffer
;
1003 DEFUN ("process-mark", Fprocess_mark
, Sprocess_mark
,
1005 doc
: /* Return the marker for the end of the last output from PROCESS. */)
1006 (register Lisp_Object process
)
1008 CHECK_PROCESS (process
);
1009 return XPROCESS (process
)->mark
;
1012 DEFUN ("set-process-filter", Fset_process_filter
, Sset_process_filter
,
1014 doc
: /* Give PROCESS the filter function FILTER; nil means default.
1015 A value of t means stop accepting output from the process.
1017 When a process has a non-default filter, its buffer is not used for output.
1018 Instead, each time it does output, the entire string of output is
1019 passed to the filter.
1021 The filter gets two arguments: the process and the string of output.
1022 The string argument is normally a multibyte string, except:
1023 - if the process's input coding system is no-conversion or raw-text,
1024 it is a unibyte string (the non-converted input), or else
1025 - if `default-enable-multibyte-characters' is nil, it is a unibyte
1026 string (the result of converting the decoded input multibyte
1027 string to unibyte with `string-make-unibyte'). */)
1028 (register Lisp_Object process
, Lisp_Object filter
)
1030 struct Lisp_Process
*p
;
1032 CHECK_PROCESS (process
);
1034 p
= XPROCESS (process
);
1036 /* Don't signal an error if the process's input file descriptor
1037 is closed. This could make debugging Lisp more difficult,
1038 for example when doing something like
1040 (setq process (start-process ...))
1042 (set-process-filter process ...) */
1045 filter
= Qinternal_default_process_filter
;
1049 if (EQ (filter
, Qt
) && !EQ (p
->status
, Qlisten
))
1051 FD_CLR (p
->infd
, &input_wait_mask
);
1052 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
1054 else if (EQ (p
->filter
, Qt
)
1055 /* Network or serial process not stopped: */
1056 && !EQ (p
->command
, Qt
))
1058 FD_SET (p
->infd
, &input_wait_mask
);
1059 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
1063 pset_filter (p
, filter
);
1064 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1065 pset_childp (p
, Fplist_put (p
->childp
, QCfilter
, filter
));
1066 setup_process_coding_systems (process
);
1070 DEFUN ("process-filter", Fprocess_filter
, Sprocess_filter
,
1072 doc
: /* Return the filter function of PROCESS.
1073 See `set-process-filter' for more info on filter functions. */)
1074 (register Lisp_Object process
)
1076 CHECK_PROCESS (process
);
1077 return XPROCESS (process
)->filter
;
1080 DEFUN ("set-process-sentinel", Fset_process_sentinel
, Sset_process_sentinel
,
1082 doc
: /* Give PROCESS the sentinel SENTINEL; nil for default.
1083 The sentinel is called as a function when the process changes state.
1084 It gets two arguments: the process, and a string describing the change. */)
1085 (register Lisp_Object process
, Lisp_Object sentinel
)
1087 struct Lisp_Process
*p
;
1089 CHECK_PROCESS (process
);
1090 p
= XPROCESS (process
);
1092 if (NILP (sentinel
))
1093 sentinel
= Qinternal_default_process_sentinel
;
1095 pset_sentinel (p
, sentinel
);
1096 if (NETCONN1_P (p
) || SERIALCONN1_P (p
) || PIPECONN1_P (p
))
1097 pset_childp (p
, Fplist_put (p
->childp
, QCsentinel
, sentinel
));
1101 DEFUN ("process-sentinel", Fprocess_sentinel
, Sprocess_sentinel
,
1103 doc
: /* Return the sentinel of PROCESS.
1104 See `set-process-sentinel' for more info on sentinels. */)
1105 (register Lisp_Object process
)
1107 CHECK_PROCESS (process
);
1108 return XPROCESS (process
)->sentinel
;
1111 DEFUN ("set-process-window-size", Fset_process_window_size
,
1112 Sset_process_window_size
, 3, 3, 0,
1113 doc
: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH. */)
1114 (Lisp_Object process
, Lisp_Object height
, Lisp_Object width
)
1116 CHECK_PROCESS (process
);
1118 if (NETCONN_P (process
))
1119 wait_for_socket_fds (process
, "set-process-window-size");
1121 /* All known platforms store window sizes as 'unsigned short'. */
1122 CHECK_RANGED_INTEGER (height
, 0, USHRT_MAX
);
1123 CHECK_RANGED_INTEGER (width
, 0, USHRT_MAX
);
1125 if (XPROCESS (process
)->infd
< 0
1126 || (set_window_size (XPROCESS (process
)->infd
,
1127 XINT (height
), XINT (width
))
1134 DEFUN ("set-process-inherit-coding-system-flag",
1135 Fset_process_inherit_coding_system_flag
,
1136 Sset_process_inherit_coding_system_flag
, 2, 2, 0,
1137 doc
: /* Determine whether buffer of PROCESS will inherit coding-system.
1138 If the second argument FLAG is non-nil, then the variable
1139 `buffer-file-coding-system' of the buffer associated with PROCESS
1140 will be bound to the value of the coding system used to decode
1143 This is useful when the coding system specified for the process buffer
1144 leaves either the character code conversion or the end-of-line conversion
1145 unspecified, or if the coding system used to decode the process output
1146 is more appropriate for saving the process buffer.
1148 Binding the variable `inherit-process-coding-system' to non-nil before
1149 starting the process is an alternative way of setting the inherit flag
1150 for the process which will run.
1152 This function returns FLAG. */)
1153 (register Lisp_Object process
, Lisp_Object flag
)
1155 CHECK_PROCESS (process
);
1156 XPROCESS (process
)->inherit_coding_system_flag
= !NILP (flag
);
1160 DEFUN ("set-process-query-on-exit-flag",
1161 Fset_process_query_on_exit_flag
, Sset_process_query_on_exit_flag
,
1163 doc
: /* Specify if query is needed for PROCESS when Emacs is exited.
1164 If the second argument FLAG is non-nil, Emacs will query the user before
1165 exiting or killing a buffer if PROCESS is running. This function
1167 (register Lisp_Object process
, Lisp_Object flag
)
1169 CHECK_PROCESS (process
);
1170 XPROCESS (process
)->kill_without_query
= NILP (flag
);
1174 DEFUN ("process-query-on-exit-flag",
1175 Fprocess_query_on_exit_flag
, Sprocess_query_on_exit_flag
,
1177 doc
: /* Return the current value of query-on-exit flag for PROCESS. */)
1178 (register Lisp_Object process
)
1180 CHECK_PROCESS (process
);
1181 return (XPROCESS (process
)->kill_without_query
? Qnil
: Qt
);
1184 DEFUN ("process-contact", Fprocess_contact
, Sprocess_contact
,
1186 doc
: /* Return the contact info of PROCESS; t for a real child.
1187 For a network or serial connection, the value depends on the optional
1188 KEY arg. If KEY is nil, value is a cons cell of the form (HOST
1189 SERVICE) for a network connection or (PORT SPEED) for a serial
1190 connection. If KEY is t, the complete contact information for the
1191 connection is returned, else the specific value for the keyword KEY is
1192 returned. See `make-network-process' or `make-serial-process' for a
1193 list of keywords. */)
1194 (register Lisp_Object process
, Lisp_Object key
)
1196 Lisp_Object contact
;
1198 CHECK_PROCESS (process
);
1199 contact
= XPROCESS (process
)->childp
;
1201 #ifdef DATAGRAM_SOCKETS
1203 if (NETCONN_P (process
))
1204 wait_for_socket_fds (process
, "process-contact");
1206 if (DATAGRAM_CONN_P (process
)
1207 && (EQ (key
, Qt
) || EQ (key
, QCremote
)))
1208 contact
= Fplist_put (contact
, QCremote
,
1209 Fprocess_datagram_address (process
));
1212 if ((!NETCONN_P (process
) && !SERIALCONN_P (process
) && !PIPECONN_P (process
))
1215 if (NILP (key
) && NETCONN_P (process
))
1216 return list2 (Fplist_get (contact
, QChost
),
1217 Fplist_get (contact
, QCservice
));
1218 if (NILP (key
) && SERIALCONN_P (process
))
1219 return list2 (Fplist_get (contact
, QCport
),
1220 Fplist_get (contact
, QCspeed
));
1221 /* FIXME: Return a meaningful value (e.g., the child end of the pipe)
1222 if the pipe process is useful for purposes other than receiving
1224 if (NILP (key
) && PIPECONN_P (process
))
1226 return Fplist_get (contact
, key
);
1229 DEFUN ("process-plist", Fprocess_plist
, Sprocess_plist
,
1231 doc
: /* Return the plist of PROCESS. */)
1232 (register Lisp_Object process
)
1234 CHECK_PROCESS (process
);
1235 return XPROCESS (process
)->plist
;
1238 DEFUN ("set-process-plist", Fset_process_plist
, Sset_process_plist
,
1240 doc
: /* Replace the plist of PROCESS with PLIST. Returns PLIST. */)
1241 (register Lisp_Object process
, Lisp_Object plist
)
1243 CHECK_PROCESS (process
);
1246 pset_plist (XPROCESS (process
), plist
);
1250 #if 0 /* Turned off because we don't currently record this info
1251 in the process. Perhaps add it. */
1252 DEFUN ("process-connection", Fprocess_connection
, Sprocess_connection
, 1, 1, 0,
1253 doc
: /* Return the connection type of PROCESS.
1254 The value is nil for a pipe, t or `pty' for a pty, or `stream' for
1255 a socket connection. */)
1256 (Lisp_Object process
)
1258 return XPROCESS (process
)->type
;
1262 DEFUN ("process-type", Fprocess_type
, Sprocess_type
, 1, 1, 0,
1263 doc
: /* Return the connection type of PROCESS.
1264 The value is either the symbol `real', `network', or `serial'.
1265 PROCESS may be a process, a buffer, the name of a process or buffer, or
1266 nil, indicating the current buffer's process. */)
1267 (Lisp_Object process
)
1270 proc
= get_process (process
);
1271 return XPROCESS (proc
)->type
;
1274 DEFUN ("format-network-address", Fformat_network_address
, Sformat_network_address
,
1276 doc
: /* Convert network ADDRESS from internal format to a string.
1277 A 4 or 5 element vector represents an IPv4 address (with port number).
1278 An 8 or 9 element vector represents an IPv6 address (with port number).
1279 If optional second argument OMIT-PORT is non-nil, don't include a port
1280 number in the string, even when present in ADDRESS.
1281 Returns nil if format of ADDRESS is invalid. */)
1282 (Lisp_Object address
, Lisp_Object omit_port
)
1287 if (STRINGP (address
)) /* AF_LOCAL */
1290 if (VECTORP (address
)) /* AF_INET or AF_INET6 */
1292 register struct Lisp_Vector
*p
= XVECTOR (address
);
1293 ptrdiff_t size
= p
->header
.size
;
1294 Lisp_Object args
[10];
1298 if (size
== 4 || (size
== 5 && !NILP (omit_port
)))
1300 format
= "%d.%d.%d.%d";
1305 format
= "%d.%d.%d.%d:%d";
1308 else if (size
== 8 || (size
== 9 && !NILP (omit_port
)))
1310 format
= "%x:%x:%x:%x:%x:%x:%x:%x";
1315 format
= "[%x:%x:%x:%x:%x:%x:%x:%x]:%d";
1321 AUTO_STRING (format_obj
, format
);
1322 args
[0] = format_obj
;
1324 for (i
= 0; i
< nargs
; i
++)
1326 if (! RANGED_INTEGERP (0, p
->contents
[i
], 65535))
1329 if (nargs
<= 5 /* IPv4 */
1330 && i
< 4 /* host, not port */
1331 && XINT (p
->contents
[i
]) > 255)
1334 args
[i
+ 1] = p
->contents
[i
];
1337 return Fformat (nargs
+ 1, args
);
1340 if (CONSP (address
))
1342 AUTO_STRING (format
, "<Family %d>");
1343 return CALLN (Fformat
, format
, Fcar (address
));
1349 DEFUN ("process-list", Fprocess_list
, Sprocess_list
, 0, 0, 0,
1350 doc
: /* Return a list of all processes that are Emacs sub-processes. */)
1353 return Fmapcar (Qcdr
, Vprocess_alist
);
1356 /* Starting asynchronous inferior processes. */
1358 static void start_process_unwind (Lisp_Object proc
);
1360 DEFUN ("make-process", Fmake_process
, Smake_process
, 0, MANY
, 0,
1361 doc
: /* Start a program in a subprocess. Return the process object for it.
1363 This is similar to `start-process', but arguments are specified as
1364 keyword/argument pairs. The following arguments are defined:
1366 :name NAME -- NAME is name for process. It is modified if necessary
1369 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
1370 with the process. Process output goes at end of that buffer, unless
1371 you specify an output stream or filter function to handle the output.
1372 BUFFER may be also nil, meaning that this process is not associated
1375 :command COMMAND -- COMMAND is a list starting with the program file
1376 name, followed by strings to give to the program as arguments.
1378 :coding CODING -- If CODING is a symbol, it specifies the coding
1379 system used for both reading and writing for this process. If CODING
1380 is a cons (DECODING . ENCODING), DECODING is used for reading, and
1381 ENCODING is used for writing.
1383 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
1384 the process is running. If BOOL is not given, query before exiting.
1386 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
1387 In the stopped state, a process does not accept incoming data, but you
1388 can send outgoing data. The stopped state is cleared by
1389 `continue-process' and set by `stop-process'.
1391 :connection-type TYPE -- TYPE is control type of device used to
1392 communicate with subprocesses. Values are `pipe' to use a pipe, `pty'
1393 to use a pty, or nil to use the default specified through
1394 `process-connection-type'.
1396 :filter FILTER -- Install FILTER as the process filter.
1398 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
1400 :stderr STDERR -- STDERR is either a buffer or a pipe process attached
1401 to the standard error of subprocess. Specifying this implies
1402 `:connection-type' is set to `pipe'.
1404 usage: (make-process &rest ARGS) */)
1405 (ptrdiff_t nargs
, Lisp_Object
*args
)
1407 Lisp_Object buffer
, name
, command
, program
, proc
, contact
, current_dir
, tem
;
1408 Lisp_Object xstderr
, stderrproc
;
1409 ptrdiff_t count
= SPECPDL_INDEX ();
1415 /* Save arguments for process-contact and clone-process. */
1416 contact
= Flist (nargs
, args
);
1418 buffer
= Fplist_get (contact
, QCbuffer
);
1420 buffer
= Fget_buffer_create (buffer
);
1422 /* Make sure that the child will be able to chdir to the current
1423 buffer's current directory, or its unhandled equivalent. We
1424 can't just have the child check for an error when it does the
1425 chdir, since it's in a vfork. */
1426 current_dir
= encode_current_directory ();
1428 name
= Fplist_get (contact
, QCname
);
1429 CHECK_STRING (name
);
1431 command
= Fplist_get (contact
, QCcommand
);
1432 if (CONSP (command
))
1433 program
= XCAR (command
);
1437 if (!NILP (program
))
1438 CHECK_STRING (program
);
1441 xstderr
= Fplist_get (contact
, QCstderr
);
1442 if (PROCESSP (xstderr
))
1444 if (!PIPECONN_P (xstderr
))
1445 error ("Process is not a pipe process");
1446 stderrproc
= xstderr
;
1448 else if (!NILP (xstderr
))
1450 CHECK_STRING (program
);
1451 stderrproc
= CALLN (Fmake_pipe_process
,
1453 concat2 (name
, build_string (" stderr")),
1455 Fget_buffer_create (xstderr
));
1458 proc
= make_process (name
);
1459 /* If an error occurs and we can't start the process, we want to
1460 remove it from the process list. This means that each error
1461 check in create_process doesn't need to call remove_process
1462 itself; it's all taken care of here. */
1463 record_unwind_protect (start_process_unwind
, proc
);
1465 pset_childp (XPROCESS (proc
), Qt
);
1466 pset_plist (XPROCESS (proc
), Qnil
);
1467 pset_type (XPROCESS (proc
), Qreal
);
1468 pset_buffer (XPROCESS (proc
), buffer
);
1469 pset_sentinel (XPROCESS (proc
), Fplist_get (contact
, QCsentinel
));
1470 pset_filter (XPROCESS (proc
), Fplist_get (contact
, QCfilter
));
1471 pset_command (XPROCESS (proc
), Fcopy_sequence (command
));
1473 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
1474 XPROCESS (proc
)->kill_without_query
= 1;
1475 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
1476 pset_command (XPROCESS (proc
), Qt
);
1478 tem
= Fplist_get (contact
, QCconnection_type
);
1480 XPROCESS (proc
)->pty_flag
= true;
1481 else if (EQ (tem
, Qpipe
))
1482 XPROCESS (proc
)->pty_flag
= false;
1483 else if (NILP (tem
))
1484 XPROCESS (proc
)->pty_flag
= !NILP (Vprocess_connection_type
);
1486 report_file_error ("Unknown connection type", tem
);
1488 if (!NILP (stderrproc
))
1490 pset_stderrproc (XPROCESS (proc
), stderrproc
);
1492 XPROCESS (proc
)->pty_flag
= false;
1496 /* AKA GNUTLS_INITSTAGE(proc). */
1497 XPROCESS (proc
)->gnutls_initstage
= GNUTLS_STAGE_EMPTY
;
1498 pset_gnutls_cred_type (XPROCESS (proc
), Qnil
);
1501 XPROCESS (proc
)->adaptive_read_buffering
1502 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
1503 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
1505 /* Make the process marker point into the process buffer (if any). */
1506 if (BUFFERP (buffer
))
1507 set_marker_both (XPROCESS (proc
)->mark
, buffer
,
1508 BUF_ZV (XBUFFER (buffer
)),
1509 BUF_ZV_BYTE (XBUFFER (buffer
)));
1512 /* Decide coding systems for communicating with the process. Here
1513 we don't setup the structure coding_system nor pay attention to
1514 unibyte mode. They are done in create_process. */
1516 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
1517 Lisp_Object coding_systems
= Qt
;
1518 Lisp_Object val
, *args2
;
1520 tem
= Fplist_get (contact
, QCcoding
);
1528 val
= Vcoding_system_for_read
;
1531 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1533 SAFE_ALLOCA_LISP (args2
, nargs2
);
1535 args2
[i
++] = Qstart_process
;
1537 args2
[i
++] = buffer
;
1538 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1539 args2
[i
++] = XCAR (tem2
);
1540 if (!NILP (program
))
1541 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1542 if (CONSP (coding_systems
))
1543 val
= XCAR (coding_systems
);
1544 else if (CONSP (Vdefault_process_coding_system
))
1545 val
= XCAR (Vdefault_process_coding_system
);
1547 pset_decode_coding_system (XPROCESS (proc
), val
);
1556 val
= Vcoding_system_for_write
;
1559 if (EQ (coding_systems
, Qt
))
1561 ptrdiff_t nargs2
= 3 + XINT (Flength (command
));
1563 SAFE_ALLOCA_LISP (args2
, nargs2
);
1565 args2
[i
++] = Qstart_process
;
1567 args2
[i
++] = buffer
;
1568 for (tem2
= command
; CONSP (tem2
); tem2
= XCDR (tem2
))
1569 args2
[i
++] = XCAR (tem2
);
1570 if (!NILP (program
))
1571 coding_systems
= Ffind_operation_coding_system (nargs2
, args2
);
1573 if (CONSP (coding_systems
))
1574 val
= XCDR (coding_systems
);
1575 else if (CONSP (Vdefault_process_coding_system
))
1576 val
= XCDR (Vdefault_process_coding_system
);
1578 pset_encode_coding_system (XPROCESS (proc
), val
);
1579 /* Note: At this moment, the above coding system may leave
1580 text-conversion or eol-conversion unspecified. They will be
1581 decided after we read output from the process and decode it by
1582 some coding system, or just before we actually send a text to
1587 pset_decoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1588 XPROCESS (proc
)->decoding_carryover
= 0;
1589 pset_encoding_buf (XPROCESS (proc
), empty_unibyte_string
);
1591 XPROCESS (proc
)->inherit_coding_system_flag
1592 = !(NILP (buffer
) || !inherit_process_coding_system
);
1594 if (!NILP (program
))
1596 Lisp_Object program_args
= XCDR (command
);
1598 /* If program file name is not absolute, search our path for it.
1599 Put the name we will really use in TEM. */
1600 if (!IS_DIRECTORY_SEP (SREF (program
, 0))
1601 && !(SCHARS (program
) > 1
1602 && IS_DEVICE_SEP (SREF (program
, 1))))
1605 openp (Vexec_path
, program
, Vexec_suffixes
, &tem
,
1606 make_number (X_OK
), false);
1608 report_file_error ("Searching for program", program
);
1609 tem
= Fexpand_file_name (tem
, Qnil
);
1613 if (!NILP (Ffile_directory_p (program
)))
1614 error ("Specified program for new process is a directory");
1618 /* Remove "/:" from TEM. */
1619 tem
= remove_slash_colon (tem
);
1621 Lisp_Object arg_encoding
= Qnil
;
1623 /* Encode the file name and put it in NEW_ARGV.
1624 That's where the child will use it to execute the program. */
1625 tem
= list1 (ENCODE_FILE (tem
));
1626 ptrdiff_t new_argc
= 1;
1628 /* Here we encode arguments by the coding system used for sending
1629 data to the process. We don't support using different coding
1630 systems for encoding arguments and for encoding data sent to the
1633 for (Lisp_Object tem2
= program_args
; CONSP (tem2
); tem2
= XCDR (tem2
))
1635 Lisp_Object arg
= XCAR (tem2
);
1637 if (STRING_MULTIBYTE (arg
))
1639 if (NILP (arg_encoding
))
1640 arg_encoding
= (complement_process_encoding_system
1641 (XPROCESS (proc
)->encode_coding_system
));
1642 arg
= code_convert_string_norecord (arg
, arg_encoding
, 1);
1644 tem
= Fcons (arg
, tem
);
1648 /* Now that everything is encoded we can collect the strings into
1651 SAFE_NALLOCA (new_argv
, 1, new_argc
+ 1);
1652 new_argv
[new_argc
] = 0;
1654 for (ptrdiff_t i
= new_argc
- 1; i
>= 0; i
--)
1656 new_argv
[i
] = SSDATA (XCAR (tem
));
1660 create_process (proc
, new_argv
, current_dir
);
1666 return unbind_to (count
, proc
);
1669 /* This function is the unwind_protect form for Fstart_process. If
1670 PROC doesn't have its pid set, then we know someone has signaled
1671 an error and the process wasn't started successfully, so we should
1672 remove it from the process list. */
1674 start_process_unwind (Lisp_Object proc
)
1676 if (!PROCESSP (proc
))
1679 /* Was PROC started successfully?
1680 -2 is used for a pty with no process, eg for gdb. */
1681 if (XPROCESS (proc
)->pid
<= 0 && XPROCESS (proc
)->pid
!= -2)
1682 remove_process (proc
);
1685 /* If *FD_ADDR is nonnegative, close it, and mark it as closed. */
1688 close_process_fd (int *fd_addr
)
1698 /* Indexes of file descriptors in open_fds. */
1701 /* The pipe from Emacs to its subprocess. */
1703 WRITE_TO_SUBPROCESS
,
1705 /* The main pipe from the subprocess to Emacs. */
1706 READ_FROM_SUBPROCESS
,
1709 /* The pipe from the subprocess to Emacs that is closed when the
1710 subprocess execs. */
1711 READ_FROM_EXEC_MONITOR
,
1715 verify (PROCESS_OPEN_FDS
== EXEC_MONITOR_OUTPUT
+ 1);
1718 create_process (Lisp_Object process
, char **new_argv
, Lisp_Object current_dir
)
1720 struct Lisp_Process
*p
= XPROCESS (process
);
1721 int inchannel
, outchannel
;
1724 int forkin
, forkout
, forkerr
= -1;
1726 char pty_name
[PTY_NAME_SIZE
];
1727 Lisp_Object lisp_pty_name
= Qnil
;
1730 inchannel
= outchannel
= -1;
1733 outchannel
= inchannel
= allocate_pty (pty_name
);
1737 p
->open_fd
[READ_FROM_SUBPROCESS
] = inchannel
;
1738 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
1739 /* On most USG systems it does not work to open the pty's tty here,
1740 then close it and reopen it in the child. */
1741 /* Don't let this terminal become our controlling terminal
1742 (in case we don't have one). */
1743 forkout
= forkin
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
1745 report_file_error ("Opening pty", Qnil
);
1746 p
->open_fd
[SUBPROCESS_STDIN
] = forkin
;
1748 forkin
= forkout
= -1;
1749 #endif /* not USG, or USG_SUBTTY_WORKS */
1751 lisp_pty_name
= build_string (pty_name
);
1755 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
1756 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
1757 report_file_error ("Creating pipe", Qnil
);
1758 forkin
= p
->open_fd
[SUBPROCESS_STDIN
];
1759 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
1760 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
1761 forkout
= p
->open_fd
[SUBPROCESS_STDOUT
];
1763 if (!NILP (p
->stderrproc
))
1765 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
1767 forkerr
= pp
->open_fd
[SUBPROCESS_STDOUT
];
1769 /* Close unnecessary file descriptors. */
1770 close_process_fd (&pp
->open_fd
[WRITE_TO_SUBPROCESS
]);
1771 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDIN
]);
1776 if (emacs_pipe (p
->open_fd
+ READ_FROM_EXEC_MONITOR
) != 0)
1777 report_file_error ("Creating pipe", Qnil
);
1780 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
1781 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
1783 /* Record this as an active process, with its channels. */
1784 chan_process
[inchannel
] = process
;
1785 p
->infd
= inchannel
;
1786 p
->outfd
= outchannel
;
1788 /* Previously we recorded the tty descriptor used in the subprocess.
1789 It was only used for getting the foreground tty process, so now
1790 we just reopen the device (see emacs_get_tty_pgrp) as this is
1791 more portable (see USG_SUBTTY_WORKS above). */
1793 p
->pty_flag
= pty_flag
;
1794 pset_status (p
, Qrun
);
1796 if (!EQ (p
->command
, Qt
))
1798 FD_SET (inchannel
, &input_wait_mask
);
1799 FD_SET (inchannel
, &non_keyboard_wait_mask
);
1802 if (inchannel
> max_process_desc
)
1803 max_process_desc
= inchannel
;
1805 /* This may signal an error. */
1806 setup_process_coding_systems (process
);
1809 block_child_signal (&oldset
);
1812 /* vfork, and prevent local vars from being clobbered by the vfork. */
1813 Lisp_Object
volatile current_dir_volatile
= current_dir
;
1814 Lisp_Object
volatile lisp_pty_name_volatile
= lisp_pty_name
;
1815 char **volatile new_argv_volatile
= new_argv
;
1816 int volatile forkin_volatile
= forkin
;
1817 int volatile forkout_volatile
= forkout
;
1818 int volatile forkerr_volatile
= forkerr
;
1819 struct Lisp_Process
*p_volatile
= p
;
1823 current_dir
= current_dir_volatile
;
1824 lisp_pty_name
= lisp_pty_name_volatile
;
1825 new_argv
= new_argv_volatile
;
1826 forkin
= forkin_volatile
;
1827 forkout
= forkout_volatile
;
1828 forkerr
= forkerr_volatile
;
1831 pty_flag
= p
->pty_flag
;
1834 #endif /* not WINDOWSNT */
1836 /* Make the pty be the controlling terminal of the process. */
1838 /* First, disconnect its current controlling terminal. */
1839 /* We tried doing setsid only if pty_flag, but it caused
1840 process_set_signal to fail on SGI when using a pipe. */
1842 /* Make the pty's terminal the controlling terminal. */
1843 if (pty_flag
&& forkin
>= 0)
1846 /* We ignore the return value
1847 because faith@cs.unc.edu says that is necessary on Linux. */
1848 ioctl (forkin
, TIOCSCTTY
, 0);
1851 #if defined (LDISC1)
1852 if (pty_flag
&& forkin
>= 0)
1855 tcgetattr (forkin
, &t
);
1857 if (tcsetattr (forkin
, TCSANOW
, &t
) < 0)
1858 emacs_perror ("create_process/tcsetattr LDISC1");
1861 #if defined (NTTYDISC) && defined (TIOCSETD)
1862 if (pty_flag
&& forkin
>= 0)
1864 /* Use new line discipline. */
1865 int ldisc
= NTTYDISC
;
1866 ioctl (forkin
, TIOCSETD
, &ldisc
);
1871 /* In 4.3BSD, the TIOCSPGRP bug has been fixed, and now you
1872 can do TIOCSPGRP only to the process's controlling tty. */
1875 /* I wonder: would just ioctl (0, TIOCNOTTY, 0) work here?
1876 I can't test it since I don't have 4.3. */
1877 int j
= emacs_open ("/dev/tty", O_RDWR
, 0);
1880 ioctl (j
, TIOCNOTTY
, 0);
1884 #endif /* TIOCNOTTY */
1886 #if !defined (DONT_REOPEN_PTY)
1887 /*** There is a suggestion that this ought to be a
1888 conditional on TIOCSPGRP, or !defined TIOCSCTTY.
1889 Trying the latter gave the wrong results on Debian GNU/Linux 1.1;
1890 that system does seem to need this code, even though
1891 both TIOCSCTTY is defined. */
1892 /* Now close the pty (if we had it open) and reopen it.
1893 This makes the pty the controlling terminal of the subprocess. */
1897 /* I wonder if emacs_close (emacs_open (SSDATA (lisp_pty_name), ...))
1900 emacs_close (forkin
);
1901 forkout
= forkin
= emacs_open (SSDATA (lisp_pty_name
), O_RDWR
, 0);
1905 emacs_perror (SSDATA (lisp_pty_name
));
1906 _exit (EXIT_CANCELED
);
1910 #endif /* not DONT_REOPEN_PTY */
1912 #ifdef SETUP_SLAVE_PTY
1917 #endif /* SETUP_SLAVE_PTY */
1918 #endif /* HAVE_PTYS */
1920 signal (SIGINT
, SIG_DFL
);
1921 signal (SIGQUIT
, SIG_DFL
);
1923 signal (SIGPROF
, SIG_DFL
);
1926 /* Emacs ignores SIGPIPE, but the child should not. */
1927 signal (SIGPIPE
, SIG_DFL
);
1929 /* Stop blocking SIGCHLD in the child. */
1930 unblock_child_signal (&oldset
);
1933 child_setup_tty (forkout
);
1938 pid
= child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
1939 #else /* not WINDOWSNT */
1940 child_setup (forkin
, forkout
, forkerr
, new_argv
, 1, current_dir
);
1941 #endif /* not WINDOWSNT */
1944 /* Back in the parent process. */
1946 vfork_errno
= errno
;
1951 /* Stop blocking in the parent. */
1952 unblock_child_signal (&oldset
);
1956 report_file_errno ("Doing vfork", Qnil
, vfork_errno
);
1959 /* vfork succeeded. */
1961 /* Close the pipe ends that the child uses, or the child's pty. */
1962 close_process_fd (&p
->open_fd
[SUBPROCESS_STDIN
]);
1963 close_process_fd (&p
->open_fd
[SUBPROCESS_STDOUT
]);
1966 register_child (pid
, inchannel
);
1967 #endif /* WINDOWSNT */
1969 pset_tty_name (p
, lisp_pty_name
);
1972 /* Wait for child_setup to complete in case that vfork is
1973 actually defined as fork. The descriptor
1974 XPROCESS (proc)->open_fd[EXEC_MONITOR_OUTPUT]
1975 of a pipe is closed at the child side either by close-on-exec
1976 on successful execve or the _exit call in child_setup. */
1980 close_process_fd (&p
->open_fd
[EXEC_MONITOR_OUTPUT
]);
1981 emacs_read (p
->open_fd
[READ_FROM_EXEC_MONITOR
], &dummy
, 1);
1982 close_process_fd (&p
->open_fd
[READ_FROM_EXEC_MONITOR
]);
1985 if (!NILP (p
->stderrproc
))
1987 struct Lisp_Process
*pp
= XPROCESS (p
->stderrproc
);
1988 close_process_fd (&pp
->open_fd
[SUBPROCESS_STDOUT
]);
1994 create_pty (Lisp_Object process
)
1996 struct Lisp_Process
*p
= XPROCESS (process
);
1997 char pty_name
[PTY_NAME_SIZE
];
1998 int pty_fd
= !p
->pty_flag
? -1 : allocate_pty (pty_name
);
2002 p
->open_fd
[SUBPROCESS_STDIN
] = pty_fd
;
2003 #if ! defined (USG) || defined (USG_SUBTTY_WORKS)
2004 /* On most USG systems it does not work to open the pty's tty here,
2005 then close it and reopen it in the child. */
2006 /* Don't let this terminal become our controlling terminal
2007 (in case we don't have one). */
2008 int forkout
= emacs_open (pty_name
, O_RDWR
| O_NOCTTY
, 0);
2010 report_file_error ("Opening pty", Qnil
);
2011 p
->open_fd
[WRITE_TO_SUBPROCESS
] = forkout
;
2012 #if defined (DONT_REOPEN_PTY)
2013 /* In the case that vfork is defined as fork, the parent process
2014 (Emacs) may send some data before the child process completes
2015 tty options setup. So we setup tty before forking. */
2016 child_setup_tty (forkout
);
2017 #endif /* DONT_REOPEN_PTY */
2018 #endif /* not USG, or USG_SUBTTY_WORKS */
2020 fcntl (pty_fd
, F_SETFL
, O_NONBLOCK
);
2022 /* Record this as an active process, with its channels.
2023 As a result, child_setup will close Emacs's side of the pipes. */
2024 chan_process
[pty_fd
] = process
;
2028 /* Previously we recorded the tty descriptor used in the subprocess.
2029 It was only used for getting the foreground tty process, so now
2030 we just reopen the device (see emacs_get_tty_pgrp) as this is
2031 more portable (see USG_SUBTTY_WORKS above). */
2034 pset_status (p
, Qrun
);
2035 setup_process_coding_systems (process
);
2037 FD_SET (pty_fd
, &input_wait_mask
);
2038 FD_SET (pty_fd
, &non_keyboard_wait_mask
);
2039 if (pty_fd
> max_process_desc
)
2040 max_process_desc
= pty_fd
;
2042 pset_tty_name (p
, build_string (pty_name
));
2048 DEFUN ("make-pipe-process", Fmake_pipe_process
, Smake_pipe_process
,
2050 doc
: /* Create and return a bidirectional pipe process.
2052 In Emacs, pipes are represented by process objects, so input and
2053 output work as for subprocesses, and `delete-process' closes a pipe.
2054 However, a pipe process has no process id, it cannot be signaled,
2055 and the status codes are different from normal processes.
2057 Arguments are specified as keyword/argument pairs. The following
2058 arguments are defined:
2060 :name NAME -- NAME is the name of the process. It is modified if necessary to make it unique.
2062 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2063 with the process. Process output goes at the end of that buffer,
2064 unless you specify an output stream or filter function to handle the
2065 output. If BUFFER is not given, the value of NAME is used.
2067 :coding CODING -- If CODING is a symbol, it specifies the coding
2068 system used for both reading and writing for this process. If CODING
2069 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2070 ENCODING is used for writing.
2072 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2073 the process is running. If BOOL is not given, query before exiting.
2075 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
2076 In the stopped state, a pipe process does not accept incoming data,
2077 but you can send outgoing data. The stopped state is cleared by
2078 `continue-process' and set by `stop-process'.
2080 :filter FILTER -- Install FILTER as the process filter.
2082 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2084 usage: (make-pipe-process &rest ARGS) */)
2085 (ptrdiff_t nargs
, Lisp_Object
*args
)
2087 Lisp_Object proc
, contact
;
2088 struct Lisp_Process
*p
;
2089 Lisp_Object name
, buffer
;
2091 ptrdiff_t specpdl_count
;
2092 int inchannel
, outchannel
;
2097 contact
= Flist (nargs
, args
);
2099 name
= Fplist_get (contact
, QCname
);
2100 CHECK_STRING (name
);
2101 proc
= make_process (name
);
2102 specpdl_count
= SPECPDL_INDEX ();
2103 record_unwind_protect (remove_process
, proc
);
2104 p
= XPROCESS (proc
);
2106 if (emacs_pipe (p
->open_fd
+ SUBPROCESS_STDIN
) != 0
2107 || emacs_pipe (p
->open_fd
+ READ_FROM_SUBPROCESS
) != 0)
2108 report_file_error ("Creating pipe", Qnil
);
2109 outchannel
= p
->open_fd
[WRITE_TO_SUBPROCESS
];
2110 inchannel
= p
->open_fd
[READ_FROM_SUBPROCESS
];
2112 fcntl (inchannel
, F_SETFL
, O_NONBLOCK
);
2113 fcntl (outchannel
, F_SETFL
, O_NONBLOCK
);
2116 register_aux_fd (inchannel
);
2119 /* Record this as an active process, with its channels. */
2120 chan_process
[inchannel
] = proc
;
2121 p
->infd
= inchannel
;
2122 p
->outfd
= outchannel
;
2124 if (inchannel
> max_process_desc
)
2125 max_process_desc
= inchannel
;
2127 buffer
= Fplist_get (contact
, QCbuffer
);
2130 buffer
= Fget_buffer_create (buffer
);
2131 pset_buffer (p
, buffer
);
2133 pset_childp (p
, contact
);
2134 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2135 pset_type (p
, Qpipe
);
2136 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2137 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2139 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2140 p
->kill_without_query
= 1;
2141 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2142 pset_command (p
, Qt
);
2143 eassert (! p
->pty_flag
);
2145 if (!EQ (p
->command
, Qt
))
2147 FD_SET (inchannel
, &input_wait_mask
);
2148 FD_SET (inchannel
, &non_keyboard_wait_mask
);
2150 p
->adaptive_read_buffering
2151 = (NILP (Vprocess_adaptive_read_buffering
) ? 0
2152 : EQ (Vprocess_adaptive_read_buffering
, Qt
) ? 1 : 2);
2154 /* Make the process marker point into the process buffer (if any). */
2155 if (BUFFERP (buffer
))
2156 set_marker_both (p
->mark
, buffer
,
2157 BUF_ZV (XBUFFER (buffer
)),
2158 BUF_ZV_BYTE (XBUFFER (buffer
)));
2161 /* Setup coding systems for communicating with the network stream. */
2163 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2164 Lisp_Object coding_systems
= Qt
;
2167 tem
= Fplist_get (contact
, QCcoding
);
2175 else if (!NILP (Vcoding_system_for_read
))
2176 val
= Vcoding_system_for_read
;
2177 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2178 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2179 /* We dare not decode end-of-line format by setting VAL to
2180 Qraw_text, because the existing Emacs Lisp libraries
2181 assume that they receive bare code including a sequence of
2186 if (CONSP (coding_systems
))
2187 val
= XCAR (coding_systems
);
2188 else if (CONSP (Vdefault_process_coding_system
))
2189 val
= XCAR (Vdefault_process_coding_system
);
2193 pset_decode_coding_system (p
, val
);
2201 else if (!NILP (Vcoding_system_for_write
))
2202 val
= Vcoding_system_for_write
;
2203 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2207 if (CONSP (coding_systems
))
2208 val
= XCDR (coding_systems
);
2209 else if (CONSP (Vdefault_process_coding_system
))
2210 val
= XCDR (Vdefault_process_coding_system
);
2214 pset_encode_coding_system (p
, val
);
2216 /* This may signal an error. */
2217 setup_process_coding_systems (proc
);
2219 specpdl_ptr
= specpdl
+ specpdl_count
;
2225 /* Convert an internal struct sockaddr to a lisp object (vector or string).
2226 The address family of sa is not included in the result. */
2229 conv_sockaddr_to_lisp (struct sockaddr
*sa
, int len
)
2231 Lisp_Object address
;
2234 register struct Lisp_Vector
*p
;
2236 /* Workaround for a bug in getsockname on BSD: Names bound to
2237 sockets in the UNIX domain are inaccessible; getsockname returns
2238 a zero length name. */
2239 if (len
< offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
))
2240 return empty_unibyte_string
;
2242 switch (sa
->sa_family
)
2246 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2247 len
= sizeof (sin
->sin_addr
) + 1;
2248 address
= Fmake_vector (make_number (len
), Qnil
);
2249 p
= XVECTOR (address
);
2250 p
->contents
[--len
] = make_number (ntohs (sin
->sin_port
));
2251 cp
= (unsigned char *) &sin
->sin_addr
;
2257 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2258 uint16_t *ip6
= (uint16_t *) &sin6
->sin6_addr
;
2259 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2260 address
= Fmake_vector (make_number (len
), Qnil
);
2261 p
= XVECTOR (address
);
2262 p
->contents
[--len
] = make_number (ntohs (sin6
->sin6_port
));
2263 for (i
= 0; i
< len
; i
++)
2264 p
->contents
[i
] = make_number (ntohs (ip6
[i
]));
2268 #ifdef HAVE_LOCAL_SOCKETS
2271 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2272 ptrdiff_t name_length
= len
- offsetof (struct sockaddr_un
, sun_path
);
2273 /* If the first byte is NUL, the name is a Linux abstract
2274 socket name, and the name can contain embedded NULs. If
2275 it's not, we have a NUL-terminated string. Be careful not
2276 to walk past the end of the object looking for the name
2277 terminator, however. */
2278 if (name_length
> 0 && sockun
->sun_path
[0] != '\0')
2280 const char *terminator
2281 = memchr (sockun
->sun_path
, '\0', name_length
);
2284 name_length
= terminator
- (const char *) sockun
->sun_path
;
2287 return make_unibyte_string (sockun
->sun_path
, name_length
);
2291 len
-= offsetof (struct sockaddr
, sa_family
) + sizeof (sa
->sa_family
);
2292 address
= Fcons (make_number (sa
->sa_family
),
2293 Fmake_vector (make_number (len
), Qnil
));
2294 p
= XVECTOR (XCDR (address
));
2295 cp
= (unsigned char *) &sa
->sa_family
+ sizeof (sa
->sa_family
);
2301 p
->contents
[i
++] = make_number (*cp
++);
2307 /* Get family and required size for sockaddr structure to hold ADDRESS. */
2310 get_lisp_to_sockaddr_size (Lisp_Object address
, int *familyp
)
2312 register struct Lisp_Vector
*p
;
2314 if (VECTORP (address
))
2316 p
= XVECTOR (address
);
2317 if (p
->header
.size
== 5)
2320 return sizeof (struct sockaddr_in
);
2323 else if (p
->header
.size
== 9)
2325 *familyp
= AF_INET6
;
2326 return sizeof (struct sockaddr_in6
);
2330 #ifdef HAVE_LOCAL_SOCKETS
2331 else if (STRINGP (address
))
2333 *familyp
= AF_LOCAL
;
2334 return sizeof (struct sockaddr_un
);
2337 else if (CONSP (address
) && TYPE_RANGED_INTEGERP (int, XCAR (address
))
2338 && VECTORP (XCDR (address
)))
2340 struct sockaddr
*sa
;
2341 p
= XVECTOR (XCDR (address
));
2342 if (MAX_ALLOCA
- sizeof sa
->sa_family
< p
->header
.size
)
2344 *familyp
= XINT (XCAR (address
));
2345 return p
->header
.size
+ sizeof (sa
->sa_family
);
2350 /* Convert an address object (vector or string) to an internal sockaddr.
2352 The address format has been basically validated by
2353 get_lisp_to_sockaddr_size, but this does not mean FAMILY is valid;
2354 it could have come from user data. So if FAMILY is not valid,
2355 we return after zeroing *SA. */
2358 conv_lisp_to_sockaddr (int family
, Lisp_Object address
, struct sockaddr
*sa
, int len
)
2360 register struct Lisp_Vector
*p
;
2361 register unsigned char *cp
= NULL
;
2365 memset (sa
, 0, len
);
2367 if (VECTORP (address
))
2369 p
= XVECTOR (address
);
2370 if (family
== AF_INET
)
2372 struct sockaddr_in
*sin
= (struct sockaddr_in
*) sa
;
2373 len
= sizeof (sin
->sin_addr
) + 1;
2374 hostport
= XINT (p
->contents
[--len
]);
2375 sin
->sin_port
= htons (hostport
);
2376 cp
= (unsigned char *)&sin
->sin_addr
;
2377 sa
->sa_family
= family
;
2380 else if (family
== AF_INET6
)
2382 struct sockaddr_in6
*sin6
= (struct sockaddr_in6
*) sa
;
2383 uint16_t *ip6
= (uint16_t *)&sin6
->sin6_addr
;
2384 len
= sizeof (sin6
->sin6_addr
) / 2 + 1;
2385 hostport
= XINT (p
->contents
[--len
]);
2386 sin6
->sin6_port
= htons (hostport
);
2387 for (i
= 0; i
< len
; i
++)
2388 if (INTEGERP (p
->contents
[i
]))
2390 int j
= XFASTINT (p
->contents
[i
]) & 0xffff;
2393 sa
->sa_family
= family
;
2400 else if (STRINGP (address
))
2402 #ifdef HAVE_LOCAL_SOCKETS
2403 if (family
== AF_LOCAL
)
2405 struct sockaddr_un
*sockun
= (struct sockaddr_un
*) sa
;
2406 cp
= SDATA (address
);
2407 for (i
= 0; i
< sizeof (sockun
->sun_path
) && *cp
; i
++)
2408 sockun
->sun_path
[i
] = *cp
++;
2409 sa
->sa_family
= family
;
2416 p
= XVECTOR (XCDR (address
));
2417 cp
= (unsigned char *)sa
+ sizeof (sa
->sa_family
);
2420 for (i
= 0; i
< len
; i
++)
2421 if (INTEGERP (p
->contents
[i
]))
2422 *cp
++ = XFASTINT (p
->contents
[i
]) & 0xff;
2425 #ifdef DATAGRAM_SOCKETS
2426 DEFUN ("process-datagram-address", Fprocess_datagram_address
, Sprocess_datagram_address
,
2428 doc
: /* Get the current datagram address associated with PROCESS. */)
2429 (Lisp_Object process
)
2433 CHECK_PROCESS (process
);
2435 if (NETCONN_P (process
))
2436 wait_for_socket_fds (process
, "process-datagram-address");
2438 if (!DATAGRAM_CONN_P (process
))
2441 channel
= XPROCESS (process
)->infd
;
2442 return conv_sockaddr_to_lisp (datagram_address
[channel
].sa
,
2443 datagram_address
[channel
].len
);
2446 DEFUN ("set-process-datagram-address", Fset_process_datagram_address
, Sset_process_datagram_address
,
2448 doc
: /* Set the datagram address for PROCESS to ADDRESS.
2449 Returns nil upon error setting address, ADDRESS otherwise. */)
2450 (Lisp_Object process
, Lisp_Object address
)
2455 CHECK_PROCESS (process
);
2457 if (NETCONN_P (process
))
2458 wait_for_socket_fds (process
, "set-process-datagram-address");
2460 if (!DATAGRAM_CONN_P (process
))
2463 channel
= XPROCESS (process
)->infd
;
2465 len
= get_lisp_to_sockaddr_size (address
, &family
);
2466 if (len
== 0 || datagram_address
[channel
].len
!= len
)
2468 conv_lisp_to_sockaddr (family
, address
, datagram_address
[channel
].sa
, len
);
2474 static const struct socket_options
{
2475 /* The name of this option. Should be lowercase version of option
2476 name without SO_ prefix. */
2478 /* Option level SOL_... */
2480 /* Option number SO_... */
2482 enum { SOPT_UNKNOWN
, SOPT_BOOL
, SOPT_INT
, SOPT_IFNAME
, SOPT_LINGER
} opttype
;
2483 enum { OPIX_NONE
= 0, OPIX_MISC
= 1, OPIX_REUSEADDR
= 2 } optbit
;
2484 } socket_options
[] =
2486 #ifdef SO_BINDTODEVICE
2487 { ":bindtodevice", SOL_SOCKET
, SO_BINDTODEVICE
, SOPT_IFNAME
, OPIX_MISC
},
2490 { ":broadcast", SOL_SOCKET
, SO_BROADCAST
, SOPT_BOOL
, OPIX_MISC
},
2493 { ":dontroute", SOL_SOCKET
, SO_DONTROUTE
, SOPT_BOOL
, OPIX_MISC
},
2496 { ":keepalive", SOL_SOCKET
, SO_KEEPALIVE
, SOPT_BOOL
, OPIX_MISC
},
2499 { ":linger", SOL_SOCKET
, SO_LINGER
, SOPT_LINGER
, OPIX_MISC
},
2502 { ":oobinline", SOL_SOCKET
, SO_OOBINLINE
, SOPT_BOOL
, OPIX_MISC
},
2505 { ":priority", SOL_SOCKET
, SO_PRIORITY
, SOPT_INT
, OPIX_MISC
},
2508 { ":reuseaddr", SOL_SOCKET
, SO_REUSEADDR
, SOPT_BOOL
, OPIX_REUSEADDR
},
2510 { 0, 0, 0, SOPT_UNKNOWN
, OPIX_NONE
}
2513 /* Set option OPT to value VAL on socket S.
2515 Returns (1<<socket_options[OPT].optbit) if option is known, 0 otherwise.
2516 Signals an error if setting a known option fails.
2520 set_socket_option (int s
, Lisp_Object opt
, Lisp_Object val
)
2523 const struct socket_options
*sopt
;
2528 name
= SSDATA (SYMBOL_NAME (opt
));
2529 for (sopt
= socket_options
; sopt
->name
; sopt
++)
2530 if (strcmp (name
, sopt
->name
) == 0)
2533 switch (sopt
->opttype
)
2538 optval
= NILP (val
) ? 0 : 1;
2539 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2540 &optval
, sizeof (optval
));
2547 if (TYPE_RANGED_INTEGERP (int, val
))
2548 optval
= XINT (val
);
2550 error ("Bad option value for %s", name
);
2551 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2552 &optval
, sizeof (optval
));
2556 #ifdef SO_BINDTODEVICE
2559 char devname
[IFNAMSIZ
+ 1];
2561 /* This is broken, at least in the Linux 2.4 kernel.
2562 To unbind, the arg must be a zero integer, not the empty string.
2563 This should work on all systems. KFS. 2003-09-23. */
2564 memset (devname
, 0, sizeof devname
);
2567 char *arg
= SSDATA (val
);
2568 int len
= min (strlen (arg
), IFNAMSIZ
);
2569 memcpy (devname
, arg
, len
);
2571 else if (!NILP (val
))
2572 error ("Bad option value for %s", name
);
2573 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2582 struct linger linger
;
2585 linger
.l_linger
= 0;
2586 if (TYPE_RANGED_INTEGERP (int, val
))
2587 linger
.l_linger
= XINT (val
);
2589 linger
.l_onoff
= NILP (val
) ? 0 : 1;
2590 ret
= setsockopt (s
, sopt
->optlevel
, sopt
->optnum
,
2591 &linger
, sizeof (linger
));
2602 int setsockopt_errno
= errno
;
2603 report_file_errno ("Cannot set network option", list2 (opt
, val
),
2607 return (1 << sopt
->optbit
);
2611 DEFUN ("set-network-process-option",
2612 Fset_network_process_option
, Sset_network_process_option
,
2614 doc
: /* For network process PROCESS set option OPTION to value VALUE.
2615 See `make-network-process' for a list of options and values.
2616 If optional fourth arg NO-ERROR is non-nil, don't signal an error if
2617 OPTION is not a supported option, return nil instead; otherwise return t. */)
2618 (Lisp_Object process
, Lisp_Object option
, Lisp_Object value
, Lisp_Object no_error
)
2621 struct Lisp_Process
*p
;
2623 CHECK_PROCESS (process
);
2624 p
= XPROCESS (process
);
2625 if (!NETCONN1_P (p
))
2626 error ("Process is not a network process");
2628 wait_for_socket_fds (process
, "set-network-process-option");
2632 error ("Process is not running");
2634 if (set_socket_option (s
, option
, value
))
2636 pset_childp (p
, Fplist_put (p
->childp
, option
, value
));
2640 if (NILP (no_error
))
2641 error ("Unknown or unsupported option");
2647 DEFUN ("serial-process-configure",
2648 Fserial_process_configure
,
2649 Sserial_process_configure
,
2651 doc
: /* Configure speed, bytesize, etc. of a serial process.
2653 Arguments are specified as keyword/argument pairs. Attributes that
2654 are not given are re-initialized from the process's current
2655 configuration (available via the function `process-contact') or set to
2656 reasonable default values. The following arguments are defined:
2662 -- Any of these arguments can be given to identify the process that is
2663 to be configured. If none of these arguments is given, the current
2664 buffer's process is used.
2666 :speed SPEED -- SPEED is the speed of the serial port in bits per
2667 second, also called baud rate. Any value can be given for SPEED, but
2668 most serial ports work only at a few defined values between 1200 and
2669 115200, with 9600 being the most common value. If SPEED is nil, the
2670 serial port is not configured any further, i.e., all other arguments
2671 are ignored. This may be useful for special serial ports such as
2672 Bluetooth-to-serial converters which can only be configured through AT
2673 commands. A value of nil for SPEED can be used only when passed
2674 through `make-serial-process' or `serial-term'.
2676 :bytesize BYTESIZE -- BYTESIZE is the number of bits per byte, which
2677 can be 7 or 8. If BYTESIZE is not given or nil, a value of 8 is used.
2679 :parity PARITY -- PARITY can be nil (don't use parity), the symbol
2680 `odd' (use odd parity), or the symbol `even' (use even parity). If
2681 PARITY is not given, no parity is used.
2683 :stopbits STOPBITS -- STOPBITS is the number of stopbits used to
2684 terminate a byte transmission. STOPBITS can be 1 or 2. If STOPBITS
2685 is not given or nil, 1 stopbit is used.
2687 :flowcontrol FLOWCONTROL -- FLOWCONTROL determines the type of
2688 flowcontrol to be used, which is either nil (don't use flowcontrol),
2689 the symbol `hw' (use RTS/CTS hardware flowcontrol), or the symbol `sw'
2690 (use XON/XOFF software flowcontrol). If FLOWCONTROL is not given, no
2691 flowcontrol is used.
2693 `serial-process-configure' is called by `make-serial-process' for the
2694 initial configuration of the serial port.
2698 (serial-process-configure :process "/dev/ttyS0" :speed 1200)
2700 (serial-process-configure
2701 :buffer "COM1" :stopbits 1 :parity \\='odd :flowcontrol \\='hw)
2703 (serial-process-configure :port "\\\\.\\COM13" :bytesize 7)
2705 usage: (serial-process-configure &rest ARGS) */)
2706 (ptrdiff_t nargs
, Lisp_Object
*args
)
2708 struct Lisp_Process
*p
;
2709 Lisp_Object contact
= Qnil
;
2710 Lisp_Object proc
= Qnil
;
2712 contact
= Flist (nargs
, args
);
2714 proc
= Fplist_get (contact
, QCprocess
);
2716 proc
= Fplist_get (contact
, QCname
);
2718 proc
= Fplist_get (contact
, QCbuffer
);
2720 proc
= Fplist_get (contact
, QCport
);
2721 proc
= get_process (proc
);
2722 p
= XPROCESS (proc
);
2723 if (!EQ (p
->type
, Qserial
))
2724 error ("Not a serial process");
2726 if (NILP (Fplist_get (p
->childp
, QCspeed
)))
2729 serial_configure (p
, contact
);
2733 DEFUN ("make-serial-process", Fmake_serial_process
, Smake_serial_process
,
2735 doc
: /* Create and return a serial port process.
2737 In Emacs, serial port connections are represented by process objects,
2738 so input and output work as for subprocesses, and `delete-process'
2739 closes a serial port connection. However, a serial process has no
2740 process id, it cannot be signaled, and the status codes are different
2741 from normal processes.
2743 `make-serial-process' creates a process and a buffer, on which you
2744 probably want to use `process-send-string'. Try \\[serial-term] for
2745 an interactive terminal. See below for examples.
2747 Arguments are specified as keyword/argument pairs. The following
2748 arguments are defined:
2750 :port PORT -- (mandatory) PORT is the path or name of the serial port.
2751 For example, this could be "/dev/ttyS0" on Unix. On Windows, this
2752 could be "COM1", or "\\\\.\\COM10" for ports higher than COM9 (double
2753 the backslashes in strings).
2755 :speed SPEED -- (mandatory) is handled by `serial-process-configure',
2756 which this function calls.
2758 :name NAME -- NAME is the name of the process. If NAME is not given,
2759 the value of PORT is used.
2761 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
2762 with the process. Process output goes at the end of that buffer,
2763 unless you specify an output stream or filter function to handle the
2764 output. If BUFFER is not given, the value of NAME is used.
2766 :coding CODING -- If CODING is a symbol, it specifies the coding
2767 system used for both reading and writing for this process. If CODING
2768 is a cons (DECODING . ENCODING), DECODING is used for reading, and
2769 ENCODING is used for writing.
2771 :noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and
2772 the process is running. If BOOL is not given, query before exiting.
2774 :stop BOOL -- Start process in the `stopped' state if BOOL is non-nil.
2775 In the stopped state, a serial process does not accept incoming data,
2776 but you can send outgoing data. The stopped state is cleared by
2777 `continue-process' and set by `stop-process'.
2779 :filter FILTER -- Install FILTER as the process filter.
2781 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
2783 :plist PLIST -- Install PLIST as the initial plist of the process.
2789 -- This function calls `serial-process-configure' to handle these
2792 The original argument list, possibly modified by later configuration,
2793 is available via the function `process-contact'.
2797 (make-serial-process :port "/dev/ttyS0" :speed 9600)
2799 (make-serial-process :port "COM1" :speed 115200 :stopbits 2)
2801 (make-serial-process :port "\\\\.\\COM13" :speed 1200 :bytesize 7 :parity \\='odd)
2803 (make-serial-process :port "/dev/tty.BlueConsole-SPP-1" :speed nil)
2805 usage: (make-serial-process &rest ARGS) */)
2806 (ptrdiff_t nargs
, Lisp_Object
*args
)
2809 Lisp_Object proc
, contact
, port
;
2810 struct Lisp_Process
*p
;
2811 Lisp_Object name
, buffer
;
2812 Lisp_Object tem
, val
;
2813 ptrdiff_t specpdl_count
;
2818 contact
= Flist (nargs
, args
);
2820 port
= Fplist_get (contact
, QCport
);
2822 error ("No port specified");
2823 CHECK_STRING (port
);
2825 if (NILP (Fplist_member (contact
, QCspeed
)))
2826 error (":speed not specified");
2827 if (!NILP (Fplist_get (contact
, QCspeed
)))
2828 CHECK_NUMBER (Fplist_get (contact
, QCspeed
));
2830 name
= Fplist_get (contact
, QCname
);
2833 CHECK_STRING (name
);
2834 proc
= make_process (name
);
2835 specpdl_count
= SPECPDL_INDEX ();
2836 record_unwind_protect (remove_process
, proc
);
2837 p
= XPROCESS (proc
);
2839 fd
= serial_open (port
);
2840 p
->open_fd
[SUBPROCESS_STDIN
] = fd
;
2843 if (fd
> max_process_desc
)
2844 max_process_desc
= fd
;
2845 chan_process
[fd
] = proc
;
2847 buffer
= Fplist_get (contact
, QCbuffer
);
2850 buffer
= Fget_buffer_create (buffer
);
2851 pset_buffer (p
, buffer
);
2853 pset_childp (p
, contact
);
2854 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
2855 pset_type (p
, Qserial
);
2856 pset_sentinel (p
, Fplist_get (contact
, QCsentinel
));
2857 pset_filter (p
, Fplist_get (contact
, QCfilter
));
2859 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
2860 p
->kill_without_query
= 1;
2861 if (tem
= Fplist_get (contact
, QCstop
), !NILP (tem
))
2862 pset_command (p
, Qt
);
2863 eassert (! p
->pty_flag
);
2865 if (!EQ (p
->command
, Qt
))
2867 FD_SET (fd
, &input_wait_mask
);
2868 FD_SET (fd
, &non_keyboard_wait_mask
);
2871 if (BUFFERP (buffer
))
2873 set_marker_both (p
->mark
, buffer
,
2874 BUF_ZV (XBUFFER (buffer
)),
2875 BUF_ZV_BYTE (XBUFFER (buffer
)));
2878 tem
= Fplist_member (contact
, QCcoding
);
2879 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2885 val
= XCAR (XCDR (tem
));
2889 else if (!NILP (Vcoding_system_for_read
))
2890 val
= Vcoding_system_for_read
;
2891 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2892 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2894 pset_decode_coding_system (p
, val
);
2899 val
= XCAR (XCDR (tem
));
2903 else if (!NILP (Vcoding_system_for_write
))
2904 val
= Vcoding_system_for_write
;
2905 else if ((!NILP (buffer
) && NILP (BVAR (XBUFFER (buffer
), enable_multibyte_characters
)))
2906 || (NILP (buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2908 pset_encode_coding_system (p
, val
);
2910 setup_process_coding_systems (proc
);
2911 pset_decoding_buf (p
, empty_unibyte_string
);
2912 p
->decoding_carryover
= 0;
2913 pset_encoding_buf (p
, empty_unibyte_string
);
2914 p
->inherit_coding_system_flag
2915 = !(!NILP (tem
) || NILP (buffer
) || !inherit_process_coding_system
);
2917 Fserial_process_configure (nargs
, args
);
2919 specpdl_ptr
= specpdl
+ specpdl_count
;
2924 void set_network_socket_coding_system (Lisp_Object proc
)
2927 struct Lisp_Process
*p
= XPROCESS (proc
);
2928 Lisp_Object contact
= p
->childp
;
2929 Lisp_Object service
, host
, name
;
2930 Lisp_Object coding_systems
= Qt
;
2933 service
= Fplist_get (contact
, QCservice
);
2934 host
= Fplist_get (contact
, QChost
);
2935 name
= Fplist_get (contact
, QCname
);
2937 tem
= Fplist_member (contact
, QCcoding
);
2938 if (!NILP (tem
) && (!CONSP (tem
) || !CONSP (XCDR (tem
))))
2939 tem
= Qnil
; /* No error message (too late!). */
2941 /* Setup coding systems for communicating with the network stream. */
2942 /* Qt denotes we have not yet called Ffind_operation_coding_system. */
2946 val
= XCAR (XCDR (tem
));
2950 else if (!NILP (Vcoding_system_for_read
))
2951 val
= Vcoding_system_for_read
;
2952 else if ((!NILP (p
->buffer
) &&
2953 NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
2954 || (NILP (p
->buffer
) && NILP (BVAR (&buffer_defaults
, enable_multibyte_characters
))))
2955 /* We dare not decode end-of-line format by setting VAL to
2956 Qraw_text, because the existing Emacs Lisp libraries
2957 assume that they receive bare code including a sequence of
2962 if (NILP (host
) || NILP (service
))
2963 coding_systems
= Qnil
;
2965 coding_systems
= CALLN (Ffind_operation_coding_system
,
2966 Qopen_network_stream
, name
, p
->buffer
,
2968 if (CONSP (coding_systems
))
2969 val
= XCAR (coding_systems
);
2970 else if (CONSP (Vdefault_process_coding_system
))
2971 val
= XCAR (Vdefault_process_coding_system
);
2975 pset_decode_coding_system (p
, val
);
2979 val
= XCAR (XCDR (tem
));
2983 else if (!NILP (Vcoding_system_for_write
))
2984 val
= Vcoding_system_for_write
;
2985 else if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
2989 if (EQ (coding_systems
, Qt
))
2991 if (NILP (host
) || NILP (service
))
2992 coding_systems
= Qnil
;
2994 coding_systems
= CALLN (Ffind_operation_coding_system
,
2995 Qopen_network_stream
, name
, p
->buffer
,
2998 if (CONSP (coding_systems
))
2999 val
= XCDR (coding_systems
);
3000 else if (CONSP (Vdefault_process_coding_system
))
3001 val
= XCDR (Vdefault_process_coding_system
);
3005 pset_encode_coding_system (p
, val
);
3007 pset_decoding_buf (p
, empty_unibyte_string
);
3008 p
->decoding_carryover
= 0;
3009 pset_encoding_buf (p
, empty_unibyte_string
);
3011 p
->inherit_coding_system_flag
3012 = !(!NILP (tem
) || NILP (p
->buffer
) || !inherit_process_coding_system
);
3015 void connect_network_socket (Lisp_Object proc
, Lisp_Object ip_addresses
)
3017 ptrdiff_t count
= SPECPDL_INDEX ();
3019 int s
= -1, outch
, inch
;
3021 Lisp_Object ip_address
;
3023 struct sockaddr
*sa
= NULL
;
3026 struct Lisp_Process
*p
= XPROCESS (proc
);
3027 Lisp_Object contact
= p
->childp
;
3030 /* Do this in case we never enter the while-loop below. */
3031 count1
= SPECPDL_INDEX ();
3034 while (!NILP (ip_addresses
))
3036 ip_address
= XCAR (ip_addresses
);
3037 ip_addresses
= XCDR (ip_addresses
);
3043 addrlen
= get_lisp_to_sockaddr_size (ip_address
, &family
);
3046 sa
= xmalloc (addrlen
);
3047 conv_lisp_to_sockaddr (family
, ip_address
, sa
, addrlen
);
3049 s
= socket (family
, p
->socktype
| SOCK_CLOEXEC
, p
->ai_protocol
);
3056 #ifdef DATAGRAM_SOCKETS
3057 if (!p
->is_server
&& p
->socktype
== SOCK_DGRAM
)
3059 #endif /* DATAGRAM_SOCKETS */
3061 #ifdef NON_BLOCKING_CONNECT
3062 if (p
->is_non_blocking_client
)
3064 ret
= fcntl (s
, F_SETFL
, O_NONBLOCK
);
3075 /* Make us close S if quit. */
3076 record_unwind_protect_int (close_file_unwind
, s
);
3078 /* Parse network options in the arg list. We simply ignore anything
3079 which isn't a known option (including other keywords). An error
3080 is signaled if setting a known option fails. */
3082 Lisp_Object params
= contact
, key
, val
;
3084 while (!NILP (params
))
3086 key
= XCAR (params
);
3087 params
= XCDR (params
);
3088 val
= XCAR (params
);
3089 params
= XCDR (params
);
3090 optbits
|= set_socket_option (s
, key
, val
);
3096 /* Configure as a server socket. */
3098 /* SO_REUSEADDR = 1 is default for server sockets; must specify
3099 explicit :reuseaddr key to override this. */
3100 #ifdef HAVE_LOCAL_SOCKETS
3101 if (family
!= AF_LOCAL
)
3103 if (!(optbits
& (1 << OPIX_REUSEADDR
)))
3106 if (setsockopt (s
, SOL_SOCKET
, SO_REUSEADDR
, &optval
, sizeof optval
))
3107 report_file_error ("Cannot set reuse option on server socket", Qnil
);
3110 if (bind (s
, sa
, addrlen
))
3111 report_file_error ("Cannot bind server socket", Qnil
);
3113 #ifdef HAVE_GETSOCKNAME
3116 struct sockaddr_in sa1
;
3117 socklen_t len1
= sizeof (sa1
);
3118 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3120 Lisp_Object service
;
3121 service
= make_number (ntohs (sa1
.sin_port
));
3122 contact
= Fplist_put (contact
, QCservice
, service
);
3123 // Save the port number so that we can stash it in
3124 // the process object later.
3125 ((struct sockaddr_in
*)sa
)->sin_port
= sa1
.sin_port
;
3130 if (p
->socktype
!= SOCK_DGRAM
&& listen (s
, p
->backlog
))
3131 report_file_error ("Cannot listen on server socket", Qnil
);
3139 ret
= connect (s
, sa
, addrlen
);
3142 if (ret
== 0 || xerrno
== EISCONN
)
3144 /* The unwind-protect will be discarded afterwards.
3145 Likewise for immediate_quit. */
3149 #ifdef NON_BLOCKING_CONNECT
3151 if (p
->is_non_blocking_client
&& xerrno
== EINPROGRESS
)
3155 if (p
->is_non_blocking_client
&& xerrno
== EWOULDBLOCK
)
3162 if (xerrno
== EINTR
)
3164 /* Unlike most other syscalls connect() cannot be called
3165 again. (That would return EALREADY.) The proper way to
3166 wait for completion is pselect(). */
3174 sc
= pselect (s
+ 1, NULL
, &fdset
, NULL
, NULL
, NULL
);
3180 report_file_error ("Failed select", Qnil
);
3184 len
= sizeof xerrno
;
3185 eassert (FD_ISSET (s
, &fdset
));
3186 if (getsockopt (s
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &len
) < 0)
3187 report_file_error ("Failed getsockopt", Qnil
);
3189 report_file_errno ("Failed connect", Qnil
, xerrno
);
3192 #endif /* !WINDOWSNT */
3196 /* Discard the unwind protect closing S. */
3197 specpdl_ptr
= specpdl
+ count1
;
3202 if (xerrno
== EINTR
)
3209 #ifdef DATAGRAM_SOCKETS
3210 if (p
->socktype
== SOCK_DGRAM
)
3212 if (datagram_address
[s
].sa
)
3215 datagram_address
[s
].sa
= xmalloc (addrlen
);
3216 datagram_address
[s
].len
= addrlen
;
3220 memset (datagram_address
[s
].sa
, 0, addrlen
);
3221 if (remote
= Fplist_get (contact
, QCremote
), !NILP (remote
))
3224 rlen
= get_lisp_to_sockaddr_size (remote
, &rfamily
);
3225 if (rlen
!= 0 && rfamily
== family
3227 conv_lisp_to_sockaddr (rfamily
, remote
,
3228 datagram_address
[s
].sa
, rlen
);
3232 memcpy (datagram_address
[s
].sa
, sa
, addrlen
);
3236 contact
= Fplist_put (contact
, p
->is_server
? QClocal
: QCremote
,
3237 conv_sockaddr_to_lisp (sa
, addrlen
));
3238 #ifdef HAVE_GETSOCKNAME
3241 struct sockaddr_in sa1
;
3242 socklen_t len1
= sizeof (sa1
);
3243 if (getsockname (s
, (struct sockaddr
*)&sa1
, &len1
) == 0)
3244 contact
= Fplist_put (contact
, QClocal
,
3245 conv_sockaddr_to_lisp ((struct sockaddr
*)&sa1
, len1
));
3254 /* If non-blocking got this far - and failed - assume non-blocking is
3255 not supported after all. This is probably a wrong assumption, but
3256 the normal blocking calls to open-network-stream handles this error
3258 if (p
->is_non_blocking_client
)
3261 report_file_errno ((p
->is_server
3262 ? "make server process failed"
3263 : "make client process failed"),
3270 chan_process
[inch
] = proc
;
3272 fcntl (inch
, F_SETFL
, O_NONBLOCK
);
3274 p
= XPROCESS (proc
);
3275 p
->open_fd
[SUBPROCESS_STDIN
] = inch
;
3279 /* Discard the unwind protect for closing S, if any. */
3280 specpdl_ptr
= specpdl
+ count1
;
3282 /* Unwind bind_polling_period and request_sigio. */
3283 unbind_to (count
, Qnil
);
3285 if (p
->is_server
&& p
->socktype
!= SOCK_DGRAM
)
3286 pset_status (p
, Qlisten
);
3288 /* Make the process marker point into the process buffer (if any). */
3289 if (BUFFERP (p
->buffer
))
3290 set_marker_both (p
->mark
, p
->buffer
,
3291 BUF_ZV (XBUFFER (p
->buffer
)),
3292 BUF_ZV_BYTE (XBUFFER (p
->buffer
)));
3294 #ifdef NON_BLOCKING_CONNECT
3295 if (p
->is_non_blocking_client
)
3297 /* We may get here if connect did succeed immediately. However,
3298 in that case, we still need to signal this like a non-blocking
3300 pset_status (p
, Qconnect
);
3301 if (!FD_ISSET (inch
, &connect_wait_mask
))
3303 FD_SET (inch
, &connect_wait_mask
);
3304 FD_SET (inch
, &write_mask
);
3305 num_pending_connects
++;
3310 /* A server may have a client filter setting of Qt, but it must
3311 still listen for incoming connects unless it is stopped. */
3312 if ((!EQ (p
->filter
, Qt
) && !EQ (p
->command
, Qt
))
3313 || (EQ (p
->status
, Qlisten
) && NILP (p
->command
)))
3315 FD_SET (inch
, &input_wait_mask
);
3316 FD_SET (inch
, &non_keyboard_wait_mask
);
3319 if (inch
> max_process_desc
)
3320 max_process_desc
= inch
;
3322 setup_process_coding_systems (proc
);
3325 /* Continue the asynchronous connection. */
3326 if (!NILP (p
->gnutls_boot_parameters
))
3328 Lisp_Object boot
, params
= p
->gnutls_boot_parameters
;
3330 boot
= Fgnutls_boot (proc
, XCAR (params
), XCDR (params
));
3331 p
->gnutls_boot_parameters
= Qnil
;
3333 if (NILP (boot
) || STRINGP (boot
) ||
3334 p
->gnutls_initstage
!= GNUTLS_STAGE_READY
)
3336 deactivate_process (proc
);
3338 pset_status (p
, list2 (Qfailed
,
3339 build_string ("TLS negotiation failed")));
3341 pset_status (p
, list2 (Qfailed
, boot
));
3345 Lisp_Object result
= Qt
;
3347 if (!NILP (Ffboundp (Qnsm_verify_connection
)))
3348 result
= call3 (Qnsm_verify_connection
,
3350 Fplist_get (contact
, QChost
),
3351 Fplist_get (contact
, QCservice
));
3355 pset_status (p
, list2 (Qfailed
,
3356 build_string ("The Network Security Manager stopped the connections")));
3357 deactivate_process (proc
);
3361 /* If we cleared the connection wait mask before we did
3362 the TLS setup, then we have to say that the process
3363 is finally "open" here. */
3364 if (! FD_ISSET (p
->outfd
, &connect_wait_mask
))
3366 pset_status (p
, Qrun
);
3367 /* Execute the sentinel here. If we had relied on
3368 status_notify to do it later, it will read input
3369 from the process before calling the sentinel. */
3370 exec_sentinel (proc
, build_string ("open\n"));
3379 #ifndef HAVE_GETADDRINFO
3381 conv_numerical_to_lisp (unsigned char *number
, unsigned int length
, int port
)
3383 Lisp_Object address
= Fmake_vector (make_number (length
+ 1), Qnil
);
3384 register struct Lisp_Vector
*p
= XVECTOR (address
);
3387 p
->contents
[length
] = make_number (port
);
3388 for (i
= 0; i
< length
; i
++)
3389 p
->contents
[i
] = make_number (*(number
+ i
));
3395 /* Create a network stream/datagram client/server process. Treated
3396 exactly like a normal process when reading and writing. Primary
3397 differences are in status display and process deletion. A network
3398 connection has no PID; you cannot signal it. All you can do is
3399 stop/continue it and deactivate/close it via delete-process. */
3401 DEFUN ("make-network-process", Fmake_network_process
, Smake_network_process
,
3403 doc
: /* Create and return a network server or client process.
3405 In Emacs, network connections are represented by process objects, so
3406 input and output work as for subprocesses and `delete-process' closes
3407 a network connection. However, a network process has no process id,
3408 it cannot be signaled, and the status codes are different from normal
3411 Arguments are specified as keyword/argument pairs. The following
3412 arguments are defined:
3414 :name NAME -- NAME is name for process. It is modified if necessary
3417 :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate
3418 with the process. Process output goes at end of that buffer, unless
3419 you specify an output stream or filter function to handle the output.
3420 BUFFER may be also nil, meaning that this process is not associated
3423 :host HOST -- HOST is name of the host to connect to, or its IP
3424 address. The symbol `local' specifies the local host. If specified
3425 for a server process, it must be a valid name or address for the local
3426 host, and only clients connecting to that address will be accepted.
3428 :service SERVICE -- SERVICE is name of the service desired, or an
3429 integer specifying a port number to connect to. If SERVICE is t,
3430 a random port number is selected for the server. (If Emacs was
3431 compiled with getaddrinfo, a port number can also be specified as a
3432 string, e.g. "80", as well as an integer. This is not portable.)
3434 :type TYPE -- TYPE is the type of connection. The default (nil) is a
3435 stream type connection, `datagram' creates a datagram type connection,
3436 `seqpacket' creates a reliable datagram connection.
3438 :family FAMILY -- FAMILY is the address (and protocol) family for the
3439 service specified by HOST and SERVICE. The default (nil) is to use
3440 whatever address family (IPv4 or IPv6) that is defined for the host
3441 and port number specified by HOST and SERVICE. Other address families
3443 local -- for a local (i.e. UNIX) address specified by SERVICE.
3444 ipv4 -- use IPv4 address family only.
3445 ipv6 -- use IPv6 address family only.
3447 :local ADDRESS -- ADDRESS is the local address used for the connection.
3448 This parameter is ignored when opening a client process. When specified
3449 for a server process, the FAMILY, HOST and SERVICE args are ignored.
3451 :remote ADDRESS -- ADDRESS is the remote partner's address for the
3452 connection. This parameter is ignored when opening a stream server
3453 process. For a datagram server process, it specifies the initial
3454 setting of the remote datagram address. When specified for a client
3455 process, the FAMILY, HOST, and SERVICE args are ignored.
3457 The format of ADDRESS depends on the address family:
3458 - An IPv4 address is represented as an vector of integers [A B C D P]
3459 corresponding to numeric IP address A.B.C.D and port number P.
3460 - A local address is represented as a string with the address in the
3461 local address space.
3462 - An "unsupported family" address is represented by a cons (F . AV)
3463 where F is the family number and AV is a vector containing the socket
3464 address data with one element per address data byte. Do not rely on
3465 this format in portable code, as it may depend on implementation
3466 defined constants, data sizes, and data structure alignment.
3468 :coding CODING -- If CODING is a symbol, it specifies the coding
3469 system used for both reading and writing for this process. If CODING
3470 is a cons (DECODING . ENCODING), DECODING is used for reading, and
3471 ENCODING is used for writing.
3473 :nowait BOOL -- If NOWAIT is non-nil for a stream type client
3474 process, return without waiting for the connection to complete;
3475 instead, the sentinel function will be called with second arg matching
3476 "open" (if successful) or "failed" when the connect completes.
3477 Default is to use a blocking connect (i.e. wait) for stream type
3480 :noquery BOOL -- Query the user unless BOOL is non-nil, and process is
3481 running when Emacs is exited.
3483 :stop BOOL -- Start process in the `stopped' state if BOOL non-nil.
3484 In the stopped state, a server process does not accept new
3485 connections, and a client process does not handle incoming traffic.
3486 The stopped state is cleared by `continue-process' and set by
3489 :filter FILTER -- Install FILTER as the process filter.
3491 :filter-multibyte BOOL -- If BOOL is non-nil, strings given to the
3492 process filter are multibyte, otherwise they are unibyte.
3493 If this keyword is not specified, the strings are multibyte if
3494 the default value of `enable-multibyte-characters' is non-nil.
3496 :sentinel SENTINEL -- Install SENTINEL as the process sentinel.
3498 :log LOG -- Install LOG as the server process log function. This
3499 function is called when the server accepts a network connection from a
3500 client. The arguments are SERVER, CLIENT, and MESSAGE, where SERVER
3501 is the server process, CLIENT is the new process for the connection,
3502 and MESSAGE is a string.
3504 :plist PLIST -- Install PLIST as the new process's initial plist.
3506 :tls-parameters LIST -- is a list that should be supplied if you're
3507 opening a TLS connection. The first element is the TLS type (either
3508 `gnutls-x509pki' or `gnutls-anon'), and the remaining elements should
3509 be a keyword list accepted by gnutls-boot (as returned by
3510 `gnutls-boot-parameters').
3512 :server QLEN -- if QLEN is non-nil, create a server process for the
3513 specified FAMILY, SERVICE, and connection type (stream or datagram).
3514 If QLEN is an integer, it is used as the max. length of the server's
3515 pending connection queue (also known as the backlog); the default
3516 queue length is 5. Default is to create a client process.
3518 The following network options can be specified for this connection:
3520 :broadcast BOOL -- Allow send and receive of datagram broadcasts.
3521 :dontroute BOOL -- Only send to directly connected hosts.
3522 :keepalive BOOL -- Send keep-alive messages on network stream.
3523 :linger BOOL or TIMEOUT -- Send queued messages before closing.
3524 :oobinline BOOL -- Place out-of-band data in receive data stream.
3525 :priority INT -- Set protocol defined priority for sent packets.
3526 :reuseaddr BOOL -- Allow reusing a recently used local address
3527 (this is allowed by default for a server process).
3528 :bindtodevice NAME -- bind to interface NAME. Using this may require
3529 special privileges on some systems.
3531 Consult the relevant system programmer's manual pages for more
3532 information on using these options.
3535 A server process will listen for and accept connections from clients.
3536 When a client connection is accepted, a new network process is created
3537 for the connection with the following parameters:
3539 - The client's process name is constructed by concatenating the server
3540 process's NAME and a client identification string.
3541 - If the FILTER argument is non-nil, the client process will not get a
3542 separate process buffer; otherwise, the client's process buffer is a newly
3543 created buffer named after the server process's BUFFER name or process
3544 NAME concatenated with the client identification string.
3545 - The connection type and the process filter and sentinel parameters are
3546 inherited from the server process's TYPE, FILTER and SENTINEL.
3547 - The client process's contact info is set according to the client's
3548 addressing information (typically an IP address and a port number).
3549 - The client process's plist is initialized from the server's plist.
3551 Notice that the FILTER and SENTINEL args are never used directly by
3552 the server process. Also, the BUFFER argument is not used directly by
3553 the server process, but via the optional :log function, accepted (and
3554 failed) connections may be logged in the server process's buffer.
3556 The original argument list, modified with the actual connection
3557 information, is available via the `process-contact' function.
3559 usage: (make-network-process &rest ARGS) */)
3560 (ptrdiff_t nargs
, Lisp_Object
*args
)
3563 Lisp_Object contact
;
3564 struct Lisp_Process
*p
;
3565 #if defined(HAVE_GETADDRINFO) || defined(HAVE_GETADDRINFO_A)
3566 struct addrinfo
*hints
;
3567 const char *portstring
;
3570 #ifdef HAVE_LOCAL_SOCKETS
3571 struct sockaddr_un address_un
;
3575 Lisp_Object name
, buffer
, host
, service
, address
;
3576 Lisp_Object filter
, sentinel
;
3577 Lisp_Object ip_addresses
= Qnil
;
3580 int ai_protocol
= 0;
3581 #ifdef HAVE_GETADDRINFO_A
3582 struct gaicb
**dns_requests
= NULL
;
3584 ptrdiff_t count
= SPECPDL_INDEX ();
3589 /* Save arguments for process-contact and clone-process. */
3590 contact
= Flist (nargs
, args
);
3593 /* Ensure socket support is loaded if available. */
3594 init_winsock (TRUE
);
3597 /* :type TYPE (nil: stream, datagram */
3598 tem
= Fplist_get (contact
, QCtype
);
3600 socktype
= SOCK_STREAM
;
3601 #ifdef DATAGRAM_SOCKETS
3602 else if (EQ (tem
, Qdatagram
))
3603 socktype
= SOCK_DGRAM
;
3605 #ifdef HAVE_SEQPACKET
3606 else if (EQ (tem
, Qseqpacket
))
3607 socktype
= SOCK_SEQPACKET
;
3610 error ("Unsupported connection type");
3612 name
= Fplist_get (contact
, QCname
);
3613 buffer
= Fplist_get (contact
, QCbuffer
);
3614 filter
= Fplist_get (contact
, QCfilter
);
3615 sentinel
= Fplist_get (contact
, QCsentinel
);
3617 CHECK_STRING (name
);
3619 /* :local ADDRESS or :remote ADDRESS */
3620 tem
= Fplist_get (contact
, QCserver
);
3622 address
= Fplist_get (contact
, QCremote
);
3624 address
= Fplist_get (contact
, QClocal
);
3625 if (!NILP (address
))
3627 host
= service
= Qnil
;
3629 if (!get_lisp_to_sockaddr_size (address
, &family
))
3630 error ("Malformed :address");
3632 ip_addresses
= Fcons (address
, Qnil
);
3636 /* :family FAMILY -- nil (for Inet), local, or integer. */
3637 tem
= Fplist_get (contact
, QCfamily
);
3640 #if defined (HAVE_GETADDRINFO) && defined (AF_INET6)
3646 #ifdef HAVE_LOCAL_SOCKETS
3647 else if (EQ (tem
, Qlocal
))
3651 else if (EQ (tem
, Qipv6
))
3654 else if (EQ (tem
, Qipv4
))
3656 else if (TYPE_RANGED_INTEGERP (int, tem
))
3657 family
= XINT (tem
);
3659 error ("Unknown address family");
3661 /* :service SERVICE -- string, integer (port number), or t (random port). */
3662 service
= Fplist_get (contact
, QCservice
);
3664 /* :host HOST -- hostname, ip address, or 'local for localhost. */
3665 host
= Fplist_get (contact
, QChost
);
3668 /* The "connection" function gets it bind info from the address we're
3669 given, so use this dummy address if nothing is specified. */
3670 #ifdef HAVE_LOCAL_SOCKETS
3671 if (family
!= AF_LOCAL
)
3673 host
= build_string ("127.0.0.1");
3677 if (EQ (host
, Qlocal
))
3678 /* Depending on setup, "localhost" may map to different IPv4 and/or
3679 IPv6 addresses, so it's better to be explicit (Bug#6781). */
3680 host
= build_string ("127.0.0.1");
3681 CHECK_STRING (host
);
3684 #ifdef HAVE_LOCAL_SOCKETS
3685 if (family
== AF_LOCAL
)
3689 message (":family local ignores the :host property");
3690 contact
= Fplist_put (contact
, QChost
, Qnil
);
3693 CHECK_STRING (service
);
3694 if (sizeof address_un
.sun_path
<= SBYTES (service
))
3695 error ("Service name too long");
3696 ip_addresses
= Fcons (service
, Qnil
);
3701 /* Slow down polling to every ten seconds.
3702 Some kernels have a bug which causes retrying connect to fail
3703 after a connect. Polling can interfere with gethostbyname too. */
3704 #ifdef POLL_FOR_INPUT
3705 if (socktype
!= SOCK_DGRAM
)
3707 record_unwind_protect_void (run_all_atimers
);
3708 bind_polling_period (10);
3712 #if defined (HAVE_GETADDRINFO) || defined (HAVE_GETADDRINFO_A)
3716 /* SERVICE can either be a string or int.
3717 Convert to a C string for later use by getaddrinfo. */
3718 if (EQ (service
, Qt
))
3720 else if (INTEGERP (service
))
3722 sprintf (portbuf
, "%"pI
"d", XINT (service
));
3723 portstring
= portbuf
;
3727 CHECK_STRING (service
);
3728 portstring
= SSDATA (service
);
3731 hints
= xzalloc (sizeof (struct addrinfo
));
3732 hints
->ai_flags
= 0;
3733 hints
->ai_family
= family
;
3734 hints
->ai_socktype
= socktype
;
3735 hints
->ai_protocol
= 0;
3740 #ifdef HAVE_GETADDRINFO_A
3741 if (!NILP (Fplist_get (contact
, QCnowait
)) &&
3746 printf("Async DNS for '%s'\n", SSDATA (host
));
3747 dns_requests
= xmalloc (sizeof (struct gaicb
*));
3748 dns_requests
[0] = xmalloc (sizeof (struct gaicb
));
3749 dns_requests
[0]->ar_name
= strdup (SSDATA (host
));
3750 dns_requests
[0]->ar_service
= strdup (portstring
);
3751 dns_requests
[0]->ar_request
= hints
;
3752 dns_requests
[0]->ar_result
= NULL
;
3754 ret
= getaddrinfo_a (GAI_NOWAIT
, dns_requests
, 1, NULL
);
3756 error ("%s/%s getaddrinfo_a error %d", SSDATA (host
), portstring
, ret
);
3760 #endif /* HAVE_GETADDRINFO_A */
3762 #ifdef HAVE_GETADDRINFO
3763 /* If we have a host, use getaddrinfo to resolve both host and service.
3764 Otherwise, use getservbyname to lookup the service. */
3768 struct addrinfo
*res
, *lres
;
3774 #ifdef HAVE_RES_INIT
3778 ret
= getaddrinfo (SSDATA (host
), portstring
, hints
, &res
);
3780 #ifdef HAVE_GAI_STRERROR
3781 error ("%s/%s %s", SSDATA (host
), portstring
, gai_strerror (ret
));
3783 error ("%s/%s getaddrinfo error %d", SSDATA (host
), portstring
, ret
);
3787 for (lres
= res
; lres
; lres
= lres
->ai_next
)
3789 ip_addresses
= Fcons (conv_sockaddr_to_lisp
3790 (lres
->ai_addr
, lres
->ai_addrlen
),
3792 ai_protocol
= lres
->ai_protocol
;
3795 ip_addresses
= Fnreverse (ip_addresses
);
3802 #endif /* HAVE_GETADDRINFO */
3804 /* We end up here if getaddrinfo is not defined, or in case no hostname
3805 has been specified (e.g. for a local server process). */
3807 if (EQ (service
, Qt
))
3809 else if (INTEGERP (service
))
3810 port
= (unsigned short) XINT (service
);
3813 struct servent
*svc_info
;
3814 CHECK_STRING (service
);
3815 svc_info
= getservbyname (SSDATA (service
),
3816 (socktype
== SOCK_DGRAM
? "udp" : "tcp"));
3818 error ("Unknown service: %s", SDATA (service
));
3819 port
= ntohs (svc_info
->s_port
);
3822 #ifndef HAVE_GETADDRINFO
3825 struct hostent
*host_info_ptr
;
3827 /* gethostbyname may fail with TRY_AGAIN, but we don't honor that,
3828 as it may `hang' Emacs for a very long time. */
3832 #ifdef HAVE_RES_INIT
3836 host_info_ptr
= gethostbyname ((const char *) SDATA (host
));
3841 ip_addresses
= Fcons (conv_numerical_to_lisp
3842 ((unsigned char *) host_info_ptr
->h_addr
,
3843 host_info_ptr
->h_length
,
3848 /* Attempt to interpret host as numeric inet address. This
3849 only works for IPv4 addresses. */
3851 unsigned long numeric_addr
= inet_addr (SSDATA (host
));
3853 if (numeric_addr
== -1)
3854 error ("Unknown host \"%s\"", SDATA (host
));
3856 ip_addresses
= Fcons (conv_numerical_to_lisp
3857 ((unsigned char *) &numeric_addr
, 4, port
),
3862 #endif /* not HAVE_GETADDRINFO */
3867 buffer
= Fget_buffer_create (buffer
);
3868 proc
= make_process (name
);
3869 p
= XPROCESS (proc
);
3870 pset_childp (p
, contact
);
3871 pset_plist (p
, Fcopy_sequence (Fplist_get (contact
, QCplist
)));
3872 pset_type (p
, Qnetwork
);
3874 pset_buffer (p
, buffer
);
3875 pset_sentinel (p
, sentinel
);
3876 pset_filter (p
, filter
);
3877 pset_log (p
, Fplist_get (contact
, QClog
));
3878 if (tem
= Fplist_get (contact
, QCnoquery
), !NILP (tem
))
3879 p
->kill_without_query
= 1;
3880 if ((tem
= Fplist_get (contact
, QCstop
), !NILP (tem
)))
3881 pset_command (p
, Qt
);
3884 p
->is_non_blocking_client
= 0;
3887 p
->socktype
= socktype
;
3888 p
->ai_protocol
= ai_protocol
;
3889 #ifdef HAVE_GETADDRINFO_A
3890 p
->dns_requests
= NULL
;
3893 tem
= Fplist_get (contact
, QCtls_parameters
);
3895 p
->gnutls_boot_parameters
= tem
;
3898 set_network_socket_coding_system (proc
);
3900 unbind_to (count
, Qnil
);
3903 tem
= Fplist_get (contact
, QCserver
);
3906 /* Don't support network sockets when non-blocking mode is
3907 not available, since a blocked Emacs is not useful. */
3909 if (TYPE_RANGED_INTEGERP (int, tem
))
3910 p
->backlog
= XINT (tem
);
3914 if (!p
->is_server
&& socktype
!= SOCK_DGRAM
3915 && (tem
= Fplist_get (contact
, QCnowait
), !NILP (tem
)))
3917 #ifndef NON_BLOCKING_CONNECT
3918 error ("Non-blocking connect not supported");
3920 p
->is_non_blocking_client
= 1;
3924 #ifdef HAVE_GETADDRINFO_A
3925 /* If we're doing async address resolution, the list of addresses
3926 here will be nil, so we postpone connecting to the server. */
3927 if (!p
->is_server
&& NILP (ip_addresses
))
3929 p
->dns_requests
= dns_requests
;
3930 p
->status
= Qconnect
;
3931 dns_processes
= Fcons (proc
, dns_processes
);
3935 connect_network_socket (proc
, ip_addresses
);
3937 #else /* HAVE_GETADDRINFO_A */
3938 connect_network_socket (proc
, ip_addresses
);
3945 #ifdef HAVE_NET_IF_H
3949 network_interface_list (void)
3951 struct ifconf ifconf
;
3952 struct ifreq
*ifreq
;
3954 ptrdiff_t buf_size
= 512;
3959 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
3962 count
= SPECPDL_INDEX ();
3963 record_unwind_protect_int (close_file_unwind
, s
);
3967 buf
= xpalloc (buf
, &buf_size
, 1, INT_MAX
, 1);
3968 ifconf
.ifc_buf
= buf
;
3969 ifconf
.ifc_len
= buf_size
;
3970 if (ioctl (s
, SIOCGIFCONF
, &ifconf
))
3977 while (ifconf
.ifc_len
== buf_size
);
3979 res
= unbind_to (count
, Qnil
);
3980 ifreq
= ifconf
.ifc_req
;
3981 while ((char *) ifreq
< (char *) ifconf
.ifc_req
+ ifconf
.ifc_len
)
3983 struct ifreq
*ifq
= ifreq
;
3984 #ifdef HAVE_STRUCT_IFREQ_IFR_ADDR_SA_LEN
3985 #define SIZEOF_IFREQ(sif) \
3986 ((sif)->ifr_addr.sa_len < sizeof (struct sockaddr) \
3987 ? sizeof (*(sif)) : sizeof ((sif)->ifr_name) + (sif)->ifr_addr.sa_len)
3989 int len
= SIZEOF_IFREQ (ifq
);
3991 int len
= sizeof (*ifreq
);
3993 char namebuf
[sizeof (ifq
->ifr_name
) + 1];
3994 ifreq
= (struct ifreq
*) ((char *) ifreq
+ len
);
3996 if (ifq
->ifr_addr
.sa_family
!= AF_INET
)
3999 memcpy (namebuf
, ifq
->ifr_name
, sizeof (ifq
->ifr_name
));
4000 namebuf
[sizeof (ifq
->ifr_name
)] = 0;
4001 res
= Fcons (Fcons (build_string (namebuf
),
4002 conv_sockaddr_to_lisp (&ifq
->ifr_addr
,
4003 sizeof (struct sockaddr
))),
4010 #endif /* SIOCGIFCONF */
4012 #if defined (SIOCGIFADDR) || defined (SIOCGIFHWADDR) || defined (SIOCGIFFLAGS)
4016 const char *flag_sym
;
4019 static const struct ifflag_def ifflag_table
[] = {
4023 #ifdef IFF_BROADCAST
4024 { IFF_BROADCAST
, "broadcast" },
4027 { IFF_DEBUG
, "debug" },
4030 { IFF_LOOPBACK
, "loopback" },
4032 #ifdef IFF_POINTOPOINT
4033 { IFF_POINTOPOINT
, "pointopoint" },
4036 { IFF_RUNNING
, "running" },
4039 { IFF_NOARP
, "noarp" },
4042 { IFF_PROMISC
, "promisc" },
4044 #ifdef IFF_NOTRAILERS
4045 #ifdef NS_IMPL_COCOA
4046 /* Really means smart, notrailers is obsolete. */
4047 { IFF_NOTRAILERS
, "smart" },
4049 { IFF_NOTRAILERS
, "notrailers" },
4053 { IFF_ALLMULTI
, "allmulti" },
4056 { IFF_MASTER
, "master" },
4059 { IFF_SLAVE
, "slave" },
4061 #ifdef IFF_MULTICAST
4062 { IFF_MULTICAST
, "multicast" },
4065 { IFF_PORTSEL
, "portsel" },
4067 #ifdef IFF_AUTOMEDIA
4068 { IFF_AUTOMEDIA
, "automedia" },
4071 { IFF_DYNAMIC
, "dynamic" },
4074 { IFF_OACTIVE
, "oactive" }, /* OpenBSD: transmission in progress. */
4077 { IFF_SIMPLEX
, "simplex" }, /* OpenBSD: can't hear own transmissions. */
4080 { IFF_LINK0
, "link0" }, /* OpenBSD: per link layer defined bit. */
4083 { IFF_LINK1
, "link1" }, /* OpenBSD: per link layer defined bit. */
4086 { IFF_LINK2
, "link2" }, /* OpenBSD: per link layer defined bit. */
4092 network_interface_info (Lisp_Object ifname
)
4095 Lisp_Object res
= Qnil
;
4100 #if (! (defined SIOCGIFHWADDR && defined HAVE_STRUCT_IFREQ_IFR_HWADDR) \
4101 && defined HAVE_GETIFADDRS && defined LLADDR)
4102 struct ifaddrs
*ifap
;
4105 CHECK_STRING (ifname
);
4107 if (sizeof rq
.ifr_name
<= SBYTES (ifname
))
4108 error ("interface name too long");
4109 lispstpcpy (rq
.ifr_name
, ifname
);
4111 s
= socket (AF_INET
, SOCK_STREAM
| SOCK_CLOEXEC
, 0);
4114 count
= SPECPDL_INDEX ();
4115 record_unwind_protect_int (close_file_unwind
, s
);
4118 #if defined (SIOCGIFFLAGS) && defined (HAVE_STRUCT_IFREQ_IFR_FLAGS)
4119 if (ioctl (s
, SIOCGIFFLAGS
, &rq
) == 0)
4121 int flags
= rq
.ifr_flags
;
4122 const struct ifflag_def
*fp
;
4125 /* If flags is smaller than int (i.e. short) it may have the high bit set
4126 due to IFF_MULTICAST. In that case, sign extending it into
4128 if (flags
< 0 && sizeof (rq
.ifr_flags
) < sizeof (flags
))
4129 flags
= (unsigned short) rq
.ifr_flags
;
4132 for (fp
= ifflag_table
; flags
!= 0 && fp
->flag_sym
; fp
++)
4134 if (flags
& fp
->flag_bit
)
4136 elt
= Fcons (intern (fp
->flag_sym
), elt
);
4137 flags
-= fp
->flag_bit
;
4140 for (fnum
= 0; flags
&& fnum
< 32; flags
>>= 1, fnum
++)
4144 elt
= Fcons (make_number (fnum
), elt
);
4149 res
= Fcons (elt
, res
);
4152 #if defined (SIOCGIFHWADDR) && defined (HAVE_STRUCT_IFREQ_IFR_HWADDR)
4153 if (ioctl (s
, SIOCGIFHWADDR
, &rq
) == 0)
4155 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4156 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4160 for (n
= 0; n
< 6; n
++)
4161 p
->contents
[n
] = make_number (((unsigned char *)
4162 &rq
.ifr_hwaddr
.sa_data
[0])
4164 elt
= Fcons (make_number (rq
.ifr_hwaddr
.sa_family
), hwaddr
);
4166 #elif defined (HAVE_GETIFADDRS) && defined (LLADDR)
4167 if (getifaddrs (&ifap
) != -1)
4169 Lisp_Object hwaddr
= Fmake_vector (make_number (6), Qnil
);
4170 register struct Lisp_Vector
*p
= XVECTOR (hwaddr
);
4173 for (it
= ifap
; it
!= NULL
; it
= it
->ifa_next
)
4175 struct sockaddr_dl
*sdl
= (struct sockaddr_dl
*) it
->ifa_addr
;
4176 unsigned char linkaddr
[6];
4179 if (it
->ifa_addr
->sa_family
!= AF_LINK
4180 || strcmp (it
->ifa_name
, SSDATA (ifname
)) != 0
4181 || sdl
->sdl_alen
!= 6)
4184 memcpy (linkaddr
, LLADDR (sdl
), sdl
->sdl_alen
);
4185 for (n
= 0; n
< 6; n
++)
4186 p
->contents
[n
] = make_number (linkaddr
[n
]);
4188 elt
= Fcons (make_number (it
->ifa_addr
->sa_family
), hwaddr
);
4192 #ifdef HAVE_FREEIFADDRS
4196 #endif /* HAVE_GETIFADDRS && LLADDR */
4198 res
= Fcons (elt
, res
);
4201 #if defined (SIOCGIFNETMASK) && (defined (HAVE_STRUCT_IFREQ_IFR_NETMASK) || defined (HAVE_STRUCT_IFREQ_IFR_ADDR))
4202 if (ioctl (s
, SIOCGIFNETMASK
, &rq
) == 0)
4205 #ifdef HAVE_STRUCT_IFREQ_IFR_NETMASK
4206 elt
= conv_sockaddr_to_lisp (&rq
.ifr_netmask
, sizeof (rq
.ifr_netmask
));
4208 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4212 res
= Fcons (elt
, res
);
4215 #if defined (SIOCGIFBRDADDR) && defined (HAVE_STRUCT_IFREQ_IFR_BROADADDR)
4216 if (ioctl (s
, SIOCGIFBRDADDR
, &rq
) == 0)
4219 elt
= conv_sockaddr_to_lisp (&rq
.ifr_broadaddr
, sizeof (rq
.ifr_broadaddr
));
4222 res
= Fcons (elt
, res
);
4225 #if defined (SIOCGIFADDR) && defined (HAVE_STRUCT_IFREQ_IFR_ADDR)
4226 if (ioctl (s
, SIOCGIFADDR
, &rq
) == 0)
4229 elt
= conv_sockaddr_to_lisp (&rq
.ifr_addr
, sizeof (rq
.ifr_addr
));
4232 res
= Fcons (elt
, res
);
4234 return unbind_to (count
, any
? res
: Qnil
);
4236 #endif /* !SIOCGIFADDR && !SIOCGIFHWADDR && !SIOCGIFFLAGS */
4237 #endif /* defined (HAVE_NET_IF_H) */
4239 DEFUN ("network-interface-list", Fnetwork_interface_list
,
4240 Snetwork_interface_list
, 0, 0, 0,
4241 doc
: /* Return an alist of all network interfaces and their network address.
4242 Each element is a cons, the car of which is a string containing the
4243 interface name, and the cdr is the network address in internal
4244 format; see the description of ADDRESS in `make-network-process'.
4246 If the information is not available, return nil. */)
4249 #if (defined HAVE_NET_IF_H && defined SIOCGIFCONF) || defined WINDOWSNT
4250 return network_interface_list ();
4256 DEFUN ("network-interface-info", Fnetwork_interface_info
,
4257 Snetwork_interface_info
, 1, 1, 0,
4258 doc
: /* Return information about network interface named IFNAME.
4259 The return value is a list (ADDR BCAST NETMASK HWADDR FLAGS),
4260 where ADDR is the layer 3 address, BCAST is the layer 3 broadcast address,
4261 NETMASK is the layer 3 network mask, HWADDR is the layer 2 address, and
4262 FLAGS is the current flags of the interface.
4264 Data that is unavailable is returned as nil. */)
4265 (Lisp_Object ifname
)
4267 #if ((defined HAVE_NET_IF_H \
4268 && (defined SIOCGIFADDR || defined SIOCGIFHWADDR \
4269 || defined SIOCGIFFLAGS)) \
4270 || defined WINDOWSNT)
4271 return network_interface_info (ifname
);
4277 /* If program file NAME starts with /: for quoting a magic
4278 name, remove that, preserving the multibyteness of NAME. */
4281 remove_slash_colon (Lisp_Object name
)
4284 ((SBYTES (name
) > 2 && SREF (name
, 0) == '/' && SREF (name
, 1) == ':')
4285 ? make_specified_string (SSDATA (name
) + 2, SCHARS (name
) - 2,
4286 SBYTES (name
) - 2, STRING_MULTIBYTE (name
))
4290 /* Turn off input and output for process PROC. */
4293 deactivate_process (Lisp_Object proc
)
4296 struct Lisp_Process
*p
= XPROCESS (proc
);
4300 /* Delete GnuTLS structures in PROC, if any. */
4301 emacs_gnutls_deinit (proc
);
4302 #endif /* HAVE_GNUTLS */
4304 if (p
->read_output_delay
> 0)
4306 if (--process_output_delay_count
< 0)
4307 process_output_delay_count
= 0;
4308 p
->read_output_delay
= 0;
4309 p
->read_output_skip
= 0;
4312 /* Beware SIGCHLD hereabouts. */
4314 for (i
= 0; i
< PROCESS_OPEN_FDS
; i
++)
4315 close_process_fd (&p
->open_fd
[i
]);
4317 inchannel
= p
->infd
;
4322 #ifdef DATAGRAM_SOCKETS
4323 if (DATAGRAM_CHAN_P (inchannel
))
4325 xfree (datagram_address
[inchannel
].sa
);
4326 datagram_address
[inchannel
].sa
= 0;
4327 datagram_address
[inchannel
].len
= 0;
4330 chan_process
[inchannel
] = Qnil
;
4331 FD_CLR (inchannel
, &input_wait_mask
);
4332 FD_CLR (inchannel
, &non_keyboard_wait_mask
);
4333 #ifdef NON_BLOCKING_CONNECT
4334 if (FD_ISSET (inchannel
, &connect_wait_mask
))
4336 FD_CLR (inchannel
, &connect_wait_mask
);
4337 FD_CLR (inchannel
, &write_mask
);
4338 if (--num_pending_connects
< 0)
4342 if (inchannel
== max_process_desc
)
4344 /* We just closed the highest-numbered process input descriptor,
4345 so recompute the highest-numbered one now. */
4349 while (0 <= i
&& NILP (chan_process
[i
]));
4351 max_process_desc
= i
;
4357 DEFUN ("accept-process-output", Faccept_process_output
, Saccept_process_output
,
4359 doc
: /* Allow any pending output from subprocesses to be read by Emacs.
4360 It is given to their filter functions.
4361 Optional argument PROCESS means do not return until output has been
4362 received from PROCESS.
4364 Optional second argument SECONDS and third argument MILLISEC
4365 specify a timeout; return after that much time even if there is
4366 no subprocess output. If SECONDS is a floating point number,
4367 it specifies a fractional number of seconds to wait.
4368 The MILLISEC argument is obsolete and should be avoided.
4370 If optional fourth argument JUST-THIS-ONE is non-nil, accept output
4371 from PROCESS only, suspending reading output from other processes.
4372 If JUST-THIS-ONE is an integer, don't run any timers either.
4373 Return non-nil if we received any output from PROCESS (or, if PROCESS
4374 is nil, from any process) before the timeout expired. */)
4375 (register Lisp_Object process
, Lisp_Object seconds
, Lisp_Object millisec
, Lisp_Object just_this_one
)
4380 if (! NILP (process
))
4381 CHECK_PROCESS (process
);
4383 just_this_one
= Qnil
;
4385 if (!NILP (millisec
))
4386 { /* Obsolete calling convention using integers rather than floats. */
4387 CHECK_NUMBER (millisec
);
4389 seconds
= make_float (XINT (millisec
) / 1000.0);
4392 CHECK_NUMBER (seconds
);
4393 seconds
= make_float (XINT (millisec
) / 1000.0 + XINT (seconds
));
4400 if (!NILP (seconds
))
4402 if (INTEGERP (seconds
))
4404 if (XINT (seconds
) > 0)
4406 secs
= XINT (seconds
);
4410 else if (FLOATP (seconds
))
4412 if (XFLOAT_DATA (seconds
) > 0)
4414 struct timespec t
= dtotimespec (XFLOAT_DATA (seconds
));
4415 secs
= min (t
.tv_sec
, WAIT_READING_MAX
);
4420 wrong_type_argument (Qnumberp
, seconds
);
4422 else if (! NILP (process
))
4426 ((wait_reading_process_output (secs
, nsecs
, 0, 0,
4428 !NILP (process
) ? XPROCESS (process
) : NULL
,
4429 (NILP (just_this_one
) ? 0
4430 : !INTEGERP (just_this_one
) ? 1 : -1))
4435 /* Accept a connection for server process SERVER on CHANNEL. */
4437 static EMACS_INT connect_counter
= 0;
4440 server_accept_connection (Lisp_Object server
, int channel
)
4442 Lisp_Object proc
, caller
, name
, buffer
;
4443 Lisp_Object contact
, host
, service
;
4444 struct Lisp_Process
*ps
= XPROCESS (server
);
4445 struct Lisp_Process
*p
;
4449 struct sockaddr_in in
;
4451 struct sockaddr_in6 in6
;
4453 #ifdef HAVE_LOCAL_SOCKETS
4454 struct sockaddr_un un
;
4457 socklen_t len
= sizeof saddr
;
4460 s
= accept4 (channel
, &saddr
.sa
, &len
, SOCK_CLOEXEC
);
4469 if (code
== EWOULDBLOCK
)
4473 if (!NILP (ps
->log
))
4474 call3 (ps
->log
, server
, Qnil
,
4475 concat3 (build_string ("accept failed with code"),
4476 Fnumber_to_string (make_number (code
)),
4477 build_string ("\n")));
4481 count
= SPECPDL_INDEX ();
4482 record_unwind_protect_int (close_file_unwind
, s
);
4486 /* Setup a new process to handle the connection. */
4488 /* Generate a unique identification of the caller, and build contact
4489 information for this process. */
4492 switch (saddr
.sa
.sa_family
)
4496 unsigned char *ip
= (unsigned char *)&saddr
.in
.sin_addr
.s_addr
;
4498 AUTO_STRING (ipv4_format
, "%d.%d.%d.%d");
4499 host
= CALLN (Fformat
, ipv4_format
,
4500 make_number (ip
[0]), make_number (ip
[1]),
4501 make_number (ip
[2]), make_number (ip
[3]));
4502 service
= make_number (ntohs (saddr
.in
.sin_port
));
4503 AUTO_STRING (caller_format
, " <%s:%d>");
4504 caller
= CALLN (Fformat
, caller_format
, host
, service
);
4511 Lisp_Object args
[9];
4512 uint16_t *ip6
= (uint16_t *)&saddr
.in6
.sin6_addr
;
4515 AUTO_STRING (ipv6_format
, "%x:%x:%x:%x:%x:%x:%x:%x");
4516 args
[0] = ipv6_format
;
4517 for (i
= 0; i
< 8; i
++)
4518 args
[i
+ 1] = make_number (ntohs (ip6
[i
]));
4519 host
= CALLMANY (Fformat
, args
);
4520 service
= make_number (ntohs (saddr
.in
.sin_port
));
4521 AUTO_STRING (caller_format
, " <[%s]:%d>");
4522 caller
= CALLN (Fformat
, caller_format
, host
, service
);
4527 #ifdef HAVE_LOCAL_SOCKETS
4531 caller
= Fnumber_to_string (make_number (connect_counter
));
4532 AUTO_STRING (space_less_than
, " <");
4533 AUTO_STRING (greater_than
, ">");
4534 caller
= concat3 (space_less_than
, caller
, greater_than
);
4538 /* Create a new buffer name for this process if it doesn't have a
4539 filter. The new buffer name is based on the buffer name or
4540 process name of the server process concatenated with the caller
4543 if (!(EQ (ps
->filter
, Qinternal_default_process_filter
)
4544 || EQ (ps
->filter
, Qt
)))
4548 buffer
= ps
->buffer
;
4550 buffer
= Fbuffer_name (buffer
);
4555 buffer
= concat2 (buffer
, caller
);
4556 buffer
= Fget_buffer_create (buffer
);
4560 /* Generate a unique name for the new server process. Combine the
4561 server process name with the caller identification. */
4563 name
= concat2 (ps
->name
, caller
);
4564 proc
= make_process (name
);
4566 chan_process
[s
] = proc
;
4568 fcntl (s
, F_SETFL
, O_NONBLOCK
);
4570 p
= XPROCESS (proc
);
4572 /* Build new contact information for this setup. */
4573 contact
= Fcopy_sequence (ps
->childp
);
4574 contact
= Fplist_put (contact
, QCserver
, Qnil
);
4575 contact
= Fplist_put (contact
, QChost
, host
);
4576 if (!NILP (service
))
4577 contact
= Fplist_put (contact
, QCservice
, service
);
4578 contact
= Fplist_put (contact
, QCremote
,
4579 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4580 #ifdef HAVE_GETSOCKNAME
4582 if (getsockname (s
, &saddr
.sa
, &len
) == 0)
4583 contact
= Fplist_put (contact
, QClocal
,
4584 conv_sockaddr_to_lisp (&saddr
.sa
, len
));
4587 pset_childp (p
, contact
);
4588 pset_plist (p
, Fcopy_sequence (ps
->plist
));
4589 pset_type (p
, Qnetwork
);
4591 pset_buffer (p
, buffer
);
4592 pset_sentinel (p
, ps
->sentinel
);
4593 pset_filter (p
, ps
->filter
);
4594 pset_command (p
, Qnil
);
4597 /* Discard the unwind protect for closing S. */
4598 specpdl_ptr
= specpdl
+ count
;
4600 p
->open_fd
[SUBPROCESS_STDIN
] = s
;
4603 pset_status (p
, Qrun
);
4605 /* Client processes for accepted connections are not stopped initially. */
4606 if (!EQ (p
->filter
, Qt
))
4608 FD_SET (s
, &input_wait_mask
);
4609 FD_SET (s
, &non_keyboard_wait_mask
);
4612 if (s
> max_process_desc
)
4613 max_process_desc
= s
;
4615 /* Setup coding system for new process based on server process.
4616 This seems to be the proper thing to do, as the coding system
4617 of the new process should reflect the settings at the time the
4618 server socket was opened; not the current settings. */
4620 pset_decode_coding_system (p
, ps
->decode_coding_system
);
4621 pset_encode_coding_system (p
, ps
->encode_coding_system
);
4622 setup_process_coding_systems (proc
);
4624 pset_decoding_buf (p
, empty_unibyte_string
);
4625 p
->decoding_carryover
= 0;
4626 pset_encoding_buf (p
, empty_unibyte_string
);
4628 p
->inherit_coding_system_flag
4629 = (NILP (buffer
) ? 0 : ps
->inherit_coding_system_flag
);
4631 AUTO_STRING (dash
, "-");
4632 AUTO_STRING (nl
, "\n");
4633 Lisp_Object host_string
= STRINGP (host
) ? host
: dash
;
4635 if (!NILP (ps
->log
))
4637 AUTO_STRING (accept_from
, "accept from ");
4638 call3 (ps
->log
, server
, proc
, concat3 (accept_from
, host_string
, nl
));
4641 AUTO_STRING (open_from
, "open from ");
4642 exec_sentinel (proc
, concat3 (open_from
, host_string
, nl
));
4645 #ifdef HAVE_GETADDRINFO_A
4647 check_for_dns (Lisp_Object proc
)
4649 struct Lisp_Process
*p
= XPROCESS (proc
);
4650 Lisp_Object ip_addresses
= Qnil
;
4654 if (! p
->dns_requests
)
4657 /* This process should not already be connected (or killed). */
4658 if (!EQ (p
->status
, Qconnect
))
4661 ret
= gai_error (p
->dns_requests
[0]);
4662 if (ret
== EAI_INPROGRESS
)
4665 /* We got a response. */
4668 struct addrinfo
*res
;
4670 for (res
= p
->dns_requests
[0]->ar_result
; res
; res
= res
->ai_next
)
4672 ip_addresses
= Fcons (conv_sockaddr_to_lisp
4673 (res
->ai_addr
, res
->ai_addrlen
),
4677 ip_addresses
= Fnreverse (ip_addresses
);
4678 freeaddrinfo (p
->dns_requests
[0]->ar_result
);
4680 /* The DNS lookup failed. */
4683 deactivate_process (proc
);
4684 pset_status (p
, (list2
4686 concat3 (build_string ("Name lookup of "),
4687 build_string (p
->dns_requests
[0]->ar_name
),
4688 build_string (" failed")))));
4691 xfree ((void *)p
->dns_requests
[0]->ar_request
);
4692 xfree ((void *)p
->dns_requests
[0]->ar_name
);
4693 xfree ((void *)p
->dns_requests
[0]->ar_service
);
4694 xfree (p
->dns_requests
[0]);
4695 xfree (p
->dns_requests
);
4696 p
->dns_requests
= NULL
;
4698 return ip_addresses
;
4701 #endif /* HAVE_GETADDRINFO_A */
4704 wait_for_socket_fds (Lisp_Object process
, char *name
)
4706 while (XPROCESS (process
)->infd
< 0 &&
4707 EQ (XPROCESS (process
)->status
, Qconnect
))
4709 printf("Waiting for socket from %s...\n", name
);
4710 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4715 wait_while_connecting (Lisp_Object process
)
4717 while (EQ (XPROCESS (process
)->status
, Qconnect
))
4719 printf("Waiting for connection...\n");
4720 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4725 wait_for_tls_negotiation (Lisp_Object process
)
4728 while (EQ (XPROCESS (process
)->status
, Qconnect
) &&
4729 !NILP (XPROCESS (process
)->gnutls_boot_parameters
))
4731 printf("Waiting for TLS...\n");
4732 wait_reading_process_output (0, 20 * 1000 * 1000, 0, 0, Qnil
, NULL
, 0);
4737 /* This variable is different from waiting_for_input in keyboard.c.
4738 It is used to communicate to a lisp process-filter/sentinel (via the
4739 function Fwaiting_for_user_input_p below) whether Emacs was waiting
4740 for user-input when that process-filter was called.
4741 waiting_for_input cannot be used as that is by definition 0 when
4742 lisp code is being evalled.
4743 This is also used in record_asynch_buffer_change.
4744 For that purpose, this must be 0
4745 when not inside wait_reading_process_output. */
4746 static int waiting_for_user_input_p
;
4749 wait_reading_process_output_unwind (int data
)
4751 waiting_for_user_input_p
= data
;
4754 /* This is here so breakpoints can be put on it. */
4756 wait_reading_process_output_1 (void)
4760 /* Read and dispose of subprocess output while waiting for timeout to
4761 elapse and/or keyboard input to be available.
4765 If negative, gobble data immediately available but don't wait for any.
4768 an additional duration to wait, measured in nanoseconds
4769 If TIME_LIMIT is zero, then:
4770 If NSECS == 0, there is no limit.
4771 If NSECS > 0, the timeout consists of NSECS only.
4772 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
4775 0 to ignore keyboard input, or
4776 1 to return when input is available, or
4777 -1 meaning caller will actually read the input, so don't throw to
4778 the quit handler, or
4780 DO_DISPLAY means redisplay should be done to show subprocess
4781 output that arrives.
4783 If WAIT_FOR_CELL is a cons cell, wait until its car is non-nil
4784 (and gobble terminal input into the buffer if any arrives).
4786 If WAIT_PROC is specified, wait until something arrives from that
4789 If JUST_WAIT_PROC is nonzero, handle only output from WAIT_PROC
4790 (suspending output from other processes). A negative value
4791 means don't run any timers either.
4793 Return positive if we received input from WAIT_PROC (or from any
4794 process if WAIT_PROC is null), zero if we attempted to receive
4795 input but got none, and negative if we didn't even try. */
4798 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
4800 Lisp_Object wait_for_cell
,
4801 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
4811 struct timespec timeout
, end_time
, timer_delay
;
4812 struct timespec got_output_end_time
= invalid_timespec ();
4813 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
4814 int got_some_output
= -1;
4815 ptrdiff_t count
= SPECPDL_INDEX ();
4817 /* Close to the current time if known, an invalid timespec otherwise. */
4818 struct timespec now
= invalid_timespec ();
4820 FD_ZERO (&Available
);
4823 if (time_limit
== 0 && nsecs
== 0 && wait_proc
&& !NILP (Vinhibit_quit
)
4824 && !(CONSP (wait_proc
->status
)
4825 && EQ (XCAR (wait_proc
->status
), Qexit
)))
4826 message1 ("Blocking call to accept-process-output with quit inhibited!!");
4828 record_unwind_protect_int (wait_reading_process_output_unwind
,
4829 waiting_for_user_input_p
);
4830 waiting_for_user_input_p
= read_kbd
;
4832 if (TYPE_MAXIMUM (time_t) < time_limit
)
4833 time_limit
= TYPE_MAXIMUM (time_t);
4835 if (time_limit
< 0 || nsecs
< 0)
4837 else if (time_limit
> 0 || nsecs
> 0)
4840 now
= current_timespec ();
4841 end_time
= timespec_add (now
, make_timespec (time_limit
, nsecs
));
4848 bool process_skipped
= false;
4850 /* If calling from keyboard input, do not quit
4851 since we want to return C-g as an input character.
4852 Otherwise, do pending quit if requested. */
4855 else if (pending_signals
)
4856 process_pending_signals ();
4858 /* Exit now if the cell we're waiting for became non-nil. */
4859 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
4862 #ifdef HAVE_GETADDRINFO_A
4863 if (!NILP (dns_processes
))
4865 Lisp_Object dns_list
= dns_processes
, dns
, ip_addresses
,
4866 answers
= Qnil
, answer
, new = Qnil
;
4867 struct Lisp_Process
*p
;
4869 /* This is programmed in a somewhat awkward fashion because
4870 calling connect_network_socket might make us end up back
4871 here again, and we would have a race condition with
4872 segfaults. So first go through all pending requests and see
4873 whether we got any answers. */
4874 while (!NILP (dns_list
))
4876 dns
= XCAR (dns_list
);
4877 dns_list
= XCDR (dns_list
);
4879 if (p
&& p
->dns_requests
)
4881 if (! wait_proc
|| p
== wait_proc
)
4883 ip_addresses
= check_for_dns (dns
);
4884 if (EQ (ip_addresses
, Qt
))
4885 new = Fcons (dns
, new);
4887 answers
= Fcons (Fcons (dns
, ip_addresses
), answers
);
4890 new = Fcons (dns
, new);
4894 /* Replace with the list of DNS requests still not responded
4896 dns_processes
= new;
4898 /* Then continue the connection for the successful
4900 while (!NILP (answers
))
4902 answer
= XCAR (answers
);
4903 answers
= XCDR (answers
);
4904 if (!NILP (XCDR (answer
)))
4905 connect_network_socket (XCAR (answer
), XCDR (answer
));
4908 #endif /* HAVE_GETADDRINFO_A */
4910 /* Compute time from now till when time limit is up. */
4911 /* Exit if already run out. */
4912 if (wait
== TIMEOUT
)
4914 if (!timespec_valid_p (now
))
4915 now
= current_timespec ();
4916 if (timespec_cmp (end_time
, now
) <= 0)
4918 timeout
= timespec_sub (end_time
, now
);
4921 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
4923 /* Normally we run timers here.
4924 But not if wait_for_cell; in those cases,
4925 the wait is supposed to be short,
4926 and those callers cannot handle running arbitrary Lisp code here. */
4927 if (NILP (wait_for_cell
)
4928 && just_wait_proc
>= 0)
4932 unsigned old_timers_run
= timers_run
;
4933 struct buffer
*old_buffer
= current_buffer
;
4934 Lisp_Object old_window
= selected_window
;
4936 timer_delay
= timer_check ();
4938 /* If a timer has run, this might have changed buffers
4939 an alike. Make read_key_sequence aware of that. */
4940 if (timers_run
!= old_timers_run
4941 && (old_buffer
!= current_buffer
4942 || !EQ (old_window
, selected_window
))
4943 && waiting_for_user_input_p
== -1)
4944 record_asynch_buffer_change ();
4946 if (timers_run
!= old_timers_run
&& do_display
)
4947 /* We must retry, since a timer may have requeued itself
4948 and that could alter the time_delay. */
4949 redisplay_preserve_echo_area (9);
4953 while (!detect_input_pending ());
4955 /* If there is unread keyboard input, also return. */
4957 && requeued_events_pending_p ())
4960 /* This is so a breakpoint can be put here. */
4961 if (!timespec_valid_p (timer_delay
))
4962 wait_reading_process_output_1 ();
4965 /* Cause C-g and alarm signals to take immediate action,
4966 and cause input available signals to zero out timeout.
4968 It is important that we do this before checking for process
4969 activity. If we get a SIGCHLD after the explicit checks for
4970 process activity, timeout is the only way we will know. */
4972 set_waiting_for_input (&timeout
);
4974 /* If status of something has changed, and no input is
4975 available, notify the user of the change right away. After
4976 this explicit check, we'll let the SIGCHLD handler zap
4977 timeout to get our attention. */
4978 if (update_tick
!= process_tick
)
4983 if (kbd_on_hold_p ())
4986 Atemp
= input_wait_mask
;
4989 timeout
= make_timespec (0, 0);
4990 if ((pselect (max (max_process_desc
, max_input_desc
) + 1,
4992 #ifdef NON_BLOCKING_CONNECT
4993 (num_pending_connects
> 0 ? &Ctemp
: NULL
),
4997 NULL
, &timeout
, NULL
)
5000 /* It's okay for us to do this and then continue with
5001 the loop, since timeout has already been zeroed out. */
5002 clear_waiting_for_input ();
5003 got_some_output
= status_notify (NULL
, wait_proc
);
5004 if (do_display
) redisplay_preserve_echo_area (13);
5008 /* Don't wait for output from a non-running process. Just
5009 read whatever data has already been received. */
5010 if (wait_proc
&& wait_proc
->raw_status_new
)
5011 update_status (wait_proc
);
5013 && ! EQ (wait_proc
->status
, Qrun
)
5014 && ! EQ (wait_proc
->status
, Qconnect
))
5016 bool read_some_bytes
= false;
5018 clear_waiting_for_input ();
5020 /* If data can be read from the process, do so until exhausted. */
5021 if (wait_proc
->infd
>= 0)
5023 XSETPROCESS (proc
, wait_proc
);
5027 int nread
= read_process_output (proc
, wait_proc
->infd
);
5030 if (errno
== EIO
|| errno
== EAGAIN
)
5033 if (errno
== EWOULDBLOCK
)
5039 if (got_some_output
< nread
)
5040 got_some_output
= nread
;
5043 read_some_bytes
= true;
5048 if (read_some_bytes
&& do_display
)
5049 redisplay_preserve_echo_area (10);
5054 /* Wait till there is something to do. */
5056 if (wait_proc
&& just_wait_proc
)
5058 if (wait_proc
->infd
< 0) /* Terminated. */
5060 FD_SET (wait_proc
->infd
, &Available
);
5064 else if (!NILP (wait_for_cell
))
5066 Available
= non_process_wait_mask
;
5073 Available
= non_keyboard_wait_mask
;
5075 Available
= input_wait_mask
;
5076 Writeok
= write_mask
;
5077 check_delay
= wait_proc
? 0 : process_output_delay_count
;
5081 /* If frame size has changed or the window is newly mapped,
5082 redisplay now, before we start to wait. There is a race
5083 condition here; if a SIGIO arrives between now and the select
5084 and indicates that a frame is trashed, the select may block
5085 displaying a trashed screen. */
5086 if (frame_garbaged
&& do_display
)
5088 clear_waiting_for_input ();
5089 redisplay_preserve_echo_area (11);
5091 set_waiting_for_input (&timeout
);
5094 /* Skip the `select' call if input is available and we're
5095 waiting for keyboard input or a cell change (which can be
5096 triggered by processing X events). In the latter case, set
5097 nfds to 1 to avoid breaking the loop. */
5099 if ((read_kbd
|| !NILP (wait_for_cell
))
5100 && detect_input_pending ())
5102 nfds
= read_kbd
? 0 : 1;
5104 FD_ZERO (&Available
);
5108 /* Set the timeout for adaptive read buffering if any
5109 process has non-zero read_output_skip and non-zero
5110 read_output_delay, and we are not reading output for a
5111 specific process. It is not executed if
5112 Vprocess_adaptive_read_buffering is nil. */
5113 if (process_output_skip
&& check_delay
> 0)
5115 int adaptive_nsecs
= timeout
.tv_nsec
;
5116 if (timeout
.tv_sec
> 0 || adaptive_nsecs
> READ_OUTPUT_DELAY_MAX
)
5117 adaptive_nsecs
= READ_OUTPUT_DELAY_MAX
;
5118 for (channel
= 0; check_delay
> 0 && channel
<= max_process_desc
; channel
++)
5120 proc
= chan_process
[channel
];
5123 /* Find minimum non-zero read_output_delay among the
5124 processes with non-zero read_output_skip. */
5125 if (XPROCESS (proc
)->read_output_delay
> 0)
5128 if (!XPROCESS (proc
)->read_output_skip
)
5130 FD_CLR (channel
, &Available
);
5131 process_skipped
= true;
5132 XPROCESS (proc
)->read_output_skip
= 0;
5133 if (XPROCESS (proc
)->read_output_delay
< adaptive_nsecs
)
5134 adaptive_nsecs
= XPROCESS (proc
)->read_output_delay
;
5137 timeout
= make_timespec (0, adaptive_nsecs
);
5138 process_output_skip
= 0;
5141 /* If we've got some output and haven't limited our timeout
5142 with adaptive read buffering, limit it. */
5143 if (got_some_output
> 0 && !process_skipped
5145 || timeout
.tv_nsec
> READ_OUTPUT_DELAY_INCREMENT
))
5146 timeout
= make_timespec (0, READ_OUTPUT_DELAY_INCREMENT
);
5149 if (NILP (wait_for_cell
) && just_wait_proc
>= 0
5150 && timespec_valid_p (timer_delay
)
5151 && timespec_cmp (timer_delay
, timeout
) < 0)
5153 if (!timespec_valid_p (now
))
5154 now
= current_timespec ();
5155 struct timespec timeout_abs
= timespec_add (now
, timeout
);
5156 if (!timespec_valid_p (got_output_end_time
)
5157 || timespec_cmp (timeout_abs
, got_output_end_time
) < 0)
5158 got_output_end_time
= timeout_abs
;
5159 timeout
= timer_delay
;
5162 got_output_end_time
= invalid_timespec ();
5164 /* NOW can become inaccurate if time can pass during pselect. */
5165 if (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0)
5166 now
= invalid_timespec ();
5168 #if defined (HAVE_NS)
5170 #elif defined (HAVE_GLIB)
5175 (max (max_process_desc
, max_input_desc
) + 1,
5177 (check_write
? &Writeok
: 0),
5178 NULL
, &timeout
, NULL
);
5181 /* GnuTLS buffers data internally. In lowat mode it leaves
5182 some data in the TCP buffers so that select works, but
5183 with custom pull/push functions we need to check if some
5184 data is available in the buffers manually. */
5187 fd_set tls_available
;
5190 FD_ZERO (&tls_available
);
5193 /* We're not waiting on a specific process, so loop
5194 through all the channels and check for data.
5195 This is a workaround needed for some versions of
5196 the gnutls library -- 2.12.14 has been confirmed
5198 http://comments.gmane.org/gmane.emacs.devel/145074 */
5199 for (channel
= 0; channel
< FD_SETSIZE
; ++channel
)
5200 if (! NILP (chan_process
[channel
]))
5202 struct Lisp_Process
*p
=
5203 XPROCESS (chan_process
[channel
]);
5204 if (p
&& p
->gnutls_p
&& p
->gnutls_state
5205 && ((emacs_gnutls_record_check_pending
5210 eassert (p
->infd
== channel
);
5211 FD_SET (p
->infd
, &tls_available
);
5218 /* Check this specific channel. */
5219 if (wait_proc
->gnutls_p
/* Check for valid process. */
5220 && wait_proc
->gnutls_state
5221 /* Do we have pending data? */
5222 && ((emacs_gnutls_record_check_pending
5223 (wait_proc
->gnutls_state
))
5227 eassert (0 <= wait_proc
->infd
);
5228 /* Set to Available. */
5229 FD_SET (wait_proc
->infd
, &tls_available
);
5234 Available
= tls_available
;
5241 /* Make C-g and alarm signals set flags again. */
5242 clear_waiting_for_input ();
5244 /* If we woke up due to SIGWINCH, actually change size now. */
5245 do_pending_window_change (0);
5249 /* Exit the main loop if we've passed the requested timeout,
5250 or aren't skipping processes and got some output and
5251 haven't lowered our timeout due to timers or SIGIO and
5252 have waited a long amount of time due to repeated
5256 struct timespec cmp_time
5259 : (!process_skipped
&& got_some_output
> 0
5260 && (timeout
.tv_sec
> 0 || timeout
.tv_nsec
> 0))
5261 ? got_output_end_time
5262 : invalid_timespec ());
5263 if (timespec_valid_p (cmp_time
))
5265 now
= current_timespec ();
5266 if (timespec_cmp (cmp_time
, now
) <= 0)
5273 if (xerrno
== EINTR
)
5275 else if (xerrno
== EBADF
)
5278 report_file_errno ("Failed select", Qnil
, xerrno
);
5281 /* Check for keyboard input. */
5282 /* If there is any, return immediately
5283 to give it higher priority than subprocesses. */
5287 unsigned old_timers_run
= timers_run
;
5288 struct buffer
*old_buffer
= current_buffer
;
5289 Lisp_Object old_window
= selected_window
;
5292 if (detect_input_pending_run_timers (do_display
))
5294 swallow_events (do_display
);
5295 if (detect_input_pending_run_timers (do_display
))
5299 /* If a timer has run, this might have changed buffers
5300 an alike. Make read_key_sequence aware of that. */
5301 if (timers_run
!= old_timers_run
5302 && waiting_for_user_input_p
== -1
5303 && (old_buffer
!= current_buffer
5304 || !EQ (old_window
, selected_window
)))
5305 record_asynch_buffer_change ();
5311 /* If there is unread keyboard input, also return. */
5313 && requeued_events_pending_p ())
5316 /* If we are not checking for keyboard input now,
5317 do process events (but don't run any timers).
5318 This is so that X events will be processed.
5319 Otherwise they may have to wait until polling takes place.
5320 That would causes delays in pasting selections, for example.
5322 (We used to do this only if wait_for_cell.) */
5323 if (read_kbd
== 0 && detect_input_pending ())
5325 swallow_events (do_display
);
5326 #if 0 /* Exiting when read_kbd doesn't request that seems wrong, though. */
5327 if (detect_input_pending ())
5332 /* Exit now if the cell we're waiting for became non-nil. */
5333 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
5337 /* If we think we have keyboard input waiting, but didn't get SIGIO,
5338 go read it. This can happen with X on BSD after logging out.
5339 In that case, there really is no input and no SIGIO,
5340 but select says there is input. */
5342 if (read_kbd
&& interrupt_input
5343 && keyboard_bit_set (&Available
) && ! noninteractive
)
5344 handle_input_available_signal (SIGIO
);
5347 /* If checking input just got us a size-change event from X,
5348 obey it now if we should. */
5349 if (read_kbd
|| ! NILP (wait_for_cell
))
5350 do_pending_window_change (0);
5352 /* Check for data from a process. */
5353 if (no_avail
|| nfds
== 0)
5356 for (channel
= 0; channel
<= max_input_desc
; ++channel
)
5358 struct fd_callback_data
*d
= &fd_callback_info
[channel
];
5360 && ((d
->condition
& FOR_READ
5361 && FD_ISSET (channel
, &Available
))
5362 || (d
->condition
& FOR_WRITE
5363 && FD_ISSET (channel
, &write_mask
))))
5364 d
->func (channel
, d
->data
);
5367 for (channel
= 0; channel
<= max_process_desc
; channel
++)
5369 if (FD_ISSET (channel
, &Available
)
5370 && FD_ISSET (channel
, &non_keyboard_wait_mask
)
5371 && !FD_ISSET (channel
, &non_process_wait_mask
))
5375 /* If waiting for this channel, arrange to return as
5376 soon as no more input to be processed. No more
5378 proc
= chan_process
[channel
];
5382 /* If this is a server stream socket, accept connection. */
5383 if (EQ (XPROCESS (proc
)->status
, Qlisten
))
5385 server_accept_connection (proc
, channel
);
5389 /* Read data from the process, starting with our
5390 buffered-ahead character if we have one. */
5392 nread
= read_process_output (proc
, channel
);
5393 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
5394 && got_some_output
< nread
)
5395 got_some_output
= nread
;
5398 /* Vacuum up any leftovers without waiting. */
5399 if (wait_proc
== XPROCESS (proc
))
5401 /* Since read_process_output can run a filter,
5402 which can call accept-process-output,
5403 don't try to read from any other processes
5404 before doing the select again. */
5405 FD_ZERO (&Available
);
5408 redisplay_preserve_echo_area (12);
5411 else if (nread
== -1 && errno
== EWOULDBLOCK
)
5414 else if (nread
== -1 && errno
== EAGAIN
)
5417 /* FIXME: Is this special case still needed? */
5418 /* Note that we cannot distinguish between no input
5419 available now and a closed pipe.
5420 With luck, a closed pipe will be accompanied by
5421 subprocess termination and SIGCHLD. */
5422 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5423 && !PIPECONN_P (proc
))
5427 /* On some OSs with ptys, when the process on one end of
5428 a pty exits, the other end gets an error reading with
5429 errno = EIO instead of getting an EOF (0 bytes read).
5430 Therefore, if we get an error reading and errno =
5431 EIO, just continue, because the child process has
5432 exited and should clean itself up soon (e.g. when we
5434 else if (nread
== -1 && errno
== EIO
)
5436 struct Lisp_Process
*p
= XPROCESS (proc
);
5438 /* Clear the descriptor now, so we only raise the
5440 FD_CLR (channel
, &input_wait_mask
);
5441 FD_CLR (channel
, &non_keyboard_wait_mask
);
5445 /* If the EIO occurs on a pty, the SIGCHLD handler's
5446 waitpid call will not find the process object to
5447 delete. Do it here. */
5448 p
->tick
= ++process_tick
;
5449 pset_status (p
, Qfailed
);
5452 #endif /* HAVE_PTYS */
5453 /* If we can detect process termination, don't consider the
5454 process gone just because its pipe is closed. */
5455 else if (nread
== 0 && !NETCONN_P (proc
) && !SERIALCONN_P (proc
)
5456 && !PIPECONN_P (proc
))
5458 else if (nread
== 0 && PIPECONN_P (proc
))
5460 /* Preserve status of processes already terminated. */
5461 XPROCESS (proc
)->tick
= ++process_tick
;
5462 deactivate_process (proc
);
5463 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5464 pset_status (XPROCESS (proc
),
5465 list2 (Qexit
, make_number (0)));
5469 /* Preserve status of processes already terminated. */
5470 XPROCESS (proc
)->tick
= ++process_tick
;
5471 deactivate_process (proc
);
5472 if (XPROCESS (proc
)->raw_status_new
)
5473 update_status (XPROCESS (proc
));
5474 if (EQ (XPROCESS (proc
)->status
, Qrun
))
5475 pset_status (XPROCESS (proc
),
5476 list2 (Qexit
, make_number (256)));
5479 #ifdef NON_BLOCKING_CONNECT
5480 if (FD_ISSET (channel
, &Writeok
)
5481 && FD_ISSET (channel
, &connect_wait_mask
))
5483 struct Lisp_Process
*p
;
5485 FD_CLR (channel
, &connect_wait_mask
);
5486 FD_CLR (channel
, &write_mask
);
5487 if (--num_pending_connects
< 0)
5490 proc
= chan_process
[channel
];
5494 p
= XPROCESS (proc
);
5497 /* getsockopt(,,SO_ERROR,,) is said to hang on some systems.
5498 So only use it on systems where it is known to work. */
5500 socklen_t xlen
= sizeof (xerrno
);
5501 if (getsockopt (channel
, SOL_SOCKET
, SO_ERROR
, &xerrno
, &xlen
))
5506 struct sockaddr pname
;
5507 socklen_t pnamelen
= sizeof (pname
);
5509 /* If connection failed, getpeername will fail. */
5511 if (getpeername (channel
, &pname
, &pnamelen
) < 0)
5513 /* Obtain connect failure code through error slippage. */
5516 if (errno
== ENOTCONN
&& read (channel
, &dummy
, 1) < 0)
5523 p
->tick
= ++process_tick
;
5524 pset_status (p
, list2 (Qfailed
, make_number (xerrno
)));
5525 deactivate_process (proc
);
5529 if (NILP (p
->gnutls_boot_parameters
))
5531 pset_status (p
, Qrun
);
5532 /* Execute the sentinel here. If we had relied on
5533 status_notify to do it later, it will read input
5534 from the process before calling the sentinel. */
5535 exec_sentinel (proc
, build_string ("open\n"));
5538 if (0 <= p
->infd
&& !EQ (p
->filter
, Qt
)
5539 && !EQ (p
->command
, Qt
))
5541 FD_SET (p
->infd
, &input_wait_mask
);
5542 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
5546 #endif /* NON_BLOCKING_CONNECT */
5547 } /* End for each file descriptor. */
5548 } /* End while exit conditions not met. */
5550 unbind_to (count
, Qnil
);
5552 /* If calling from keyboard input, do not quit
5553 since we want to return C-g as an input character.
5554 Otherwise, do pending quit if requested. */
5557 /* Prevent input_pending from remaining set if we quit. */
5558 clear_input_pending ();
5562 return got_some_output
;
5565 /* Given a list (FUNCTION ARGS...), apply FUNCTION to the ARGS. */
5568 read_process_output_call (Lisp_Object fun_and_args
)
5570 return apply1 (XCAR (fun_and_args
), XCDR (fun_and_args
));
5574 read_process_output_error_handler (Lisp_Object error_val
)
5576 cmd_error_internal (error_val
, "error in process filter: ");
5578 update_echo_area ();
5579 Fsleep_for (make_number (2), Qnil
);
5584 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5586 struct coding_system
*coding
);
5588 /* Read pending output from the process channel,
5589 starting with our buffered-ahead character if we have one.
5590 Yield number of decoded characters read.
5592 This function reads at most 4096 characters.
5593 If you want to read all available subprocess output,
5594 you must call it repeatedly until it returns zero.
5596 The characters read are decoded according to PROC's coding-system
5600 read_process_output (Lisp_Object proc
, int channel
)
5603 struct Lisp_Process
*p
= XPROCESS (proc
);
5604 struct coding_system
*coding
= proc_decode_coding_system
[channel
];
5605 int carryover
= p
->decoding_carryover
;
5606 enum { readmax
= 4096 };
5607 ptrdiff_t count
= SPECPDL_INDEX ();
5608 Lisp_Object odeactivate
;
5609 char chars
[sizeof coding
->carryover
+ readmax
];
5612 /* See the comment above. */
5613 memcpy (chars
, SDATA (p
->decoding_buf
), carryover
);
5615 #ifdef DATAGRAM_SOCKETS
5616 /* We have a working select, so proc_buffered_char is always -1. */
5617 if (DATAGRAM_CHAN_P (channel
))
5619 socklen_t len
= datagram_address
[channel
].len
;
5620 nbytes
= recvfrom (channel
, chars
+ carryover
, readmax
,
5621 0, datagram_address
[channel
].sa
, &len
);
5626 bool buffered
= proc_buffered_char
[channel
] >= 0;
5629 chars
[carryover
] = proc_buffered_char
[channel
];
5630 proc_buffered_char
[channel
] = -1;
5633 if (p
->gnutls_p
&& p
->gnutls_state
)
5634 nbytes
= emacs_gnutls_read (p
, chars
+ carryover
+ buffered
,
5635 readmax
- buffered
);
5638 nbytes
= emacs_read (channel
, chars
+ carryover
+ buffered
,
5639 readmax
- buffered
);
5640 if (nbytes
> 0 && p
->adaptive_read_buffering
)
5642 int delay
= p
->read_output_delay
;
5645 if (delay
< READ_OUTPUT_DELAY_MAX_MAX
)
5648 process_output_delay_count
++;
5649 delay
+= READ_OUTPUT_DELAY_INCREMENT
* 2;
5652 else if (delay
> 0 && nbytes
== readmax
- buffered
)
5654 delay
-= READ_OUTPUT_DELAY_INCREMENT
;
5656 process_output_delay_count
--;
5658 p
->read_output_delay
= delay
;
5661 p
->read_output_skip
= 1;
5662 process_output_skip
= 1;
5666 nbytes
+= buffered
&& nbytes
<= 0;
5669 p
->decoding_carryover
= 0;
5671 /* At this point, NBYTES holds number of bytes just received
5672 (including the one in proc_buffered_char[channel]). */
5675 if (nbytes
< 0 || coding
->mode
& CODING_MODE_LAST_BLOCK
)
5677 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
5680 /* Now set NBYTES how many bytes we must decode. */
5681 nbytes
+= carryover
;
5683 odeactivate
= Vdeactivate_mark
;
5684 /* There's no good reason to let process filters change the current
5685 buffer, and many callers of accept-process-output, sit-for, and
5686 friends don't expect current-buffer to be changed from under them. */
5687 record_unwind_current_buffer ();
5689 read_and_dispose_of_process_output (p
, chars
, nbytes
, coding
);
5691 /* Handling the process output should not deactivate the mark. */
5692 Vdeactivate_mark
= odeactivate
;
5694 unbind_to (count
, Qnil
);
5699 read_and_dispose_of_process_output (struct Lisp_Process
*p
, char *chars
,
5701 struct coding_system
*coding
)
5703 Lisp_Object outstream
= p
->filter
;
5705 bool outer_running_asynch_code
= running_asynch_code
;
5706 int waiting
= waiting_for_user_input_p
;
5709 Lisp_Object obuffer
, okeymap
;
5710 XSETBUFFER (obuffer
, current_buffer
);
5711 okeymap
= BVAR (current_buffer
, keymap
);
5714 /* We inhibit quit here instead of just catching it so that
5715 hitting ^G when a filter happens to be running won't screw
5717 specbind (Qinhibit_quit
, Qt
);
5718 specbind (Qlast_nonmenu_event
, Qt
);
5720 /* In case we get recursively called,
5721 and we already saved the match data nonrecursively,
5722 save the same match data in safely recursive fashion. */
5723 if (outer_running_asynch_code
)
5726 /* Don't clobber the CURRENT match data, either! */
5727 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
5728 restore_search_regs ();
5729 record_unwind_save_match_data ();
5730 Fset_match_data (tem
, Qt
);
5733 /* For speed, if a search happens within this code,
5734 save the match data in a special nonrecursive fashion. */
5735 running_asynch_code
= 1;
5737 decode_coding_c_string (coding
, (unsigned char *) chars
, nbytes
, Qt
);
5738 text
= coding
->dst_object
;
5739 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
5740 /* A new coding system might be found. */
5741 if (!EQ (p
->decode_coding_system
, Vlast_coding_system_used
))
5743 pset_decode_coding_system (p
, Vlast_coding_system_used
);
5745 /* Don't call setup_coding_system for
5746 proc_decode_coding_system[channel] here. It is done in
5747 detect_coding called via decode_coding above. */
5749 /* If a coding system for encoding is not yet decided, we set
5750 it as the same as coding-system for decoding.
5752 But, before doing that we must check if
5753 proc_encode_coding_system[p->outfd] surely points to a
5754 valid memory because p->outfd will be changed once EOF is
5755 sent to the process. */
5756 if (NILP (p
->encode_coding_system
) && p
->outfd
>= 0
5757 && proc_encode_coding_system
[p
->outfd
])
5759 pset_encode_coding_system
5760 (p
, coding_inherit_eol_type (Vlast_coding_system_used
, Qnil
));
5761 setup_coding_system (p
->encode_coding_system
,
5762 proc_encode_coding_system
[p
->outfd
]);
5766 if (coding
->carryover_bytes
> 0)
5768 if (SCHARS (p
->decoding_buf
) < coding
->carryover_bytes
)
5769 pset_decoding_buf (p
, make_uninit_string (coding
->carryover_bytes
));
5770 memcpy (SDATA (p
->decoding_buf
), coding
->carryover
,
5771 coding
->carryover_bytes
);
5772 p
->decoding_carryover
= coding
->carryover_bytes
;
5774 if (SBYTES (text
) > 0)
5775 /* FIXME: It's wrong to wrap or not based on debug-on-error, and
5776 sometimes it's simply wrong to wrap (e.g. when called from
5777 accept-process-output). */
5778 internal_condition_case_1 (read_process_output_call
,
5779 list3 (outstream
, make_lisp_proc (p
), text
),
5780 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
5781 read_process_output_error_handler
);
5783 /* If we saved the match data nonrecursively, restore it now. */
5784 restore_search_regs ();
5785 running_asynch_code
= outer_running_asynch_code
;
5787 /* Restore waiting_for_user_input_p as it was
5788 when we were called, in case the filter clobbered it. */
5789 waiting_for_user_input_p
= waiting
;
5791 #if 0 /* Call record_asynch_buffer_change unconditionally,
5792 because we might have changed minor modes or other things
5793 that affect key bindings. */
5794 if (! EQ (Fcurrent_buffer (), obuffer
)
5795 || ! EQ (current_buffer
->keymap
, okeymap
))
5797 /* But do it only if the caller is actually going to read events.
5798 Otherwise there's no need to make him wake up, and it could
5799 cause trouble (for example it would make sit_for return). */
5800 if (waiting_for_user_input_p
== -1)
5801 record_asynch_buffer_change ();
5804 DEFUN ("internal-default-process-filter", Finternal_default_process_filter
,
5805 Sinternal_default_process_filter
, 2, 2, 0,
5806 doc
: /* Function used as default process filter.
5807 This inserts the process's output into its buffer, if there is one.
5808 Otherwise it discards the output. */)
5809 (Lisp_Object proc
, Lisp_Object text
)
5811 struct Lisp_Process
*p
;
5814 CHECK_PROCESS (proc
);
5815 p
= XPROCESS (proc
);
5816 CHECK_STRING (text
);
5818 if (!NILP (p
->buffer
) && BUFFER_LIVE_P (XBUFFER (p
->buffer
)))
5820 Lisp_Object old_read_only
;
5821 ptrdiff_t old_begv
, old_zv
;
5822 ptrdiff_t old_begv_byte
, old_zv_byte
;
5823 ptrdiff_t before
, before_byte
;
5824 ptrdiff_t opoint_byte
;
5827 Fset_buffer (p
->buffer
);
5829 opoint_byte
= PT_BYTE
;
5830 old_read_only
= BVAR (current_buffer
, read_only
);
5833 old_begv_byte
= BEGV_BYTE
;
5834 old_zv_byte
= ZV_BYTE
;
5836 bset_read_only (current_buffer
, Qnil
);
5838 /* Insert new output into buffer at the current end-of-output
5839 marker, thus preserving logical ordering of input and output. */
5840 if (XMARKER (p
->mark
)->buffer
)
5841 set_point_from_marker (p
->mark
);
5843 SET_PT_BOTH (ZV
, ZV_BYTE
);
5845 before_byte
= PT_BYTE
;
5847 /* If the output marker is outside of the visible region, save
5848 the restriction and widen. */
5849 if (! (BEGV
<= PT
&& PT
<= ZV
))
5852 /* Adjust the multibyteness of TEXT to that of the buffer. */
5853 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
))
5854 != ! STRING_MULTIBYTE (text
))
5855 text
= (STRING_MULTIBYTE (text
)
5856 ? Fstring_as_unibyte (text
)
5857 : Fstring_to_multibyte (text
));
5858 /* Insert before markers in case we are inserting where
5859 the buffer's mark is, and the user's next command is Meta-y. */
5860 insert_from_string_before_markers (text
, 0, 0,
5861 SCHARS (text
), SBYTES (text
), 0);
5863 /* Make sure the process marker's position is valid when the
5864 process buffer is changed in the signal_after_change above.
5865 W3 is known to do that. */
5866 if (BUFFERP (p
->buffer
)
5867 && (b
= XBUFFER (p
->buffer
), b
!= current_buffer
))
5868 set_marker_both (p
->mark
, p
->buffer
, BUF_PT (b
), BUF_PT_BYTE (b
));
5870 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
5872 update_mode_lines
= 23;
5874 /* Make sure opoint and the old restrictions
5875 float ahead of any new text just as point would. */
5876 if (opoint
>= before
)
5878 opoint
+= PT
- before
;
5879 opoint_byte
+= PT_BYTE
- before_byte
;
5881 if (old_begv
> before
)
5883 old_begv
+= PT
- before
;
5884 old_begv_byte
+= PT_BYTE
- before_byte
;
5886 if (old_zv
>= before
)
5888 old_zv
+= PT
- before
;
5889 old_zv_byte
+= PT_BYTE
- before_byte
;
5892 /* If the restriction isn't what it should be, set it. */
5893 if (old_begv
!= BEGV
|| old_zv
!= ZV
)
5894 Fnarrow_to_region (make_number (old_begv
), make_number (old_zv
));
5896 bset_read_only (current_buffer
, old_read_only
);
5897 SET_PT_BOTH (opoint
, opoint_byte
);
5902 /* Sending data to subprocess. */
5904 /* In send_process, when a write fails temporarily,
5905 wait_reading_process_output is called. It may execute user code,
5906 e.g. timers, that attempts to write new data to the same process.
5907 We must ensure that data is sent in the right order, and not
5908 interspersed half-completed with other writes (Bug#10815). This is
5909 handled by the write_queue element of struct process. It is a list
5910 with each entry having the form
5912 (string . (offset . length))
5914 where STRING is a lisp string, OFFSET is the offset into the
5915 string's byte sequence from which we should begin to send, and
5916 LENGTH is the number of bytes left to send. */
5918 /* Create a new entry in write_queue.
5919 INPUT_OBJ should be a buffer, string Qt, or Qnil.
5920 BUF is a pointer to the string sequence of the input_obj or a C
5921 string in case of Qt or Qnil. */
5924 write_queue_push (struct Lisp_Process
*p
, Lisp_Object input_obj
,
5925 const char *buf
, ptrdiff_t len
, bool front
)
5928 Lisp_Object entry
, obj
;
5930 if (STRINGP (input_obj
))
5932 offset
= buf
- SSDATA (input_obj
);
5938 obj
= make_unibyte_string (buf
, len
);
5941 entry
= Fcons (obj
, Fcons (make_number (offset
), make_number (len
)));
5944 pset_write_queue (p
, Fcons (entry
, p
->write_queue
));
5946 pset_write_queue (p
, nconc2 (p
->write_queue
, list1 (entry
)));
5949 /* Remove the first element in the write_queue of process P, put its
5950 contents in OBJ, BUF and LEN, and return true. If the
5951 write_queue is empty, return false. */
5954 write_queue_pop (struct Lisp_Process
*p
, Lisp_Object
*obj
,
5955 const char **buf
, ptrdiff_t *len
)
5957 Lisp_Object entry
, offset_length
;
5960 if (NILP (p
->write_queue
))
5963 entry
= XCAR (p
->write_queue
);
5964 pset_write_queue (p
, XCDR (p
->write_queue
));
5966 *obj
= XCAR (entry
);
5967 offset_length
= XCDR (entry
);
5969 *len
= XINT (XCDR (offset_length
));
5970 offset
= XINT (XCAR (offset_length
));
5971 *buf
= SSDATA (*obj
) + offset
;
5976 /* Send some data to process PROC.
5977 BUF is the beginning of the data; LEN is the number of characters.
5978 OBJECT is the Lisp object that the data comes from. If OBJECT is
5979 nil or t, it means that the data comes from C string.
5981 If OBJECT is not nil, the data is encoded by PROC's coding-system
5982 for encoding before it is sent.
5984 This function can evaluate Lisp code and can garbage collect. */
5987 send_process (Lisp_Object proc
, const char *buf
, ptrdiff_t len
,
5990 struct Lisp_Process
*p
= XPROCESS (proc
);
5992 struct coding_system
*coding
;
5994 if (NETCONN_P (proc
)) {
5995 wait_while_connecting (proc
);
5996 wait_for_tls_negotiation (proc
);
5999 if (p
->raw_status_new
)
6001 if (! EQ (p
->status
, Qrun
))
6002 error ("Process %s not running", SDATA (p
->name
));
6004 error ("Output file descriptor of %s is closed", SDATA (p
->name
));
6006 coding
= proc_encode_coding_system
[p
->outfd
];
6007 Vlast_coding_system_used
= CODING_ID_NAME (coding
->id
);
6009 if ((STRINGP (object
) && STRING_MULTIBYTE (object
))
6010 || (BUFFERP (object
)
6011 && !NILP (BVAR (XBUFFER (object
), enable_multibyte_characters
)))
6014 pset_encode_coding_system
6015 (p
, complement_process_encoding_system (p
->encode_coding_system
));
6016 if (!EQ (Vlast_coding_system_used
, p
->encode_coding_system
))
6018 /* The coding system for encoding was changed to raw-text
6019 because we sent a unibyte text previously. Now we are
6020 sending a multibyte text, thus we must encode it by the
6021 original coding system specified for the current process.
6023 Another reason we come here is that the coding system
6024 was just complemented and a new one was returned by
6025 complement_process_encoding_system. */
6026 setup_coding_system (p
->encode_coding_system
, coding
);
6027 Vlast_coding_system_used
= p
->encode_coding_system
;
6029 coding
->src_multibyte
= 1;
6033 coding
->src_multibyte
= 0;
6034 /* For sending a unibyte text, character code conversion should
6035 not take place but EOL conversion should. So, setup raw-text
6036 or one of the subsidiary if we have not yet done it. */
6037 if (CODING_REQUIRE_ENCODING (coding
))
6039 if (CODING_REQUIRE_FLUSHING (coding
))
6041 /* But, before changing the coding, we must flush out data. */
6042 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6043 send_process (proc
, "", 0, Qt
);
6044 coding
->mode
&= CODING_MODE_LAST_BLOCK
;
6046 setup_coding_system (raw_text_coding_system
6047 (Vlast_coding_system_used
),
6049 coding
->src_multibyte
= 0;
6052 coding
->dst_multibyte
= 0;
6054 if (CODING_REQUIRE_ENCODING (coding
))
6056 coding
->dst_object
= Qt
;
6057 if (BUFFERP (object
))
6059 ptrdiff_t from_byte
, from
, to
;
6060 ptrdiff_t save_pt
, save_pt_byte
;
6061 struct buffer
*cur
= current_buffer
;
6063 set_buffer_internal (XBUFFER (object
));
6064 save_pt
= PT
, save_pt_byte
= PT_BYTE
;
6066 from_byte
= PTR_BYTE_POS ((unsigned char *) buf
);
6067 from
= BYTE_TO_CHAR (from_byte
);
6068 to
= BYTE_TO_CHAR (from_byte
+ len
);
6069 TEMP_SET_PT_BOTH (from
, from_byte
);
6070 encode_coding_object (coding
, object
, from
, from_byte
,
6071 to
, from_byte
+ len
, Qt
);
6072 TEMP_SET_PT_BOTH (save_pt
, save_pt_byte
);
6073 set_buffer_internal (cur
);
6075 else if (STRINGP (object
))
6077 encode_coding_object (coding
, object
, 0, 0, SCHARS (object
),
6078 SBYTES (object
), Qt
);
6082 coding
->dst_object
= make_unibyte_string (buf
, len
);
6083 coding
->produced
= len
;
6086 len
= coding
->produced
;
6087 object
= coding
->dst_object
;
6088 buf
= SSDATA (object
);
6091 /* If there is already data in the write_queue, put the new data
6092 in the back of queue. Otherwise, ignore it. */
6093 if (!NILP (p
->write_queue
))
6094 write_queue_push (p
, object
, buf
, len
, 0);
6096 do /* while !NILP (p->write_queue) */
6098 ptrdiff_t cur_len
= -1;
6099 const char *cur_buf
;
6100 Lisp_Object cur_object
;
6102 /* If write_queue is empty, ignore it. */
6103 if (!write_queue_pop (p
, &cur_object
, &cur_buf
, &cur_len
))
6107 cur_object
= object
;
6112 /* Send this batch, using one or more write calls. */
6113 ptrdiff_t written
= 0;
6114 int outfd
= p
->outfd
;
6115 #ifdef DATAGRAM_SOCKETS
6116 if (DATAGRAM_CHAN_P (outfd
))
6118 rv
= sendto (outfd
, cur_buf
, cur_len
,
6119 0, datagram_address
[outfd
].sa
,
6120 datagram_address
[outfd
].len
);
6123 else if (errno
== EMSGSIZE
)
6124 report_file_error ("Sending datagram", proc
);
6130 if (p
->gnutls_p
&& p
->gnutls_state
)
6131 written
= emacs_gnutls_write (p
, cur_buf
, cur_len
);
6134 written
= emacs_write_sig (outfd
, cur_buf
, cur_len
);
6135 rv
= (written
? 0 : -1);
6136 if (p
->read_output_delay
> 0
6137 && p
->adaptive_read_buffering
== 1)
6139 p
->read_output_delay
= 0;
6140 process_output_delay_count
--;
6141 p
->read_output_skip
= 0;
6149 || errno
== EWOULDBLOCK
6152 /* Buffer is full. Wait, accepting input;
6153 that may allow the program
6154 to finish doing output and read more. */
6156 #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
6157 /* A gross hack to work around a bug in FreeBSD.
6158 In the following sequence, read(2) returns
6162 write(2) 954 bytes, get EAGAIN
6163 read(2) 1024 bytes in process_read_output
6164 read(2) 11 bytes in process_read_output
6166 That is, read(2) returns more bytes than have
6167 ever been written successfully. The 1033 bytes
6168 read are the 1022 bytes written successfully
6169 after processing (for example with CRs added if
6170 the terminal is set up that way which it is
6171 here). The same bytes will be seen again in a
6172 later read(2), without the CRs. */
6174 if (errno
== EAGAIN
)
6177 ioctl (p
->outfd
, TIOCFLUSH
, &flags
);
6179 #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
6181 /* Put what we should have written in wait_queue. */
6182 write_queue_push (p
, cur_object
, cur_buf
, cur_len
, 1);
6183 wait_reading_process_output (0, 20 * 1000 * 1000,
6184 0, 0, Qnil
, NULL
, 0);
6185 /* Reread queue, to see what is left. */
6188 else if (errno
== EPIPE
)
6190 p
->raw_status_new
= 0;
6191 pset_status (p
, list2 (Qexit
, make_number (256)));
6192 p
->tick
= ++process_tick
;
6193 deactivate_process (proc
);
6194 error ("process %s no longer connected to pipe; closed it",
6198 /* This is a real error. */
6199 report_file_error ("Writing to process", proc
);
6205 while (!NILP (p
->write_queue
));
6208 DEFUN ("process-send-region", Fprocess_send_region
, Sprocess_send_region
,
6210 doc
: /* Send current contents of region as input to PROCESS.
6211 PROCESS may be a process, a buffer, the name of a process or buffer, or
6212 nil, indicating the current buffer's process.
6213 Called from program, takes three arguments, PROCESS, START and END.
6214 If the region is more than 500 characters long,
6215 it is sent in several bunches. This may happen even for shorter regions.
6216 Output from processes can arrive in between bunches. */)
6217 (Lisp_Object process
, Lisp_Object start
, Lisp_Object end
)
6219 Lisp_Object proc
= get_process (process
);
6220 ptrdiff_t start_byte
, end_byte
;
6222 validate_region (&start
, &end
);
6224 start_byte
= CHAR_TO_BYTE (XINT (start
));
6225 end_byte
= CHAR_TO_BYTE (XINT (end
));
6227 if (XINT (start
) < GPT
&& XINT (end
) > GPT
)
6228 move_gap_both (XINT (start
), start_byte
);
6230 if (NETCONN_P (proc
))
6231 wait_while_connecting (proc
);
6233 send_process (proc
, (char *) BYTE_POS_ADDR (start_byte
),
6234 end_byte
- start_byte
, Fcurrent_buffer ());
6239 DEFUN ("process-send-string", Fprocess_send_string
, Sprocess_send_string
,
6241 doc
: /* Send PROCESS the contents of STRING as input.
6242 PROCESS may be a process, a buffer, the name of a process or buffer, or
6243 nil, indicating the current buffer's process.
6244 If STRING is more than 500 characters long,
6245 it is sent in several bunches. This may happen even for shorter strings.
6246 Output from processes can arrive in between bunches. */)
6247 (Lisp_Object process
, Lisp_Object string
)
6250 CHECK_STRING (string
);
6251 proc
= get_process (process
);
6253 send_process (proc
, SSDATA (string
),
6254 SBYTES (string
), string
);
6258 /* Return the foreground process group for the tty/pty that
6259 the process P uses. */
6261 emacs_get_tty_pgrp (struct Lisp_Process
*p
)
6266 if (ioctl (p
->infd
, TIOCGPGRP
, &gid
) == -1 && ! NILP (p
->tty_name
))
6269 /* Some OS:es (Solaris 8/9) does not allow TIOCGPGRP from the
6270 master side. Try the slave side. */
6271 fd
= emacs_open (SSDATA (p
->tty_name
), O_RDONLY
, 0);
6275 ioctl (fd
, TIOCGPGRP
, &gid
);
6279 #endif /* defined (TIOCGPGRP ) */
6284 DEFUN ("process-running-child-p", Fprocess_running_child_p
,
6285 Sprocess_running_child_p
, 0, 1, 0,
6286 doc
: /* Return non-nil if PROCESS has given the terminal to a
6287 child. If the operating system does not make it possible to find out,
6288 return t. If we can find out, return the numeric ID of the foreground
6290 (Lisp_Object process
)
6292 /* Initialize in case ioctl doesn't exist or gives an error,
6293 in a way that will cause returning t. */
6296 struct Lisp_Process
*p
;
6298 proc
= get_process (process
);
6299 p
= XPROCESS (proc
);
6301 if (!EQ (p
->type
, Qreal
))
6302 error ("Process %s is not a subprocess",
6305 error ("Process %s is not active",
6308 gid
= emacs_get_tty_pgrp (p
);
6313 return make_number (gid
);
6317 /* Send a signal number SIGNO to PROCESS.
6318 If CURRENT_GROUP is t, that means send to the process group
6319 that currently owns the terminal being used to communicate with PROCESS.
6320 This is used for various commands in shell mode.
6321 If CURRENT_GROUP is lambda, that means send to the process group
6322 that currently owns the terminal, but only if it is NOT the shell itself.
6324 If NOMSG is false, insert signal-announcements into process's buffers
6327 If we can, we try to signal PROCESS by sending control characters
6328 down the pty. This allows us to signal inferiors who have changed
6329 their uid, for which kill would return an EPERM error. */
6332 process_send_signal (Lisp_Object process
, int signo
, Lisp_Object current_group
,
6336 struct Lisp_Process
*p
;
6340 proc
= get_process (process
);
6341 p
= XPROCESS (proc
);
6343 if (!EQ (p
->type
, Qreal
))
6344 error ("Process %s is not a subprocess",
6347 error ("Process %s is not active",
6351 current_group
= Qnil
;
6353 /* If we are using pgrps, get a pgrp number and make it negative. */
6354 if (NILP (current_group
))
6355 /* Send the signal to the shell's process group. */
6359 #ifdef SIGNALS_VIA_CHARACTERS
6360 /* If possible, send signals to the entire pgrp
6361 by sending an input character to it. */
6364 cc_t
*sig_char
= NULL
;
6366 tcgetattr (p
->infd
, &t
);
6371 sig_char
= &t
.c_cc
[VINTR
];
6375 sig_char
= &t
.c_cc
[VQUIT
];
6379 #if defined (VSWTCH) && !defined (PREFER_VSUSP)
6380 sig_char
= &t
.c_cc
[VSWTCH
];
6382 sig_char
= &t
.c_cc
[VSUSP
];
6387 if (sig_char
&& *sig_char
!= CDISABLE
)
6389 send_process (proc
, (char *) sig_char
, 1, Qnil
);
6392 /* If we can't send the signal with a character,
6393 fall through and send it another way. */
6395 /* The code above may fall through if it can't
6396 handle the signal. */
6397 #endif /* defined (SIGNALS_VIA_CHARACTERS) */
6400 /* Get the current pgrp using the tty itself, if we have that.
6401 Otherwise, use the pty to get the pgrp.
6402 On pfa systems, saka@pfu.fujitsu.co.JP writes:
6403 "TIOCGPGRP symbol defined in sys/ioctl.h at E50.
6404 But, TIOCGPGRP does not work on E50 ;-P works fine on E60"
6405 His patch indicates that if TIOCGPGRP returns an error, then
6406 we should just assume that p->pid is also the process group id. */
6408 gid
= emacs_get_tty_pgrp (p
);
6411 /* If we can't get the information, assume
6412 the shell owns the tty. */
6415 /* It is not clear whether anything really can set GID to -1.
6416 Perhaps on some system one of those ioctls can or could do so.
6417 Or perhaps this is vestigial. */
6420 #else /* ! defined (TIOCGPGRP) */
6421 /* Can't select pgrps on this system, so we know that
6422 the child itself heads the pgrp. */
6424 #endif /* ! defined (TIOCGPGRP) */
6426 /* If current_group is lambda, and the shell owns the terminal,
6427 don't send any signal. */
6428 if (EQ (current_group
, Qlambda
) && gid
== p
->pid
)
6433 if (signo
== SIGCONT
)
6435 p
->raw_status_new
= 0;
6436 pset_status (p
, Qrun
);
6437 p
->tick
= ++process_tick
;
6440 status_notify (NULL
, NULL
);
6441 redisplay_preserve_echo_area (13);
6447 /* Work around a HP-UX 7.0 bug that mishandles signals to subjobs.
6448 We don't know whether the bug is fixed in later HP-UX versions. */
6449 if (! NILP (current_group
) && ioctl (p
->infd
, TIOCSIGSEND
, signo
) != -1)
6453 /* If we don't have process groups, send the signal to the immediate
6454 subprocess. That isn't really right, but it's better than any
6455 obvious alternative. */
6456 pid_t pid
= no_pgrp
? gid
: - gid
;
6458 /* Do not kill an already-reaped process, as that could kill an
6459 innocent bystander that happens to have the same process ID. */
6461 block_child_signal (&oldset
);
6464 unblock_child_signal (&oldset
);
6467 DEFUN ("interrupt-process", Finterrupt_process
, Sinterrupt_process
, 0, 2, 0,
6468 doc
: /* Interrupt process PROCESS.
6469 PROCESS may be a process, a buffer, or the name of a process or buffer.
6470 No arg or nil means current buffer's process.
6471 Second arg CURRENT-GROUP non-nil means send signal to
6472 the current process-group of the process's controlling terminal
6473 rather than to the process's own process group.
6474 If the process is a shell, this means interrupt current subjob
6475 rather than the shell.
6477 If CURRENT-GROUP is `lambda', and if the shell owns the terminal,
6478 don't send the signal. */)
6479 (Lisp_Object process
, Lisp_Object current_group
)
6481 process_send_signal (process
, SIGINT
, current_group
, 0);
6485 DEFUN ("kill-process", Fkill_process
, Skill_process
, 0, 2, 0,
6486 doc
: /* Kill process PROCESS. May be process or name of one.
6487 See function `interrupt-process' for more details on usage. */)
6488 (Lisp_Object process
, Lisp_Object current_group
)
6490 process_send_signal (process
, SIGKILL
, current_group
, 0);
6494 DEFUN ("quit-process", Fquit_process
, Squit_process
, 0, 2, 0,
6495 doc
: /* Send QUIT signal to process PROCESS. May be process or name of one.
6496 See function `interrupt-process' for more details on usage. */)
6497 (Lisp_Object process
, Lisp_Object current_group
)
6499 process_send_signal (process
, SIGQUIT
, current_group
, 0);
6503 DEFUN ("stop-process", Fstop_process
, Sstop_process
, 0, 2, 0,
6504 doc
: /* Stop process PROCESS. May be process or name of one.
6505 See function `interrupt-process' for more details on usage.
6506 If PROCESS is a network or serial process, inhibit handling of incoming
6508 (Lisp_Object process
, Lisp_Object current_group
)
6510 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6511 || PIPECONN_P (process
)))
6513 struct Lisp_Process
*p
;
6515 p
= XPROCESS (process
);
6516 if (NILP (p
->command
)
6519 FD_CLR (p
->infd
, &input_wait_mask
);
6520 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6522 pset_command (p
, Qt
);
6526 error ("No SIGTSTP support");
6528 process_send_signal (process
, SIGTSTP
, current_group
, 0);
6533 DEFUN ("continue-process", Fcontinue_process
, Scontinue_process
, 0, 2, 0,
6534 doc
: /* Continue process PROCESS. May be process or name of one.
6535 See function `interrupt-process' for more details on usage.
6536 If PROCESS is a network or serial process, resume handling of incoming
6538 (Lisp_Object process
, Lisp_Object current_group
)
6540 if (PROCESSP (process
) && (NETCONN_P (process
) || SERIALCONN_P (process
)
6541 || PIPECONN_P (process
)))
6543 struct Lisp_Process
*p
;
6545 p
= XPROCESS (process
);
6546 if (EQ (p
->command
, Qt
)
6548 && (!EQ (p
->filter
, Qt
) || EQ (p
->status
, Qlisten
)))
6550 FD_SET (p
->infd
, &input_wait_mask
);
6551 FD_SET (p
->infd
, &non_keyboard_wait_mask
);
6553 if (fd_info
[ p
->infd
].flags
& FILE_SERIAL
)
6554 PurgeComm (fd_info
[ p
->infd
].hnd
, PURGE_RXABORT
| PURGE_RXCLEAR
);
6555 #else /* not WINDOWSNT */
6556 tcflush (p
->infd
, TCIFLUSH
);
6557 #endif /* not WINDOWSNT */
6559 pset_command (p
, Qnil
);
6563 process_send_signal (process
, SIGCONT
, current_group
, 0);
6565 error ("No SIGCONT support");
6570 /* Return the integer value of the signal whose abbreviation is ABBR,
6571 or a negative number if there is no such signal. */
6573 abbr_to_signal (char const *name
)
6576 char sigbuf
[20]; /* Large enough for all valid signal abbreviations. */
6578 if (!strncmp (name
, "SIG", 3) || !strncmp (name
, "sig", 3))
6581 for (i
= 0; i
< sizeof sigbuf
; i
++)
6583 sigbuf
[i
] = c_toupper (name
[i
]);
6585 return str2sig (sigbuf
, &signo
) == 0 ? signo
: -1;
6591 DEFUN ("signal-process", Fsignal_process
, Ssignal_process
,
6592 2, 2, "sProcess (name or number): \nnSignal code: ",
6593 doc
: /* Send PROCESS the signal with code SIGCODE.
6594 PROCESS may also be a number specifying the process id of the
6595 process to signal; in this case, the process need not be a child of
6597 SIGCODE may be an integer, or a symbol whose name is a signal name. */)
6598 (Lisp_Object process
, Lisp_Object sigcode
)
6603 if (STRINGP (process
))
6605 Lisp_Object tem
= Fget_process (process
);
6608 Lisp_Object process_number
6609 = string_to_number (SSDATA (process
), 10, 1);
6610 if (NUMBERP (process_number
))
6611 tem
= process_number
;
6615 else if (!NUMBERP (process
))
6616 process
= get_process (process
);
6621 if (NUMBERP (process
))
6622 CONS_TO_INTEGER (process
, pid_t
, pid
);
6625 CHECK_PROCESS (process
);
6626 pid
= XPROCESS (process
)->pid
;
6628 error ("Cannot signal process %s", SDATA (XPROCESS (process
)->name
));
6631 if (INTEGERP (sigcode
))
6633 CHECK_TYPE_RANGED_INTEGER (int, sigcode
);
6634 signo
= XINT (sigcode
);
6640 CHECK_SYMBOL (sigcode
);
6641 name
= SSDATA (SYMBOL_NAME (sigcode
));
6643 signo
= abbr_to_signal (name
);
6645 error ("Undefined signal name %s", name
);
6648 return make_number (kill (pid
, signo
));
6651 DEFUN ("process-send-eof", Fprocess_send_eof
, Sprocess_send_eof
, 0, 1, 0,
6652 doc
: /* Make PROCESS see end-of-file in its input.
6653 EOF comes after any text already sent to it.
6654 PROCESS may be a process, a buffer, the name of a process or buffer, or
6655 nil, indicating the current buffer's process.
6656 If PROCESS is a network connection, or is a process communicating
6657 through a pipe (as opposed to a pty), then you cannot send any more
6658 text to PROCESS after you call this function.
6659 If PROCESS is a serial process, wait until all output written to the
6660 process has been transmitted to the serial port. */)
6661 (Lisp_Object process
)
6664 struct coding_system
*coding
= NULL
;
6667 proc
= get_process (process
);
6669 if (NETCONN_P (proc
))
6670 wait_while_connecting (proc
);
6672 if (DATAGRAM_CONN_P (proc
))
6676 outfd
= XPROCESS (proc
)->outfd
;
6678 coding
= proc_encode_coding_system
[outfd
];
6680 /* Make sure the process is really alive. */
6681 if (XPROCESS (proc
)->raw_status_new
)
6682 update_status (XPROCESS (proc
));
6683 if (! EQ (XPROCESS (proc
)->status
, Qrun
))
6684 error ("Process %s not running", SDATA (XPROCESS (proc
)->name
));
6686 if (coding
&& CODING_REQUIRE_FLUSHING (coding
))
6688 coding
->mode
|= CODING_MODE_LAST_BLOCK
;
6689 send_process (proc
, "", 0, Qnil
);
6692 if (XPROCESS (proc
)->pty_flag
)
6693 send_process (proc
, "\004", 1, Qnil
);
6694 else if (EQ (XPROCESS (proc
)->type
, Qserial
))
6697 if (tcdrain (XPROCESS (proc
)->outfd
) != 0)
6698 report_file_error ("Failed tcdrain", Qnil
);
6699 #endif /* not WINDOWSNT */
6700 /* Do nothing on Windows because writes are blocking. */
6704 struct Lisp_Process
*p
= XPROCESS (proc
);
6705 int old_outfd
= p
->outfd
;
6708 #ifdef HAVE_SHUTDOWN
6709 /* If this is a network connection, or socketpair is used
6710 for communication with the subprocess, call shutdown to cause EOF.
6711 (In some old system, shutdown to socketpair doesn't work.
6712 Then we just can't win.) */
6714 && (EQ (p
->type
, Qnetwork
) || p
->infd
== old_outfd
))
6715 shutdown (old_outfd
, 1);
6717 close_process_fd (&p
->open_fd
[WRITE_TO_SUBPROCESS
]);
6718 new_outfd
= emacs_open (NULL_DEVICE
, O_WRONLY
, 0);
6720 report_file_error ("Opening null device", Qnil
);
6721 p
->open_fd
[WRITE_TO_SUBPROCESS
] = new_outfd
;
6722 p
->outfd
= new_outfd
;
6724 if (!proc_encode_coding_system
[new_outfd
])
6725 proc_encode_coding_system
[new_outfd
]
6726 = xmalloc (sizeof (struct coding_system
));
6729 *proc_encode_coding_system
[new_outfd
]
6730 = *proc_encode_coding_system
[old_outfd
];
6731 memset (proc_encode_coding_system
[old_outfd
], 0,
6732 sizeof (struct coding_system
));
6735 setup_coding_system (p
->encode_coding_system
,
6736 proc_encode_coding_system
[new_outfd
]);
6741 /* The main Emacs thread records child processes in three places:
6743 - Vprocess_alist, for asynchronous subprocesses, which are child
6744 processes visible to Lisp.
6746 - deleted_pid_list, for child processes invisible to Lisp,
6747 typically because of delete-process. These are recorded so that
6748 the processes can be reaped when they exit, so that the operating
6749 system's process table is not cluttered by zombies.
6751 - the local variable PID in Fcall_process, call_process_cleanup and
6752 call_process_kill, for synchronous subprocesses.
6753 record_unwind_protect is used to make sure this process is not
6754 forgotten: if the user interrupts call-process and the child
6755 process refuses to exit immediately even with two C-g's,
6756 call_process_kill adds PID's contents to deleted_pid_list before
6759 The main Emacs thread invokes waitpid only on child processes that
6760 it creates and that have not been reaped. This avoid races on
6761 platforms such as GTK, where other threads create their own
6762 subprocesses which the main thread should not reap. For example,
6763 if the main thread attempted to reap an already-reaped child, it
6764 might inadvertently reap a GTK-created process that happened to
6765 have the same process ID. */
6767 /* LIB_CHILD_HANDLER is a SIGCHLD handler that Emacs calls while doing
6768 its own SIGCHLD handling. On POSIXish systems, glib needs this to
6769 keep track of its own children. GNUstep is similar. */
6771 static void dummy_handler (int sig
) {}
6772 static signal_handler_t
volatile lib_child_handler
;
6774 /* Handle a SIGCHLD signal by looking for known child processes of
6775 Emacs whose status have changed. For each one found, record its
6778 All we do is change the status; we do not run sentinels or print
6779 notifications. That is saved for the next time keyboard input is
6780 done, in order to avoid timing errors.
6782 ** WARNING: this can be called during garbage collection.
6783 Therefore, it must not be fooled by the presence of mark bits in
6786 ** USG WARNING: Although it is not obvious from the documentation
6787 in signal(2), on a USG system the SIGCLD handler MUST NOT call
6788 signal() before executing at least one wait(), otherwise the
6789 handler will be called again, resulting in an infinite loop. The
6790 relevant portion of the documentation reads "SIGCLD signals will be
6791 queued and the signal-catching function will be continually
6792 reentered until the queue is empty". Invoking signal() causes the
6793 kernel to reexamine the SIGCLD queue. Fred Fish, UniSoft Systems
6796 ** Malloc WARNING: This should never call malloc either directly or
6797 indirectly; if it does, that is a bug. */
6800 handle_child_signal (int sig
)
6802 Lisp_Object tail
, proc
;
6804 /* Find the process that signaled us, and record its status. */
6806 /* The process can have been deleted by Fdelete_process, or have
6807 been started asynchronously by Fcall_process. */
6808 for (tail
= deleted_pid_list
; CONSP (tail
); tail
= XCDR (tail
))
6810 bool all_pids_are_fixnums
6811 = (MOST_NEGATIVE_FIXNUM
<= TYPE_MINIMUM (pid_t
)
6812 && TYPE_MAXIMUM (pid_t
) <= MOST_POSITIVE_FIXNUM
);
6813 Lisp_Object head
= XCAR (tail
);
6818 if (all_pids_are_fixnums
? INTEGERP (xpid
) : NUMBERP (xpid
))
6821 if (INTEGERP (xpid
))
6822 deleted_pid
= XINT (xpid
);
6824 deleted_pid
= XFLOAT_DATA (xpid
);
6825 if (child_status_changed (deleted_pid
, 0, 0))
6827 if (STRINGP (XCDR (head
)))
6828 unlink (SSDATA (XCDR (head
)));
6829 XSETCAR (tail
, Qnil
);
6834 /* Otherwise, if it is asynchronous, it is in Vprocess_alist. */
6835 FOR_EACH_PROCESS (tail
, proc
)
6837 struct Lisp_Process
*p
= XPROCESS (proc
);
6841 && child_status_changed (p
->pid
, &status
, WUNTRACED
| WCONTINUED
))
6843 /* Change the status of the process that was found. */
6844 p
->tick
= ++process_tick
;
6845 p
->raw_status
= status
;
6846 p
->raw_status_new
= 1;
6848 /* If process has terminated, stop waiting for its output. */
6849 if (WIFSIGNALED (status
) || WIFEXITED (status
))
6851 bool clear_desc_flag
= 0;
6854 clear_desc_flag
= 1;
6856 /* clear_desc_flag avoids a compiler bug in Microsoft C. */
6857 if (clear_desc_flag
)
6859 FD_CLR (p
->infd
, &input_wait_mask
);
6860 FD_CLR (p
->infd
, &non_keyboard_wait_mask
);
6866 lib_child_handler (sig
);
6867 #ifdef NS_IMPL_GNUSTEP
6868 /* NSTask in GNUstep sets its child handler each time it is called.
6869 So we must re-set ours. */
6870 catch_child_signal ();
6875 deliver_child_signal (int sig
)
6877 deliver_process_signal (sig
, handle_child_signal
);
6882 exec_sentinel_error_handler (Lisp_Object error_val
)
6884 cmd_error_internal (error_val
, "error in process sentinel: ");
6886 update_echo_area ();
6887 Fsleep_for (make_number (2), Qnil
);
6892 exec_sentinel (Lisp_Object proc
, Lisp_Object reason
)
6894 Lisp_Object sentinel
, odeactivate
;
6895 struct Lisp_Process
*p
= XPROCESS (proc
);
6896 ptrdiff_t count
= SPECPDL_INDEX ();
6897 bool outer_running_asynch_code
= running_asynch_code
;
6898 int waiting
= waiting_for_user_input_p
;
6900 if (inhibit_sentinels
)
6903 odeactivate
= Vdeactivate_mark
;
6905 Lisp_Object obuffer
, okeymap
;
6906 XSETBUFFER (obuffer
, current_buffer
);
6907 okeymap
= BVAR (current_buffer
, keymap
);
6910 /* There's no good reason to let sentinels change the current
6911 buffer, and many callers of accept-process-output, sit-for, and
6912 friends don't expect current-buffer to be changed from under them. */
6913 record_unwind_current_buffer ();
6915 sentinel
= p
->sentinel
;
6917 /* Inhibit quit so that random quits don't screw up a running filter. */
6918 specbind (Qinhibit_quit
, Qt
);
6919 specbind (Qlast_nonmenu_event
, Qt
); /* Why? --Stef */
6921 /* In case we get recursively called,
6922 and we already saved the match data nonrecursively,
6923 save the same match data in safely recursive fashion. */
6924 if (outer_running_asynch_code
)
6927 tem
= Fmatch_data (Qnil
, Qnil
, Qnil
);
6928 restore_search_regs ();
6929 record_unwind_save_match_data ();
6930 Fset_match_data (tem
, Qt
);
6933 /* For speed, if a search happens within this code,
6934 save the match data in a special nonrecursive fashion. */
6935 running_asynch_code
= 1;
6937 internal_condition_case_1 (read_process_output_call
,
6938 list3 (sentinel
, proc
, reason
),
6939 !NILP (Vdebug_on_error
) ? Qnil
: Qerror
,
6940 exec_sentinel_error_handler
);
6942 /* If we saved the match data nonrecursively, restore it now. */
6943 restore_search_regs ();
6944 running_asynch_code
= outer_running_asynch_code
;
6946 Vdeactivate_mark
= odeactivate
;
6948 /* Restore waiting_for_user_input_p as it was
6949 when we were called, in case the filter clobbered it. */
6950 waiting_for_user_input_p
= waiting
;
6953 if (! EQ (Fcurrent_buffer (), obuffer
)
6954 || ! EQ (current_buffer
->keymap
, okeymap
))
6956 /* But do it only if the caller is actually going to read events.
6957 Otherwise there's no need to make him wake up, and it could
6958 cause trouble (for example it would make sit_for return). */
6959 if (waiting_for_user_input_p
== -1)
6960 record_asynch_buffer_change ();
6962 unbind_to (count
, Qnil
);
6965 /* Report all recent events of a change in process status
6966 (either run the sentinel or output a message).
6967 This is usually done while Emacs is waiting for keyboard input
6968 but can be done at other times.
6970 Return positive if any input was received from WAIT_PROC (or from
6971 any process if WAIT_PROC is null), zero if input was attempted but
6972 none received, and negative if we didn't even try. */
6975 status_notify (struct Lisp_Process
*deleting_process
,
6976 struct Lisp_Process
*wait_proc
)
6979 Lisp_Object tail
, msg
;
6980 int got_some_output
= -1;
6985 /* Set this now, so that if new processes are created by sentinels
6986 that we run, we get called again to handle their status changes. */
6987 update_tick
= process_tick
;
6989 FOR_EACH_PROCESS (tail
, proc
)
6992 register struct Lisp_Process
*p
= XPROCESS (proc
);
6994 if (p
->tick
!= p
->update_tick
)
6996 p
->update_tick
= p
->tick
;
6998 /* If process is still active, read any output that remains. */
6999 while (! EQ (p
->filter
, Qt
)
7000 && ! EQ (p
->status
, Qconnect
)
7001 && ! EQ (p
->status
, Qlisten
)
7002 /* Network or serial process not stopped: */
7003 && ! EQ (p
->command
, Qt
)
7005 && p
!= deleting_process
)
7007 int nread
= read_process_output (proc
, p
->infd
);
7008 if ((!wait_proc
|| wait_proc
== XPROCESS (proc
))
7009 && got_some_output
< nread
)
7010 got_some_output
= nread
;
7015 /* Get the text to use for the message. */
7016 if (p
->raw_status_new
)
7018 msg
= status_message (p
);
7020 /* If process is terminated, deactivate it or delete it. */
7022 if (CONSP (p
->status
))
7023 symbol
= XCAR (p
->status
);
7025 if (EQ (symbol
, Qsignal
) || EQ (symbol
, Qexit
)
7026 || EQ (symbol
, Qclosed
))
7028 if (delete_exited_processes
)
7029 remove_process (proc
);
7031 deactivate_process (proc
);
7034 /* The actions above may have further incremented p->tick.
7035 So set p->update_tick again so that an error in the sentinel will
7036 not cause this code to be run again. */
7037 p
->update_tick
= p
->tick
;
7038 /* Now output the message suitably. */
7039 exec_sentinel (proc
, msg
);
7040 if (BUFFERP (p
->buffer
))
7041 /* In case it uses %s in mode-line-format. */
7042 bset_update_mode_line (XBUFFER (p
->buffer
));
7046 return got_some_output
;
7049 DEFUN ("internal-default-process-sentinel", Finternal_default_process_sentinel
,
7050 Sinternal_default_process_sentinel
, 2, 2, 0,
7051 doc
: /* Function used as default sentinel for processes.
7052 This inserts a status message into the process's buffer, if there is one. */)
7053 (Lisp_Object proc
, Lisp_Object msg
)
7055 Lisp_Object buffer
, symbol
;
7056 struct Lisp_Process
*p
;
7057 CHECK_PROCESS (proc
);
7058 p
= XPROCESS (proc
);
7062 symbol
= XCAR (symbol
);
7064 if (!EQ (symbol
, Qrun
) && !NILP (buffer
))
7067 struct buffer
*old
= current_buffer
;
7068 ptrdiff_t opoint
, opoint_byte
;
7069 ptrdiff_t before
, before_byte
;
7071 /* Avoid error if buffer is deleted
7072 (probably that's why the process is dead, too). */
7073 if (!BUFFER_LIVE_P (XBUFFER (buffer
)))
7075 Fset_buffer (buffer
);
7077 if (NILP (BVAR (current_buffer
, enable_multibyte_characters
)))
7078 msg
= (code_convert_string_norecord
7079 (msg
, Vlocale_coding_system
, 1));
7082 opoint_byte
= PT_BYTE
;
7083 /* Insert new output into buffer
7084 at the current end-of-output marker,
7085 thus preserving logical ordering of input and output. */
7086 if (XMARKER (p
->mark
)->buffer
)
7087 Fgoto_char (p
->mark
);
7089 SET_PT_BOTH (ZV
, ZV_BYTE
);
7092 before_byte
= PT_BYTE
;
7094 tem
= BVAR (current_buffer
, read_only
);
7095 bset_read_only (current_buffer
, Qnil
);
7096 insert_string ("\nProcess ");
7097 { /* FIXME: temporary kludge. */
7098 Lisp_Object tem2
= p
->name
; Finsert (1, &tem2
); }
7099 insert_string (" ");
7101 bset_read_only (current_buffer
, tem
);
7102 set_marker_both (p
->mark
, p
->buffer
, PT
, PT_BYTE
);
7104 if (opoint
>= before
)
7105 SET_PT_BOTH (opoint
+ (PT
- before
),
7106 opoint_byte
+ (PT_BYTE
- before_byte
));
7108 SET_PT_BOTH (opoint
, opoint_byte
);
7110 set_buffer_internal (old
);
7116 DEFUN ("set-process-coding-system", Fset_process_coding_system
,
7117 Sset_process_coding_system
, 1, 3, 0,
7118 doc
: /* Set coding systems of PROCESS to DECODING and ENCODING.
7119 DECODING will be used to decode subprocess output and ENCODING to
7120 encode subprocess input. */)
7121 (register Lisp_Object process
, Lisp_Object decoding
, Lisp_Object encoding
)
7123 register struct Lisp_Process
*p
;
7125 CHECK_PROCESS (process
);
7127 if (NETCONN_P (process
))
7128 wait_for_socket_fds (process
, "set-process-coding-system");
7130 p
= XPROCESS (process
);
7133 error ("Input file descriptor of %s closed", SDATA (p
->name
));
7135 error ("Output file descriptor of %s closed", SDATA (p
->name
));
7136 Fcheck_coding_system (decoding
);
7137 Fcheck_coding_system (encoding
);
7138 encoding
= coding_inherit_eol_type (encoding
, Qnil
);
7139 pset_decode_coding_system (p
, decoding
);
7140 pset_encode_coding_system (p
, encoding
);
7141 setup_process_coding_systems (process
);
7146 DEFUN ("process-coding-system",
7147 Fprocess_coding_system
, Sprocess_coding_system
, 1, 1, 0,
7148 doc
: /* Return a cons of coding systems for decoding and encoding of PROCESS. */)
7149 (register Lisp_Object process
)
7151 CHECK_PROCESS (process
);
7152 return Fcons (XPROCESS (process
)->decode_coding_system
,
7153 XPROCESS (process
)->encode_coding_system
);
7156 DEFUN ("set-process-filter-multibyte", Fset_process_filter_multibyte
,
7157 Sset_process_filter_multibyte
, 2, 2, 0,
7158 doc
: /* Set multibyteness of the strings given to PROCESS's filter.
7159 If FLAG is non-nil, the filter is given multibyte strings.
7160 If FLAG is nil, the filter is given unibyte strings. In this case,
7161 all character code conversion except for end-of-line conversion is
7163 (Lisp_Object process
, Lisp_Object flag
)
7165 register struct Lisp_Process
*p
;
7167 CHECK_PROCESS (process
);
7169 if (NETCONN_P (process
))
7170 wait_for_socket_fds (process
, "set-process-filter-multibyte");
7172 p
= XPROCESS (process
);
7174 pset_decode_coding_system
7175 (p
, raw_text_coding_system (p
->decode_coding_system
));
7176 setup_process_coding_systems (process
);
7181 DEFUN ("process-filter-multibyte-p", Fprocess_filter_multibyte_p
,
7182 Sprocess_filter_multibyte_p
, 1, 1, 0,
7183 doc
: /* Return t if a multibyte string is given to PROCESS's filter.*/)
7184 (Lisp_Object process
)
7186 register struct Lisp_Process
*p
;
7187 struct coding_system
*coding
;
7189 CHECK_PROCESS (process
);
7190 p
= XPROCESS (process
);
7193 coding
= proc_decode_coding_system
[p
->infd
];
7194 return (CODING_FOR_UNIBYTE (coding
) ? Qnil
: Qt
);
7203 add_gpm_wait_descriptor (int desc
)
7205 add_keyboard_wait_descriptor (desc
);
7209 delete_gpm_wait_descriptor (int desc
)
7211 delete_keyboard_wait_descriptor (desc
);
7216 # ifdef USABLE_SIGIO
7218 /* Return true if *MASK has a bit set
7219 that corresponds to one of the keyboard input descriptors. */
7222 keyboard_bit_set (fd_set
*mask
)
7226 for (fd
= 0; fd
<= max_input_desc
; fd
++)
7227 if (FD_ISSET (fd
, mask
) && FD_ISSET (fd
, &input_wait_mask
)
7228 && !FD_ISSET (fd
, &non_keyboard_wait_mask
))
7235 #else /* not subprocesses */
7237 /* Defined in msdos.c. */
7238 extern int sys_select (int, fd_set
*, fd_set
*, fd_set
*,
7239 struct timespec
*, void *);
7241 /* Implementation of wait_reading_process_output, assuming that there
7242 are no subprocesses. Used only by the MS-DOS build.
7244 Wait for timeout to elapse and/or keyboard input to be available.
7248 If negative, gobble data immediately available but don't wait for any.
7251 an additional duration to wait, measured in nanoseconds
7252 If TIME_LIMIT is zero, then:
7253 If NSECS == 0, there is no limit.
7254 If NSECS > 0, the timeout consists of NSECS only.
7255 If NSECS < 0, gobble data immediately, as if TIME_LIMIT were negative.
7258 0 to ignore keyboard input, or
7259 1 to return when input is available, or
7260 -1 means caller will actually read the input, so don't throw to
7263 see full version for other parameters. We know that wait_proc will
7264 always be NULL, since `subprocesses' isn't defined.
7266 DO_DISPLAY means redisplay should be done to show subprocess
7267 output that arrives.
7269 Return -1 signifying we got no output and did not try. */
7272 wait_reading_process_output (intmax_t time_limit
, int nsecs
, int read_kbd
,
7274 Lisp_Object wait_for_cell
,
7275 struct Lisp_Process
*wait_proc
, int just_wait_proc
)
7278 struct timespec end_time
, timeout
;
7279 enum { MINIMUM
= -1, TIMEOUT
, INFINITY
} wait
;
7281 if (TYPE_MAXIMUM (time_t) < time_limit
)
7282 time_limit
= TYPE_MAXIMUM (time_t);
7284 if (time_limit
< 0 || nsecs
< 0)
7286 else if (time_limit
> 0 || nsecs
> 0)
7289 end_time
= timespec_add (current_timespec (),
7290 make_timespec (time_limit
, nsecs
));
7295 /* Turn off periodic alarms (in case they are in use)
7296 and then turn off any other atimers,
7297 because the select emulator uses alarms. */
7299 turn_on_atimers (0);
7303 bool timeout_reduced_for_timers
= false;
7304 fd_set waitchannels
;
7307 /* If calling from keyboard input, do not quit
7308 since we want to return C-g as an input character.
7309 Otherwise, do pending quit if requested. */
7313 /* Exit now if the cell we're waiting for became non-nil. */
7314 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7317 /* Compute time from now till when time limit is up. */
7318 /* Exit if already run out. */
7319 if (wait
== TIMEOUT
)
7321 struct timespec now
= current_timespec ();
7322 if (timespec_cmp (end_time
, now
) <= 0)
7324 timeout
= timespec_sub (end_time
, now
);
7327 timeout
= make_timespec (wait
< TIMEOUT
? 0 : 100000, 0);
7329 /* If our caller will not immediately handle keyboard events,
7330 run timer events directly.
7331 (Callers that will immediately read keyboard events
7332 call timer_delay on their own.) */
7333 if (NILP (wait_for_cell
))
7335 struct timespec timer_delay
;
7339 unsigned old_timers_run
= timers_run
;
7340 timer_delay
= timer_check ();
7341 if (timers_run
!= old_timers_run
&& do_display
)
7342 /* We must retry, since a timer may have requeued itself
7343 and that could alter the time delay. */
7344 redisplay_preserve_echo_area (14);
7348 while (!detect_input_pending ());
7350 /* If there is unread keyboard input, also return. */
7352 && requeued_events_pending_p ())
7355 if (timespec_valid_p (timer_delay
))
7357 if (timespec_cmp (timer_delay
, timeout
) < 0)
7359 timeout
= timer_delay
;
7360 timeout_reduced_for_timers
= true;
7365 /* Cause C-g and alarm signals to take immediate action,
7366 and cause input available signals to zero out timeout. */
7368 set_waiting_for_input (&timeout
);
7370 /* If a frame has been newly mapped and needs updating,
7371 reprocess its display stuff. */
7372 if (frame_garbaged
&& do_display
)
7374 clear_waiting_for_input ();
7375 redisplay_preserve_echo_area (15);
7377 set_waiting_for_input (&timeout
);
7380 /* Wait till there is something to do. */
7381 FD_ZERO (&waitchannels
);
7382 if (read_kbd
&& detect_input_pending ())
7386 if (read_kbd
|| !NILP (wait_for_cell
))
7387 FD_SET (0, &waitchannels
);
7388 nfds
= pselect (1, &waitchannels
, NULL
, NULL
, &timeout
, NULL
);
7393 /* Make C-g and alarm signals set flags again. */
7394 clear_waiting_for_input ();
7396 /* If we woke up due to SIGWINCH, actually change size now. */
7397 do_pending_window_change (0);
7399 if (wait
< INFINITY
&& nfds
== 0 && ! timeout_reduced_for_timers
)
7400 /* We waited the full specified time, so return now. */
7405 /* If the system call was interrupted, then go around the
7407 if (xerrno
== EINTR
)
7408 FD_ZERO (&waitchannels
);
7410 report_file_errno ("Failed select", Qnil
, xerrno
);
7413 /* Check for keyboard input. */
7416 && detect_input_pending_run_timers (do_display
))
7418 swallow_events (do_display
);
7419 if (detect_input_pending_run_timers (do_display
))
7423 /* If there is unread keyboard input, also return. */
7425 && requeued_events_pending_p ())
7428 /* If wait_for_cell. check for keyboard input
7429 but don't run any timers.
7430 ??? (It seems wrong to me to check for keyboard
7431 input at all when wait_for_cell, but the code
7432 has been this way since July 1994.
7433 Try changing this after version 19.31.) */
7434 if (! NILP (wait_for_cell
)
7435 && detect_input_pending ())
7437 swallow_events (do_display
);
7438 if (detect_input_pending ())
7442 /* Exit now if the cell we're waiting for became non-nil. */
7443 if (! NILP (wait_for_cell
) && ! NILP (XCAR (wait_for_cell
)))
7452 #endif /* not subprocesses */
7454 /* The following functions are needed even if async subprocesses are
7455 not supported. Some of them are no-op stubs in that case. */
7459 /* Add FD, which is a descriptor returned by timerfd_create,
7460 to the set of non-keyboard input descriptors. */
7463 add_timer_wait_descriptor (int fd
)
7465 FD_SET (fd
, &input_wait_mask
);
7466 FD_SET (fd
, &non_keyboard_wait_mask
);
7467 FD_SET (fd
, &non_process_wait_mask
);
7468 fd_callback_info
[fd
].func
= timerfd_callback
;
7469 fd_callback_info
[fd
].data
= NULL
;
7470 fd_callback_info
[fd
].condition
|= FOR_READ
;
7471 if (fd
> max_input_desc
)
7472 max_input_desc
= fd
;
7475 #endif /* HAVE_TIMERFD */
7477 /* Add DESC to the set of keyboard input descriptors. */
7480 add_keyboard_wait_descriptor (int desc
)
7482 #ifdef subprocesses /* Actually means "not MSDOS". */
7483 FD_SET (desc
, &input_wait_mask
);
7484 FD_SET (desc
, &non_process_wait_mask
);
7485 if (desc
> max_input_desc
)
7486 max_input_desc
= desc
;
7490 /* From now on, do not expect DESC to give keyboard input. */
7493 delete_keyboard_wait_descriptor (int desc
)
7496 FD_CLR (desc
, &input_wait_mask
);
7497 FD_CLR (desc
, &non_process_wait_mask
);
7498 delete_input_desc (desc
);
7502 /* Setup coding systems of PROCESS. */
7505 setup_process_coding_systems (Lisp_Object process
)
7508 struct Lisp_Process
*p
= XPROCESS (process
);
7510 int outch
= p
->outfd
;
7511 Lisp_Object coding_system
;
7513 if (inch
< 0 || outch
< 0)
7516 if (!proc_decode_coding_system
[inch
])
7517 proc_decode_coding_system
[inch
] = xmalloc (sizeof (struct coding_system
));
7518 coding_system
= p
->decode_coding_system
;
7519 if (EQ (p
->filter
, Qinternal_default_process_filter
)
7520 && BUFFERP (p
->buffer
))
7522 if (NILP (BVAR (XBUFFER (p
->buffer
), enable_multibyte_characters
)))
7523 coding_system
= raw_text_coding_system (coding_system
);
7525 setup_coding_system (coding_system
, proc_decode_coding_system
[inch
]);
7527 if (!proc_encode_coding_system
[outch
])
7528 proc_encode_coding_system
[outch
] = xmalloc (sizeof (struct coding_system
));
7529 setup_coding_system (p
->encode_coding_system
,
7530 proc_encode_coding_system
[outch
]);
7534 DEFUN ("get-buffer-process", Fget_buffer_process
, Sget_buffer_process
, 1, 1, 0,
7535 doc
: /* Return the (or a) live process associated with BUFFER.
7536 BUFFER may be a buffer or the name of one.
7537 Return nil if all processes associated with BUFFER have been
7538 deleted or killed. */)
7539 (register Lisp_Object buffer
)
7542 register Lisp_Object buf
, tail
, proc
;
7544 if (NILP (buffer
)) return Qnil
;
7545 buf
= Fget_buffer (buffer
);
7546 if (NILP (buf
)) return Qnil
;
7548 FOR_EACH_PROCESS (tail
, proc
)
7549 if (EQ (XPROCESS (proc
)->buffer
, buf
))
7551 #endif /* subprocesses */
7555 DEFUN ("process-inherit-coding-system-flag",
7556 Fprocess_inherit_coding_system_flag
, Sprocess_inherit_coding_system_flag
,
7558 doc
: /* Return the value of inherit-coding-system flag for PROCESS.
7559 If this flag is t, `buffer-file-coding-system' of the buffer
7560 associated with PROCESS will inherit the coding system used to decode
7561 the process output. */)
7562 (register Lisp_Object process
)
7565 CHECK_PROCESS (process
);
7566 return XPROCESS (process
)->inherit_coding_system_flag
? Qt
: Qnil
;
7568 /* Ignore the argument and return the value of
7569 inherit-process-coding-system. */
7570 return inherit_process_coding_system
? Qt
: Qnil
;
7574 /* Kill all processes associated with `buffer'.
7575 If `buffer' is nil, kill all processes. */
7578 kill_buffer_processes (Lisp_Object buffer
)
7581 Lisp_Object tail
, proc
;
7583 FOR_EACH_PROCESS (tail
, proc
)
7584 if (NILP (buffer
) || EQ (XPROCESS (proc
)->buffer
, buffer
))
7586 if (NETCONN_P (proc
) || SERIALCONN_P (proc
) || PIPECONN_P (proc
))
7587 Fdelete_process (proc
);
7588 else if (XPROCESS (proc
)->infd
>= 0)
7589 process_send_signal (proc
, SIGHUP
, Qnil
, 1);
7591 #else /* subprocesses */
7592 /* Since we have no subprocesses, this does nothing. */
7593 #endif /* subprocesses */
7596 DEFUN ("waiting-for-user-input-p", Fwaiting_for_user_input_p
,
7597 Swaiting_for_user_input_p
, 0, 0, 0,
7598 doc
: /* Return non-nil if Emacs is waiting for input from the user.
7599 This is intended for use by asynchronous process output filters and sentinels. */)
7603 return (waiting_for_user_input_p
? Qt
: Qnil
);
7609 /* Stop reading input from keyboard sources. */
7612 hold_keyboard_input (void)
7617 /* Resume reading input from keyboard sources. */
7620 unhold_keyboard_input (void)
7625 /* Return true if keyboard input is on hold, zero otherwise. */
7628 kbd_on_hold_p (void)
7630 return kbd_is_on_hold
;
7634 /* Enumeration of and access to system processes a-la ps(1). */
7636 DEFUN ("list-system-processes", Flist_system_processes
, Slist_system_processes
,
7638 doc
: /* Return a list of numerical process IDs of all running processes.
7639 If this functionality is unsupported, return nil.
7641 See `process-attributes' for getting attributes of a process given its ID. */)
7644 return list_system_processes ();
7647 DEFUN ("process-attributes", Fprocess_attributes
,
7648 Sprocess_attributes
, 1, 1, 0,
7649 doc
: /* Return attributes of the process given by its PID, a number.
7651 Value is an alist where each element is a cons cell of the form
7655 If this functionality is unsupported, the value is nil.
7657 See `list-system-processes' for getting a list of all process IDs.
7659 The KEYs of the attributes that this function may return are listed
7660 below, together with the type of the associated VALUE (in parentheses).
7661 Not all platforms support all of these attributes; unsupported
7662 attributes will not appear in the returned alist.
7663 Unless explicitly indicated otherwise, numbers can have either
7664 integer or floating point values.
7666 euid -- Effective user User ID of the process (number)
7667 user -- User name corresponding to euid (string)
7668 egid -- Effective user Group ID of the process (number)
7669 group -- Group name corresponding to egid (string)
7670 comm -- Command name (executable name only) (string)
7671 state -- Process state code, such as "S", "R", or "T" (string)
7672 ppid -- Parent process ID (number)
7673 pgrp -- Process group ID (number)
7674 sess -- Session ID, i.e. process ID of session leader (number)
7675 ttname -- Controlling tty name (string)
7676 tpgid -- ID of foreground process group on the process's tty (number)
7677 minflt -- number of minor page faults (number)
7678 majflt -- number of major page faults (number)
7679 cminflt -- cumulative number of minor page faults (number)
7680 cmajflt -- cumulative number of major page faults (number)
7681 utime -- user time used by the process, in (current-time) format,
7682 which is a list of integers (HIGH LOW USEC PSEC)
7683 stime -- system time used by the process (current-time)
7684 time -- sum of utime and stime (current-time)
7685 cutime -- user time used by the process and its children (current-time)
7686 cstime -- system time used by the process and its children (current-time)
7687 ctime -- sum of cutime and cstime (current-time)
7688 pri -- priority of the process (number)
7689 nice -- nice value of the process (number)
7690 thcount -- process thread count (number)
7691 start -- time the process started (current-time)
7692 vsize -- virtual memory size of the process in KB's (number)
7693 rss -- resident set size of the process in KB's (number)
7694 etime -- elapsed time the process is running, in (HIGH LOW USEC PSEC) format
7695 pcpu -- percents of CPU time used by the process (floating-point number)
7696 pmem -- percents of total physical memory used by process's resident set
7697 (floating-point number)
7698 args -- command line which invoked the process (string). */)
7701 return system_process_attributes (pid
);
7705 /* Arrange to catch SIGCHLD if this hasn't already been arranged.
7706 Invoke this after init_process_emacs, and after glib and/or GNUstep
7707 futz with the SIGCHLD handler, but before Emacs forks any children.
7708 This function's caller should block SIGCHLD. */
7711 catch_child_signal (void)
7713 struct sigaction action
, old_action
;
7715 emacs_sigaction_init (&action
, deliver_child_signal
);
7716 block_child_signal (&oldset
);
7717 sigaction (SIGCHLD
, &action
, &old_action
);
7718 eassert (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7719 || ! (old_action
.sa_flags
& SA_SIGINFO
));
7721 if (old_action
.sa_handler
!= deliver_child_signal
)
7723 = (old_action
.sa_handler
== SIG_DFL
|| old_action
.sa_handler
== SIG_IGN
7725 : old_action
.sa_handler
);
7726 unblock_child_signal (&oldset
);
7728 #endif /* subprocesses */
7731 /* This is not called "init_process" because that is the name of a
7732 Mach system call, so it would cause problems on Darwin systems. */
7734 init_process_emacs (void)
7739 inhibit_sentinels
= 0;
7742 if (! noninteractive
|| initialized
)
7745 #if defined HAVE_GLIB && !defined WINDOWSNT
7746 /* Tickle glib's child-handling code. Ask glib to wait for Emacs itself;
7747 this should always fail, but is enough to initialize glib's
7748 private SIGCHLD handler, allowing catch_child_signal to copy
7749 it into lib_child_handler. */
7750 g_source_unref (g_child_watch_source_new (getpid ()));
7752 catch_child_signal ();
7755 FD_ZERO (&input_wait_mask
);
7756 FD_ZERO (&non_keyboard_wait_mask
);
7757 FD_ZERO (&non_process_wait_mask
);
7758 FD_ZERO (&write_mask
);
7759 max_process_desc
= max_input_desc
= -1;
7760 memset (fd_callback_info
, 0, sizeof (fd_callback_info
));
7762 #ifdef NON_BLOCKING_CONNECT
7763 FD_ZERO (&connect_wait_mask
);
7764 num_pending_connects
= 0;
7767 process_output_delay_count
= 0;
7768 process_output_skip
= 0;
7770 /* Don't do this, it caused infinite select loops. The display
7771 method should call add_keyboard_wait_descriptor on stdin if it
7774 FD_SET (0, &input_wait_mask
);
7777 Vprocess_alist
= Qnil
;
7778 deleted_pid_list
= Qnil
;
7779 for (i
= 0; i
< FD_SETSIZE
; i
++)
7781 chan_process
[i
] = Qnil
;
7782 proc_buffered_char
[i
] = -1;
7784 memset (proc_decode_coding_system
, 0, sizeof proc_decode_coding_system
);
7785 memset (proc_encode_coding_system
, 0, sizeof proc_encode_coding_system
);
7786 #ifdef DATAGRAM_SOCKETS
7787 memset (datagram_address
, 0, sizeof datagram_address
);
7789 #ifdef HAVE_GETADDRINFO_A
7790 dns_processes
= Qnil
;
7793 #if defined (DARWIN_OS)
7794 /* PTYs are broken on Darwin < 6, but are sometimes useful for interactive
7795 processes. As such, we only change the default value. */
7798 char const *release
= (STRINGP (Voperating_system_release
)
7799 ? SSDATA (Voperating_system_release
)
7801 if (!release
|| !release
[0] || (release
[0] < '7' && release
[1] == '.')) {
7802 Vprocess_connection_type
= Qnil
;
7806 #endif /* subprocesses */
7811 syms_of_process (void)
7815 DEFSYM (Qprocessp
, "processp");
7816 DEFSYM (Qrun
, "run");
7817 DEFSYM (Qstop
, "stop");
7818 DEFSYM (Qsignal
, "signal");
7820 /* Qexit is already staticpro'd by syms_of_eval; don't staticpro it
7823 DEFSYM (Qopen
, "open");
7824 DEFSYM (Qclosed
, "closed");
7825 DEFSYM (Qconnect
, "connect");
7826 DEFSYM (Qfailed
, "failed");
7827 DEFSYM (Qlisten
, "listen");
7828 DEFSYM (Qlocal
, "local");
7829 DEFSYM (Qipv4
, "ipv4");
7831 DEFSYM (Qipv6
, "ipv6");
7833 DEFSYM (Qdatagram
, "datagram");
7834 DEFSYM (Qseqpacket
, "seqpacket");
7836 DEFSYM (QCport
, ":port");
7837 DEFSYM (QCspeed
, ":speed");
7838 DEFSYM (QCprocess
, ":process");
7840 DEFSYM (QCbytesize
, ":bytesize");
7841 DEFSYM (QCstopbits
, ":stopbits");
7842 DEFSYM (QCparity
, ":parity");
7843 DEFSYM (Qodd
, "odd");
7844 DEFSYM (Qeven
, "even");
7845 DEFSYM (QCflowcontrol
, ":flowcontrol");
7848 DEFSYM (QCsummary
, ":summary");
7850 DEFSYM (Qreal
, "real");
7851 DEFSYM (Qnetwork
, "network");
7852 DEFSYM (Qserial
, "serial");
7853 DEFSYM (Qpipe
, "pipe");
7854 DEFSYM (QCbuffer
, ":buffer");
7855 DEFSYM (QChost
, ":host");
7856 DEFSYM (QCservice
, ":service");
7857 DEFSYM (QClocal
, ":local");
7858 DEFSYM (QCremote
, ":remote");
7859 DEFSYM (QCcoding
, ":coding");
7860 DEFSYM (QCserver
, ":server");
7861 DEFSYM (QCnowait
, ":nowait");
7862 DEFSYM (QCsentinel
, ":sentinel");
7863 DEFSYM (QCtls_parameters
, ":tls-parameters");
7864 DEFSYM (Qnsm_verify_connection
, "nsm-verify-connection");
7865 DEFSYM (QClog
, ":log");
7866 DEFSYM (QCnoquery
, ":noquery");
7867 DEFSYM (QCstop
, ":stop");
7868 DEFSYM (QCplist
, ":plist");
7869 DEFSYM (QCcommand
, ":command");
7870 DEFSYM (QCconnection_type
, ":connection-type");
7871 DEFSYM (QCstderr
, ":stderr");
7872 DEFSYM (Qpty
, "pty");
7873 DEFSYM (Qpipe
, "pipe");
7875 DEFSYM (Qlast_nonmenu_event
, "last-nonmenu-event");
7877 staticpro (&Vprocess_alist
);
7878 staticpro (&deleted_pid_list
);
7879 #ifdef HAVE_GETADDRINFO_A
7880 staticpro (&dns_processes
);
7883 #endif /* subprocesses */
7885 DEFSYM (QCname
, ":name");
7886 DEFSYM (QCtype
, ":type");
7888 DEFSYM (Qeuid
, "euid");
7889 DEFSYM (Qegid
, "egid");
7890 DEFSYM (Quser
, "user");
7891 DEFSYM (Qgroup
, "group");
7892 DEFSYM (Qcomm
, "comm");
7893 DEFSYM (Qstate
, "state");
7894 DEFSYM (Qppid
, "ppid");
7895 DEFSYM (Qpgrp
, "pgrp");
7896 DEFSYM (Qsess
, "sess");
7897 DEFSYM (Qttname
, "ttname");
7898 DEFSYM (Qtpgid
, "tpgid");
7899 DEFSYM (Qminflt
, "minflt");
7900 DEFSYM (Qmajflt
, "majflt");
7901 DEFSYM (Qcminflt
, "cminflt");
7902 DEFSYM (Qcmajflt
, "cmajflt");
7903 DEFSYM (Qutime
, "utime");
7904 DEFSYM (Qstime
, "stime");
7905 DEFSYM (Qtime
, "time");
7906 DEFSYM (Qcutime
, "cutime");
7907 DEFSYM (Qcstime
, "cstime");
7908 DEFSYM (Qctime
, "ctime");
7910 DEFSYM (Qinternal_default_process_sentinel
,
7911 "internal-default-process-sentinel");
7912 DEFSYM (Qinternal_default_process_filter
,
7913 "internal-default-process-filter");
7915 DEFSYM (Qpri
, "pri");
7916 DEFSYM (Qnice
, "nice");
7917 DEFSYM (Qthcount
, "thcount");
7918 DEFSYM (Qstart
, "start");
7919 DEFSYM (Qvsize
, "vsize");
7920 DEFSYM (Qrss
, "rss");
7921 DEFSYM (Qetime
, "etime");
7922 DEFSYM (Qpcpu
, "pcpu");
7923 DEFSYM (Qpmem
, "pmem");
7924 DEFSYM (Qargs
, "args");
7926 DEFVAR_BOOL ("delete-exited-processes", delete_exited_processes
,
7927 doc
: /* Non-nil means delete processes immediately when they exit.
7928 A value of nil means don't delete them until `list-processes' is run. */);
7930 delete_exited_processes
= 1;
7933 DEFVAR_LISP ("process-connection-type", Vprocess_connection_type
,
7934 doc
: /* Control type of device used to communicate with subprocesses.
7935 Values are nil to use a pipe, or t or `pty' to use a pty.
7936 The value has no effect if the system has no ptys or if all ptys are busy:
7937 then a pipe is used in any case.
7938 The value takes effect when `start-process' is called. */);
7939 Vprocess_connection_type
= Qt
;
7941 DEFVAR_LISP ("process-adaptive-read-buffering", Vprocess_adaptive_read_buffering
,
7942 doc
: /* If non-nil, improve receive buffering by delaying after short reads.
7943 On some systems, when Emacs reads the output from a subprocess, the output data
7944 is read in very small blocks, potentially resulting in very poor performance.
7945 This behavior can be remedied to some extent by setting this variable to a
7946 non-nil value, as it will automatically delay reading from such processes, to
7947 allow them to produce more output before Emacs tries to read it.
7948 If the value is t, the delay is reset after each write to the process; any other
7949 non-nil value means that the delay is not reset on write.
7950 The variable takes effect when `start-process' is called. */);
7951 Vprocess_adaptive_read_buffering
= Qt
;
7953 defsubr (&Sprocessp
);
7954 defsubr (&Sget_process
);
7955 defsubr (&Sdelete_process
);
7956 defsubr (&Sprocess_status
);
7957 defsubr (&Sprocess_exit_status
);
7958 defsubr (&Sprocess_id
);
7959 defsubr (&Sprocess_name
);
7960 defsubr (&Sprocess_tty_name
);
7961 defsubr (&Sprocess_command
);
7962 defsubr (&Sset_process_buffer
);
7963 defsubr (&Sprocess_buffer
);
7964 defsubr (&Sprocess_mark
);
7965 defsubr (&Sset_process_filter
);
7966 defsubr (&Sprocess_filter
);
7967 defsubr (&Sset_process_sentinel
);
7968 defsubr (&Sprocess_sentinel
);
7969 defsubr (&Sset_process_window_size
);
7970 defsubr (&Sset_process_inherit_coding_system_flag
);
7971 defsubr (&Sset_process_query_on_exit_flag
);
7972 defsubr (&Sprocess_query_on_exit_flag
);
7973 defsubr (&Sprocess_contact
);
7974 defsubr (&Sprocess_plist
);
7975 defsubr (&Sset_process_plist
);
7976 defsubr (&Sprocess_list
);
7977 defsubr (&Smake_process
);
7978 defsubr (&Smake_pipe_process
);
7979 defsubr (&Sserial_process_configure
);
7980 defsubr (&Smake_serial_process
);
7981 defsubr (&Sset_network_process_option
);
7982 defsubr (&Smake_network_process
);
7983 defsubr (&Sformat_network_address
);
7984 defsubr (&Snetwork_interface_list
);
7985 defsubr (&Snetwork_interface_info
);
7986 #ifdef DATAGRAM_SOCKETS
7987 defsubr (&Sprocess_datagram_address
);
7988 defsubr (&Sset_process_datagram_address
);
7990 defsubr (&Saccept_process_output
);
7991 defsubr (&Sprocess_send_region
);
7992 defsubr (&Sprocess_send_string
);
7993 defsubr (&Sinterrupt_process
);
7994 defsubr (&Skill_process
);
7995 defsubr (&Squit_process
);
7996 defsubr (&Sstop_process
);
7997 defsubr (&Scontinue_process
);
7998 defsubr (&Sprocess_running_child_p
);
7999 defsubr (&Sprocess_send_eof
);
8000 defsubr (&Ssignal_process
);
8001 defsubr (&Swaiting_for_user_input_p
);
8002 defsubr (&Sprocess_type
);
8003 defsubr (&Sinternal_default_process_sentinel
);
8004 defsubr (&Sinternal_default_process_filter
);
8005 defsubr (&Sset_process_coding_system
);
8006 defsubr (&Sprocess_coding_system
);
8007 defsubr (&Sset_process_filter_multibyte
);
8008 defsubr (&Sprocess_filter_multibyte_p
);
8010 #endif /* subprocesses */
8012 defsubr (&Sget_buffer_process
);
8013 defsubr (&Sprocess_inherit_coding_system_flag
);
8014 defsubr (&Slist_system_processes
);
8015 defsubr (&Sprocess_attributes
);
8018 Lisp_Object subfeatures
= Qnil
;
8019 const struct socket_options
*sopt
;
8021 #define ADD_SUBFEATURE(key, val) \
8022 subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
8024 #ifdef NON_BLOCKING_CONNECT
8025 ADD_SUBFEATURE (QCnowait
, Qt
);
8027 #ifdef DATAGRAM_SOCKETS
8028 ADD_SUBFEATURE (QCtype
, Qdatagram
);
8030 #ifdef HAVE_SEQPACKET
8031 ADD_SUBFEATURE (QCtype
, Qseqpacket
);
8033 #ifdef HAVE_LOCAL_SOCKETS
8034 ADD_SUBFEATURE (QCfamily
, Qlocal
);
8036 ADD_SUBFEATURE (QCfamily
, Qipv4
);
8038 ADD_SUBFEATURE (QCfamily
, Qipv6
);
8040 #ifdef HAVE_GETSOCKNAME
8041 ADD_SUBFEATURE (QCservice
, Qt
);
8043 ADD_SUBFEATURE (QCserver
, Qt
);
8045 for (sopt
= socket_options
; sopt
->name
; sopt
++)
8046 subfeatures
= pure_cons (intern_c_string (sopt
->name
), subfeatures
);
8048 Fprovide (intern_c_string ("make-network-process"), subfeatures
);